{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Jikka.CPlusPlus.Convert.FromCore
( run,
)
where
import Control.Monad.Writer.Strict
import qualified Jikka.CPlusPlus.Language.Expr as Y
import qualified Jikka.CPlusPlus.Language.Util as Y
import Jikka.Common.Alpha
import Jikka.Common.Error
import Jikka.Common.Name
import qualified Jikka.Core.Format as X (formatBuiltinIsolated, formatType)
import qualified Jikka.Core.Language.BuiltinPatterns as X
import qualified Jikka.Core.Language.Eta as X
import qualified Jikka.Core.Language.Expr as X
import qualified Jikka.Core.Language.LambdaPatterns as X
import qualified Jikka.Core.Language.TypeCheck as X
import qualified Jikka.Core.Language.Util as X
renameVarName' :: MonadAlpha m => NameHint -> X.VarName -> m Y.VarName
renameVarName' :: NameHint -> VarName -> m VarName
renameVarName' NameHint
kind (X.VarName OccName
occ NameFlavour
_) = case OccName
occ of
OccName
Nothing -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
kind
Just String
occ -> NameHint -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> String -> m VarName
Y.renameVarName' NameHint
kind String
occ
renameFunName' :: MonadError Error m => X.VarName -> m Y.FunName
renameFunName' :: VarName -> m FunName
renameFunName' = \case
X.VarName (Just String
occ) NameFlavour
_ -> FunName -> m FunName
forall (m :: * -> *) a. Monad m => a -> m a
return (FunName -> m FunName) -> FunName -> m FunName
forall a b. (a -> b) -> a -> b
$ String -> FunName
Y.FunName String
occ
VarName
_ -> String -> m FunName
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"annonymous toplevel-let is not allowed"
newFreshNameWithAdHocHintFromExpr :: MonadAlpha m => String -> Y.Expr -> m Y.VarName
newFreshNameWithAdHocHintFromExpr :: String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
prefix Expr
e = case Expr
e of
Y.Var (Y.VarName (Just String
occ) NameFlavour
_ Maybe NameHint
_) -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName (String -> NameHint
AdHocNameHint (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
occ))
Expr
_ -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName (String -> NameHint
AdHocNameHint String
prefix)
newFreshNameWithAdHocHintFromExpr' :: MonadAlpha m => String -> X.Expr -> m Y.VarName
newFreshNameWithAdHocHintFromExpr' :: String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr' String
prefix Expr
e = case Expr
e of
X.Var (X.VarName (Just String
occ) NameFlavour
_) -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName (String -> NameHint
AdHocNameHint (String
prefix String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
occ))
Expr
_ -> NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName (String -> NameHint
AdHocNameHint String
prefix)
data Env = Env
{ Env -> [(VarName, Type)]
typeEnv :: [(X.VarName, X.Type)],
Env -> [(VarName, VarName)]
varMapping :: [(X.VarName, Y.VarName)],
Env -> [(VarName, FunName)]
funMapping :: [(X.VarName, Y.FunName)]
}
deriving (Env -> Env -> Bool
(Env -> Env -> Bool) -> (Env -> Env -> Bool) -> Eq Env
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Env -> Env -> Bool
$c/= :: Env -> Env -> Bool
== :: Env -> Env -> Bool
$c== :: Env -> Env -> Bool
Eq, Eq Env
Eq Env
-> (Env -> Env -> Ordering)
-> (Env -> Env -> Bool)
-> (Env -> Env -> Bool)
-> (Env -> Env -> Bool)
-> (Env -> Env -> Bool)
-> (Env -> Env -> Env)
-> (Env -> Env -> Env)
-> Ord Env
Env -> Env -> Bool
Env -> Env -> Ordering
Env -> Env -> Env
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 :: Env -> Env -> Env
$cmin :: Env -> Env -> Env
max :: Env -> Env -> Env
$cmax :: Env -> Env -> Env
>= :: Env -> Env -> Bool
$c>= :: Env -> Env -> Bool
> :: Env -> Env -> Bool
$c> :: Env -> Env -> Bool
<= :: Env -> Env -> Bool
$c<= :: Env -> Env -> Bool
< :: Env -> Env -> Bool
$c< :: Env -> Env -> Bool
compare :: Env -> Env -> Ordering
$ccompare :: Env -> Env -> Ordering
$cp1Ord :: Eq Env
Ord, Int -> Env -> String -> String
[Env] -> String -> String
Env -> String
(Int -> Env -> String -> String)
-> (Env -> String) -> ([Env] -> String -> String) -> Show Env
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Env] -> String -> String
$cshowList :: [Env] -> String -> String
show :: Env -> String
$cshow :: Env -> String
showsPrec :: Int -> Env -> String -> String
$cshowsPrec :: Int -> Env -> String -> String
Show, ReadPrec [Env]
ReadPrec Env
Int -> ReadS Env
ReadS [Env]
(Int -> ReadS Env)
-> ReadS [Env] -> ReadPrec Env -> ReadPrec [Env] -> Read Env
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Env]
$creadListPrec :: ReadPrec [Env]
readPrec :: ReadPrec Env
$creadPrec :: ReadPrec Env
readList :: ReadS [Env]
$creadList :: ReadS [Env]
readsPrec :: Int -> ReadS Env
$creadsPrec :: Int -> ReadS Env
Read)
emptyEnv :: Env
emptyEnv :: Env
emptyEnv =
Env :: [(VarName, Type)]
-> [(VarName, VarName)] -> [(VarName, FunName)] -> Env
Env
{ typeEnv :: [(VarName, Type)]
typeEnv = [],
varMapping :: [(VarName, VarName)]
varMapping = [],
funMapping :: [(VarName, FunName)]
funMapping = []
}
pushVar :: X.VarName -> X.Type -> Y.VarName -> Env -> Env
pushVar :: VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env =
Env
env
{ typeEnv :: [(VarName, Type)]
typeEnv = (VarName
x, Type
t) (VarName, Type) -> [(VarName, Type)] -> [(VarName, Type)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, Type)]
typeEnv Env
env,
varMapping :: [(VarName, VarName)]
varMapping = (VarName
x, VarName
y) (VarName, VarName) -> [(VarName, VarName)] -> [(VarName, VarName)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, VarName)]
varMapping Env
env
}
pushFun :: X.VarName -> X.Type -> Y.FunName -> Env -> Env
pushFun :: VarName -> Type -> FunName -> Env -> Env
pushFun VarName
x Type
t FunName
y Env
env =
Env
env
{ typeEnv :: [(VarName, Type)]
typeEnv = (VarName
x, Type
t) (VarName, Type) -> [(VarName, Type)] -> [(VarName, Type)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, Type)]
typeEnv Env
env,
funMapping :: [(VarName, FunName)]
funMapping = (VarName
x, FunName
y) (VarName, FunName) -> [(VarName, FunName)] -> [(VarName, FunName)]
forall a. a -> [a] -> [a]
: Env -> [(VarName, FunName)]
funMapping Env
env
}
typecheckExpr :: MonadError Error m => Env -> X.Expr -> m X.Type
typecheckExpr :: Env -> Expr -> m Type
typecheckExpr Env
env = [(VarName, Type)] -> Expr -> m Type
forall (m :: * -> *).
MonadError Error m =>
[(VarName, Type)] -> Expr -> m Type
X.typecheckExpr (Env -> [(VarName, Type)]
typeEnv Env
env)
lookupVarName :: MonadError Error m => Env -> X.VarName -> m Y.VarName
lookupVarName :: Env -> VarName -> m VarName
lookupVarName Env
env VarName
x = case VarName -> [(VarName, VarName)] -> Maybe VarName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VarName
x (Env -> [(VarName, VarName)]
varMapping Env
env) of
Just VarName
y -> VarName -> m VarName
forall (m :: * -> *) a. Monad m => a -> m a
return VarName
y
Maybe VarName
Nothing -> String -> m VarName
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m VarName) -> String -> m VarName
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
X.formatVarName VarName
x
lookupFunName :: MonadError Error m => Env -> X.VarName -> m Y.FunName
lookupFunName :: Env -> VarName -> m FunName
lookupFunName Env
env VarName
x = case VarName -> [(VarName, FunName)] -> Maybe FunName
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup VarName
x (Env -> [(VarName, FunName)]
funMapping Env
env) of
Just FunName
y -> FunName -> m FunName
forall (m :: * -> *) a. Monad m => a -> m a
return FunName
y
Maybe FunName
Nothing -> String -> m FunName
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m FunName) -> String -> m FunName
forall a b. (a -> b) -> a -> b
$ String
"undefined function: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
X.formatVarName VarName
x
class Monad m => MonadStatements m where
useStatement :: Y.Statement -> m ()
instance Monad m => MonadStatements (WriterT (Dual [Y.Statement]) m) where
useStatement :: Statement -> WriterT (Dual [Statement]) m ()
useStatement Statement
stmt = Dual [Statement] -> WriterT (Dual [Statement]) m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Dual [Statement] -> WriterT (Dual [Statement]) m ())
-> Dual [Statement] -> WriterT (Dual [Statement]) m ()
forall a b. (a -> b) -> a -> b
$ [Statement] -> Dual [Statement]
forall a. a -> Dual a
Dual [Statement
stmt]
useStatements :: MonadStatements m => [Y.Statement] -> m ()
useStatements :: [Statement] -> m ()
useStatements = (Statement -> m ()) -> [Statement] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement
runStatementsT :: Monad m => WriterT (Dual [Y.Statement]) m a -> m ([Y.Statement], a)
runStatementsT :: WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT WriterT (Dual [Statement]) m a
f = do
(a
a, Dual [Statement]
stmts) <- WriterT (Dual [Statement]) m a -> m (a, Dual [Statement])
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (Dual [Statement]) m a
f
([Statement], a) -> m ([Statement], a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> [Statement]
forall a. [a] -> [a]
reverse (Dual [Statement] -> [Statement]
forall a. Dual a -> a
getDual Dual [Statement]
stmts), a
a)
runType :: MonadError Error m => X.Type -> m Y.Type
runType :: Type -> m Type
runType = \case
t :: Type
t@X.VarTy {} -> String -> m Type
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Type) -> String -> m Type
forall a b. (a -> b) -> a -> b
$ String
"cannot convert type variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Type -> String
X.formatType Type
t
Type
X.IntTy -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.TyInt64
Type
X.BoolTy -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.TyBool
X.ListTy Type
t -> Type -> Type
Y.TyVector (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
X.TupleTy [Type]
ts -> do
[Type]
ts <- (Type -> m Type) -> [Type] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType [Type]
ts
Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$
if [Type] -> Bool
Y.shouldBeArray [Type]
ts
then Type -> Integer -> Type
Y.TyArray ([Type] -> Type
forall a. [a] -> a
head [Type]
ts) (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts))
else [Type] -> Type
Y.TyTuple [Type]
ts
X.FunTy Type
t Type
ret -> Type -> [Type] -> Type
Y.TyFunction (Type -> [Type] -> Type) -> m Type -> m ([Type] -> Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret m ([Type] -> Type) -> m [Type] -> m Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Type -> m Type) -> [Type] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType [Type
t]
X.DataStructureTy DataStructure
ds -> case DataStructure
ds of
DataStructure
X.ConvexHullTrick -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.TyConvexHullTrick
X.SegmentTree Semigroup'
semigrp -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return (Type -> m Type) -> Type -> m Type
forall a b. (a -> b) -> a -> b
$ Monoid' -> Type
Y.TySegmentTree (Semigroup' -> Monoid'
runSemigroup Semigroup'
semigrp)
runSemigroup :: X.Semigroup' -> Y.Monoid'
runSemigroup :: Semigroup' -> Monoid'
runSemigroup = \case
Semigroup'
X.SemigroupIntPlus -> Monoid'
Y.MonoidIntPlus
Semigroup'
X.SemigroupIntMin -> Monoid'
Y.MonoidIntMin
Semigroup'
X.SemigroupIntMax -> Monoid'
Y.MonoidIntMax
Semigroup'
X.SemigroupIntGcd -> Monoid'
Y.MonoidIntGcd
Semigroup'
X.SemigroupIntLcm -> Monoid'
Y.MonoidIntLcm
runLiteral :: (MonadAlpha m, MonadError Error m) => Env -> X.Literal -> m Y.Expr
runLiteral :: Env -> Literal -> m Expr
runLiteral Env
env = \case
X.LitBuiltin Builtin
builtin [Type]
ts -> do
([Statement]
stmts, Expr
e) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env
-> Builtin -> [Type] -> [Expr] -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Type] -> [Expr] -> m Expr
runAppBuiltin Env
env Builtin
builtin [Type]
ts []
case [Statement]
stmts of
[] -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
[Statement]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"now builtin values don't use statements"
X.LitInt Integer
n
| - (Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
63) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n Bool -> Bool -> Bool
&& Integer
n Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
2 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
63 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Literal -> Expr
Y.Lit (Integer -> Literal
Y.LitInt64 Integer
n)
| Bool
otherwise -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"integer value is too large for int64_t: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n
X.LitBool Bool
p -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Literal -> Expr
Y.Lit (Bool -> Literal
Y.LitBool Bool
p)
X.LitNil Type
t -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> [Expr] -> Expr
Y.vecCtor Type
t []
X.LitBottom Type
t String
err -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::error" [Type
t]) [Literal -> Expr
Y.Lit (String -> Literal
Y.LitString String
err)]
arityOfBuiltin :: MonadError Error m => X.Builtin -> [X.Type] -> m Int
arityOfBuiltin :: Builtin -> [Type] -> m Int
arityOfBuiltin Builtin
builtin [Type]
ts = case Builtin
builtin of
Builtin
X.Min2 -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Builtin
X.Max2 -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Builtin
X.Foldl -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
Builtin
X.Iterate -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
3
Builtin
X.At -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
2
Builtin
X.Min1 -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
Builtin
X.Max1 -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
X.Proj Integer
_ -> Int -> m Int
forall (m :: * -> *) a. Monad m => a -> m a
return Int
1
Builtin
builtin -> [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Type] -> Int) -> (Type -> [Type]) -> Type -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Type], Type) -> [Type]
forall a b. (a, b) -> a
fst (([Type], Type) -> [Type])
-> (Type -> ([Type], Type)) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> ([Type], Type)
X.uncurryFunTy (Type -> Int) -> m Type -> m Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builtin -> [Type] -> m Type
forall (m :: * -> *).
MonadError Error m =>
Builtin -> [Type] -> m Type
X.builtinToType Builtin
builtin [Type]
ts
runIterate :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Type -> X.Expr -> X.Expr -> X.Expr -> m Y.Expr
runIterate :: Env -> Type -> Expr -> Expr -> Expr -> m Expr
runIterate Env
env Type
t Expr
n Expr
f Expr
x = do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
Expr
n <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
n
Expr
x <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
x
VarName
y <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
VarName
i <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LoopCounterNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f (VarName -> Expr
Y.Var VarName
y)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
x)
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> [Statement] -> Statement
Y.repStatement VarName
i (Type -> Expr -> Expr
Y.cast Type
Y.TyInt32 Expr
n) ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [VarName -> Expr -> Statement
Y.assignSimple VarName
y Expr
f])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
runIf :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Type -> X.Expr -> X.Expr -> X.Expr -> m Y.Expr
runIf :: Env -> Type -> Expr -> Expr -> Expr -> m Expr
runIf Env
env Type
t Expr
e1 Expr
e2 Expr
e3 = do
Expr
e1' <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e1
([Statement]
stmts2, Expr
e2') <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e2
([Statement]
stmts3, Expr
e3') <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e3
case ([Statement]
stmts2, [Statement]
stmts3) of
([], [])
| Expr -> Bool
X.isConstantTimeExpr Expr
e2 Bool -> Bool -> Bool
&& Expr -> Bool
X.isConstantTimeExpr Expr
e3 ->
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
Y.Cond Expr
e1' Expr
e2' Expr
e3'
([Statement], [Statement])
_ -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
VarName
phi <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
let assign :: Expr -> Statement
assign = AssignExpr -> Statement
Y.Assign (AssignExpr -> Statement)
-> (Expr -> AssignExpr) -> Expr -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AssignOp -> LeftExpr -> Expr -> AssignExpr
Y.AssignExpr AssignOp
Y.SimpleAssign (VarName -> LeftExpr
Y.LeftVar VarName
phi)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
phi DeclareRight
Y.DeclareDefault
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> [Statement] -> Maybe [Statement] -> Statement
Y.If Expr
e1' ([Statement]
stmts2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
assign Expr
e2']) ([Statement] -> Maybe [Statement]
forall a. a -> Maybe a
Just ([Statement]
stmts3 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
assign Expr
e3']))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
phi
runFoldl :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Type -> X.Type -> X.Expr -> X.Expr -> X.Expr -> m Y.Expr
runFoldl :: Env -> Type -> Type -> Expr -> Expr -> Expr -> m Expr
runFoldl Env
env Type
t1 Type
t2 Expr
f Expr
init Expr
xs = do
Expr
init <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
init
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
Type
t1 <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t1
Type
t2 <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t2
VarName
y <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
VarName
x <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction2 Env
env Expr
f (VarName -> Expr
Y.Var VarName
y) (VarName -> Expr
Y.Var VarName
x)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t2 VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
init)
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
t1 VarName
x Expr
xs ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [VarName -> Expr -> Statement
Y.assignSimple VarName
y Expr
f])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
runMap :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Type -> X.Type -> X.Expr -> X.Expr -> m Y.Expr
runMap :: Env -> Type -> Type -> Expr -> Expr -> m Expr
runMap Env
env Type
_ Type
t2 Expr
f Expr
xs = do
VarName
ys <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr' String
"mapped" Expr
xs
Type
t2 <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t2
case (Expr
f, Expr
xs) of
(X.LamConst Type
_ Expr
e, Expr
xs) -> do
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
Expr
e <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t2) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy (Type -> [Expr] -> Expr
Y.vecCtor Type
t2 [Expr -> Expr
Y.size Expr
xs, Expr
e]))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
(Expr, Expr)
_ -> do
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
VarName
i <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LoopCounterNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f (Expr -> Expr -> Expr
Y.at Expr
xs (VarName -> Expr
Y.Var VarName
i))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t2) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy (Type -> [Expr] -> Expr
Y.vecCtor Type
t2 [Expr -> Expr
Y.size Expr
xs]))
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> [Statement] -> Statement
Y.repStatement VarName
i (Type -> Expr -> Expr
Y.cast Type
Y.TyInt32 (Expr -> Expr
Y.size Expr
xs)) ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [VarName -> Expr -> Expr -> Statement
Y.assignAt VarName
ys (VarName -> Expr
Y.Var VarName
i) Expr
f])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
runAppBuiltin :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Builtin -> [X.Type] -> [X.Expr] -> m Y.Expr
runAppBuiltin :: Env -> Builtin -> [Type] -> [Expr] -> m Expr
runAppBuiltin Env
env Builtin
f [Type]
ts [Expr]
args = String -> m Expr -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' (String
"converting builtin " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Builtin -> [Type] -> String
X.formatBuiltinIsolated Builtin
f [Type]
ts) (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
let go0T :: (MonadAlpha m, MonadError Error m, MonadStatements m) => m Y.Expr -> m Y.Expr
go0T :: m Expr -> m Expr
go0T m Expr
f = case [Type]
ts of
[] -> m Expr
f
[Type]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"expected 0 type arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts)
let go1T' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Type -> m Y.Expr) -> m Y.Expr
go1T' :: (Type -> m Expr) -> m Expr
go1T' Type -> m Expr
f = case [Type]
ts of
[Type
t1] -> Type -> m Expr
f Type
t1
[Type]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"expected 1 type argument, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts)
let go1T :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> m Y.Expr) -> m Y.Expr
go1T :: (Type -> m Expr) -> m Expr
go1T Type -> m Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T' ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> m Expr
f (Type -> m Expr) -> (Type -> m Type) -> Type -> m Expr
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType
let go2T' :: (Type -> Type -> m a) -> m a
go2T' Type -> Type -> m a
f = case [Type]
ts of
[Type
t1, Type
t2] -> Type -> Type -> m a
f Type
t1 Type
t2
[Type]
_ -> String -> m a
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"expected 2 type arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts)
let go0E :: (MonadAlpha m, MonadError Error m, MonadStatements m) => m Y.Expr -> m Y.Expr
go0E :: m Expr -> m Expr
go0E m Expr
f = case [Expr]
args of
[] -> m Expr
f
[Expr]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"expected 0 type arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
let go1E' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Expr -> m Y.Expr) -> m Y.Expr
go1E' :: (Expr -> m Expr) -> m Expr
go1E' Expr -> m Expr
f = case [Expr]
args of
[Expr
e1] -> Expr -> m Expr
f Expr
e1
[Expr]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"expected 1 type argument, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
let go1E :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> m Y.Expr) -> m Y.Expr
go1E :: (Expr -> m Expr) -> m Expr
go1E Expr -> m Expr
f = (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go1E' ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> m Expr
f (Expr -> m Expr) -> (Expr -> m Expr) -> Expr -> m Expr
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env
let go2E' :: (Expr -> Expr -> m a) -> m a
go2E' Expr -> Expr -> m a
f = case [Expr]
args of
[Expr
e1, Expr
e2] -> Expr -> Expr -> m a
f Expr
e1 Expr
e2
[Expr]
_ -> String -> m a
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"expected 2 type arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
let go2E :: (Expr -> Expr -> m a) -> m a
go2E Expr -> Expr -> m a
f = (Expr -> Expr -> m a) -> m a
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> m a) -> m a
go2E' ((Expr -> Expr -> m a) -> m a) -> (Expr -> Expr -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> m (m a) -> m a
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> m a
f (Expr -> Expr -> m a) -> m Expr -> m (Expr -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e1 m (Expr -> m a) -> m Expr -> m (m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e2
let go3E' :: (Expr -> Expr -> Expr -> m a) -> m a
go3E' Expr -> Expr -> Expr -> m a
f = case [Expr]
args of
[Expr
e1, Expr
e2, Expr
e3] -> Expr -> Expr -> Expr -> m a
f Expr
e1 Expr
e2 Expr
e3
[Expr]
_ -> String -> m a
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"expected 2 type arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
let go3E :: (Expr -> Expr -> Expr -> m a) -> m a
go3E Expr -> Expr -> Expr -> m a
f = (Expr -> Expr -> Expr -> m a) -> m a
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E' ((Expr -> Expr -> Expr -> m a) -> m a)
-> (Expr -> Expr -> Expr -> m a) -> m a
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> m (m a) -> m a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m a) -> m a) -> m (m a) -> m a
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> m a
f (Expr -> Expr -> Expr -> m a) -> m Expr -> m (Expr -> Expr -> m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e1 m (Expr -> Expr -> m a) -> m Expr -> m (Expr -> m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e2 m (Expr -> m a) -> m Expr -> m (m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e3
let go00 :: Expr -> m Expr
go00 Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0E (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
f
let go01' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> m Y.Expr) -> m Y.Expr
go01' :: (Expr -> m Expr) -> m Expr
go01' Expr -> m Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go1E Expr -> m Expr
f
let go01 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> Y.Expr) -> m Y.Expr
go01 :: (Expr -> Expr) -> m Expr
go01 Expr -> Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go1E ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
f Expr
e1
let go11' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> Y.Expr -> m Y.Expr) -> m Y.Expr
go11' :: (Type -> Expr -> m Expr) -> m Expr
go11' Type -> Expr -> m Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go1E ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 -> Type -> Expr -> m Expr
f Type
t1 Expr
e1
let go11 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> Y.Expr -> Y.Expr) -> m Y.Expr
go11 :: (Type -> Expr -> Expr) -> m Expr
go11 Type -> Expr -> Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go1E ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> Expr -> Expr
f Type
t1 Expr
e1
let go02' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> Y.Expr -> m Y.Expr) -> m Y.Expr
go02' :: (Expr -> Expr -> m Expr) -> m Expr
go02' Expr -> Expr -> m Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> m a) -> m a
go2E Expr -> Expr -> m Expr
f
let go02 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> Y.Expr -> Y.Expr) -> m Y.Expr
go02 :: (Expr -> Expr -> Expr) -> m Expr
go02 Expr -> Expr -> Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> m a) -> m a
go2E ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
f Expr
e1 Expr
e2
let go12'' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Type -> X.Expr -> X.Expr -> m Y.Expr) -> m Y.Expr
go12'' :: (Type -> Expr -> Expr -> m Expr) -> m Expr
go12'' Type -> Expr -> Expr -> m Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T' ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> m a) -> m a
go2E' ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Type -> Expr -> Expr -> m Expr
f Type
t1 Expr
e1 Expr
e2
let go12' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> Y.Expr -> Y.Expr -> m Y.Expr) -> m Y.Expr
go12' :: (Type -> Expr -> Expr -> m Expr) -> m Expr
go12' Type -> Expr -> Expr -> m Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> m a) -> m a
go2E ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Type -> Expr -> Expr -> m Expr
f Type
t1 Expr
e1 Expr
e2
let go12 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> Y.Expr -> Y.Expr -> Y.Expr) -> m Y.Expr
go12 :: (Type -> Expr -> Expr -> Expr) -> m Expr
go12 Type -> Expr -> Expr -> Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> m a) -> m a
go2E ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> Expr -> Expr -> Expr
f Type
t1 Expr
e1 Expr
e2
let go22'' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Type -> X.Type -> X.Expr -> X.Expr -> m Y.Expr) -> m Y.Expr
go22'' :: (Type -> Type -> Expr -> Expr -> m Expr) -> m Expr
go22'' Type -> Type -> Expr -> Expr -> m Expr
f = (Type -> Type -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Type -> Type -> m a) -> m a
go2T' ((Type -> Type -> m Expr) -> m Expr)
-> (Type -> Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 Type
t2 -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> m a) -> m a
go2E' ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Type -> Type -> Expr -> Expr -> m Expr
f Type
t1 Type
t2 Expr
e1 Expr
e2
let go03' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Expr -> Y.Expr -> Y.Expr -> m Y.Expr) -> m Y.Expr
go03' :: (Expr -> Expr -> Expr -> m Expr) -> m Expr
go03' Expr -> Expr -> Expr -> m Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E Expr -> Expr -> Expr -> m Expr
f
let go03 :: (Expr -> Expr -> Expr -> Expr) -> m Expr
go03 Expr -> Expr -> Expr -> Expr
f = m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
m Expr -> m Expr
go0T (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E ((Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr -> Expr
f Expr
e1 Expr
e2 Expr
e3
let go13'' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Type -> X.Expr -> X.Expr -> X.Expr -> m Y.Expr) -> m Y.Expr
go13'' :: (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go13'' Type -> Expr -> Expr -> Expr -> m Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T' ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E' ((Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Type -> Expr -> Expr -> Expr -> m Expr
f Type
t1 Expr
e1 Expr
e2 Expr
e3
let go13 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (Y.Type -> Y.Expr -> Y.Expr -> Y.Expr -> Y.Expr) -> m Y.Expr
go13 :: (Type -> Expr -> Expr -> Expr -> Expr) -> m Expr
go13 Type -> Expr -> Expr -> Expr -> Expr
f = (Type -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> m Expr) -> m Expr
go1T ((Type -> m Expr) -> m Expr) -> (Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 -> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
(MonadError Error m, MonadStatements m, MonadAlpha m) =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E ((Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> Expr -> Expr -> Expr -> Expr
f Type
t1 Expr
e1 Expr
e2 Expr
e3
let go23'' :: (MonadAlpha m, MonadError Error m, MonadStatements m) => (X.Type -> X.Type -> X.Expr -> X.Expr -> X.Expr -> m Y.Expr) -> m Y.Expr
go23'' :: (Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go23'' Type -> Type -> Expr -> Expr -> Expr -> m Expr
f = (Type -> Type -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Type -> Type -> m a) -> m a
go2T' ((Type -> Type -> m Expr) -> m Expr)
-> (Type -> Type -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t1 Type
t2 -> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
(Expr -> Expr -> Expr -> m a) -> m a
go3E' ((Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Type -> Type -> Expr -> Expr -> Expr -> m Expr
f Type
t1 Type
t2 Expr
e1 Expr
e2 Expr
e3
let goN1 :: (MonadAlpha m, MonadError Error m, MonadStatements m) => ([Y.Type] -> Y.Expr -> Y.Expr) -> m Y.Expr
goN1 :: ([Type] -> Expr -> Expr) -> m Expr
goN1 [Type] -> Expr -> Expr
f = case [Expr]
args of
[Expr
e1] -> do
[Type]
ts <- (Type -> m Type) -> [Type] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType [Type]
ts
Expr
e1 <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e1
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ [Type] -> Expr -> Expr
f [Type]
ts Expr
e1
[Expr]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"expected 1 argument, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args)
let goNN :: (MonadAlpha m, MonadError Error m, MonadStatements m) => ([Y.Type] -> [Y.Expr] -> Y.Expr) -> m Y.Expr
goNN :: ([Type] -> [Expr] -> Expr) -> m Expr
goNN [Type] -> [Expr] -> Expr
f = do
[Type]
ts <- (Type -> m Type) -> [Type] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType [Type]
ts
[Expr]
args <- (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env) [Expr]
args
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ [Type] -> [Expr] -> Expr
f [Type]
ts [Expr]
args
case Builtin
f of
Builtin
X.Negate -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e -> UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Negate Expr
e
Builtin
X.Plus -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Add Expr
e1 Expr
e2
Builtin
X.Minus -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Sub Expr
e1 Expr
e2
Builtin
X.Mult -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Mul Expr
e1 Expr
e2
Builtin
X.FloorDiv -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::floordiv" []) [Expr
e1, Expr
e2]
Builtin
X.FloorMod -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::floormod" []) [Expr
e1, Expr
e2]
Builtin
X.CeilDiv -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::ceildiv" []) [Expr
e1, Expr
e2]
Builtin
X.CeilMod -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::ceilmod" []) [Expr
e1, Expr
e2]
Builtin
X.JustDiv -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::justdiv" []) [Expr
e1, Expr
e2]
Builtin
X.Pow -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::notmod::pow" []) [Expr
e1, Expr
e2]
Builtin
X.Abs -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"std::abs" []) [Expr
e]
Builtin
X.Gcd -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"std::gcd" []) [Expr
e1, Expr
e2]
Builtin
X.Lcm -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"std::lcm" []) [Expr
e1, Expr
e2]
Builtin
X.Min2 -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"std::min" [Type
t]) [Expr
e1, Expr
e2]
Builtin
X.Max2 -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"std::max" [Type
t]) [Expr
e1, Expr
e2]
Builtin
X.Iterate -> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go13'' ((Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Env -> Type -> Expr -> Expr -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Type -> Expr -> Expr -> Expr -> m Expr
runIterate Env
env
Builtin
X.Not -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e -> UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Not Expr
e
Builtin
X.And -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.And Expr
e1 Expr
e2
Builtin
X.Or -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Or Expr
e1 Expr
e2
Builtin
X.Implies -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Or (UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Not Expr
e1) Expr
e2
Builtin
X.If -> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go13'' ((Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Env -> Type -> Expr -> Expr -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Type -> Expr -> Expr -> Expr -> m Expr
runIf Env
env
Builtin
X.BitNot -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e -> UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.BitNot Expr
e
Builtin
X.BitAnd -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.BitAnd Expr
e1 Expr
e2
Builtin
X.BitOr -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.BitOr Expr
e1 Expr
e2
Builtin
X.BitXor -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.BitXor Expr
e1 Expr
e2
Builtin
X.BitLeftShift -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.BitLeftShift Expr
e1 Expr
e2
Builtin
X.BitRightShift -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.BitRightShift Expr
e1 Expr
e2
X.MatAp Integer
h Integer
w -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
x -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::ap" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
x]
X.MatZero Integer
h Integer
w -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
Expr -> m Expr
go00 (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::zero" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) []
X.MatOne Integer
n -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
Expr -> m Expr
go00 (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::one" [Integer -> Type
Y.TyIntValue Integer
n]) []
X.MatAdd Integer
h Integer
w -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::add" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
g]
X.MatMul Integer
h Integer
n Integer
w -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::mul" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
n, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
g]
X.MatPow Integer
n -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
k -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mat::pow" [Integer -> Type
Y.TyIntValue Integer
n]) [Expr
f, Expr
k]
X.VecFloorMod Integer
n -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
x Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::floormod" [Integer -> Type
Y.TyIntValue Integer
n]) [Expr
x, Expr
m]
X.MatFloorMod Integer
h Integer
w -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::floormod" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
m]
Builtin
X.ModNegate -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::negate" []) [Expr
e1, Expr
e2]
Builtin
X.ModPlus -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::plus" []) [Expr
e1, Expr
e2, Expr
e3]
Builtin
X.ModMinus -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::minus" []) [Expr
e1, Expr
e2, Expr
e3]
Builtin
X.ModMult -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::mult" []) [Expr
e1, Expr
e2, Expr
e3]
Builtin
X.ModInv -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::inv" []) [Expr
e1, Expr
e2]
Builtin
X.ModPow -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::mod::pow" []) [Expr
e1, Expr
e2, Expr
e3]
X.ModMatAp Integer
h Integer
w -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
x Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::ap" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
x, Expr
m]
X.ModMatAdd Integer
h Integer
w -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::add" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
g, Expr
m]
X.ModMatMul Integer
h Integer
n Integer
w -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::mul" [Integer -> Type
Y.TyIntValue Integer
h, Integer -> Type
Y.TyIntValue Integer
n, Integer -> Type
Y.TyIntValue Integer
w]) [Expr
f, Expr
g, Expr
m]
X.ModMatPow Integer
n -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
k Expr
m -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modmat::pow" [Integer -> Type
Y.TyIntValue Integer
n]) [Expr
f, Expr
k, Expr
m]
Builtin
X.Cons -> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> m Expr) -> m Expr
go12' ((Type -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
x Expr
xs -> do
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys DeclareRight
Y.DeclareDefault
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [Expr
x]
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"insert" [Expr -> Expr
Y.end (VarName -> Expr
Y.Var VarName
ys), Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Snoc -> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> m Expr) -> m Expr
go12' ((Type -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs Expr
x -> do
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [Expr
x]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Foldl -> (Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go23'' ((Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Env -> Type -> Type -> Expr -> Expr -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Type -> Type -> Expr -> Expr -> Expr -> m Expr
runFoldl Env
env
Builtin
X.Scanl -> (Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go23'' ((Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Type
t2 Expr
f Expr
init Expr
xs -> do
Expr
init <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
init
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
Type
t2 <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t2
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
VarName
i <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LoopCounterNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction2 Env
env Expr
f (Expr -> Expr -> Expr
Y.at (VarName -> Expr
Y.Var VarName
ys) (VarName -> Expr
Y.Var VarName
i)) (Expr -> Expr -> Expr
Y.at Expr
xs (VarName -> Expr
Y.Var VarName
i))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t2) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy (Type -> [Expr] -> Expr
Y.vecCtor Type
t2 [Expr -> Expr
Y.incrExpr (Expr -> Expr
Y.size Expr
xs)]))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> Expr -> Statement
Y.assignAt VarName
ys (Integer -> Expr
Y.litInt32 Integer
0) Expr
init
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> [Statement] -> Statement
Y.repStatement VarName
i (Type -> Expr -> Expr
Y.cast Type
Y.TyInt32 (Expr -> Expr
Y.size Expr
xs)) ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [VarName -> Expr -> Expr -> Statement
Y.assignAt VarName
ys (Expr -> Expr
Y.incrExpr (VarName -> Expr
Y.Var VarName
i)) Expr
f])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Build -> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
go13'' ((Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
f Expr
xs Expr
n -> do
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
Expr
n <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
n
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
VarName
i <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LoopCounterNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f (VarName -> Expr
Y.Var VarName
ys)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs)
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> [Statement] -> Statement
Y.repStatement VarName
i (Type -> Expr -> Expr
Y.cast Type
Y.TyInt32 Expr
n) ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [Expr
f]])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Len -> (Type -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr) -> m Expr
go11 ((Type -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e -> Type -> Expr -> Expr
Y.cast Type
Y.TyInt64 (Expr -> Expr
Y.size Expr
e)
Builtin
X.Map -> (Type -> Type -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Type -> Expr -> Expr -> m Expr) -> m Expr
go22'' ((Type -> Type -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Type -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Env -> Type -> Type -> Expr -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Type -> Type -> Expr -> Expr -> m Expr
runMap Env
env
Builtin
X.Filter -> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> m Expr) -> m Expr
go12'' ((Type -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
f Expr
xs -> do
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
VarName
ys <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"filtered" Expr
xs
VarName
x <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
([Statement]
stmtsF, [Statement]
body, Expr
f) <- Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f (VarName -> Expr
Y.Var VarName
x)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys DeclareRight
Y.DeclareDefault
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
t VarName
x Expr
xs ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> [Statement] -> Maybe [Statement] -> Statement
Y.If Expr
f [Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [VarName -> Expr
Y.Var VarName
x]] Maybe [Statement]
forall a. Maybe a
Nothing])
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.At -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> Expr -> Expr -> Expr
Y.at Expr
e1 Expr
e2
Builtin
X.SetAt -> (Type -> Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr -> Expr) -> m Expr
go13 ((Type -> Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs Expr
i Expr
x -> Function -> [Expr] -> Expr
Y.Call' (Type -> Function
Y.SetAt Type
t) [Expr
xs, Expr
i, Expr
x]
Builtin
X.Elem -> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> m Expr) -> m Expr
go12' ((Type -> Expr -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
xs Expr
x -> do
VarName
y <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyBool VarName
y (Expr -> DeclareRight
Y.DeclareCopy (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.NotEqual (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::find" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Expr
x]) (Expr -> Expr
Y.end Expr
xs)))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Sum -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go01' ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"sum" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::accumulate" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Integer -> Expr
Y.litInt64 Integer
0]))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.ModSum -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> m Expr) -> m Expr
go02' ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs Expr
m -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"sum" Expr
xs
VarName
x <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
0))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
Y.TyInt64 VarName
x Expr
xs [AssignExpr -> Statement
Y.Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
Y.AssignExpr AssignOp
Y.AddAssign (VarName -> LeftExpr
Y.LeftVar VarName
y) (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"jikka::floormod" [] [VarName -> Expr
Y.Var VarName
x, Expr
m]))]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"jikka::floormod" [] [VarName -> Expr
Y.Var VarName
y, Expr
m]
Builtin
X.Product -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go01' ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"prod" Expr
xs
VarName
x <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
1))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
Y.TyInt64 VarName
x Expr
xs [AssignExpr -> Statement
Y.Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
Y.AssignExpr AssignOp
Y.MulAssign (VarName -> LeftExpr
Y.LeftVar VarName
y) (VarName -> Expr
Y.Var VarName
x))]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.ModProduct -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> m Expr) -> m Expr
go02' ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs Expr
m -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"prod" Expr
xs
VarName
x <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
1))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
Y.TyInt64 VarName
x Expr
xs [AssignExpr -> Statement
Y.Assign (AssignOp -> LeftExpr -> Expr -> AssignExpr
Y.AssignExpr AssignOp
Y.SimpleAssign (VarName -> LeftExpr
Y.LeftVar VarName
y) (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"jikka::mod::mult" [] [VarName -> Expr
Y.Var VarName
y, VarName -> Expr
Y.Var VarName
x, Expr
m]))]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Min1 -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"min" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Deref (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::min_element" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs])))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Max1 -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"max" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Deref (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::max_element" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs])))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.ArgMin -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"argmin" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Sub (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::min_element" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs]) (Expr -> Expr
Y.begin Expr
xs)))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.ArgMax -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"argmax" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Sub (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::max_element" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs]) (Expr -> Expr
Y.begin Expr
xs)))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Gcd1 -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"gcd" Expr
xs
VarName
a <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalArgumentNameHint
VarName
b <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalArgumentNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Deref (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::accumulate" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Integer -> Expr
Y.litInt64 Integer
0, [(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [(Type
Y.TyAuto, VarName
a), (Type
Y.TyAuto, VarName
b)] Type
Y.TyAuto [Expr -> Statement
Y.Return (Expr -> Statement) -> Expr -> Statement
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::gcd" [] [VarName -> Expr
Y.Var VarName
a, VarName -> Expr
Y.Var VarName
b]]])))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Lcm1 -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"lcm" Expr
xs
VarName
a <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalArgumentNameHint
VarName
b <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalArgumentNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy (UnaryOp -> Expr -> Expr
Y.UnOp UnaryOp
Y.Deref (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::accumulate" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Integer -> Expr
Y.litInt64 Integer
1, [(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [(Type
Y.TyAuto, VarName
a), (Type
Y.TyAuto, VarName
b)] Type
Y.TyAuto [Expr -> Statement
Y.Return (Expr -> Statement) -> Expr -> Statement
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::lcm" [] [VarName -> Expr
Y.Var VarName
a, VarName -> Expr
Y.Var VarName
b]]])))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.All -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go01' ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"all" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyBool VarName
y (Expr -> DeclareRight
Y.DeclareCopy (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Equal (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::find" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Literal -> Expr
Y.Lit (Bool -> Literal
Y.LitBool Bool
False)]) (Expr -> Expr
Y.end Expr
xs)))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Any -> (Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> m Expr) -> m Expr
go01' ((Expr -> m Expr) -> m Expr) -> (Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
VarName
y <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"any" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyBool VarName
y (Expr -> DeclareRight
Y.DeclareCopy (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.NotEqual (FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"std::find" [] [Expr -> Expr
Y.begin Expr
xs, Expr -> Expr
Y.end Expr
xs, Literal -> Expr
Y.Lit (Bool -> Literal
Y.LitBool Bool
True)]) (Expr -> Expr
Y.end Expr
xs)))
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Builtin
X.Sorted -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
ys <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"sorted" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Statement
Y.callFunction' FunName
"std::sort" [] [Expr -> Expr
Y.begin (VarName -> Expr
Y.Var VarName
ys), Expr -> Expr
Y.end (VarName -> Expr
Y.Var VarName
ys)]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Reversed -> (Type -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> m Expr) -> m Expr
go11' ((Type -> Expr -> m Expr) -> m Expr)
-> (Type -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
t Expr
xs -> do
VarName
ys <- String -> Expr -> m VarName
forall (m :: * -> *). MonadAlpha m => String -> Expr -> m VarName
newFreshNameWithAdHocHintFromExpr String
"reversed" Expr
xs
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs)
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Statement
Y.callFunction' FunName
"std::reverse" [] [Expr -> Expr
Y.begin (VarName -> Expr
Y.Var VarName
ys), Expr -> Expr
Y.end (VarName -> Expr
Y.Var VarName
ys)]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Range1 -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
n -> Function -> [Expr] -> Expr
Y.Call' Function
Y.Range [Expr
n]
Builtin
X.Range2 -> (Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> m Expr) -> m Expr
go02' ((Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
from Expr
to -> do
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
Y.TyInt64) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy (Type -> [Expr] -> Expr
Y.vecCtor Type
Y.TyInt64 [BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Sub Expr
to Expr
from]))
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ FunName -> [Type] -> [Expr] -> Statement
Y.callFunction' FunName
"std::iota" [] [Expr -> Expr
Y.begin (VarName -> Expr
Y.Var VarName
ys), Expr -> Expr
Y.end (VarName -> Expr
Y.Var VarName
ys), Expr
from]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Range3 -> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> m Expr) -> m Expr
go03' ((Expr -> Expr -> Expr -> m Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
from Expr
to Expr
step -> do
VarName
ys <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
VarName
i <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LoopCounterNameHint
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
Y.TyInt64) VarName
ys DeclareRight
Y.DeclareDefault
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type
-> VarName
-> Expr
-> Expr
-> AssignExpr
-> [Statement]
-> Statement
Y.For Type
Y.TyInt32 VarName
i Expr
from (BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.LessThan (VarName -> Expr
Y.Var VarName
i) Expr
to) (AssignOp -> LeftExpr -> Expr -> AssignExpr
Y.AssignExpr AssignOp
Y.AddAssign (VarName -> LeftExpr
Y.LeftVar VarName
i) Expr
step) [Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [VarName -> Expr
Y.Var VarName
i]]
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
ys
Builtin
X.Tuple -> ([Type] -> [Expr] -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
([Type] -> [Expr] -> Expr) -> m Expr
goNN (([Type] -> [Expr] -> Expr) -> m Expr)
-> ([Type] -> [Expr] -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \[Type]
ts [Expr]
es ->
if [Type] -> Bool
Y.shouldBeArray [Type]
ts
then Function -> [Expr] -> Expr
Y.Call' (Type -> Function
Y.ArrayExt ([Type] -> Type
forall a. [a] -> a
head [Type]
ts)) [Expr]
es
else Function -> [Expr] -> Expr
Y.Call' ([Type] -> Function
Y.StdTuple [Type]
ts) [Expr]
es
X.Proj Integer
n -> ([Type] -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
([Type] -> Expr -> Expr) -> m Expr
goN1 (([Type] -> Expr -> Expr) -> m Expr)
-> ([Type] -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \[Type]
ts Expr
e ->
if [Type] -> Bool
Y.shouldBeArray [Type]
ts
then Expr -> Expr -> Expr
Y.at Expr
e (Literal -> Expr
Y.Lit (Integer -> Literal
Y.LitInt32 Integer
n))
else Function -> [Expr] -> Expr
Y.Call' (Integer -> Function
Y.StdGet (Integer -> Integer
forall a. Integral a => a -> Integer
toInteger Integer
n)) [Expr
e]
Builtin
X.LessThan -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.LessThan Expr
e1 Expr
e2
Builtin
X.LessEqual -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.LessEqual Expr
e1 Expr
e2
Builtin
X.GreaterThan -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.GreaterThan Expr
e1 Expr
e2
Builtin
X.GreaterEqual -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.GreaterEqual Expr
e1 Expr
e2
Builtin
X.Equal -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Equal Expr
e1 Expr
e2
Builtin
X.NotEqual -> (Type -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Type -> Expr -> Expr -> Expr) -> m Expr
go12 ((Type -> Expr -> Expr -> Expr) -> m Expr)
-> (Type -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Type
_ Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.NotEqual Expr
e1 Expr
e2
Builtin
X.Fact -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::notmod::fact" []) [Expr
e]
Builtin
X.Choose -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::notmod::choose" []) [Expr
e1, Expr
e2]
Builtin
X.Permute -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::notmod::permute" []) [Expr
e1, Expr
e2]
Builtin
X.MultiChoose -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call' (FunName -> [Type] -> Function
Y.Function FunName
"jikka::notmod::multichoose" []) [Expr
e1, Expr
e2]
Builtin
X.ConvexHullTrickInit -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
Expr -> m Expr
go00 (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call' Function
Y.ConvexHullTrickCtor []
Builtin
X.ConvexHullTrickGetMin -> (Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr) -> m Expr
go02 ((Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
cht Expr
x -> Function -> [Expr] -> Expr
Y.Call' (FunName -> Function
Y.Method FunName
"get_min") [Expr
cht, Expr
x]
Builtin
X.ConvexHullTrickInsert -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
cht Expr
a Expr
b -> Function -> [Expr] -> Expr
Y.Call' Function
Y.ConvexHullTrickCopyAddLine [Expr
cht, Expr
a, Expr
b]
X.SegmentTreeInitList Semigroup'
semigrp -> (Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr) -> m Expr
go01 ((Expr -> Expr) -> m Expr) -> (Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
a -> Function -> [Expr] -> Expr
Y.Call' (Monoid' -> Function
Y.SegmentTreeCtor (Semigroup' -> Monoid'
runSemigroup Semigroup'
semigrp)) [Expr
a]
X.SegmentTreeGetRange Semigroup'
_ -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
segtree Expr
l Expr
r -> Function -> [Expr] -> Expr
Y.Call' (FunName -> Function
Y.Method FunName
"prod") [Expr
segtree, Expr
l, Expr
r]
X.SegmentTreeSetPoint Semigroup'
semigrp -> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m, MonadStatements m) =>
(Expr -> Expr -> Expr -> Expr) -> m Expr
go03 ((Expr -> Expr -> Expr -> Expr) -> m Expr)
-> (Expr -> Expr -> Expr -> Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ \Expr
segtree Expr
i Expr
a -> Function -> [Expr] -> Expr
Y.Call' (Monoid' -> Function
Y.SegmentTreeCopySetPoint (Semigroup' -> Monoid'
runSemigroup Semigroup'
semigrp)) [Expr
segtree, Expr
i, Expr
a]
runExprFunction :: (MonadAlpha m, MonadError Error m) => Env -> X.Expr -> Y.Expr -> m ([Y.Statement], [Y.Statement], Y.Expr)
runExprFunction :: Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f Expr
e = case Expr
f of
X.Lam VarName
x Type
t Expr
body -> do
VarName
y <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalArgumentNameHint VarName
x
([Statement]
stmts, Expr
body) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr (VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) Expr
body
let stmts' :: [Statement]
stmts' = (Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr -> Statement -> Statement
Y.replaceStatement VarName
y Expr
e) [Statement]
stmts
let body' :: Expr
body' = VarName -> Expr -> Expr -> Expr
Y.replaceExpr VarName
y Expr
e Expr
body
([Statement], [Statement], Expr)
-> m ([Statement], [Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Statement]
stmts', Expr
body')
Expr
f -> do
([Statement]
stmts, Expr
f) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
f
([Statement], [Statement], Expr)
-> m ([Statement], [Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts, [], Expr -> [Expr] -> Expr
Y.Call Expr
f [Expr
e])
runExprFunction2 :: (MonadAlpha m, MonadError Error m) => Env -> X.Expr -> Y.Expr -> Y.Expr -> m ([Y.Statement], [Y.Statement], Y.Expr)
runExprFunction2 :: Env -> Expr -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction2 Env
env Expr
f Expr
e1 Expr
e2 = case Expr
f of
X.Lam2 VarName
x1 Type
t1 VarName
x2 Type
t2 Expr
body -> do
VarName
y1 <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalArgumentNameHint VarName
x1
VarName
y2 <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalArgumentNameHint VarName
x2
([Statement]
stmts, Expr
body) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr (VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x2 Type
t2 VarName
y2 (VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x1 Type
t1 VarName
y1 Env
env)) Expr
body
let stmts' :: [Statement]
stmts' = (Statement -> Statement) -> [Statement] -> [Statement]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr -> Statement -> Statement
Y.replaceStatement VarName
y2 Expr
e2 (Statement -> Statement)
-> (Statement -> Statement) -> Statement -> Statement
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> Expr -> Statement -> Statement
Y.replaceStatement VarName
y1 Expr
e1) [Statement]
stmts
let body' :: Expr
body' = VarName -> Expr -> Expr -> Expr
Y.replaceExpr VarName
y2 Expr
e2 (Expr -> Expr) -> Expr -> Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr -> Expr -> Expr
Y.replaceExpr VarName
y1 Expr
e1 Expr
body
([Statement], [Statement], Expr)
-> m ([Statement], [Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [Statement]
stmts', Expr
body')
Expr
f -> do
([Statement]
stmts, Expr
f) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
f
([Statement], [Statement], Expr)
-> m ([Statement], [Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts, [], Expr -> [Expr] -> Expr
Y.Call (Expr -> [Expr] -> Expr
Y.Call Expr
f [Expr
e1]) [Expr
e2])
runAssert :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Expr -> m ()
runAssert :: Env -> Expr -> m ()
runAssert Env
env = \case
X.All' (X.Map' Type
t Type
_ Expr
f Expr
xs) -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
VarName
y <- NameHint -> m VarName
forall (m :: * -> *). MonadAlpha m => NameHint -> m VarName
Y.newFreshName NameHint
LocalNameHint
Expr
xs <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
xs
([Statement]
stmtsF, [Statement]
body, Expr
e) <- Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> Expr -> m ([Statement], [Statement], Expr)
runExprFunction Env
env Expr
f (VarName -> Expr
Y.Var VarName
y)
[Statement] -> m ()
forall (m :: * -> *). MonadStatements m => [Statement] -> m ()
useStatements [Statement]
stmtsF
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> Expr -> [Statement] -> Statement
Y.ForEach Type
t VarName
y Expr
xs ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Assert Expr
e])
Expr
e -> do
Expr
e <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Expr -> Statement
Y.Assert Expr
e
runExpr :: (MonadStatements m, MonadAlpha m, MonadError Error m) => Env -> X.Expr -> m Y.Expr
runExpr :: Env -> Expr -> m Expr
runExpr Env
env = \case
X.Var VarName
x -> do
case Env -> VarName -> Either Error VarName
forall (m :: * -> *).
MonadError Error m =>
Env -> VarName -> m VarName
lookupVarName Env
env VarName
x of
Right VarName
y -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var VarName
y
Left Error
_ -> case Env -> VarName -> Either Error FunName
forall (m :: * -> *).
MonadError Error m =>
Env -> VarName -> m FunName
lookupFunName Env
env VarName
x of
Right FunName
f -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Function -> Expr
Y.Callable (FunName -> [Type] -> Function
Y.Function FunName
f [])
Left Error
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
X.formatVarName VarName
x
X.Lit Literal
lit -> do
Env -> Literal -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Literal -> m Expr
runLiteral Env
env Literal
lit
e :: Expr
e@(X.App Expr
_ Expr
_) -> do
let (Expr
f, [Expr]
args) = Expr -> (Expr, [Expr])
X.curryApp Expr
e
case Expr
f of
X.Lit (X.LitBuiltin Builtin
builtin [Type]
bts) -> do
Int
arity <- Builtin -> [Type] -> m Int
forall (m :: * -> *).
MonadError Error m =>
Builtin -> [Type] -> m Int
arityOfBuiltin Builtin
builtin [Type]
bts
if [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
arity
then do
([Type]
ts, Type
ret) <- Type -> ([Type], Type)
X.uncurryFunTy (Type -> ([Type], Type)) -> m Type -> m ([Type], Type)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builtin -> [Type] -> m Type
forall (m :: * -> *).
MonadError Error m =>
Builtin -> [Type] -> m Type
X.builtinToType Builtin
builtin [Type]
bts
[Type]
ts <- (Type -> m Type) -> [Type] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType [Type]
ts
Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
[VarName]
xs <- Int -> m VarName -> m [VarName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
arity Int -> Int -> Int
forall a. Num a => a -> a -> a
- [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args) m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
X.genVarName'
[VarName]
ys <- (VarName -> m VarName) -> [VarName] -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalArgumentNameHint) [VarName]
xs
Expr
e <- Env -> Builtin -> [Type] -> [Expr] -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Type] -> [Expr] -> m Expr
runAppBuiltin Env
env Builtin
builtin [Type]
bts ([Expr]
args [Expr] -> [Expr] -> [Expr]
forall a. [a] -> [a] -> [a]
++ (VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> Expr
X.Var [VarName]
xs)
let (Type
_, Expr
e') = ((Type, VarName) -> (Type, Expr) -> (Type, Expr))
-> (Type, Expr) -> [(Type, VarName)] -> (Type, Expr)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Type
t, VarName
y) (Type
ret, Expr
e) -> (Type -> [Type] -> Type
Y.TyFunction Type
ret [Type
t], [(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [(Type
t, VarName
y)] Type
ret [Expr -> Statement
Y.Return Expr
e])) (Type
ret, Expr
e) ([Type] -> [VarName] -> [(Type, VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop ([Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args) [Type]
ts) [VarName]
ys)
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e'
else
if [Expr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Expr]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
arity
then do
Env -> Builtin -> [Type] -> [Expr] -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Type] -> [Expr] -> m Expr
runAppBuiltin Env
env Builtin
builtin [Type]
bts [Expr]
args
else do
[Expr]
args' <- (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env) (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
drop Int
arity [Expr]
args)
Expr
e <- Env -> Builtin -> [Type] -> [Expr] -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Type] -> [Expr] -> m Expr
runAppBuiltin Env
env Builtin
builtin [Type]
bts (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
arity [Expr]
args)
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> Expr
Y.Call Expr
e [Expr]
args'
Expr
_ -> do
Expr
f <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
f
[Expr]
args <- (Expr -> m Expr) -> [Expr] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env) [Expr]
args
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> [Expr] -> Expr
Y.Call Expr
f [Expr]
args
e :: Expr
e@(X.Lam VarName
_ Type
_ Expr
_) -> do
let ([(VarName, Type)]
args, Expr
body) = Expr -> ([(VarName, Type)], Expr)
X.uncurryLam Expr
e
[VarName]
ys <- ((VarName, Type) -> m VarName) -> [(VarName, Type)] -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalArgumentNameHint (VarName -> m VarName)
-> ((VarName, Type) -> VarName) -> (VarName, Type) -> m VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarName, Type) -> VarName
forall a b. (a, b) -> a
fst) [(VarName, Type)]
args
let env' :: Env
env' = (Env -> ((VarName, Type), VarName) -> Env)
-> Env -> [((VarName, Type), VarName)] -> Env
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Env
env ((VarName
x, Type
t), VarName
y) -> VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) Env
env ([(VarName, Type)] -> [VarName] -> [((VarName, Type), VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [(VarName, Type)]
args [VarName]
ys)
Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType (Type -> m Type) -> m Type -> m Type
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Env -> Expr -> m Type
forall (m :: * -> *). MonadError Error m => Env -> Expr -> m Type
typecheckExpr Env
env' Expr
body
([Statement]
stmts, Expr
body) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env' Expr
body
[Type]
ts <- ((VarName, Type) -> m Type) -> [(VarName, Type)] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType (Type -> m Type)
-> ((VarName, Type) -> Type) -> (VarName, Type) -> m Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarName, Type) -> Type
forall a b. (a, b) -> b
snd) [(VarName, Type)]
args
let (Type
_, [Y.Return Expr
e]) = ((Type, VarName) -> (Type, [Statement]) -> (Type, [Statement]))
-> (Type, [Statement]) -> [(Type, VarName)] -> (Type, [Statement])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Type
t, VarName
y) (Type
ret, [Statement]
body) -> (Type -> [Type] -> Type
Y.TyFunction Type
ret [Type
t], [Expr -> Statement
Y.Return ([(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [(Type
t, VarName
y)] Type
ret [Statement]
body)])) (Type
ret, [Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return Expr
body]) ([Type] -> [VarName] -> [(Type, VarName)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
ts [VarName]
ys)
Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
X.Let VarName
x Type
t Expr
e1 Expr
e2 -> do
VarName
y <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
LocalNameHint VarName
x
Type
t' <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
Expr
e1 <- Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e1
Statement -> m ()
forall (m :: * -> *). MonadStatements m => Statement -> m ()
useStatement (Statement -> m ()) -> Statement -> m ()
forall a b. (a -> b) -> a -> b
$ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t' VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
e1)
Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr (VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) Expr
e2
X.Assert Expr
e1 Expr
e2 -> do
Env -> Expr -> m ()
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ()
runAssert Env
env Expr
e1
Env -> Expr -> m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e2
runToplevelFunDef :: (MonadAlpha m, MonadError Error m) => Env -> Y.FunName -> [(X.VarName, X.Type)] -> X.Type -> X.Expr -> m [Y.ToplevelStatement]
runToplevelFunDef :: Env
-> FunName
-> [(VarName, Type)]
-> Type
-> Expr
-> m [ToplevelStatement]
runToplevelFunDef Env
env FunName
f [(VarName, Type)]
args Type
ret Expr
body = do
Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
[(VarName, Type, VarName)]
args <- [(VarName, Type)]
-> ((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName, Type)]
args (((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)])
-> ((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)]
forall a b. (a -> b) -> a -> b
$ \(VarName
x, Type
t) -> do
VarName
y <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
ArgumentNameHint VarName
x
(VarName, Type, VarName) -> m (VarName, Type, VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName
x, Type
t, VarName
y)
([Statement]
stmts, Expr
result) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr ((Env -> (VarName, Type, VarName) -> Env)
-> Env -> [(VarName, Type, VarName)] -> Env
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Env
env (VarName
x, Type
t, VarName
y) -> VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) Env
env [(VarName, Type, VarName)]
args) Expr
body
[(Type, VarName)]
args <- [(VarName, Type, VarName)]
-> ((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName, Type, VarName)]
args (((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)])
-> ((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)]
forall a b. (a -> b) -> a -> b
$ \(VarName
_, Type
t, VarName
y) -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
(Type, VarName) -> m (Type, VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, VarName
y)
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type
-> FunName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
Y.FunDef Type
ret FunName
f [(Type, VarName)]
args ([Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return Expr
result])]
runToplevelVarDef :: (MonadAlpha m, MonadError Error m) => Env -> Y.VarName -> X.Type -> X.Expr -> m [Y.ToplevelStatement]
runToplevelVarDef :: Env -> VarName -> Type -> Expr -> m [ToplevelStatement]
runToplevelVarDef Env
env VarName
x Type
t Expr
e = do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
([Statement]
stmts, Expr
e) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e
case [Statement]
stmts of
[] -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> Expr -> ToplevelStatement
Y.VarDef Type
t VarName
x Expr
e]
[Statement]
_ -> [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type -> VarName -> Expr -> ToplevelStatement
Y.VarDef Type
t VarName
x (Expr -> [Expr] -> Expr
Y.Call ([(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [] Type
t ([Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return Expr
e])) [])]
runToplevelExpr :: (MonadAlpha m, MonadError Error m) => Env -> X.ToplevelExpr -> m [Y.ToplevelStatement]
runToplevelExpr :: Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr Env
env = \case
X.ResultExpr Expr
e -> do
Type
t <- Env -> Expr -> m Type
forall (m :: * -> *). MonadError Error m => Env -> Expr -> m Type
typecheckExpr Env
env Expr
e
([Type]
ts, Type
ret) <- case Type -> ([Type], Type)
X.uncurryFunTy Type
t of
(ts :: [Type]
ts@(Type
_ : [Type]
_), Type
ret) -> ([Type], Type) -> m ([Type], Type)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Type]
ts, Type
ret)
([Type], Type)
_ -> String -> m ([Type], Type)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"solve function must be a function"
Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
Expr
e <- [(VarName, Type)] -> Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
[(VarName, Type)] -> Expr -> m Expr
X.etaExpand (Env -> [(VarName, Type)]
typeEnv Env
env) Expr
e
([(VarName, Type)]
args, Expr
body) <- case Expr -> ([(VarName, Type)], Expr)
X.uncurryLam Expr
e of
([(VarName, Type)]
args, Expr
body) | [(VarName, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarName, Type)]
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts -> ([(VarName, Type)], Expr) -> m ([(VarName, Type)], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(VarName, Type)]
args, Expr
body)
([(VarName, Type)], Expr)
_ -> String -> m ([(VarName, Type)], Expr)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"the result expr must be eta-converted"
[(VarName, Type, VarName)]
args <- [(VarName, Type)]
-> ((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName, Type)]
args (((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)])
-> ((VarName, Type) -> m (VarName, Type, VarName))
-> m [(VarName, Type, VarName)]
forall a b. (a -> b) -> a -> b
$ \(VarName
x, Type
t) -> do
VarName
y <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
ArgumentNameHint VarName
x
(VarName, Type, VarName) -> m (VarName, Type, VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName
x, Type
t, VarName
y)
([Statement]
stmts, Expr
e) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr ((Env -> (VarName, Type, VarName) -> Env)
-> Env -> [(VarName, Type, VarName)] -> Env
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Env
env (VarName
x, Type
t, VarName
y) -> VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) Env
env [(VarName, Type, VarName)]
args) Expr
body
let body :: [Statement]
body = [Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return Expr
e]
[(Type, VarName)]
args' <- [(VarName, Type, VarName)]
-> ((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(VarName, Type, VarName)]
args (((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)])
-> ((VarName, Type, VarName) -> m (Type, VarName))
-> m [(Type, VarName)]
forall a b. (a -> b) -> a -> b
$ \(VarName
_, Type
t, VarName
y) -> do
Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
(Type, VarName) -> m (Type, VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (Type
t, VarName
y)
let f :: FunName
f = String -> FunName
Y.FunName String
"solve"
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type
-> FunName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
Y.FunDef Type
ret FunName
f [(Type, VarName)]
args' [Statement]
body]
X.ToplevelLet VarName
x Type
t Expr
e ToplevelExpr
cont -> case (Expr -> ([(VarName, Type)], Expr)
X.uncurryLam Expr
e, Type -> ([Type], Type)
X.uncurryFunTy Type
t) of
((args :: [(VarName, Type)]
args@((VarName, Type)
_ : [(VarName, Type)]
_), Expr
body), (ts :: [Type]
ts@(Type
_ : [Type]
_), Type
ret)) -> do
FunName
g <- VarName -> m FunName
forall (m :: * -> *). MonadError Error m => VarName -> m FunName
renameFunName' VarName
x
([(VarName, Type)]
args, Expr
body) <-
if [(VarName, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarName, Type)]
args Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts
then do
[VarName]
xs <- Int -> m VarName -> m [VarName]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- [(VarName, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarName, Type)]
args) m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
X.genVarName'
let args' :: [(VarName, Type)]
args' = [(VarName, Type)]
args [(VarName, Type)] -> [(VarName, Type)] -> [(VarName, Type)]
forall a. [a] -> [a] -> [a]
++ [VarName] -> [Type] -> [(VarName, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [VarName]
xs (Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop ([(VarName, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarName, Type)]
args) [Type]
ts)
let body' :: Expr
body' = Expr -> [Expr] -> Expr
X.uncurryApp Expr
body ((VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> Expr
X.Var [VarName]
xs)
([(VarName, Type)], Expr) -> m ([(VarName, Type)], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(VarName, Type)]
args', Expr
body')
else ([(VarName, Type)], Expr) -> m ([(VarName, Type)], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(VarName, Type)]
args, Expr
body)
[ToplevelStatement]
stmt <- Env
-> FunName
-> [(VarName, Type)]
-> Type
-> Expr
-> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env
-> FunName
-> [(VarName, Type)]
-> Type
-> Expr
-> m [ToplevelStatement]
runToplevelFunDef (VarName -> Type -> FunName -> Env -> Env
pushFun VarName
x Type
t FunName
g Env
env) FunName
g [(VarName, Type)]
args Type
ret Expr
body
[ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr (VarName -> Type -> FunName -> Env -> Env
pushFun VarName
x Type
t FunName
g Env
env) ToplevelExpr
cont
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ToplevelStatement] -> m [ToplevelStatement])
-> [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ [ToplevelStatement]
stmt [ToplevelStatement] -> [ToplevelStatement] -> [ToplevelStatement]
forall a. [a] -> [a] -> [a]
++ [ToplevelStatement]
cont
(([(VarName, Type)], Expr), ([Type], Type))
_ -> do
VarName
y <- NameHint -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameHint -> VarName -> m VarName
renameVarName' NameHint
ConstantNameHint VarName
x
[ToplevelStatement]
stmt <- Env -> VarName -> Type -> Expr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> VarName -> Type -> Expr -> m [ToplevelStatement]
runToplevelVarDef Env
env VarName
y Type
t Expr
e
[ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr (VarName -> Type -> VarName -> Env -> Env
pushVar VarName
x Type
t VarName
y Env
env) ToplevelExpr
cont
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ToplevelStatement] -> m [ToplevelStatement])
-> [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ [ToplevelStatement]
stmt [ToplevelStatement] -> [ToplevelStatement] -> [ToplevelStatement]
forall a. [a] -> [a] -> [a]
++ [ToplevelStatement]
cont
X.ToplevelLetRec VarName
f [(VarName, Type)]
args Type
ret Expr
body ToplevelExpr
cont -> do
FunName
g <- VarName -> m FunName
forall (m :: * -> *). MonadError Error m => VarName -> m FunName
renameFunName' VarName
f
let t :: Type
t = [Type] -> Type -> Type
X.curryFunTy (((VarName, Type) -> Type) -> [(VarName, Type)] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (VarName, Type) -> Type
forall a b. (a, b) -> b
snd [(VarName, Type)]
args) Type
ret
[ToplevelStatement]
stmt <- Env
-> FunName
-> [(VarName, Type)]
-> Type
-> Expr
-> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env
-> FunName
-> [(VarName, Type)]
-> Type
-> Expr
-> m [ToplevelStatement]
runToplevelFunDef (VarName -> Type -> FunName -> Env -> Env
pushFun VarName
f Type
t FunName
g Env
env) FunName
g [(VarName, Type)]
args Type
ret Expr
body
[ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr (VarName -> Type -> FunName -> Env -> Env
pushFun VarName
f Type
t FunName
g Env
env) ToplevelExpr
cont
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ToplevelStatement] -> m [ToplevelStatement])
-> [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ [ToplevelStatement]
stmt [ToplevelStatement] -> [ToplevelStatement] -> [ToplevelStatement]
forall a. [a] -> [a] -> [a]
++ [ToplevelStatement]
cont
X.ToplevelAssert Expr
e ToplevelExpr
cont -> do
([Statement]
stmts, Expr
e) <- WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall (m :: * -> *) a.
Monad m =>
WriterT (Dual [Statement]) m a -> m ([Statement], a)
runStatementsT (WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr))
-> WriterT (Dual [Statement]) m Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Env -> Expr -> WriterT (Dual [Statement]) m Expr
forall (m :: * -> *).
(MonadStatements m, MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m Expr
runExpr Env
env Expr
e
let stmt :: ToplevelStatement
stmt = Expr -> String -> ToplevelStatement
Y.StaticAssert (Expr -> [Expr] -> Expr
Y.Call ([(Type, VarName)] -> Type -> [Statement] -> Expr
Y.Lam [] Type
Y.TyBool ([Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return Expr
e])) []) String
""
[ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr Env
env ToplevelExpr
cont
[ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([ToplevelStatement] -> m [ToplevelStatement])
-> [ToplevelStatement] -> m [ToplevelStatement]
forall a b. (a -> b) -> a -> b
$ ToplevelStatement
stmt ToplevelStatement -> [ToplevelStatement] -> [ToplevelStatement]
forall a. a -> [a] -> [a]
: [ToplevelStatement]
cont
runProgram :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program
runProgram :: ToplevelExpr -> m Program
runProgram ToplevelExpr
prog = [ToplevelStatement] -> Program
Y.Program ([ToplevelStatement] -> Program)
-> m [ToplevelStatement] -> m Program
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr Env
emptyEnv ToplevelExpr
prog
run :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program
run :: ToplevelExpr -> m Program
run ToplevelExpr
prog = String -> m Program -> m Program
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.CPlusPlus.Convert.FromCore" (m Program -> m Program) -> m Program -> m Program
forall a b. (a -> b) -> a -> b
$ do
ToplevelExpr -> m Program
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
ToplevelExpr -> m Program
runProgram ToplevelExpr
prog