{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Jikka.CPlusPlus.Language.Util where

import Control.Monad.Identity
import Data.Char (isAlphaNum)
import qualified Data.Set as S
import Jikka.CPlusPlus.Language.Expr
import Jikka.Common.Alpha

fromLeftExpr :: LeftExpr -> Expr
fromLeftExpr :: LeftExpr -> Expr
fromLeftExpr = \case
  LeftVar VarName
x -> VarName -> Expr
Var VarName
x
  LeftAt LeftExpr
x Expr
e -> Function -> [Expr] -> Expr
Call Function
At [LeftExpr -> Expr
fromLeftExpr LeftExpr
x, Expr
e]
  LeftGet Integer
n LeftExpr
e -> Function -> [Expr] -> Expr
Call (FunName -> [Type] -> Function
Function FunName
"std::get" [Integer -> Type
TyIntValue Integer
n]) [LeftExpr -> Expr
fromLeftExpr LeftExpr
e]

data NameKind
  = LocalNameKind
  | LocalArgumentNameKind
  | LoopCounterNameKind
  | ConstantNameKind
  | FunctionNameKind
  | ArgumentNameKind
  deriving (NameKind -> NameKind -> Bool
(NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool) -> Eq NameKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NameKind -> NameKind -> Bool
$c/= :: NameKind -> NameKind -> Bool
== :: NameKind -> NameKind -> Bool
$c== :: NameKind -> NameKind -> Bool
Eq, Eq NameKind
Eq NameKind
-> (NameKind -> NameKind -> Ordering)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> Bool)
-> (NameKind -> NameKind -> NameKind)
-> (NameKind -> NameKind -> NameKind)
-> Ord NameKind
NameKind -> NameKind -> Bool
NameKind -> NameKind -> Ordering
NameKind -> NameKind -> NameKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NameKind -> NameKind -> NameKind
$cmin :: NameKind -> NameKind -> NameKind
max :: NameKind -> NameKind -> NameKind
$cmax :: NameKind -> NameKind -> NameKind
>= :: NameKind -> NameKind -> Bool
$c>= :: NameKind -> NameKind -> Bool
> :: NameKind -> NameKind -> Bool
$c> :: NameKind -> NameKind -> Bool
<= :: NameKind -> NameKind -> Bool
$c<= :: NameKind -> NameKind -> Bool
< :: NameKind -> NameKind -> Bool
$c< :: NameKind -> NameKind -> Bool
compare :: NameKind -> NameKind -> Ordering
$ccompare :: NameKind -> NameKind -> Ordering
$cp1Ord :: Eq NameKind
Ord, Int -> NameKind -> ShowS
[NameKind] -> ShowS
NameKind -> String
(Int -> NameKind -> ShowS)
-> (NameKind -> String) -> ([NameKind] -> ShowS) -> Show NameKind
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NameKind] -> ShowS
$cshowList :: [NameKind] -> ShowS
show :: NameKind -> String
$cshow :: NameKind -> String
showsPrec :: Int -> NameKind -> ShowS
$cshowsPrec :: Int -> NameKind -> ShowS
Show, ReadPrec [NameKind]
ReadPrec NameKind
Int -> ReadS NameKind
ReadS [NameKind]
(Int -> ReadS NameKind)
-> ReadS [NameKind]
-> ReadPrec NameKind
-> ReadPrec [NameKind]
-> Read NameKind
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [NameKind]
$creadListPrec :: ReadPrec [NameKind]
readPrec :: ReadPrec NameKind
$creadPrec :: ReadPrec NameKind
readList :: ReadS [NameKind]
$creadList :: ReadS [NameKind]
readsPrec :: Int -> ReadS NameKind
$creadsPrec :: Int -> ReadS NameKind
Read)

fromNameKind :: NameKind -> String
fromNameKind :: NameKind -> String
fromNameKind = \case
  NameKind
LocalNameKind -> String
"x"
  NameKind
LocalArgumentNameKind -> String
"b"
  NameKind
LoopCounterNameKind -> String
"i"
  NameKind
ConstantNameKind -> String
"c"
  NameKind
FunctionNameKind -> String
"f"
  NameKind
ArgumentNameKind -> String
"a"

newFreshName :: MonadAlpha m => NameKind -> m VarName
newFreshName :: NameKind -> m VarName
newFreshName NameKind
kind = NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
renameVarName NameKind
kind String
""

renameVarName :: MonadAlpha m => NameKind -> String -> m VarName
renameVarName :: NameKind -> String -> m VarName
renameVarName NameKind
kind String
hint = do
  Int
i <- m Int
forall (m :: * -> *). MonadAlpha m => m Int
nextCounter
  let prefix :: String
prefix = case (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_') String
hint of
        String
"" -> NameKind -> String
fromNameKind NameKind
kind
        String
hint' -> String
hint' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"_"
  VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> VarName
VarName (String
prefix String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i))

freeVars :: Expr -> S.Set VarName
freeVars :: Expr -> Set VarName
freeVars = \case
  Var VarName
x -> VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x
  Lit Literal
_ -> Set VarName
forall a. Set a
S.empty
  UnOp UnaryOp
_ Expr
e -> Expr -> Set VarName
freeVars Expr
e
  BinOp BinaryOp
_ Expr
e1 Expr
e2 -> Expr -> Set VarName
freeVars Expr
e1 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e2
  Cond Expr
e1 Expr
e2 Expr
e3 -> Expr -> Set VarName
freeVars Expr
e1 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e2 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e3
  Lam [(Type, VarName)]
args Type
_ [Statement]
body -> [Statement] -> Set VarName
freeVarsStatements [Statement]
body Set VarName -> Set VarName -> Set VarName
forall a. Ord a => Set a -> Set a -> Set a
S.\\ [VarName] -> Set VarName
forall a. Ord a => [a] -> Set a
S.fromList (((Type, VarName) -> VarName) -> [(Type, VarName)] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd [(Type, VarName)]
args)
  Call Function
_ [Expr]
args -> [Set VarName] -> Set VarName
forall a. Monoid a => [a] -> a
mconcat ((Expr -> Set VarName) -> [Expr] -> [Set VarName]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Set VarName
freeVars [Expr]
args)
  CallExpr Expr
f [Expr]
args -> Expr -> Set VarName
freeVars Expr
f Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> [Set VarName] -> Set VarName
forall a. Monoid a => [a] -> a
mconcat ((Expr -> Set VarName) -> [Expr] -> [Set VarName]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Set VarName
freeVars [Expr]
args)

freeVarsStatements :: [Statement] -> S.Set VarName
freeVarsStatements :: [Statement] -> Set VarName
freeVarsStatements = [Set VarName] -> Set VarName
forall a. Monoid a => [a] -> a
mconcat ([Set VarName] -> Set VarName)
-> ([Statement] -> [Set VarName]) -> [Statement] -> Set VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> Set VarName) -> [Statement] -> [Set VarName]
forall a b. (a -> b) -> [a] -> [b]
map Statement -> Set VarName
freeVarsStatement

freeVarsStatement :: Statement -> S.Set VarName
freeVarsStatement :: Statement -> Set VarName
freeVarsStatement = \case
  ExprStatement Expr
e -> Expr -> Set VarName
freeVars Expr
e
  Block [Statement]
stmts -> [Statement] -> Set VarName
freeVarsStatements [Statement]
stmts
  If Expr
e [Statement]
body1 Maybe [Statement]
body2 -> Expr -> Set VarName
freeVars Expr
e Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> [Statement] -> Set VarName
freeVarsStatements [Statement]
body1 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Maybe (Set VarName) -> Set VarName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions (([Statement] -> Set VarName)
-> Maybe [Statement] -> Maybe (Set VarName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Statement] -> Set VarName
freeVarsStatements Maybe [Statement]
body2)
  For Type
_ VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
init Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
pred Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> AssignExpr -> Set VarName
freeVarsAssignExpr AssignExpr
incr Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> [Statement] -> Set VarName
freeVarsStatements [Statement]
body
  ForEach Type
_ VarName
x Expr
e [Statement]
body -> VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> [Statement] -> Set VarName
freeVarsStatements [Statement]
body
  While Expr
e [Statement]
body -> Expr -> Set VarName
freeVars Expr
e Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> [Statement] -> Set VarName
freeVarsStatements [Statement]
body
  Declare Type
_ VarName
x DeclareRight
init -> VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> DeclareRight -> Set VarName
freeVarsDeclareRight DeclareRight
init
  DeclareDestructure [VarName]
xs Expr
e -> [VarName] -> Set VarName
forall a. Ord a => [a] -> Set a
S.fromList [VarName]
xs Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e
  Assign AssignExpr
e -> AssignExpr -> Set VarName
freeVarsAssignExpr AssignExpr
e
  Assert Expr
e -> Expr -> Set VarName
freeVars Expr
e
  Return Expr
e -> Expr -> Set VarName
freeVars Expr
e

freeVarsDeclareRight :: DeclareRight -> S.Set VarName
freeVarsDeclareRight :: DeclareRight -> Set VarName
freeVarsDeclareRight = \case
  DeclareRight
DeclareDefault -> Set VarName
forall a. Set a
S.empty
  DeclareCopy Expr
e -> Expr -> Set VarName
freeVars Expr
e
  DeclareInitialize [Expr]
es -> [Set VarName] -> Set VarName
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ((Expr -> Set VarName) -> [Expr] -> [Set VarName]
forall a b. (a -> b) -> [a] -> [b]
map Expr -> Set VarName
freeVars [Expr]
es)

freeVarsAssignExpr :: AssignExpr -> S.Set VarName
freeVarsAssignExpr :: AssignExpr -> Set VarName
freeVarsAssignExpr = \case
  AssignExpr AssignOp
_ LeftExpr
e1 Expr
e2 -> LeftExpr -> Set VarName
freeVarsLeftExpr LeftExpr
e1 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e2
  AssignIncr LeftExpr
e -> LeftExpr -> Set VarName
freeVarsLeftExpr LeftExpr
e
  AssignDecr LeftExpr
e -> LeftExpr -> Set VarName
freeVarsLeftExpr LeftExpr
e

freeVarsLeftExpr :: LeftExpr -> S.Set VarName
freeVarsLeftExpr :: LeftExpr -> Set VarName
freeVarsLeftExpr = \case
  LeftVar VarName
x -> VarName -> Set VarName
forall a. a -> Set a
S.singleton VarName
x
  LeftAt LeftExpr
e1 Expr
e2 -> LeftExpr -> Set VarName
freeVarsLeftExpr LeftExpr
e1 Set VarName -> Set VarName -> Set VarName
forall a. Semigroup a => a -> a -> a
<> Expr -> Set VarName
freeVars Expr
e2
  LeftGet Integer
_ LeftExpr
e -> LeftExpr -> Set VarName
freeVarsLeftExpr LeftExpr
e

shouldBeArray :: [Type] -> Bool
shouldBeArray :: [Type] -> Bool
shouldBeArray [Type]
ts = Bool -> Bool
not ([Type] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
ts) Bool -> Bool -> Bool
&& [Type]
ts [Type] -> [Type] -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Type -> [Type]
forall a. Int -> a -> [a]
replicate ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts) ([Type] -> Type
forall a. [a] -> a
head [Type]
ts)

cinStatement :: Expr -> Statement
cinStatement :: Expr -> Statement
cinStatement Expr
e = Expr -> Statement
ExprStatement (BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
BitRightShift (VarName -> Expr
Var VarName
"std::cin") Expr
e)

coutStatement :: Expr -> Statement
coutStatement :: Expr -> Statement
coutStatement Expr
e = Expr -> Statement
ExprStatement (BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
BitLeftShift (BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
BitLeftShift (VarName -> Expr
Var VarName
"std::cout") Expr
e) (Literal -> Expr
Lit (Char -> Literal
LitChar Char
' ')))

repStatement :: VarName -> Expr -> [Statement] -> Statement
repStatement :: VarName -> Expr -> [Statement] -> Statement
repStatement VarName
i Expr
n [Statement]
body = Type
-> VarName
-> Expr
-> Expr
-> AssignExpr
-> [Statement]
-> Statement
For Type
TyInt32 VarName
i (Literal -> Expr
Lit (Integer -> Literal
LitInt32 Integer
0)) (BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
LessThan (VarName -> Expr
Var VarName
i) Expr
n) (LeftExpr -> AssignExpr
AssignIncr (VarName -> LeftExpr
LeftVar VarName
i)) [Statement]
body

litInt64 :: Integer -> Expr
litInt64 :: Integer -> Expr
litInt64 Integer
n = Literal -> Expr
Lit (Integer -> Literal
LitInt64 Integer
n)

litInt32 :: Integer -> Expr
litInt32 :: Integer -> Expr
litInt32 Integer
n = Literal -> Expr
Lit (Integer -> Literal
LitInt32 Integer
n)

incrExpr :: Expr -> Expr
incrExpr :: Expr -> Expr
incrExpr Expr
e = BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
Add Expr
e (Literal -> Expr
Lit (Integer -> Literal
LitInt32 Integer
1))

size :: Expr -> Expr
size :: Expr -> Expr
size Expr
e = Function -> [Expr] -> Expr
Call Function
MethodSize [Expr
e]

at :: Expr -> Expr -> Expr
at :: Expr -> Expr -> Expr
at Expr
e Expr
i = Function -> [Expr] -> Expr
Call Function
At [Expr
e, Expr
i]

cast :: Type -> Expr -> Expr
cast :: Type -> Expr -> Expr
cast Type
t Expr
e = Function -> [Expr] -> Expr
Call (Type -> Function
Cast Type
t) [Expr
e]

assignSimple :: VarName -> Expr -> Statement
assignSimple :: VarName -> Expr -> Statement
assignSimple VarName
x Expr
e = AssignExpr -> Statement
Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
SimpleAssign (VarName -> LeftExpr
LeftVar VarName
x) Expr
e)

assignAt :: VarName -> Expr -> Expr -> Statement
assignAt :: VarName -> Expr -> Expr -> Statement
assignAt VarName
xs Expr
i Expr
e = AssignExpr -> Statement
Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
SimpleAssign (LeftExpr -> Expr -> LeftExpr
LeftAt (VarName -> LeftExpr
LeftVar VarName
xs) Expr
i) Expr
e)

callFunction :: FunName -> [Type] -> [Expr] -> Expr
callFunction :: FunName -> [Type] -> [Expr] -> Expr
callFunction FunName
f [Type]
ts [Expr]
args = Function -> [Expr] -> Expr
Call (FunName -> [Type] -> Function
Function FunName
f [Type]
ts) [Expr]
args

callFunction' :: FunName -> [Type] -> [Expr] -> Statement
callFunction' :: FunName -> [Type] -> [Expr] -> Statement
callFunction' = ((Expr -> Statement
ExprStatement (Expr -> Statement) -> ([Expr] -> Expr) -> [Expr] -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([Expr] -> Expr) -> [Expr] -> Statement)
-> ([Type] -> [Expr] -> Expr) -> [Type] -> [Expr] -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([Type] -> [Expr] -> Expr) -> [Type] -> [Expr] -> Statement)
-> (FunName -> [Type] -> [Expr] -> Expr)
-> FunName
-> [Type]
-> [Expr]
-> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FunName -> [Type] -> [Expr] -> Expr
callFunction

callMethod :: Expr -> FunName -> [Expr] -> Expr
callMethod :: Expr -> FunName -> [Expr] -> Expr
callMethod Expr
e FunName
f [Expr]
args = Function -> [Expr] -> Expr
Call (FunName -> Function
Method FunName
f) (Expr
e Expr -> [Expr] -> [Expr]
forall a. a -> [a] -> [a]
: [Expr]
args)

callMethod' :: Expr -> FunName -> [Expr] -> Statement
callMethod' :: Expr -> FunName -> [Expr] -> Statement
callMethod' = ((Expr -> Statement
ExprStatement (Expr -> Statement) -> ([Expr] -> Expr) -> [Expr] -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (([Expr] -> Expr) -> [Expr] -> Statement)
-> (FunName -> [Expr] -> Expr) -> FunName -> [Expr] -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((FunName -> [Expr] -> Expr) -> FunName -> [Expr] -> Statement)
-> (Expr -> FunName -> [Expr] -> Expr)
-> Expr
-> FunName
-> [Expr]
-> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> FunName -> [Expr] -> Expr
callMethod

vecCtor :: Type -> [Expr] -> Expr
vecCtor :: Type -> [Expr] -> Expr
vecCtor Type
t [Expr]
es = Function -> [Expr] -> Expr
Call (Type -> Function
VecCtor Type
t) [Expr]
es

begin :: Expr -> Expr
begin :: Expr -> Expr
begin Expr
e = Function -> [Expr] -> Expr
Call (FunName -> Function
Method FunName
"begin") [Expr
e]

end :: Expr -> Expr
end :: Expr -> Expr
end Expr
e = Function -> [Expr] -> Expr
Call (FunName -> Function
Method FunName
"end") [Expr
e]

mapExprStatementExprM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM :: (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> m Expr
f Statement -> m Statement
g = Expr -> m Expr
go
  where
    go :: Expr -> m Expr
go = \case
      Var VarName
x -> Expr -> m Expr
f (VarName -> Expr
Var VarName
x)
      Lit Literal
lit -> Expr -> m Expr
f (Literal -> Expr
Lit Literal
lit)
      UnOp UnaryOp
op Expr
e -> Expr -> m Expr
f (Expr -> m Expr) -> (Expr -> Expr) -> Expr -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnaryOp -> Expr -> Expr
UnOp UnaryOp
op (Expr -> m Expr) -> m Expr -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> m Expr
go Expr
e
      BinOp BinaryOp
op Expr
e1 Expr
e2 -> Expr -> m Expr
f (Expr -> m Expr) -> m Expr -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (BinaryOp -> Expr -> Expr -> Expr
BinOp BinaryOp
op (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go Expr
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
go Expr
e2)
      Cond Expr
e1 Expr
e2 Expr
e3 -> Expr -> m Expr
f (Expr -> m Expr) -> m Expr -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> Expr -> Expr -> Expr
Cond (Expr -> Expr -> Expr -> Expr)
-> m Expr -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go Expr
e1 m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
go Expr
e2 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
go Expr
e3)
      Lam [(Type, VarName)]
args Type
ret [Statement]
body -> Expr -> m Expr
f (Expr -> m Expr) -> ([Statement] -> Expr) -> [Statement] -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Type, VarName)] -> Type -> [Statement] -> Expr
Lam [(Type, VarName)]
args Type
ret ([Statement] -> m Expr) -> m [Statement] -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
mapExprStatementStatementM Expr -> m Expr
f Statement -> m Statement
g) [Statement]
body
      Call Function
g [Expr]
args -> Expr -> m Expr
f (Expr -> m Expr) -> ([Expr] -> Expr) -> [Expr] -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Function -> [Expr] -> Expr
Call Function
g ([Expr] -> m Expr) -> m [Expr] -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
go [Expr]
args
      CallExpr Expr
g [Expr]
args -> Expr -> m Expr
f (Expr -> m Expr) -> m Expr -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> [Expr] -> Expr
CallExpr (Expr -> [Expr] -> Expr) -> m Expr -> m ([Expr] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go Expr
g m ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
go [Expr]
args)

mapExprStatementLeftExprM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM :: (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g = \case
  LeftVar VarName
x -> LeftExpr -> m LeftExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftExpr -> m LeftExpr) -> LeftExpr -> m LeftExpr
forall a b. (a -> b) -> a -> b
$ VarName -> LeftExpr
LeftVar VarName
x
  LeftAt LeftExpr
e1 Expr
e2 -> LeftExpr -> Expr -> LeftExpr
LeftAt (LeftExpr -> Expr -> LeftExpr)
-> m LeftExpr -> m (Expr -> LeftExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g LeftExpr
e1 m (Expr -> LeftExpr) -> m Expr -> m LeftExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> m Expr
f Statement -> m Statement
g Expr
e2
  LeftGet Integer
n LeftExpr
e -> Integer -> LeftExpr -> LeftExpr
LeftGet Integer
n (LeftExpr -> LeftExpr) -> m LeftExpr -> m LeftExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g LeftExpr
e

mapExprStatementAssignExprM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
mapExprStatementAssignExprM :: (Expr -> m Expr)
-> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
mapExprStatementAssignExprM Expr -> m Expr
f Statement -> m Statement
g = \case
  AssignExpr AssignOp
op LeftExpr
e1 Expr
e2 -> AssignOp -> LeftExpr -> Expr -> AssignExpr
AssignExpr AssignOp
op (LeftExpr -> Expr -> AssignExpr)
-> m LeftExpr -> m (Expr -> AssignExpr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g LeftExpr
e1 m (Expr -> AssignExpr) -> m Expr -> m AssignExpr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> m Expr
f Statement -> m Statement
g Expr
e2
  AssignIncr LeftExpr
e -> LeftExpr -> AssignExpr
AssignIncr (LeftExpr -> AssignExpr) -> m LeftExpr -> m AssignExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g LeftExpr
e
  AssignDecr LeftExpr
e -> LeftExpr -> AssignExpr
AssignDecr (LeftExpr -> AssignExpr) -> m LeftExpr -> m AssignExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> LeftExpr -> m LeftExpr
mapExprStatementLeftExprM Expr -> m Expr
f Statement -> m Statement
g LeftExpr
e

mapExprStatementStatementM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> Statement -> m Statement
mapExprStatementStatementM :: (Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
mapExprStatementStatementM Expr -> m Expr
f Statement -> m Statement
g = Statement -> m Statement
go
  where
    go' :: Expr -> m Expr
go' = (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> m Expr
f Statement -> m Statement
g
    go :: Statement -> m Statement
go = \case
      ExprStatement Expr
e -> Statement -> m Statement
g (Statement -> m Statement)
-> (Expr -> Statement) -> Expr -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Statement
ExprStatement (Expr -> m Statement) -> m Expr -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> m Expr
go' Expr
e
      Block [Statement]
stmts -> Statement -> m Statement
g (Statement -> m Statement)
-> ([Statement] -> Statement) -> [Statement] -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Statement] -> Statement
Block ([Statement] -> m Statement) -> m [Statement] -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go [Statement]
stmts
      If Expr
e [Statement]
body1 Maybe [Statement]
body2 -> Statement -> m Statement
g (Statement -> m Statement) -> m Statement -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> [Statement] -> Maybe [Statement] -> Statement
If (Expr -> [Statement] -> Maybe [Statement] -> Statement)
-> m Expr -> m ([Statement] -> Maybe [Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go' Expr
e m ([Statement] -> Maybe [Statement] -> Statement)
-> m [Statement] -> m (Maybe [Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go [Statement]
body1 m (Maybe [Statement] -> Statement)
-> m (Maybe [Statement]) -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([Statement] -> m [Statement])
-> Maybe [Statement] -> m (Maybe [Statement])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go) Maybe [Statement]
body2)
      For Type
t VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> Statement -> m Statement
g (Statement -> m Statement) -> m Statement -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Type
-> VarName
-> Expr
-> Expr
-> AssignExpr
-> [Statement]
-> Statement
For Type
t VarName
x (Expr -> Expr -> AssignExpr -> [Statement] -> Statement)
-> m Expr -> m (Expr -> AssignExpr -> [Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go' Expr
init m (Expr -> AssignExpr -> [Statement] -> Statement)
-> m Expr -> m (AssignExpr -> [Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
go' Expr
pred m (AssignExpr -> [Statement] -> Statement)
-> m AssignExpr -> m ([Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr -> m Expr)
-> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
mapExprStatementAssignExprM Expr -> m Expr
f Statement -> m Statement
g AssignExpr
incr m ([Statement] -> Statement) -> m [Statement] -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go [Statement]
body)
      ForEach Type
t VarName
x Expr
e [Statement]
body -> Statement -> m Statement
g (Statement -> m Statement) -> m Statement -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Type -> VarName -> Expr -> [Statement] -> Statement
ForEach Type
t VarName
x (Expr -> [Statement] -> Statement)
-> m Expr -> m ([Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go' Expr
e m ([Statement] -> Statement) -> m [Statement] -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go [Statement]
body)
      While Expr
e [Statement]
body -> Statement -> m Statement
g (Statement -> m Statement) -> m Statement -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> [Statement] -> Statement
While (Expr -> [Statement] -> Statement)
-> m Expr -> m ([Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go' Expr
e m ([Statement] -> Statement) -> m [Statement] -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Statement -> m Statement
go [Statement]
body)
      Declare Type
t VarName
x DeclareRight
init -> do
        DeclareRight
init <- case DeclareRight
init of
          DeclareRight
DeclareDefault -> DeclareRight -> m DeclareRight
forall (m :: * -> *) a. Monad m => a -> m a
return DeclareRight
DeclareDefault
          DeclareCopy Expr
e -> Expr -> DeclareRight
DeclareCopy (Expr -> DeclareRight) -> m Expr -> m DeclareRight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
go' Expr
e
          DeclareInitialize [Expr]
es -> [Expr] -> DeclareRight
DeclareInitialize ([Expr] -> DeclareRight) -> m [Expr] -> m DeclareRight
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr -> m Expr
go' [Expr]
es
        Statement -> m Statement
g (Statement -> m Statement) -> Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
x DeclareRight
init
      DeclareDestructure [VarName]
xs Expr
e -> Statement -> m Statement
g (Statement -> m Statement)
-> (Expr -> Statement) -> Expr -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VarName] -> Expr -> Statement
DeclareDestructure [VarName]
xs (Expr -> m Statement) -> m Expr -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> m Expr
go' Expr
e
      Assign AssignExpr
e -> Statement -> m Statement
g (Statement -> m Statement)
-> (AssignExpr -> Statement) -> AssignExpr -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssignExpr -> Statement
Assign (AssignExpr -> m Statement) -> m AssignExpr -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Expr -> m Expr)
-> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> AssignExpr -> m AssignExpr
mapExprStatementAssignExprM Expr -> m Expr
f Statement -> m Statement
g AssignExpr
e
      Assert Expr
e -> Statement -> m Statement
g (Statement -> m Statement)
-> (Expr -> Statement) -> Expr -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Statement
Assert (Expr -> m Statement) -> m Expr -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> m Expr
go' Expr
e
      Return Expr
e -> Statement -> m Statement
g (Statement -> m Statement)
-> (Expr -> Statement) -> Expr -> m Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Statement
Return (Expr -> m Statement) -> m Expr -> m Statement
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Expr -> m Expr
go' Expr
e

mapExprStatementToplevelStatementM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> ToplevelStatement -> m ToplevelStatement
mapExprStatementToplevelStatementM :: (Expr -> m Expr)
-> (Statement -> m Statement)
-> ToplevelStatement
-> m ToplevelStatement
mapExprStatementToplevelStatementM Expr -> m Expr
f Statement -> m Statement
g = \case
  VarDef Type
t VarName
x Expr
e -> Type -> VarName -> Expr -> ToplevelStatement
VarDef Type
t VarName
x (Expr -> ToplevelStatement) -> m Expr -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> m Expr
f Statement -> m Statement
g Expr
e
  FunDef Type
ret VarName
h [(Type, VarName)]
args [Statement]
body -> Type
-> VarName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
FunDef Type
ret VarName
h [(Type, VarName)]
args ([Statement] -> ToplevelStatement)
-> m [Statement] -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Statement -> m Statement) -> [Statement] -> m [Statement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
mapExprStatementStatementM Expr -> m Expr
f Statement -> m Statement
g) [Statement]
body

mapExprStatementProgramM :: Monad m => (Expr -> m Expr) -> (Statement -> m Statement) -> Program -> m Program
mapExprStatementProgramM :: (Expr -> m Expr)
-> (Statement -> m Statement) -> Program -> m Program
mapExprStatementProgramM Expr -> m Expr
f Statement -> m Statement
g (Program [ToplevelStatement]
decls) = [ToplevelStatement] -> Program
Program ([ToplevelStatement] -> Program)
-> m [ToplevelStatement] -> m Program
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ToplevelStatement -> m ToplevelStatement)
-> [ToplevelStatement] -> m [ToplevelStatement]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Expr -> m Expr)
-> (Statement -> m Statement)
-> ToplevelStatement
-> m ToplevelStatement
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement)
-> ToplevelStatement
-> m ToplevelStatement
mapExprStatementToplevelStatementM Expr -> m Expr
f Statement -> m Statement
g) [ToplevelStatement]
decls

mapExprStatementProgram :: (Expr -> Expr) -> (Statement -> Statement) -> Program -> Program
mapExprStatementProgram :: (Expr -> Expr) -> (Statement -> Statement) -> Program -> Program
mapExprStatementProgram Expr -> Expr
f Statement -> Statement
g = Identity Program -> Program
forall a. Identity a -> a
runIdentity (Identity Program -> Program)
-> (Program -> Identity Program) -> Program -> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Identity Expr)
-> (Statement -> Identity Statement) -> Program -> Identity Program
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> Program -> m Program
mapExprStatementProgramM (Expr -> Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> Identity Expr) -> (Expr -> Expr) -> Expr -> Identity Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
f) (Statement -> Identity Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> Identity Statement)
-> (Statement -> Statement) -> Statement -> Identity Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> Statement
g)

replaceExpr :: VarName -> Expr -> Expr -> Expr
replaceExpr :: VarName -> Expr -> Expr -> Expr
replaceExpr VarName
x Expr
e = Identity Expr -> Expr
forall a. Identity a -> a
runIdentity (Identity Expr -> Expr) -> (Expr -> Identity Expr) -> Expr -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Identity Expr)
-> (Statement -> Identity Statement) -> Expr -> Identity Expr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> (Statement -> m Statement) -> Expr -> m Expr
mapExprStatementExprM Expr -> Identity Expr
go Statement -> Identity Statement
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    go :: Expr -> Identity Expr
go = \case
      Var VarName
y | VarName
y VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
x -> Expr -> Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
      Expr
e' -> Expr -> Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e'

replaceStatement :: VarName -> Expr -> Statement -> Statement
replaceStatement :: VarName -> Expr -> Statement -> Statement
replaceStatement VarName
x Expr
e = Identity Statement -> Statement
forall a. Identity a -> a
runIdentity (Identity Statement -> Statement)
-> (Statement -> Identity Statement) -> Statement -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Expr -> Identity Expr)
-> (Statement -> Identity Statement)
-> Statement
-> Identity Statement
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m Statement) -> Statement -> m Statement
mapExprStatementStatementM Expr -> Identity Expr
go Statement -> Identity Statement
forall (m :: * -> *) a. Monad m => a -> m a
return
  where
    go :: Expr -> Identity Expr
go = \case
      Var VarName
y | VarName
y VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
x -> Expr -> Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
      Expr
e' -> Expr -> Identity Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e'