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.)

typing/printpat.ml

@@ -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 _ ->

typing/printtyped.ml

@@ -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;

typing/rec_check.ml

@@ -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

typing/tast_iterator.ml

@@ -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;

typing/tast_mapper.ml

@@ -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) ->

typing/typedtree.ml

@@ -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;

typing/typedtree.mli

@@ -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;

typing/untypeast.ml

@@ -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