From: simonpj <unknown>
Date: Mon, 19 Jul 2004 11:29:39 +0000 (+0000)
Subject: [project @ 2004-07-19 11:29:34 by simonpj]
X-Git-Tag: Initial_conversion_from_CVS_complete~1779
X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=c92ad29760f7e307bade71ff51ca10563fd6d474

[project @ 2004-07-19 11:29:34 by simonpj]
Template Haskell improvements

a) Make '() and '[] work.
b) Add tupleTypeName, tupleDataName
b) Try to improve error message for (lack of) existential data constructors in TH
---

diff --git a/ghc/compiler/deSugar/DsMeta.hs b/ghc/compiler/deSugar/DsMeta.hs
index 0f1ee5e..23117b0 100644
--- a/ghc/compiler/deSugar/DsMeta.hs
+++ b/ghc/compiler/deSugar/DsMeta.hs
@@ -211,11 +211,10 @@ repTyClD (L loc (ClassDecl { tcdCtxt = cxt, tcdLName = cls,
     	return $ Just (loc, dec) }
 
 -- Un-handled cases
-repTyClD (L loc d) = do { dsWarn (loc, hang msg 4 (ppr d)) ;
+repTyClD (L loc d) = do { dsWarn (loc, hang ds_msg 4 (ppr d)) ;
 	          	   return Nothing
 	     		 }
-  where
-    msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
+
 
 repInstD' (L loc (InstDecl ty binds _))		-- Ignore user pragmas for now
  = do	{ i <- addTyVarBinds tvs $ \tv_bndrs ->
@@ -266,15 +265,23 @@ repSafety PlayRisky = rep2 unsafeName []
 repSafety (PlaySafe False) = rep2 safeName []
 repSafety (PlaySafe True) = rep2 threadsafeName []
 
+ds_msg = ptext SLIT("Cannot desugar this Template Haskell declaration:")
+
 -------------------------------------------------------
 -- 			Constructors
 -------------------------------------------------------
 
 repC :: LConDecl Name -> DsM (Core TH.ConQ)
 repC (L loc (ConDecl con [] (L _ []) details))
-  = do { con1     <- lookupLOcc con ;		-- See note [Binders and occurrences] 
+  = do { con1 <- lookupLOcc con ;		-- See note [Binders and occurrences] 
 	 repConstr con1 details }
 
+repC (L loc con_decl)
+  = do	{ dsWarn (loc, hang ds_msg 4 (ppr con_decl))
+	; return (panic "DsMeta:repC") }
+  where
+
+
 repBangTy :: LBangType Name -> DsM (Core (TH.StrictTypeQ))
 repBangTy (L _ (BangType str ty)) = do 
   MkC s <- rep2 strName []
diff --git a/ghc/compiler/parser/Parser.y.pp b/ghc/compiler/parser/Parser.y.pp
index 4f7890d..a5e5da4 100644
--- a/ghc/compiler/parser/Parser.y.pp
+++ b/ghc/compiler/parser/Parser.y.pp
@@ -1076,7 +1076,7 @@ aexp2	:: { LHsExpr RdrName }
 	| '$(' exp ')'   	{ LL $ HsSpliceE (mkHsSplice $2) }               -- $( exp )
 
 	| TH_VAR_QUOTE qvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
-	| TH_VAR_QUOTE qcon 	{ LL $ HsBracket (VarBr (unLoc $2)) }
+	| TH_VAR_QUOTE gcon 	{ LL $ HsBracket (VarBr (unLoc $2)) }
 	| TH_TY_QUOTE tyvar 	{ LL $ HsBracket (VarBr (unLoc $2)) }
  	| TH_TY_QUOTE gtycon	{ LL $ HsBracket (VarBr (unLoc $2)) }
 	| '[|' exp '|]'         { LL $ HsBracket (ExpBr $2) }