diff options
-rw-r--r-- | testsuite/tests/typing-gadts/dynamic_frisch.ml.principal.reference | 18 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/dynamic_frisch.ml.reference | 18 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/omega07.ml.principal.reference | 78 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/omega07.ml.reference | 78 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/term-conv.ml.principal.reference | 8 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/term-conv.ml.reference | 8 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/test.ml.principal.reference | 20 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/test.ml.reference | 22 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/yallop_bugs.ml.principal.reference | 2 | ||||
-rw-r--r-- | testsuite/tests/typing-gadts/yallop_bugs.ml.reference | 2 | ||||
-rw-r--r-- | typing/oprint.ml | 6 | ||||
-rw-r--r-- | typing/printtyp.ml | 3 | ||||
-rw-r--r-- | typing/typedecl.ml | 9 |
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)) |