{-# 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 qualified Jikka.Core.Format as X (formatBuiltinIsolated, formatType)
import qualified Jikka.Core.Language.BuiltinPatterns 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 => Y.NameKind -> X.VarName -> m Y.VarName
renameVarName' :: NameKind -> VarName -> m VarName
renameVarName' NameKind
kind VarName
x = NameKind -> String -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> String -> m VarName
Y.renameVarName NameKind
kind (VarName -> String
X.unVarName VarName
x)

type Env = [(X.VarName, X.Type, Y.VarName)]

typecheckExpr :: MonadError Error m => Env -> X.Expr -> m X.Type
typecheckExpr :: Env -> Expr -> m Type
typecheckExpr Env
env = TypeEnv -> Expr -> m Type
forall (m :: * -> *).
MonadError Error m =>
TypeEnv -> Expr -> m Type
X.typecheckExpr (((VarName, Type, VarName) -> (VarName, Type)) -> Env -> TypeEnv
forall a b. (a -> b) -> [a] -> [b]
map (\(VarName
x, Type
t, VarName
_) -> (VarName
x, Type
t)) 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 (((VarName, Type, VarName) -> (VarName, VarName))
-> Env -> [(VarName, VarName)]
forall a b. (a -> b) -> [a] -> [b]
map (\(VarName
x, Type
_, VarName
y) -> (VarName
x, VarName
y)) 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.unVarName 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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
  VarName
i <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LoopCounterNameKind
  ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
  VarName
x <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
  ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
  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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LoopCounterNameKind
      ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
i <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LoopCounterNameKind
      ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
i <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LoopCounterNameKind
      ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
x <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      ([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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
x <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
x <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
x <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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, String -> VarName
Y.VarName String
"a"), (Type
Y.TyAuto, String -> VarName
Y.VarName String
"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 -> Expr) -> VarName -> Expr
forall a b. (a -> b) -> a -> b
$ String -> VarName
Y.VarName String
"a", VarName -> Expr
Y.Var (VarName -> Expr) -> VarName -> Expr
forall a b. (a -> b) -> a -> b
$ String -> VarName
Y.VarName String
"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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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, String -> VarName
Y.VarName String
"a"), (Type
Y.TyAuto, String -> VarName
Y.VarName String
"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 -> Expr) -> VarName -> Expr
forall a b. (a -> b) -> a -> b
$ String -> VarName
Y.VarName String
"a", VarName -> Expr
Y.Var (VarName -> Expr) -> VarName -> Expr
forall a b. (a -> b) -> a -> b
$ String -> VarName
Y.VarName String
"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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      VarName
i <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LoopCounterNameKind
      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 <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalArgumentNameKind 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
x, Type
t, VarName
y) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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.CallExpr 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 <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalArgumentNameKind VarName
x1
    VarName
y2 <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalArgumentNameKind 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
x2, Type
t2, VarName
y2) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: (VarName
x1, Type
t1, VarName
y1) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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.CallExpr (Expr -> [Expr] -> Expr
Y.CallExpr 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 <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
    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
    VarName
y <- Env -> VarName -> m VarName
forall (m :: * -> *).
MonadError Error m =>
Env -> VarName -> m VarName
lookupVarName Env
env 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
  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 (NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalArgumentNameKind) [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.CallExpr 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.CallExpr Expr
f [Expr]
args
  e :: Expr
e@(X.Lam VarName
_ Type
_ Expr
_) -> do
    let (TypeEnv
args, Expr
body) = Expr -> (TypeEnv, Expr)
X.uncurryLam Expr
e
    [VarName]
ys <- ((VarName, Type) -> m VarName) -> TypeEnv -> m [VarName]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalArgumentNameKind (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) TypeEnv
args
    let env' :: Env
env' = Env -> Env
forall a. [a] -> [a]
reverse (((VarName, Type) -> VarName -> (VarName, Type, VarName))
-> TypeEnv -> [VarName] -> Env
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\(VarName
x, Type
t) VarName
y -> (VarName
x, Type
t, VarName
y)) TypeEnv
args [VarName]
ys) Env -> Env -> Env
forall a. [a] -> [a] -> [a]
++ Env
env
    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) -> TypeEnv -> 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) TypeEnv
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 <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.LocalNameKind 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
x, Type
t, VarName
y) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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.VarName -> [(X.VarName, X.Type)] -> X.Type -> X.Expr -> m [Y.ToplevelStatement]
runToplevelFunDef :: Env -> VarName -> TypeEnv -> Type -> Expr -> m [ToplevelStatement]
runToplevelFunDef Env
env VarName
f TypeEnv
args Type
ret Expr
body = do
  Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
  Env
args <- TypeEnv -> ((VarName, Type) -> m (VarName, Type, VarName)) -> m Env
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM TypeEnv
args (((VarName, Type) -> m (VarName, Type, VarName)) -> m Env)
-> ((VarName, Type) -> m (VarName, Type, VarName)) -> m Env
forall a b. (a -> b) -> a -> b
$ \(VarName
x, Type
t) -> do
    VarName
y <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.ArgumentNameKind 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 -> Env
forall a. [a] -> [a]
reverse Env
args Env -> Env -> Env
forall a. [a] -> [a] -> [a]
++ Env
env) Expr
body
  [(Type, VarName)]
args <- Env
-> ((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 Env
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
-> VarName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
Y.FunDef Type
ret VarName
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.CallExpr ([(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
    case Type -> ([Type], Type)
X.uncurryFunTy Type
t of
      (ts :: [Type]
ts@(Type
_ : [Type]
_), Type
ret) -> do
        let f :: VarName
f = String -> VarName
Y.VarName String
"solve"
        ([(Type, VarName)]
args, [Statement]
body) <- case Expr -> (TypeEnv, Expr)
X.uncurryLam Expr
e of
          (TypeEnv
args, Expr
body) | TypeEnv -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TypeEnv
args Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts -> do
            -- merge two sets of arguments which introduced by @FunTy@ and @Lam@
            Env
args <- TypeEnv -> ((VarName, Type) -> m (VarName, Type, VarName)) -> m Env
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM TypeEnv
args (((VarName, Type) -> m (VarName, Type, VarName)) -> m Env)
-> ((VarName, Type) -> m (VarName, Type, VarName)) -> m Env
forall a b. (a -> b) -> a -> b
$ \(VarName
x, Type
t) -> do
              VarName
y <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.ArgumentNameKind 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 -> Env
forall a. [a] -> [a]
reverse Env
args Env -> Env -> Env
forall a. [a] -> [a] -> [a]
++ Env
env) 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' <- Env
-> ((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 Env
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)
            ([(Type, VarName)], [Statement])
-> m ([(Type, VarName)], [Statement])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Type, VarName)]
args', [Statement]
body)
          (TypeEnv, Expr)
_ -> do
            [(Type, VarName)]
args <- [Type] -> (Type -> m (Type, VarName)) -> m [(Type, VarName)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Type]
ts ((Type -> m (Type, VarName)) -> m [(Type, VarName)])
-> (Type -> m (Type, VarName)) -> m [(Type, VarName)]
forall a b. (a -> b) -> a -> b
$ \Type
t -> do
              Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
              VarName
y <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.ArgumentNameKind
              (Type, VarName) -> m (Type, VarName)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
env Expr
e
            let body :: [Statement]
body = [Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr -> Statement
Y.Return (Expr -> [Expr] -> Expr
Y.CallExpr Expr
e (((Type, VarName) -> Expr) -> [(Type, VarName)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Y.Var (VarName -> Expr)
-> ((Type, VarName) -> VarName) -> (Type, VarName) -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Type, VarName) -> VarName
forall a b. (a, b) -> b
snd) [(Type, VarName)]
args))]
            ([(Type, VarName)], [Statement])
-> m ([(Type, VarName)], [Statement])
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Type, VarName)]
args, [Statement]
body)
        Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
        [ToplevelStatement] -> m [ToplevelStatement]
forall (m :: * -> *) a. Monad m => a -> m a
return [Type
-> VarName -> [(Type, VarName)] -> [Statement] -> ToplevelStatement
Y.FunDef Type
ret VarName
f [(Type, VarName)]
args [Statement]
body]
      ([Type], Type)
_ -> String -> m [ToplevelStatement]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"solve function must be a function" -- TODO: add check in restricted Python
  X.ToplevelLet VarName
x Type
t Expr
e ToplevelExpr
cont -> case (Expr -> (TypeEnv, Expr)
X.uncurryLam Expr
e, Type -> ([Type], Type)
X.uncurryFunTy Type
t) of
    ((args :: TypeEnv
args@((VarName, Type)
_ : TypeEnv
_), Expr
body), (ts :: [Type]
ts@(Type
_ : [Type]
_), Type
ret)) -> do
      VarName
g <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.FunctionNameKind VarName
x
      (TypeEnv
args, Expr
body) <-
        if TypeEnv -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TypeEnv
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
- TypeEnv -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TypeEnv
args) m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
X.genVarName'
            let args' :: TypeEnv
args' = TypeEnv
args TypeEnv -> TypeEnv -> TypeEnv
forall a. [a] -> [a] -> [a]
++ [VarName] -> [Type] -> TypeEnv
forall a b. [a] -> [b] -> [(a, b)]
zip [VarName]
xs (Int -> [Type] -> [Type]
forall a. Int -> [a] -> [a]
drop (TypeEnv -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length TypeEnv
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)
            (TypeEnv, Expr) -> m (TypeEnv, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv
args', Expr
body')
          else (TypeEnv, Expr) -> m (TypeEnv, Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (TypeEnv
args, Expr
body)
      [ToplevelStatement]
stmt <- Env -> VarName -> TypeEnv -> Type -> Expr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> VarName -> TypeEnv -> Type -> Expr -> m [ToplevelStatement]
runToplevelFunDef ((VarName
x, Type
t, VarName
g) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: Env
env) VarName
g TypeEnv
args Type
ret Expr
body
      [ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr ((VarName
x, Type
t, VarName
g) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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
    ((TypeEnv, Expr), ([Type], Type))
_ -> do
      VarName
y <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.ConstantNameKind 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
x, Type
t, VarName
y) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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 TypeEnv
args Type
ret Expr
body ToplevelExpr
cont -> do
    VarName
g <- NameKind -> VarName -> m VarName
forall (m :: * -> *).
MonadAlpha m =>
NameKind -> VarName -> m VarName
renameVarName' NameKind
Y.FunctionNameKind VarName
f
    let t :: Type
t = [Type] -> Type -> Type
X.curryFunTy (((VarName, Type) -> Type) -> TypeEnv -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (VarName, Type) -> Type
forall a b. (a, b) -> b
snd TypeEnv
args) Type
ret
    [ToplevelStatement]
stmt <- Env -> VarName -> TypeEnv -> Type -> Expr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> VarName -> TypeEnv -> Type -> Expr -> m [ToplevelStatement]
runToplevelFunDef ((VarName
f, Type
t, VarName
g) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: Env
env) VarName
g TypeEnv
args Type
ret Expr
body
    [ToplevelStatement]
cont <- Env -> ToplevelExpr -> m [ToplevelStatement]
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> ToplevelExpr -> m [ToplevelStatement]
runToplevelExpr ((VarName
f, Type
t, VarName
g) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: 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.CallExpr ([(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 [] 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