typedtree: make the Tpat_value argument a private synonym
This prevents users from mistakenly constructing a Tpat_value pattern using the natural implementation { pat with pat_desc = Tpat_value pat } which breaks the attributes-placement invariant (the attributes are duplicated with this version, instead of being placed only on the value pattern, with empty attributes on the computation pattern). (Suggestion from Jacques Garrigue.)master
parent
dec6513105
commit
8b59222d01
|
@ -95,7 +95,7 @@ let rec pretty_val : type k . _ -> k general_pattern -> _ = fun ppf v ->
|
|||
| Tpat_alias (v, x,_) ->
|
||||
fprintf ppf "@[(%a@ as %a)@]" pretty_val v Ident.print x
|
||||
| Tpat_value v ->
|
||||
fprintf ppf "%a" pretty_val v
|
||||
fprintf ppf "%a" pretty_val (v :> pattern)
|
||||
| Tpat_exception v ->
|
||||
fprintf ppf "@[<2>exception@ %a@]" pretty_arg v
|
||||
| Tpat_or _ ->
|
||||
|
|
|
@ -261,7 +261,7 @@ and pattern : type k . _ -> _ -> k general_pattern -> unit = fun i ppf x ->
|
|||
pattern i ppf p;
|
||||
| Tpat_value p ->
|
||||
line i ppf "Tpat_value\n";
|
||||
pattern i ppf p;
|
||||
pattern i ppf (p :> pattern);
|
||||
| Tpat_or (p1, p2, _) ->
|
||||
line i ppf "Tpat_or\n";
|
||||
pattern i ppf p1;
|
||||
|
|
|
@ -1197,7 +1197,7 @@ and is_destructuring_pattern : type k . k general_pattern -> bool =
|
|||
| Tpat_record (_, _) -> true
|
||||
| Tpat_array _ -> true
|
||||
| Tpat_lazy _ -> true
|
||||
| Tpat_value pat -> is_destructuring_pattern pat
|
||||
| Tpat_value pat -> is_destructuring_pattern (pat :> pattern)
|
||||
| Tpat_exception _ -> false
|
||||
| Tpat_or (l,r,_) ->
|
||||
is_destructuring_pattern l || is_destructuring_pattern r
|
||||
|
|
|
@ -170,7 +170,7 @@ let pat
|
|||
| Tpat_array l -> List.iter (sub.pat sub) l
|
||||
| Tpat_alias (p, _, _) -> sub.pat sub p
|
||||
| Tpat_lazy p -> sub.pat sub p
|
||||
| Tpat_value p
|
||||
| Tpat_value p -> sub.pat sub (p :> pattern)
|
||||
| Tpat_exception p -> sub.pat sub p
|
||||
| Tpat_or (p1, p2, _) ->
|
||||
sub.pat sub p1;
|
||||
|
|
|
@ -221,7 +221,7 @@ let pat
|
|||
| Tpat_alias (p, id, s) -> Tpat_alias (sub.pat sub p, id, s)
|
||||
| Tpat_lazy p -> Tpat_lazy (sub.pat sub p)
|
||||
| Tpat_value p ->
|
||||
Tpat_value (sub.pat sub p)
|
||||
(as_computation_pattern (sub.pat sub (p :> pattern))).pat_desc
|
||||
| Tpat_exception p ->
|
||||
Tpat_exception (sub.pat sub p)
|
||||
| Tpat_or (p1, p2, rd) ->
|
||||
|
|
|
@ -71,13 +71,15 @@ and 'k pattern_desc =
|
|||
| Tpat_array : value general_pattern list -> value pattern_desc
|
||||
| Tpat_lazy : value general_pattern -> value pattern_desc
|
||||
(* computation patterns *)
|
||||
| Tpat_value : value general_pattern -> computation pattern_desc
|
||||
| Tpat_value : tpat_value_argument -> computation pattern_desc
|
||||
| Tpat_exception : value general_pattern -> computation pattern_desc
|
||||
(* generic constructions *)
|
||||
| Tpat_or :
|
||||
'k general_pattern * 'k general_pattern * row_desc option ->
|
||||
'k pattern_desc
|
||||
|
||||
and tpat_value_argument = value general_pattern
|
||||
|
||||
and expression =
|
||||
{ exp_desc: expression_desc;
|
||||
exp_loc: Location.t;
|
||||
|
|
|
@ -117,7 +117,7 @@ and 'k pattern_desc =
|
|||
| Tpat_lazy : value general_pattern -> value pattern_desc
|
||||
(** lazy P *)
|
||||
(* computation patterns *)
|
||||
| Tpat_value : value general_pattern -> computation pattern_desc
|
||||
| Tpat_value : tpat_value_argument -> computation pattern_desc
|
||||
(** P
|
||||
|
||||
Invariant: Tpat_value pattern should not carry
|
||||
|
@ -126,9 +126,10 @@ and 'k pattern_desc =
|
|||
facilitate searching for a certain value pattern
|
||||
constructor with a specific attributed.
|
||||
|
||||
To enforce this restriction it suffices to use the
|
||||
[as_computation_pattern] function below instead of the
|
||||
[Tpat_value] constructor directly.
|
||||
To enforce this restriction, we made the argument of
|
||||
the Tpat_value constructor a private synonym of [pattern],
|
||||
requiring you to use the [as_computation_pattern] function
|
||||
below instead of using the [Tpat_value] constructor directly.
|
||||
*)
|
||||
| Tpat_exception : value general_pattern -> computation pattern_desc
|
||||
(** exception P *)
|
||||
|
@ -142,6 +143,8 @@ and 'k pattern_desc =
|
|||
[None] otherwise.
|
||||
*)
|
||||
|
||||
and tpat_value_argument = private value general_pattern
|
||||
|
||||
and expression =
|
||||
{ exp_desc: expression_desc;
|
||||
exp_loc: Location.t;
|
||||
|
|
|
@ -349,7 +349,7 @@ let pattern : type k . _ -> k T.general_pattern -> _ = fun sub pat ->
|
|||
| Tpat_lazy p -> Ppat_lazy (sub.pat sub p)
|
||||
|
||||
| Tpat_exception p -> Ppat_exception (sub.pat sub p)
|
||||
| Tpat_value p -> (sub.pat sub p).ppat_desc
|
||||
| Tpat_value p -> (sub.pat sub (p :> pattern)).ppat_desc
|
||||
| Tpat_or (p1, p2, _) -> Ppat_or (sub.pat sub p1, sub.pat sub p2)
|
||||
in
|
||||
Pat.mk ~loc ~attrs desc
|
||||
|
|
Loading…
Reference in New Issue