X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=pa_bitmatch.ml;h=1e3225ca0e56f8affa1e1e6b9eed6065a8088fdb;hb=00f782f26fa89fa07dabb7155707b1415f50572b;hp=b154a318cd1a410c3ed2e873c05e3bc27b495a31;hpb=4853c75eb968f482dc8d9919cb56fc12fec8e3d2;p=ocaml-bitstring.git diff --git a/pa_bitmatch.ml b/pa_bitmatch.ml index b154a31..1e3225c 100644 --- a/pa_bitmatch.ml +++ b/pa_bitmatch.ml @@ -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: pa_bitmatch.ml,v 1.10 2008-04-25 12:55:39 rjones Exp $ + * $Id$ *) open Printf @@ -32,25 +32,54 @@ open Ast *) let debug = false -(* A field when used in a bitmatch (a pattern). *) -type fpatt = { - fpatt : patt; (* field matching pattern *) - fpc : fcommon; -} -(* A field when used in a BITSTRING constructor (an expression). *) -and fexpr = { - fexpr : expr; (* field value *) - fec : fcommon; -} - -and fcommon = { +(* Work out if an expression is an integer constant. + * + * Returns [Some i] if so (where i is the integer value), else [None]. + * + * Fairly simplistic algorithm: we can only detect simple constant + * expressions such as [k], [k+c], [k-c] etc. + *) +let rec expr_is_constant = function + | <:expr< $int:i$ >> -> (* Literal integer constant. *) + Some (int_of_string i) + | <:expr< $a$ + $b$ >> -> (* Addition of constants. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a+b) + | _ -> None) + | <:expr< $a$ - $b$ >> -> (* Subtraction. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a-b) + | _ -> None) + | <:expr< $a$ * $b$ >> -> (* Multiplication. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a*b) + | _ -> None) + | <:expr< $a$ / $b$ >> -> (* Division. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a/b) + | _ -> None) + | <:expr< $a$ lsl $b$ >> -> (* Shift left. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a lsl b) + | _ -> None) + | <:expr< $a$ lsr $b$ >> -> (* Shift right. *) + (match expr_is_constant a, expr_is_constant b with + | Some a, Some b -> Some (a lsr b) + | _ -> None) + | _ -> None (* Anything else is not constant. *) + +(* Field. In bitmatch (patterns) the type is [patt field]. In + * BITSTRING (constructor) the type is [expr field]. + *) +type 'a field = { + field : 'a; (* field ('a is either patt or expr) *) flen : expr; (* length in bits, may be non-const *) - endian : endian; (* endianness *) + endian : Bitmatch.endian; (* endianness *) signed : bool; (* true if signed, false if unsigned *) t : t; (* type *) _loc : Loc.t; (* location in source code *) + printer : 'a -> string; (* turn the field into a string *) } -and endian = BigEndian | LittleEndian | NativeEndian and t = Int | String | Bitstring (* Generate a fresh, unique symbol each time called. *) @@ -60,21 +89,8 @@ let gensym = incr i; let i = !i in sprintf "__pabitmatch_%s_%d" name i -(* Heuristic test if a pattern is exhaustive. *) -let pattern_is_exhaustive = function - | <:patt< $lid:_$ >> -> true - | _ -> false - -let rec parse_patt_field _loc fpatt flen qs = - let fpc = parse_field_common _loc flen qs in - { fpatt = fpatt; fpc = fpc } - -and parse_constr_field _loc fexpr flen qs = - let fec = parse_field_common _loc flen qs in - { fexpr = fexpr; fec = fec } - (* Deal with the qualifiers which appear for a field of both types. *) -and parse_field_common _loc flen qs = +let parse_field _loc field flen qs printer = let endian, signed, t = match qs with | None -> (None, None, None) @@ -86,21 +102,21 @@ and parse_field_common _loc flen qs = if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some BigEndian in + let endian = Some Bitmatch.BigEndian in (endian, signed, t) ) | "littleendian" -> if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some LittleEndian in + let endian = Some Bitmatch.LittleEndian in (endian, signed, t) ) | "nativeendian" -> if endian <> None then Loc.raise _loc (Failure "an endian flag has been set already") else ( - let endian = Some NativeEndian in + let endian = Some Bitmatch.NativeEndian in (endian, signed, t) ) | "signed" -> @@ -152,60 +168,50 @@ and parse_field_common _loc flen qs = ); (* Default endianness, signedness, type. *) - let endian = match endian with None -> BigEndian | Some e -> e in + let endian = match endian with None -> Bitmatch.BigEndian | Some e -> e in let signed = match signed with None -> false | Some s -> s in let t = match t with None -> Int | Some t -> t in { + field = field; flen = flen; endian = endian; signed = signed; t = t; _loc = _loc; + printer = printer; } -let string_of_endian = function - | BigEndian -> "bigendian" - | LittleEndian -> "littleendian" - | NativeEndian -> "nativeendian" - let string_of_t = function | Int -> "int" | String -> "string" | Bitstring -> "bitstring" -let rec string_of_patt_field { fpatt = fpatt; fpc = fpc } = - let fpc = string_of_field_common fpc in - let fpatt = - match fpatt with - | <:patt< $lid:id$ >> -> id - | _ -> "[pattern]" in - fpatt ^ " : " ^ fpc - -and string_of_constr_field { fexpr = fexpr; fec = fec } = - let fec = string_of_field_common fec in - let fexpr = - match fexpr with - | <:expr< $lid:id$ >> -> id - | _ -> "[expression]" in - fexpr ^ " : " ^ fec - -and string_of_field_common { flen = flen; - endian = endian; signed = signed; t = t; - _loc = _loc } = +let patt_printer = function + | <:patt< $lid:id$ >> -> id + | _ -> "[pattern]" + +let expr_printer = function + | <:expr< $lid:id$ >> -> id + | _ -> "[expression]" + +let string_of_field { field = field; flen = flen; + endian = endian; signed = signed; t = t; + _loc = _loc; + printer = printer} = let flen = - match flen with - | <:expr< $int:i$ >> -> i - | _ -> "[non-const-len]" in - let endian = string_of_endian endian in + match expr_is_constant flen with + | Some i -> string_of_int i + | None -> "[non-const-len]" in + let endian = Bitmatch.string_of_endian endian in let signed = if signed then "signed" else "unsigned" in let t = string_of_t t 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 "%s : %s, %s, %s @ (%S, %d, %d)" - flen t endian signed loc_fname loc_line loc_char + sprintf "%s : %s : %s, %s, %s @ (%S, %d, %d)" + (printer field) flen t endian signed loc_fname loc_line loc_char (* Generate the code for a constructor, ie. 'BITSTRING ...'. *) let output_constructor _loc fields = @@ -227,15 +233,12 @@ let output_constructor _loc fields = (* Convert each field to a simple bitstring-generating expression. *) let fields = List.map ( - fun {fexpr=fexpr; fec={flen=flen; endian=endian; signed=signed; - t=t; _loc=_loc}} -> + fun {field=fexpr; flen=flen; endian=endian; signed=signed; + t=t; _loc=_loc} -> (* Is flen an integer constant? If so, what is it? This * is very simple-minded and only detects simple constants. *) - let flen_is_const = - match flen with - | <:expr< $int:i$ >> -> Some (int_of_string i) - | _ -> None in + let flen_is_const = expr_is_constant flen in let name_of_int_construct_const = function (* XXX As an enhancement we should allow a 64-bit-only @@ -248,36 +251,42 @@ let output_constructor _loc fields = | (1, _, _) -> "construct_bit" | ((2|3|4|5|6|7|8), _, false) -> "construct_char_unsigned" | ((2|3|4|5|6|7|8), _, true) -> "construct_char_signed" - | (i, BigEndian, false) when i <= 31 -> "construct_int_be_unsigned" - | (i, BigEndian, true) when i <= 31 -> "construct_int_be_signed" - | (i, LittleEndian, false) when i <= 31 -> "construct_int_le_unsigned" - | (i, LittleEndian, true) when i <= 31 -> "construct_int_le_signed" - | (i, NativeEndian, false) when i <= 31 -> "construct_int_ne_unsigned" - | (i, NativeEndian, true) when i <= 31 -> "construct_int_ne_signed" - | (32, BigEndian, false) -> "construct_int32_be_unsigned" - | (32, BigEndian, true) -> "construct_int32_be_signed" - | (32, LittleEndian, false) -> "construct_int32_le_unsigned" - | (32, LittleEndian, true) -> "construct_int32_le_signed" - | (32, NativeEndian, false) -> "construct_int32_ne_unsigned" - | (32, NativeEndian, true) -> "construct_int32_ne_signed" - | (_, BigEndian, false) -> "construct_int64_be_unsigned" - | (_, BigEndian, true) -> "construct_int64_be_signed" - | (_, LittleEndian, false) -> "construct_int64_le_unsigned" - | (_, LittleEndian, true) -> "construct_int64_le_signed" - | (_, NativeEndian, false) -> "construct_int64_ne_unsigned" - | (_, NativeEndian, true) -> "construct_int64_ne_signed" + | (i, Bitmatch.BigEndian, false) when i <= 31 -> + "construct_int_be_unsigned" + | (i, Bitmatch.BigEndian, true) when i <= 31 -> + "construct_int_be_signed" + | (i, Bitmatch.LittleEndian, false) when i <= 31 -> + "construct_int_le_unsigned" + | (i, Bitmatch.LittleEndian, true) when i <= 31 -> + "construct_int_le_signed" + | (i, Bitmatch.NativeEndian, false) when i <= 31 -> + "construct_int_ne_unsigned" + | (i, Bitmatch.NativeEndian, true) when i <= 31 -> + "construct_int_ne_signed" + | (32, Bitmatch.BigEndian, false) -> "construct_int32_be_unsigned" + | (32, Bitmatch.BigEndian, true) -> "construct_int32_be_signed" + | (32, Bitmatch.LittleEndian, false) -> "construct_int32_le_unsigned" + | (32, Bitmatch.LittleEndian, true) -> "construct_int32_le_signed" + | (32, Bitmatch.NativeEndian, false) -> "construct_int32_ne_unsigned" + | (32, Bitmatch.NativeEndian, true) -> "construct_int32_ne_signed" + | (_, Bitmatch.BigEndian, false) -> "construct_int64_be_unsigned" + | (_, Bitmatch.BigEndian, true) -> "construct_int64_be_signed" + | (_, Bitmatch.LittleEndian, false) -> "construct_int64_le_unsigned" + | (_, Bitmatch.LittleEndian, true) -> "construct_int64_le_signed" + | (_, Bitmatch.NativeEndian, false) -> "construct_int64_ne_unsigned" + | (_, Bitmatch.NativeEndian, true) -> "construct_int64_ne_signed" in let name_of_int_construct = function (* XXX As an enhancement we should allow users to * specify that a field length can fit into a char/int/int32 * (of course, this would have to be checked at runtime). *) - | (BigEndian, false) -> "construct_int64_be_unsigned" - | (BigEndian, true) -> "construct_int64_be_signed" - | (LittleEndian, false) -> "construct_int64_le_unsigned" - | (LittleEndian, true) -> "construct_int64_le_signed" - | (NativeEndian, false) -> "construct_int64_ne_unsigned" - | (NativeEndian, true) -> "construct_int64_ne_signed" + | (Bitmatch.BigEndian, false) -> "construct_int64_be_unsigned" + | (Bitmatch.BigEndian, true) -> "construct_int64_be_signed" + | (Bitmatch.LittleEndian, false) -> "construct_int64_le_unsigned" + | (Bitmatch.LittleEndian, true) -> "construct_int64_le_signed" + | (Bitmatch.NativeEndian, false) -> "construct_int64_ne_unsigned" + | (Bitmatch.NativeEndian, true) -> "construct_int64_ne_signed" in let expr = @@ -487,17 +496,14 @@ let output_bitmatch _loc bs cases = let rec output_field_extraction inner = function | [] -> inner | field :: fields -> - let {fpatt=fpatt; fpc={flen=flen; endian=endian; signed=signed; - t=t; _loc=_loc}} + let {field=fpatt; flen=flen; endian=endian; signed=signed; + t=t; _loc=_loc} = field in (* Is flen an integer constant? If so, what is it? This * is very simple-minded and only detects simple constants. *) - let flen_is_const = - match flen with - | <:expr< $int:i$ >> -> Some (int_of_string i) - | _ -> None in + let flen_is_const = expr_is_constant flen in let name_of_int_extract_const = function (* XXX As an enhancement we should allow a 64-bit-only @@ -510,36 +516,42 @@ let output_bitmatch _loc bs cases = | (1, _, _) -> "extract_bit" | ((2|3|4|5|6|7|8), _, false) -> "extract_char_unsigned" | ((2|3|4|5|6|7|8), _, true) -> "extract_char_signed" - | (i, BigEndian, false) when i <= 31 -> "extract_int_be_unsigned" - | (i, BigEndian, true) when i <= 31 -> "extract_int_be_signed" - | (i, LittleEndian, false) when i <= 31 -> "extract_int_le_unsigned" - | (i, LittleEndian, true) when i <= 31 -> "extract_int_le_signed" - | (i, NativeEndian, false) when i <= 31 -> "extract_int_ne_unsigned" - | (i, NativeEndian, true) when i <= 31 -> "extract_int_ne_signed" - | (32, BigEndian, false) -> "extract_int32_be_unsigned" - | (32, BigEndian, true) -> "extract_int32_be_signed" - | (32, LittleEndian, false) -> "extract_int32_le_unsigned" - | (32, LittleEndian, true) -> "extract_int32_le_signed" - | (32, NativeEndian, false) -> "extract_int32_ne_unsigned" - | (32, NativeEndian, true) -> "extract_int32_ne_signed" - | (_, BigEndian, false) -> "extract_int64_be_unsigned" - | (_, BigEndian, true) -> "extract_int64_be_signed" - | (_, LittleEndian, false) -> "extract_int64_le_unsigned" - | (_, LittleEndian, true) -> "extract_int64_le_signed" - | (_, NativeEndian, false) -> "extract_int64_ne_unsigned" - | (_, NativeEndian, true) -> "extract_int64_ne_signed" + | (i, Bitmatch.BigEndian, false) when i <= 31 -> + "extract_int_be_unsigned" + | (i, Bitmatch.BigEndian, true) when i <= 31 -> + "extract_int_be_signed" + | (i, Bitmatch.LittleEndian, false) when i <= 31 -> + "extract_int_le_unsigned" + | (i, Bitmatch.LittleEndian, true) when i <= 31 -> + "extract_int_le_signed" + | (i, Bitmatch.NativeEndian, false) when i <= 31 -> + "extract_int_ne_unsigned" + | (i, Bitmatch.NativeEndian, true) when i <= 31 -> + "extract_int_ne_signed" + | (32, Bitmatch.BigEndian, false) -> "extract_int32_be_unsigned" + | (32, Bitmatch.BigEndian, true) -> "extract_int32_be_signed" + | (32, Bitmatch.LittleEndian, false) -> "extract_int32_le_unsigned" + | (32, Bitmatch.LittleEndian, true) -> "extract_int32_le_signed" + | (32, Bitmatch.NativeEndian, false) -> "extract_int32_ne_unsigned" + | (32, Bitmatch.NativeEndian, true) -> "extract_int32_ne_signed" + | (_, Bitmatch.BigEndian, false) -> "extract_int64_be_unsigned" + | (_, Bitmatch.BigEndian, true) -> "extract_int64_be_signed" + | (_, Bitmatch.LittleEndian, false) -> "extract_int64_le_unsigned" + | (_, Bitmatch.LittleEndian, true) -> "extract_int64_le_signed" + | (_, Bitmatch.NativeEndian, false) -> "extract_int64_ne_unsigned" + | (_, Bitmatch.NativeEndian, true) -> "extract_int64_ne_signed" in let name_of_int_extract = function (* XXX As an enhancement we should allow users to * specify that a field length can fit into a char/int/int32 * (of course, this would have to be checked at runtime). *) - | (BigEndian, false) -> "extract_int64_be_unsigned" - | (BigEndian, true) -> "extract_int64_be_signed" - | (LittleEndian, false) -> "extract_int64_le_unsigned" - | (LittleEndian, true) -> "extract_int64_le_signed" - | (NativeEndian, false) -> "extract_int64_ne_unsigned" - | (NativeEndian, true) -> "extract_int64_ne_signed" + | (Bitmatch.BigEndian, false) -> "extract_int64_be_unsigned" + | (Bitmatch.BigEndian, true) -> "extract_int64_be_signed" + | (Bitmatch.LittleEndian, false) -> "extract_int64_le_unsigned" + | (Bitmatch.LittleEndian, true) -> "extract_int64_le_signed" + | (Bitmatch.NativeEndian, false) -> "extract_int64_ne_unsigned" + | (Bitmatch.NativeEndian, true) -> "extract_int64_ne_signed" in let expr = @@ -548,24 +560,14 @@ let output_bitmatch _loc bs cases = | Int, Some i when i > 0 && i <= 64 -> let extract_func = name_of_int_extract_const (i,endian,signed) in let v = gensym "val" in - if pattern_is_exhaustive fpatt then - <:expr< - if $lid:len$ >= $flen$ then ( - let $lid:v$, $lid:off$, $lid:len$ = - Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match $lid:v$ with $fpatt$ -> $inner$ - ) - >> - else - <:expr< - if $lid:len$ >= $flen$ then ( - let $lid:v$, $lid:off$, $lid:len$ = - Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match $lid:v$ with $fpatt$ -> $inner$ | _ -> () - ) - >> + <:expr< + if $lid:len$ >= $flen$ then ( + let $lid:v$, $lid:off$, $lid:len$ = + Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ + $flen$ in + match $lid:v$ with $fpatt$ when true -> $inner$ | _ -> () + ) + >> | Int, Some _ -> Loc.raise _loc (Failure "length of int field must be [1..64]") @@ -577,70 +579,41 @@ let output_bitmatch _loc bs cases = | Int, None -> let extract_func = name_of_int_extract (endian,signed) in let v = gensym "val" in - if pattern_is_exhaustive fpatt then - <:expr< - if $flen$ >= 1 && $flen$ <= 64 && $flen$ <= $lid:len$ then ( - let $lid:v$, $lid:off$, $lid:len$ = - Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match $lid:v$ with $fpatt$ -> $inner$ - ) - >> - else - <:expr< - if $flen$ >= 1 && $flen$ <= 64 && $flen$ <= $lid:len$ then ( - let $lid:v$, $lid:off$, $lid:len$ = - Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match $lid:v$ with $fpatt$ -> $inner$ | _ -> () - ) - >> + <:expr< + if $flen$ >= 1 && $flen$ <= 64 && $flen$ <= $lid:len$ then ( + let $lid:v$, $lid:off$, $lid:len$ = + Bitmatch.$lid:extract_func$ $lid:data$ $lid:off$ $lid:len$ + $flen$ in + match $lid:v$ with $fpatt$ when true -> $inner$ | _ -> () + ) + >> (* String, constant flen > 0. *) | String, Some i when i > 0 && i land 7 = 0 -> let bs = gensym "bs" in - if pattern_is_exhaustive fpatt then - <:expr< - if $lid:len$ >= $flen$ then ( - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - ) - >> - else - <:expr< - if $lid:len$ >= $flen$ then ( - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$ - $flen$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - | _ -> () - ) - >> + <:expr< + if $lid:len$ >= $flen$ then ( + let $lid:bs$, $lid:off$, $lid:len$ = + Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$ + $flen$ in + match Bitmatch.string_of_bitstring $lid:bs$ with + | $fpatt$ when true -> $inner$ + | _ -> () + ) + >> (* String, constant flen = -1, means consume all the * rest of the input. *) | String, Some i when i = -1 -> let bs = gensym "bs" in - if pattern_is_exhaustive fpatt then - <:expr< - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_remainder $lid:data$ $lid:off$ $lid:len$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - >> - else - <:expr< - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_remainder $lid:data$ $lid:off$ $lid:len$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - | _ -> () - >> + <:expr< + let $lid:bs$, $lid:off$, $lid:len$ = + Bitmatch.extract_remainder $lid:data$ $lid:off$ $lid:len$ in + match Bitmatch.string_of_bitstring $lid:bs$ with + | $fpatt$ when true -> $inner$ + | _ -> () + >> | String, Some _ -> Loc.raise _loc (Failure "length of string must be > 0 and a multiple of 8, or the special value -1") @@ -650,29 +623,17 @@ let output_bitmatch _loc bs cases = *) | String, None -> let bs = gensym "bs" in - if pattern_is_exhaustive fpatt then - <:expr< - if $flen$ >= 0 && $flen$ <= $lid:len$ - && $flen$ land 7 = 0 then ( - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_bitstring - $lid:data$ $lid:off$ $lid:len$ $flen$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - ) - >> - else - <:expr< - if $flen$ >= 0 && $flen$ <= $lid:len$ - && $flen$ land 7 = 0 then ( - let $lid:bs$, $lid:off$, $lid:len$ = - Bitmatch.extract_bitstring - $lid:data$ $lid:off$ $lid:len$ $flen$ in - match Bitmatch.string_of_bitstring $lid:bs$ with - | $fpatt$ -> $inner$ - | _ -> () - ) - >> + <:expr< + if $flen$ >= 0 && $flen$ <= $lid:len$ + && $flen$ land 7 = 0 then ( + let $lid:bs$, $lid:off$, $lid:len$ = + Bitmatch.extract_bitstring + $lid:data$ $lid:off$ $lid:len$ $flen$ in + match Bitmatch.string_of_bitstring $lid:bs$ with + | $fpatt$ when true -> $inner$ + | _ -> () + ) + >> (* Bitstring, constant flen >= 0. * At the moment all we can do is assign the bitstring to an @@ -702,6 +663,7 @@ let output_bitmatch _loc bs cases = let ident = match fpatt with | <:patt< $lid:ident$ >> -> ident + | <:patt< _ >> -> "_" | _ -> Loc.raise _loc (Failure "cannot compare a bitstring to a constant") in @@ -721,6 +683,7 @@ let output_bitmatch _loc bs cases = let ident = match fpatt with | <:patt< $lid:ident$ >> -> ident + | <:patt< _ >> -> "_" | _ -> Loc.raise _loc (Failure "cannot compare a bitstring to a constant") in @@ -737,7 +700,7 @@ let output_bitmatch _loc bs cases = (* Emit extra debugging code. *) let expr = if not debug then expr else ( - let field = string_of_patt_field field in + let field = string_of_field field in <:expr< if !Bitmatch.debug then ( @@ -822,7 +785,7 @@ EXTEND Gram patt_field: [ [ fpatt = patt; ":"; len = expr LEVEL "top"; qs = OPT [ ":"; qs = qualifiers -> qs ] -> - parse_patt_field _loc fpatt len qs + parse_field _loc fpatt len qs patt_printer ] ]; @@ -842,7 +805,7 @@ EXTEND Gram constr_field: [ [ fexpr = expr LEVEL "top"; ":"; len = expr LEVEL "top"; qs = OPT [ ":"; qs = qualifiers -> qs ] -> - parse_constr_field _loc fexpr len qs + parse_field _loc fexpr len qs expr_printer ] ];