Commit c92ad297 authored by simonpj's avatar simonpj

[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
parent be5bbcf6
......@@ -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 []
......
......@@ -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) }
......
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