{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Jikka.CPlusPlus.Convert.FromCore
-- Description : converts core programs to C++ programs. / core 言語のプログラムを C++ のプログラムに変換します。
-- Copyright   : (c) Kimiyuki Onaka, 2020
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
--
-- `Jikka.Language.CPlusPlus.FromCore` converts exprs of our core language to exprs of C++.
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

--------------------------------------------------------------------------------
-- monad

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)

--------------------------------------------------------------------------------
-- run

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
    -- optimize @map (const e) xs@
    (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
    -- other cases
    (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
    -- arithmetical functions
    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]
    -- advanced arithmetical functions
    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
    -- logical functions
    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
    -- bitwise functions
    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
    -- matrix functions
    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]
    -- modular functions
    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]
    -- list functions
    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
    -- tuple functions
    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]
    -- comparison
    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
    -- combinational functions
    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]
    -- data structures
    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
  -- optimize @assert all(...)@
  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])
  -- other cases
  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" -- TODO: add check in restricted Python
    Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
    -- do eta-expansion to define it as a function.
    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"
    -- merge two sets of arguments which introduced by @FunTy@ and @Lam@
    [(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