Fix Makefile

.gitignore

@@ -94,7 +94,7 @@ _build
 
 middle_end/flambda2.0/simplify/simplify.ml
 middle_end/flambda2.0/terms/flambda.ml
-middle_end/flambda2.0/types/flambda_type0.ml
+middle_end/flambda2.0/types/flambda_type.ml
 
 /ocamldoc/ocamldoc
 /ocamldoc/ocamldoc.opt

Makefile

@@ -46,6 +46,7 @@ INCLUDES=-I utils -I parsing -I typing -I bytecomp -I file_formats \
         -I middle_end/flambda2.0/basic \
         -I middle_end/flambda2.0/from_lambda \
         -I middle_end/flambda2.0/inlining \
+        -I middle_end/flambda2.0/lifting \
         -I middle_end/flambda2.0/naming \
         -I middle_end/flambda2.0/parser \
         -I middle_end/flambda2.0/simplify \
@@ -172,7 +173,9 @@ endif
 ASMCOMP_FLAMBDA2=\
   middle_end/flambda2.0/to_cmm/un_cps_helper.cmo \
   middle_end/flambda2.0/to_cmm/un_cps_closure.cmo \
+  middle_end/flambda2.0/to_cmm/un_cps_result.cmo \
   middle_end/flambda2.0/to_cmm/un_cps_env.cmo \
+  middle_end/flambda2.0/to_cmm/un_cps_static.cmo \
   middle_end/flambda2.0/to_cmm/un_cps.cmo
 
 ASMCOMP=\
@@ -227,13 +230,14 @@ MIDDLE_END_FLAMBDA2_COMPILENV_DEPS=\
   middle_end/flambda2.0/compilenv_deps/symbol.cmo
 
 MIDDLE_END_FLAMBDA2_BASIC=\
-  middle_end/flambda2.0/basic/closure_element.cmo \
+  middle_end/flambda2.0/basic/id_types.cmo \
   middle_end/flambda2.0/basic/continuation.cmo \
   middle_end/flambda2.0/basic/name.cmo \
   middle_end/flambda2.0/basic/var_within_closure.cmo \
   middle_end/flambda2.0/naming/name_mode.cmo \
   middle_end/flambda2.0/naming/permutation.cmo \
   middle_end/flambda2.0/naming/name_permutation.cmo \
+  middle_end/flambda2.0/basic/code_id.cmo \
   middle_end/flambda2.0/naming/name_occurrences.cmo \
   middle_end/flambda2.0/basic/immediate.cmo \
   middle_end/flambda2.0/types/kinds/flambda_kind.cmo \
@@ -247,8 +251,7 @@ MIDDLE_END_FLAMBDA2_BASIC=\
   middle_end/flambda2.0/basic/trap_action.cmo \
   middle_end/flambda2.0/basic/exn_continuation.cmo \
   middle_end/flambda2.0/basic/inline_attribute.cmo \
-  middle_end/flambda2.0/basic/id_types.cmo \
-  middle_end/flambda2.0/basic/code_id.cmo \
+  middle_end/flambda2.0/basic/code_id_or_symbol.cmo \
   middle_end/flambda2.0/basic/coeffects.cmo \
   middle_end/flambda2.0/basic/effects.cmo \
   middle_end/flambda2.0/basic/export_id.cmo \
@@ -291,17 +294,16 @@ MIDDLE_END_FLAMBDA2_TYPES=\
   middle_end/flambda2.0/types/basic/or_bottom_or_absorbing.cmo \
   middle_end/flambda2.0/types/basic/or_unknown.cmo \
   middle_end/flambda2.0/types/basic/or_unknown_or_bottom.cmo \
+  middle_end/flambda2.0/types/structures/code_age_relation.cmo \
   middle_end/flambda2.0/types/structures/type_structure_intf.cmo \
   middle_end/flambda2.0/types/structures/product_intf.cmo \
   middle_end/flambda2.0/types/structures/row_like_maps_to_intf.cmo \
   middle_end/flambda2.0/types/structures/set_of_closures_contents.cmo \
   middle_end/flambda2.0/types/basic/tag_and_size.cmo \
   middle_end/flambda2.0/types/basic/tag_or_unknown_and_size.cmo \
-  middle_end/flambda2.0/types/basic/term_language_function_declaration.cmo \
   middle_end/flambda2.0/types/type_descr_intf.cmo \
   middle_end/flambda2.0/types/type_head_intf.cmo \
-  middle_end/flambda2.0/types/flambda_type0.cmo \
-  middle_end/flambda2.0/types/type_system_intf.cmo \
+  middle_end/flambda2.0/types/flambda_type.cmo \
   middle_end/flambda2.0/types/basic/unit.cmo \
   middle_end/flambda2.0/types/basic/or_absorbing.cmo \
   middle_end/flambda2.0/types/basic/closure_id_set.cmo \
@@ -312,10 +314,13 @@ MIDDLE_END_FLAMBDA2_TERMS=\
   middle_end/flambda2.0/terms/apply_cont_expr.cmo \
   middle_end/flambda2.0/terms/call_kind.cmo \
   middle_end/flambda2.0/terms/apply_expr.cmo \
+  middle_end/flambda2.0/terms/function_declaration.cmo \
+  middle_end/flambda2.0/terms/function_declarations.cmo \
+  middle_end/flambda2.0/terms/set_of_closures.cmo \
   middle_end/flambda2.0/terms/switch_expr.cmo \
+  middle_end/flambda2.0/types/flambda_type.cmo \
   middle_end/flambda2.0/terms/flambda.cmo \
-  middle_end/flambda2.0/terms/flambda_static.cmo \
-  middle_end/flambda2.0/types/flambda_type.cmo
+  middle_end/flambda2.0/terms/flambda_unit.cmo
 
 MIDDLE_END_FLAMBDA2_SIMPLIFY=\
   middle_end/flambda2.0/simplify/env/continuation_use_kind.cmo \
@@ -330,12 +335,10 @@ MIDDLE_END_FLAMBDA2_SIMPLIFY=\
   middle_end/flambda2.0/simplify/env/simplify_env_and_result.cmo \
   middle_end/flambda2.0/simplify/env/downwards_acc.cmo \
   middle_end/flambda2.0/simplify/env/upwards_acc.cmo \
-  middle_end/flambda2.0/inlining/inlining_cost.cmo \
-  middle_end/flambda2.0/inlining/inlining_decision.cmo \
-  middle_end/flambda2.0/inlining/inlining_transforms.cmo \
   middle_end/flambda2.0/simplify/simplify_simple.cmo \
   middle_end/flambda2.0/simplify/simplify_import.cmo \
   middle_end/flambda2.0/unboxing/unbox_continuation_params.cmo \
+  middle_end/flambda2.0/lifting/sort_lifted_constants.cmo \
   middle_end/flambda2.0/simplify/basic/reachable.cmo \
   middle_end/flambda2.0/simplify/simplify_common.cmo \
   middle_end/flambda2.0/simplify/simplify_variadic_primitive.cmo \
@@ -344,10 +347,13 @@ MIDDLE_END_FLAMBDA2_SIMPLIFY=\
   middle_end/flambda2.0/simplify/simplify_ternary_primitive.cmo \
   middle_end/flambda2.0/simplify/simplify_binary_primitive.cmo \
   middle_end/flambda2.0/simplify/simplify_primitive.cmo \
+  middle_end/flambda2.0/inlining/inlining_cost.cmo \
+  middle_end/flambda2.0/inlining/inlining_decision.cmo \
+  middle_end/flambda2.0/inlining/inlining_transforms.cmo \
+  middle_end/flambda2.0/lifting/reification.cmo \
+  middle_end/flambda2.0/lifting/reify_continuation_param_types.cmo \
   middle_end/flambda2.0/simplify/typing_helpers/continuation_handler_like_intf.cmo \
-  middle_end/flambda2.0/simplify/typing_helpers/reification.cmo \
   middle_end/flambda2.0/utils/monad.cmo \
-  middle_end/flambda2.0/utils/top_closure.cmo \
   middle_end/flambda2.0/simplify/simplify.cmo
 
 MIDDLE_END_FLAMBDA2_FROM_LAMBDA=\
@@ -1281,15 +1287,15 @@ partialclean::
 
 # Flambda2 recursive modules black magic
 
-FLAMBDA_TYPE0_DEPS=$(shell sed "s|^|middle_end/flambda2.0/types/|g" \
+FLAMBDA_TYPE_DEPS=$(shell sed "s|^|middle_end/flambda2.0/types/|g" \
   middle_end/flambda2.0/types/rec_modules | tr '\n' ' ')
-middle_end/flambda2.0/types/flambda_type0.ml: \
-  middle_end/flambda2.0/types/template/flambda_type0.templ.ml \
+middle_end/flambda2.0/types/flambda_type.ml: \
+  middle_end/flambda2.0/types/template/flambda_type.templ.ml \
   middle_end/flambda2.0/types/rec_modules \
-  $(FLAMBDA_TYPE0_DEPS)
+  $(FLAMBDA_TYPE_DEPS)
 	cd middle_end/flambda2.0/types && \
-	  ../scripts/assemble_rec_modules.sh template/flambda_type0.templ.ml \
-	    rec_modules flambda_type0.ml
+	  ../scripts/assemble_rec_modules.sh template/flambda_type.templ.ml \
+	    rec_modules flambda_type.ml
 
 FLAMBDA_DEPS=$(shell sed "s|^|middle_end/flambda2.0/terms/|g" \
   middle_end/flambda2.0/terms/rec_modules | tr '\n' ' ')
@@ -1312,7 +1318,7 @@ middle_end/flambda2.0/simplify/simplify.ml: \
 	    rec_modules simplify.ml
 
 beforedepend:: \
-  middle_end/flambda2.0/types/flambda_type0.ml \
+  middle_end/flambda2.0/types/flambda_type.ml \
   middle_end/flambda2.0/terms/flambda.ml \
   middle_end/flambda2.0/simplify/simplify.ml
 
@@ -1516,6 +1522,7 @@ partialclean::
            middle_end/flambda2.0/basic \
            middle_end/flambda2.0/from_lambda \
            middle_end/flambda2.0/inlining \
+           middle_end/flambda2.0/lifting \
            middle_end/flambda2.0/naming \
            middle_end/flambda2.0/parser \
            middle_end/flambda2.0/simplify \
@@ -1548,6 +1555,7 @@ depend: beforedepend
          middle_end/flambda2.0/basic \
          middle_end/flambda2.0/from_lambda \
          middle_end/flambda2.0/inlining \
+         middle_end/flambda2.0/lifting \
          middle_end/flambda2.0/naming \
          middle_end/flambda2.0/parser \
          middle_end/flambda2.0/simplify \

asmcomp/asmgen.ml

@@ -182,14 +182,15 @@ type middle_end2 =
      ppf_dump:Format.formatter
   -> prefixname:string
   -> backend:(module Flambda2_backend_intf.S)
-  -> size:int
   -> filename:string
   -> module_ident:Ident.t
+  -> module_block_size_in_words:int
   -> module_initializer:Lambda.lambda
-  -> Flambda_static.Program.t
+  -> Flambda_unit.t
 
-let compile_implementation2 ?toplevel ~backend ~filename ~prefixname ~size
-    ~module_ident ~module_initializer ~middle_end ~ppf_dump required_globals =
+let compile_implementation2 ?toplevel ~backend ~filename ~prefixname
+    ~size:module_block_size_in_words ~module_ident ~module_initializer
+    ~middle_end ~ppf_dump required_globals =
   let asmfile =
     if !keep_asm_file || !Emitaux.binary_backend_available
     then prefixname ^ ext_asm
@@ -199,10 +200,10 @@ let compile_implementation2 ?toplevel ~backend ~filename ~prefixname ~size
     (fun () ->
       Ident.Set.iter Compilenv.require_global required_globals;
       let translated_program =
-        (middle_end : middle_end2) ~backend ~size ~filename ~prefixname
-          ~ppf_dump ~module_ident ~module_initializer
+        (middle_end : middle_end2) ~backend ~module_block_size_in_words
+          ~filename ~prefixname ~ppf_dump ~module_ident ~module_initializer
       in
-      end_gen_implementation ?toplevel ~ppf_dump Un_cps.program
+      end_gen_implementation ?toplevel ~ppf_dump Un_cps.unit
         translated_program)
 
 let compile_implementation_flambda ?toplevel ~prefixname
@@ -216,7 +217,7 @@ let compile_implementation_flambda ?toplevel ~prefixname
     (fun () ->
       Ident.Set.iter Compilenv.require_global required_globals;
       end_gen_implementation ?toplevel ~ppf_dump
-        Un_cps.program program)
+        Un_cps.unit program)
 
 (* Error report *)
 

asmcomp/asmgen.mli

@@ -40,11 +40,11 @@ type middle_end2 =
      ppf_dump:Format.formatter
   -> prefixname:string
   -> backend:(module Flambda2_backend_intf.S)
-  -> size:int
   -> filename:string
   -> module_ident:Ident.t
+  -> module_block_size_in_words:int
   -> module_initializer:Lambda.lambda
-  -> Flambda_static.Program.t
+  -> Flambda_unit.t
 
 (** Compile an implementation from Lambda using the given middle end. *)
 val compile_implementation2
@@ -66,7 +66,7 @@ val compile_implementation_flambda
   -> prefixname:string
   -> ppf_dump:Format.formatter
   -> required_globals:Ident.Set.t
-  -> Flambda_static.Program.t
+  -> Flambda_unit.t
   -> unit
 
 val compile_phrase :

driver/optcompile.ml

@@ -31,18 +31,34 @@ let (|>>) (x, y) f = (x, f y)
 
 (** Native compilation backend for .ml files. *)
 
-(* XXX *)
 module Flambda2_backend = struct
-  let symbol_for_global' ?comp_unit id =
+  let symbol_for_module_block id =
+    assert (Ident.global id);
+    assert (not (Ident.is_predef id));
     let comp_unit =
-      match comp_unit with
-      | None -> Compilation_unit.get_current_exn ()
-      | Some comp_unit -> comp_unit
+      (* CR mshinwell: Get rid of this "caml" hack *)
+      Compilation_unit.create id
+        (Linkage_name.create ("caml" ^ Ident.name id))
     in
     Symbol.unsafe_create
       comp_unit
       (Linkage_name.create (Compilenv.symbol_for_global id))
 
+  let symbol_for_global' ?comp_unit id =
+    if Ident.global id && not (Ident.is_predef id) then
+      symbol_for_module_block id
+    else
+      let comp_unit =
+        match comp_unit with
+        | Some comp_unit -> comp_unit
+        | None ->
+          if Ident.is_predef id then Compilation_unit.predefined_exception ()
+          else Compilation_unit.get_current_exn ()
+      in
+      Symbol.unsafe_create
+        comp_unit
+        (Linkage_name.create (Compilenv.symbol_for_global id))
+
   let closure_symbol _ = failwith "Not yet implemented"
 
   let division_by_zero =
@@ -56,10 +72,15 @@ module Flambda2_backend = struct
       Predef.ident_invalid_argument
 
   let all_predefined_exception_symbols =
-    Symbol.Set.of_list [
-      division_by_zero;
-      invalid_argument;
-    ] (* CR mshinwell: and the rest... *)
+    Predef.all_predef_exns
+    |> List.map (fun ident ->
+      symbol_for_global' ~comp_unit:(Compilation_unit.predefined_exception ())
+        ident)
+    |> Symbol.Set.of_list
+
+  let () =
+    assert (Symbol.Set.mem division_by_zero all_predefined_exception_symbols);
+    assert (Symbol.Set.mem invalid_argument all_predefined_exception_symbols)
 
   let symbol_for_global' id : Symbol.t = symbol_for_global' id
 

flambdatest/mlexamples/let_symbol_order_atexit.ml

@@ -0,0 +1,11 @@
+type 'a ref = { mutable contents : 'a }
+external ref : 'a -> 'a ref = "%makemutable"
+external ( ! ) : 'a ref -> 'a = "%field0"
+let id () = ()
+external sys_exit : int -> 'a = "caml_sys_exit"
+let exit_function = ref id
+let do_at_exit () = (!exit_function) ()
+let _at_exit _f = ()
+let exit retcode =
+  do_at_exit ();
+  sys_exit retcode

flambdatest/mlexamples/let_symbol_order_atexit.mli

@@ -0,0 +1,31 @@
+(* val at_exit : (unit -> unit) -> unit *)
+
+val exit : int -> 'a
+val do_at_exit : unit -> unit
+(*
+
+(let
+  (id/7 = (function param/9 0a)
+   exit_function/11 = (makemutable 0 id/7)
+   do_at_exit/12 = (function param/14 (apply (field_mut 0 exit_function/11) 0a))
+   _at_exit/15 = (function _f/17 0a)
+   exit/18 = (function retcode/20[int] (seq (apply do_at_exit/12 0a) (caml_sys_exit retcode/20))))
+  (makeblock 0 exit/18 do_at_exit/12))
+
+*)
+
+
+(*
+
+val do_at_exit : unit -> unit
+val exit : int -> 'a
+
+(let
+  (id/7 = (function param/9 0a)
+   exit_function/11 = (makemutable 0 id/7)
+   do_at_exit/12 = (function param/14 (apply (field_mut 0 exit_function/11) 0a))
+   _at_exit/15 = (function _f/17 0a)
+   exit/18 = (function retcode/20[int] (seq (apply do_at_exit/12 0a) (caml_sys_exit retcode/20))))
+  (makeblock 0 do_at_exit/12 exit/18))
+
+*)

flambdatest/mlexamples/tests.ml

@@ -118,4 +118,4 @@ let foo3 arr f i =
 let f c m n x' y' =
   let x = if c < 0 then x' else x' + 10 in
   let y = if c < 0 then y' else y' + 20 in
-  x + y
+  x + y, 2L

flambdatest/mlexamples/tests0.ml

@@ -0,0 +1,12 @@
+type t =
+  | A
+  | B of int
+  | C of int
+
+let f () =
+  let x = A in
+  match x with
+  | A -> 0
+  | B _ -> 1
+  | C _ -> 2
+

flambdatest/mlexamples/tests10.ml

@@ -0,0 +1,3 @@
+(* needs -rectypes *)
+
+let rec f () = f, f

flambdatest/mlexamples/tests4.ml

@@ -52,6 +52,13 @@ let pr2162_1 z x y =
   float_of_int a -. b
 *)
 
+let pr2162_2_first z x y =
+  let a, b =
+    if z then (x * 2, y *. 3.)
+    else (x, y +. 0.)
+  in
+  float_of_int a -. b
+
 let pr2162_2 z x y =
   let a, b =
     if z then (x * 2, y *. 3.)