Tidy up the error messages we get from TH in stage1 (Trac #8312)

Instead of panic-ing we now give a sensible message.
There is quite a bit of refactoring here too, removing
several #ifdef GHCI things

6 files changed, 19 insertions, 69 deletions

diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index cb36b9055a..32e0a47193 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -16,9 +16,7 @@ module RnExpr (
 
 #include "HsVersions.h"
 
-#ifdef GHCI
 import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
-#endif  /* GHCI */
 
 import RnBinds   ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
                    rnMatchGroup, rnGRHS, makeMiniFixityEnv)
@@ -179,15 +177,12 @@ rnExpr e@(HsBracket br_body) = rnBracket e br_body
 
 rnExpr (HsSpliceE splice) = rnSpliceExpr splice
 
-#ifndef GHCI
-rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
-#else
+
 rnExpr (HsQuasiQuoteE qq)
   = runQuasiQuoteExpr qq        `thenM` \ lexpr' ->
     -- Wrap the result of the quasi-quoter in parens so that we don't
     -- lose the outermost location set by runQuasiQuote (#7918) 
     rnExpr (HsPar lexpr')
-#endif  /* GHCI */
 
 ---------------------------------------------
 --      Sections
diff --git a/compiler/rename/RnPat.lhs b/compiler/rename/RnPat.lhs
index 16f94fe5a8..28879d301e 100644
--- a/compiler/rename/RnPat.lhs
+++ b/compiler/rename/RnPat.lhs
@@ -39,10 +39,8 @@ module RnPat (-- main entry points
 -- ENH: thin imports to only what is necessary for patterns
 
 import {-# SOURCE #-} RnExpr ( rnLExpr )
-#ifdef GHCI
 import {-# SOURCE #-} RnSplice ( rnSplicePat )
 import {-# SOURCE #-} TcSplice ( runQuasiQuotePat )
-#endif  /* GHCI */
 
 #include "HsVersions.h"
 
@@ -424,22 +422,15 @@ rnPatAndThen mk (TuplePat pats boxed _)
        ; pats' <- rnLPatsAndThen mk pats
        ; return (TuplePat pats' boxed placeHolderType) }
 
-#ifndef GHCI
-rnPatAndThen _ p@(SplicePat {})
-  = pprPanic "Can't do SplicePat without GHCi" (ppr p)
-rnPatAndThen _ p@(QuasiQuotePat {}) 
-  = pprPanic "Can't do QuasiQuotePat without GHCi" (ppr p)
-#else
 rnPatAndThen _ (SplicePat splice)
   = do { -- XXX How to deal with free variables?
-         (pat, _) <- liftCps $ rnSplicePat splice
+       ; (pat, _) <- liftCps $ rnSplicePat splice
        ; return pat }
 rnPatAndThen mk (QuasiQuotePat qq)
   = do { pat <- liftCps $ runQuasiQuotePat qq
          -- Wrap the result of the quasi-quoter in parens so that we don't
          -- lose the outermost location set by runQuasiQuote (#7918) 
        ; rnPatAndThen mk (ParPat pat) }
-#endif  /* GHCI */
 
 rnPatAndThen _ pat = pprPanic "rnLPatAndThen" (ppr pat)
 
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 43932b4904..44b88cb880 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -12,9 +12,7 @@ module RnSource (
 
 import {-# SOURCE #-} RnExpr( rnLExpr )
 import {-# SOURCE #-} RnSplice ( rnSpliceDecl )
-#ifdef GHCI
 import {-# SOURCE #-} TcSplice ( runQuasiQuoteDecl )
-#endif /* GHCI */
 
 import HsSyn
 import RdrName
@@ -1475,14 +1473,9 @@ add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds
   where
     badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
 
-#ifndef GHCI
-add _ _ (QuasiQuoteD qq) _
-  = pprPanic "Can't do QuasiQuote declarations without GHCi" (ppr qq)
-#else
 add gp _ (QuasiQuoteD qq) ds            -- Expand quasiquotes
   = do { ds' <- runQuasiQuoteDecl qq
        ; addl gp (ds' ++ ds) }
-#endif
 
 -- Class declarations: pull out the fixity signatures to the top
 add gp@(HsGroup {hs_tyclds = ts, hs_fixds = fs}) l (TyClD d) ds
diff --git a/compiler/rename/RnSplice.lhs b/compiler/rename/RnSplice.lhs
index 01c4087df7..52cae5af75 100644
--- a/compiler/rename/RnSplice.lhs
+++ b/compiler/rename/RnSplice.lhs
@@ -5,11 +5,10 @@ module RnSplice (
         checkThLocalName
   ) where
 
-import FastString
+
 import Name
 import NameSet
 import HsSyn
-import Outputable
 import RdrName
 import TcRnMonad
 
@@ -25,6 +24,8 @@ import RnSource         ( rnSrcDecls, findSplice )
 import RnTypes
 import SrcLoc
 import TcEnv            ( checkWellStaged, tcLookup, tcMetaTy, thTopLevelId )
+import Outputable
+import FastString
 
 import {-# SOURCE #-} RnExpr   ( rnLExpr )
 import {-# SOURCE #-} TcExpr   ( tcMonoExpr )
@@ -35,29 +36,22 @@ import {-# SOURCE #-} TcSplice ( runMetaE, runMetaP, runMetaT, tcTopSpliceExpr )
 \begin{code}
 #ifndef GHCI
 rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
-rnBracket e _ = failTH e "bracket"
+rnBracket e _ = failTH e "Template Haskell bracket"
 
 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
-rnSplice e = failTH e "splice"
+rnSplice e = failTH e "Template Haskell splice"
 
 rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
-rnSpliceType e _ = failTH e "splice"
+rnSpliceType e _ = failTH e "Template Haskell type splice"
 
 rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
-rnSpliceExpr e = failTH e "splice"
+rnSpliceExpr e = failTH e "Template Haskell splice"
 
 rnSplicePat :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
-rnSplicePat e = failTH e "splice"
+rnSplicePat e = failTH e "Template Haskell pattern splice"
 
 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-rnSpliceDecl e = failTH e "splice"
-
-failTH :: Outputable a => a -> String -> RnM b
-failTH e what  -- Raise an error in a stage-1 compiler
-  = failWithTc (vcat [ptext (sLit "Template Haskell") <+> text what <+>
-                      ptext (sLit "requires GHC with interpreter support"),
-                      ptext (sLit "Perhaps you are using a stage-1 compiler?"),
-                      nest 2 (ppr e)])
+rnSpliceDecl e = failTH e "Template Haskell declaration splice"
 #else
 \end{code}
 
@@ -89,7 +83,7 @@ type checker.  Not very satisfactory really.
 \begin{code}
 rnSplice :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
 rnSplice (HsSplice isTyped n expr)
-  = do  { checkTH expr "splice"
+  = do  { checkTH expr "Template Haskell splice"
         ; loc  <- getSrcSpanM
         ; n' <- newLocalBndrRn (L loc n)
         ; (expr', fvs) <- rnLExpr expr
@@ -124,13 +118,13 @@ rnSpliceType splice@(HsSplice isTypedSplice _ expr) k
                  -- ToDo: deal with fvs
                ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
                                                            rnSplice splice
-           
+
                ; ps <- readMutVar ps_var
                ; writeMutVar ps_var (PendingRnTypeSplice name expr' : ps)
 
                ; return (HsSpliceTy splice' fvs k, fvs)
                }
-        ; _ -> 
+        ; _ ->
             do { -- ToDo: deal with fvs
                  (splice', fvs) <- addErrCtxt (spliceResultDoc expr) $
                                    setStage (Splice isTypedSplice) $
@@ -144,7 +138,7 @@ rnSpliceType splice@(HsSplice isTypedSplice _ expr) k
     maybeExpandTopSplice splice@(HsSplice True _ _) fvs
       = return (HsSpliceTy splice fvs k, fvs)
 
-    maybeExpandTopSplice (HsSplice False _ expr) _ 
+    maybeExpandTopSplice (HsSplice False _ expr) _
       = do { -- The splice must have type TypeQ
            ; meta_exp_ty <- tcMetaTy typeQTyConName
 
@@ -180,13 +174,13 @@ rnSpliceExpr splice@(HsSplice isTypedSplice _ expr)
 
                ; (splice'@(HsSplice _ name expr'), fvs) <- setStage pop_stage $
                                                            rnSplice splice
-           
+
                ; ps <- readMutVar ps_var
                ; writeMutVar ps_var (PendingRnExpSplice name expr' : ps)
 
                ; return (HsSpliceE splice', fvs)
                }
-        ; _ -> 
+        ; _ ->
             do { (splice', fvs) <- addErrCtxt (spliceResultDoc expr) $
                                    setStage (Splice isTypedSplice) $
                                    rnSplice splice
@@ -199,7 +193,7 @@ rnSpliceExpr splice@(HsSplice isTypedSplice _ expr)
     maybeExpandTopSplice splice@(HsSplice True _ _) fvs
       = return (HsSpliceE splice, fvs)
 
-    maybeExpandTopSplice (HsSplice False _ expr) _ 
+    maybeExpandTopSplice (HsSplice False _ expr) _
       = do { -- The splice must have type ExpQ
            ; meta_exp_ty <- tcMetaTy expQTyConName
 
@@ -307,7 +301,7 @@ rnBracket e br_body
        ; unless thEnabled $
            failWith ( vcat [ ptext (sLit "Syntax error on") <+> ppr e
                            , ptext (sLit "Perhaps you intended to use TemplateHaskell") ] )
-       ; checkTH e "bracket"
+       ; checkTH e "Template Haskell bracket"
 
          -- Check for nested brackets
        ; cur_stage <- getStage
@@ -470,19 +464,6 @@ spliceResultDoc expr
 \end{code}
 
 \begin{code}
-checkTH :: Outputable a => a -> String -> RnM ()
-#ifdef GHCI
-checkTH _ _ = return () -- OK
-#else
-checkTH e what  -- Raise an error in a stage-1 compiler
-  = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
-                  ptext (sLit "requires GHC with interpreter support"),
-                  ptext (sLit "Perhaps you are using a stage-1 compiler?"),
-                  nest 2 (ppr e)])
-#endif
-\end{code}
-
-\begin{code}
 checkThLocalName :: Name -> ThLevel -> RnM ()
 #ifndef GHCI  /* GHCI and TH is off */
 --------------------------------------
diff --git a/compiler/rename/RnSplice.lhs-boot b/compiler/rename/RnSplice.lhs-boot
index 2e9990f207..128f5ef6d3 100644
--- a/compiler/rename/RnSplice.lhs-boot
+++ b/compiler/rename/RnSplice.lhs-boot
@@ -7,8 +7,6 @@ import RdrName
 import Name
 import NameSet
 
-import Outputable
-
 rnBracket :: HsExpr RdrName -> HsBracket RdrName -> RnM (HsExpr Name, FreeVars)
 
 rnSplice     :: HsSplice RdrName -> RnM (HsSplice Name, FreeVars)
@@ -16,6 +14,4 @@ rnSpliceType :: HsSplice RdrName -> PostTcKind -> RnM (HsType Name, FreeVars)
 rnSpliceExpr :: HsSplice RdrName -> RnM (HsExpr Name, FreeVars)
 rnSplicePat  :: HsSplice RdrName -> RnM (Pat Name, FreeVars)
 rnSpliceDecl :: SpliceDecl RdrName -> RnM (SpliceDecl Name, FreeVars)
-
-checkTH :: Outputable a => a -> String -> RnM ()
 \end{code}
diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs
index 0db92e8f90..0052393bb4 100644
--- a/compiler/rename/RnTypes.lhs
+++ b/compiler/rename/RnTypes.lhs
@@ -21,9 +21,7 @@ module RnTypes (
         extractRdrKindSigVars, extractDataDefnKindVars, filterInScope
   ) where
 
-#ifdef GHCI
 import {-# SOURCE #-} TcSplice( runQuasiQuoteType )
-#endif /* GHCI */
 import {-# SOURCE #-} RnSplice( rnSpliceType )
 
 import DynFlags
@@ -261,16 +259,12 @@ rnHsTyKi isType doc (HsDocTy ty haddock_doc)
        ; haddock_doc' <- rnLHsDoc haddock_doc
        ; return (HsDocTy ty' haddock_doc', fvs) }
 
-#ifndef GHCI
-rnHsTyKi _ _ ty@(HsQuasiQuoteTy _) = pprPanic "Can't do quasiquotation without GHCi" (ppr ty)
-#else
 rnHsTyKi isType doc (HsQuasiQuoteTy qq)
   = ASSERT( isType )
     do { ty <- runQuasiQuoteType qq
          -- Wrap the result of the quasi-quoter in parens so that we don't
          -- lose the outermost location set by runQuasiQuote (#7918) 
        ; rnHsType doc (HsParTy ty) }
-#endif
 
 rnHsTyKi isType _ (HsCoreTy ty)
   = ASSERT( isType )