Treat universal variables as abstract in expected types

testsuite/tests/effects/backtrace.ml

@@ -45,9 +45,9 @@ let main () =
     exnc = (fun e ->
       let open Printexc in
       print_raw_backtrace stdout (get_raw_backtrace ()));
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
-      | Wait -> Some (fun (k : (a, _) continuation) ->
+      | Wait -> Some (fun k ->
           discontinue_with_backtrace k x bt)
       | _ -> None }
 

testsuite/tests/effects/cmphash.ml

@@ -7,7 +7,7 @@ type _ t += E : unit t
 
 let () =
   try_with perform E
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
       | E -> Some (fun k ->
           begin match k = k with

testsuite/tests/effects/evenodd.ml

@@ -8,7 +8,7 @@ type _ t += E : unit t
 let rec even n =
   if n = 0 then true
   else try_with odd (n-1)
-       { effc = fun (type a) (e : a t) ->
+       { effc = fun e ->
            match e with
            | E -> Some (fun k -> assert false)
            | _ -> None }

testsuite/tests/effects/issue479.ml

@@ -31,9 +31,9 @@ let iter2gen : _ iter2gen = fun iter c ->
     match_with (iter suspending_f) c
     { retc = (fun _ -> fun () -> None);
       exnc = (fun e -> raise e);
-      effc = fun (type a) (e : a t) ->
+      effc = fun e ->
         match e with
-        | Hold -> Some (fun (k : (a,_) continuation) ->
+        | Hold -> Some (fun k ->
             fun () ->
               let x = !r in
               Printf.printf "Hold %s\n%!" (

testsuite/tests/effects/marshal.ml

@@ -7,7 +7,7 @@ type _ t += E : unit t
 
 let () =
   try_with perform E
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       Some (fun k ->
           match Marshal.to_string k [] with
           | _ -> assert false

testsuite/tests/effects/overflow.ml

@@ -33,7 +33,7 @@ let () =
   match_with (fun _ -> f 1 2 3 4 5 6 7 8) ()
   { retc = (fun n -> Printf.printf "%d\n" n);
     exnc = (fun e -> raise e);
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
       | E -> Some (fun k -> assert false)
       | _ -> None }

testsuite/tests/effects/partial.ml

@@ -8,7 +8,7 @@ exception Done
 
 let handle_partial f =
   try_with f ()
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
       | E -> Some (fun k -> assert false)
       | _ -> None }
@@ -21,7 +21,7 @@ let () =
     exnc = (function
       | Done -> print_string "ok\n"
       | e -> raise e);
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
-      | E -> Some (fun (k : (a, _) continuation) -> discontinue k Done)
+      | E -> Some (fun k -> discontinue k Done)
       | _ -> None }

testsuite/tests/effects/reperform.ml

@@ -12,7 +12,7 @@ let rec nest = function
      match_with (fun _ -> Printf.printf "[%d\n" n; nest (n - 1)) ()
      { retc = (fun x -> Printf.printf " %d]\n" n; x);
        exnc = (fun e -> Printf.printf " !%d]\n" n; raise e);
-       effc = fun (type a) (e : a t) ->
+       effc = fun e ->
          match e with
          | F -> Some (fun k -> assert false)
          | _ -> None }
@@ -21,16 +21,16 @@ let () =
   match_with nest 5
   { retc = (fun x -> Printf.printf "= %d\n" x);
     exnc = (fun e -> raise e);
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
-      | E n -> Some (fun (k : (a, _) continuation) -> continue k (n + 100))
+      | E n -> Some (fun k -> continue k (n + 100))
       | _ -> None }
 
 let () =
   match_with nest 5
   { retc = (fun x -> assert false);
     exnc = (fun e -> Printf.printf "%s\n" (Printexc.to_string e));
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
       | F -> Some (fun k -> assert false)
       | _ -> None }

testsuite/tests/effects/sched.ml

@@ -26,13 +26,13 @@ let run main =
       exnc = (function
         | E -> say "!"; dequeue ()
         | e -> raise e);
-      effc = fun (type a) (e : a t) ->
+      effc = fun e ->
         match e with
-        | Yield -> Some (fun (k : (a, _) continuation) ->
+        | Yield -> Some (fun k ->
             say ","; enqueue k; dequeue ())
-        | Fork f -> Some (fun (k : (a, _) continuation) ->
+        | Fork f -> Some (fun k ->
             say "+"; enqueue k; spawn f)
-        | Ping -> Some (fun (k : (a, _) continuation) ->
+        | Ping -> Some (fun k ->
             say "["; discontinue k Pong)
         | _ -> None }
   in
@@ -47,9 +47,9 @@ let test () =
         exnc = (function
           | Pong -> say "]"
           | e -> raise e);
-        effc = fun (type a) (e : a t) ->
+        effc = fun e ->
           match e with
-          | Yield -> Some (fun (k : (a,_) continuation) -> failwith "what?")
+          | Yield -> Some (fun k -> failwith "what?")
           | _ -> None }
      end;
      raise E));

testsuite/tests/effects/shallow_state.ml

@@ -23,11 +23,11 @@ let handle_state init f x =
       continue_with k x
       { retc = (fun result -> result, state);
         exnc = (fun e -> raise e);
-        effc = (fun (type b) (eff : b t) ->
+        effc = (fun eff ->
           match eff with
-          | Get -> Some (fun (k : (b,r) continuation) ->
+          | Get -> Some (fun k ->
               loop state k state)
-          | Set new_state -> Some (fun (k : (b,r) continuation) ->
+          | Set new_state -> Some (fun k ->
               loop new_state k ())
           | e -> None) }
   in

testsuite/tests/effects/test1.ml

@@ -8,7 +8,7 @@ type _ t += E : unit t
 let () =
   Printf.printf "%d\n%!" @@
     try_with (fun x -> x) 10
-    { effc = (fun (type a) (e : a t) ->
+    { effc = (fun e ->
         match e with
         | E -> Some (fun k -> 11)
         | e -> None) }

testsuite/tests/effects/test10.ml

@@ -13,17 +13,17 @@ let rec c i = b i + Random.int i
 let rec d i =
   Random.int i +
   try_with c i
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
-      | Poke -> Some (fun (k : (a,_) continuation) -> continue k ())
+      | Poke -> Some (fun k -> continue k ())
       | _ -> None }
 
 let rec e i =
   Random.int i +
   try_with d i
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
-      | Peek -> Some (fun (k : (a,_) continuation) ->
+      | Peek -> Some (fun k ->
           ignore (Deep.get_callstack k 100);
           continue k 42)
       | _ -> None }

testsuite/tests/effects/test11.ml

@@ -10,9 +10,9 @@ type _ t += E : int t
 
 let handle comp =
   try_with comp ()
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
-      | E -> Some (fun (k : (a,_) continuation) -> continue k 10)
+      | E -> Some (fun k -> continue k 10)
       | _ -> None }
 
 let () =

testsuite/tests/effects/test3.ml

@@ -15,7 +15,7 @@ let () =
       exnc = (function
         | X -> 10
         | e -> raise e);
-      effc = (fun (type a) (e : a t) ->
+      effc = (fun e ->
         match e with
         | E -> Some (fun k -> 11)
         | e -> None) }

testsuite/tests/effects/test4.ml

@@ -7,11 +7,11 @@ type _ t += Foo : int -> int t
 
 let r =
   try_with perform (Foo 3)
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
-      | Foo i -> Some (fun (k : (a,_) continuation) ->
+      | Foo i -> Some (fun k ->
           try_with (continue k) (i+1)
-          { effc = fun (type a) (e : a t) ->
+          { effc = fun e ->
               match e with
               | Foo i -> Some (fun k -> failwith "NO")
               | e -> None })

testsuite/tests/effects/test5.ml

@@ -10,11 +10,11 @@ let f () = (perform (Foo 3)) (* 3 + 1 *)
 
 let r =
   try_with f ()
-  { effc = fun (type a) (e : a t) ->
+  { effc = fun e ->
       match e with
-      | Foo i -> Some (fun (k : (a, _) continuation) ->
+      | Foo i -> Some (fun k ->
           try_with (continue k) (i + 1)
-          { effc = fun (type a) (e : a t) ->
+          { effc = fun e ->
               match e with
               | Foo i -> Some (fun k -> failwith "NO")
               | _ -> None })

testsuite/tests/effects/test6.ml

@@ -21,7 +21,7 @@ let () =
   Printf.printf "%b\n%!" !ok2;
 
   try_with (f E) ok3 {
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
       | F -> Some (fun k -> assert false)
       | _ -> None

testsuite/tests/effects/test_lazy.ml

@@ -17,18 +17,18 @@ let _ =
   let l = lazy (f 1_000) in
   let v1 =
     try_with Lazy.force l
-    { effc = fun (type a) (e : a t) ->
+    { effc = fun e ->
         match e with
-        | Stop -> Some (fun (k : (a, _) continuation) -> continue k ())
+        | Stop -> Some (fun k -> continue k ())
         | _ -> None }
   in
   Printf.printf "%d\n" v1;
   let l2 = lazy (f 2_000) in
   let v2 =
     try_with Lazy.force l2
-    { effc = fun (type a) (e : a t) ->
+    { effc = fun e ->
         match e with
-        | Stop -> Some (fun (k : (a, _) continuation) ->
+        | Stop -> Some (fun k ->
             let d = Domain.spawn(fun () -> continue k ()) in
             Domain.join d)
         | _ -> None }
@@ -37,7 +37,7 @@ let _ =
   let l3 = lazy (f 3_000) in
   let _ =
     try_with Lazy.force l3
-    { effc = fun (type a) (e : a t) ->
+    { effc = fun e ->
         match e with
         | Stop -> Some (fun _ ->
             try

testsuite/tests/effects/used_cont.ml

@@ -10,9 +10,9 @@ let () =
   match_with (fun _ -> perform E; 42) ()
   { retc = (fun n -> assert (n = 42));
     exnc = (fun e -> raise e);
-    effc = fun (type a) (e : a t) ->
+    effc = fun e ->
       match e with
-      | E -> Some (fun (k : (a,_) continuation) ->
+      | E -> Some (fun k ->
           continue k ();
           r := Some (k : (unit, unit) continuation);
           Gc.full_major ();

testsuite/tests/shapes/simple.ml

@@ -125,8 +125,8 @@ class c : object  end
 class type c = object end
 [%%expect{|
 {
- "c"[type] -> <.34>;
- "c"[class type] -> <.34>;
+ "c"[type] -> <.35>;
+ "c"[class type] -> <.35>;
  }
 class type c = object  end
 |}]

testsuite/tests/typing-gadts/pr10907.ml

@@ -45,9 +45,10 @@ val t : 'a some_iso = Iso (<fun>, <fun>)
 let unsound_cast : 'a 'b. 'a -> 'b = fun x ->
   match t with Iso (g, h) -> h (g x)
 [%%expect{|
-Lines 1-2, characters 37-36:
-1 | .....................................fun x ->
+Line 2, characters 29-36:
 2 |   match t with Iso (g, h) -> h (g x)
-Error: This definition has type "'c. 'c -> 'c" which is less general than
-         "'a 'b. 'a -> 'b"
+                                 ^^^^^^^
+Error: This expression has type "$a" but an expression was expected of type "$b"
+       Hint: "$a" and "$b" are abstract types
+         bound by the polymorphic annotation on "unsound_cast".
 |}]