diff options
| author | Douglas Wilson <douglas.wilson@gmail.com> | 2017-07-03 16:54:29 -0400 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2017-07-03 18:58:11 -0400 |
| commit | d55bea14c745f7f448fb24673a21b511d1c1c222 (patch) | |
| tree | ce5dca5e7ee1e044160d1ba9146235717fcc3f18 | |
| parent | c3a78623cf7bb74c8ca0749f1216e802aa37a721 (diff) | |
| download | haskell-d55bea14c745f7f448fb24673a21b511d1c1c222.tar.gz | |
Fix -fno-code for modules that use -XQuasiQuotes
In commit 53c78be0aab76a3107c4dacbb1d177afacdd37fa object code is
generated for modules depended on by modules that use -XTemplateHaskell.
This turns the same logic on for modules that use -XQuasiQuotes.
A test is added.
Note that I've based this of D3646, as it has a function I want to use.
Test Plan: ./validate
Reviewers: austin, bgamari, alexbiehl
Reviewed By: alexbiehl
Subscribers: alexbiehl, rwbarton, thomie
GHC Trac Issues: #13863
Differential Revision: https://phabricator.haskell.org/D3677
| -rw-r--r-- | compiler/main/GHC.hs | 11 | ||||
| -rw-r--r-- | compiler/main/GhcMake.hs | 2 | ||||
| -rw-r--r-- | compiler/main/HscTypes.hs | 18 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/T13863/A.hs | 8 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/T13863/B.hs | 7 | ||||
| -rw-r--r-- | testsuite/tests/quasiquotation/T13863/all.T | 1 |
6 files changed, 36 insertions, 11 deletions
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 2102009019..4a45bea2e0 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -23,7 +23,7 @@ module GHC ( gcatch, gbracket, gfinally, printException, handleSourceError, - needsTemplateHaskell, + needsTemplateHaskellOrQQ, -- * Flags and settings DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), gopt, @@ -1075,15 +1075,6 @@ compileCore simplify fn = do getModuleGraph :: GhcMonad m => m ModuleGraph -- ToDo: DiGraph ModSummary getModuleGraph = liftM hsc_mod_graph getSession --- | Determines whether a set of modules requires Template Haskell. --- --- Note that if the session's 'DynFlags' enabled Template Haskell when --- 'depanal' was called, then each module in the returned module graph will --- have Template Haskell enabled whether it is actually needed or not. -needsTemplateHaskell :: ModuleGraph -> Bool -needsTemplateHaskell ms = - any (xopt LangExt.TemplateHaskell . ms_hspp_opts) ms - -- | Return @True@ <==> module is loaded. isLoaded :: GhcMonad m => ModuleName -> m Bool isLoaded m = withSession $ \hsc_env -> diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 134a0607bc..5935a771a7 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -1994,7 +1994,7 @@ enableCodeGenForTH target nodemap = [ ms | mss <- Map.elems nodemap , Right ms <- mss - , xopt LangExt.TemplateHaskell (ms_hspp_opts ms) + , needsTemplateHaskellOrQQ $ [ms] ] transitive_deps_set marked_mods modSums = foldl' go marked_mods modSums go marked_mods ms diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs index fa9c18a3e1..9f1da3fcdd 100644 --- a/compiler/main/HscTypes.hs +++ b/compiler/main/HscTypes.hs @@ -12,6 +12,7 @@ module HscTypes ( HscEnv(..), hscEPS, FinderCache, FindResult(..), InstalledFindResult(..), Target(..), TargetId(..), pprTarget, pprTargetId, + needsTemplateHaskellOrQQ, ModuleGraph, emptyMG, mapMG, HscStatus(..), IServ(..), @@ -199,6 +200,7 @@ import Platform import Util import UniqDSet import GHC.Serialized ( Serialized ) +import qualified GHC.LanguageExtensions as LangExt import Foreign import Control.Monad ( guard, liftM, ap ) @@ -2608,12 +2610,28 @@ soExt platform -- 'GHC.topSortModuleGraph' and 'Digraph.flattenSCC' to achieve this. type ModuleGraph = [ModSummary] + +-- | Determines whether a set of modules requires Template Haskell or +-- Quasi Quotes +-- +-- Note that if the session's 'DynFlags' enabled Template Haskell when +-- 'depanal' was called, then each module in the returned module graph will +-- have Template Haskell enabled whether it is actually needed or not. +needsTemplateHaskellOrQQ :: ModuleGraph -> Bool +needsTemplateHaskellOrQQ mg = any isTemplateHaskellOrQQNonBoot mg + emptyMG :: ModuleGraph emptyMG = [] mapMG :: (ModSummary -> ModSummary) -> ModuleGraph -> ModuleGraph mapMG = map +isTemplateHaskellOrQQNonBoot :: ModSummary -> Bool +isTemplateHaskellOrQQNonBoot ms = + (xopt LangExt.TemplateHaskell (ms_hspp_opts ms) + || xopt LangExt.QuasiQuotes (ms_hspp_opts ms)) && + not (isBootSummary ms) + -- | A single node in a 'ModuleGraph'. The nodes of the module graph -- are one of: -- diff --git a/testsuite/tests/quasiquotation/T13863/A.hs b/testsuite/tests/quasiquotation/T13863/A.hs new file mode 100644 index 0000000000..0d3137cde9 --- /dev/null +++ b/testsuite/tests/quasiquotation/T13863/A.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wno-missing-fields#-} +module A where + +import Language.Haskell.TH +import Language.Haskell.TH.Quote + +aquoter :: QuasiQuoter +aquoter = QuasiQuoter {quoteType = conT . mkName } diff --git a/testsuite/tests/quasiquotation/T13863/B.hs b/testsuite/tests/quasiquotation/T13863/B.hs new file mode 100644 index 0000000000..649a551071 --- /dev/null +++ b/testsuite/tests/quasiquotation/T13863/B.hs @@ -0,0 +1,7 @@ +{-# LANGUAGE QuasiQuotes #-} +module B where + +import A + +foo:: [aquoter|Int|] -> [aquoter|String|] +foo = show diff --git a/testsuite/tests/quasiquotation/T13863/all.T b/testsuite/tests/quasiquotation/T13863/all.T new file mode 100644 index 0000000000..c29dc20b56 --- /dev/null +++ b/testsuite/tests/quasiquotation/T13863/all.T @@ -0,0 +1 @@ +test('T13863', [req_interp, omit_ways(prof_ways), extra_files(['A.hs', 'B.hs'])], multimod_compile, ['B', '-fno-code -v0'])
\ No newline at end of file |
