diff options
| author | Mikhail Vorozhtsov <mikhail.vorozhtsov@gmail.com> | 2011-04-23 12:06:38 +0700 |
|---|---|---|
| committer | Simon Marlow <marlowsd@gmail.com> | 2012-07-16 11:09:35 +0100 |
| commit | b1e97f2f325537664f09eee7ea0e7c53264b061e (patch) | |
| tree | 3e66009147692d7dfb408325c431c8f5a126d798 /compiler/deSugar/DsExpr.lhs | |
| parent | c1f01e351759e7c25818b05e32bdb7b702dac6f2 (diff) | |
| download | haskell-b1e97f2f325537664f09eee7ea0e7c53264b061e.tar.gz | |
Implemented \case expressions.
Diffstat (limited to 'compiler/deSugar/DsExpr.lhs')
| -rw-r--r-- | compiler/deSugar/DsExpr.lhs | 9 |
1 files changed, 9 insertions, 0 deletions
diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index 11fa5d53c9..4795b5f68c 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -205,6 +205,15 @@ dsExpr (NegApp expr neg_expr) dsExpr (HsLam a_Match) = uncurry mkLams <$> matchWrapper LambdaExpr a_Match +dsExpr (HsLamCase arg matches@(MatchGroup _ rhs_ty)) + | isEmptyMatchGroup matches -- A Core 'case' is always non-empty + = -- So desugar empty HsLamCase to error call + mkErrorAppDs pAT_ERROR_ID (funResultTy rhs_ty) (ptext (sLit "\\case")) + | otherwise + = do { arg_var <- newSysLocalDs arg + ; ([discrim_var], matching_code) <- matchWrapper CaseAlt matches + ; return $ Lam arg_var $ bindNonRec discrim_var (Var arg_var) matching_code } + dsExpr (HsApp fun arg) = mkCoreAppDs <$> dsLExpr fun <*> dsLExpr arg \end{code} |