X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FdeSugar%2FDsMeta.hs;fp=compiler%2FdeSugar%2FDsMeta.hs;h=3a2dda8127f686700ee74f0f4202c7eec3b0b271;hp=ce0f23113de905d40287f1dd6e15ce1bb0a0f43a;hb=ffabe3acb2d30be0c8e89e139f5bca7a1eb900f6;hpb=fed25228aec3f3bd2f91c50d67043d83efb1af18 diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs index ce0f231..3a2dda8 100644 --- a/compiler/deSugar/DsMeta.hs +++ b/compiler/deSugar/DsMeta.hs @@ -724,23 +724,19 @@ repE (HsLet bs e) = do { (ss,ds) <- repBinds bs ; wrapGenSyms ss z } -- FIXME: I haven't got the types here right yet -repE e@(HsDo ctxt sts body _) +repE e@(HsDo ctxt sts _) | case ctxt of { DoExpr -> True; GhciStmt -> True; _ -> False } = do { (ss,zs) <- repLSts sts; - body' <- addBinds ss $ repLE body; - ret <- repNoBindSt body'; - e' <- repDoE (nonEmptyCoreList (zs ++ [ret])); + e' <- repDoE (nonEmptyCoreList zs); wrapGenSyms ss e' } | ListComp <- ctxt = do { (ss,zs) <- repLSts sts; - body' <- addBinds ss $ repLE body; - ret <- repNoBindSt body'; - e' <- repComp (nonEmptyCoreList (zs ++ [ret])); + e' <- repComp (nonEmptyCoreList zs); wrapGenSyms ss e' } | otherwise - = notHandled "mdo and [: :]" (ppr e) + = notHandled "mdo, monad comprehension and [: :]" (ppr e) repE (ExplicitList _ es) = do { xs <- repLEs es; repListExp xs } repE e@(ExplicitPArr _ _) = notHandled "Parallel arrays" (ppr e) @@ -820,7 +816,7 @@ repGuards other wrapGenSyms (concat xs) gd } where process :: LGRHS Name -> DsM ([GenSymBind], (Core (TH.Q (TH.Guard, TH.Exp)))) - process (L _ (GRHS [L _ (ExprStmt e1 _ _)] e2)) + process (L _ (GRHS [L _ (ExprStmt e1 _ _ _)] e2)) = do { x <- repLNormalGE e1 e2; return ([], x) } process (L _ (GRHS ss rhs)) @@ -879,7 +875,7 @@ repSts (LetStmt bs : ss) = ; z <- repLetSt ds ; (ss2,zs) <- addBinds ss1 (repSts ss) ; return (ss1++ss2, z : zs) } -repSts (ExprStmt e _ _ : ss) = +repSts (ExprStmt e _ _ _ : ss) = do { e2 <- repLE e ; z <- repNoBindSt e2 ; (ss2,zs) <- repSts ss