Commit 0917c5db authored by simonpj's avatar simonpj
Browse files

[project @ 2002-12-10 15:27:58 by simonpj]

Report TH errors better in stage 1
parent 8a8eee36
...@@ -581,19 +581,32 @@ implicitModuleFVs source_fvs ...@@ -581,19 +581,32 @@ implicitModuleFVs source_fvs
namesNeededForFlattening `plusFV` namesNeededForFlattening `plusFV`
ubiquitousNames ubiquitousNames
thProxyName :: NameSet
mkTemplateHaskellFVs :: NameSet -> NameSet
-- This is a bit of a hack. When we see the Template-Haskell construct -- This is a bit of a hack. When we see the Template-Haskell construct
-- [| expr |] -- [| expr |]
-- we are going to need lots of the ``smart constructors'' defined in -- we are going to need lots of the ``smart constructors'' defined in
-- the main Template Haskell data type module. Rather than treat them -- the main Template Haskell data type module. Rather than treat them
-- all as free vars at every occurrence site, we just make the Q type -- all as free vars at every occurrence site, we just make the Q type
-- consructor a free var.... and then use that here to haul in the others -- consructor a free var.... and then use that here to haul in the others
mkTemplateHaskellFVs source_fvs
#ifdef GHCI #ifdef GHCI
-- Only if Template Haskell is enabled --------------- Template Haskell enabled --------------
thProxyName = unitFV qTyConName
mkTemplateHaskellFVs source_fvs
| qTyConName `elemNameSet` source_fvs = templateHaskellNames | qTyConName `elemNameSet` source_fvs = templateHaskellNames
#endif
| otherwise = emptyFVs | otherwise = emptyFVs
#else
--------------- Template Haskell disabled --------------
thProxyName = emptyFVs
mkTemplateHaskellFVs source_fvs = emptyFVs
#endif
--------------------------------------------------------
-- ubiquitous_names are loaded regardless, because -- ubiquitous_names are loaded regardless, because
-- they are needed in virtually every program -- they are needed in virtually every program
ubiquitousNames ubiquitousNames
......
...@@ -43,9 +43,6 @@ import PrelNames ( hasKey, assertIdKey, ...@@ -43,9 +43,6 @@ import PrelNames ( hasKey, assertIdKey,
crossPName, zipPName, toPName, crossPName, zipPName, toPName,
enumFromToPName, enumFromThenToPName, assertErrorName, enumFromToPName, enumFromThenToPName, assertErrorName,
negateName, monadNames, mfixName ) negateName, monadNames, mfixName )
#ifdef GHCI
import DsMeta ( qTyConName )
#endif
import Name ( Name, nameOccName ) import Name ( Name, nameOccName )
import NameSet import NameSet
import UnicodeUtil ( stringToUtf8 ) import UnicodeUtil ( stringToUtf8 )
...@@ -227,30 +224,26 @@ rnExpr (HsPar e) ...@@ -227,30 +224,26 @@ rnExpr (HsPar e)
returnM (HsPar e', fvs_e) returnM (HsPar e', fvs_e)
-- Template Haskell extensions -- Template Haskell extensions
#ifdef GHCI -- Don't ifdef-GHCI them because we want to fail gracefully
rnExpr (HsBracket br_body loc) -- (not with an rnExpr crash) in a stage-1 compiler.
= addSrcLoc loc $ rnExpr e@(HsBracket br_body loc)
checkGHCI (thErr "bracket") `thenM_` = addSrcLoc loc $
rnBracket br_body `thenM` \ (body', fvs_e) -> checkTH e "bracket" `thenM_`
returnM (HsBracket body' loc, fvs_e `addOneFV` qTyConName) rnBracket br_body `thenM` \ (body', fvs_e) ->
-- We use the Q tycon as a proxy to haul in all the smart returnM (HsBracket body' loc, fvs_e `plusFV` thProxyName)
-- constructors; see the hack in RnIfaces
rnExpr e@(HsSplice n splice loc)
rnExpr (HsSplice n e loc) = addSrcLoc loc $
= addSrcLoc loc $ checkTH e "splice" `thenM_`
checkGHCI (thErr "splice") `thenM_` newLocalsRn [(n,loc)] `thenM` \ [n'] ->
newLocalsRn [(n,loc)] `thenM` \ [n'] -> rnExpr splice `thenM` \ (splice', fvs_e) ->
rnExpr e `thenM` \ (e', fvs_e) -> returnM (HsSplice n' splice' loc, fvs_e `plusFV` thProxyName)
returnM (HsSplice n' e' loc, fvs_e `addOneFV` qTyConName)
-- The qTyCon brutally pulls in all the meta stuff rnExpr e@(HsReify (Reify flavour name))
= checkTH e "reify" `thenM_`
rnExpr (HsReify (Reify flavour name)) lookupGlobalOccRn name `thenM` \ name' ->
= checkGHCI (thErr "reify") `thenM_`
lookupGlobalOccRn name `thenM` \ name' ->
-- For now, we can only reify top-level things -- For now, we can only reify top-level things
returnM (HsReify (Reify flavour name'), mkFVs [name', qTyConName]) returnM (HsReify (Reify flavour name'), unitFV name' `plusFV` thProxyName)
-- The qTyCon brutally pulls in all the meta stuff
#endif
rnExpr section@(SectionL expr op) rnExpr section@(SectionL expr op)
= rnExpr expr `thenM` \ (expr', fvs_expr) -> = rnExpr expr `thenM` \ (expr', fvs_expr) ->
...@@ -917,9 +910,14 @@ doStmtListErr do_or_lc e ...@@ -917,9 +910,14 @@ doStmtListErr do_or_lc e
MDoExpr -> "mdo" MDoExpr -> "mdo"
other -> "do" other -> "do"
thErr what #ifdef GHCI
= ptext SLIT("Template Haskell") <+> text what <+> checkTH e what = returnRn () -- OK
ptext SLIT("illegal in a stage-1 compiler") #else
checkTH e what -- Raise an error in a stage-1 compiler
= addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
ptext SLIT("illegal in a stage-1 compiler"),
nest 2 (ppr e)])
#endif
badIpBinds binds badIpBinds binds
= hang (ptext SLIT("Implicit-parameter bindings illegal in a parallel list comprehension:")) 4 = hang (ptext SLIT("Implicit-parameter bindings illegal in a parallel list comprehension:")) 4
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment