X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=bitmatch_persistent.ml;h=41ea0c93a01a4412581ea1cc08cbbb7fcf8d142d;hb=4f8971025e9431049a97c260fa586fe64bde22d2;hp=8ad07d98848c5da7ec617c532f79569711cb9aae;hpb=091a76c07b4ddd25c3459b7e6a9fd3e1245a57a7;p=ocaml-bitstring.git

diff --git a/bitmatch_persistent.ml b/bitmatch_persistent.ml
index 8ad07d9..41ea0c9 100644
--- a/bitmatch_persistent.ml
+++ b/bitmatch_persistent.ml
@@ -38,17 +38,30 @@ 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 *)
+  offset : expr option;			(* offset expression *)
+
+  (* 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 +131,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 +158,8 @@ let create_pattern_field _loc =
     signed = false;
     t = Int;
     _loc = _loc;
-    printer = patt_printer;
+    printer = PattPrinter;
+    offset = None;
   }
 
 let set_lident_patt field id =
@@ -179,6 +186,11 @@ let set_type_int field = { field with t = Int }
 let set_type_string field = { field with t = String }
 let set_type_bitstring field = { field with t = Bitstring }
 let set_location field loc = { field with _loc = loc }
+let set_offset_int field i =
+  let _loc = field._loc in
+  { field with offset = Some <:expr< $`int:i$ >> }
+let set_offset field expr = { field with offset = Some expr }
+let set_no_offset field = { field with offset = None }
 
 let create_constructor_field _loc =
   {
@@ -188,7 +200,8 @@ let create_constructor_field _loc =
     signed = false;
     t = Int;
     _loc = _loc;
-    printer = expr_printer;
+    printer = ExprPrinter;
+    offset = None;
   }
 
 let set_lident_expr field id =
@@ -211,3 +224,4 @@ let get_endian field = field.endian
 let get_signed field = field.signed
 let get_type field = field.t
 let get_location field = field._loc
+let get_offset field = field.offset