diff options
Diffstat (limited to 'compiler')
| -rw-r--r-- | compiler/GHC/Driver/Make.hs | 105 |
1 files changed, 87 insertions, 18 deletions
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs index 93681eba11..8f8f644cdb 100644 --- a/compiler/GHC/Driver/Make.hs +++ b/compiler/GHC/Driver/Make.hs @@ -1328,10 +1328,12 @@ during the downsweep we patch the DynFlags in the ModSummary of any home module that is imported by a module that uses template haskell, to generate object code. -The flavour of generated object code is chosen by defaultObjectTarget for the -target platform. It would likely be faster to generate bytecode, but this is not -supported on all platforms(?Please Confirm?), and does not support the entirety -of GHC haskell. See #1257. +The flavour of the generated code depends on whether `-fprefer-byte-code` is enabled +or not in the module which needs the code generation. If the module requires byte-code then +dependencies will generate byte-code, otherwise they will generate object files. +In the case where some modules require byte-code and some object files, both are +generated by enabling `-fbyte-code-and-object-code`, the test "fat015" tests these +configurations. The object files (and interface files if -fwrite-interface is disabled) produced for template haskell are written to temporary files. @@ -1756,6 +1758,12 @@ enableCodeGenForTH enableCodeGenForTH logger tmpfs unit_env = enableCodeGenWhen logger tmpfs TFL_CurrentModule TFL_GhcSession unit_env + +data CodeGenEnable = EnableByteCode | EnableObject | EnableByteCodeAndObject deriving (Eq, Show, Ord) + +instance Outputable CodeGenEnable where + ppr = text . show + -- | Helper used to implement 'enableCodeGenForTH'. -- In particular, this enables -- unoptimized code generation for all modules that meet some @@ -1781,7 +1789,7 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = , ms_hsc_src = HsSrcFile , ms_hspp_opts = dflags } <- ms - , mkNodeKey n `Set.member` needs_codegen_set = + , Just enable_spec <- mkNodeKey n `Map.lookup` needs_codegen_map = if | nocode_enable ms -> do let new_temp_file suf dynsuf = do tn <- newTempName logger tmpfs (tmpDir dflags) staticLife suf @@ -1800,17 +1808,31 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = , (ml_obj_file ms_location, ml_dyn_obj_file ms_location)) else (,) <$> (new_temp_file (hiSuf_ dflags) (dynHiSuf_ dflags)) <*> (new_temp_file (objectSuf_ dflags) (dynObjectSuf_ dflags)) + let new_dflags = case enable_spec of + EnableByteCode -> dflags { backend = interpreterBackend } + EnableObject -> dflags { backend = defaultBackendOf ms } + EnableByteCodeAndObject -> (gopt_set dflags Opt_ByteCodeAndObjectCode) { backend = defaultBackendOf ms} let ms' = ms { ms_location = ms_location { ml_hi_file = hi_file , ml_obj_file = o_file , ml_dyn_hi_file = dyn_hi_file , ml_dyn_obj_file = dyn_o_file } - , ms_hspp_opts = updOptLevel 0 $ dflags {backend = defaultBackendOf ms} + , ms_hspp_opts = updOptLevel 0 $ new_dflags } -- Recursive call to catch the other cases enable_code_gen (ModuleNode deps ms') - | dynamic_too_enable ms -> do + + -- If -fprefer-byte-code then satisfy dependency by enabling bytecode (if normal object not enough) + -- we only get to this case if the default backend is already generating object files, but we need dynamic + -- objects + | bytecode_and_enable enable_spec ms -> do + let ms' = ms + { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_ByteCodeAndObjectCode + } + -- Recursive call to catch the other cases + enable_code_gen (ModuleNode deps ms') + | dynamic_too_enable enable_spec ms -> do let ms' = ms { ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo } @@ -1833,18 +1855,40 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = -- can't compile anything anyway! See #16219. isHomeUnitDefinite (ue_unitHomeUnit (ms_unitid ms) unit_env) + bytecode_and_enable enable_spec ms = + -- In the situation where we **would** need to enable dynamic-too + -- IF we had decided we needed objects + dynamic_too_enable EnableObject ms + -- but we prefer to use bytecode rather than objects + && prefer_bytecode + -- and we haven't already turned it on + && not generate_both + where + lcl_dflags = ms_hspp_opts ms + prefer_bytecode = case enable_spec of + EnableByteCodeAndObject -> True + EnableByteCode -> True + EnableObject -> False + + generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags + -- #8180 - when using TemplateHaskell, switch on -dynamic-too so -- the linker can correctly load the object files. This isn't necessary -- when using -fexternal-interpreter. - dynamic_too_enable ms + dynamic_too_enable enable_spec ms = hostIsDynamic && internalInterpreter && not isDynWay && not isProfWay && not dyn_too_enabled + && enable_object where lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - dyn_too_enabled = (gopt Opt_BuildDynamicToo lcl_dflags) + dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags isDynWay = hasWay (ways lcl_dflags) WayDyn isProfWay = hasWay (ways lcl_dflags) WayProf + enable_object = case enable_spec of + EnableByteCode -> False + EnableByteCodeAndObject -> True + EnableObject -> True -- #16331 - when no "internal interpreter" is available but we -- need to process some TemplateHaskell or QuasiQuotes, we automatically @@ -1854,18 +1898,43 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph = lcl_dflags = ms_hspp_opts ms internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags) - - - (mg, lookup_node) = moduleGraphNodes False mod_graph - needs_codegen_set = Set.fromList $ map (mkNodeKey . node_payload) $ reachablesG mg (map (expectJust "needs_th" . lookup_node) has_th_set) + mk_needed_set roots = Set.fromList $ map (mkNodeKey . node_payload) $ reachablesG mg (map (expectJust "needs_th" . lookup_node) roots) + + needs_obj_set, needs_bc_set :: Set.Set NodeKey + needs_obj_set = mk_needed_set need_obj_set + + needs_bc_set = mk_needed_set need_bc_set + + -- A map which tells us how to enable code generation for a NodeKey + needs_codegen_map :: Map.Map NodeKey CodeGenEnable + needs_codegen_map = + -- Another option here would be to just produce object code, rather than both object and + -- byte code + Map.unionWith (\_ _ -> EnableByteCodeAndObject) + (Map.fromList $ [(m, EnableObject) | m <- Set.toList needs_obj_set]) + (Map.fromList $ [(m, EnableByteCode) | m <- Set.toList needs_bc_set]) + + -- The direct dependencies of modules which require object code + need_obj_set = + concat + -- Note we don't need object code for a module if it uses TemplateHaskell itself. Only + -- it's dependencies. + [ deps + | (ModuleNode deps ms) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , not (gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms)) + ] - has_th_set = - [ mkNodeKey mn - | mn@(ModuleNode _ ms) <- mod_graph - , isTemplateHaskellOrQQNonBoot ms - ] + -- The direct dependencies of modules which require byte code + need_bc_set = + concat + [ deps + | (ModuleNode deps ms) <- mod_graph + , isTemplateHaskellOrQQNonBoot ms + , gopt Opt_UseBytecodeRatherThanObjects (ms_hspp_opts ms) + ] -- | Populate the Downsweep cache with the root modules. mkRootMap |