* 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.
+ * version 2 of the License, or (at your option) any later version,
+ * with the OCaml linking exception described in COPYING.LIB.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
signed : bool; (* true if signed, false if unsigned *)
t : field_type; (* type *)
_loc : Loc.t; (* location in source code *)
-
- (* 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;
+ offset : expr option; (* offset expression *)
+ check : expr option; (* check expression [patterns only] *)
+ bind : expr option; (* bind expression [patterns only] *)
+ save_offset_to : patt option; (* save_offset_to [patterns only] *)
}
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
| <:expr< $int:i$ >> -> i
| _ -> "[expression]"
-let string_of_field { field = field; flen = flen;
- endian = endian; signed = signed; t = t;
- _loc = _loc;
- printer = printer} =
+let _string_of_field { flen = flen;
+ endian = endian; signed = signed; t = t;
+ _loc = _loc;
+ offset = offset; check = check; bind = bind;
+ save_offset_to = save_offset_to } =
let flen =
match expr_is_constant flen with
| Some i -> string_of_int i
let endian =
match endian with
| ConstantEndian endian -> Bitmatch.string_of_endian endian
- | EndianExpr _ -> "endian [expr]" in
+ | EndianExpr _ -> "endian([expr])" in
let signed = if signed then "signed" else "unsigned" in
let t = string_of_field_type t in
+
+ let offset =
+ match offset with
+ | None -> ""
+ | Some expr ->
+ match expr_is_constant expr with
+ | Some i -> sprintf ", offset(%d)" i
+ | None -> sprintf ", offset([expr])" in
+
+ let check =
+ match check with
+ | None -> ""
+ | Some expr -> sprintf ", check([expr])" in
+
+ let bind =
+ match bind with
+ | None -> ""
+ | Some expr -> sprintf ", bind([expr])" in
+
+ let save_offset_to =
+ match save_offset_to with
+ | None -> ""
+ | Some patt ->
+ match patt with
+ | <:patt< $lid:id$ >> -> sprintf ", save_offset_to(%s)" id
+ | _ -> sprintf ", save_offset_to([patt])" in
+
let loc_fname = Loc.file_name _loc in
let loc_line = Loc.start_line _loc in
let loc_char = Loc.start_off _loc - Loc.start_bol _loc in
- sprintf "[field] : %s : %s, %s, %s @ (%S, %d, %d)"
- (*printer field*) flen t endian signed loc_fname loc_line loc_char
+ sprintf "%s : %s, %s, %s%s%s%s%s (* %S:%d %d *)"
+ flen t endian signed offset check bind save_offset_to
+ loc_fname loc_line loc_char
+
+let rec string_of_pattern_field ({ field = patt } as field) =
+ sprintf "%s : %s" (patt_printer patt) (_string_of_field field)
+
+and string_of_constructor_field ({ field = expr } as field) =
+ sprintf "%s : %s" (expr_printer expr) (_string_of_field field)
let string_of_pattern pattern =
- "{ " ^ String.concat ";\n " (List.map string_of_field pattern) ^ " }\n"
+ "{ " ^
+ String.concat ";\n " (List.map string_of_pattern_field pattern) ^
+ " }\n"
let string_of_constructor constructor =
- "{ " ^ String.concat ";\n " (List.map string_of_field constructor) ^ " }\n"
+ "{ " ^
+ String.concat ";\n " (List.map string_of_constructor_field constructor) ^
+ " }\n"
let named_to_channel chan n = Marshal.to_channel chan n []
signed = false;
t = Int;
_loc = _loc;
- printer = PattPrinter;
+ offset = None;
+ check = None;
+ bind = None;
+ save_offset_to = None;
}
let set_lident_patt field id =
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 set_check field expr = { field with check = Some expr }
+let set_no_check field = { field with check = None }
+let set_bind field expr = { field with bind = Some expr }
+let set_no_bind field = { field with bind = None }
+let set_save_offset_to field patt = { field with save_offset_to = Some patt }
+let set_save_offset_to_lident field id =
+ let _loc = field._loc in
+ { field with save_offset_to = Some <:patt< $lid:id$ >> }
+let set_no_save_offset_to field = { field with save_offset_to = None }
let create_constructor_field _loc =
{
signed = false;
t = Int;
_loc = _loc;
- printer = ExprPrinter;
+ offset = None;
+ check = None;
+ bind = None;
+ save_offset_to = None;
}
let set_lident_expr field id =
let get_signed field = field.signed
let get_type field = field.t
let get_location field = field._loc
+let get_offset field = field.offset
+let get_check field = field.check
+let get_bind field = field.bind
+let get_save_offset_to field = field.save_offset_to
git.annexia.org / ocaml-bitstring.git / blobdiff