projects
/
ghc-hetmet.git
/ commitdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
| commitdiff |
tree
raw
|
patch
|
inline
| side by side (parent:
3bf13c8
)
Fix Trac #2674: in TH reject empty case expressions and function definitions
author
simonpj@microsoft.com
<unknown>
Thu, 30 Oct 2008 09:45:28 +0000
(09:45 +0000)
committer
simonpj@microsoft.com
<unknown>
Thu, 30 Oct 2008 09:45:28 +0000
(09:45 +0000)
compiler/hsSyn/Convert.lhs
patch
|
blob
|
history
diff --git
a/compiler/hsSyn/Convert.lhs
b/compiler/hsSyn/Convert.lhs
index
48844dd
..
4a35fda
100644
(file)
--- a/
compiler/hsSyn/Convert.lhs
+++ b/
compiler/hsSyn/Convert.lhs
@@
-327,6
+327,11
@@
cvtBind (TH.ValD (TH.VarP s) body ds)
; returnL $ mkFunBind s' [cl'] }
cvtBind (TH.FunD nm cls)
; returnL $ mkFunBind s' [cl'] }
cvtBind (TH.FunD nm cls)
+ | null cls
+ = failWith (ptext (sLit "Function binding for")
+ <+> quotes (text (TH.pprint nm))
+ <+> ptext (sLit "has no equations"))
+ | otherwise
= do { nm' <- vNameL nm
; cls' <- mapM cvtClause cls
; returnL $ mkFunBind nm' cls' }
= do { nm' <- vNameL nm
; cls' <- mapM cvtClause cls
; returnL $ mkFunBind nm' cls' }
@@
-371,7
+376,9
@@
cvtl e = wrapL (cvt e)
cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z
; return $ HsIf x' y' z' }
cvt (LetE ds e) = do { ds' <- cvtDecs ds; e' <- cvtl e; return $ HsLet ds' e' }
cvt (CondE x y z) = do { x' <- cvtl x; y' <- cvtl y; z' <- cvtl z
; return $ HsIf x' y' z' }
cvt (LetE ds e) = do { ds' <- cvtDecs ds; e' <- cvtl e; return $ HsLet ds' e' }
- cvt (CaseE e ms) = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
+ cvt (CaseE e ms)
+ | null ms = failWith (ptext (sLit "Case expression with no alternatives"))
+ | otherwise = do { e' <- cvtl e; ms' <- mapM cvtMatch ms
; return $ HsCase e' (mkMatchGroup ms') }
cvt (DoE ss) = cvtHsDo DoExpr ss
cvt (CompE ss) = cvtHsDo ListComp ss
; return $ HsCase e' (mkMatchGroup ms') }
cvt (DoE ss) = cvtHsDo DoExpr ss
cvt (CompE ss) = cvtHsDo ListComp ss