module Curry.ExtendedFlat.MonadicGoodies
( UpdateM, postOrderM, updFuncExpsM, updProgFuncsM, updFuncLetsM
) where
import Control.Monad
import Curry.ExtendedFlat.Type
type UpdateM m a b = (b -> m b) -> a -> m a
postOrderM :: Monad m => UpdateM m Expr Expr
postOrderM f = po where
po e@(Var _) = f e
po e@(Lit _) = f e
po (Comb t n es) = do es' <- mapM po es
f (Comb t n es')
po (Free vs e) = do e' <- po e
f (Free vs e')
po (Let bs e) = do bs' <- mapM poBind bs
e' <- po e
f (Let bs' e')
po (Or l r) = liftM2 Or (po l) (po r) >>= f
po (Case r t e bs) = do e' <- po e
bs' <- mapM poBranch bs
f (Case r t e' bs')
po (Typed e ty) = do e' <- po e
f (Typed e' ty)
poBind (v, rhs) = do rhs' <- po rhs
return (v, rhs')
poBranch (Branch p rhs) = do rhs' <- po rhs
return (Branch p rhs')
updFuncExpsM :: Monad m => UpdateM m FuncDecl Expr
updFuncExpsM f (Func name arity visibility ftype (Rule vs e)) = do
e' <- postOrderM f e
return (Func name arity visibility ftype (Rule vs e'))
updFuncExpsM _ func@(Func _ _ _ _ (External _)) = return func
updProgFuncsM :: Monad m => UpdateM m Prog FuncDecl
updProgFuncsM f (Prog name imps types funcs ops) = do
funcs' <- mapM f funcs
return (Prog name imps types funcs' ops)
updFuncLetsM :: Monad m => ([(VarIndex, Expr)] -> Expr -> m Expr)
-> FuncDecl -> m FuncDecl
updFuncLetsM = updFuncExpsM . updExprLetsM where
updExprLetsM f (Let bs e) = f bs e
updExprLetsM _ e = return e