summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2013-11-06 16:21:05 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2013-11-06 16:21:05 +0000
commitbf3b29323d69b2c6f073885fb896dd4a5c346c02 (patch)
tree510f1c4a46dd368985566226c7055c9738afa0b5
parent5bf435bd01981a65dba7c611cf8da327c8268738 (diff)
downloadhaskell-bf3b29323d69b2c6f073885fb896dd4a5c346c02.tar.gz
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
-rw-r--r--compiler/ghc.cabal.in2
-rw-r--r--compiler/rename/RnExpr.lhs7
-rw-r--r--compiler/rename/RnPat.lhs11
-rw-r--r--compiler/rename/RnSource.lhs7
-rw-r--r--compiler/rename/RnSplice.lhs53
-rw-r--r--compiler/rename/RnSplice.lhs-boot4
-rw-r--r--compiler/rename/RnTypes.lhs6
-rw-r--r--compiler/typecheck/TcAnnotations.lhs12
-rw-r--r--compiler/typecheck/TcExpr.lhs16
-rw-r--r--compiler/typecheck/TcHsType.lhs26
-rw-r--r--compiler/typecheck/TcRnMonad.lhs14
-rw-r--r--compiler/typecheck/TcSplice.lhs128
-rw-r--r--compiler/typecheck/TcSplice.lhs-boot16
13 files changed, 125 insertions, 177 deletions
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index ce1223b13a..70f7c1634d 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -387,6 +387,7 @@ Library
TcCanonical
TcSMonad
TcTypeNats
+ TcSplice
Class
Coercion
FamInstEnv
@@ -532,7 +533,6 @@ Library
if flag(ghci)
Exposed-Modules:
DsMeta
- TcSplice
Convert
ByteCodeAsm
ByteCodeGen
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 )
diff --git a/compiler/typecheck/TcAnnotations.lhs b/compiler/typecheck/TcAnnotations.lhs
index 1d495c0eec..4f4ab60f24 100644
--- a/compiler/typecheck/TcAnnotations.lhs
+++ b/compiler/typecheck/TcAnnotations.lhs
@@ -7,6 +7,8 @@
\begin{code}
module TcAnnotations ( tcAnnotations ) where
+import {-# SOURCE #-} TcSplice ( runAnnotation )
+
import HsSyn
import Annotations
import Name
@@ -14,12 +16,9 @@ import TcRnMonad
import SrcLoc
import Outputable
-#ifdef GHCI
import Module
import TcExpr
-import {-# SOURCE #-} TcSplice ( runAnnotation )
import FastString
-#endif
\end{code}
\begin{code}
@@ -27,15 +26,11 @@ tcAnnotations :: [LAnnDecl Name] -> TcM [Annotation]
tcAnnotations = mapM tcAnnotation
tcAnnotation :: LAnnDecl Name -> TcM Annotation
-#ifndef GHCI
--- TODO: modify lexer so ANN pragmas are parsed as comments in a stage1 compiler, so developers don't see this error
-tcAnnotation (L _ (HsAnnotation _ expr)) = pprPanic "Cant do annotations without GHCi" (ppr expr)
-#else
tcAnnotation ann@(L loc (HsAnnotation provenance expr)) = do
-- Work out what the full target of this annotation was
mod <- getModule
let target = annProvenanceToTarget mod provenance
-
+
-- Run that annotation and construct the full Annotation data structure
setSrcSpan loc $ addErrCtxt (annCtxt ann) $ addExprErrCtxt expr $ runAnnotation target expr
@@ -47,5 +42,4 @@ annProvenanceToTarget mod ModuleAnnProvenance = ModuleTarget mod
annCtxt :: OutputableBndr id => LAnnDecl id -> SDoc
annCtxt ann
= hang (ptext (sLit "In the annotation:")) 2 (ppr ann)
-#endif
\end{code} \ No newline at end of file
diff --git a/compiler/typecheck/TcExpr.lhs b/compiler/typecheck/TcExpr.lhs
index d03a43b747..d047afc6fa 100644
--- a/compiler/typecheck/TcExpr.lhs
+++ b/compiler/typecheck/TcExpr.lhs
@@ -12,9 +12,9 @@ module TcExpr ( tcPolyExpr, tcPolyExprNC, tcMonoExpr, tcMonoExprNC,
#include "HsVersions.h"
-#ifdef GHCI /* Only if bootstrapped */
import {-# SOURCE #-} TcSplice( tcSpliceExpr, tcBracket )
-import qualified DsMeta
+#ifdef GHCI
+import DsMeta( liftStringName, liftName )
#endif
import HsSyn
@@ -797,7 +797,6 @@ tcExpr (PArrSeq _ _) _
%************************************************************************
\begin{code}
-#ifdef GHCI /* Only if bootstrapped */
-- Rename excludes these cases otherwise
tcExpr (HsSpliceE splice) res_ty = tcSpliceExpr splice res_ty
tcExpr (HsRnBracketOut brack ps) res_ty = tcBracket brack ps res_ty
@@ -805,7 +804,6 @@ tcExpr e@(HsBracketOut _ _) _ =
pprPanic "Should never see HsBracketOut in type checker" (ppr e)
tcExpr e@(HsQuasiQuoteE _) _ =
pprPanic "Should never see HsQuasiQuoteE in type checker" (ppr e)
-#endif /* GHCI */
\end{code}
@@ -1339,6 +1337,10 @@ checkCrossStageLifting id _ (Brack _ _ ps_var lie_var)
; writeMutVar ps_var (PendingTcSplice (idName id) (nlHsApp (noLoc lift) (nlHsVar id)) : ps)
; return () }
+
+polySpliceErr :: Id -> SDoc
+polySpliceErr id
+ = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)
#endif /* GHCI */
\end{code}
@@ -1616,10 +1618,4 @@ missingFields con fields
<+> pprWithCommas ppr fields
-- callCtxt fun args = ptext (sLit "In the call") <+> parens (ppr (foldl mkHsApp fun args))
-
-#ifdef GHCI
-polySpliceErr :: Id -> SDoc
-polySpliceErr id
- = ptext (sLit "Can't splice the polymorphic local variable") <+> quotes (ppr id)
-#endif
\end{code}
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index b7cd841081..853cee906f 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -41,10 +41,6 @@ module TcHsType (
#include "HsVersions.h"
-#ifdef GHCI /* Only if bootstrapped */
-import {-# SOURCE #-} TcSplice( tcSpliceType )
-#endif
-
import HsSyn
import TcRnMonad
import TcEvidence( HsWrapper )
@@ -509,31 +505,19 @@ tc_hs_type (HsCoreTy ty) exp_kind
; return ty }
-#ifdef GHCI /* Only if bootstrapped */
--- This looks highly suspect to me
--- It will really only be fixed properly when we do the TH
--- reorganisation so that type splices happen in the renamer
-tc_hs_type hs_ty@(HsSpliceTy sp fvs _) exp_kind
- = do { s <- getStage
- ; traceTc "tc_hs_type: splice" (ppr sp $$ ppr s)
- ; (ty, kind) <- tcSpliceType sp fvs
- ; checkExpectedKind hs_ty kind exp_kind
--- -- See Note [Kind of a type splice]
- ; return ty }
-#else
-tc_hs_type ty@(HsSpliceTy {}) _exp_kind
+-- This should never happen; type splices are expanded by the renamer
+tc_hs_type ty@(HsSpliceTy {}) _exp_kind
= failWithTc (ptext (sLit "Unexpected type splice:") <+> ppr ty)
-#endif
-tc_hs_type (HsWrapTy {}) _exp_kind
+tc_hs_type (HsWrapTy {}) _exp_kind
= panic "tc_hs_type HsWrapTy" -- We kind checked something twice
-tc_hs_type hs_ty@(HsTyLit (HsNumTy n)) exp_kind
+tc_hs_type hs_ty@(HsTyLit (HsNumTy n)) exp_kind
= do { checkExpectedKind hs_ty typeNatKind exp_kind
; checkWiredInTyCon typeNatKindCon
; return (mkNumLitTy n) }
-tc_hs_type hs_ty@(HsTyLit (HsStrTy s)) exp_kind
+tc_hs_type hs_ty@(HsTyLit (HsStrTy s)) exp_kind
= do { checkExpectedKind hs_ty typeSymbolKind exp_kind
; checkWiredInTyCon typeSymbolKindCon
; return (mkStrLitTy s) }
diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs
index 6168dc216d..1b66b948f1 100644
--- a/compiler/typecheck/TcRnMonad.lhs
+++ b/compiler/typecheck/TcRnMonad.lhs
@@ -828,6 +828,20 @@ ifErrsM bale_out normal
failIfErrsM :: TcRn ()
-- Useful to avoid error cascades
failIfErrsM = ifErrsM failM (return ())
+
+checkTH :: Outputable a => a -> String -> TcRn ()
+#ifdef GHCI
+checkTH _ _ = return () -- OK
+#else
+checkTH e what = failTH e what -- Raise an error in a stage-1 compiler
+#endif
+
+failTH :: Outputable a => a -> String -> TcRn x
+failTH e what -- Raise an error in a stage-1 compiler
+ = failWithTc (vcat [ text what
+ <+> ptext (sLit "requires GHC with interpreter support")
+ , ptext (sLit "Perhaps you are using a stage-1 compiler?")
+ , nest 2 (ppr e)])
\end{code}
diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs
index fde2d7bc99..5b41fdbe35 100644
--- a/compiler/typecheck/TcSplice.lhs
+++ b/compiler/typecheck/TcSplice.lhs
@@ -9,26 +9,40 @@ TcSplice: Template Haskell splices
\begin{code}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-module TcSplice( tcSpliceType, tcSpliceExpr, tcSpliceDecls, tcBracket,
- tcTopSpliceExpr,
- lookupThName_maybe,
- runQuasiQuoteExpr, runQuasiQuotePat,
- runQuasiQuoteDecl, runQuasiQuoteType,
- runAnnotation,
- runQuasi, runMetaE, runMetaP, runMetaT, runMetaD ) where
+module TcSplice(
+ -- These functions are defined in stage1 and stage2
+ -- The raise civilised errors in stage1
+ tcSpliceExpr, tcSpliceDecls, tcBracket,
+ runQuasiQuoteExpr, runQuasiQuotePat,
+ runQuasiQuoteDecl, runQuasiQuoteType,
+ runAnnotation,
+
+#ifdef GHCI
+ -- These ones are defined only in stage2, and are
+ -- called only in stage2 (ie GHCI is on)
+ runMetaE, runMetaP, runMetaT, runMetaD, runQuasi,
+ tcTopSpliceExpr, lookupThName_maybe,
+#endif
+ ) where
#include "HsVersions.h"
+import HsSyn
+import Annotations
+import Name
+import TcRnMonad
+import RdrName
+import TcType
+
+#ifdef GHCI
import HscMain
-- These imports are the reason that TcSplice
-- is very high up the module hierarchy
import HscTypes
-import HsSyn
import Convert
import RnExpr
import RnEnv
-import RdrName
import RnTypes
import TcExpr
import TcHsSyn
@@ -36,7 +50,7 @@ import TcSimplify
import TcUnify
import Type
import Kind
-import TcType
+import NameSet
import TcEnv
import TcMType
import TcHsType
@@ -45,16 +59,12 @@ import TypeRep
import FamInst
import FamInstEnv
import InstEnv
-import Name
import NameEnv
-import NameSet
import PrelNames
import OccName
import Hooks
import Var
import Module
-import Annotations
-import TcRnMonad
import LoadIface
import Class
import Inst
@@ -64,13 +74,11 @@ import DataCon
import TcEvidence( TcEvBinds(..) )
import Id
import IdInfo
-import DsMeta
import DsExpr
import DsMonad hiding (Splice)
import Serialized
import ErrUtils
import SrcLoc
-import Outputable
import Util
import Data.List ( mapAccumL )
import Unique
@@ -80,25 +88,60 @@ import Maybes( MaybeErr(..) )
import DynFlags
import Panic
import FastString
+import Outputable
import Control.Monad ( when )
+import DsMeta
import qualified Language.Haskell.TH as TH
-- THSyntax gives access to internal functions and data types
import qualified Language.Haskell.TH.Syntax as TH
-#ifdef GHCI
-- Because GHC.Desugar might not be in the base library of the bootstrapping compiler
import GHC.Desugar ( AnnotationWrapper(..) )
import qualified Data.Map as Map
import Data.Dynamic ( fromDynamic, toDyn )
import Data.Typeable ( typeOf )
-#endif
-
import Data.Data (Data)
import GHC.Exts ( unsafeCoerce# )
+#endif
+\end{code}
+
+%************************************************************************
+%* *
+\subsection{Main interface + stubs for the non-GHCI case
+%* *
+%************************************************************************
+
+\begin{code}
+tcBracket :: HsBracket Name -> [PendingSplice] -> TcRhoType -> TcM (HsExpr TcId)
+tcSpliceDecls :: HsSplice Name -> TcM [LHsDecl RdrName]
+tcSpliceExpr :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
+ -- None of these functions add constraints to the LIE
+
+runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
+runQuasiQuotePat :: HsQuasiQuote RdrName -> RnM (LPat RdrName)
+runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName)
+runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
+
+runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
+
+#ifndef GHCI
+tcBracket x _ _ = failTH x "Template Haskell bracket"
+tcSpliceExpr e _ = failTH e "Template Haskell splice"
+tcSpliceDecls x = failTH x "Template Haskell declaration splice"
+
+runQuasiQuoteExpr q = failTH q "quasiquote"
+runQuasiQuotePat q = failTH q "pattern quasiquote"
+runQuasiQuoteType q = failTH q "type quasiquote"
+runQuasiQuoteDecl q = failTH q "declaration quasiquote"
+runAnnotation _ q = failTH q "annotation"
+
+#else
+ -- The whole of the rest of the file is the else-branch (ie stage2 only)
\end{code}
+
Note [How top-level splices are handled]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Top-level splices (those not inside a [| .. |] quotation bracket) are handled
@@ -288,46 +331,6 @@ The predicate we use is TcEnv.thTopLevelId.
%************************************************************************
%* *
-\subsection{Main interface + stubs for the non-GHCI case
-%* *
-%************************************************************************
-
-\begin{code}
-tcBracket :: HsBracket Name -> [PendingSplice] -> TcRhoType -> TcM (HsExpr TcId)
-tcSpliceDecls :: HsSplice Name -> TcM [LHsDecl RdrName]
-tcSpliceExpr :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
-tcSplicePat :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
-tcSpliceType :: HsSplice Name -> FreeVars -> TcM (TcType, TcKind)
- -- None of these functions add constraints to the LIE
-
-lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
-
-runQuasiQuoteExpr :: HsQuasiQuote RdrName -> RnM (LHsExpr RdrName)
-runQuasiQuotePat :: HsQuasiQuote RdrName -> RnM (LPat RdrName)
-runQuasiQuoteType :: HsQuasiQuote RdrName -> RnM (LHsType RdrName)
-runQuasiQuoteDecl :: HsQuasiQuote RdrName -> RnM [LHsDecl RdrName]
-
-runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
-
-#ifndef GHCI
-tcBracket x _ _ = pprPanic "Cant do tcBracket without GHCi" (ppr x)
-tcSpliceExpr e = pprPanic "Cant do tcSpliceExpr without GHCi" (ppr e)
-tcSplicePat e = pprPanic "Cant do tcSplicePat without GHCi" (ppr e)
-tcSpliceDecls x = pprPanic "Cant do tcSpliceDecls without GHCi" (ppr x)
-tcSpliceType x fvs = pprPanic "Cant do kcSpliceType without GHCi" (ppr x)
-
-lookupThName_maybe n = pprPanic "Cant do lookupThName_maybe without GHCi" (ppr n)
-
-runQuasiQuoteExpr q = pprPanic "Cant do runQuasiQuoteExpr without GHCi" (ppr q)
-runQuasiQuotePat q = pprPanic "Cant do runQuasiQuotePat without GHCi" (ppr q)
-runQuasiQuoteType q = pprPanic "Cant do runQuasiQuoteType without GHCi" (ppr q)
-runQuasiQuoteDecl q = pprPanic "Cant do runQuasiQuoteDecl without GHCi" (ppr q)
-runAnnotation _ q = pprPanic "Cant do runAnnotation without GHCi" (ppr q)
-#else
-\end{code}
-
-%************************************************************************
-%* *
\subsection{Quoting an expression}
%* *
%************************************************************************
@@ -526,6 +529,7 @@ tcTopSplice expr res_ty
%************************************************************************
\begin{code}
+tcSplicePat :: HsSplice Name -> TcRhoType -> TcM (HsExpr TcId)
tcSplicePat splice@(HsSplice True _ _) _
= pprPanic "tcSplicePat: encountered typed pattern splice" (ppr splice)
@@ -623,6 +627,7 @@ We don't want the type checker to see these bogus unbound variables.
Very like splicing an expression, but we don't yet share code.
\begin{code}
+tcSpliceType :: HsSplice Name -> FreeVars -> TcM (TcType, TcKind)
tcSpliceType splice@(HsSplice True _ _) _
= pprPanic "tcSpliceType: encountered a typed type splice" (ppr splice)
@@ -1151,7 +1156,6 @@ illegalTypedSplice = ptext (sLit "Typed splices may not appear in untyped bracke
illegalUntypedSplice :: SDoc
illegalUntypedSplice = ptext (sLit "Untyped splices may not appear in typed brackets")
-#endif /* GHCI */
\end{code}
@@ -1261,6 +1265,7 @@ lookupThName th_name = do
Nothing -> failWithTc (notInScope th_name)
Just name -> return name
+lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
lookupThName_maybe th_name
= do { names <- mapMaybeM lookup (thRdrNameGuesses th_name)
-- Pick the first that works
@@ -1729,3 +1734,6 @@ will appear in TH syntax like this
data T a = forall b. (a ~ [b]) => MkT1 b
| (a ~ Int) => MkT2
+\begin{code}
+#endif /* GHCI */
+\end{code} \ No newline at end of file
diff --git a/compiler/typecheck/TcSplice.lhs-boot b/compiler/typecheck/TcSplice.lhs-boot
index 9bacd1f707..07ba144958 100644
--- a/compiler/typecheck/TcSplice.lhs-boot
+++ b/compiler/typecheck/TcSplice.lhs-boot
@@ -5,19 +5,19 @@ import HsSyn ( HsSplice, HsBracket, HsQuasiQuote,
import HsExpr ( PendingSplice )
import Id ( Id )
import Name ( Name )
-import NameSet ( FreeVars )
import RdrName ( RdrName )
import TcRnTypes( TcM, TcId )
-import TcType ( TcRhoType, TcType, TcKind )
+import TcType ( TcRhoType )
import Annotations ( Annotation, CoreAnnTarget )
+
+#ifdef GHCI
import qualified Language.Haskell.TH as TH
+#endif
tcSpliceExpr :: HsSplice Name
-> TcRhoType
-> TcM (HsExpr TcId)
-tcSpliceType :: HsSplice Name -> FreeVars -> TcM (TcType, TcKind)
-
tcSpliceDecls :: HsSplice Name -> TcM [LHsDecl RdrName]
tcBracket :: HsBracket Name
@@ -27,17 +27,19 @@ tcBracket :: HsBracket Name
tcTopSpliceExpr :: Bool -> TcM (LHsExpr Id) -> TcM (LHsExpr Id)
-lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
-
runQuasiQuoteDecl :: HsQuasiQuote RdrName -> TcM [LHsDecl RdrName]
runQuasiQuoteExpr :: HsQuasiQuote RdrName -> TcM (LHsExpr RdrName)
runQuasiQuoteType :: HsQuasiQuote RdrName -> TcM (LHsType RdrName)
runQuasiQuotePat :: HsQuasiQuote RdrName -> TcM (LPat RdrName)
runAnnotation :: CoreAnnTarget -> LHsExpr Name -> TcM Annotation
-runQuasi :: TH.Q a -> TcM a
runMetaE :: LHsExpr Id -> TcM (LHsExpr RdrName)
runMetaP :: LHsExpr Id -> TcM (LPat RdrName)
runMetaT :: LHsExpr Id -> TcM (LHsType RdrName)
runMetaD :: LHsExpr Id -> TcM [LHsDecl RdrName]
+
+#ifdef GHCI
+lookupThName_maybe :: TH.Name -> TcM (Maybe Name)
+runQuasi :: TH.Q a -> TcM a
+#endif
\end{code}