(* This test is extracted from the compiler's testsuite. *)

let poly1 (id : 'a. 'a -> 'a) = id 3, id "three"

let _ = poly1 (fun x -> x)

let _ = poly1 (fun x -> x + 1)

let id x = x
let _ = poly1 id

let _ = poly1 (id (fun x -> x))

let _ = poly1 (let r = ref None in fun x -> r := Some x; x)

let escape f = poly1 (fun x -> f x; x)

let poly2 : ('a. 'a -> 'a) -> int * string =
  fun id -> id 3, id "three"

let _ = poly2 (fun x -> x)

let _ = poly2 (fun x -> x + 1)

let poly3 : 'b. ('a. 'a -> 'a) -> 'b -> 'b * 'b option =
  fun id x -> id x, id (Some x)

let _ = poly3 (fun x -> x) 8

let _ = poly3 (fun x -> x + 1) 8

let rec poly4 p (id : 'a. 'a -> 'a) =
  if p then poly4 false id else id 4, id "four"

let _ = poly4 true (fun x -> x)

let _ = poly4 true (fun x -> x + 1)

let rec poly5 : bool -> ('a. 'a -> 'a) -> int * string =
  fun p id ->
    if p then poly5 false id else id 5, id "five"

let _ = poly5 true (fun x -> x)

let _ = poly5 true (fun x -> x + 1)


let rec poly6 : 'b. bool -> ('a. 'a -> 'a) -> 'b -> 'b * 'b option =
  fun p id x ->
    if p then poly6 false id x else id x, id (Some x)

let _ = poly6 true (fun x -> x) 8

let _ = poly6 true (fun x -> x + 1) 8

let needs_magic (magic : 'a 'b. 'a -> 'b) = (magic 5 : string)
let _ = needs_magic (fun x -> x)

let with_id (f : ('a. 'a -> 'a) -> 'b) = f (fun x -> x)

let _ = with_id (fun id -> id 4, id "four")

let non_principal1 p f =
  if p then with_id f
  else f (fun x -> x)

let non_principal2 p f =
  if p then f (fun x -> x)
  else with_id f

let principal1 p (f : ('a. 'a -> 'a) -> 'b) =
  if p then f (fun x -> x)
  else with_id f

let principal2 : bool -> (('a. 'a -> 'a) -> 'b) -> 'b =
  fun p f ->
    if p then f (fun x -> x)
    else with_id f

type poly = ('a. 'a -> 'a) -> int * string

let principal3 : poly option list = [ None; Some (fun x -> x 5, x "hello") ]

let non_principal3 =
  [ (Some (fun x -> x 5, x "hello") : poly option);
    Some (fun y -> y 6, y "goodbye") ]

let non_principal4 =
  [ Some (fun y -> y 6, y "goodbye");
    (Some (fun x -> x 5, x "hello") : poly option) ]

(* Functions with polymorphic parameters are separate from other functions *)
type 'a arg = 'b
  constraint 'a = 'b -> 'c
type really_poly = (('a. 'a -> 'a) -> string) arg

(* Polymorphic parameters are (mostly) treated as invariant *)
type p1 = ('a. 'a -> 'a) -> int
type p2 = ('a 'b. 'a -> 'b) -> int

let foo (f : p1) : p2 = f

let foo f = (f : p1 :> p2)

module Foo (X : sig val f : p1 end) : sig val f : p2 end = X

let foo (f : p1) : p2 = (fun id -> f id)

(* Following the existing behaviour for polymorphic methods, you can
   subtype from a polymorphic parameter to a monomorphic
   parameter. Elsewhere it still behaves as invariant. *)
type p1 = (bool -> bool) -> int
type p2 = ('a. 'a -> 'a) -> int

let foo (x : p1) : p2 = x

let foo x = (x : p1 :> p2)

module Foo (X : sig val f : p1 end) : sig val f : p2 end = X

let foo (f : p1) : p2 = (fun id -> f id)

class c (f: 'a. 'a -> 'a) = object
  method m = f 0
  method n = f "a"
end;;

class c' (f: 'a. int -> int) = object
  method m = f 0
end;;

let poly1' ~(id : 'a. 'a -> 'a) = id 3, id "three"

let poly2' ?(id : 'a. 'a -> 'a) = id 3, id "three"

let poly3' ?(id : 'a. int -> int) = id 3

(* This test illustrate a new occurrence of the bug discussed in
   https://github.com/ocaml/ocaml/pull/13984*)

module type T = sig type 'a t = 'a list  end

let rec f (x : (module T)) =
  let (module LocalModule) = x in (assert false : ('a. 'a LocalModule.t) -> unit)

(* The following test requires full translation in the [approx_type] function if
   the annotation is partial. *)
let rec f () = g () Fun.id
and g () : ('a. 'a -> 'a) -> unit = fun _ -> () ;;

let rec f () = g () Fun.id
and g : unit -> ('a. 'a -> 'a) -> unit = fun () _ -> () ;;

(* Attempts at breaking type_pattern_approx *)
let rec f ([] : 'a. 'a list) = ()

let rec f () : ('a. 'a list) -> unit = fun [] -> ()

(* New expert trick: use 'a. to trigger "exact approximation" *)
let rec f () = g (module Map.Make(Int)) and g (m : (module Map.S)) = ();;

let rec f () = g (module Map.Make(Int)) and g (m : 'a. (module Map.S)) = ();;

(* Check that we are getting the right behaviour for polymorphic variants
   in polymorphic parameters. *)

let poly_poly_var : [< `A | `B ] -> unit = function  | `A -> () | `B -> ()

let accept_poly_poly_var (g : 'a. ([< `A | `B ] as 'a) -> unit) = g `A

let () = accept_poly_poly_var poly_poly_var

let f (`B|_) = ()
let h (f:'a. ([> `A ] as 'a) -> unit ) = f `B
let error = h f

let (let*) x (id : 'a. 'a -> 'a) = id x, id 1

let (let*) (x : 'a. 'a option) (id : 'a. 'a -> 'a) = id x, id 1

let y =
  let* x = 3. in
  x

let f ((g, x) : 'a. ('a -> int) * 'a) =
  g 3, g "three"

let f (x: [< `A of ('a. 'a option) -> unit ]) = match x with `A f -> f None

let f: type a. unit -> (a, ('b. 'b -> 'b) -> int) Type.eq ->  a =
  fun () Equal f -> f 0