[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 (file)
--- 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 (file)
--- 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) }