[Git][ghc/ghc][wip/ghc-fat-interface] 2 commits: Fix -fno-code logic to determine which backend to use based on demand
Matthew Pickering (@mpickering)
gitlab at gitlab.haskell.org
Fri Aug 12 11:28:47 UTC 2022
Matthew Pickering pushed to branch wip/ghc-fat-interface at Glasgow Haskell Compiler / GHC
Commits:
531f63bd by Matthew Pickering at 2022-08-12T10:38:47+01:00
Fix -fno-code logic to determine which backend to use based on demand
- - - - -
dec02917 by Matthew Pickering at 2022-08-12T12:28:36+01:00
Fixes
- - - - -
29 changed files:
- compiler/GHC/CoreToIface.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Iface/Load.hs
- compiler/GHC/Iface/Recomp.hs
- compiler/GHC/IfaceToCore.hs
- compiler/GHC/Linker/Loader.hs
- compiler/GHC/Unit/Home/ModInfo.hs
- compiler/GHC/Unit/Module/FatIface.hs
- compiler/GHC/Unit/Module/ModIface.hs
- testsuite/tests/driver/T20300/T20300.stderr
- + testsuite/tests/driver/T20348/B.hs
- testsuite/tests/driver/T20348/Makefile
- testsuite/tests/driver/T20348/T20348.stdout
- testsuite/tests/driver/T20348/all.T
- testsuite/tests/driver/T20696/T20696.stderr
- + testsuite/tests/driver/fat-iface/FatQuote1.hs
- + testsuite/tests/driver/fat-iface/FatQuote2.hs
- + testsuite/tests/driver/fat-iface/FatTH1.hs
- + testsuite/tests/driver/fat-iface/FatTH2.hs
- + testsuite/tests/driver/fat-iface/FatTHTop.hs
- testsuite/tests/driver/fat-iface/all.T
- testsuite/tests/driver/fat-iface/fat008.stdout
- testsuite/tests/driver/fat-iface/fat012.stderr
- testsuite/tests/driver/fat-iface/fat013.stderr
- testsuite/tests/driver/fat-iface/fat014.stdout
- + testsuite/tests/driver/fat-iface/fat015.stderr
- testsuite/tests/driver/implicit-dyn-too/implicit-dyn-too.stdout
- testsuite/tests/ghci/T16670/Makefile
- testsuite/tests/ghci/T16670/T16670_th.stdout
Changes:
=====================================
compiler/GHC/CoreToIface.hs
=====================================
@@ -599,8 +599,10 @@ toIfaceTopBind b =
let top_bndr = toIfaceTopBndr b
rhs' = case top_bndr of
-- Use the existing unfolding for a global binder if we store that anyway.
+ -- See Note [Fat Interface: Sharing RHSs]
IfGblTopBndr {} -> if already_has_unfolding b then IfUseUnfoldingRhs else IfRhs (toIfaceExpr rhs)
- -- Local binders will have had unfoldings trimmed
+ -- Local binders will have had unfoldings trimmed so have
+ -- to serialise the whole RHS.
IfLclTopBndr {} -> IfRhs (toIfaceExpr rhs)
in (top_bndr, rhs')
@@ -750,4 +752,27 @@ slower by 8% overall (on #9872a-d, and T1969: the reason
is that these NOINLINE'd functions now can't be profitably inlined
outside of the hs-boot loop.
+Note [Fat Interface: Sharing RHSs]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+In order to avoid duplicating definitions for bindings which already have unfoldings
+we do some minor headstands to avoid serialising the RHS of a definition if it has
+*any* unfolding.
+
+* Only global things have unfoldings, because local things have had their unfoldings stripped.
+* For any global thing which has an unfolding, we just use that, and ignore if it's stable or so on.
+
+Using whatever unfolding means that you could end up with an unoptimised
+definition for something (if it has a stable unfolding) rather than an optimised
+version but without much further headstanding this seemed a good
+compromise until someone raises an issue.
+
+In order to implement this sharing:
+
+* When creating the interface, check the criteria above and don't serialise the RHS
+ if such a case.
+ See
+* When reading an interface, look at the realIdUnfolding, and then the unfoldingTemplate.
+ See `tc_iface_binding` for where this happens.
+
-}
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -1270,10 +1270,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.
@@ -1698,6 +1700,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
@@ -1723,7 +1731,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
@@ -1742,18 +1750,17 @@ 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))
- -- Setting --interactive sets -fprefer-byte-code so we use interpreterBackend
- -- when using -fno-code with --interactive
- let new_backend = if gopt Opt_UseBytecodeRatherThanObjects dflags
- then interpreterBackend
- else defaultBackendOf ms
+ 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 = new_backend}
+ , ms_hspp_opts = updOptLevel 0 $ new_dflags
}
-- Recursive call to catch the other cases
enable_code_gen (ModuleNode deps ms')
@@ -1761,13 +1768,13 @@ enableCodeGenWhen logger tmpfs staticLife dynLife unit_env mod_graph =
-- 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 ms -> do
+ | 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 ms -> do
+ | dynamic_too_enable enable_spec ms -> do
let ms' = ms
{ ms_hspp_opts = gopt_set (ms_hspp_opts ms) Opt_BuildDynamicToo
}
@@ -1790,36 +1797,35 @@ 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 ms =
+ bytecode_and_enable enable_spec ms =
-- In the situation where we **would** need to enable dynamic-too
- dynamic_too_enable ms
+ dynamic_too_enable enable_spec 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
- -- MP: This should be a property of the module which requests this dependency
- -- but I will assume it's global for now
- prefer_bytecode = gopt Opt_UseBytecodeRatherThanObjects lcl_dflags
+ prefer_bytecode = EnableByteCodeAndObject == enable_spec
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
- -- Don't enable dynamic-too if we're handling the situation by generating bytecode.
- && not (generate_both && prefer_bytecode)
+ && enable_object
where
lcl_dflags = ms_hspp_opts ms
internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)
dyn_too_enabled = gopt Opt_BuildDynamicToo lcl_dflags
isDynWay = hasWay (ways lcl_dflags) WayDyn
isProfWay = hasWay (ways lcl_dflags) WayProf
- prefer_bytecode = gopt Opt_UseBytecodeRatherThanObjects lcl_dflags
- generate_both = gopt Opt_ByteCodeAndObjectCode lcl_dflags
+ 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
@@ -1829,18 +1835,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
=====================================
compiler/GHC/Iface/Load.hs
=====================================
@@ -1128,7 +1128,7 @@ pprModIface unit_state iface at ModIface{ mi_final_exts = exts }
, vcat [ppr ver $$ nest 2 (ppr decl) | (ver,decl) <- mi_decls iface]
, case mi_extra_decls iface of
Nothing -> empty
- Just eds -> text "extra-decls"
+ Just eds -> text "extra decls:"
$$ nest 2 (vcat ([ppr bs | bs <- eds]))
, vcat (map ppr (mi_insts iface))
, vcat (map ppr (mi_fam_insts iface))
=====================================
compiler/GHC/Iface/Recomp.hs
=====================================
@@ -1201,6 +1201,7 @@ addFingerprints hsc_env iface0
sorted_decls = Map.elems $ Map.fromList $
[(getOccName d, e) | e@(_, d) <- decls_w_hashes]
+ -- This key is safe because mi_extra_decls contains tidied things.
getOcc (IfGblTopBndr b) = getOccName b
getOcc (IfLclTopBndr fs _ _ _) = mkVarOccFS fs
=====================================
compiler/GHC/IfaceToCore.hs
=====================================
@@ -922,6 +922,7 @@ tc_iface_bindings (IfaceRec bs) = do
rs <- mapM (\(b, rhs) -> (b,) <$> tc_iface_binding b rhs) bs
return (Rec rs)
+-- | See Note [Fat Interface: Sharing RHSs]
tc_iface_binding :: Id -> IfaceMaybeRhs -> IfL CoreExpr
tc_iface_binding i IfUseUnfoldingRhs = return (unfoldingTemplate $ realIdUnfolding i)
tc_iface_binding _ (IfRhs rhs) = tcIfaceExpr rhs
=====================================
compiler/GHC/Linker/Loader.hs
=====================================
@@ -841,8 +841,8 @@ getLinkDeps hsc_env pls replace_osuf span mods
while_linking_expr = text "while linking an interpreted expression"
- -- This one is a build-system bug
+ -- See Note [Using Byte Code rather than Object Code for Template Haskell]
homeModLinkable :: DynFlags -> HomeModInfo -> Maybe Linkable
homeModLinkable dflags hmi =
if gopt Opt_UseBytecodeRatherThanObjects dflags
@@ -899,6 +899,31 @@ getLinkDeps hsc_env pls replace_osuf span mods
adjust_ul _ l at LoadedBCOs{} = return l
adjust_ul _ (FI (FatIface _ mod _)) = pprPanic "Unhydrated fat interface" (ppr mod)
+{-
+Note [Using Byte Code rather than Object Code for Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+The `-fprefer-byte-code` flag allows a user to specify that they want to use
+byte code (if availble) rather than object code for home module dependenices
+when executing Template Haskell splices.
+
+Why might you want to use byte code rather than object code?
+
+* Producing object code is much slower than producing byte code (for example if you're using -fno-code)
+* Linking many large object files, which happens once per splice, is quite expensive. (#21700)
+
+So we allow the user to choose to use byte code rather than object files if they want to avoid these
+two pitfalls.
+
+When using `-fprefer-byte-code` you have to arrange to have the byte code availble.
+In normal --make mode it will not be produced unless you enable `-fbyte-code-and-object-code`.
+See Note [Home module build products] for some more information about that.
+
+The only other place where the flag is consulted is when enabling code generation
+with `-fno-code`, which does so to anticipate what decision we will make at the
+splice point about what we would prefer.
+
+-}
{- **********************************************************************
=====================================
compiler/GHC/Unit/Home/ModInfo.hs
=====================================
@@ -58,18 +58,15 @@ data HomeModInfo = HomeModInfo
, hm_linkable :: !HomeModLinkable
-- ^ The actual artifact we would like to link to access things in
- -- this module.
+ -- this module. See Note [Home module build products]
--
- -- 'hm_linkable' might be Nothing:
+ -- 'hm_linkable' might be empty:
--
-- 1. If this is an .hs-boot module
--
-- 2. Temporarily during compilation if we pruned away
-- the old linkable because it was out of date.
--
- -- After a complete compilation ('GHC.load'), all 'hm_linkable' fields
- -- in the 'HomePackageTable' will be @Just at .
- --
-- When re-linking a module ('GHC.Driver.Main.HscNoRecomp'), we construct the
-- 'HomeModInfo' by building a new 'ModDetails' from the old
-- 'ModIface' (only).
@@ -84,7 +81,7 @@ homeModInfoObject = homeMod_object . hm_linkable
emptyHomeModInfoLinkable :: HomeModLinkable
emptyHomeModInfoLinkable = HomeModLinkable Nothing Nothing
-
+-- See Note [Home module build products]
data HomeModLinkable = HomeModLinkable { homeMod_bytecode :: !(Maybe Linkable)
, homeMod_object :: !(Maybe Linkable) }
@@ -106,6 +103,29 @@ bytecodeAndObjects bc o =
assertPpr (not (isObjectLinkable bc) && isObjectLinkable o) (ppr bc $$ ppr o)
(HomeModLinkable (Just bc) (Just o))
+
+{- Note [Home module build products]
+
+When compiling a home module we can produce some combination of the following
+build products.
+
+1. A byte code linkable, for use with the byte code interpreter.
+2. An object file linkable, for linking a final executable or the byte code interpreter
+
+What we have produced is recorded in the `HomeModLinkable` type. In the case
+that these linkables are produced they are stored in the relevant field so that
+subsequent modules can retrieve and use them as necessary.
+
+* `-fbyte-code` will *only* produce a byte code linkable. This is the default in GHCi.
+* `-fobject-code` will *only* produce an object file linkable. This is the default in -c and --make mode.
+* `-fbyte-code-and-object-code` produces both a byte-code and object file linkable. So both fields are populated.
+
+Why would you want to produce both an object file and byte code linkable? If you
+also want to use `-fprefer-byte-code` then you should probably also use this
+flag to make sure that byte code is generated for your modules.
+
+-}
+
-- | Helps us find information about modules in the home package
type HomePackageTable = DModuleNameEnv HomeModInfo
-- Domain = modules in the home unit that have been fully compiled
=====================================
compiler/GHC/Unit/Module/FatIface.hs
=====================================
@@ -4,6 +4,56 @@ import GHC.Unit.Types (Module)
import GHC.Unit.Module.Location
import GHC.Iface.Syntax
+{-
+Note [Fat Interface Files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+A fat interface file contains everything needed in addition to the normal ModIface and ModDetails
+to restart compilation after typechecking to generate bytecode. The `fi_bindings` field
+is stored in the normal interface file and the other fields populated whilst loading
+the interface file.
+
+The lifecycle of a FatInterface typically proceeds as follows:
+
+1. The ModIface which contains mi_extra_decls is loaded from disk. A linkable is
+ created which contains a `FI <>` entry. This is an unhydrated fat interface which
+ is currently unsuitable for linking, but at the point it is loaded, the ModIface
+ hasn't been hydrated yet either so the FI constructor allows the delaying of converting
+ the FatInterface into a proper Linkable (if we ever do that). The FI constructor also
+ allows us to convert the FI into multiple different linkables if we so desired.
+
+2. `initFatIface` turns a FatIface into a proper BCO linkable. This step combines together
+ all the necessary information from a ModIface, ModDetails and FatIface in order to
+ create the linkable. The linkable created is a "LoadedBCOs" linkable, which
+ was introduced just for initFatIface, so that the bytecode can be generated lazilly.
+ Using the `BCOs` constructor directly here leads to the bytecode being forced
+ too eagerly.
+
+3. Then when bytecode is needed, the LoadedBCOs value is inspected and unpacked and
+ the linkable is used as before.
+
+The flag `-fwrite-fat-interface` determines whether the extra information is written
+to an interface file. The program which is written is the core bindings of the module
+after whatever simplification the user requested has been performed. So the bindings
+of the fat interface file agree with the optimisation level as reported by the interface
+file.
+
+Note [Size of Fat Interface Files]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+How much overhead does `-fwrite-fat-interface` add to a typical interface file?
+As an experiment I compiled the `Cabal` library and `ghc` library (Aug 22) with
+
+| Project | .hi | .hi (fat) | .o |
+| --------| ---- | --------- | -- |
+| ghc | 32M | 68M | 127M |
+| Cabal | 3.2M | 9.8M | 14M |
+
+So the interface files gained in size but the end result was still smaller than
+the object files.
+
+-}
+
data FatIface = FatIface { fi_bindings :: [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo]
, fi_module :: Module
, fi_mod_location :: ModLocation
=====================================
compiler/GHC/Unit/Module/ModIface.hs
=====================================
@@ -203,6 +203,7 @@ data ModIface_ (phase :: ModIfacePhase)
mi_extra_decls :: Maybe [IfaceBindingX IfaceMaybeRhs IfaceTopBndrInfo],
-- ^ Extra variable definitions which are **NOT** exposed but when
-- combined with mi_decls allows us to restart code generation.
+ -- See Note [Fat Interface Files] and Note [Fat Interface: Sharing RHSs]
mi_globals :: !(Maybe GlobalRdrEnv),
-- ^ Binds all the things defined at the top level in
=====================================
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 )
=====================================
testsuite/tests/driver/T20348/B.hs
=====================================
@@ -0,0 +1,4 @@
+{-# LANGUAGE TemplateHaskell #-}
+module B where
+
+import A
=====================================
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)
=====================================
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
=====================================
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, [])
=====================================
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 )
=====================================
testsuite/tests/driver/fat-iface/FatQuote1.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module FatQuote1 where
+
+import FatQuote ()
+
+import Language.Haskell.TH
+
+a :: Q Exp
+a = [| () |]
+
+
=====================================
testsuite/tests/driver/fat-iface/FatQuote2.hs
=====================================
@@ -0,0 +1,11 @@
+{-# LANGUAGE TemplateHaskellQuotes #-}
+module FatQuote2 where
+
+import FatQuote ()
+
+import Language.Haskell.TH
+
+a :: Q Exp
+a = [| () |]
+
+
=====================================
testsuite/tests/driver/fat-iface/FatTH1.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -fprefer-byte-code #-}
+module FatTH1 where
+
+import FatQuote1
+
+top = $(a)
=====================================
testsuite/tests/driver/fat-iface/FatTH2.hs
=====================================
@@ -0,0 +1,7 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC #-}
+module FatTH2 where
+
+import FatQuote2
+
+top = $(a)
=====================================
testsuite/tests/driver/fat-iface/FatTHTop.hs
=====================================
@@ -0,0 +1,4 @@
+module FatTHTop where
+
+import FatTH1
+import FatTH2
=====================================
testsuite/tests/driver/fat-iface/all.T
=====================================
@@ -14,5 +14,6 @@ test('fat012', [unless(ghc_dynamic(), skip), extra_files(['FatTH.hs', 'FatQuote.
test('fat013', [extra_files(['FatTH.hs', 'FatQuote.hs'])], multimod_compile, ['FatTH', '-fno-code -fprefer-byte-code'])
# When using interpreter should not produce objects
test('fat014', [extra_files(['FatTH.hs', 'FatQuote.hs'])], makefile_test, ['fat014'])
+test('fat015', [unless(ghc_dynamic(), skip), extra_files(['FatQuote.hs', 'FatQuote1.hs', 'FatQuote2.hs', 'FatTH1.hs', 'FatTH2.hs', 'FatTHTop.hs'])], multimod_compile, ['FatTHTop', '-fno-code -fwrite-interface'])
=====================================
testsuite/tests/driver/fat-iface/fat008.stdout
=====================================
@@ -1,3 +1,3 @@
[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted ) [Source file changed]
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o )
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o ) [Source file changed]
=====================================
testsuite/tests/driver/fat-iface/fat012.stderr
=====================================
@@ -1,2 +1,2 @@
[1 of 2] Compiling FatQuote ( FatQuote.hs, FatQuote.o, interpreted )
-[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, FatTH.o )
=====================================
testsuite/tests/driver/fat-iface/fat013.stderr
=====================================
@@ -1,2 +1,2 @@
[1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted )
-[2 of 2] Compiling FatTH ( FatTH.hs, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, nothing )
=====================================
testsuite/tests/driver/fat-iface/fat014.stdout
=====================================
@@ -1,3 +1,3 @@
[1 of 2] Compiling FatQuote ( FatQuote.hs, interpreted )
-[2 of 2] Compiling FatTH ( FatTH.hs, interpreted )
+[2 of 2] Compiling FatTH ( FatTH.hs, nothing )
Ok, two modules loaded.
=====================================
testsuite/tests/driver/fat-iface/fat015.stderr
=====================================
@@ -0,0 +1,6 @@
+[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, nothing )
+[5 of 6] Compiling FatTH2 ( FatTH2.hs, nothing )
+[6 of 6] Compiling FatTHTop ( FatTHTop.hs, nothing )
=====================================
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]
=====================================
testsuite/tests/ghci/T16670/Makefile
=====================================
@@ -20,5 +20,5 @@ T16670_th:
mkdir my-odir
echo ":load T16670_th.hs" | "$(TEST_HC)" $(TEST_HC_OPTS_INTERACTIVE) \
-v0 -fno-code -fno-prefer-byte-code -fwrite-interface -odir my-odir
- find . -name T16670_th.o
- test -f my-odir/T16670_th.o
+ find . -name TH.o
+ test -f my-odir/TH.o
=====================================
testsuite/tests/ghci/T16670/T16670_th.stdout
=====================================
@@ -1,2 +1,2 @@
~~~~~~~~ testing T16670_th
-./my-odir/T16670_th.o
+./my-odir/TH.o
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/943b6f7e90df8d99bb8430fb56bd6ee84cca972d...dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/943b6f7e90df8d99bb8430fb56bd6ee84cca972d...dec02917c0a6c57e5164b0f0b5f6fb1d9e5128d9
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20220812/d681b05c/attachment-0001.html>
More information about the ghc-commits
mailing list