Skip to content

Commit c656dc9

Browse files
stedolanstedolan
committed
Merge flambda-backend changes
2 parents 11b5424 + 23a7f73 commit c656dc9

26 files changed

Lines changed: 203 additions & 86 deletions

‎driver/compenv.ml‎

Lines changed: 16 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -469,6 +469,10 @@ let read_one_param ppf position name v =
469469
| Some pass -> set_save_ir_after pass true
470470
end
471471

472+
| "extension" -> Clflags.Extension.enable v
473+
| "disable-all-extensions" ->
474+
if check_bool ppf name v then Clflags.Extension.disable_all ()
475+
472476
| _ ->
473477
if !warnings_for_discarded_params &&
474478
not (List.mem name !can_discard) then begin
@@ -617,11 +621,13 @@ let c_object_of_filename name =
617621
Filename.chop_suffix (Filename.basename name) ".c" ^ Config.ext_obj
618622

619623
let process_action
620-
(ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action =
624+
(ppf, implementation, interface, ocaml_mod_ext, ocaml_lib_ext) action
625+
~keep_symbol_tables =
621626
let impl ~start_from name =
622627
readenv ppf (Before_compile name);
623628
let opref = output_prefix name in
624-
implementation ~start_from ~source_file:name ~output_prefix:opref;
629+
implementation ~start_from ~source_file:name ~output_prefix:opref
630+
~keep_symbol_tables;
625631
objfiles := (opref ^ ocaml_mod_ext) :: !objfiles
626632
in
627633
match action with
@@ -705,7 +711,14 @@ let process_deferred_actions env =
705711
| ProcessOtherFile name -> Filename.check_suffix name ".cmxa"
706712
| _ -> false) !deferred_actions then
707713
fatal "Option -a cannot be used with .cmxa input files.";
708-
List.iter (process_action env) (List.rev !deferred_actions);
714+
let compiling_multiple_impls =
715+
List.length (List.filter (function
716+
| ProcessImplementation _ -> true
717+
| _ -> false) !deferred_actions) > 1
718+
in
719+
let keep_symbol_tables = compiling_multiple_impls in
720+
List.iter (process_action env ~keep_symbol_tables)
721+
(List.rev !deferred_actions);
709722
output_name := final_output_name;
710723
stop_early :=
711724
!compile_only ||

‎driver/compenv.mli‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,8 @@ val intf : string -> unit
8282
val process_deferred_actions :
8383
Format.formatter *
8484
(start_from:Clflags.Compiler_pass.t ->
85-
source_file:string -> output_prefix:string -> unit) *
85+
source_file:string -> output_prefix:string ->
86+
keep_symbol_tables:bool -> unit) *
8687
(* compile implementation *)
8788
(source_file:string -> output_prefix:string -> unit) *
8889
(* compile interface *)

‎driver/compile.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,8 @@ let emit_bytecode i (bytecode, required_globals) =
5757
(Emitcode.to_file oc i.module_name cmofile ~required_globals);
5858
)
5959

60-
let implementation ~start_from ~source_file ~output_prefix =
60+
let implementation ~start_from ~source_file ~output_prefix
61+
~keep_symbol_tables:_ =
6162
let backend info typed =
6263
let bytecode = to_bytecode info typed in
6364
emit_bytecode info bytecode

‎driver/compile.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -19,7 +19,7 @@ val interface:
1919
source_file:string -> output_prefix:string -> unit
2020
val implementation:
2121
start_from:Clflags.Compiler_pass.t ->
22-
source_file:string -> output_prefix:string -> unit
22+
source_file:string -> output_prefix:string -> keep_symbol_tables:bool -> unit
2323

2424
(** {2 Internal functions} **)
2525

‎driver/main_args.ml‎

Lines changed: 16 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -716,11 +716,19 @@ let mk_dump_into_file f =
716716
;;
717717

718718
let mk_extension f =
719-
"-extension", Arg.String f, "<extension> Enable the extension"
719+
let available_extensions =
720+
Clflags.Extension.(List.map to_string all)
721+
in
722+
"-extension", Arg.Symbol (available_extensions, f),
723+
"<extension> Enable the extension (may be specified more than once)"
720724
;;
721725

722-
let mk_standard f =
723-
"-standard", Arg.Unit f, " Disable all default extensions"
726+
let mk_disable_all_extensions f =
727+
"-disable-all-extensions", Arg.Unit f,
728+
" Disable all extensions, wherever they are specified; this flag\n\
729+
\ overrides the -extension flag (whether specified before or after this\n\
730+
\ flag), disables any extensions that are enabled by default, and\n\
731+
\ ignores any extensions requested in OCAMLPARAM."
724732
;;
725733

726734
let mk_dparsetree f =
@@ -1031,7 +1039,7 @@ module type Compiler_options = sig
10311039
val _match_context_rows : int -> unit
10321040
val _dtimings : unit -> unit
10331041
val _dprofile : unit -> unit
1034-
val _standard : unit -> unit
1042+
val _disable_all_extensions : unit -> unit
10351043
val _dump_into_file : unit -> unit
10361044

10371045
val _args: string -> string array
@@ -1283,7 +1291,7 @@ struct
12831291
mk_dcamlprimc F._dcamlprimc;
12841292
mk_dtimings F._dtimings;
12851293
mk_dprofile F._dprofile;
1286-
mk_standard F._standard;
1294+
mk_disable_all_extensions F._disable_all_extensions;
12871295
mk_dump_into_file F._dump_into_file;
12881296
mk_extension F._extension;
12891297

@@ -1510,7 +1518,7 @@ struct
15101518
mk_dstartup F._dstartup;
15111519
mk_dtimings F._dtimings;
15121520
mk_dprofile F._dprofile;
1513-
mk_standard F._standard;
1521+
mk_disable_all_extensions F._disable_all_extensions;
15141522
mk_dump_into_file F._dump_into_file;
15151523
mk_dump_pass F._dump_pass;
15161524
mk_extension F._extension;
@@ -1769,7 +1777,7 @@ module Default = struct
17691777
let _unsafe = set unsafe
17701778
let _warn_error s = Warnings.parse_options true s
17711779
let _warn_help = Warnings.help_warnings
1772-
let _extension s = add_extension s
1780+
let _extension s = Extension.enable s
17731781
end
17741782

17751783
module Native = struct
@@ -1884,7 +1892,7 @@ module Default = struct
18841892
let _config_var = Misc.show_config_variable_and_exit
18851893
let _dprofile () = profile_columns := Profile.all_columns
18861894
let _dtimings () = profile_columns := [`Time]
1887-
let _standard = set_standard
1895+
let _disable_all_extensions = Extension.disable_all
18881896
let _dump_into_file = set dump_into_file
18891897
let _for_pack s = for_package := (Some s)
18901898
let _g = set debug

‎driver/main_args.mli‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -119,7 +119,7 @@ module type Compiler_options = sig
119119
val _match_context_rows : int -> unit
120120
val _dtimings : unit -> unit
121121
val _dprofile : unit -> unit
122-
val _standard : unit -> unit
122+
val _disable_all_extensions : unit -> unit
123123
val _dump_into_file : unit -> unit
124124

125125
val _args: string -> string array

‎driver/optcompile.ml‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -87,7 +87,8 @@ let emit i =
8787
Compilenv.reset ?packname:!Clflags.for_package i.module_name;
8888
Asmgen.compile_implementation_linear i.output_prefix ~progname:i.source_file
8989

90-
let implementation ~backend ~start_from ~source_file ~output_prefix =
90+
let implementation ~backend ~start_from ~source_file
91+
~output_prefix ~keep_symbol_tables:_ =
9192
let backend info typed =
9293
Compilenv.reset ?packname:!Clflags.for_package info.module_name;
9394
if Config.flambda

‎driver/optcompile.mli‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -20,7 +20,8 @@ val interface: source_file:string -> output_prefix:string -> unit
2020
val implementation:
2121
backend:(module Backend_intf.S)
2222
-> start_from:Clflags.Compiler_pass.t
23-
-> source_file:string -> output_prefix:string -> unit
23+
-> source_file:string -> output_prefix:string -> keep_symbol_tables:bool
24+
-> unit
2425

2526
(** {2 Internal functions} **)
2627

‎lambda/debuginfo.ml‎

Lines changed: 22 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -24,11 +24,17 @@ module Scoped_location = struct
2424
| Sc_module_definition
2525
| Sc_class_definition
2626
| Sc_method_definition
27+
| Sc_partial_or_eta_wrapper
28+
| Sc_lazy
2729

2830
type scopes =
2931
| Empty
3032
| Cons of {item: scope_item; str: string; str_fun: string}
3133

34+
let str = function
35+
| Empty -> ""
36+
| Cons r -> r.str
37+
3238
let str_fun = function
3339
| Empty -> "(fun)"
3440
| Cons r -> r.str_fun
@@ -45,8 +51,12 @@ module Scoped_location = struct
4551
| 'a'..'z' | 'A'..'Z' | '_' | '0'..'9' -> s
4652
| _ -> "(" ^ s ^ ")"
4753

48-
let dot ?(sep = ".") scopes s =
49-
let s = add_parens_if_symbolic s in
54+
let dot ?(sep = ".") ?no_parens scopes s =
55+
let s =
56+
match no_parens with
57+
| None -> add_parens_if_symbolic s
58+
| Some () -> s
59+
in
5060
match scopes with
5161
| Empty -> s
5262
| Cons {str; _} -> str ^ sep ^ s
@@ -72,6 +82,11 @@ module Scoped_location = struct
7282
in
7383
cons Sc_method_definition str
7484

85+
let enter_lazy ~scopes = cons Sc_lazy (str scopes)
86+
87+
let enter_partial_or_eta_wrapper ~scopes =
88+
cons Sc_partial_or_eta_wrapper (dot ~no_parens:() scopes "(partial)")
89+
7590
let string_of_scopes = function
7691
| Empty -> "<unknown>"
7792
| Cons {str; _} -> str
@@ -106,6 +121,11 @@ module Scoped_location = struct
106121
let string_of_scoped_location = function
107122
| Loc_unknown -> "??"
108123
| Loc_known { loc = _; scopes } -> string_of_scopes scopes
124+
125+
let map_scopes f t =
126+
match t with
127+
| Loc_unknown -> Loc_unknown
128+
| Loc_known { loc; scopes } -> Loc_known { loc; scopes = f ~scopes }
109129
end
110130

111131
type item = {

‎lambda/debuginfo.mli‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -23,6 +23,8 @@ module Scoped_location : sig
2323
val enter_module_definition : scopes:scopes -> Ident.t -> scopes
2424
val enter_class_definition : scopes:scopes -> Ident.t -> scopes
2525
val enter_method_definition : scopes:scopes -> Asttypes.label -> scopes
26+
val enter_lazy : scopes:scopes -> scopes
27+
val enter_partial_or_eta_wrapper : scopes:scopes -> scopes
2628

2729
type t =
2830
| Loc_unknown
@@ -33,6 +35,8 @@ module Scoped_location : sig
3335
val of_location : scopes:scopes -> Location.t -> t
3436
val to_location : t -> Location.t
3537
val string_of_scoped_location : t -> string
38+
39+
val map_scopes : (scopes:scopes -> scopes) -> t -> t
3640
end
3741

3842
type item = private {

0 commit comments

Comments
 (0)