[commit: ghc] master: Fix -fno-code for modules that use -XQuasiQuotes (d55bea1)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/d55bea14c745f7f448fb24673a21b511d1c1c222/ghc

>---------------------------------------------------------------

commit d55bea14c745f7f448fb24673a21b511d1c1c222
Author: Douglas Wilson <douglas.wilson at gmail.com>
Date:   Mon Jul 3 16:54:29 2017 -0400

    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


>---------------------------------------------------------------

d55bea14c745f7f448fb24673a21b511d1c1c222
 compiler/main/GHC.hs                        | 11 +----------
 compiler/main/GhcMake.hs                    |  2 +-
 compiler/main/HscTypes.hs                   | 18 ++++++++++++++++++
 testsuite/tests/quasiquotation/T13863/A.hs  |  8 ++++++++
 testsuite/tests/quasiquotation/T13863/B.hs  |  7 +++++++
 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 2102009..4a45bea 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 134a060..5935a77 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 fa9c18a..9f1da3f 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 0000000..0d3137c
--- /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 0000000..649a551
--- /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 0000000..c29dc20
--- /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