From a02d4dc211b61d5dd8827ce5727adf07ca4ccffb Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Fri, 13 Jun 2008 15:56:04 +0000 Subject: [PATCH] Persistent patterns, save and load to a file. --- Makefile.in | 30 ++++++-- bitmatch.mli | 4 + bitmatch_config.ml.in | 1 + bitmatch_objinfo.ml | 50 ++++++++++++ bitmatch_persistent.ml | 43 ++++++----- bitmatch_persistent.mli | 191 ++++++++++++++++++++++++++++++++++++++++------ cil-tools/Makefile.in | 6 +- create_test_pattern.ml | 27 +++++++ pa_bitmatch.ml | 101 +++++++++++++++++++++--- tests/50_named_pattern.ml | 20 +++++ tests/51_open_pattern.ml | 17 +++++ 11 files changed, 432 insertions(+), 58 deletions(-) create mode 100644 bitmatch_objinfo.ml create mode 100644 create_test_pattern.ml create mode 100644 tests/50_named_pattern.ml create mode 100644 tests/51_open_pattern.ml diff --git a/Makefile.in b/Makefile.in index a28fb92..c695a5e 100644 --- a/Makefile.in +++ b/Makefile.in @@ -43,7 +43,8 @@ TESTS = $(patsubst %.ml,%,$(wildcard tests/*.ml)) all: bitmatch.cma bitmatch_persistent.cma \ bitmatch.cmxa bitmatch_persistent.cmxa \ - pa_bitmatch.cmo + pa_bitmatch.cmo \ + bitmatch-objinfo @for d in $(SUBDIRS); do $(MAKE) -C $$d $@; done bitmatch.cma: bitmatch_types.cmo bitmatch_config.cmo bitmatch.cmo @@ -74,11 +75,16 @@ pa_bitmatch.cmo: pa_bitmatch.ml bitmatch.cma bitmatch_persistent.cma $(OCAMLFIND) ocamlc bitmatch.cma -I +camlp4 camlp4lib.cma \ -pp camlp4of -c $< -o $@ +bitmatch-objinfo: bitmatch_objinfo.cmo bitmatch.cma bitmatch_persistent.cma + $(OCAMLFIND) ocamlc -I +camlp4 unix.cma camlp4lib.cma \ + bitmatch.cma bitmatch_persistent.cma \ + $< -o $@ + # Tests and examples. PP = -pp "camlp4o bitmatch.cma bitmatch_persistent.cma pa_bitmatch.cmo" -test: pa_bitmatch.cmo bitmatch.cma bitmatch_persistent.cma +test: pa_bitmatch.cmo bitmatch.cma bitmatch_persistent.cma tests/test.bmpp @for f in $(TESTS); do \ echo Building $$f; \ $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) $(PP) \ @@ -90,10 +96,24 @@ test: pa_bitmatch.cmo bitmatch.cma bitmatch_persistent.cma done @for d in $(SUBDIRS); do $(MAKE) -C $$d $@; done +tests/test.bmpp: create_test_pattern + ./$< $@.new + mv $@.new $@ + +create_test_pattern: create_test_pattern.cmo + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -pp camlp4of \ + unix.cma -I +camlp4 camlp4lib.cma \ + -I . bitmatch.cma bitmatch_persistent.cma $< -o $@ + +create_test_pattern.cmo: create_test_pattern.ml + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) -pp camlp4of \ + unix.cma -I +camlp4 \ + -I . -c $< -o $@ + examples: pa_bitmatch.cmo bitmatch.cma bitmatch_persistent.cma @for f in $(EXAMPLES); do \ echo Building $$f; \ - $(OCAMLFIND) ocamlc $(OCAMLFLAGS) $(PP) \ + $(OCAMLFIND) ocamlc $(OCAMLCFLAGS) $(PP) \ -package unix -linkpkg -I . bitmatch.cma $$f.ml -o $$f; \ if [ $$? -ne 0 ]; then exit 1; fi; \ done @@ -136,8 +156,8 @@ ifneq ($(OCAMLDOC),) doc: rm -rf html mkdir html - $(OCAMLDOC) $(OCAMLDOCFLAGS) -d html bitmatch.mli bitmatch.ml \ - bitmatch_persistent.mli bitmatch_persistent.ml + $(OCAMLDOC) $(OCAMLDOCFLAGS) -d html -I +camlp4 \ + bitmatch.mli bitmatch_persistent.mli endif # Install. diff --git a/bitmatch.mli b/bitmatch.mli index 0777c28..95cc63c 100644 --- a/bitmatch.mli +++ b/bitmatch.mli @@ -417,6 +417,10 @@ Bitmatch.hexdump_bitstring stdout bits ;; still need to be a runtime check to enforce the size). + {2 Named patterns and persistent patterns} + + Please see {!Bitmatch_persistent} for documentation on this subject. + {2 Compiling} Using the compiler directly you can do: diff --git a/bitmatch_config.ml.in b/bitmatch_config.ml.in index e38dc31..09fda2e 100644 --- a/bitmatch_config.ml.in +++ b/bitmatch_config.ml.in @@ -28,3 +28,4 @@ let nativeendian = Bitmatch_types.@NATIVEENDIAN@ let package = "@PACKAGE_NAME@" let version = "@PACKAGE_VERSION@" +let ocamllibdir = "@OCAMLLIB@" diff --git a/bitmatch_objinfo.ml b/bitmatch_objinfo.ml new file mode 100644 index 0000000..863d9bb --- /dev/null +++ b/bitmatch_objinfo.ml @@ -0,0 +1,50 @@ +(* Bitmatch syntax extension. + * Copyright (C) 2008 Red Hat Inc., Richard W.M. Jones + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public + * License as published by the Free Software Foundation; either + * version 2 of the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + * + * $Id$ + *) + +open Printf + +open Bitmatch +module P = Bitmatch_persistent + +let () = + if Array.length Sys.argv <= 1 then + failwith "bitmatch_objinfo filename.bmpp"; + let filename = Sys.argv.(1) in + let chan = open_in filename in + let names = ref [] in + (try + let rec loop () = + let name = P.named_from_channel chan in + names := name :: !names + in + loop () + with End_of_file -> () + ); + close_in chan; + let names = List.rev !names in + List.iter ( + function + | name, P.Pattern patt -> + printf "let bitmatch %s =\n%s\n" + name (P.string_of_pattern patt) + | name, P.Constructor cons -> + printf "let BITSTRING %s =\n%s\n" + name (P.string_of_constructor cons) + ) names diff --git a/bitmatch_persistent.ml b/bitmatch_persistent.ml index 8ad07d9..8a2cbdf 100644 --- a/bitmatch_persistent.ml +++ b/bitmatch_persistent.ml @@ -38,17 +38,29 @@ type 'a field = { signed : bool; (* true if signed, false if unsigned *) t : field_type; (* type *) _loc : Loc.t; (* location in source code *) - printer : 'a -> string; (* turn the field into a string *) + + (* Turn the field into a string. This used to be a function, + * but that would prevent this structure from being marshalled. + * This is unsatisfactory at the moment because it means we + * can't print out the 'a field. + *) + printer : printer_t; } and field_type = Int | String | Bitstring (* field type *) and endian_expr = | ConstantEndian of Bitmatch.endian (* a constant little/big/nativeendian *) | EndianExpr of expr (* an endian expression *) +and printer_t = PattPrinter | ExprPrinter | NoPrinter type pattern = patt field list type constructor = expr field list +type named = string * alt +and alt = + | Pattern of pattern + | Constructor of constructor + (* Work out if an expression is an integer constant. * * Returns [Some i] if so (where i is the integer value), else [None]. @@ -118,31 +130,24 @@ let string_of_field { field = field; flen = flen; let loc_line = Loc.start_line _loc in let loc_char = Loc.start_off _loc - Loc.start_bol _loc in - sprintf "%s : %s : %s, %s, %s @ (%S, %d, %d)" - (printer field) flen t endian signed loc_fname loc_line loc_char + sprintf "[field] : %s : %s, %s, %s @ (%S, %d, %d)" + (*printer field*) flen t endian signed loc_fname loc_line loc_char let string_of_pattern pattern = - "{ " ^ String.concat "; " (List.map string_of_field pattern) ^ " }" + "{ " ^ String.concat ";\n " (List.map string_of_field pattern) ^ " }\n" let string_of_constructor constructor = - "{ " ^ String.concat "; " (List.map string_of_field constructor) ^ " }" + "{ " ^ String.concat ";\n " (List.map string_of_field constructor) ^ " }\n" -let pattern_to_channel chan patt = Marshal.to_channel chan patt [] -let constructor_to_channel chan cons = Marshal.to_channel chan cons [] +let named_to_channel chan n = Marshal.to_channel chan n [] -let pattern_to_string patt = Marshal.to_string patt [] -let constructor_to_string cons = Marshal.to_string cons [] +let named_to_string n = Marshal.to_string n [] -let pattern_to_buffer str ofs len patt = - Marshal.to_buffer str ofs len patt [] -let constructor_to_buffer str ofs len cons = - Marshal.to_buffer str ofs len cons [] +let named_to_buffer str ofs len n = Marshal.to_buffer str ofs len n [] -let pattern_from_channel = Marshal.from_channel -let constructor_from_channel = Marshal.from_channel +let named_from_channel = Marshal.from_channel -let pattern_from_string = Marshal.from_string -let constructor_from_string = Marshal.from_string +let named_from_string = Marshal.from_string let create_pattern_field _loc = { @@ -152,7 +157,7 @@ let create_pattern_field _loc = signed = false; t = Int; _loc = _loc; - printer = patt_printer; + printer = PattPrinter; } let set_lident_patt field id = @@ -188,7 +193,7 @@ let create_constructor_field _loc = signed = false; t = Int; _loc = _loc; - printer = expr_printer; + printer = ExprPrinter; } let set_lident_expr field id = diff --git a/bitmatch_persistent.mli b/bitmatch_persistent.mli index 7e3f37b..13927af 100644 --- a/bitmatch_persistent.mli +++ b/bitmatch_persistent.mli @@ -19,6 +19,10 @@ *) (** + {b Warning:} This documentation is for ADVANCED USERS ONLY. + If you are not an advanced user, you are probably looking + for {{:Bitmatch.html}the Bitmatch documentation}. + {{:#reference}Jump straight to the reference section for documentation on types and functions}. @@ -26,8 +30,8 @@ Bitmatch allows you to name sets of fields and reuse them elsewhere. For example if you frequently need to parse - Pascal-style strings in the form [length byte + string], then you - could name the [{ strlen : 8 : int; str : strlen*8 : string}] + Pascal-style strings in the form length byte + string, then you + could name the [{ strlen : 8 : int; str : strlen*8 : string }] pattern and reuse it everywhere by name. These are called {b persistent patterns}. @@ -35,16 +39,16 @@ The basic usage is: {v -(* Create a persistent pattern called 'pascal' which +(* Create a persistent pattern called 'pascal_string' which * matches Pascal-style strings (length byte + string). *) -bitmatch pascal = - { strlen : 8 : int; +let bitmatch pascal_string = + \{ strlen : 8 : int; str : strlen*8 : string } let is_pascal_string bits = bitmatch bits with - | { pascal } -> + | \{ :pascal_string } -> printf "matches a Pascal string %s, len %d bytes\n" str strlen v} @@ -82,43 +86,191 @@ v} patterns (not unless your program runs [ocamlc] to make a [*.cmo] file then dynamically links to the [*.cmo] file). + {2 Named patterns} + + A named pattern is a way to name a pattern and use it later + in the same source file. To name a pattern, use: + + [let bitmatch name = { fields ... } ;;] + + and you can then use the name later on inside another pattern, + by prefixing the name with a colon. + For example: + + [bitmatch bits with { :name } -> ...] + + You can use named patterns within named patterns. + + Currently the use of named patterns is somewhat limited. + The restrictions are: + + Named patterns can only be used within the same source file, and + the names occupy a completely separate namespace from anything + else in the source file. + + The [let bitmatch] syntax only works at the top level. We may + add a [let bitmatch ... in] for inner levels later. + + Because you cannot rename the bound identifiers in named + patterns, you can effectively only use them once in a + pattern. For example, [{ :name; :name }] is legal, but + any bindings in the first name would be overridden by + the second name. + + There are no "named constructors" yet, but the machinery + is in place to do this, and we may add them later. + + {2 Persistent patterns in files} + More useful than just naming patterns, you can load + persistent patterns from external files. The patterns + in these external files can come from a variety of sources: + for example, in the [cil-tools] subdirectory are some + {{:http://cil.sf.net/}Cil-based} tools for importing C + structures from header files. You can also generate + your own files or write your own tools, as described below. + To use the persistent pattern(s) from a file do: + [open bitmatch "filename.bmpp" ;;] + A list of zero or more {!named} patterns are read from the file + and each is bound to a name (as contained in the file), + and then the patterns can be used with the usual [:name] + syntax described above. + {3 Extension} + The standard extension is [.bmpp]. This is just a convention + and you can use any extension you want. + {3 Directory search order} + If the filename is an absolute or explicit path, then we try to + load it from that path and stop if it fails. See the [Filename] + module in the standard OCaml library for the definitions of + "absolute path" and "explicit path". Otherwise we use the + following directory search order: + + - Relative to the current directory + - Relative to the OCaml library directory + + {3 bitmatch-objinfo} + + The [bitmatch-objinfo] command can be run on a file in order + to print out the patterns in the file. + + {3 Constructors} + + We haven't implemented persistent constructors yet, although + the machinery is in place to make this happen. Any constructors + found in the file are ignored. + + {2 Creating your own persistent patterns} + + If you want to write a tool to import bitstrings from an + exotic location or markup language, you will need + to use the functions found in the {{:#reference}reference section}. + + I will describe using an example here of how you would + programmatically create a persistent pattern which + matches Pascal-style "length byte + data" strings. + Firstly note that there are two fields, so our pattern + will be a list of length 2 and type {!pattern}. + + You will need to create a camlp4 location object ([Loc.t]) + describing the source file. This source file is used + to generate useful error messages for the user, so + you may want to set it to be the name and location in + the file that your tool reads for input. By convention, + locations are bound to name [_loc]: + +{v + let _loc = Loc.move_line 42 (Loc.mk "input.xml") +v} + + Create a pattern field representing a length field which is 8 bits wide, + bound to the identifier [len]: + +{v + let len_field = create_pattern_field _loc + let len_field = set_length_int len_field 8 + let len_field = set_lident_patt len_field "len" +v} + + Create a pattern field representing a string of [len*8] bits. + Note that the use of [<:expr< >>] quotation requires + you to preprocess your source with [camlp4of] + (see {{:http://brion.inria.fr/gallium/index.php/Reflective_OCaml}this + page on Reflective OCaml}). + +{v + let str_field = create_pattern_field _loc + let str_field = set_length str_field <:expr< len*8 >> + let str_field = set_lident_patt str_field "str" + let str_field = set_type_string str_field +v} + + Join the two fields together and name it: + +{v + let named_pattern = "pascal_string", Pattern [len_field; str_field] +v} + + Save it to a file: + +{v + let chan = open_out "output.bmpp" in + named_to_channel chan named_pattern; + close_out chan +v} + + You can now use this pattern in another program like this: + +{v + open bitmatch "output.bmpp" ;; + let parse_pascal_string bits = + bitmatch bits with + | \{ :pascal_string } -> str, len + | \{ _ } -> invalid_arg "not a Pascal string" +v} {2:reference Reference} - {3 Internal} + {3 Types} *) type patt = Camlp4.PreCast.Syntax.Ast.patt type expr = Camlp4.PreCast.Syntax.Ast.expr type loc_t = Camlp4.PreCast.Syntax.Ast.Loc.t - -(** {3 Types} *) +(** Just short names for the camlp4 types. *) type 'a field (** A field in a persistent pattern or persistent constructor. *) type pattern = patt field list -(** A persistent pattern (used in [bitmatch] operator), is just a list - of pattern fields. *) +(** A persistent pattern (used in [bitmatch] operator), is just a + list of pattern fields. *) type constructor = expr field list (** A persistent constructor (used in [BITSTRING] operator), is just a list of constructor fields. *) +type named = string * alt +and alt = + | Pattern of pattern (** Pattern *) + | Constructor of constructor (** Constructor *) +(** A named pattern or constructor. + + The name is used when binding a pattern from a file, but + is otherwise ignored. *) + (** {3 Printers} *) val string_of_pattern : pattern -> string val string_of_constructor : constructor -> string val string_of_field : 'a field -> string -(** Convert patterns, constructors, or individual fields +(** Convert patterns, constructors or individual fields into printable strings for debugging purposes. The strings look similar to the syntax used by bitmatch, but @@ -126,28 +278,23 @@ val string_of_field : 'a field -> string (** {3 Persistence} *) -val pattern_to_channel : out_channel -> pattern -> unit -val constructor_to_channel : out_channel -> constructor -> unit +val named_to_channel : out_channel -> named -> unit (** Save a pattern/constructor to an output channel. *) -val pattern_to_string : pattern -> string -val constructor_to_string : constructor -> string +val named_to_string : named -> string (** Serialize a pattern/constructor to a string. *) -val pattern_to_buffer : string -> int -> int -> pattern -> int -val constructor_to_buffer : string -> int -> int -> constructor -> int +val named_to_buffer : string -> int -> int -> named -> int (** Serialize a pattern/constructor to part of a string, return the length. *) -val pattern_from_channel : in_channel -> pattern -val constructor_from_channel : in_channel -> constructor +val named_from_channel : in_channel -> named (** Load a pattern/constructor from an output channel. Note: This is not type safe. The pattern/constructor must have been written out under the same version of OCaml and the same version of bitmatch. *) -val pattern_from_string : string -> int -> pattern -val constructor_from_string : string -> int -> constructor +val named_from_string : string -> int -> named (** Load a pattern/constructor from a string at offset within the string. Note: This is not type safe. The pattern/constructor must diff --git a/cil-tools/Makefile.in b/cil-tools/Makefile.in index 4acf391..a72952b 100644 --- a/cil-tools/Makefile.in +++ b/cil-tools/Makefile.in @@ -15,7 +15,7 @@ # License along with this library; if not, write to the Free Software # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA # -# $Id: Makefile.in 81 2008-05-21 09:59:21Z richard.wm.jones $ +# $Id$ PACKAGE = @PACKAGE_NAME@ VERSION = @PACKAGE_VERSION@ @@ -27,10 +27,10 @@ INSTALL = @INSTALL@ OCAMLCFLAGS = -g OCAMLCPACKAGES = -package unix,str,extlib,cil -I .. -OCAMLCLIBS = $(OCAMLCPACKAGES) -linkpkg ../bitmatch.cma +OCAMLCLIBS = $(OCAMLCPACKAGES) -linkpkg ../bitmatch.cma ../bitmatch_persistent.cma OCAMLOPTFLAGS = OCAMLOPTPACKAGES = $(OCAMLCPACKAGES) -OCAMLOPTLIBS = $(OCAMLOPTPACKAGES) -linkpkg ../bitmatch.cmxa +OCAMLOPTLIBS = $(OCAMLOPTPACKAGES) -linkpkg ../bitmatch.cmxa ../bitmatch_persistent.cmxa OCAMLDOCFLAGS = -html -sort diff --git a/create_test_pattern.ml b/create_test_pattern.ml new file mode 100644 index 0000000..ca90d98 --- /dev/null +++ b/create_test_pattern.ml @@ -0,0 +1,27 @@ +(* Create persistent pattern + * $Id$ + *) + +open Bitmatch_persistent + +open Camlp4.PreCast +open Syntax +open Ast + +let () = + let _loc = Loc.ghost in + + let len_field = create_pattern_field _loc in + let len_field = set_length_int len_field 8 in + let len_field = set_lident_patt len_field "len" in + + let str_field = create_pattern_field _loc in + let str_field = set_length str_field <:expr< len*8 >> in + let str_field = set_lident_patt str_field "str" in + let str_field = set_type_string str_field in + + let named_pattern = "pascal_string", Pattern [len_field; str_field] in + + let chan = open_out Sys.argv.(1) in + named_to_channel chan named_pattern; + close_out chan diff --git a/pa_bitmatch.ml b/pa_bitmatch.ml index 82818f6..9ea15c3 100644 --- a/pa_bitmatch.ml +++ b/pa_bitmatch.ml @@ -35,6 +35,9 @@ module P = Bitmatch_persistent *) let debug = false +(* Hashtable storing named persistent patterns. *) +let pattern_hash : (string, P.pattern) Hashtbl.t = Hashtbl.create 13 + (* Work out if an expression is an integer constant. * * Returns [Some i] if so (where i is the integer value), else [None]. @@ -798,8 +801,51 @@ let output_bitmatch _loc bs cases = $int:loc_line$, $int:loc_char$)) >> +(* Add a named pattern. *) +let add_named_pattern _loc name pattern = + Hashtbl.add pattern_hash name pattern + +(* Expand a named pattern from the pattern_hash. *) +let expand_named_pattern _loc name = + try Hashtbl.find pattern_hash name + with Not_found -> + Loc.raise _loc (Failure (sprintf "named pattern not found: %s" name)) + +(* Add named patterns from a file. See the documentation on the + * directory search path in bitmatch_persistent.mli + *) +let load_patterns_from_file _loc filename = + let chan = + if Filename.is_relative filename && Filename.is_implicit filename then ( + (* Try current directory. *) + try open_in filename + with _ -> + (* Try OCaml library directory. *) + try open_in (Filename.concat Bitmatch_config.ocamllibdir filename) + with exn -> Loc.raise _loc exn + ) else ( + try open_in filename + with exn -> Loc.raise _loc exn + ) in + let names = ref [] in + (try + let rec loop () = + let name = P.named_from_channel chan in + names := name :: !names + in + loop () + with End_of_file -> () + ); + close_in chan; + let names = List.rev !names in + List.iter ( + function + | name, P.Pattern patt -> add_named_pattern _loc name patt + | _, P.Constructor _ -> () (* just ignore these for now *) + ) names + EXTEND Gram - GLOBAL: expr; + GLOBAL: expr str_item; (* Qualifiers are a list of identifiers ("string", "bigendian", etc.) * followed by an optional expression (used in certain cases). Note @@ -812,22 +858,33 @@ EXTEND Gram SEP "," ] ]; - (* Field used in the bitmatch operator (a pattern). *) + (* Field used in the bitmatch operator (a pattern). This can actually + * return multiple fields, in the case where the 'field' is a named + * persitent pattern. + *) patt_field: [ [ fpatt = patt; ":"; len = expr LEVEL "top"; qs = OPT [ ":"; qs = qualifiers -> qs ] -> let field = P.create_pattern_field _loc in let field = P.set_patt field fpatt in let field = P.set_length field len in - parse_field _loc field qs + [parse_field _loc field qs] (* Normal, single field. *) + | ":"; name = LIDENT -> + expand_named_pattern _loc name (* Named -> list of fields. *) ] ]; (* Case inside bitmatch operator. *) - match_case: [ + patt_fields: [ [ "{"; fields = LIST0 patt_field SEP ";"; - "}"; + "}" -> + List.concat fields + ] + ]; + + patt_case: [ + [ fields = patt_fields; bind = OPT [ "as"; name = LIDENT -> name ]; whenclause = OPT [ "when"; e = expr -> e ]; "->"; code = expr -> @@ -846,20 +903,46 @@ EXTEND Gram ] ]; + constr_fields: [ + [ "{"; + fields = LIST0 constr_field SEP ";"; + "}" -> + fields + ] + ]; + (* 'bitmatch' expressions. *) expr: LEVEL ";" [ [ "bitmatch"; bs = expr; "with"; OPT "|"; - cases = LIST1 match_case SEP "|" -> + cases = LIST1 patt_case SEP "|" -> output_bitmatch _loc bs cases ] (* Constructor. *) - | [ "BITSTRING"; "{"; - fields = LIST0 constr_field SEP ";"; - "}" -> + | [ "BITSTRING"; + fields = constr_fields -> output_constructor _loc fields ] ]; + (* Named persistent patterns. + * + * NB: Currently only allowed at the top level. We can probably lift + * this restriction later if necessary. We only deal with patterns + * at the moment, not constructors, but the infrastructure to do + * constructors is in place. + *) + str_item: LEVEL "top" [ + [ "let"; "bitmatch"; + name = LIDENT; "="; fields = patt_fields -> + add_named_pattern _loc name fields; + (* The statement disappears, but we still need a str_item so ... *) + <:str_item< >> + | "open"; "bitmatch"; filename = STRING -> + load_patterns_from_file _loc filename; + <:str_item< >> + ] + ]; + END diff --git a/tests/50_named_pattern.ml b/tests/50_named_pattern.ml new file mode 100644 index 0000000..6feee33 --- /dev/null +++ b/tests/50_named_pattern.ml @@ -0,0 +1,20 @@ +(* Named pattern + * $Id$ + *) + +open Printf +open Bitmatch + +(* A byte+length Pascal string. *) +let bitmatch pascal_string = + { len : 8; + str : len*8 : string } + +let () = + let bits = bitstring_of_string "\022Mary had a little lamb" in + bitmatch bits with + | { :pascal_string } -> + () (*printf "it's a Pascal string, len = %d, string = %S\n" len str*) + | { _ } -> + eprintf "not matching error\n"; + exit 1 diff --git a/tests/51_open_pattern.ml b/tests/51_open_pattern.ml new file mode 100644 index 0000000..3e05005 --- /dev/null +++ b/tests/51_open_pattern.ml @@ -0,0 +1,17 @@ +(* Open a persistent pattern + * $Id$ + *) + +open Printf +open Bitmatch + +open bitmatch "tests/test.bmpp" + +let () = + let bits = bitstring_of_string "\022Mary had a little lamb" in + bitmatch bits with + | { :pascal_string } -> + () (*printf "it's a Pascal string, len = %d, string = %S\n" len str*) + | { _ } -> + eprintf "not matching error\n"; + exit 1 -- 1.8.3.1