summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Driver/Make.hs105
-rw-r--r--docs/users_guide/phases.rst5
-rw-r--r--testsuite/tests/driver/T20300/T20300.stderr2
-rw-r--r--testsuite/tests/driver/T20348/B.hs4
-rw-r--r--testsuite/tests/driver/T20348/Makefile2
-rw-r--r--testsuite/tests/driver/T20348/T20348.stdout3
-rw-r--r--testsuite/tests/driver/T20348/all.T2
-rw-r--r--testsuite/tests/driver/T20696/T20696.stderr2
-rw-r--r--testsuite/tests/driver/fat-iface/fat008.stdout6
-rw-r--r--testsuite/tests/driver/fat-iface/fat011.stderr4
-rw-r--r--testsuite/tests/driver/fat-iface/fat012.stderr4
-rw-r--r--testsuite/tests/driver/fat-iface/fat013.stderr4
-rw-r--r--testsuite/tests/driver/fat-iface/fat014.stdout4
-rw-r--r--testsuite/tests/driver/fat-iface/fat015.stderr8
-rw-r--r--testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout4
15 files changed, 119 insertions, 40 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
diff --git a/docs/users_guide/phases.rst b/docs/users_guide/phases.rst
index be3ca70bf8..3a1996bc20 100644
--- a/docs/users_guide/phases.rst
+++ b/docs/users_guide/phases.rst
@@ -625,6 +625,11 @@ Options affecting code generation
Omit code generation (and all later phases) altogether. This is
useful if you're only interested in type checking code.
+ If a module contains a Template Haskell splice then in ``--make`` mode, code
+ generation will be automatically turned on for all dependencies. By default
+ object files are generated but if ghc-flag:`-fprefer-byte-code` is enable then
+ byte-code will be generated instead.
+
.. ghc-flag:: -fwrite-interface
:shortdesc: Always write interface files
:type: dynamic
diff --git a/testsuite/tests/driver/T20300/T20300.stderr b/testsuite/tests/driver/T20300/T20300.stderr
index 0698d9bf0e..0687f420dd 100644
--- a/testsuite/tests/driver/T20300/T20300.stderr
+++ b/testsuite/tests/driver/T20300/T20300.stderr
@@ -1,4 +1,4 @@
[1 of 4] Compiling T[boot] ( T.hs-boot, nothing )
[2 of 4] Compiling T ( T.hs, nothing )
-[3 of 4] Compiling S ( S.hs, S.o, S.dyn_o )
+[3 of 4] Compiling S ( S.hs, nothing )
[4 of 4] Compiling Top ( Top.hs, nothing )
diff --git a/testsuite/tests/driver/T20348/B.hs b/testsuite/tests/driver/T20348/B.hs
new file mode 100644
index 0000000000..4a022335de
--- /dev/null
+++ b/testsuite/tests/driver/T20348/B.hs
@@ -0,0 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
+module B where
+
+import A
diff --git a/testsuite/tests/driver/T20348/Makefile b/testsuite/tests/driver/T20348/Makefile
index ba1edd021d..5b78c12bf5 100644
--- a/testsuite/tests/driver/T20348/Makefile
+++ b/testsuite/tests/driver/T20348/Makefile
@@ -15,7 +15,7 @@ clean:
T20348: clean
# First run: should produce .hi, .o, .dyn_hi, .dyn_o files.
echo 'first run'
- '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface A.hs
+ '$(TEST_HC)' $(TEST_HC_OPTS) -fno-code -fwrite-interface B.hs
$(call checkExists,A.hi)
$(call checkExists,A.o)
$(call checkExists,A.dyn_hi)
diff --git a/testsuite/tests/driver/T20348/T20348.stdout b/testsuite/tests/driver/T20348/T20348.stdout
index 1763145c31..02f97c659b 100644
--- a/testsuite/tests/driver/T20348/T20348.stdout
+++ b/testsuite/tests/driver/T20348/T20348.stdout
@@ -1,3 +1,4 @@
first run
-[1 of 1] Compiling A ( A.hs, A.o, A.dyn_o )
+[1 of 2] Compiling A ( A.hs, A.o, A.dyn_o )
+[2 of 2] Compiling B ( B.hs, nothing )
second run
diff --git a/testsuite/tests/driver/T20348/all.T b/testsuite/tests/driver/T20348/all.T
index ce8f124d8a..969c436210 100644
--- a/testsuite/tests/driver/T20348/all.T
+++ b/testsuite/tests/driver/T20348/all.T
@@ -1,6 +1,6 @@
# N.B. this package requires a dynamically-linked ghc-bin, since it assumes
# that TH evaluation will build dynamic objects.
-test('T20348', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
+test('T20348', [extra_files(['A.hs', 'B.hs']), unless(have_dynamic(), skip)], makefile_test, [])
test('T20348A', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
test('T20348B', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
test('T20348C', [extra_files(['A.hs']), unless(have_dynamic(), skip)], makefile_test, [])
diff --git a/testsuite/tests/driver/T20696/T20696.stderr b/testsuite/tests/driver/T20696/T20696.stderr
index de9a537caf..54d5ad5bdd 100644
--- a/testsuite/tests/driver/T20696/T20696.stderr
+++ b/testsuite/tests/driver/T20696/T20696.stderr
@@ -1,3 +1,3 @@
[1 of 3] Compiling C ( C.hs, C.o, C.dyn_o )
-[2 of 3] Compiling B ( B.hs, B.o, B.dyn_o )
+[2 of 3] Compiling B ( B.hs, B.o )
[3 of 3] Compiling A ( A.hs, A.o )
diff --git a/testsuite/tests/driver/fat-iface/fat008.stdout b/testsuite/tests/driver/fat-iface/fat008.stdout
index 8841ce10b2..0132be4e53 100644
--- a/testsuite/tests/driver/fat-iface/fat008.stdout
+++ b/testsuite/tests/driver/fat-iface/fat008.stdout
@@ -1,3 +1,3 @@
-[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, FatTH.dyn_o )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, FatTH.dyn_o ) [Source file changed]
+[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o )
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o ) [Source file changed]
diff --git a/testsuite/tests/driver/fat-iface/fat011.stderr b/testsuite/tests/driver/fat-iface/fat011.stderr
index 71fe78f06a..0fe4749423 100644
--- a/testsuite/tests/driver/fat-iface/fat011.stderr
+++ b/testsuite/tests/driver/fat-iface/fat011.stderr
@@ -1,4 +1,4 @@
-[1 of 4] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o, interpreted )
-[2 of 4] Compiling FatTH ( FatTH.hs, FatTH.o, FatTH.dyn_o, interpreted )
+[1 of 4] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted )
+[2 of 4] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted )
[3 of 4] Compiling Main ( FatMain.hs, FatMain.o, interpreted )
[4 of 4] Linking FatMain
diff --git a/testsuite/tests/driver/fat-iface/fat012.stderr b/testsuite/tests/driver/fat-iface/fat012.stderr
index 95ac650ae4..57a6befc70 100644
--- a/testsuite/tests/driver/fat-iface/fat012.stderr
+++ b/testsuite/tests/driver/fat-iface/fat012.stderr
@@ -1,2 +1,2 @@
-[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, FatTH.dyn_o )
+[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o )
diff --git a/testsuite/tests/driver/fat-iface/fat013.stderr b/testsuite/tests/driver/fat-iface/fat013.stderr
index bf181cfc4a..2be5eddb9a 100644
--- a/testsuite/tests/driver/fat-iface/fat013.stderr
+++ b/testsuite/tests/driver/fat-iface/fat013.stderr
@@ -1,2 +1,2 @@
-[1 of 2] Compiling FatQuote ( FatQuote.hs, /run/user/1000/ghc1303986_0/ghc_2.o, /run/user/1000/ghc1303986_0/ghc_2.dyn_o )
-[2 of 2] Compiling FatTH ( FatTH.hs, /run/user/1000/ghc1303986_0/ghc_4.o, /run/user/1000/ghc1303986_0/ghc_4.dyn_o )
+[1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, nothing )
diff --git a/testsuite/tests/driver/fat-iface/fat014.stdout b/testsuite/tests/driver/fat-iface/fat014.stdout
index 52d0811a33..7bae3b3c03 100644
--- a/testsuite/tests/driver/fat-iface/fat014.stdout
+++ b/testsuite/tests/driver/fat-iface/fat014.stdout
@@ -1,3 +1,3 @@
-[1 of 2] Compiling FatQuote ( FatQuote.hs, /run/user/1000/ghc1304860_0/ghc_2.o )
-[2 of 2] Compiling FatTH ( FatTH.hs, /run/user/1000/ghc1304860_0/ghc_4.o )
+[1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, nothing )
Ok, two modules loaded.
diff --git a/testsuite/tests/driver/fat-iface/fat015.stderr b/testsuite/tests/driver/fat-iface/fat015.stderr
index ba51cd4ab0..8fb5918730 100644
--- a/testsuite/tests/driver/fat-iface/fat015.stderr
+++ b/testsuite/tests/driver/fat-iface/fat015.stderr
@@ -1,6 +1,6 @@
-[1 of 6] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o )
-[2 of 6] Compiling FatQuote1 ( FatQuote1.hs, FatQuote1.o, FatQuote1.dyn_o )
+[1 of 6] Compiling FatQuote ( FatQuote.hs, FatQuote.o, FatQuote.dyn_o, interpreted )
+[2 of 6] Compiling FatQuote1 ( FatQuote1.hs, interpreted )
[3 of 6] Compiling FatQuote2 ( FatQuote2.hs, FatQuote2.o, FatQuote2.dyn_o )
-[4 of 6] Compiling FatTH1 ( FatTH1.hs, FatTH1.o, FatTH1.dyn_o )
-[5 of 6] Compiling FatTH2 ( FatTH2.hs, FatTH2.o, FatTH2.dyn_o )
+[4 of 6] Compiling FatTH1 ( FatTH1.hs, nothing )
+[5 of 6] Compiling FatTH2 ( FatTH2.hs, nothing )
[6 of 6] Compiling FatTHTop ( FatTHTop.hs, nothing )
diff --git a/testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout b/testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout
index af7ea64403..d7546e6203 100644
--- a/testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout
+++ b/testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout
@@ -1,4 +1,4 @@
[1 of 2] Compiling QuasiExpr ( QuasiExpr.hs, QuasiExpr.o, QuasiExpr.dyn_o )
-[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, QuasiQuote.o, QuasiQuote.dyn_o )
+[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, nothing )
[1 of 2] Compiling QuasiExpr ( QuasiExpr.hs, QuasiExpr.o, QuasiExpr.dyn_o ) [Missing dynamic object file]
-[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, QuasiQuote.o, QuasiQuote.dyn_o ) [QuasiExpr[TH] changed]
+[2 of 2] Compiling QuasiQuote ( QuasiQuote.hs, nothing ) [QuasiExpr[TH] changed]
View Lorry Controller Status