[Git][ghc/ghc][master] Compile modules with `-fobject-code` enabled to byte-code when loaded with `*`...
Marge Bot
gitlab at gitlab.haskell.org
Tue Oct 20 04:49:13 UTC 2020
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
58a1ca38 by nineonine at 2020-10-20T00:49:07-04:00
Compile modules with `-fobject-code` enabled to byte-code when loaded with `*` prefix in ghci (#8042)
The documentation states that when using :add and :load, the `*` prefix forces a module
to be loaded as byte-code. However, this seems to be ignored when -fobject-code has been
enabled. In that case, the compiled code is always used, regardless of whether the *-form
is used.
The idea is to consult the Targets in HscEnv and check the 'targetAllowObjCode' flag. If
the flag for given module is set, then patch up DynFlags and select compilation backend
accordingly.
This would require a linear scan of course, but that shouldn't be too costly.
- - - - -
5 changed files:
- compiler/GHC/Driver/Pipeline.hs
- compiler/GHC/Driver/Types.hs
- + testsuite/tests/ghci/scripts/T8042.script
- + testsuite/tests/ghci/scripts/T8042.stdout
- testsuite/tests/ghci/scripts/all.T
Changes:
=====================================
compiler/GHC/Driver/Pipeline.hs
=====================================
@@ -316,8 +316,19 @@ compileOne' m_tc_result mHscMessage
current_dir = takeDirectory basename
old_paths = includePaths dflags2
!prevailing_dflags = hsc_dflags hsc_env0
+ -- Figure out which backend we're using
+ (bcknd, dflags3)
+ -- #8042: When module was loaded with `*` prefix in ghci, but DynFlags
+ -- suggest to generate object code (which may happen in case -fobject-code
+ -- was set), force it to generate byte-code. This is NOT transitive and
+ -- only applies to direct targets.
+ | Just (Target _ obj _) <- findTarget summary (hsc_targets hsc_env0)
+ , not obj
+ = (Interpreter, dflags2 { backend = Interpreter })
+ | otherwise
+ = (backend dflags, dflags2)
dflags =
- dflags2 { includePaths = addQuoteInclude old_paths [current_dir]
+ dflags3 { includePaths = addQuoteInclude old_paths [current_dir]
, log_action = log_action prevailing_dflags }
-- use the prevailing log_action / log_finaliser,
-- not the one cached in the summary. This is so
@@ -325,9 +336,6 @@ compileOne' m_tc_result mHscMessage
-- to re-summarize all the source files.
hsc_env = hsc_env0 {hsc_dflags = dflags}
- -- Figure out which backend we're using
- bcknd = backend dflags
-
-- -fforce-recomp should also work with --make
force_recomp = gopt Opt_ForceRecomp dflags
source_modified
=====================================
compiler/GHC/Driver/Types.hs
=====================================
@@ -19,7 +19,7 @@ module GHC.Driver.Types (
-- * compilation state
HscEnv(..), hscEPS,
FinderCache, FindResult(..), InstalledFindResult(..),
- Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId,
+ Target(..), TargetId(..), InputFileBuffer, pprTarget, pprTargetId, findTarget,
HscStatus(..),
-- * ModuleGraph
@@ -605,7 +605,7 @@ type InputFileBuffer = StringBuffer
pprTarget :: Target -> SDoc
pprTarget (Target id obj _) =
- (if obj then char '*' else empty) <> pprTargetId id
+ (if obj then empty else char '*') <> pprTargetId id
instance Outputable Target where
ppr = pprTarget
@@ -617,6 +617,20 @@ pprTargetId (TargetFile f _) = text f
instance Outputable TargetId where
ppr = pprTargetId
+findTarget :: ModSummary -> [Target] -> Maybe Target
+findTarget ms ts =
+ case filter (matches ms) ts of
+ [] -> Nothing
+ (t:_) -> Just t
+ where
+ summary `matches` Target (TargetModule m) _ _
+ = ms_mod_name summary == m
+ summary `matches` Target (TargetFile f _) _ _
+ | Just f' <- ml_hs_file (ms_location summary)
+ = f == f'
+ _ `matches` _
+ = False
+
{-
************************************************************************
* *
=====================================
testsuite/tests/ghci/scripts/T8042.script
=====================================
@@ -0,0 +1,11 @@
+:set -v1
+System.IO.writeFile "T8042B.hs" "{-# OPTIONS_GHC -fobject-code #-} module T8042B where { type I = Int; }"
+System.IO.writeFile "T8042C.hs" "module T8042C where { type B = Bool; }"
+System.IO.writeFile "T8042A.hs" "module T8042A where { import T8042B; import T8042C }"
+-- no `*` prefix so should compile object-code for B only
+:load T8042A
+System.IO.writeFile "T8042A.hs" "{-# OPTIONS_GHC -fobject-code #-} module T8042A where { import T8042B; import T8042C }"
+-- should compile object-code for A now
+:reload
+-- with `*` prefix should compile byte-code for A
+:load *T8042A
=====================================
testsuite/tests/ghci/scripts/T8042.stdout
=====================================
@@ -0,0 +1,9 @@
+[1 of 3] Compiling T8042B ( T8042B.hs, T8042B.o )
+[2 of 3] Compiling T8042C ( T8042C.hs, interpreted )
+[3 of 3] Compiling T8042A ( T8042A.hs, interpreted )
+Ok, three modules loaded.
+[3 of 3] Compiling T8042A ( T8042A.hs, T8042A.o )
+Ok, three modules loaded.
+[2 of 3] Compiling T8042C ( T8042C.hs, interpreted )
+[3 of 3] Compiling T8042A ( T8042A.hs, interpreted )
+Ok, three modules loaded.
=====================================
testsuite/tests/ghci/scripts/all.T
=====================================
@@ -174,6 +174,7 @@ test('T7872', normal, ghci_script, ['T7872.script'])
test('T7873', normal, ghci_script, ['T7873.script'])
test('T7939', normal, ghci_script, ['T7939.script'])
test('T7894', normal, ghci_script, ['T7894.script'])
+test('T8042', normal, ghci_script, ['T8042.script'])
test('T8116', normal, ghci_script, ['T8116.script'])
test('T8113', normal, ghci_script, ['T8113.script'])
test('T8172', when(opsys('mingw32'), normalise_drive_letter),
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58a1ca3886b00630937d7f5073b2d7961f8e80ca
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/58a1ca3886b00630937d7f5073b2d7961f8e80ca
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/20201020/79c4dba9/attachment-0001.html>
More information about the ghc-commits
mailing list