From: simonpj@microsoft.com <unknown>
Date: Thu, 6 May 2010 16:15:23 +0000 (+0000)
Subject: Add a HsExplicitFlag to SpliceDecl, to improve Trac #4042
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=302e2e29f2e1074bfba561e077a484dc4e1d15f6

Add a HsExplicitFlag to SpliceDecl, to improve Trac #4042

The issue here is that

    g :: A -> A
    f
    data A = A

is treated as if you'd written $(f); that is the call of
f is a top-level Template Haskell splice.  This patch
makes sure that we *first* check the -XTemplateHaskellFlag
and bleat about a parse error if it's off.  Othewise we
get strange seeing "A is out of scope" errors.
---

diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs
index 0038ebe..baf6eca 100644
--- a/compiler/hsSyn/HsDecls.lhs
+++ b/compiler/hsSyn/HsDecls.lhs
@@ -232,11 +232,15 @@ instance OutputableBndr name => Outputable (HsGroup name) where
 	  ppr_ds [] = empty
 	  ppr_ds ds = blankLine $$ vcat (map ppr ds)
 
-data SpliceDecl id = SpliceDecl (Located (HsExpr id))	-- Top level splice
+data SpliceDecl id 
+  = SpliceDecl			-- Top level splice
+        (Located (HsExpr id))
+        HsExplicitFlag		-- Explicit <=> $(f x y)
+				-- Implicit <=> f x y,  i.e. a naked top level expression
     deriving (Data, Typeable)
 
 instance OutputableBndr name => Outputable (SpliceDecl name) where
-   ppr (SpliceDecl e) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
+   ppr (SpliceDecl e _) = ptext (sLit "$") <> parens (pprExpr (unLoc e))
 \end{code}
 
 
diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs
index ae4a15a..ef761e6 100644
--- a/compiler/parser/RdrHsSyn.lhs
+++ b/compiler/parser/RdrHsSyn.lhs
@@ -231,8 +231,8 @@ mkTopSpliceDecl :: LHsExpr RdrName -> HsDecl RdrName
 --      f x            then behave as if she'd written $(f x)
 --		       ie a SpliceD
 mkTopSpliceDecl (L _ (HsQuasiQuoteE qq))            = QuasiQuoteD qq
-mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ expr))) = SpliceD (SpliceDecl expr)
-mkTopSpliceDecl other_expr                          = SpliceD (SpliceDecl other_expr)
+mkTopSpliceDecl (L _ (HsSpliceE (HsSplice _ expr))) = SpliceD (SpliceDecl expr       Explicit)
+mkTopSpliceDecl other_expr                          = SpliceD (SpliceDecl other_expr Implicit)
 \end{code}
 
 %************************************************************************
diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs
index 48f1e6f..490faec 100644
--- a/compiler/rename/RnExpr.lhs
+++ b/compiler/rename/RnExpr.lhs
@@ -605,7 +605,7 @@ rnBracket (DecBrL decls)
   = do { (group, mb_splice) <- findSplice decls
        ; case mb_splice of
            Nothing -> return ()
-           Just (SpliceDecl (L loc _), _)  
+           Just (SpliceDecl (L loc _) _, _)  
               -> setSrcSpan loc $
                  addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets"))
 		-- Why not?  See Section 7.3 of the TH paper.  
diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs
index 6dce034..5d23110 100644
--- a/compiler/rename/RnSource.lhs
+++ b/compiler/rename/RnSource.lhs
@@ -1119,7 +1119,18 @@ addl gp (L l d : ds) = add gp l d ds
 add :: HsGroup RdrName -> SrcSpan -> HsDecl RdrName -> [LHsDecl RdrName]
     -> RnM (HsGroup RdrName, Maybe (SpliceDecl RdrName, [LHsDecl RdrName]))
 
-add gp _ (SpliceD e) ds = return (gp, Just (e, ds))
+add gp loc (SpliceD splice@(SpliceDecl _ flag)) ds 
+  = do { -- We've found a top-level splice.  If it is an *implicit* one 
+         -- (i.e. a naked top level expression)
+         case flag of
+           Explicit -> return ()
+           Implicit -> do { th_on <- doptM Opt_TemplateHaskell
+                          ; unless th_on $ setSrcSpan loc $
+                            failWith badImplicitSplice }
+
+       ; return (gp, Just (splice, ds)) }
+  where
+    badImplicitSplice = ptext (sLit "Parse error: naked expression at top level")
 
 #ifndef GHCI
 add _ _ (QuasiQuoteD qq) _
diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs
index c06d4e0..262bd73 100644
--- a/compiler/typecheck/TcRnDriver.lhs
+++ b/compiler/typecheck/TcRnDriver.lhs
@@ -433,7 +433,7 @@ tc_rn_src_decls boot_details ds
 	failWithTc (text "Can't do a top-level splice; need a bootstrapped compiler")
 #else
 	-- If there's a splice, we must carry on
-	   Just (SpliceDecl splice_expr, rest_ds) -> do {
+	   Just (SpliceDecl splice_expr _, rest_ds) -> do {
 
 	-- Rename the splice expression, and get its supporting decls
 	(rn_splice_expr, splice_fvs) <- checkNoErrs (rnLExpr splice_expr) ;
@@ -477,8 +477,8 @@ tcRnHsBootDecls decls
 
 		-- Check for illegal declarations
 	; case group_tail of
-	     Just (SpliceDecl d, _) -> badBootDecl "splice" d
-	     Nothing                -> return ()
+	     Just (SpliceDecl d _, _) -> badBootDecl "splice" d
+	     Nothing                  -> return ()
 	; mapM_ (badBootDecl "foreign") for_decls
 	; mapM_ (badBootDecl "default") def_decls
 	; mapM_ (badBootDecl "rule")    rule_decls