diff options
| author | simonpj@microsoft.com <unknown> | 2008-10-30 09:45:28 +0000 |
|---|---|---|
| committer | simonpj@microsoft.com <unknown> | 2008-10-30 09:45:28 +0000 |
| commit | b1f3ff48870a3a4670cb41b890b78bbfffa8a32e (patch) | |
| tree | b86d2f4f78e30d5741a81dec0194d1245df5751e | |
| parent | 3bf13c8815401d1a4c1173824b26bfab13fbf406 (diff) | |
| download | haskell-b1f3ff48870a3a4670cb41b890b78bbfffa8a32e.tar.gz | |
Fix Trac #2674: in TH reject empty case expressions and function definitions
| -rw-r--r-- | compiler/hsSyn/Convert.lhs | 9 |
1 files changed, 8 insertions, 1 deletions
diff --git a/compiler/hsSyn/Convert.lhs b/compiler/hsSyn/Convert.lhs index 48844ddc85..4a35fda355 100644 --- 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) + | 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' } @@ -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 (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 |