names.ml

(* TEST_BELOW
(* Blank lines added here to preserve locations. *)
*)


let id x = Sys.opaque_identity x

let[@inline never] bang () = raise Exit

let[@inline never] fn_multi _ _ f = f 42 + 1

let[@inline never] fn_function = function
  | f -> f 42 + 1

let[@inline never] fn_poly : 'a . 'a -> ('a -> int) -> int = fun x f ->
  f x + 1

module Mod1 = struct
  module Nested = struct
    let[@inline never] apply f = f 42 + 1
  end
end

let[@inline never] anon f =
  let fn = id (fun () -> f 42 + 1) in
  fn ()

let[@inline never] double_anon f =
  let fn = id (fun () ->
    let fn = id (fun () ->
      f 42 + 1) in
    fn ()) in
  fn ()

let[@inline never] local f =
  let[@inline never] inner () = f 42 + 1 in
  (id inner) () + 1

let[@inline never] double_local f =
  let inner1 () =
    let inner2 () = f 42 + 1 in
    (id inner2) () + 1 in
  (id inner1) () + 1

let local_no_arg =
  let inner f = f 42 + 1 in
  fun[@inline never] f -> (id inner) f + 1

let[@inline never] curried () =
  let inner () f = f 42 in
  id (inner ())

let[@inline never] local_module f =
  let module N = struct
    let[@inline never] foo () =
      f 42 + 1
    let r = ref 0    let () = r := id (id foo ())
  end in
  !N.r

module Functor (X : sig end) = struct
  let[@inline never] fn f = f 42 + 1
end
module Inst = Functor (struct end)

module rec Rec1 : sig
  val fn : (int -> int) -> int
end = struct
  module M = Rec2 (struct end)
  let[@inline never] fn f = M.fn f + 1
end
and Rec2 : functor (X : sig end) -> sig
  val fn : (int -> int) -> int
end = functor (X : sig end) -> struct
  let[@inline never] fn f = f 42 + 1
end

let[@inline never] (+@+) n f = f 42 + 1

(* [nested] shows up in the backtrace as [nested.(fun)] because
   it creates an inner lambda. In contrast, [flat]'s arity is syntactically
   2 and does not create an inner lambda.
*)
let[@inline never] flat = fun x f -> f x + 1
let[@inline never] nested x = fun[@inline never] f -> f x + 1

class klass = object (self)
  val other = new klass2 "asdf"
  method meth f : int =
    other#othermeth 1 1 f 1 + 1
end
and klass2 _v = object (self)
  method othermeth _ _ f _ =
    (id (fun g -> g 42 + 1) f) + 1
end

let inline_object f =
  let obj = object (self)
    method meth : int =
      self#othermeth 1 f 1 + 1
    method othermeth _ _ _ =
      f 42 + 1
  end in
  obj#meth

let[@inline never] lazy_ f =
  let x = Sys.opaque_identity (lazy (1 + f ())) in
  Lazy.force x


let[@inline never] nontailcall f =
  f () [@nontail]

let () =
  Printexc.record_backtrace true;
  match
    fn_multi 1 1 @@ fun _ ->
    fn_function @@ fun _ ->
    fn_poly 42 @@ fun _ ->
    Mod1.Nested.apply @@ fun _ ->
    anon @@ fun _ ->
    double_anon @@ fun _ ->
    local @@ fun _ ->
    double_local @@ fun _ ->
    local_no_arg @@ fun _ ->
    curried () @@ fun _ ->
    local_module @@ fun _ ->
    Inst.fn @@ fun _ ->
    Rec1.fn @@ fun _ ->
    42 +@+ fun _ ->
    flat 7 @@ fun _ ->
    nested 5 @@ fun _ ->
    (new klass)#meth @@ fun _ ->
    inline_object @@ fun _ ->
    lazy_ @@ fun _ ->
    nontailcall @@ fun _ ->
    bang ()
  with
  | _ -> assert false
  | exception Exit ->
     Printexc.print_backtrace stdout

(* TEST
 flags = "-g";
*)