diff options
Diffstat (limited to 'compiler/GHC/HsToCore')
| -rw-r--r-- | compiler/GHC/HsToCore/Arrows.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Coverage.hs | 20 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Expr.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 2 |
4 files changed, 13 insertions, 13 deletions
diff --git a/compiler/GHC/HsToCore/Arrows.hs b/compiler/GHC/HsToCore/Arrows.hs index 4a31b9fc8d..3054eceecf 100644 --- a/compiler/GHC/HsToCore/Arrows.hs +++ b/compiler/GHC/HsToCore/Arrows.hs @@ -602,7 +602,7 @@ dsCmd ids local_vars stack_ty res_ty -- -- ---> premap (\ ((xs),stk) -> let binds in ((ys),stk)) c -dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ lbinds@binds body) env_ids = do +dsCmd ids local_vars stack_ty res_ty (HsCmdLet _ _ lbinds@binds _ body) env_ids = do let defined_vars = mkVarSet (collectLocalBinders CollWithDictBinders binds) local_vars' = defined_vars `unionVarSet` local_vars diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs index a6b9944292..326abee504 100644 --- a/compiler/GHC/HsToCore/Coverage.hs +++ b/compiler/GHC/HsToCore/Coverage.hs @@ -575,11 +575,11 @@ addTickHsExpr (HsMultiIf ty alts) = do { let isOneOfMany = case alts of [_] -> False; _ -> True ; alts' <- mapM (liftL $ addTickGRHS isOneOfMany False) alts ; return $ HsMultiIf ty alts' } -addTickHsExpr (HsLet x binds e) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ - liftM2 (HsLet x) - (addTickHsLocalBinds binds) -- to think about: !patterns. - (addTickLHsExprLetBody e) +addTickHsExpr (HsLet x tkLet binds tkIn e) = + bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + binds' <- addTickHsLocalBinds binds -- to think about: !patterns. + e' <- addTickLHsExprLetBody e + return (HsLet x tkLet binds' tkIn e') addTickHsExpr (HsDo srcloc cxt (L l stmts)) = do { (stmts', _) <- addTickLStmts' forQual stmts (return ()) ; return (HsDo srcloc cxt (L l stmts')) } @@ -884,11 +884,11 @@ addTickHsCmd (HsCmdIf x cnd e1 c2 c3) = (addBinTickLHsExpr (BinBox CondBinBox) e1) (addTickLHsCmd c2) (addTickLHsCmd c3) -addTickHsCmd (HsCmdLet x binds c) = - bindLocals (collectLocalBinders CollNoDictBinders binds) $ - liftM2 (HsCmdLet x) - (addTickHsLocalBinds binds) -- to think about: !patterns. - (addTickLHsCmd c) +addTickHsCmd (HsCmdLet x tkLet binds tkIn c) = + bindLocals (collectLocalBinders CollNoDictBinders binds) $ do + binds' <- addTickHsLocalBinds binds -- to think about: !patterns. + c' <- addTickLHsCmd c + return (HsCmdLet x tkLet binds' tkIn c') addTickHsCmd (HsCmdDo srcloc (L l stmts)) = do { (stmts', _) <- addTickLCmdStmts' stmts (return ()) ; return (HsCmdDo srcloc (L l stmts')) } diff --git a/compiler/GHC/HsToCore/Expr.hs b/compiler/GHC/HsToCore/Expr.hs index 602950bf3e..fa322a774b 100644 --- a/compiler/GHC/HsToCore/Expr.hs +++ b/compiler/GHC/HsToCore/Expr.hs @@ -357,7 +357,7 @@ dsExpr (HsCase _ discrim matches) -- Pepe: The binds are in scope in the body but NOT in the binding group -- This is to avoid silliness in breakpoints -dsExpr (HsLet _ binds body) = do +dsExpr (HsLet _ _ binds _ body) = do body' <- dsLExpr body dsLocalBinds binds body' diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 0860192e68..20a8a8622c 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -1526,7 +1526,7 @@ repE (HsMultiIf _ alts) = do { (binds, alts') <- liftM unzip $ mapM repLGRHS alts ; expr' <- repMultiIf (nonEmptyCoreList alts') ; wrapGenSyms (concat binds) expr' } -repE (HsLet _ bs e) = do { (ss,ds) <- repBinds bs +repE (HsLet _ _ bs _ e) = do { (ss,ds) <- repBinds bs ; e2 <- addBinds ss (repLE e) ; z <- repLetE ds e2 ; wrapGenSyms ss z } |