- (stmts',_) <- addTickLStmts' isGuard stmts [] (return ())
- return stmts'
-
-addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [LStmt Id]
- -> [LStmt Id] -> TM a -> TM ([LStmt Id], a)
-addTickLStmts' isGuard [] acc do_rhs = do
- rhs <- do_rhs
- return (reverse acc, rhs)
-addTickLStmts' isGuard (s:ss) acc do_rhs = do
- (s', binders) <- addTickLStmt isGuard s
- bindLocals binders $ addTickLStmts' isGuard ss (s':acc) do_rhs
-
-addTickLStmt isGuard (L pos stmt) = do
- (stmt',vars) <- addTickStmt isGuard stmt
- return (L pos stmt', vars)
-
-addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt Id -> TM (Stmt Id, [Id])
+ (stmts, _) <- addTickLStmts' isGuard stmts (return ())
+ return stmts
+
+addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [LStmt Id] -> TM a
+ -> TM ([LStmt Id], a)
+addTickLStmts' isGuard lstmts res
+ = bindLocals binders $ do
+ lstmts' <- mapM (liftL (addTickStmt isGuard)) lstmts
+ a <- res
+ return (lstmts', a)
+ where
+ binders = map unLoc (collectLStmtsBinders lstmts)
+
+addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt Id -> TM (Stmt Id)