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

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

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

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 -> do
    ([Statement]
stmts, Expr
e) <- Env -> Builtin -> [Expr] -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Expr] -> m ([Statement], Expr)
runAppBuiltin Env
env Builtin
builtin []
    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 -> 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)
  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 :: X.Builtin -> Int
arityOfBuiltin :: Builtin -> Int
arityOfBuiltin = \case
  X.Min2 Type
_ -> Int
2
  X.Max2 Type
_ -> Int
2
  X.Foldl Type
_ Type
_ -> Int
3
  X.Iterate Type
_ -> Int
3
  X.At Type
_ -> Int
2
  X.Min1 Type
_ -> Int
1
  X.Max1 Type
_ -> Int
1
  X.Proj [Type]
_ Int
_ -> Int
1
  Builtin
builtin -> [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (([Type], Type) -> [Type]
forall a b. (a, b) -> a
fst (Type -> ([Type], Type)
X.uncurryFunTy (Builtin -> Type
X.builtinToType Builtin
builtin)))

runAppBuiltin :: (MonadAlpha m, MonadError Error m) => Env -> X.Builtin -> [X.Expr] -> m ([Y.Statement], Y.Expr)
runAppBuiltin :: Env -> Builtin -> [Expr] -> m ([Statement], Expr)
runAppBuiltin Env
env Builtin
f [Expr]
args = String -> m ([Statement], Expr) -> m ([Statement], 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 -> String
X.formatBuiltinIsolated Builtin
f) (m ([Statement], Expr) -> m ([Statement], Expr))
-> m ([Statement], Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ do
  let go0 :: b -> m ([a], b)
go0 b
f = case [Expr]
args of
        [] -> ([a], b) -> m ([a], b)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], b
f)
        [Expr]
_ -> String -> m ([a], b)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m ([a], b)) -> String -> m ([a], b)
forall a b. (a -> b) -> a -> b
$ String
"expected 0 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 go1'' :: (MonadAlpha m, MonadError Error m) => (X.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go1'' :: (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1'' Expr -> m ([Statement], Expr)
f = case [Expr]
args of
        [Expr
e1] -> Expr -> m ([Statement], Expr)
f Expr
e1
        [Expr]
_ -> String -> m ([Statement], Expr)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m ([Statement], Expr))
-> String -> m ([Statement], 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 go1' :: (MonadAlpha m, MonadError Error m) => (Y.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go1' :: (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' Expr -> m ([Statement], Expr)
f = (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1'' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 -> do
        ([Statement]
stmts1, Expr
e1) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e1
        ([Statement]
stmts, Expr
e) <- Expr -> m ([Statement], Expr)
f Expr
e1
        ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts, Expr
e)
  let go1 :: (Expr -> Expr) -> m ([Statement], Expr)
go1 Expr -> Expr
f = (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' (([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Statement], Expr) -> m ([Statement], Expr))
-> (Expr -> ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],) (Expr -> ([Statement], Expr))
-> (Expr -> Expr) -> Expr -> ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr
f)
  let go2'' :: (MonadAlpha m, MonadError Error m) => (X.Expr -> X.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go2'' :: (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2'' Expr -> Expr -> m ([Statement], Expr)
f = case [Expr]
args of
        [Expr
e1, Expr
e2] -> Expr -> Expr -> m ([Statement], Expr)
f Expr
e1 Expr
e2
        [Expr]
_ -> String -> m ([Statement], Expr)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m ([Statement], Expr))
-> String -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ String
"expected 2 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 go2' :: (MonadAlpha m, MonadError Error m) => (Y.Expr -> Y.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go2' :: (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' Expr -> Expr -> m ([Statement], Expr)
f = (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2'' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> do
        ([Statement]
stmts1, Expr
e1) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e1
        ([Statement]
stmts2, Expr
e2) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e2
        ([Statement]
stmts, Expr
e) <- Expr -> Expr -> m ([Statement], Expr)
f Expr
e1 Expr
e2
        ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts, Expr
e)
  let go2 :: (Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 Expr -> Expr -> Expr
f = (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' (((([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Statement], Expr) -> m ([Statement], Expr))
-> (Expr -> ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)) (Expr -> m ([Statement], Expr))
-> (Expr -> Expr) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Expr -> Expr) -> Expr -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr -> Expr
f)
  let go3'' :: (MonadAlpha m, MonadError Error m) => (X.Expr -> X.Expr -> X.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go3'' :: (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' Expr -> Expr -> Expr -> m ([Statement], Expr)
f = case [Expr]
args of
        [Expr
e1, Expr
e2, Expr
e3] -> Expr -> Expr -> Expr -> m ([Statement], Expr)
f Expr
e1 Expr
e2 Expr
e3
        [Expr]
_ -> String -> m ([Statement], Expr)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m ([Statement], Expr))
-> String -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ String
"expected 3 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 go3' :: (MonadAlpha m, MonadError Error m) => (Y.Expr -> Y.Expr -> Y.Expr -> m ([Y.Statement], Y.Expr)) -> m ([Y.Statement], Y.Expr)
      go3' :: (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3' Expr -> Expr -> Expr -> m ([Statement], Expr)
f = (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> do
        ([Statement]
stmts1, Expr
e1) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e1
        ([Statement]
stmts2, Expr
e2) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e2
        ([Statement]
stmts3, Expr
e3) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e3
        ([Statement]
stmts, Expr
e) <- Expr -> Expr -> Expr -> m ([Statement], Expr)
f Expr
e1 Expr
e2 Expr
e3
        ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts3 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts, Expr
e)
  let go3 :: (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 Expr -> Expr -> Expr -> Expr
f = (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3' ((((([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Statement], Expr) -> m ([Statement], Expr))
-> (Expr -> ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],)) (Expr -> m ([Statement], Expr))
-> (Expr -> Expr) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Expr -> Expr) -> Expr -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> Expr -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((Expr -> Expr -> Expr) -> Expr -> Expr -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr)
-> Expr
-> Expr
-> Expr
-> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Expr -> Expr -> Expr -> Expr
f)
  let goN' :: (MonadAlpha m, MonadError Error m) => ([Y.Expr] -> m Y.Expr) -> m ([Y.Statement], Y.Expr)
      goN' :: ([Expr] -> m Expr) -> m ([Statement], Expr)
goN' [Expr] -> m Expr
f = do
        [([Statement], Expr)]
args <- (Expr -> m ([Statement], Expr))
-> [Expr] -> m [([Statement], Expr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env) [Expr]
args
        Expr
e <- [Expr] -> m Expr
f ((([Statement], Expr) -> Expr) -> [([Statement], Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([Statement], Expr) -> Expr
forall a b. (a, b) -> b
snd [([Statement], Expr)]
args)
        ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([Statement], Expr) -> [Statement])
-> [([Statement], Expr)] -> [Statement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Statement], Expr) -> [Statement]
forall a b. (a, b) -> a
fst [([Statement], Expr)]
args, Expr
e)
  case Builtin
f of
    -- arithmetical functions
    Builtin
X.Negate -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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.Pow -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::pow" []) [Expr
e1, Expr
e2]
    -- advanced arithmetical functions
    Builtin
X.Abs -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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]
    X.Min2 Type
t -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> do
      Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"std::min" [Type
t]) [Expr
e1, Expr
e2])
    X.Max2 Type
t -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> do
      Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"std::max" [Type
t]) [Expr
e1, Expr
e2])
    X.Iterate Type
t -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
n Expr
f Expr
x -> do
      Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
      ([Statement]
stmtsN, Expr
n) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
n
      ([Statement]
stmtsX, Expr
x) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Statement]
stmtsN [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsX
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
x)]
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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])
               ],
          VarName -> Expr
Y.Var VarName
y
        )
    -- logical functions
    Builtin
X.Not -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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
    X.If Type
t -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 Expr
e3 -> do
      ([Statement]
stmts1, Expr
e1') <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e1
      ([Statement]
stmts2, Expr
e2') <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e2
      ([Statement]
stmts3, Expr
e3') <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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 ->
            ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts1, 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t VarName
phi DeclareRight
Y.DeclareDefault] [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [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']))], VarName -> Expr
Y.Var VarName
phi)
    -- bitwise functions
    Builtin
X.BitNot -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 Int
h Int
w -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
x -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matap" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
x]
    X.MatZero Int
n -> Expr -> m ([Statement], Expr)
forall (m :: * -> *) b a. MonadError Error m => b -> m ([a], b)
go0 (Expr -> m ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matzero" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]) []
    X.MatOne Int
n -> Expr -> m ([Statement], Expr)
forall (m :: * -> *) b a. MonadError Error m => b -> m ([a], b)
go0 (Expr -> m ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matone" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]) []
    X.MatAdd Int
h Int
w -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matadd" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
g]
    X.MatMul Int
h Int
n Int
w -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
g -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matmul" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
g]
    X.MatPow Int
n -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
k -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matpow" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]) [Expr
f, Expr
k]
    X.VecFloorMod Int
n -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
x Expr
m -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::vecfloormod" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]) [Expr
x, Expr
m]
    X.MatFloorMod Int
h Int
w -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
m -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::matfloormod" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
m]
    -- modular functions
    Builtin
X.ModNegate -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modnegate" []) [Expr
e1, Expr
e2]
    Builtin
X.ModPlus -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modplus" []) [Expr
e1, Expr
e2, Expr
e3]
    Builtin
X.ModMinus -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modminus" []) [Expr
e1, Expr
e2, Expr
e3]
    Builtin
X.ModMult -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modmult" []) [Expr
e1, Expr
e2, Expr
e3]
    Builtin
X.ModInv -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::modinv" []) [Expr
e1, Expr
e2]
    Builtin
X.ModPow -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modpow" []) [Expr
e1, Expr
e2, Expr
e3]
    X.ModMatAp Int
h Int
w -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modmatap" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
x, Expr
m]
    X.ModMatAdd Int
h Int
w -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modmatadd" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
g, Expr
m]
    X.ModMatMul Int
h Int
n Int
w -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modmatmul" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n), Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w)]) [Expr
f, Expr
g, Expr
m]
    X.ModMatPow Int
n -> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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::modmatpow" [Integer -> Type
Y.TyIntValue (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)]) [Expr
f, Expr
k, Expr
m]
    -- list functions
    X.Cons Type
t -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
x Expr
xs -> do
      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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys DeclareRight
Y.DeclareDefault,
            Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [Expr
x],
            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]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Snoc Type
t -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
xs Expr
x -> do
      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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs),
            Expr -> FunName -> [Expr] -> Statement
Y.callMethod' (VarName -> Expr
Y.Var VarName
ys) FunName
"push_back" [Expr
x]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Foldl Type
t1 Type
t2 -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
init Expr
xs -> do
      ([Statement]
stmtsInit, Expr
init) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
init
      ([Statement]
stmtsXs, Expr
xs) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Statement]
stmtsInit [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsXs
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t2 VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
init)]
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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])
               ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.Scanl Type
_ Type
t2 -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
init Expr
xs -> do
      ([Statement]
stmtsInit, Expr
init) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
init
      ([Statement]
stmtsXs, Expr
xs) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Statement]
stmtsInit [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsXs
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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)])),
                 VarName -> Expr -> Expr -> Statement
Y.assignAt VarName
ys (Integer -> Expr
Y.litInt32 Integer
0) Expr
init
               ]
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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])
               ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Build Type
t -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3'' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
xs Expr
n -> do
      ([Statement]
stmtsInit, Expr
xs) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
xs
      ([Statement]
stmtsXs, Expr
n) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Statement]
stmtsInit [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsXs
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs)
               ]
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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]])
               ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Len Type
_ -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e -> Type -> Expr -> Expr
Y.cast Type
Y.TyInt64 (Expr -> Expr
Y.size Expr
e)
    X.Map Type
_ Type
t2 -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2'' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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
      [Statement]
stmts <- case (Expr
f, Expr
xs) of
        (X.Lam VarName
_ Type
_ (X.Lit Literal
lit), X.Range1' Expr
n) -> do
          ([Statement]
stmtsN, Expr
n) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
n
          Expr
lit <- Env -> Literal -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Literal -> m Expr
runLiteral Env
env Literal
lit
          [Statement] -> m [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> m [Statement]) -> [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$
            [Statement]
stmtsN
              [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [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
n, Expr
lit]))]
        (Expr, Expr)
_ -> do
          ([Statement]
stmtsXs, Expr
xs) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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 [Statement]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement] -> m [Statement]) -> [Statement] -> m [Statement]
forall a b. (a -> b) -> a -> b
$
            [Statement]
stmtsXs
              [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [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] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
              [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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])
                 ]
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts, VarName -> Expr
Y.Var VarName
ys)
    X.Filter Type
t -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2'' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
f Expr
xs -> do
      ([Statement]
stmtsXs, Expr
xs) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [Statement]
stmtsXs
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys DeclareRight
Y.DeclareDefault]
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmtsF
            [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [ 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
                          ]
                   )
               ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.At Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Expr -> Expr -> Expr
Y.at Expr
e1 Expr
e2
    X.SetAt Type
t -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
xs Expr
i Expr
x -> do
      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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs),
            VarName -> Expr -> Expr -> Statement
Y.assignAt VarName
ys Expr
i Expr
x
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Elem Type
_ -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
xs Expr
x -> do
      VarName
y <- NameKind -> m VarName
forall (m :: * -> *). MonadAlpha m => NameKind -> m VarName
Y.newFreshName NameKind
Y.LocalNameKind
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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)))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    Builtin
X.Sum -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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]))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    Builtin
X.ModSum -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
0)),
            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]))]
          ],
          FunName -> [Type] -> [Expr] -> Expr
Y.callFunction FunName
"jikka::floormod" [] [VarName -> Expr
Y.Var VarName
y, Expr
m]
        )
    Builtin
X.Product -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
1)),
            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))]
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    Builtin
X.ModProduct -> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
Y.TyInt64 VarName
y (Expr -> DeclareRight
Y.DeclareCopy (Integer -> Expr
Y.litInt64 Integer
1)),
            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::modmult" [] [VarName -> Expr
Y.Var VarName
y, VarName -> Expr
Y.Var VarName
x, Expr
m]))]
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.Min1 Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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])))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.Max1 Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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])))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.ArgMin Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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)))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.ArgMax Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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)))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    Builtin
X.All -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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
True)]) (Expr -> Expr
Y.end Expr
xs)))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    Builtin
X.Any -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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
False)]) (Expr -> Expr
Y.end Expr
xs)))
          ],
          VarName -> Expr
Y.Var VarName
y
        )
    X.Sorted Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
      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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs),
            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)]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    X.Reversed Type
t -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
xs -> do
      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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
t) VarName
ys (Expr -> DeclareRight
Y.DeclareCopy Expr
xs),
            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)]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    Builtin
X.Range1 -> (Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go2' ((Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> Expr -> m ([Statement], Expr)) -> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ 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])),
            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]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    Builtin
X.Range3 -> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], Expr)
go3' ((Expr -> Expr -> Expr -> m ([Statement], Expr))
 -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> m ([Statement], Expr))
-> m ([Statement], 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], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return
        ( [ Type -> VarName -> DeclareRight -> Statement
Y.Declare (Type -> Type
Y.TyVector Type
Y.TyInt64) VarName
ys DeclareRight
Y.DeclareDefault,
            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]
              ]
          ],
          VarName -> Expr
Y.Var VarName
ys
        )
    -- tuple functions
    X.Tuple [Type]
ts -> ([Expr] -> m Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
([Expr] -> m Expr) -> m ([Statement], Expr)
goN' (([Expr] -> m Expr) -> m ([Statement], Expr))
-> ([Expr] -> m Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \[Expr]
es -> 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 -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$
        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 [Type]
ts Int
n -> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
go1' ((Expr -> m ([Statement], Expr)) -> m ([Statement], Expr))
-> (Expr -> m ([Statement], Expr)) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e -> 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
      ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Statement], Expr) -> m ([Statement], Expr))
-> (Expr -> ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([],) (Expr -> m ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$
        if [Type] -> Bool
Y.shouldBeArray [Type]
ts
          then Expr -> Expr -> Expr
Y.at Expr
e (Literal -> Expr
Y.Lit (Integer -> Literal
Y.LitInt32 (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)))
          else Function -> [Expr] -> Expr
Y.Call (Integer -> Function
Y.StdGet (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
n)) [Expr
e]
    -- comparison
    X.LessThan Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.LessThan Expr
e1 Expr
e2
    X.LessEqual Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.LessEqual Expr
e1 Expr
e2
    X.GreaterThan Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.GreaterThan Expr
e1 Expr
e2
    X.GreaterEqual Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.GreaterEqual Expr
e1 Expr
e2
    X.Equal Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> BinaryOp -> Expr -> Expr -> Expr
Y.BinOp BinaryOp
Y.Equal Expr
e1 Expr
e2
    X.NotEqual Type
_ -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::fact" []) [Expr
e]
    Builtin
X.Choose -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::choose" []) [Expr
e1, Expr
e2]
    Builtin
X.Permute -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::permute" []) [Expr
e1, Expr
e2]
    Builtin
X.MultiChoose -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ \Expr
e1 Expr
e2 -> Function -> [Expr] -> Expr
Y.Call (FunName -> [Type] -> Function
Y.Function FunName
"jikka::multichoose" []) [Expr
e1, Expr
e2]
    -- data structures
    Builtin
X.ConvexHullTrickInit -> Expr -> m ([Statement], Expr)
forall (m :: * -> *) b a. MonadError Error m => b -> m ([a], b)
go0 (Expr -> m ([Statement], Expr)) -> Expr -> m ([Statement], Expr)
forall a b. (a -> b) -> a -> b
$ Function -> [Expr] -> Expr
Y.Call Function
Y.ConvexHullTrickCtor []
    Builtin
X.ConvexHullTrickGetMin -> (Expr -> Expr -> Expr) -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr) -> m ([Statement], Expr)
go2 ((Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr) -> m ([Statement], Expr)
go1 ((Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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 ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
(Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr)
go3 ((Expr -> Expr -> Expr -> Expr) -> m ([Statement], Expr))
-> (Expr -> Expr -> Expr -> Expr) -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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])

runExpr :: (MonadAlpha m, MonadError Error m) => Env -> X.Expr -> m ([Y.Statement], Y.Expr)
runExpr :: Env -> Expr -> m ([Statement], 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
    ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], VarName -> Expr
Y.Var VarName
y)
  X.Lit Literal
lit -> do
    Expr
lit <- Env -> Literal -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Literal -> m Expr
runLiteral Env
env Literal
lit
    ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], Expr
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) -> do
        let arity :: Int
arity = Builtin -> Int
arityOfBuiltin Builtin
builtin
        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
            let ([Type]
ts, Type
ret) = Type -> ([Type], Type)
X.uncurryFunTy (Builtin -> Type
X.builtinToType Builtin
builtin)
            [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
            ([Statement]
stmts, Expr
e) <- Env -> Builtin -> [Expr] -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Expr] -> m ([Statement], Expr)
runAppBuiltin Env
env Builtin
builtin ([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)
            ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts, 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 -> [Expr] -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Expr] -> m ([Statement], Expr)
runAppBuiltin Env
env Builtin
builtin [Expr]
args
              else do
                ([Statement]
stmts, Expr
e) <- Env -> Builtin -> [Expr] -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Builtin -> [Expr] -> m ([Statement], Expr)
runAppBuiltin Env
env Builtin
builtin (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
take Int
arity [Expr]
args)
                [([Statement], Expr)]
args <- (Expr -> m ([Statement], Expr))
-> [Expr] -> m [([Statement], Expr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env) (Int -> [Expr] -> [Expr]
forall a. Int -> [a] -> [a]
drop Int
arity [Expr]
args)
                ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([Statement], Expr) -> [Statement])
-> [([Statement], Expr)] -> [Statement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Statement], Expr) -> [Statement]
forall a b. (a, b) -> a
fst [([Statement], Expr)]
args [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
stmts, Expr -> [Expr] -> Expr
Y.CallExpr Expr
e ((([Statement], Expr) -> Expr) -> [([Statement], Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([Statement], Expr) -> Expr
forall a b. (a, b) -> b
snd [([Statement], Expr)]
args))
      Expr
_ -> do
        [([Statement], Expr)]
args <- (Expr -> m ([Statement], Expr))
-> [Expr] -> m [([Statement], Expr)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env) [Expr]
args
        ([Statement]
stmts, Expr
f) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
f
        ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ (([Statement], Expr) -> [Statement])
-> [([Statement], Expr)] -> [Statement]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([Statement], Expr) -> [Statement]
forall a b. (a, b) -> a
fst [([Statement], Expr)]
args, Expr -> [Expr] -> Expr
Y.CallExpr Expr
f ((([Statement], Expr) -> Expr) -> [([Statement], Expr)] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map ([Statement], Expr) -> Expr
forall a b. (a, b) -> b
snd [([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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)
    ([Statement], Expr) -> m ([Statement], 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
    ([Statement]
stmts1, Expr
e1) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr Env
env Expr
e1
    ([Statement]
stmts2, Expr
e2) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], Expr)
runExpr ((VarName
x, Type
t, VarName
y) (VarName, Type, VarName) -> Env -> Env
forall a. a -> [a] -> [a]
: Env
env) Expr
e2
    ([Statement], Expr) -> m ([Statement], Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Statement]
stmts1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ Type -> VarName -> DeclareRight -> Statement
Y.Declare Type
t' VarName
y (Expr -> DeclareRight
Y.DeclareCopy Expr
e1) Statement -> [Statement] -> [Statement]
forall a. a -> [a] -> [a]
: [Statement]
stmts2, 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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) <- Env -> Expr -> m ([Statement], Expr)
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Env -> Expr -> m ([Statement], 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

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