diff -Nur orig/ghc-7.4.2/compiler/ghc.cabal.in ghc-7.4.2/compiler/ghc.cabal.in --- orig/ghc-7.4.2/compiler/ghc.cabal.in 2012-06-06 18:10:25.000000000 +0100 +++ ghc-7.4.2/compiler/ghc.cabal.in 2013-07-08 17:23:14.000000000 +0100 @@ -320,6 +320,7 @@ DynamicLoading HeaderInfo HscMain + HscPlugin HscStats HscTypes InteractiveEval diff -Nur orig/ghc-7.4.2/compiler/main/DynFlags.hs ghc-7.4.2/compiler/main/DynFlags.hs --- orig/ghc-7.4.2/compiler/main/DynFlags.hs 2012-06-06 18:10:25.000000000 +0100 +++ ghc-7.4.2/compiler/main/DynFlags.hs 2013-07-08 17:23:14.000000000 +0100 @@ -115,6 +115,7 @@ import Foreign.C ( CInt(..) ) #endif import {-# SOURCE #-} ErrUtils ( Severity(..), Message, mkLocMessage ) +import {-# SOURCE #-} HscPlugin (HscPlugin) #ifdef GHCI import System.IO.Unsafe ( unsafePerformIO ) @@ -526,6 +527,7 @@ -- Plugins pluginModNames :: [ModuleName], pluginModNameOpts :: [(ModuleName,String)], + sourcePlugins :: [HscPlugin], -- For ghc -M depMakefile :: FilePath, @@ -881,6 +883,7 @@ pluginModNames = [], pluginModNameOpts = [], + sourcePlugins = [], outputFile = Nothing, outputHi = Nothing, diff -Nur orig/ghc-7.4.2/compiler/main/HscMain.hs ghc-7.4.2/compiler/main/HscMain.hs --- orig/ghc-7.4.2/compiler/main/HscMain.hs 2012-06-06 18:10:25.000000000 +0100 +++ ghc-7.4.2/compiler/main/HscMain.hs 2013-07-08 17:23:18.000000000 +0100 @@ -130,6 +130,7 @@ import InstEnv import FamInstEnv import Fingerprint ( Fingerprint ) +import HscPlugin import DynFlags import ErrUtils @@ -149,6 +150,7 @@ import Control.Monad import Data.Maybe import Data.IORef +import Data.Monoid (mconcat) import System.FilePath as FilePath import System.Directory @@ -633,8 +635,10 @@ | ExtCoreFile <- ms_hsc_src mod_summary = panic "GHC does not currently support reading External Core files" | otherwise = do - tc_result <- hscFileFrontEnd mod_summary - hscBackend compiler tc_result mod_summary mb_old_hash + dynFlags <- getDynFlags + tc_result <- hscFileFrontEnd mod_summary + tc_result' <- runHscPlugin (mconcat (sourcePlugins dynFlags)) dynFlags tc_result + hscBackend compiler tc_result' mod_summary mb_old_hash genericHscBackend :: HsCompiler a -> TcGblEnv -> ModSummary -> Maybe Fingerprint @@ -844,7 +848,7 @@ hscFileFrontEnd mod_summary = do hpm <- hscParse' mod_summary hsc_env <- getHscEnv - tcg_env <- tcRnModule' hsc_env mod_summary False hpm + tcg_env <- tcRnModule' hsc_env mod_summary True hpm return tcg_env -------------------------------------------------------------- diff -Nur orig/ghc-7.4.2/compiler/main/HscPlugin.hs ghc-7.4.2/compiler/main/HscPlugin.hs --- orig/ghc-7.4.2/compiler/main/HscPlugin.hs 1970-01-01 01:00:00.000000000 +0100 +++ ghc-7.4.2/compiler/main/HscPlugin.hs 2013-07-08 17:23:31.000000000 +0100 @@ -0,0 +1,34 @@ +module HscPlugin + ( HscPlugin(..) + ) where + +import Prelude hiding (span) +import TcRnTypes +import DynFlags +import MonadUtils +import HsTypes +import Name + +import Data.Monoid +import Control.Monad + +data HscPlugin = HscPlugin { + runHscPlugin :: forall m. MonadIO m => DynFlags + -> TcGblEnv + -> m TcGblEnv + + , runHscQQ :: forall m. MonadIO m => Env TcGblEnv TcLclEnv + -> HsQuasiQuote Name + -> m (HsQuasiQuote Name) + } + +instance Monoid HscPlugin where + mempty = HscPlugin { + runHscPlugin = const return + , runHscQQ = const return + } + + a `mappend` b = HscPlugin { + runHscPlugin = \dynFlags -> runHscPlugin a dynFlags >=> runHscPlugin b dynFlags + , runHscQQ = \env -> runHscQQ a env >=> runHscQQ b env + } diff -Nur orig/ghc-7.4.2/compiler/main/HscPlugin.hs-boot ghc-7.4.2/compiler/main/HscPlugin.hs-boot --- orig/ghc-7.4.2/compiler/main/HscPlugin.hs-boot 1970-01-01 01:00:00.000000000 +0100 +++ ghc-7.4.2/compiler/main/HscPlugin.hs-boot 2013-07-08 17:23:14.000000000 +0100 @@ -0,0 +1,3 @@ +module HscPlugin where + +data HscPlugin diff -Nur orig/ghc-7.4.2/compiler/typecheck/TcSplice.lhs ghc-7.4.2/compiler/typecheck/TcSplice.lhs --- orig/ghc-7.4.2/compiler/typecheck/TcSplice.lhs 2012-06-06 18:10:25.000000000 +0100 +++ ghc-7.4.2/compiler/typecheck/TcSplice.lhs 2013-07-08 17:23:31.000000000 +0100 @@ -75,6 +75,9 @@ import Panic import FastString import Control.Monad ( when ) +import HscPlugin +import Data.Monoid (mconcat) +import DynFlags (DynFlags(sourcePlugins)) import qualified Language.Haskell.TH as TH -- THSyntax gives access to internal functions and data types @@ -703,6 +706,13 @@ ; traceTc "runQQ" (ppr quoter <+> ppr is_local) + -- Notify any source plugins about the QQ + ; env <- getEnv + ; HsQuasiQuote quoter' q_span quote <- + runHscQQ (mconcat . sourcePlugins . hsc_dflags . env_top $ env) + env + (HsQuasiQuote quoter' q_span quote) + -- Build the expression ; let quoterExpr = L q_span $! HsVar $! quoter' ; let quoteExpr = L q_span $! HsLit $! HsString quote