{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}

module Jikka.CPlusPlus.Language.Util where

import Control.Monad.Identity
import qualified Data.Set as S
import Jikka.CPlusPlus.Language.Expr
import Jikka.Common.Alpha
import Jikka.Common.Name

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]

newFreshName :: MonadAlpha m => NameHint -> m VarName
newFreshName :: NameHint -> m VarName
newFreshName NameHint
kind = do
  Int
i <- m Int
forall (m :: * -> *). MonadAlpha m => m Int
nextCounter
  VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return (OccName -> NameFlavour -> Maybe NameHint -> VarName
VarName OccName
forall a. Maybe a
Nothing (Int -> NameFlavour
forall a. a -> Maybe a
Just Int
i) (NameHint -> Maybe NameHint
forall a. a -> Maybe a
Just NameHint
kind))

renameVarName :: MonadAlpha m => NameHint -> VarName -> m VarName
renameVarName :: NameHint -> VarName -> m VarName
renameVarName NameHint
kind (VarName OccName
occ NameFlavour
_ Maybe NameHint
_) = case OccName
occ of
  OccName
Nothing -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
newFreshName NameHint
kind
  Just String
occ -> NameHint -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> String -> m VarName
renameVarName' NameHint
kind String
occ

renameVarName' :: MonadAlpha m => NameHint -> String -> m VarName
renameVarName' :: NameHint -> String -> m VarName
renameVarName' NameHint
kind String
occ = do
  Int
i <- m Int
forall (m :: * -> *). MonadAlpha m => m Int
nextCounter
  VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return (OccName -> NameFlavour -> Maybe NameHint -> VarName
VarName (String -> OccName
forall a. a -> Maybe a
Just String
occ) (Int -> NameFlavour
forall a. a -> Maybe a
Just Int
i) (NameHint -> Maybe NameHint
forall a. a -> Maybe a
Just NameHint
kind))

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 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)
  Callable Function
_ -> Set VarName
forall a. Set a
S.empty

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))

pattern Call' :: Function -> [Expr] -> Expr
pattern $bCall' :: Function -> [Expr] -> Expr
$mCall' :: forall r. Expr -> (Function -> [Expr] -> r) -> (Void# -> r) -> r
Call' f args = Call (Callable f) args

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] -> Expr)
-> ([[Statement]] -> [Statement]) -> [[Statement]] -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[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 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
Call (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)
      Callable Function
g -> Expr -> m Expr
f (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> Expr
Callable Function
g

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
e = (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
    go'' :: [Statement] -> m [Statement]
go'' [Statement]
body = [[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Statement]] -> [Statement]) -> m [[Statement]] -> m [Statement]
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 Statement -> m [Statement]
go [Statement]
body
    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]
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]
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]
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]
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]
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]
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 FunName
h [(Type, VarName)]
args [Statement]
body -> Type
-> FunName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
FunDef Type
ret FunName
h [(Type, VarName)]
args ([Statement] -> ToplevelStatement)
-> m [Statement] -> m ToplevelStatement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[Statement]] -> [Statement]) -> m [[Statement]] -> m [Statement]
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)
  StaticAssert Expr
e String
msg -> Expr -> String -> ToplevelStatement
StaticAssert (Expr -> String -> ToplevelStatement)
-> m Expr -> m (String -> 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 m (String -> ToplevelStatement) -> m String -> m ToplevelStatement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
msg

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)

mapExprStatementExpr :: (Expr -> Expr) -> (Statement -> [Statement]) -> Expr -> Expr
mapExprStatementExpr :: (Expr -> Expr) -> (Statement -> [Statement]) -> Expr -> Expr
mapExprStatementExpr Expr -> Expr
goE Statement -> [Statement]
goS = 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
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
goE) ([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]
goS)

mapSubExprM :: Monad m => (Expr -> m Expr) -> Expr -> m Expr
mapSubExprM :: (Expr -> m Expr) -> Expr -> m Expr
mapSubExprM Expr -> m Expr
f Expr
e = (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]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> m [Statement])
-> (Statement -> [Statement]) -> Statement -> m [Statement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [])) Expr
e

-- | `mapDirectExprStatementM` replaces exprs which are direct children of a given statement.
mapDirectExprStatementM :: Monad m => (Expr -> m Expr) -> Statement -> m Statement
mapDirectExprStatementM :: (Expr -> m Expr) -> Statement -> m Statement
mapDirectExprStatementM Expr -> m Expr
f = \case
  ExprStatement Expr
e -> Expr -> Statement
ExprStatement (Expr -> Statement) -> m Expr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
f Expr
e
  Block [Statement]
stmts -> Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return (Statement -> m Statement) -> Statement -> m Statement
forall a b. (a -> b) -> a -> b
$ [Statement] -> Statement
Block [Statement]
stmts
  If Expr
e [Statement]
body1 Maybe [Statement]
body2 -> 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
f 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body1 m (Maybe [Statement] -> Statement)
-> m (Maybe [Statement]) -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Maybe [Statement] -> m (Maybe [Statement])
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [Statement]
body2
  For Type
t VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> 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
f 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
f 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) -> AssignExpr -> m AssignExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> AssignExpr -> m AssignExpr
mapDirectExprAssignExprM Expr -> m Expr
f 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
  ForEach Type
t VarName
x Expr
e [Statement]
body -> 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
f 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
  While Expr
e [Statement]
body -> 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
f 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
  Declare Type
t VarName
x DeclareRight
init ->
    Type -> VarName -> DeclareRight -> Statement
Declare Type
t VarName
x (DeclareRight -> Statement) -> m DeclareRight -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
f 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
f [Expr]
es
  DeclareDestructure [VarName]
xs Expr
e -> [VarName] -> Expr -> Statement
DeclareDestructure [VarName]
xs (Expr -> Statement) -> m Expr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
f Expr
e
  Assign AssignExpr
e -> AssignExpr -> Statement
Assign (AssignExpr -> Statement) -> m AssignExpr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> AssignExpr -> m AssignExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> AssignExpr -> m AssignExpr
mapDirectExprAssignExprM Expr -> m Expr
f AssignExpr
e
  Assert Expr
e -> Expr -> Statement
Assert (Expr -> Statement) -> m Expr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
f Expr
e
  Return Expr
e -> Expr -> Statement
Return (Expr -> Statement) -> m Expr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr -> m Expr
f Expr
e

mapDirectExprAssignExprM :: Monad m => (Expr -> m Expr) -> AssignExpr -> m AssignExpr
mapDirectExprAssignExprM :: (Expr -> m Expr) -> AssignExpr -> m AssignExpr
mapDirectExprAssignExprM Expr -> m Expr
f = \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) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f 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
f 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) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f 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) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f LeftExpr
e

mapDirectExprLeftExprM :: Monad m => (Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM :: (Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f = \case
  LeftVar VarName
x -> LeftExpr -> m LeftExpr
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f 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
f Expr
e2
  LeftGet Integer
i LeftExpr
e -> Integer -> LeftExpr -> LeftExpr
LeftGet Integer
i (LeftExpr -> LeftExpr) -> m LeftExpr -> m LeftExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr -> m Expr) -> LeftExpr -> m LeftExpr
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr) -> LeftExpr -> m LeftExpr
mapDirectExprLeftExprM Expr -> m Expr
f LeftExpr
e

replaceExpr :: VarName -> Expr -> Expr -> Expr
replaceExpr :: VarName -> Expr -> Expr -> Expr
replaceExpr VarName
x Expr
e = (Expr -> Expr) -> (Statement -> [Statement]) -> Expr -> Expr
mapExprStatementExpr Expr -> Expr
go (Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [])
  where
    go :: Expr -> Expr
go = \case
      Var VarName
y | VarName
y VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
x -> Expr
e
      Expr
e' -> Expr
e'

replaceStatement :: VarName -> Expr -> Statement -> Statement
replaceStatement :: VarName -> Expr -> Statement -> Statement
replaceStatement VarName
x Expr
e = [Statement] -> Statement
forall a. [a] -> a
head ([Statement] -> Statement)
-> (Statement -> [Statement]) -> Statement -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 ([Statement] -> Identity [Statement])
-> (Statement -> [Statement]) -> Statement -> Identity [Statement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: []))
  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'

mapToplevelStatementProgramM :: Monad m => (ToplevelStatement -> m [ToplevelStatement]) -> Program -> m Program
mapToplevelStatementProgramM :: (ToplevelStatement -> m [ToplevelStatement])
-> Program -> m Program
mapToplevelStatementProgramM ToplevelStatement -> m [ToplevelStatement]
f Program
prog = [ToplevelStatement] -> Program
Program ([ToplevelStatement] -> Program)
-> ([[ToplevelStatement]] -> [ToplevelStatement])
-> [[ToplevelStatement]]
-> Program
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[ToplevelStatement]] -> [ToplevelStatement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[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 ToplevelStatement -> m [ToplevelStatement]
f (Program -> [ToplevelStatement]
decls Program
prog)

mapLeftExprAssignExprM :: Applicative m => (LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr
mapLeftExprAssignExprM :: (LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr
mapLeftExprAssignExprM LeftExpr -> m LeftExpr
f = \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
<$> LeftExpr -> m LeftExpr
f 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
<$> LeftExpr -> m LeftExpr
f 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
<$> LeftExpr -> m LeftExpr
f LeftExpr
e

mapLeftExprAssignExpr :: (LeftExpr -> LeftExpr) -> AssignExpr -> AssignExpr
mapLeftExprAssignExpr :: (LeftExpr -> LeftExpr) -> AssignExpr -> AssignExpr
mapLeftExprAssignExpr LeftExpr -> LeftExpr
f = Identity AssignExpr -> AssignExpr
forall a. Identity a -> a
runIdentity (Identity AssignExpr -> AssignExpr)
-> (AssignExpr -> Identity AssignExpr) -> AssignExpr -> AssignExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LeftExpr -> Identity LeftExpr)
-> AssignExpr -> Identity AssignExpr
forall (m :: * -> *).
Applicative m =>
(LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr
mapLeftExprAssignExprM (LeftExpr -> Identity LeftExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (LeftExpr -> Identity LeftExpr)
-> (LeftExpr -> LeftExpr) -> LeftExpr -> Identity LeftExpr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LeftExpr -> LeftExpr
f)

mapVarNameExprStatementGenericM :: forall m a. Monad m => ((Expr -> m Expr) -> (Statement -> m [Statement]) -> a) -> (VarName -> m VarName) -> a
mapVarNameExprStatementGenericM :: ((Expr -> m Expr) -> (Statement -> m [Statement]) -> a)
-> (VarName -> m VarName) -> a
mapVarNameExprStatementGenericM (Expr -> m Expr) -> (Statement -> m [Statement]) -> a
mapExprStatementM VarName -> m VarName
f = (Expr -> m Expr) -> (Statement -> m [Statement]) -> a
mapExprStatementM Expr -> m Expr
goE ((Statement -> [Statement]) -> m Statement -> m [Statement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: []) (m Statement -> m [Statement])
-> (Statement -> m Statement) -> Statement -> m [Statement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Statement -> m Statement
goS)
  where
    goE :: Expr -> m Expr
goE = \case
      Var VarName
x -> VarName -> Expr
Var (VarName -> Expr) -> m VarName -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x
      Lam [(Type, VarName)]
args Type
ret [Statement]
body -> [(Type, VarName)] -> Type -> [Statement] -> Expr
Lam ([(Type, VarName)] -> Type -> [Statement] -> Expr)
-> m [(Type, VarName)] -> m (Type -> [Statement] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Type, VarName) -> m (Type, VarName))
-> [(Type, VarName)] -> m [(Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Type
t, VarName
x) -> (Type
t,) (VarName -> (Type, VarName)) -> m VarName -> m (Type, VarName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x) [(Type, VarName)]
args m (Type -> [Statement] -> Expr)
-> m Type -> m ([Statement] -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> m Type
forall (f :: * -> *) a. Applicative f => a -> f a
pure Type
ret m ([Statement] -> Expr) -> m [Statement] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Statement] -> m [Statement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
      Expr
e -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
    goS :: Statement -> m Statement
    goS :: Statement -> m Statement
goS = \case
      Assign AssignExpr
e -> AssignExpr -> Statement
Assign (AssignExpr -> Statement) -> m AssignExpr -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AssignExpr -> m AssignExpr
goAssignExpr AssignExpr
e
      Declare Type
t VarName
x DeclareRight
init -> Type -> VarName -> DeclareRight -> Statement
Declare Type
t (VarName -> DeclareRight -> Statement)
-> m VarName -> m (DeclareRight -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x m (DeclareRight -> Statement) -> m DeclareRight -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> DeclareRight -> m DeclareRight
forall (f :: * -> *) a. Applicative f => a -> f a
pure DeclareRight
init
      DeclareDestructure [VarName]
xs Expr
e -> [VarName] -> Expr -> Statement
DeclareDestructure ([VarName] -> Expr -> Statement)
-> m [VarName] -> m (Expr -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarName -> m VarName) -> [VarName] -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM VarName -> m VarName
f [VarName]
xs m (Expr -> Statement) -> m Expr -> m Statement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e
      For Type
t VarName
x Expr
init Expr
pred AssignExpr
incr [Statement]
body -> Type
-> VarName
-> Expr
-> Expr
-> AssignExpr
-> [Statement]
-> Statement
For Type
t (VarName -> Expr -> Expr -> AssignExpr -> [Statement] -> Statement)
-> m VarName
-> m (Expr -> Expr -> AssignExpr -> [Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x m (Expr -> Expr -> AssignExpr -> [Statement] -> Statement)
-> m Expr -> m (Expr -> AssignExpr -> [Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
pred m (AssignExpr -> [Statement] -> Statement)
-> m AssignExpr -> m ([Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AssignExpr -> m AssignExpr
goAssignExpr 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
      ForEach Type
t VarName
x Expr
e [Statement]
body -> Type -> VarName -> Expr -> [Statement] -> Statement
ForEach Type
t (VarName -> Expr -> [Statement] -> Statement)
-> m VarName -> m (Expr -> [Statement] -> Statement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x m (Expr -> [Statement] -> Statement)
-> m Expr -> m ([Statement] -> Statement)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
      Statement
stmt -> Statement -> m Statement
forall (m :: * -> *) a. Monad m => a -> m a
return Statement
stmt
    goAssignExpr :: AssignExpr -> m AssignExpr
goAssignExpr = (LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr
forall (m :: * -> *).
Applicative m =>
(LeftExpr -> m LeftExpr) -> AssignExpr -> m AssignExpr
mapLeftExprAssignExprM LeftExpr -> m LeftExpr
goLeftExpr
    goLeftExpr :: LeftExpr -> m LeftExpr
goLeftExpr = \case
      LeftVar VarName
x -> VarName -> LeftExpr
LeftVar (VarName -> LeftExpr) -> m VarName -> m LeftExpr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f 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
<$> LeftExpr -> m LeftExpr
goLeftExpr 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
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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
<$> LeftExpr -> m LeftExpr
goLeftExpr LeftExpr
e

mapVarNameStatementM :: Monad m => (VarName -> m VarName) -> Statement -> m Statement
mapVarNameStatementM :: (VarName -> m VarName) -> Statement -> m Statement
mapVarNameStatementM VarName -> m VarName
f Statement
stmt = [Statement] -> Statement
forall a. [a] -> a
head ([Statement] -> Statement) -> m [Statement] -> m Statement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Expr -> m Expr)
 -> (Statement -> m [Statement]) -> Statement -> m [Statement])
-> (VarName -> m VarName) -> Statement -> m [Statement]
forall (m :: * -> *) a.
Monad m =>
((Expr -> m Expr) -> (Statement -> m [Statement]) -> a)
-> (VarName -> m VarName) -> a
mapVarNameExprStatementGenericM (Expr -> m Expr)
-> (Statement -> m [Statement]) -> Statement -> m [Statement]
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m [Statement]) -> Statement -> m [Statement]
mapExprStatementStatementM VarName -> m VarName
f Statement
stmt

mapVarNameToplevelStatementM :: Monad m => (VarName -> m VarName) -> ToplevelStatement -> m ToplevelStatement
mapVarNameToplevelStatementM :: (VarName -> m VarName) -> ToplevelStatement -> m ToplevelStatement
mapVarNameToplevelStatementM VarName -> m VarName
f ToplevelStatement
stmt = do
  ToplevelStatement
stmt <- case ToplevelStatement
stmt of
    VarDef Type
t VarName
x Expr
e -> Type -> VarName -> Expr -> ToplevelStatement
VarDef Type
t (VarName -> Expr -> ToplevelStatement)
-> m VarName -> m (Expr -> ToplevelStatement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x m (Expr -> ToplevelStatement) -> m Expr -> m ToplevelStatement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e
    FunDef Type
ret FunName
g [(Type, VarName)]
args [Statement]
body -> Type
-> FunName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
FunDef Type
ret FunName
g ([(Type, VarName)] -> [Statement] -> ToplevelStatement)
-> m [(Type, VarName)] -> m ([Statement] -> ToplevelStatement)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Type, VarName) -> m (Type, VarName))
-> [(Type, VarName)] -> m [(Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(Type
t, VarName
x) -> (Type
t,) (VarName -> (Type, VarName)) -> m VarName -> m (Type, VarName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarName -> m VarName
f VarName
x) [(Type, VarName)]
args m ([Statement] -> ToplevelStatement)
-> m [Statement] -> m ToplevelStatement
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Statement] -> m [Statement]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Statement]
body
    ToplevelStatement
_ -> ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *) a. Monad m => a -> m a
return ToplevelStatement
stmt
  ((Expr -> m Expr)
 -> (Statement -> m [Statement])
 -> ToplevelStatement
 -> m ToplevelStatement)
-> (VarName -> m VarName)
-> ToplevelStatement
-> m ToplevelStatement
forall (m :: * -> *) a.
Monad m =>
((Expr -> m Expr) -> (Statement -> m [Statement]) -> a)
-> (VarName -> m VarName) -> a
mapVarNameExprStatementGenericM (Expr -> m Expr)
-> (Statement -> m [Statement])
-> ToplevelStatement
-> m ToplevelStatement
forall (m :: * -> *).
Monad m =>
(Expr -> m Expr)
-> (Statement -> m [Statement])
-> ToplevelStatement
-> m ToplevelStatement
mapExprStatementToplevelStatementM VarName -> m VarName
f ToplevelStatement
stmt

mapVarNameProgramM :: Monad m => (VarName -> m VarName) -> Program -> m Program
mapVarNameProgramM :: (VarName -> m VarName) -> Program -> m Program
mapVarNameProgramM VarName -> m VarName
f = (ToplevelStatement -> m [ToplevelStatement])
-> Program -> m Program
forall (m :: * -> *).
Monad m =>
(ToplevelStatement -> m [ToplevelStatement])
-> Program -> m Program
mapToplevelStatementProgramM ((ToplevelStatement -> [ToplevelStatement])
-> m ToplevelStatement -> m [ToplevelStatement]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ToplevelStatement -> [ToplevelStatement] -> [ToplevelStatement]
forall a. a -> [a] -> [a]
: []) (m ToplevelStatement -> m [ToplevelStatement])
-> (ToplevelStatement -> m ToplevelStatement)
-> ToplevelStatement
-> m [ToplevelStatement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarName -> m VarName) -> ToplevelStatement -> m ToplevelStatement
forall (m :: * -> *).
Monad m =>
(VarName -> m VarName) -> ToplevelStatement -> m ToplevelStatement
mapVarNameToplevelStatementM VarName -> m VarName
f)

renameVarNameStatement :: VarName -> VarName -> Statement -> Statement
renameVarNameStatement :: VarName -> VarName -> Statement -> Statement
renameVarNameStatement VarName
x VarName
y = 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
. (VarName -> Identity VarName) -> Statement -> Identity Statement
forall (m :: * -> *).
Monad m =>
(VarName -> m VarName) -> Statement -> m Statement
mapVarNameStatementM (\VarName
z -> VarName -> Identity VarName
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName -> Identity VarName) -> VarName -> Identity VarName
forall a b. (a -> b) -> a -> b
$ if VarName
z VarName -> VarName -> Bool
forall a. Eq a => a -> a -> Bool
== VarName
x then VarName
y else VarName
z)