- Previously check() was called when().
Note that moving the offset backwards, and moving the offset in
[BITSTRING] constructors, are both not supported at present.
- {3 When-qualifiers}
+ {3 Check expressions}
- You can add a [when(expr)] qualifier to bitmatch patterns.
- If the expression evaluates to false then the current match case fails.
+ You can add a [check(expr)] qualifier to bitmatch patterns.
+ If the expression evaluates to false then the current match case
+ fails to match (in other words, we fall through to the next
+ match case - there is no error).
For example:
{[
bitmatch bits with
-| { field : 16 : when (field > 100) } -> ...
+| { field : 16 : check (field > 100) } -> ...
]}
- Note the difference between a when-qualifier and a when-clause
+ Note the difference between a check expression and a when-clause
is that the when-clause is evaluated after all the fields have
- been matched. On the other hand a when-qualifier is evaluated
+ been matched. On the other hand a check expression is evaluated
after the individual field has been matched, which means it is
- potentially more efficient (if the when-qualifier fails then
+ potentially more efficient (if the check expression fails then
we don't waste any time matching later fields).
+ We wanted to use the notation [when(expr)] here, but because
+ [when] is a reserved word we could not do this.
+
{3 Bind expressions}
A bind expression is used to change the value of a matched
(* remaining fields *)
]}
- {3 Order of evaluation of when() and bind()}
+ {3 Order of evaluation of check() and bind()}
- The choice is arbitrary, but we have chosen that when-qualifiers
+ The choice is arbitrary, but we have chosen that check expressions
are evaluated first, and bind expressions are evaluated after.
This means that the result of bind() is {i not} available in
- the when-qualifier.
+ the check expression.
- Note that this rule applies whatever order the when() and bind()
- appear in the source code.
+ Note that this rule applies regardless of the order of check()
+ and bind() in the source code.
{3 save_offset_to}
Use [save_offset_to(variable)] to save the current bit offset
within the match to a variable (strictly speaking, to a pattern).
- This variable is then made available in any [when()] and [bind()]
+ This variable is then made available in any [check()] and [bind()]
clauses in the current field, {i and} to any later fields, and
to the code after the [->].
t : field_type; (* type *)
_loc : Loc.t; (* location in source code *)
offset : expr option; (* offset expression *)
- when_ : expr option; (* when qualifier [patterns only] *)
+ check : expr option; (* check expression [patterns only] *)
bind : expr option; (* bind expression [patterns only] *)
save_offset_to : patt option; (* save_offset_to [patterns only] *)
}
let _string_of_field { flen = flen;
endian = endian; signed = signed; t = t;
_loc = _loc;
- offset = offset; when_ = when_; bind = bind;
+ offset = offset; check = check; bind = bind;
save_offset_to = save_offset_to } =
let flen =
match expr_is_constant flen with
| Some i -> sprintf ", offset(%d)" i
| None -> sprintf ", offset([expr])" in
- let when_ =
- match when_ with
+ let check =
+ match check with
| None -> ""
- | Some expr -> sprintf ", when([expr])" in
+ | Some expr -> sprintf ", check([expr])" in
let bind =
match bind with
let loc_char = Loc.start_off _loc - Loc.start_bol _loc in
sprintf "%s : %s, %s, %s%s%s%s%s (* %S:%d %d *)"
- flen t endian signed offset when_ bind save_offset_to
+ 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) =
t = Int;
_loc = _loc;
offset = None;
- when_ = None;
+ check = None;
bind = None;
save_offset_to = None;
}
{ 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_when field expr = { field with when_ = Some expr }
-let set_no_when field = { field with when_ = 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 }
t = Int;
_loc = _loc;
offset = None;
- when_ = None;
+ check = None;
bind = None;
save_offset_to = None;
}
let get_type field = field.t
let get_location field = field._loc
let get_offset field = field.offset
-let get_when field = field.when_
+let get_check field = field.check
let get_bind field = field.bind
let get_save_offset_to field = field.save_offset_to
follow the previous field, or if it is the first field will
be at offset zero. *)
-val set_when : 'a field -> expr -> 'a field
-(** Set the when-expression for a field to the given expression. *)
+val set_check : 'a field -> expr -> 'a field
+(** Set the check expression for a field to the given expression. *)
-val set_no_when : 'a field -> 'a field
-(** Remove the when-expression from a field. *)
+val set_no_check : 'a field -> 'a field
+(** Remove the check expression from a field. *)
val set_bind : 'a field -> expr -> 'a field
(** Set the bind-expression for a field to the given expression. *)
val get_offset : 'a field -> expr option
(** Get the offset expression of a field, or [None] if there is none. *)
-val get_when : 'a field -> expr option
-(** Get the when expression of a field, or [None] if there is none. *)
+val get_check : 'a field -> expr option
+(** Get the check expression of a field, or [None] if there is none. *)
val get_bind : 'a field -> expr option
(** Get the bind expression of a field, or [None] if there is none. *)
(* Used to keep track of which qualifiers we've seen in parse_field. *)
type whatset_t = {
endian_set : bool; signed_set : bool; type_set : bool;
- offset_set : bool; when_set : bool; bind_set : bool;
+ offset_set : bool; check_set : bool; bind_set : bool;
save_offset_to_set : bool;
}
let noneset = {
endian_set = false; signed_set = false; type_set = false;
- offset_set = false; when_set = false; bind_set = false;
+ offset_set = false; check_set = false; bind_set = false;
save_offset_to_set = false
}
{ whatset with offset_set = true }, field
| "offset", None ->
fail "qualifier 'offset' should be followed by an expression"
- | "when", Some expr ->
- check whatset.when_set "a when-qualifier has been set already";
- let field = P.set_when field expr in
- { whatset with when_set = true }, field
- | "when", None ->
- fail "qualifier 'when' should be followed by an expression"
+ | "check", Some expr ->
+ check whatset.check_set "a check-qualifier has been set already";
+ let field = P.set_check field expr in
+ { whatset with check_set = true }, field
+ | "check", None ->
+ fail "qualifier 'check' should be followed by an expression"
| "bind", Some expr ->
check whatset.bind_set "a bind expression has been set already";
let field = P.set_bind field expr in
let fail = locfail _loc in
- (* offset(), when(), bind(), save_offset_to() not supported in
+ (* offset(), check(), bind(), save_offset_to() not supported in
* constructors.
*
* Implementation of forward-only offsets is fairly
*)
if P.get_offset field <> None then
fail "offset expressions are not supported in BITSTRING constructors";
- if P.get_when field <> None then
- fail "when expressions are not supported in BITSTRING constructors";
+ if P.get_check field <> None then
+ fail "check expressions are not supported in BITSTRING constructors";
if P.get_bind field <> None then
fail "bind expressions are not supported in BITSTRING constructors";
if P.get_save_offset_to field <> None then
*)
let flen_is_const = expr_is_constant flen in
+ (* Surround the inner expression by check and bind clauses, so:
+ * if $check$ then
+ * let $bind...$ in
+ * $inner$
+ * where the check and bind are switched on only if they are
+ * present in the field. (In the common case when neither
+ * clause is present, expr = inner). Note the order of the
+ * check & bind is visible to the user and defined in the
+ * documentation, so it must not change.
+ *)
+ let expr = inner in
+ let expr =
+ match P.get_bind field with
+ | None -> expr
+ | Some bind_expr ->
+ <:expr< let $fpatt$ = $bind_expr$ in $expr$ >> in
+ let expr =
+ match P.get_check field with
+ | None -> expr
+ | Some check_expr ->
+ <:expr< if $check_expr$ then $expr$ >> in
+
+ (* Now build the code which matches a field. *)
let int_extract_const (i, endian, signed) =
build_bitmatch_call _loc "extract" (Some i) endian signed in
let int_extract (endian, signed) =
if $lid:len$ >= $`int:i$ then (
let $lid:v$, $lid:off$, $lid:len$ =
$extract_fn$ $lid:data$ $lid:off$ $lid:len$ $`int:i$ in
- match $lid:v$ with $fpatt$ when true -> $inner$ | _ -> ()
+ match $lid:v$ with $fpatt$ when true -> $expr$ | _ -> ()
)
>>
if $flen$ >= 1 && $flen$ <= 64 && $flen$ <= $lid:len$ then (
let $lid:v$, $lid:off$, $lid:len$ =
$extract_fn$ $lid:data$ $lid:off$ $lid:len$ $flen$ in
- match $lid:v$ with $fpatt$ when true -> $inner$ | _ -> ()
+ match $lid:v$ with $fpatt$ when true -> $expr$ | _ -> ()
)
>>
Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$`int:i$ in
match Bitmatch.string_of_bitstring $lid:bs$ with
- | $fpatt$ when true -> $inner$
+ | $fpatt$ when true -> $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$
+ | $fpatt$ when true -> $expr$
| _ -> ()
>>
Bitmatch.extract_bitstring
$lid:data$ $lid:off$ $lid:len$ $flen$ in
match Bitmatch.string_of_bitstring $lid:bs$ with
- | $fpatt$ when true -> $inner$
+ | $fpatt$ when true -> $expr$
| _ -> ()
)
>>
let $lid:ident$, $lid:off$, $lid:len$ =
Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$`int:i$ in
- $inner$
+ $expr$
)
>>
<:expr<
let $lid:ident$, $lid:off$, $lid:len$ =
Bitmatch.extract_remainder $lid:data$ $lid:off$ $lid:len$ in
- $inner$
+ $expr$
>>
| P.Bitstring, Some _ ->
let $lid:ident$, $lid:off$, $lid:len$ =
Bitmatch.extract_bitstring $lid:data$ $lid:off$ $lid:len$
$flen$ in
- $inner$
+ $expr$
)
>>
in
--- /dev/null
+(* Test check() and bind().
+ * $Id$
+ *)
+
+open Printf
+open Bitmatch
+
+let bits = (BITSTRING { 101 : 16; 202 : 16 })
+
+let () =
+ bitmatch bits with
+ | { i : 16 : check (i > 100), bind (i*4);
+ j : 16 : check (j > 200) } ->
+ if i <> 404 || j <> 202 then
+ failwith (sprintf "70_check_and_bind: failed: %d %d" i j)
+ | { _ } ->
+ failwith "70_check_and_bind: match failed"
git.annexia.org / ocaml-bitstring.git / commitdiff