Merge flambda-backend changes

Author: stedolan

driver/compenv.ml

@@ -469,6 +469,10 @@ let read_one_param ppf position name v =
       | Some pass -> set_save_ir_after pass true
     end
 
+  | "extension" -> Clflags.Extension.enable v
+  | "disable-all-extensions" ->
+    if check_bool ppf name v then Clflags.Extension.disable_all ()
+
   | _ ->
     if !warnings_for_discarded_params &&
        not (List.mem name !can_discard) then begin
@@ -617,11 +621,13 @@ let c_object_of_filename name =
   Filename.chop_suffix (Filename.basename name) ".c" ^ Config.ext_obj
 
 let process_action
-    (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
+    (ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action
+    ~keep_symbol_tables =
   let impl ~start_from name =
     readenv ppf (Before_compile name);
     let opref = output_prefix name in
-    implementation ~start_from ~source_file:name ~output_prefix:opref;
+    implementation ~start_from ~source_file:name ~output_prefix:opref
+      ~keep_symbol_tables;
     objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
   in
   match action with
@@ -705,7 +711,14 @@ let process_deferred_actions env =
       | ProcessOtherFile name -> Filename.check_suffix name ".cmxa"
       | _ -> false) !deferred_actions then
     fatal "Option -a cannot be used with .cmxa input files.";
-  List.iter (process_action env) (List.rev !deferred_actions);
+  let compiling_multiple_impls =
+    List.length (List.filter (function
+        | ProcessImplementation _ -> true
+        | _ -> false) !deferred_actions) > 1
+  in
+  let keep_symbol_tables = compiling_multiple_impls in
+  List.iter (process_action env ~keep_symbol_tables)
+    (List.rev !deferred_actions);
   output_name := final_output_name;
   stop_early :=
     !compile_only ||

driver/compenv.mli

@@ -82,7 +82,8 @@ val intf : string -> unit
 val process_deferred_actions :
   Format.formatter *
   (start_from:Clflags.Compiler_pass.t ->
-   source_file:string -> output_prefix:string -> unit) *
+   source_file:string -> output_prefix:string ->
+   keep_symbol_tables:bool -> unit) *
   (* compile implementation *)
   (source_file:string -> output_prefix:string -> unit) *
   (* compile interface *)

driver/compile.ml

@@ -57,7 +57,8 @@ let emit_bytecode i (bytecode, required_globals) =
          (Emitcode.to_file oc i.module_name cmofile ~required_globals);
     )
 
-let implementation ~start_from ~source_file ~output_prefix =
+let implementation ~start_from ~source_file ~output_prefix
+    ~keep_symbol_tables:_ =
   let backend info typed =
     let bytecode = to_bytecode info typed in
     emit_bytecode info bytecode

driver/compile.mli

@@ -19,7 +19,7 @@ val interface:
   source_file:string -> output_prefix:string -> unit
 val implementation:
   start_from:Clflags.Compiler_pass.t ->
-  source_file:string -> output_prefix:string -> unit
+  source_file:string -> output_prefix:string -> keep_symbol_tables:bool -> unit
 
 (** {2 Internal functions} **)
 

driver/main_args.ml

@@ -716,11 +716,19 @@ let mk_dump_into_file f =
 ;;
 
 let mk_extension f =
-  "-extension", Arg.String f, "<extension> Enable the extension"
+  let available_extensions =
+    Clflags.Extension.(List.map to_string all)
+  in
+  "-extension", Arg.Symbol (available_extensions, f),
+  "<extension>  Enable the extension (may be specified more than once)"
 ;;
 
-let mk_standard f =
-  "-standard", Arg.Unit f, " Disable all default extensions"
+let mk_disable_all_extensions f =
+  "-disable-all-extensions", Arg.Unit f,
+  " Disable all extensions, wherever they are specified; this flag\n\
+  \    overrides the -extension flag (whether specified before or after this\n\
+  \    flag), disables any extensions that are enabled by default, and\n\
+  \    ignores any extensions requested in OCAMLPARAM."
 ;;
 
 let mk_dparsetree f =
@@ -1031,7 +1039,7 @@ module type Compiler_options = sig
   val _match_context_rows : int -> unit
   val _dtimings : unit -> unit
   val _dprofile : unit -> unit
-  val _standard : unit -> unit
+  val _disable_all_extensions : unit -> unit
   val _dump_into_file : unit -> unit
 
   val _args: string -> string array
@@ -1283,7 +1291,7 @@ struct
     mk_dcamlprimc F._dcamlprimc;
     mk_dtimings F._dtimings;
     mk_dprofile F._dprofile;
-    mk_standard F._standard;
+    mk_disable_all_extensions F._disable_all_extensions;
     mk_dump_into_file F._dump_into_file;
     mk_extension F._extension;
 
@@ -1510,7 +1518,7 @@ struct
     mk_dstartup F._dstartup;
     mk_dtimings F._dtimings;
     mk_dprofile F._dprofile;
-    mk_standard F._standard;
+    mk_disable_all_extensions F._disable_all_extensions;
     mk_dump_into_file F._dump_into_file;
     mk_dump_pass F._dump_pass;
     mk_extension F._extension;
@@ -1769,7 +1777,7 @@ module Default = struct
     let _unsafe = set unsafe
     let _warn_error s = Warnings.parse_options true s
     let _warn_help = Warnings.help_warnings
-    let _extension s = add_extension s
+    let _extension s = Extension.enable s
   end
 
   module Native = struct
@@ -1884,7 +1892,7 @@ module Default = struct
     let _config_var = Misc.show_config_variable_and_exit
     let _dprofile () = profile_columns := Profile.all_columns
     let _dtimings () = profile_columns := [`Time]
-    let _standard = set_standard
+    let _disable_all_extensions = Extension.disable_all
     let _dump_into_file = set dump_into_file
     let _for_pack s = for_package := (Some s)
     let _g = set debug

driver/main_args.mli

@@ -119,7 +119,7 @@ module type Compiler_options = sig
   val _match_context_rows : int -> unit
   val _dtimings : unit -> unit
   val _dprofile : unit -> unit
-  val _standard : unit -> unit
+  val _disable_all_extensions : unit -> unit
   val _dump_into_file : unit -> unit
 
   val _args: string -> string array

driver/optcompile.ml

@@ -87,7 +87,8 @@ let emit i =
   Compilenv.reset ?packname:!Clflags.for_package i.module_name;
   Asmgen.compile_implementation_linear i.output_prefix ~progname:i.source_file
 
-let implementation ~backend ~start_from ~source_file ~output_prefix =
+let implementation ~backend ~start_from ~source_file
+    ~output_prefix ~keep_symbol_tables:_ =
   let backend info typed =
     Compilenv.reset ?packname:!Clflags.for_package info.module_name;
     if Config.flambda

driver/optcompile.mli

@@ -20,7 +20,8 @@ val interface: source_file:string -> output_prefix:string -> unit
 val implementation:
    backend:(module Backend_intf.S)
    -> start_from:Clflags.Compiler_pass.t
-   -> source_file:string -> output_prefix:string -> unit
+   -> source_file:string -> output_prefix:string -> keep_symbol_tables:bool
+   -> unit
 
 (** {2 Internal functions} **)
 

lambda/debuginfo.ml

@@ -24,11 +24,17 @@ module Scoped_location = struct
     | Sc_module_definition
     | Sc_class_definition
     | Sc_method_definition
+    | Sc_partial_or_eta_wrapper
+    | Sc_lazy
 
   type scopes =
     | Empty
     | Cons of {item: scope_item; str: string; str_fun: string}
 
+  let str = function
+    | Empty -> ""
+    | Cons r -> r.str
+
   let str_fun = function
     | Empty -> "(fun)"
     | Cons r -> r.str_fun
@@ -45,8 +51,12 @@ module Scoped_location = struct
        | 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> s
        | _ -> "(" ^ s ^ ")"
 
-  let dot ?(sep = ".") scopes s =
-    let s = add_parens_if_symbolic s in
+  let dot ?(sep = ".") ?no_parens scopes s =
+    let s =
+      match no_parens with
+      | None -> add_parens_if_symbolic s
+      | Some () -> s
+    in
     match scopes with
     | Empty -> s
     | Cons {str; _} -> str ^ sep ^ s
@@ -72,6 +82,11 @@ module Scoped_location = struct
     in
     cons Sc_method_definition str
 
+  let enter_lazy ~scopes = cons Sc_lazy (str scopes)
+
+  let enter_partial_or_eta_wrapper ~scopes =
+    cons Sc_partial_or_eta_wrapper (dot ~no_parens:() scopes "(partial)")
+
   let string_of_scopes = function
     | Empty -> "<unknown>"
     | Cons {str; _} -> str
@@ -106,6 +121,11 @@ module Scoped_location = struct
   let string_of_scoped_location = function
     | Loc_unknown -> "??"
     | Loc_known { loc = _; scopes } -> string_of_scopes scopes
+
+  let map_scopes f t =
+    match t with
+    | Loc_unknown -> Loc_unknown
+    | Loc_known { loc; scopes } -> Loc_known { loc; scopes = f ~scopes }
 end
 
 type item = {

lambda/debuginfo.mli

@@ -23,6 +23,8 @@ module Scoped_location : sig
   val enter_module_definition : scopes:scopes -> Ident.t -> scopes
   val enter_class_definition : scopes:scopes -> Ident.t -> scopes
   val enter_method_definition : scopes:scopes -> Asttypes.label -> scopes
+  val enter_lazy : scopes:scopes -> scopes
+  val enter_partial_or_eta_wrapper : scopes:scopes -> scopes
 
   type t =
     | Loc_unknown
@@ -33,6 +35,8 @@ module Scoped_location : sig
   val of_location : scopes:scopes -> Location.t -> t
   val to_location : t -> Location.t
   val string_of_scoped_location : t -> string
+
+  val map_scopes : (scopes:scopes -> scopes) -> t -> t
 end
 
 type item = private {