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

-- |
-- Module      : Jikka.RestrictedPython.Convert.ToCore
-- Description : converts programs of our restricted Python to programs of core language. / 制限された Python のプログラムを core 言語のプログラムに変換します。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.RestrictedPython.Convert.ToCore
  ( run,
    runForStatement,
    runIfStatement,
  )
where

import Control.Monad.State.Strict
import Data.List (intersect, union)
import Jikka.Common.Alpha
import Jikka.Common.Error
import Jikka.Common.Location
import qualified Jikka.Core.Language.BuiltinPatterns as Y
import qualified Jikka.Core.Language.Expr as Y
import qualified Jikka.Core.Language.Util as Y
import qualified Jikka.RestrictedPython.Language.Expr as X
import qualified Jikka.RestrictedPython.Language.Lint as X
import qualified Jikka.RestrictedPython.Language.Util as X
import qualified Jikka.RestrictedPython.Language.VariableAnalysis as X

type Env = [X.VarName]

defineVar :: MonadState Env m => X.VarName -> m ()
defineVar :: VarName -> m ()
defineVar VarName
x = ([VarName] -> [VarName]) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (VarName
x VarName -> [VarName] -> [VarName]
forall a. a -> [a] -> [a]
:)

isDefinedVar :: MonadState Env m => X.VarName -> m Bool
isDefinedVar :: VarName -> m Bool
isDefinedVar VarName
x = ([VarName] -> Bool) -> m Bool
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (VarName
x VarName -> [VarName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`)

withScope :: MonadState Env m => m a -> m a
withScope :: m a -> m a
withScope m a
f = do
  [VarName]
env <- m [VarName]
forall s (m :: * -> *). MonadState s m => m s
get
  a
x <- m a
f
  [VarName] -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put [VarName]
env
  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x

runVarName :: X.VarName' -> Y.VarName
runVarName :: VarName' -> VarName
runVarName (X.WithLoc' Maybe Loc
_ (X.VarName String
x)) = String -> VarName
Y.VarName String
x

runType :: MonadError Error m => X.Type -> m Y.Type
runType :: Type -> m Type
runType = \case
  X.VarTy (X.TypeName String
x) -> 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
$ TypeName -> Type
Y.VarTy (String -> TypeName
Y.TypeName String
x)
  Type
X.IntTy -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.IntTy
  Type
X.BoolTy -> Type -> m Type
forall (m :: * -> *) a. Monad m => a -> m a
return Type
Y.BoolTy
  X.ListTy Type
t -> Type -> Type
Y.ListTy (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 -> [Type] -> Type
Y.TupleTy ([Type] -> Type) -> m [Type] -> m Type
forall (f :: * -> *) a b. Functor 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]
ts
  X.CallableTy [Type]
args Type
ret -> [Type] -> Type -> Type
Y.curryFunTy ([Type] -> Type -> Type) -> m [Type] -> m (Type -> Type)
forall (f :: * -> *) a b. Functor 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]
args m (Type -> Type) -> m Type -> m Type
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
  Type
X.StringTy -> String -> m Type
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `str' type out of main function"
  Type
X.SideEffectTy -> String -> m Type
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"side-effect type must be used only as expr-statement" -- TODO: check in Jikka.RestrictedPython.Language.Lint

runConstant :: MonadError Error m => X.Constant -> m Y.Expr
runConstant :: Constant -> m Expr
runConstant = \case
  Constant
X.ConstNone -> 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
Y.Tuple' []
  X.ConstInt 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.LitInt Integer
n)
  X.ConstBool 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.ConstBuiltin Builtin
builtin -> Builtin -> m Expr
forall (m :: * -> *). MonadError Error m => Builtin -> m Expr
runBuiltin Builtin
builtin

runBuiltin :: MonadError Error m => X.Builtin -> m Y.Expr
runBuiltin :: Builtin -> m Expr
runBuiltin Builtin
builtin =
  let f :: Builtin -> m Expr
f = Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> (Builtin -> Expr) -> Builtin -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Literal -> Expr
Y.Lit (Literal -> Expr) -> (Builtin -> Literal) -> Builtin -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builtin -> Literal
Y.LitBuiltin
   in case Builtin
builtin of
        Builtin
X.BuiltinAbs -> Builtin -> m Expr
f Builtin
Y.Abs
        Builtin
X.BuiltinPow -> Builtin -> m Expr
f Builtin
Y.Pow
        Builtin
X.BuiltinModPow -> Builtin -> m Expr
f Builtin
Y.ModPow
        Builtin
X.BuiltinDivMod -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> VarName -> Type -> Expr -> Expr
Y.Lam2 VarName
"a" Type
Y.IntTy VarName
"b" Type
Y.IntTy (Expr -> [Expr] -> Expr
Y.uncurryApp ([Type] -> Expr
Y.Tuple' [Type
Y.IntTy, Type
Y.IntTy]) [Expr -> Expr -> Expr
Y.FloorDiv' (VarName -> Expr
Y.Var VarName
"a") (VarName -> Expr
Y.Var VarName
"b"), Expr -> Expr -> Expr
Y.FloorMod' (VarName -> Expr
Y.Var VarName
"a") (VarName -> Expr
Y.Var VarName
"b")])
        Builtin
X.BuiltinCeilDiv -> Builtin -> m Expr
f Builtin
Y.CeilDiv
        Builtin
X.BuiltinCeilMod -> Builtin -> m Expr
f Builtin
Y.CeilMod
        Builtin
X.BuiltinFloorDiv -> Builtin -> m Expr
f Builtin
Y.FloorDiv
        Builtin
X.BuiltinFloorMod -> Builtin -> m Expr
f Builtin
Y.FloorMod
        Builtin
X.BuiltinGcd -> Builtin -> m Expr
f Builtin
Y.Gcd
        Builtin
X.BuiltinLcm -> Builtin -> m Expr
f Builtin
Y.Lcm
        X.BuiltinInt Type
t -> case Type
t of
          Type
X.IntTy -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"x" Type
Y.IntTy (VarName -> Expr
Y.Var VarName
"x")
          Type
X.BoolTy -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"p" Type
Y.BoolTy (Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
Y.IntTy (VarName -> Expr
Y.Var VarName
"p") Expr
Y.Lit1 Expr
Y.Lit0)
          Type
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwTypeError String
"the argument of int must be int or bool"
        X.BuiltinBool Type
t -> case Type
t of
          Type
X.IntTy -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"x" Type
Y.IntTy (Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
Y.BoolTy (Type -> Expr -> Expr -> Expr
Y.Equal' Type
Y.IntTy (VarName -> Expr
Y.Var VarName
"x") Expr
Y.Lit0) Expr
Y.LitFalse Expr
Y.LitTrue)
          Type
X.BoolTy -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"p" Type
Y.BoolTy (VarName -> Expr
Y.Var VarName
"p")
          X.ListTy 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
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"xs" (Type -> Type
Y.ListTy Type
t) (Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
Y.BoolTy (Type -> Expr -> Expr -> Expr
Y.Equal' (Type -> Type
Y.ListTy Type
t) (VarName -> Expr
Y.Var VarName
"xs") (Literal -> Expr
Y.Lit (Type -> Literal
Y.LitNil Type
t))) Expr
Y.LitFalse Expr
Y.LitTrue)
          Type
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwTypeError String
"the argument of bool must be bool, int, or list(a)"
        X.BuiltinList 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
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"xs" (Type -> Type
Y.ListTy Type
t) (VarName -> Expr
Y.Var VarName
"xs")
        X.BuiltinTuple [Type]
ts -> Builtin -> m Expr
f (Builtin -> m Expr) -> ([Type] -> Builtin) -> [Type] -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type] -> Builtin
Y.Tuple ([Type] -> m Expr) -> m [Type] -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m 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]
ts
        X.BuiltinLen Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Len (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinMap [Type]
ts Type
ret -> case [Type]
ts of
          [] -> Type -> Expr
Y.Nil' (Type -> Expr) -> m Type -> m Expr
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
          [Type]
_ -> 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
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
            let var :: a -> VarName
var a
i = String -> VarName
Y.VarName (String
"xs" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i)
            let lam :: Expr -> Expr
lam Expr
body = VarName -> Type -> Expr -> Expr
Y.Lam VarName
"f" ([Type] -> Type -> Type
Y.curryFunTy [Type]
ts Type
ret) (((Integer, Type) -> Expr -> Expr)
-> Expr -> [(Integer, Type)] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Integer
i, Type
t) -> VarName -> Type -> Expr -> Expr
Y.Lam (Integer -> VarName
forall a. Show a => a -> VarName
var Integer
i) (Type -> Type
Y.ListTy Type
t)) Expr
body ([Integer] -> [Type] -> [(Integer, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Type]
ts))
            let len :: Expr
len = Type -> Expr -> Expr
Y.Min1' Type
Y.IntTy ((Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Expr -> Expr -> Expr
Y.Cons' Type
Y.IntTy) (Type -> Expr
Y.Nil' Type
Y.IntTy) ((Integer -> Type -> Expr) -> [Integer] -> [Type] -> [Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i Type
t -> Type -> Expr -> Expr
Y.Len' Type
t (VarName -> Expr
Y.Var (Integer -> VarName
forall a. Show a => a -> VarName
var Integer
i))) [Integer
0 ..] [Type]
ts))
            let body :: Expr
body = Type -> Type -> Expr -> Expr -> Expr
Y.Map' Type
Y.IntTy Type
ret (VarName -> Type -> Expr -> Expr
Y.Lam VarName
"i" Type
Y.IntTy (Expr -> [Expr] -> Expr
Y.uncurryApp (VarName -> Expr
Y.Var VarName
"f") ((Int -> Expr) -> [Int] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Y.Var (VarName -> Expr) -> (Int -> VarName) -> Int -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarName
forall a. Show a => a -> VarName
var) [Int
0 .. [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]))) (Expr -> Expr
Y.Range1' Expr
len)
            Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
lam Expr
body
        X.BuiltinSorted Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Sorted (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinReversed Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Reversed (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinEnumerate Type
t -> do
          Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
          let body :: Expr
body = VarName -> Type -> Expr -> Expr
Y.Lam VarName
"i" Type
Y.IntTy (Expr -> [Expr] -> Expr
Y.uncurryApp ([Type] -> Expr
Y.Tuple' [Type
Y.IntTy, Type
t]) [VarName -> Expr
Y.Var VarName
"i", Type -> Expr -> Expr -> Expr
Y.At' Type
t (VarName -> Expr
Y.Var VarName
"xs") (VarName -> Expr
Y.Var VarName
"i")])
          Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"xs" (Type -> Type
Y.ListTy Type
t) (Type -> Type -> Expr -> Expr -> Expr
Y.Map' (Type -> Type
Y.ListTy Type
t) (Type -> Type
Y.ListTy ([Type] -> Type
Y.TupleTy [Type
Y.IntTy, Type
t])) Expr
body (Expr -> Expr
Y.Range1' (Type -> Expr -> Expr
Y.Len' Type
t (VarName -> Expr
Y.Var VarName
"xs"))))
        X.BuiltinFilter Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Filter (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinZip [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
          let var :: a -> VarName
var a
i = String -> VarName
Y.VarName (String
"xs" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
i)
          let lam :: Expr -> Expr
lam Expr
body = ((Integer, Type) -> Expr -> Expr)
-> Expr -> [(Integer, Type)] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Integer
i, Type
t) -> VarName -> Type -> Expr -> Expr
Y.Lam (Integer -> VarName
forall a. Show a => a -> VarName
var Integer
i) (Type -> Type
Y.ListTy Type
t)) Expr
body ([Integer] -> [Type] -> [(Integer, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
0 ..] [Type]
ts)
          let len :: Expr
len = Type -> Expr -> Expr
Y.Min1' Type
Y.IntTy ((Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Expr -> Expr -> Expr
Y.Cons' Type
Y.IntTy) (Type -> Expr
Y.Nil' Type
Y.IntTy) ((Integer -> Type -> Expr) -> [Integer] -> [Type] -> [Expr]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i Type
t -> Type -> Expr -> Expr
Y.Len' Type
t (VarName -> Expr
Y.Var (Integer -> VarName
forall a. Show a => a -> VarName
var Integer
i))) [Integer
0 ..] [Type]
ts))
          let body :: Expr
body = Type -> Type -> Expr -> Expr -> Expr
Y.Map' Type
Y.IntTy ([Type] -> Type
Y.TupleTy [Type]
ts) (VarName -> Type -> Expr -> Expr
Y.Lam VarName
"i" Type
Y.IntTy (Expr -> [Expr] -> Expr
Y.uncurryApp ([Type] -> Expr
Y.Tuple' [Type]
ts) ((Int -> Expr) -> [Int] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Y.Var (VarName -> Expr) -> (Int -> VarName) -> Int -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> VarName
forall a. Show a => a -> VarName
var) [Int
0 .. [Type] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Type]
ts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]))) (Expr -> Expr
Y.Range1' Expr
len)
          Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr
lam Expr
body
        Builtin
X.BuiltinAll -> Builtin -> m Expr
f Builtin
Y.All
        Builtin
X.BuiltinAny -> Builtin -> m Expr
f Builtin
Y.Any
        Builtin
X.BuiltinSum -> Builtin -> m Expr
f Builtin
Y.Sum
        Builtin
X.BuiltinProduct -> Builtin -> m Expr
f Builtin
Y.Product
        Builtin
X.BuiltinRange1 -> Builtin -> m Expr
f Builtin
Y.Range1
        Builtin
X.BuiltinRange2 -> Builtin -> m Expr
f Builtin
Y.Range2
        Builtin
X.BuiltinRange3 -> Builtin -> m Expr
f Builtin
Y.Range1
        X.BuiltinMax1 Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Max1 (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinMax Type
t Int
n -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwTypeError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"max expected 2 or more arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
          Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
          let args :: [VarName]
args = (Int -> VarName) -> [Int] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> String -> VarName
Y.VarName (Char
'x' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
          Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ [(VarName, Type)] -> Expr -> Expr
Y.curryLam ((VarName -> (VarName, Type)) -> [VarName] -> [(VarName, Type)]
forall a b. (a -> b) -> [a] -> [b]
map (,Type
t) [VarName]
args) ((Expr -> Expr -> Expr) -> [Expr] -> Expr
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (Type -> Expr -> Expr -> Expr
Y.Max2' Type
t) ((VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> Expr
Y.Var [VarName]
args))
        X.BuiltinMin1 Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.Min1 (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinMin Type
t Int
n -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwTypeError (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"max min 2 or more arguments, got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n
          Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
          let args :: [VarName]
args = (Int -> VarName) -> [Int] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (\Int
i -> String -> VarName
Y.VarName (Char
'x' Char -> String -> String
forall a. a -> [a] -> [a]
: Int -> String
forall a. Show a => a -> String
show Int
i)) [Int
0 .. Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
          Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ [(VarName, Type)] -> Expr -> Expr
Y.curryLam ((VarName -> (VarName, Type)) -> [VarName] -> [(VarName, Type)]
forall a b. (a -> b) -> [a] -> [b]
map (,Type
t) [VarName]
args) ((Expr -> Expr -> Expr) -> [Expr] -> Expr
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 (Type -> Expr -> Expr -> Expr
Y.Min2' Type
t) ((VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map VarName -> Expr
Y.Var [VarName]
args))
        X.BuiltinArgMax Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.ArgMax (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        X.BuiltinArgMin Type
t -> Builtin -> m Expr
f (Builtin -> m Expr) -> (Type -> Builtin) -> Type -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Builtin
Y.ArgMin (Type -> m Expr) -> m Type -> m Expr
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        Builtin
X.BuiltinFact -> Builtin -> m Expr
f Builtin
Y.Fact
        Builtin
X.BuiltinChoose -> Builtin -> m Expr
f Builtin
Y.Choose
        Builtin
X.BuiltinPermute -> Builtin -> m Expr
f Builtin
Y.Permute
        Builtin
X.BuiltinMultiChoose -> Builtin -> m Expr
f Builtin
Y.MultiChoose
        Builtin
X.BuiltinModInv -> Builtin -> m Expr
f Builtin
Y.ModInv
        Builtin
X.BuiltinInput -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `input' out of main function"
        X.BuiltinPrint [Type]
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `print' out of main function"

runAttribute :: MonadError Error m => X.Attribute' -> m Y.Expr
runAttribute :: Attribute' -> m Expr
runAttribute Attribute'
a = Maybe Loc -> m Expr -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Attribute' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Attribute'
a) (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
  case Attribute' -> Attribute
forall a. WithLoc' a -> a
value' Attribute'
a of
    X.UnresolvedAttribute AttributeName
a -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Expr) -> String -> m Expr
forall a b. (a -> b) -> a -> b
$ String
"unresolved attribute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttributeName -> String
X.unAttributeName AttributeName
a
    X.BuiltinCount 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
$ VarName -> Type -> VarName -> Type -> Expr -> Expr
Y.Lam2 VarName
"xs" (Type -> Type
Y.ListTy Type
t) VarName
"x" Type
t (Type -> Expr -> Expr
Y.Len' Type
t (Type -> Expr -> Expr -> Expr
Y.Filter' Type
t (VarName -> Type -> Expr -> Expr
Y.Lam VarName
"y" Type
t (Type -> Expr -> Expr -> Expr
Y.Equal' Type
t (VarName -> Expr
Y.Var VarName
"x") (VarName -> Expr
Y.Var VarName
"y"))) (VarName -> Expr
Y.Var VarName
"xs")))
    X.BuiltinIndex 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
$ VarName -> Type -> VarName -> Type -> Expr -> Expr
Y.Lam2 VarName
"xs" (Type -> Type
Y.ListTy Type
t) VarName
"x" Type
t (Type -> Expr -> Expr
Y.Min1' Type
Y.IntTy (Type -> Expr -> Expr -> Expr
Y.Filter' Type
Y.IntTy (VarName -> Type -> Expr -> Expr
Y.Lam VarName
"i" Type
Y.IntTy (Type -> Expr -> Expr -> Expr
Y.Equal' Type
t (Type -> Expr -> Expr -> Expr
Y.At' Type
t (VarName -> Expr
Y.Var VarName
"xs") (VarName -> Expr
Y.Var VarName
"i")) (VarName -> Expr
Y.Var VarName
"x"))) (Expr -> Expr
Y.Range1' (Type -> Expr -> Expr
Y.Len' Type
t (VarName -> Expr
Y.Var VarName
"xs")))))
    X.BuiltinCopy 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
$ VarName -> Type -> Expr -> Expr
Y.Lam VarName
"x" Type
t (VarName -> Expr
Y.Var VarName
"x")
    X.BuiltinAppend Type
_ -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `append' out of expr-statements"
    Attribute
X.BuiltinSplit -> String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `split' out of main function"

runBoolOp :: X.BoolOp -> Y.Builtin
runBoolOp :: BoolOp -> Builtin
runBoolOp = \case
  BoolOp
X.And -> Builtin
Y.And
  BoolOp
X.Or -> Builtin
Y.Or
  BoolOp
X.Implies -> Builtin
Y.Implies

runUnaryOp :: X.UnaryOp -> Y.Expr
runUnaryOp :: UnaryOp -> Expr
runUnaryOp =
  let f :: Builtin -> Expr
f = Literal -> Expr
Y.Lit (Literal -> Expr) -> (Builtin -> Literal) -> Builtin -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builtin -> Literal
Y.LitBuiltin
   in \case
        UnaryOp
X.Invert -> Builtin -> Expr
f Builtin
Y.BitNot
        UnaryOp
X.Not -> Builtin -> Expr
f Builtin
Y.Not
        UnaryOp
X.UAdd -> VarName -> Type -> Expr -> Expr
Y.Lam VarName
"x" Type
Y.IntTy (VarName -> Expr
Y.Var VarName
"x")
        UnaryOp
X.USub -> Builtin -> Expr
f Builtin
Y.Negate

runOperator :: MonadError Error m => X.Operator -> m Y.Builtin
runOperator :: Operator -> m Builtin
runOperator = \case
  Operator
X.Add -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.Plus
  Operator
X.Sub -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.Minus
  Operator
X.Mult -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.Mult
  Operator
X.MatMult -> String -> m Builtin
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"matmul operator ('@') is not supported"
  Operator
X.Div -> String -> m Builtin
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"floatdiv operator ('/') is not supported"
  Operator
X.FloorDiv -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.FloorDiv
  Operator
X.FloorMod -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.FloorMod
  Operator
X.CeilDiv -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.CeilDiv
  Operator
X.CeilMod -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.CeilMod
  Operator
X.Pow -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.Pow
  Operator
X.BitLShift -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.BitLeftShift
  Operator
X.BitRShift -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.BitRightShift
  Operator
X.BitOr -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.BitOr
  Operator
X.BitXor -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.BitXor
  Operator
X.BitAnd -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return Builtin
Y.BitAnd
  Operator
X.Max -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return (Builtin -> m Builtin) -> Builtin -> m Builtin
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.Max2 Type
Y.IntTy
  Operator
X.Min -> Builtin -> m Builtin
forall (m :: * -> *) a. Monad m => a -> m a
return (Builtin -> m Builtin) -> Builtin -> m Builtin
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.Min2 Type
Y.IntTy

runCmpOp :: MonadError Error m => X.CmpOp' -> m Y.Expr
runCmpOp :: CmpOp' -> m Expr
runCmpOp (X.CmpOp' CmpOp
op Type
t) = do
  Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
  let f :: Builtin -> Expr
f = Literal -> Expr
Y.Lit (Literal -> Expr) -> (Builtin -> Literal) -> Builtin -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builtin -> Literal
Y.LitBuiltin
  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
$ case CmpOp
op of
    CmpOp
X.Lt -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.LessThan Type
t
    CmpOp
X.LtE -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.LessEqual Type
t
    CmpOp
X.Gt -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.GreaterThan Type
t
    CmpOp
X.GtE -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.GreaterEqual Type
t
    CmpOp
X.Eq' -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.Equal Type
t
    CmpOp
X.NotEq -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.NotEqual Type
t
    CmpOp
X.Is -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.Equal Type
t
    CmpOp
X.IsNot -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.NotEqual Type
t
    CmpOp
X.In -> Builtin -> Expr
f (Builtin -> Expr) -> Builtin -> Expr
forall a b. (a -> b) -> a -> b
$ Type -> Builtin
Y.Elem Type
t
    CmpOp
X.NotIn -> [(VarName, Type)] -> Expr -> Expr
Y.curryLam [(VarName
"x", Type
t), (VarName
"xs", Type -> Type
Y.ListTy Type
t)] (Expr -> Expr
Y.Not' (Type -> Expr -> Expr -> Expr
Y.Elem' Type
t (VarName -> Expr
Y.Var VarName
"x") (VarName -> Expr
Y.Var VarName
"xs")))

runTargetExpr :: (MonadAlpha m, MonadError Error m) => X.Target' -> m Y.Expr
runTargetExpr :: Target' -> m Expr
runTargetExpr (WithLoc' Maybe Loc
_ Target
x) = case Target
x of
  X.SubscriptTrg Target'
x Expr'
e -> Type -> Expr -> Expr -> Expr
Y.At' (Type -> Expr -> Expr -> Expr)
-> m Type -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Target' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> m Expr
runTargetExpr Target'
x m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
  X.NameTrg VarName'
x -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var (VarName' -> VarName
runVarName VarName'
x)
  X.TupleTrg [Target']
xs -> Expr -> [Expr] -> Expr
Y.uncurryApp (Expr -> [Expr] -> Expr) -> m Expr -> m ([Expr] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Type] -> Expr
Y.Tuple' ([Type] -> Expr) -> m [Type] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m Type -> m [Type]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Target'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Target']
xs) m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType) m ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Target' -> m Expr) -> [Target'] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Target' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> m Expr
runTargetExpr [Target']
xs

runAssign :: (MonadAlpha m, MonadError Error m) => X.Target' -> Y.Expr -> m Y.Expr -> m Y.Expr
runAssign :: Target' -> Expr -> m Expr -> m Expr
runAssign (WithLoc' Maybe Loc
_ Target
x) Expr
e m Expr
cont = case Target
x of
  X.SubscriptTrg Target'
x Expr'
index -> m (m Expr) -> m Expr
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m Expr) -> m Expr) -> m (m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (Expr -> m Expr -> m Expr) -> m Expr -> m (m Expr -> m Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Expr -> Expr -> Expr -> Expr
Y.SetAt' (Type -> Expr -> Expr -> Expr -> Expr)
-> m Type -> m (Expr -> Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType m (Expr -> Expr -> Expr -> Expr)
-> m Expr -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Target' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> m Expr
runTargetExpr Target'
x m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
index m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e) m (m Expr -> m Expr) -> m (m Expr) -> m (m Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Expr -> m (m Expr)
forall (f :: * -> *) a. Applicative f => a -> f a
pure m Expr
cont
  X.NameTrg VarName'
x -> VarName -> Type -> Expr -> Expr -> Expr
Y.Let (VarName' -> VarName
runVarName VarName'
x) (Type -> Expr -> Expr -> Expr)
-> m Type -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Expr
cont
  X.TupleTrg [Target']
xs -> do
    VarName
y <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
    [Type]
ts <- Int -> m Type -> m [Type]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([Target'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Target']
xs) m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
    Expr
cont <- m (m Expr) -> m Expr
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (m (m Expr) -> m Expr) -> m (m Expr) -> m Expr
forall a b. (a -> b) -> a -> b
$ (m Expr -> (Int, Target') -> m (m Expr))
-> m Expr -> [(Int, Target')] -> m (m Expr)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM (\m Expr
cont (Int
i, Target'
x) -> m Expr -> m (m Expr)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Expr -> m (m Expr)) -> m Expr -> m (m Expr)
forall a b. (a -> b) -> a -> b
$ Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x ([Type] -> Int -> Expr -> Expr
Y.Proj' [Type]
ts Int
i (VarName -> Expr
Y.Var VarName
y)) m Expr
cont) m Expr
cont ([Int] -> [Target'] -> [(Int, Target')]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 ..] [Target']
xs)
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr -> Expr
Y.Let VarName
y ([Type] -> Type
Y.TupleTy [Type]
ts) Expr
e Expr
cont

runListComp :: (MonadAlpha m, MonadError Error m) => X.Expr' -> X.Comprehension -> m Y.Expr
runListComp :: Expr' -> Comprehension -> m Expr
runListComp Expr'
e (X.Comprehension Target'
x Expr'
iter Maybe Expr'
pred) = do
  Expr
iter <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
iter
  VarName
y <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
  Type
t1 <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  Expr
iter <- case Maybe Expr'
pred of
    Maybe Expr'
Nothing -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
iter
    Just Expr'
pred -> Type -> Expr -> Expr -> Expr
Y.Filter' Type
t1 (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarName -> Type -> Expr -> Expr
Y.Lam VarName
y Type
t1 (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (VarName -> Expr
Y.Var VarName
y) (Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
pred)) m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
iter
  Type
t2 <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
  Type -> Type -> Expr -> Expr -> Expr
Y.Map' Type
t1 Type
t2 (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VarName -> Type -> Expr -> Expr
Y.Lam VarName
y Type
t1 (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (VarName -> Expr
Y.Var VarName
y) (Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
e)) m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr -> m Expr
forall (f :: * -> *) a. Applicative f => a -> f a
pure Expr
iter

runExpr :: (MonadAlpha m, MonadError Error m) => X.Expr' -> m Y.Expr
runExpr :: Expr' -> m Expr
runExpr Expr'
e0 = Maybe Loc -> m Expr -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e0) (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ case Expr' -> Expr
forall a. WithLoc' a -> a
value' Expr'
e0 of
  X.BoolOp Expr'
e1 BoolOp
op Expr'
e2 -> Builtin -> Expr -> Expr -> Expr
Y.AppBuiltin2 (BoolOp -> Builtin
runBoolOp BoolOp
op) (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e2
  X.BinOp Expr'
e1 Operator
op Expr'
e2 -> Builtin -> Expr -> Expr -> Expr
Y.AppBuiltin2 (Builtin -> Expr -> Expr -> Expr)
-> m Builtin -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operator -> m Builtin
forall (m :: * -> *). MonadError Error m => Operator -> m Builtin
runOperator Operator
op m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e2
  X.UnaryOp UnaryOp
op Expr'
e -> Expr -> Expr -> Expr
Y.App (UnaryOp -> Expr
runUnaryOp UnaryOp
op) (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
  X.Lambda [(VarName', Type)]
args Expr'
body -> [(VarName, Type)] -> Expr -> Expr
Y.curryLam ([(VarName, Type)] -> Expr -> Expr)
-> m [(VarName, Type)] -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((VarName', Type) -> m (VarName, Type))
-> [(VarName', Type)] -> m [(VarName, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(VarName'
x, Type
t) -> (VarName' -> VarName
runVarName VarName'
x,) (Type -> (VarName, Type)) -> m Type -> m (VarName, 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) [(VarName', Type)]
args m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
body
  X.IfExp Expr'
e1 Expr'
e2 Expr'
e3 -> do
    Expr
e1 <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e1
    Expr
e2 <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e2
    Expr
e3 <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e3
    Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
t Expr
e1 Expr
e2 Expr
e3
  X.ListComp Expr'
x Comprehension
comp -> Expr' -> Comprehension -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> Comprehension -> m Expr
runListComp Expr'
x Comprehension
comp
  X.Compare Expr'
e1 CmpOp'
op Expr'
e2 -> Expr -> Expr -> Expr -> Expr
Y.App2 (Expr -> Expr -> Expr -> Expr)
-> m Expr -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CmpOp' -> m Expr
forall (m :: * -> *). MonadError Error m => CmpOp' -> m Expr
runCmpOp CmpOp'
op m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e2
  X.Call Expr'
f [Expr']
args -> Expr -> [Expr] -> Expr
Y.uncurryApp (Expr -> [Expr] -> Expr) -> m Expr -> m ([Expr] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
f m ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr' -> m Expr) -> [Expr'] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr [Expr']
args
  X.Constant Constant
const -> Constant -> m Expr
forall (m :: * -> *). MonadError Error m => Constant -> m Expr
runConstant Constant
const
  X.Attribute Expr'
e Attribute'
a -> do
    Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
    Expr
a <- Attribute' -> m Expr
forall (m :: * -> *). MonadError Error m => Attribute' -> m Expr
runAttribute Attribute'
a
    Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
Y.App Expr
a Expr
e
  X.Subscript Expr'
e1 Expr'
e2 -> Builtin -> Expr -> Expr -> Expr
Y.AppBuiltin2 (Builtin -> Expr -> Expr -> Expr)
-> m Builtin -> m (Expr -> Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Type -> Builtin
Y.At (Type -> Builtin) -> m Type -> m Builtin
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType) m (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e1 m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e2
  X.Starred Expr'
e -> Maybe Loc -> String -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e) String
"cannot use starred expr"
  X.Name VarName'
x -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Expr
Y.Var (VarName' -> VarName
runVarName VarName'
x)
  X.List Type
t [Expr']
es -> do
    Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
    (Expr -> Expr -> Expr) -> Expr -> [Expr] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Type -> Expr -> Expr -> Expr
Y.Cons' Type
t) (Literal -> Expr
Y.Lit (Type -> Literal
Y.LitNil Type
t)) ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr' -> m Expr) -> [Expr'] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr [Expr']
es
  X.Tuple [Expr']
es -> Expr -> [Expr] -> Expr
Y.uncurryApp (Expr -> [Expr] -> Expr) -> m Expr -> m ([Expr] -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Type] -> Expr
Y.Tuple' ([Type] -> Expr) -> m [Type] -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr' -> m Type) -> [Expr'] -> m [Type]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (m Type -> Expr' -> m Type
forall a b. a -> b -> a
const m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType) [Expr']
es) m ([Expr] -> Expr) -> m [Expr] -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Expr' -> m Expr) -> [Expr'] -> m [Expr]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr [Expr']
es
  X.SubscriptSlice Expr'
e Maybe Expr'
from Maybe Expr'
to Maybe Expr'
step -> do
    Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
    Maybe Expr
from <- (Expr' -> m Expr) -> Maybe Expr' -> m (Maybe Expr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Maybe Expr'
from
    Maybe Expr
to <- (Expr' -> m Expr) -> Maybe Expr' -> m (Maybe Expr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Maybe Expr'
to
    Maybe Expr
step <- (Expr' -> m Expr) -> Maybe Expr' -> m (Maybe Expr)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Maybe Expr'
step
    VarName
i <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
    Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
    let mapAt :: Expr -> m Expr
mapAt = Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> (Expr -> Expr) -> Expr -> m Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Type -> Expr -> Expr -> Expr
Y.Map' Type
Y.IntTy Type
t (VarName -> Type -> Expr -> Expr
Y.Lam VarName
i Type
t (Type -> Expr -> Expr -> Expr
Y.At' Type
t Expr
e (VarName -> Expr
Y.Var VarName
i)))
    case (Maybe Expr
from, Maybe Expr
to, Maybe Expr
step) of
      (Maybe Expr
Nothing, Maybe Expr
Nothing, Maybe Expr
Nothing) -> Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return Expr
e
      (Maybe Expr
Nothing, Just Expr
to, Maybe Expr
Nothing) -> Expr -> m Expr
mapAt (Expr -> Expr
Y.Range1' Expr
to)
      (Just Expr
from, Maybe Expr
Nothing, Maybe Expr
Nothing) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr
Y.Range2' Expr
from (Type -> Expr -> Expr
Y.Len' Type
t Expr
e))
      (Just Expr
from, Just Expr
to, Maybe Expr
Nothing) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr
Y.Range2' Expr
from Expr
to)
      (Maybe Expr
Nothing, Maybe Expr
Nothing, Just Expr
step) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr -> Expr
Y.Range3' Expr
Y.Lit0 (Type -> Expr -> Expr
Y.Len' Type
t Expr
e) Expr
step)
      (Maybe Expr
Nothing, Just Expr
to, Just Expr
step) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr -> Expr
Y.Range3' Expr
Y.Lit0 Expr
to Expr
step)
      (Just Expr
from, Maybe Expr
Nothing, Just Expr
step) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr -> Expr
Y.Range3' Expr
from (Type -> Expr -> Expr
Y.Len' Type
t Expr
e) Expr
step)
      (Just Expr
from, Just Expr
to, Just Expr
step) -> Expr -> m Expr
mapAt (Expr -> Expr -> Expr -> Expr
Y.Range3' Expr
from Expr
to Expr
step)

-- | `runForStatement` converts for-loops to `foldl`.
-- For example, this converts the following:
--
-- > # a, b are defined
-- > for _ in range(n):
-- >     c = a + b
-- >     a = b
-- >     b = c
-- > ...
--
-- to:
--
-- > let (a, b) = foldl (fun (a, b) i -> (b, a + b)) (a, b) (range n)
-- > in ...
runForStatement :: (MonadState Env m, MonadAlpha m, MonadError Error m) => X.Target' -> X.Expr' -> [X.Statement] -> [X.Statement] -> [[X.Statement]] -> m Y.Expr
runForStatement :: Target'
-> Expr' -> [Statement] -> [Statement] -> [[Statement]] -> m Expr
runForStatement Target'
x Expr'
iter [Statement]
body [Statement]
cont [[Statement]]
conts = do
  Type
tx <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  Expr
iter <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
iter
  VarName
x' <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
  VarName
z <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
  let (ReadList
_, X.WriteList [VarName]
w) = [Statement] -> (ReadList, WriteList)
X.analyzeStatementsMax [Statement]
body
  [VarName]
ys <- (VarName -> m Bool) -> [VarName] -> m [VarName]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM VarName -> m Bool
forall (m :: * -> *). MonadState [VarName] m => VarName -> m Bool
isDefinedVar [VarName]
w
  [Type]
ts <- Int -> m Type -> m [Type]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([VarName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VarName]
ys) m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  let init :: Expr
init = Expr -> [Expr] -> Expr
Y.uncurryApp ([Type] -> Expr
Y.Tuple' [Type]
ts) ((VarName -> Expr) -> [VarName] -> [Expr]
forall a b. (a -> b) -> [a] -> [b]
map (VarName -> Expr
Y.Var (VarName -> Expr) -> (VarName -> VarName) -> VarName -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName' -> VarName
runVarName (VarName' -> VarName)
-> (VarName -> VarName') -> VarName -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc) [VarName]
ys)
  let write :: Expr -> Expr
write Expr
cont = ((Int, VarName, Type) -> Expr -> Expr)
-> Expr -> [(Int, VarName, Type)] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, VarName
y, Type
t) -> VarName -> Type -> Expr -> Expr -> Expr
Y.Let (VarName' -> VarName
runVarName (VarName' -> VarName) -> VarName' -> VarName
forall a b. (a -> b) -> a -> b
$ Maybe Loc -> VarName -> VarName'
forall a. Maybe Loc -> a -> WithLoc' a
X.WithLoc' Maybe Loc
forall a. Maybe a
Nothing VarName
y) Type
t ([Type] -> Int -> Expr -> Expr
Y.Proj' [Type]
ts Int
i (VarName -> Expr
Y.Var VarName
z))) Expr
cont ([Int] -> [VarName] -> [Type] -> [(Int, VarName, Type)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 ..] [VarName]
ys [Type]
ts)
  Expr
body <- Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (VarName -> Expr
Y.Var VarName
x') (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
    [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements ([Statement]
body [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr' -> Statement
X.Return (Expr -> Expr'
forall a. a -> WithLoc' a
withoutLoc ([Expr'] -> Expr
X.Tuple ((VarName -> Expr') -> [VarName] -> [Expr']
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Expr'
forall a. a -> WithLoc' a
withoutLoc (Expr -> Expr') -> (VarName -> Expr) -> VarName -> Expr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName' -> Expr
X.Name (VarName' -> Expr) -> (VarName -> VarName') -> VarName -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc) [VarName]
ys)))]) ([Statement]
cont [Statement] -> [[Statement]] -> [[Statement]]
forall a. a -> [a] -> [a]
: [[Statement]]
conts)
  let loop :: Expr -> Expr
loop Expr
init = Type -> Type -> Expr -> Expr -> Expr -> Expr
Y.Foldl' Type
tx ([Type] -> Type
Y.TupleTy [Type]
ts) (VarName -> Type -> VarName -> Type -> Expr -> Expr
Y.Lam2 VarName
z ([Type] -> Type
Y.TupleTy [Type]
ts) VarName
x' Type
tx (Expr -> Expr
write Expr
body)) Expr
init Expr
iter
  Expr
cont <- [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
cont [[Statement]]
conts
  Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> Expr -> Expr
Y.Let VarName
z ([Type] -> Type
Y.TupleTy [Type]
ts) (Expr -> Expr
loop Expr
init) (Expr -> Expr
write Expr
cont)

-- | `runIfStatement` converts if-loops to if-exprs.
--
-- > # a, b are defined
-- > if True:
-- >     a = 0
-- >     b = 1
-- >     c = 3
-- > else:
-- >     a = 1
-- >     c = 10
-- > ...
--
-- to:
--
-- > let (a, c) = if true then (0, 3) else (1, 10)
-- > in ...
runIfStatement :: (MonadState Env m, MonadAlpha m, MonadError Error m) => X.Expr' -> [X.Statement] -> [X.Statement] -> [X.Statement] -> [[X.Statement]] -> m Y.Expr
runIfStatement :: Expr'
-> [Statement]
-> [Statement]
-> [Statement]
-> [[Statement]]
-> m Expr
runIfStatement Expr'
e [Statement]
body1 [Statement]
body2 [Statement]
cont [[Statement]]
conts = do
  Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
  Type
t <- m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
  case ((Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
X.doesAlwaysReturn [Statement]
body1, (Statement -> Bool) -> [Statement] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Statement -> Bool
X.doesAlwaysReturn [Statement]
body2) of
    (Bool
False, Bool
False) -> do
      let (ReadList
_, X.WriteList [VarName]
w1) = [Statement] -> (ReadList, WriteList)
X.analyzeStatementsMin [Statement]
body1
      let (ReadList
_, X.WriteList [VarName]
w2) = [Statement] -> (ReadList, WriteList)
X.analyzeStatementsMin [Statement]
body2
      let (X.ReadList [VarName]
r, WriteList
_) = [Statement] -> (ReadList, WriteList)
X.analyzeStatementsMax ([[Statement]] -> [Statement]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([Statement]
cont [Statement] -> [[Statement]] -> [[Statement]]
forall a. a -> [a] -> [a]
: [[Statement]]
conts))
      let w :: [VarName]
w = ([VarName]
r [VarName] -> [VarName] -> [VarName]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [VarName]
w1) [VarName] -> [VarName] -> [VarName]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([VarName]
r [VarName] -> [VarName] -> [VarName]
forall a. Eq a => [a] -> [a] -> [a]
`intersect` [VarName]
w2)
      let read :: Expr'
read = Expr -> Expr'
forall a. a -> WithLoc' a
withoutLoc ([Expr'] -> Expr
X.Tuple ((VarName -> Expr') -> [VarName] -> [Expr']
forall a b. (a -> b) -> [a] -> [b]
map (Expr -> Expr'
forall a. a -> WithLoc' a
withoutLoc (Expr -> Expr') -> (VarName -> Expr) -> VarName -> Expr'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName' -> Expr
X.Name (VarName' -> Expr) -> (VarName -> VarName') -> VarName -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc) [VarName]
w))
      [Type]
ts <- Int -> m Type -> m [Type]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM ([VarName] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [VarName]
w) m Type
forall (m :: * -> *). MonadAlpha m => m Type
Y.genType
      VarName
z <- m VarName
forall (m :: * -> *). MonadAlpha m => m VarName
Y.genVarName'
      let write :: Expr -> Expr -> Expr
write Expr
value Expr
cont = VarName -> Type -> Expr -> Expr -> Expr
Y.Let VarName
z ([Type] -> Type
Y.TupleTy [Type]
ts) Expr
value (((Int, VarName, Type) -> Expr -> Expr)
-> Expr -> [(Int, VarName, Type)] -> Expr
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Int
i, VarName
y, Type
t) -> VarName -> Type -> Expr -> Expr -> Expr
Y.Let (VarName' -> VarName
runVarName (VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc VarName
y)) Type
t ([Type] -> Int -> Expr -> Expr
Y.Proj' [Type]
ts Int
i (VarName -> Expr
Y.Var VarName
z))) Expr
cont ([Int] -> [VarName] -> [Type] -> [(Int, VarName, Type)]
forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [Int
0 ..] [VarName]
w [Type]
ts))
      Expr
body1 <- [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements ([Statement]
body1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr' -> Statement
X.Return Expr'
read]) ([Statement]
cont [Statement] -> [[Statement]] -> [[Statement]]
forall a. a -> [a] -> [a]
: [[Statement]]
conts)
      Expr
body2 <- [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements ([Statement]
body2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Expr' -> Statement
X.Return Expr'
read]) ([Statement]
cont [Statement] -> [[Statement]] -> [[Statement]]
forall a. a -> [a] -> [a]
: [[Statement]]
conts)
      Expr
cont <- [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
cont [[Statement]]
conts
      Expr -> m Expr
forall (m :: * -> *) a. Monad m => a -> m a
return (Expr -> m Expr) -> Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ Expr -> Expr -> Expr
write (Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
t Expr
e Expr
body1 Expr
body2) Expr
cont
    (Bool
False, Bool
True) -> Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
t Expr
e (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements ([Statement]
body1 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
cont) [[Statement]]
conts m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
body2 []
    (Bool
True, Bool
False) -> Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
t Expr
e (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
body1 [] m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements ([Statement]
body2 [Statement] -> [Statement] -> [Statement]
forall a. [a] -> [a] -> [a]
++ [Statement]
cont) [[Statement]]
conts
    (Bool
True, Bool
True) -> Type -> Expr -> Expr -> Expr -> Expr
Y.If' Type
t Expr
e (Expr -> Expr -> Expr) -> m Expr -> m (Expr -> Expr)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
body1 [] m (Expr -> Expr) -> m Expr -> m Expr
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
body2 []

runStatements :: (MonadState Env m, MonadAlpha m, MonadError Error m) => [X.Statement] -> [[X.Statement]] -> m Y.Expr
runStatements :: [Statement] -> [[Statement]] -> m Expr
runStatements [] [[Statement]]
_ = String -> m Expr
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"function may not return"
runStatements (Statement
stmt : [Statement]
stmts) [[Statement]]
cont = case Statement
stmt of
  X.Return Expr'
e -> Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
  X.AugAssign Target'
x Operator
op Expr'
e -> do
    Expr
y <- Target' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> m Expr
runTargetExpr Target'
x
    Expr
op <- Literal -> Expr
Y.Lit (Literal -> Expr) -> (Builtin -> Literal) -> Builtin -> Expr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builtin -> Literal
Y.LitBuiltin (Builtin -> Expr) -> m Builtin -> m Expr
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Operator -> m Builtin
forall (m :: * -> *). MonadError Error m => Operator -> m Builtin
runOperator Operator
op
    Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
    Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (Expr -> Expr -> Expr -> Expr
Y.App2 Expr
op Expr
y Expr
e) (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
      [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
stmts [[Statement]]
cont
  X.AnnAssign Target'
x Type
_ Expr'
e -> do
    Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
    Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x Expr
e (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
      m Expr -> m Expr
forall (m :: * -> *) a. MonadState [VarName] m => m a -> m a
withScope (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
        (VarName -> m ()) -> [VarName] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ VarName -> m ()
forall (m :: * -> *). MonadState [VarName] m => VarName -> m ()
defineVar (Target' -> [VarName]
X.targetVars Target'
x)
        [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
stmts [[Statement]]
cont
  X.For Target'
x Expr'
iter [Statement]
body -> Target'
-> Expr' -> [Statement] -> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
Target'
-> Expr' -> [Statement] -> [Statement] -> [[Statement]] -> m Expr
runForStatement Target'
x Expr'
iter [Statement]
body [Statement]
stmts [[Statement]]
cont
  X.If Expr'
e [Statement]
body1 [Statement]
body2 -> Expr'
-> [Statement]
-> [Statement]
-> [Statement]
-> [[Statement]]
-> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
Expr'
-> [Statement]
-> [Statement]
-> [Statement]
-> [[Statement]]
-> m Expr
runIfStatement Expr'
e [Statement]
body1 [Statement]
body2 [Statement]
stmts [[Statement]]
cont
  X.Assert Expr'
_ -> [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
stmts [[Statement]]
cont
  X.Append Maybe Loc
loc Type
t Expr'
x Expr'
e -> do
    case Expr' -> Maybe Target'
X.exprToTarget Expr'
x of
      Maybe Target'
Nothing -> Maybe Loc -> String -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' Maybe Loc
loc String
"invalid `append` method"
      Just Target'
x -> do
        Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
        Expr
y <- Target' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> m Expr
runTargetExpr Target'
x
        Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
        Target' -> Expr -> m Expr -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Target' -> Expr -> m Expr -> m Expr
runAssign Target'
x (Type -> Expr -> Expr -> Expr
Y.Snoc' Type
t Expr
y Expr
e) (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
          [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
stmts [[Statement]]
cont
  X.Expr' Expr'
e -> Maybe Loc -> String -> m Expr
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e) String
"invalid expr-statement"

runToplevelStatements :: (MonadState Env m, MonadAlpha m, MonadError Error m) => [X.ToplevelStatement] -> m Y.ToplevelExpr
runToplevelStatements :: [ToplevelStatement] -> m ToplevelExpr
runToplevelStatements [] = ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelExpr -> m ToplevelExpr) -> ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ Expr -> ToplevelExpr
Y.ResultExpr (VarName -> Expr
Y.Var VarName
"solve")
runToplevelStatements (ToplevelStatement
stmt : [ToplevelStatement]
stmts) = case ToplevelStatement
stmt of
  X.ToplevelAnnAssign VarName'
x Type
t Expr'
e -> do
    Expr
e <- Expr' -> m Expr
forall (m :: * -> *).
(MonadAlpha m, MonadError Error m) =>
Expr' -> m Expr
runExpr Expr'
e
    VarName -> m ()
forall (m :: * -> *). MonadState [VarName] m => VarName -> m ()
defineVar (VarName' -> VarName
forall a. WithLoc' a -> a
X.value' VarName'
x)
    ToplevelExpr
cont <- [ToplevelStatement] -> m ToplevelExpr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[ToplevelStatement] -> m ToplevelExpr
runToplevelStatements [ToplevelStatement]
stmts
    Type
t <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
t
    ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelExpr -> m ToplevelExpr) -> ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ VarName -> Type -> Expr -> ToplevelExpr -> ToplevelExpr
Y.ToplevelLet (VarName' -> VarName
runVarName VarName'
x) Type
t Expr
e ToplevelExpr
cont
  X.ToplevelFunctionDef VarName'
f [(VarName', Type)]
args Type
ret [Statement]
body -> do
    VarName -> m ()
forall (m :: * -> *). MonadState [VarName] m => VarName -> m ()
defineVar (VarName' -> VarName
forall a. WithLoc' a -> a
X.value' VarName'
f)
    Expr
body <- m Expr -> m Expr
forall (m :: * -> *) a. MonadState [VarName] m => m a -> m a
withScope (m Expr -> m Expr) -> m Expr -> m Expr
forall a b. (a -> b) -> a -> b
$ do
      ((VarName', Type) -> m ()) -> [(VarName', Type)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (VarName -> m ()
forall (m :: * -> *). MonadState [VarName] m => VarName -> m ()
defineVar (VarName -> m ())
-> ((VarName', Type) -> VarName) -> (VarName', Type) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName' -> VarName
forall a. WithLoc' a -> a
X.value' (VarName' -> VarName)
-> ((VarName', Type) -> VarName') -> (VarName', Type) -> VarName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarName', Type) -> VarName'
forall a b. (a, b) -> a
fst) [(VarName', Type)]
args
      [Statement] -> [[Statement]] -> m Expr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[Statement] -> [[Statement]] -> m Expr
runStatements [Statement]
body []
    ToplevelExpr
cont <- [ToplevelStatement] -> m ToplevelExpr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[ToplevelStatement] -> m ToplevelExpr
runToplevelStatements [ToplevelStatement]
stmts
    [(VarName, Type)]
args <- ((VarName', Type) -> m (VarName, Type))
-> [(VarName', Type)] -> m [(VarName, Type)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(VarName'
x, Type
t) -> (VarName' -> VarName
runVarName VarName'
x,) (Type -> (VarName, Type)) -> m Type -> m (VarName, 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) [(VarName', Type)]
args
    Type
ret <- Type -> m Type
forall (m :: * -> *). MonadError Error m => Type -> m Type
runType Type
ret
    ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. Monad m => a -> m a
return (ToplevelExpr -> m ToplevelExpr) -> ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ VarName
-> [(VarName, Type)]
-> Type
-> Expr
-> ToplevelExpr
-> ToplevelExpr
Y.ToplevelLetRec (VarName' -> VarName
runVarName VarName'
f) [(VarName, Type)]
args Type
ret Expr
body ToplevelExpr
cont
  X.ToplevelAssert Expr'
_ -> [ToplevelStatement] -> m ToplevelExpr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[ToplevelStatement] -> m ToplevelExpr
runToplevelStatements [ToplevelStatement]
stmts -- TOOD: use assertions as hints

-- | `run` converts programs of our restricted Python-like language to programs of our core language.
-- This assumes the follwing conditions:
--
-- * `X.doesntHaveSubscriptionInLoopCounters`
-- * `X.doesntHaveLeakOfLoopCounters`
-- * `X.doesntHaveAssignmentToLoopCounters`
-- * `X.doesntHaveAssignmentToLoopIterators`
-- * `X.doesntHaveReturnInLoops`
-- * `X.doesntHaveNonTrivialSubscriptedAssignmentInForLoops`
--
-- For example, this converts the following:
--
-- > def solve(n):
-- >     if n == 0:
-- >         return 1
-- >     else:
-- >         return n * solve(n - 1)
--
-- to:
--
-- > let solve n =
-- >     if n == 0 then
-- >         1
-- >     else:
-- >         n * solve (n - 1)
-- > in solve
--
-- Also, this converts the following:
--
-- > def solve(n):
-- >     a = 0
-- >     b = 1
-- >     for _ in range(n):
-- >         c = a + b
-- >         a = b
-- >         b = c
-- >     return a
--
-- to:
--
-- > let solve n =
-- >     fst (foldl (fun (a, b) i -> (b, a + b)) (0, 1) [0 .. n - 1])
-- > in solve
run :: (MonadAlpha m, MonadError Error m) => X.Program -> m Y.Program
run :: [ToplevelStatement] -> m ToplevelExpr
run [ToplevelStatement]
prog = String -> m ToplevelExpr -> m ToplevelExpr
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.RestrictedPython.Convert.ToCore" (m ToplevelExpr -> m ToplevelExpr)
-> m ToplevelExpr -> m ToplevelExpr
forall a b. (a -> b) -> a -> b
$ do
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveSubscriptionInLoopCounters [ToplevelStatement]
prog
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveLeakOfLoopCounters [ToplevelStatement]
prog
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveAssignmentToLoopCounters [ToplevelStatement]
prog
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveAssignmentToLoopIterators [ToplevelStatement]
prog
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveReturnInLoops [ToplevelStatement]
prog
  [ToplevelStatement] -> m ()
forall (m :: * -> *).
MonadError Error m =>
[ToplevelStatement] -> m ()
X.ensureDoesntHaveNonTrivialSubscriptedAssignmentInForLoops [ToplevelStatement]
prog
  StateT [VarName] m ToplevelExpr -> [VarName] -> m ToplevelExpr
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT ([ToplevelStatement] -> StateT [VarName] m ToplevelExpr
forall (m :: * -> *).
(MonadState [VarName] m, MonadAlpha m, MonadError Error m) =>
[ToplevelStatement] -> m ToplevelExpr
runToplevelStatements [ToplevelStatement]
prog) []