From 1624c8e7a05c5374ee3b9be9e221d6bfcbfcaf46 Mon Sep 17 00:00:00 2001 From: Pierre Chambart Date: Fri, 3 Jun 2016 11:03:50 +0200 Subject: [PATCH] Also remove the forced dependency dummy code hack for closure This also share the result type of transl_implementation_flambda and transl_store_implementation --- asmcomp/asmgen.ml | 3 ++- asmcomp/asmpackager.ml | 3 ++- bytecomp/lambda.ml | 6 ++++-- bytecomp/lambda.mli | 6 ++++-- bytecomp/translmod.ml | 22 ++++++---------------- bytecomp/translmod.mli | 8 +------- driver/optcompile.ml | 8 ++++---- toplevel/opttoploop.ml | 5 +++-- 8 files changed, 26 insertions(+), 35 deletions(-) diff --git a/asmcomp/asmgen.ml b/asmcomp/asmgen.ml index fb2640c43..020732dd6 100644 --- a/asmcomp/asmgen.ml +++ b/asmcomp/asmgen.ml @@ -247,7 +247,8 @@ let compile_implementation_gen ?toplevel ~source_provenance prefixname let compile_implementation_clambda ?toplevel ~source_provenance prefixname ppf (program:Lambda.program) = compile_implementation_gen ?toplevel ~source_provenance prefixname - ~required_globals:Ident.Set.empty ppf lambda_gen_implementation program + ~required_globals:program.Lambda.required_globals + ppf lambda_gen_implementation program let compile_implementation_flambda ?toplevel ~source_provenance prefixname ~required_globals ~backend ppf (program:Flambda.program) = diff --git a/asmcomp/asmpackager.ml b/asmcomp/asmpackager.ml index ecac45c77..0ef1257cb 100644 --- a/asmcomp/asmpackager.ml +++ b/asmcomp/asmpackager.ml @@ -117,7 +117,8 @@ let make_package_object ppf members targetobj targetname coercion Translmod.transl_store_package components (Ident.create_persistent targetname) coercion in Asmgen.compile_implementation_clambda ~source_provenance - prefixname ppf { Lambda.code; main_module_block_size; } + prefixname ppf { Lambda.code; main_module_block_size; + module_ident; required_globals = Ident.Set.empty } end; let objfiles = List.map diff --git a/bytecomp/lambda.ml b/bytecomp/lambda.ml index e583ac435..df783b4ab 100644 --- a/bytecomp/lambda.ml +++ b/bytecomp/lambda.ml @@ -265,8 +265,10 @@ and lambda_event_kind = | Lev_pseudo type program = - { code : lambda; - main_module_block_size : int; } + { module_ident : Ident.t; + main_module_block_size : int; + required_globals : Ident.Set.t; + code : lambda } let const_unit = Const_pointer 0 diff --git a/bytecomp/lambda.mli b/bytecomp/lambda.mli index f07644ddf..adf45b837 100644 --- a/bytecomp/lambda.mli +++ b/bytecomp/lambda.mli @@ -282,8 +282,10 @@ and lambda_event_kind = | Lev_pseudo type program = - { code : lambda; - main_module_block_size : int; } + { module_ident : Ident.t; + main_module_block_size : int; + required_globals : Ident.Set.t; + code : lambda } (* Lambda code for the Closure middle-end. The main module block size is required for preallocating the block *) diff --git a/bytecomp/translmod.ml b/bytecomp/translmod.ml index 5a4acef3c..fd53a151b 100644 --- a/bytecomp/translmod.ml +++ b/bytecomp/translmod.ml @@ -598,22 +598,8 @@ let wrap_required_globals required body = Location.none), expr)) required body -let wrap_globals ~flambda body = - let required = required_globals ~flambda body in - wrap_required_globals required body - (* Location.prerr_warning loc - (Warnings.Nonrequired_global (Ident.name (Path.head path), - "uses the primitive " ^ - Printtyp.string_of_path path))) *) - (* Compile an implementation *) -type implementation = - { module_ident : Ident.t; - main_module_block_size : int; - required_globals : Ident.Set.t; - code : lambda } - let transl_implementation_flambda module_name (str, cc) = reset_labels (); primitive_declarations := []; @@ -995,10 +981,14 @@ let transl_store_phrases module_name str = let transl_store_implementation module_name (str, restr) = let s = !transl_store_subst in transl_store_subst := Ident.empty; - let (i, r) = transl_store_gen module_name (str, restr) false in + let (i, code) = transl_store_gen module_name (str, restr) false in transl_store_subst := s; { Lambda.main_module_block_size = i; - code = wrap_globals ~flambda:false r; } + code; + (* module_ident is not used by closure, but this allow to share + the type with the flambda version *) + module_ident = Ident.create_persistent module_name; + required_globals = required_globals ~flambda:true code } (* Compile a toplevel phrase *) diff --git a/bytecomp/translmod.mli b/bytecomp/translmod.mli index e70bcb708..a6fb9a501 100644 --- a/bytecomp/translmod.mli +++ b/bytecomp/translmod.mli @@ -24,14 +24,8 @@ val transl_store_phrases: string -> structure -> int * lambda val transl_store_implementation: string -> structure * module_coercion -> Lambda.program -type implementation = - { module_ident : Ident.t; - main_module_block_size : int; - required_globals : Ident.Set.t; - code : lambda } - val transl_implementation_flambda: - string -> structure * module_coercion -> implementation + string -> structure * module_coercion -> Lambda.program val transl_toplevel_definition: structure -> lambda val transl_package: diff --git a/driver/optcompile.ml b/driver/optcompile.ml index 2f3976ed5..8f4275af4 100644 --- a/driver/optcompile.ml +++ b/driver/optcompile.ml @@ -94,7 +94,7 @@ let implementation ppf sourcefile outputprefix ~backend = ++ Timings.(time (Timings.Transl sourcefile) (Translmod.transl_implementation_flambda modulename)) ++ Timings.time (Timings.Generate sourcefile) - (fun { Translmod.module_ident; main_module_block_size; + (fun { Lambda.module_ident; main_module_block_size; required_globals; code } -> ((module_ident, main_module_block_size), code) +++ print_if ppf Clflags.dump_rawlambda Printlambda.lambda @@ -119,9 +119,9 @@ let implementation ppf sourcefile outputprefix ~backend = (Translmod.transl_store_implementation modulename) ++ print_if ppf Clflags.dump_rawlambda Printlambda.program ++ Timings.(time (Generate sourcefile)) - (fun { Lambda.code; main_module_block_size } -> - { Lambda.code = Simplif.simplify_lambda code; - main_module_block_size } + (fun program -> + { program with + Lambda.code = Simplif.simplify_lambda program.Lambda.code } ++ print_if ppf Clflags.dump_lambda Printlambda.program ++ Asmgen.compile_implementation_clambda ~source_provenance outputprefix ppf; diff --git a/toplevel/opttoploop.ml b/toplevel/opttoploop.ml index 3f9a9bb8d..82fd71f6a 100644 --- a/toplevel/opttoploop.ml +++ b/toplevel/opttoploop.ml @@ -222,7 +222,8 @@ let load_lambda ppf ~module_ident ~required_globals lam size = if not Config.flambda then Asmgen.compile_implementation_clambda ~source_provenance:Timings.Toplevel ~toplevel:need_symbol fn ppf - { Lambda.code=lam ; main_module_block_size=size } + { Lambda.code=lam ; main_module_block_size=size; + module_ident; required_globals } else Asmgen.compile_implementation_flambda ~source_provenance:Timings.Toplevel ~required_globals ~backend ~toplevel:need_symbol fn ppf @@ -306,7 +307,7 @@ let execute_phrase print_outcome ppf phr = Typecore.force_delayed_checks (); let module_ident, res, required_globals, size = if Config.flambda then - let { Translmod.module_ident; main_module_block_size = size; + let { Lambda.module_ident; main_module_block_size = size; required_globals; code = res } = Translmod.transl_implementation_flambda !phrase_name (str, Tcoerce_none)