summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference18
-rw-r--r--testsuite/tests/typing-gadts/dynamic_frisch.ml.reference18
-rw-r--r--testsuite/tests/typing-gadts/omega07.ml.principal.reference78
-rw-r--r--testsuite/tests/typing-gadts/omega07.ml.reference78
-rw-r--r--testsuite/tests/typing-gadts/term-conv.ml.principal.reference8
-rw-r--r--testsuite/tests/typing-gadts/term-conv.ml.reference8
-rw-r--r--testsuite/tests/typing-gadts/test.ml.principal.reference20
-rw-r--r--testsuite/tests/typing-gadts/test.ml.reference22
-rw-r--r--testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference2
-rw-r--r--testsuite/tests/typing-gadts/yallop_bugs.ml.reference2
-rw-r--r--typing/oprint.ml6
-rw-r--r--typing/printtyp.ml3
-rw-r--r--typing/typedecl.ml9
13 files changed, 132 insertions, 140 deletions
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
index f9c67023c..72a301c4a 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference
@@ -58,7 +58,7 @@ val my_record : my_record ty =
Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
create_builder = <fun>; of_builder = <fun>}
# type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
Int : (int, 'c) ty
| String : (string, 'd) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,16 +75,16 @@ and ('a, 'e, 'b) ty_sum = {
sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
}
and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
Thd : ('a -> 'b, 'a) ty_sel
| Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
| TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-# type 'a ty_env =
+# type _ ty_env =
Enil : unit ty_env
| Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-# type ('a, 'b) eq = Eq : ('a, 'a) eq
+# type (_, _) eq = Eq : ('a, 'a) eq
val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
val get_case :
('b, 'a) ty_sel ->
@@ -129,7 +129,7 @@ val v : variant =
VSum ("Cons",
Some
(VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-# type ('a, 'b) ty =
+# type (_, _) ty =
Int : (int, 'c) ty
| String : (string, 'd) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
Error: This pattern matches values of type a * a vlist
but a pattern was expected which matches values of type
ex#46 = ex#47 * ex#48
-# type ('a, 'b) ty =
+# type (_, _) ty =
Int : (int, 'd) ty
| String : (string, 'f) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,10 +164,10 @@ Error: This pattern matches values of type a * a vlist
inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
Thd : ('a -> 'b, 'a) ty_sel
| Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
| TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
# val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
diff --git a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
index f9c67023c..72a301c4a 100644
--- a/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
+++ b/testsuite/tests/typing-gadts/dynamic_frisch.ml.reference
@@ -58,7 +58,7 @@ val my_record : my_record ty =
Field {label = "b"; field_type = List String; get = <fun>; set = <fun>}];
create_builder = <fun>; of_builder = <fun>}
# type noarg = Noarg
-type ('a, 'b) ty =
+type (_, _) ty =
Int : (int, 'c) ty
| String : (string, 'd) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -75,16 +75,16 @@ and ('a, 'e, 'b) ty_sum = {
sum_inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
}
and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
Thd : ('a -> 'b, 'a) ty_sel
| Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
| TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
-# type 'a ty_env =
+# type _ ty_env =
Enil : unit ty_env
| Econs : ('a, 'e) ty * 'e ty_env -> ('a -> 'e) ty_env
-# type ('a, 'b) eq = Eq : ('a, 'a) eq
+# type (_, _) eq = Eq : ('a, 'a) eq
val eq_sel : ('a, 'b) ty_sel -> ('a, 'c) ty_sel -> ('b, 'c) eq option = <fun>
val get_case :
('b, 'a) ty_sel ->
@@ -129,7 +129,7 @@ val v : variant =
VSum ("Cons",
Some
(VPair (VInt 1, VSum ("Cons", Some (VPair (VInt 2, VSum ("Nil", None)))))))
-# type ('a, 'b) ty =
+# type (_, _) ty =
Int : (int, 'c) ty
| String : (string, 'd) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -149,7 +149,7 @@ val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum (<fun>, <fun>)
Error: This pattern matches values of type a * a vlist
but a pattern was expected which matches values of type
ex#46 = ex#47 * ex#48
-# type ('a, 'b) ty =
+# type (_, _) ty =
Int : (int, 'd) ty
| String : (string, 'f) ty
| List : ('a, 'e) ty -> ('a list, 'e) ty
@@ -164,10 +164,10 @@ Error: This pattern matches values of type a * a vlist
inj : 'c. ('b, 'c) ty_sel * 'c -> 'a;
proj : 'a -> string * 'e ty_dyn option > -> ('a, 'e) ty
and 'e ty_dyn = Tdyn : ('a, 'e) ty * 'a -> 'e ty_dyn
-and ('a, 'b) ty_sel =
+and (_, _) ty_sel =
Thd : ('a -> 'b, 'a) ty_sel
| Ttl : ('b -> 'c, 'd) ty_sel -> ('a -> 'b -> 'c, 'd) ty_sel
-and ('a, 'b) ty_case =
+and (_, _) ty_case =
TCarg : ('b, 'a) ty_sel * ('a, 'e) ty -> ('e, 'b) ty_case
| TCnoarg : ('b, noarg) ty_sel -> ('e, 'b) ty_case
# val ty_abc : ([ `A of int | `B of string | `C ], 'e) ty = Sum <obj>
diff --git a/testsuite/tests/typing-gadts/omega07.ml.principal.reference b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
index 2565d932b..cf8b0b5bc 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.principal.reference
@@ -1,35 +1,35 @@
# * * * * * type ('a, 'b) sum = Inl of 'a | Inr of 'b
type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-# type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+# type (_, _) seq =
Snil : ('a, zero) seq
| Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
# val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-# * type ('a, 'b, 'c) plus =
+# * type (_, _, _) plus =
PlusZ : 'a nat -> (zero, 'a, 'a) plus
| PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
# val length : ('a, 'n) seq -> 'n nat = <fun>
-# * type ('a, 'b, 'c) app =
+# * type (_, _, _) app =
App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
# * type tp
type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
Tp : tp shape
| Nd : nd shape
| Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
# type tt
type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-# type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+# type (_, _) path =
Pnone : 'a -> (tp, 'a) path
| Phere : (nd, 'a) path
| Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
| Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-# type ('a, 'b) tree =
+# type (_, _) tree =
Ttip : (tp, 'a) tree
| Tnode : 'a -> (nd, 'a) tree
| Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
@@ -38,10 +38,10 @@ type 'a boolean = BT : tt boolean | BF : ff boolean
# val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
<fun>
# val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
-# type ('a, 'b) le =
+# type (_, _) le =
LeZ : 'a nat -> (zero, 'a) le
| LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-# type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+# type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
# type one = zero succ
type two = one succ
type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
val even4 : four even = EvenSS (EvenSS EvenZ)
# val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
# val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-# type ('a, 'b) equal = Eq : ('a, 'a) equal
+# type (_, _) equal = Eq : ('a, 'a) equal
val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
# val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-# type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+# type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
# * * * * * * * * * val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
# Characters 87-243:
..match a, b,le with (* warning *)
@@ -67,14 +67,14 @@ Here is an example of a value that is not matched:
(NS _, NZ, _)
val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
# val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-# type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+# type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
# val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
-# type ('a, 'b, 'c) balance =
+# type (_, _, _) balance =
Less : ('h, 'h succ, 'h succ) balance
| Same : ('h, 'h, 'h) balance
| More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
Leaf : zero avl
| Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
'hR avl -> 'hMax succ avl
@@ -91,14 +91,14 @@ val elem : int -> 'h avl -> bool = <fun>
# val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
# val insert : int -> avl' -> avl' = <fun>
# val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
-type 'a avl_del =
+type _ avl_del =
Dsame : 'n avl -> 'n avl_del
| Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
val del : int -> 'n avl -> 'n avl_del = <fun>
# val delete : int -> avl' -> avl' = <fun>
# type red
type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
Bleaf : (black, zero) sub_tree
| Rnode : (black, 'n) sub_tree * int *
(black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,14 +106,14 @@ type ('a, 'b) sub_tree =
('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
# type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
CNil : (black, 'n) ctxt
| CRed : int * dir * (black, 'n) sub_tree *
(red, 'n) ctxt -> (black, 'n) ctxt
| CBlk : int * dir * ('c1, 'n) sub_tree *
(black, 'n succ) ctxt -> ('c, 'n) ctxt
# val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
+type _ crep = Red : red crep | Black : black crep
val color : ('c, 'n) sub_tree -> 'c crep = <fun>
# val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
# val recolor :
@@ -135,7 +135,7 @@ val color : ('c, 'n) sub_tree -> 'c crep = <fun>
# val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
# val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
# val insert : int -> rb_tree -> rb_tree = <fun>
-# type 'a term =
+# type _ term =
Const : int -> int term
| Add : (int * int -> int) term
| LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
val ex2 : (int * int) term =
Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
Rint : int rep
| Rbool : bool rep
| Rpair : 'a rep * 'b rep -> ('a * 'b) rep
| Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
# type assoc = Assoc : string * 'a rep * 'a -> assoc
val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
Var : string * 'a rep -> 'a term
| Abs : string * 'a rep * 'b term -> ('a -> 'b) term
| Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
Const 3)
val v4 : int = 6
# type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
Rnil : rnil is_row
| Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
Const : int -> ('e, int) lam
| Var : 'a -> (('a, 't, 'e) rcons, 't) lam
| Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,7 +186,7 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
App (Var X, Shift (Var Y))
val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-# type 'a env =
+# type _ env =
Enil : rnil env
| Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
@@ -233,19 +233,17 @@ val ex3 :
App (Shift (Var Suc),
App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
# val v3 : int = 6
-# * type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+# * type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
# type term =
C of int
| Ab : string * 'a rep * term -> term
| Ap of term * term
| V of string
-type 'a ctx =
+type _ ctx =
Cnil : rnil ctx
| Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-# type 'a checked =
- Cerror of string
- | Cok : ('e, 't) lam * 't rep -> 'e checked
+# type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
val lookup : string -> 'e ctx -> 'e checked = <fun>
# val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
# val ctx0 :
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
# val v2 : int = 6
# type pexp
type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
type tint
-type ('a, 'b) rel =
+type (_, _) rel =
IntR : (tint, int) rel
| IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
| Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
| Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -292,12 +290,12 @@ type ('a, 'b, 'c) lam =
# val ex1 : (pexp, 'a, tint) lam =
App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
-# type ('a, 'b) sub =
+# type (_, _) sub =
Id : ('r, 'r) sub
| Bind : 't * ('m, 'r2, 'x) lam *
('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
| Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
# val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
# type closed = rnil
type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
diff --git a/testsuite/tests/typing-gadts/omega07.ml.reference b/testsuite/tests/typing-gadts/omega07.ml.reference
index 2565d932b..cf8b0b5bc 100644
--- a/testsuite/tests/typing-gadts/omega07.ml.reference
+++ b/testsuite/tests/typing-gadts/omega07.ml.reference
@@ -1,35 +1,35 @@
# * * * * * type ('a, 'b) sum = Inl of 'a | Inr of 'b
type zero = Zero
-type 'a succ
-type 'a nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
-# type ('a, 'b) seq =
+type _ succ
+type _ nat = NZ : zero nat | NS : 'a nat -> 'a succ nat
+# type (_, _) seq =
Snil : ('a, zero) seq
| Scons : 'a * ('a, 'n) seq -> ('a, 'n succ) seq
# val l1 : (int, zero succ succ) seq = Scons (3, Scons (5, Snil))
-# * type ('a, 'b, 'c) plus =
+# * type (_, _, _) plus =
PlusZ : 'a nat -> (zero, 'a, 'a) plus
| PlusS : ('a, 'b, 'c) plus -> ('a succ, 'b, 'c succ) plus
# val length : ('a, 'n) seq -> 'n nat = <fun>
-# * type ('a, 'b, 'c) app =
+# * type (_, _, _) app =
App : ('a, 'p) seq * ('n, 'm, 'p) plus -> ('a, 'n, 'm) app
val app : ('a, 'n) seq -> ('a, 'm) seq -> ('a, 'n, 'm) app = <fun>
# * type tp
type nd
-type ('a, 'b) fk
-type 'a shape =
+type (_, _) fk
+type _ shape =
Tp : tp shape
| Nd : nd shape
| Fk : 'a shape * 'b shape -> ('a, 'b) fk shape
# type tt
type ff
-type 'a boolean = BT : tt boolean | BF : ff boolean
-# type ('a, 'b) path =
+type _ boolean = BT : tt boolean | BF : ff boolean
+# type (_, _) path =
Pnone : 'a -> (tp, 'a) path
| Phere : (nd, 'a) path
| Pleft : ('x, 'a) path -> (('x, 'y) fk, 'a) path
| Pright : ('y, 'a) path -> (('x, 'y) fk, 'a) path
-# type ('a, 'b) tree =
+# type (_, _) tree =
Ttip : (tp, 'a) tree
| Tnode : 'a -> (nd, 'a) tree
| Tfork : ('x, 'a) tree * ('y, 'a) tree -> (('x, 'y) fk, 'a) tree
@@ -38,10 +38,10 @@ type 'a boolean = BT : tt boolean | BF : ff boolean
# val find : ('a -> 'a -> bool) -> 'a -> ('sh, 'a) tree -> ('sh, 'a) path list =
<fun>
# val extract : ('sh, 'a) path -> ('sh, 'a) tree -> 'a = <fun>
-# type ('a, 'b) le =
+# type (_, _) le =
LeZ : 'a nat -> (zero, 'a) le
| LeS : ('n, 'm) le -> ('n succ, 'm succ) le
-# type 'a even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
+# type _ even = EvenZ : zero even | EvenSS : 'n even -> 'n succ succ even
# type one = zero succ
type two = one succ
type three = two succ
@@ -51,11 +51,11 @@ val even2 : two even = EvenSS EvenZ
val even4 : four even = EvenSS (EvenSS EvenZ)
# val p1 : (two, one, three) plus = PlusS (PlusS (PlusZ (NS NZ)))
# val summandLessThanSum : ('a, 'b, 'c) plus -> ('a, 'c) le = <fun>
-# type ('a, 'b) equal = Eq : ('a, 'a) equal
+# type (_, _) equal = Eq : ('a, 'a) equal
val convert : ('a, 'b) equal -> 'a -> 'b = <fun>
val sameNat : 'a nat -> 'b nat -> ('a, 'b) equal option = <fun>
# val smaller : ('a succ, 'b succ) le -> ('a, 'b) le = <fun>
-# type ('a, 'b) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
+# type (_, _) diff = Diff : 'c nat * ('a, 'c, 'b) plus -> ('a, 'b) diff
# * * * * * * * * * val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
# Characters 87-243:
..match a, b,le with (* warning *)
@@ -67,14 +67,14 @@ Here is an example of a value that is not matched:
(NS _, NZ, _)
val diff : ('a, 'b) le -> 'a nat -> 'b nat -> ('a, 'b) diff = <fun>
# val diff : ('a, 'b) le -> 'b nat -> ('a, 'b) diff = <fun>
-# type ('a, 'b) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
+# type (_, _) filter = Filter : ('m, 'n) le * ('a, 'm) seq -> ('a, 'n) filter
val leS' : ('m, 'n) le -> ('m, 'n succ) le = <fun>
# val filter : ('a -> bool) -> ('a, 'n) seq -> ('a, 'n) filter = <fun>
-# type ('a, 'b, 'c) balance =
+# type (_, _, _) balance =
Less : ('h, 'h succ, 'h succ) balance
| Same : ('h, 'h, 'h) balance
| More : ('h succ, 'h, 'h succ) balance
-type 'a avl =
+type _ avl =
Leaf : zero avl
| Node : ('hL, 'hR, 'hMax) balance * 'hL avl * int *
'hR avl -> 'hMax succ avl
@@ -91,14 +91,14 @@ val elem : int -> 'h avl -> bool = <fun>
# val ins : int -> 'n avl -> ('n avl, 'n succ avl) sum = <fun>
# val insert : int -> avl' -> avl' = <fun>
# val del_min : 'n succ avl -> int * ('n avl, 'n succ avl) sum = <fun>
-type 'a avl_del =
+type _ avl_del =
Dsame : 'n avl -> 'n avl_del
| Ddecr : ('m succ, 'n) equal * 'm avl -> 'n avl_del
val del : int -> 'n avl -> 'n avl_del = <fun>
# val delete : int -> avl' -> avl' = <fun>
# type red
type black
-type ('a, 'b) sub_tree =
+type (_, _) sub_tree =
Bleaf : (black, zero) sub_tree
| Rnode : (black, 'n) sub_tree * int *
(black, 'n) sub_tree -> (red, 'n) sub_tree
@@ -106,14 +106,14 @@ type ('a, 'b) sub_tree =
('cR, 'n) sub_tree -> (black, 'n succ) sub_tree
type rb_tree = Root : (black, 'n) sub_tree -> rb_tree
# type dir = LeftD | RightD
-type ('a, 'b) ctxt =
+type (_, _) ctxt =
CNil : (black, 'n) ctxt
| CRed : int * dir * (black, 'n) sub_tree *
(red, 'n) ctxt -> (black, 'n) ctxt
| CBlk : int * dir * ('c1, 'n) sub_tree *
(black, 'n succ) ctxt -> ('c, 'n) ctxt
# val blacken : (red, 'a) sub_tree -> (black, 'a succ) sub_tree = <fun>
-type 'a crep = Red : red crep | Black : black crep
+type _ crep = Red : red crep | Black : black crep
val color : ('c, 'n) sub_tree -> 'c crep = <fun>
# val fill : ('c, 'n) ctxt -> ('c, 'n) sub_tree -> rb_tree = <fun>
# val recolor :
@@ -135,7 +135,7 @@ val color : ('c, 'n) sub_tree -> 'c crep = <fun>
# val repair : (red, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
# val ins : int -> ('c, 'n) sub_tree -> ('c, 'n) ctxt -> rb_tree = <fun>
# val insert : int -> rb_tree -> rb_tree = <fun>
-# type 'a term =
+# type _ term =
Const : int -> int term
| Add : (int * int -> int) term
| LT : (int * int -> bool) term
@@ -145,16 +145,16 @@ val ex1 : int term = Ap (Add, Pair (Const 3, Const 5))
val ex2 : (int * int) term =
Pair (Ap (Add, Pair (Const 3, Const 5)), Const 1)
val eval_term : 'a term -> 'a = <fun>
-type 'a rep =
+type _ rep =
Rint : int rep
| Rbool : bool rep
| Rpair : 'a rep * 'b rep -> ('a * 'b) rep
| Rfun : 'a rep * 'b rep -> ('a -> 'b) rep
-type ('a, 'b) equal = Eq : ('a, 'a) equal
+type (_, _) equal = Eq : ('a, 'a) equal
val rep_equal : 'a rep -> 'b rep -> ('a, 'b) equal option = <fun>
# type assoc = Assoc : string * 'a rep * 'a -> assoc
val assoc : string -> 'a rep -> assoc list -> 'a = <fun>
-type 'a term =
+type _ term =
Var : string * 'a rep -> 'a term
| Abs : string * 'a rep * 'b term -> ('a -> 'b) term
| Const : int -> int term
@@ -170,11 +170,11 @@ val ex4 : int term =
Const 3)
val v4 : int = 6
# type rnil
-type ('a, 'b, 'c) rcons
-type 'a is_row =
+type (_, _, _) rcons
+type _ is_row =
Rnil : rnil is_row
| Rcons : 'c is_row -> ('a, 'b, 'c) rcons is_row
-type ('a, 'b) lam =
+type (_, _) lam =
Const : int -> ('e, int) lam
| Var : 'a -> (('a, 't, 'e) rcons, 't) lam
| Shift : ('e, 't) lam -> (('a, 'q, 'e) rcons, 't) lam
@@ -186,7 +186,7 @@ val ex1 : ((x, 'a -> 'b, (y, 'a, 'c) rcons) rcons, 'b) lam =
App (Var X, Shift (Var Y))
val ex2 : ('a, ('b -> 'c) -> 'b -> 'c) lam =
Abs (<poly>, Abs (<poly>, App (Shift (Var <poly>), Var <poly>)))
-# type 'a env =
+# type _ env =
Enil : rnil env
| Econs : 'a * 't * 'e env -> ('a, 't, 'e) rcons env
val eval_lam : 'e env -> ('e, 't) lam -> 't = <fun>
@@ -233,19 +233,17 @@ val ex3 :
App (Shift (Var Suc),
App (Shift (Var Suc), App (Shift (Var Suc), Var Zero))))
# val v3 : int = 6
-# * type 'a rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
+# * type _ rep = I : int rep | Ar : 'a rep * 'b rep -> ('a -> 'b) rep
val compare : 'a rep -> 'b rep -> (string, ('a, 'b) equal) sum = <fun>
# type term =
C of int
| Ab : string * 'a rep * term -> term
| Ap of term * term
| V of string
-type 'a ctx =
+type _ ctx =
Cnil : rnil ctx
| Ccons : 't * string * 'x rep * 'e ctx -> ('t, 'x, 'e) rcons ctx
-# type 'a checked =
- Cerror of string
- | Cok : ('e, 't) lam * 't rep -> 'e checked
+# type _ checked = Cerror of string | Cok : ('e, 't) lam * 't rep -> 'e checked
val lookup : string -> 'e ctx -> 'e checked = <fun>
# val tc : 'n nat -> 'e ctx -> term -> 'e checked = <fun>
# val ctx0 :
@@ -275,13 +273,13 @@ val ex1 : term = Ab ("x", I, Ap (Ap (V "+", V "x"), V "x"))
# val v2 : int = 6
# type pexp
type pval
-type 'a mode = Pexp : pexp mode | Pval : pval mode
-type ('a, 'b) tarr
+type _ mode = Pexp : pexp mode | Pval : pval mode
+type (_, _) tarr
type tint
-type ('a, 'b) rel =
+type (_, _) rel =
IntR : (tint, int) rel
| IntTo : ('b, 's) rel -> ((tint, 'b) tarr, int -> 's) rel
-type ('a, 'b, 'c) lam =
+type (_, _, _) lam =
Const : ('a, 'b) rel * 'b -> (pval, 'env, 'a) lam
| Var : 'a -> (pval, ('a, 't, 'e) rcons, 't) lam
| Shift : ('m, 'e, 't) lam -> ('m, ('a, 'q, 'e) rcons, 't) lam
@@ -292,12 +290,12 @@ type ('a, 'b, 'c) lam =
# val ex1 : (pexp, 'a, tint) lam =
App (Lam (<poly>, Var <poly>), Const (IntR, <poly>))
val mode : ('m, 'e, 't) lam -> 'm mode = <fun>
-# type ('a, 'b) sub =
+# type (_, _) sub =
Id : ('r, 'r) sub
| Bind : 't * ('m, 'r2, 'x) lam *
('r, 'r2) sub -> (('t, 'x, 'r) rcons, 'r2) sub
| Push : ('r1, 'r2) sub -> (('a, 'b, 'r1) rcons, ('a, 'b, 'r2) rcons) sub
-type ('a, 'b) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
+type (_, _) lam' = Ex : ('m, 's, 't) lam -> ('s, 't) lam'
# val subst : ('m1, 'r, 't) lam -> ('r, 's) sub -> ('s, 't) lam' = <fun>
# type closed = rnil
type 'a rlam = ((pexp, closed, 'a) lam, (pval, closed, 'a) lam) sum
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
index ca6f94776..cff10f16f 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.principal.reference
@@ -7,14 +7,14 @@
| List : 'a ty -> 'a list ty
| Pair : ('a ty * 'b ty) -> ('a * 'b) ty
| Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
- type ('a, 'b) eq = Eq : ('a, 'a) eq
+ type (_, _) eq = Eq : ('a, 'a) eq
exception CastFailure
val check_eq : 't ty -> 't' ty -> ('t, 't') eq
val gcast : 't ty -> 't' ty -> 't -> 't'
end
# module HOAS :
sig
- type 'a term =
+ type _ term =
Tag : 't Typeable.ty * int -> 't term
| Con : 't -> 't term
| Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
@@ -32,7 +32,7 @@
| Con : 't -> ('env, 't) term
| Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
| App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
- type 'a stack =
+ type _ stack =
Empty : unit stack
| Push : 'env stack * 't -> ('env * 't) stack
val prj : ('env, 't) ix -> 'env stack -> 't
@@ -40,7 +40,7 @@
end
# module Convert :
sig
- type ('a, 'b) layout =
+ type (_, _) layout =
EmptyLayout : ('env, unit) layout
| PushLayout : 't Typeable.ty * ('env, 'env') layout *
('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
diff --git a/testsuite/tests/typing-gadts/term-conv.ml.reference b/testsuite/tests/typing-gadts/term-conv.ml.reference
index ca6f94776..cff10f16f 100644
--- a/testsuite/tests/typing-gadts/term-conv.ml.reference
+++ b/testsuite/tests/typing-gadts/term-conv.ml.reference
@@ -7,14 +7,14 @@
| List : 'a ty -> 'a list ty
| Pair : ('a ty * 'b ty) -> ('a * 'b) ty
| Fun : ('a ty * 'b ty) -> ('a -> 'b) ty
- type ('a, 'b) eq = Eq : ('a, 'a) eq
+ type (_, _) eq = Eq : ('a, 'a) eq
exception CastFailure
val check_eq : 't ty -> 't' ty -> ('t, 't') eq
val gcast : 't ty -> 't' ty -> 't -> 't'
end
# module HOAS :
sig
- type 'a term =
+ type _ term =
Tag : 't Typeable.ty * int -> 't term
| Con : 't -> 't term
| Lam : 's Typeable.ty * ('s term -> 't term) -> ('s -> 't) term
@@ -32,7 +32,7 @@
| Con : 't -> ('env, 't) term
| Lam : ('env * 's, 't) term -> ('env, 's -> 't) term
| App : ('env, 's -> 't) term * ('env, 's) term -> ('env, 't) term
- type 'a stack =
+ type _ stack =
Empty : unit stack
| Push : 'env stack * 't -> ('env * 't) stack
val prj : ('env, 't) ix -> 'env stack -> 't
@@ -40,7 +40,7 @@
end
# module Convert :
sig
- type ('a, 'b) layout =
+ type (_, _) layout =
EmptyLayout : ('env, unit) layout
| PushLayout : 't Typeable.ty * ('env, 'env') layout *
('env, 't) DeBruijn.ix -> ('env, 'env' * 't) layout
diff --git a/testsuite/tests/typing-gadts/test.ml.principal.reference b/testsuite/tests/typing-gadts/test.ml.principal.reference
index 6cdc7de00..f692325f1 100644
--- a/testsuite/tests/typing-gadts/test.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/test.ml.principal.reference
@@ -1,7 +1,7 @@
# module Exp :
sig
- type 'a t =
+ type _ t =
IntLit : int -> int t
| BoolLit : bool -> bool t
| Pair : 'a t * 'b t -> ('a * 'b) t
@@ -13,7 +13,7 @@
# module List :
sig
type zero
- type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+ type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
val head : ('a * 'b) t -> 'a
val tail : ('a * 'b) t -> 'b t
val length : 'a t -> int
@@ -76,7 +76,7 @@ Error: This expression has type bool but an expression was expected of type s
^
Error: This pattern matches values of type b
but a pattern was expected which matches values of type a
-# type 'a t = Int : int t
+# type _ t = Int : int t
# val ky : 'a -> 'a -> 'a = <fun>
# val test : 'a t -> 'a = <fun>
# val test : 'a t -> int = <fun>
@@ -138,11 +138,11 @@ Error: This expression has type a = int
This instance of int is ambiguous:
it would escape the scope of its equation
# val f : 'a t -> int -> int = <fun>
-# type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+# type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
val f : 'a h -> 'a = <fun>
-# type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+# type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
val f : 'a j -> 'a = <fun>
-# type ('a, 'b) eq = Eq : ('a, 'a) eq
+# type (_, _) eq = Eq : ('a, 'a) eq
# Characters 5-91:
....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
fun Eq o -> o
@@ -226,7 +226,7 @@ Error: This expression has type [> `A of a | `B ]
This instance of a is ambiguous:
it would escape the scope of its equation
# type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
TE : 'a ty -> 'a array ty
| TA : int ty
| TB : bool ty
@@ -276,11 +276,11 @@ Error: This expression has type (a, a) eq
but an expression was expected of type (a, b) eq
# val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
# val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-# type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+# type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
val f : 'a t -> 'a = <fun>
# - : [ `A | `B ] = `A
-# type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+# type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
# Characters 98-99:
(x:<foo:int>)
^
diff --git a/testsuite/tests/typing-gadts/test.ml.reference b/testsuite/tests/typing-gadts/test.ml.reference
index 80542d949..8d05b4ffe 100644
--- a/testsuite/tests/typing-gadts/test.ml.reference
+++ b/testsuite/tests/typing-gadts/test.ml.reference
@@ -1,7 +1,7 @@
# module Exp :
sig
- type 'a t =
+ type _ t =
IntLit : int -> int t
| BoolLit : bool -> bool t
| Pair : 'a t * 'b t -> ('a * 'b) t
@@ -13,7 +13,7 @@
# module List :
sig
type zero
- type 'a t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
+ type _ t = Nil : zero t | Cons : 'a * 'b t -> ('a * 'b) t
val head : ('a * 'b) t -> 'a
val tail : ('a * 'b) t -> 'b t
val length : 'a t -> int
@@ -69,7 +69,7 @@ Error: This pattern matches values of type ([? `A ] as 'a) * bool t
but a pattern was expected which matches values of type 'a * int t
# module Propagation :
sig
- type 'a t = IntLit : int -> int t | BoolLit : bool -> bool t
+ type _ t = IntLit : int -> int t | BoolLit : bool -> bool t
val check : 's t -> 's
end
# Characters 87-88:
@@ -77,7 +77,7 @@ Error: This pattern matches values of type ([? `A ] as 'a) * bool t
^
Error: This pattern matches values of type b
but a pattern was expected which matches values of type a
-# type 'a t = Int : int t
+# type _ t = Int : int t
# val ky : 'a -> 'a -> 'a = <fun>
# val test : 'a t -> 'a = <fun>
# val test : 'a t -> int = <fun>
@@ -139,11 +139,11 @@ Error: This expression has type a = int
This instance of int is ambiguous:
it would escape the scope of its equation
# val f : 'a t -> int -> int = <fun>
-# type 'a h = Has_m : < m : int > h | Has_b : < b : bool > h
+# type _ h = Has_m : < m : int > h | Has_b : < b : bool > h
val f : 'a h -> 'a = <fun>
-# type 'a j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
+# type _ j = Has_A : [ `A of int ] j | Has_B : [ `B of bool ] j
val f : 'a j -> 'a = <fun>
-# type ('a, 'b) eq = Eq : ('a, 'a) eq
+# type (_, _) eq = Eq : ('a, 'a) eq
# Characters 5-91:
....f : type a b. (a,b) eq -> (<m : a; ..> as 'a) -> (<m : b; ..> as 'a) =
fun Eq o -> o
@@ -213,7 +213,7 @@ Error: This expression has type [> `A of a | `B ]
This instance of a is ambiguous:
it would escape the scope of its equation
# type 'a t = A of int | B of bool | C of float | D of 'a
-type 'a ty =
+type _ ty =
TE : 'a ty -> 'a array ty
| TA : int ty
| TB : bool ty
@@ -263,11 +263,11 @@ Error: This expression has type (a, a) eq
but an expression was expected of type (a, b) eq
# val f : ('a M.t * 'a, 'b M.t * 'b) eq -> ('a, 'b) eq = <fun>
# val f : ('a * 'a M.t, 'b * 'b M.t) eq -> ('a, 'b) eq = <fun>
-# type 'a t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
+# type _ t = V1 : [ `A | `B ] t | V2 : [ `C | `D ] t
val f : 'a t -> 'a = <fun>
# - : [ `A | `B ] = `A
-# type 'a int_foo = IF_constr : < foo : int; .. > int_foo
-type 'a int_bar = IB_constr : < bar : int; .. > int_bar
+# type _ int_foo = IF_constr : < foo : int; .. > int_foo
+type _ int_bar = IB_constr : < bar : int; .. > int_bar
# Characters 98-99:
(x:<foo:int>)
^
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
index 0859c1335..ddae4d248 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference
@@ -15,7 +15,7 @@ Error: In this GADT definition, the variance of some parameter
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
+type _ t = IntLit : int t | BoolLit : bool t
val check : 's t * 's -> bool = <fun>
# Characters 91-180:
.............................................function
diff --git a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
index 0859c1335..ddae4d248 100644
--- a/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
+++ b/testsuite/tests/typing-gadts/yallop_bugs.ml.reference
@@ -15,7 +15,7 @@ Error: In this GADT definition, the variance of some parameter
Warning 8: this pattern-matching is not exhaustive.
Here is an example of a value that is not matched:
(IntLit, 0)
-type 'a t = IntLit : int t | BoolLit : bool t
+type _ t = IntLit : int t | BoolLit : bool t
val check : 's t * 's -> bool = <fun>
# Characters 91-180:
.............................................function
diff --git a/typing/oprint.ml b/typing/oprint.ml
index 21ef16080..0bfd8797c 100644
--- a/typing/oprint.ml
+++ b/typing/oprint.ml
@@ -265,9 +265,9 @@ let out_type = ref print_out_type
(* Class types *)
let type_parameter ppf (ty, (co, cn)) =
- fprintf ppf "%s'%s" (if not cn then "+" else if not co then "-" else "")
- (*if co then if cn then "!" else "+" else if cn then "-" else "?"*)
- ty
+ fprintf ppf "%s%s"
+ (if not cn then "+" else if not co then "-" else "")
+ (if ty = "_" then ty else "'"^ty)
let print_out_class_params ppf =
function
diff --git a/typing/printtyp.ml b/typing/printtyp.ml
index ed8b2e75f..2b5470ea4 100644
--- a/typing/printtyp.ml
+++ b/typing/printtyp.ml
@@ -236,7 +236,8 @@ let name_of_type t =
(* No name available, create a new one *)
new_name ()
in
- names := (t, name) :: !names;
+ (* Exception for type declarations *)
+ if name <> "_" then names := (t, name) :: !names;
name
let check_name_of_type t = ignore(name_of_type t)
diff --git a/typing/typedecl.ml b/typing/typedecl.ml
index 8b93fdef6..7929a6143 100644
--- a/typing/typedecl.ml
+++ b/typing/typedecl.ml
@@ -125,16 +125,11 @@ module StringSet =
end)
let make_params sdecl =
- let param_counter = ref 0 in
try
List.map
(function
- None ->
- incr param_counter ;
- enter_type_variable true sdecl.ptype_loc
- (Printf.sprintf "*%d" !param_counter)
- | Some x ->
- enter_type_variable true sdecl.ptype_loc x)
+ None -> Ctype.new_global_var ~name:"_" ()
+ | Some x -> enter_type_variable true sdecl.ptype_loc x)
sdecl.ptype_params
with Already_bound ->
raise(Error(sdecl.ptype_loc, Repeated_parameter))