Enforce a structure invariant in [Tpat_value p] patterns

pat_attributes and pat_extra nodes should be on the inner value
pattern, rather than on the outer computation pattern, so that a user
looking for a specific value-pattern constructor with a specific
attribute does not need to consider the Tpat_value case specifically.

(Thanks to Alain Frisch for this suggestion.)
master
Gabriel Scherer 2019-10-30 06:48:50 +01:00
parent 312253ce82
commit dec6513105
4 changed files with 28 additions and 4 deletions

View File

@ -133,7 +133,7 @@ let rec push_defaults loc bindings cases partial =
let exp =
let cases =
let pure_case ({c_lhs; _} as case) =
{case with c_lhs = {c_lhs with pat_desc = Tpat_value c_lhs}} in
{case with c_lhs = as_computation_pattern c_lhs} in
List.map pure_case cases in
{ exp with exp_loc = loc; exp_env = env; exp_desc =
Texp_match

View File

@ -1181,7 +1181,7 @@ let pure
= fun category pat ->
match category with
| Value -> pat
| Computation -> { pat with pat_desc = Tpat_value pat }
| Computation -> as_computation_pattern pat
let only_impure
: type k . k pattern_category ->
@ -1199,7 +1199,7 @@ let as_comp_pattern
k general_pattern -> computation general_pattern
= fun category pat ->
match category with
| Value -> { pat with pat_desc = Tpat_value pat }
| Value -> as_computation_pattern pat
| Computation -> pat
(* type_pat propagates the expected type as well as maps for

View File

@ -613,6 +613,16 @@ and 'a class_infos =
(* Auxiliary functions over the a.s.t. *)
let as_computation_pattern (p : pattern) : computation general_pattern =
{
pat_desc = Tpat_value p;
pat_loc = p.pat_loc;
pat_extra = [];
pat_type = p.pat_type;
pat_env = p.pat_env;
pat_attributes = [];
}
let rec classify_pattern_desc : type k . k pattern_desc -> k pattern_category =
function
| Tpat_alias _ -> Value

View File

@ -120,7 +120,15 @@ and 'k pattern_desc =
| Tpat_value : value general_pattern -> computation pattern_desc
(** P
Invariant: TODO
Invariant: Tpat_value pattern should not carry
pat_attributes or pat_extra metadata coming from user
syntax, which must be on the inner pattern node -- to
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.
*)
| Tpat_exception : value general_pattern -> computation pattern_desc
(** exception P *)
@ -743,6 +751,12 @@ and 'a class_infos =
(* Auxiliary functions over the a.s.t. *)
(** [as_computation_pattern p] is a computation pattern with description
[Tpat_value p], which enforces a correct placement of pat_attributes
and pat_extra metadata (on the inner value pattern, rather than on
the computation pattern). *)
val as_computation_pattern: pattern -> computation general_pattern
val classify_pattern_desc: 'k pattern_desc -> 'k pattern_category
val classify_pattern: 'k general_pattern -> 'k pattern_category