{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}

-- |
-- Module      : Jikka.RestrictedPython.Evaluate
-- Description : evaluates programs of the restricted Python. / 制限された Python のプログラムを評価します。
-- Copyright   : (c) Kimiyuki Onaka, 2021
-- License     : Apache License 2.0
-- Maintainer  : kimiyuki95@gmail.com
-- Stability   : experimental
-- Portability : portable
module Jikka.RestrictedPython.Evaluate
  ( run,

    -- * internal functions
    makeGlobal,
    runWithGlobal,
    evalExpr,
    evalStatement,
    evalStatements,
    execToplevelStatement,
  )
where

import Control.Arrow (first)
import Control.Monad.Reader
import Control.Monad.State.Strict
import Data.Bits
import Data.List (maximumBy, minimumBy, sortBy)
import qualified Data.Map.Strict as M
import qualified Data.Vector as V
import Jikka.Common.Combinatorics
import Jikka.Common.Error
import Jikka.RestrictedPython.Format (formatAttribute, formatBuiltin, formatOperator)
import Jikka.RestrictedPython.Language.Expr
import Jikka.RestrictedPython.Language.Lint
import Jikka.RestrictedPython.Language.Util
import Jikka.RestrictedPython.Language.Value

assign :: MonadState Local m => VarName -> Value -> m ()
assign :: VarName -> Value -> m ()
assign VarName
x Value
v = (Local -> Local) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify' (Map VarName Value -> Local
Local (Map VarName Value -> Local)
-> (Local -> Map VarName Value) -> Local -> Local
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> Value -> Map VarName Value -> Map VarName Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert VarName
x Value
v (Map VarName Value -> Map VarName Value)
-> (Local -> Map VarName Value) -> Local -> Map VarName Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Local -> Map VarName Value
unLocal)

lookupLocal :: (MonadState Local m, MonadError Error m) => VarName' -> m Value
lookupLocal :: VarName' -> m Value
lookupLocal VarName'
x = do
  Local
local <- m Local
forall s (m :: * -> *). MonadState s m => m s
get
  case VarName -> Map VarName Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) (Local -> Map VarName Value
unLocal Local
local) of
    Just Value
v -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
    Maybe Value
Nothing -> Maybe Loc -> String -> m Value
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwInternalErrorAt' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)

assignSubscriptedTarget :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Target' -> Expr' -> Value -> m ()
assignSubscriptedTarget :: Target' -> Expr' -> Value -> m ()
assignSubscriptedTarget Target'
f Expr'
index Value
v = Maybe Loc -> m () -> m ()
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
f) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  let go :: Target' -> [Expr'] -> m (VarName', [Expr'])
go Target'
f [Expr']
indices = Maybe Loc -> m (VarName', [Expr']) -> m (VarName', [Expr'])
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
f) (m (VarName', [Expr']) -> m (VarName', [Expr']))
-> m (VarName', [Expr']) -> m (VarName', [Expr'])
forall a b. (a -> b) -> a -> b
$ case Target' -> Target
forall a. WithLoc' a -> a
value' Target'
f of
        SubscriptTrg Target'
f Expr'
index -> Target' -> [Expr'] -> m (VarName', [Expr'])
go Target'
f (Expr'
index Expr' -> [Expr'] -> [Expr']
forall a. a -> [a] -> [a]
: [Expr']
indices)
        NameTrg VarName'
x -> (VarName', [Expr']) -> m (VarName', [Expr'])
forall (m :: * -> *) a. Monad m => a -> m a
return (VarName'
x, [Expr']
indices)
        TupleTrg [Target']
_ -> String -> m (VarName', [Expr'])
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"cannot subscript a tuple target"
  (VarName'
x, [Expr']
indices) <- Target' -> [Expr'] -> m (VarName', [Expr'])
forall (m :: * -> *).
MonadError Error m =>
Target' -> [Expr'] -> m (VarName', [Expr'])
go Target'
f [Expr'
index]
  Value
f <- VarName' -> m Value
forall (m :: * -> *).
(MonadState Local m, MonadError Error m) =>
VarName' -> m Value
lookupLocal VarName'
x
  [Value]
indices <- (Expr' -> m Value) -> [Expr'] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr [Expr']
indices
  let go :: Value -> [Value] -> m Value
go Value
f [Value]
index = case (Value
f, [Value]
index) of
        (Value
_, []) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
        (ListVal Vector Value
f, IntVal Integer
index : [Value]
indices) -> do
          Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
index Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
f) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
index) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
            String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"list index out of range"
          Value
v' <- Value -> [Value] -> m Value
go (Vector Value
f Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
V.! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
index) [Value]
indices
          Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Vector Value -> Value
ListVal (Vector Value
f Vector Value -> [(Int, Value)] -> Vector Value
forall a. Vector a -> [(Int, a)] -> Vector a
V.// [(Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
index, Value
v')])
        (Value
_, [Value]
_) -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  Value
f <- Value -> [Value] -> m Value
forall (m :: * -> *).
MonadError Error m =>
Value -> [Value] -> m Value
go Value
f [Value]
indices
  VarName -> Value -> m ()
forall (m :: * -> *).
MonadState Local m =>
VarName -> Value -> m ()
assign (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) Value
f

assignTarget :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Target' -> Value -> m ()
assignTarget :: Target' -> Value -> m ()
assignTarget Target'
x0 Value
v = Maybe Loc -> m () -> m ()
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
x0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ case Target' -> Target
forall a. WithLoc' a -> a
value' Target'
x0 of
  SubscriptTrg Target'
f Expr'
index -> do
    Target' -> Expr' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Expr' -> Value -> m ()
assignSubscriptedTarget Target'
f Expr'
index Value
v
  NameTrg VarName'
x -> do
    VarName -> Value -> m ()
forall (m :: * -> *).
MonadState Local m =>
VarName -> Value -> m ()
assign (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) Value
v
  TupleTrg [Target']
xs -> do
    case Value
v of
      TupleVal [Value]
vs -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Target'] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Target']
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
vs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"the lengths of tuple are different"
        [(Target', Value)] -> ((Target', Value) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Target'] -> [Value] -> [(Target', Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Target']
xs [Value]
vs) (((Target', Value) -> m ()) -> m ())
-> ((Target', Value) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(Target'
x, Value
v) -> do
          Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
v
      Value
_ -> String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"cannot unpack non-tuple value"

evalTarget :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Target' -> m Value
evalTarget :: Target' -> m Value
evalTarget Target'
x0 = Maybe Loc -> m Value -> m Value
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
x0) (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ case Target' -> Target
forall a. WithLoc' a -> a
value' Target'
x0 of
  SubscriptTrg Target'
f Expr'
index -> do
    Value
f <- Target' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> m Value
evalTarget Target'
f
    Value
index <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
index
    case (Value
f, Value
index) of
      (ListVal Vector Value
f, IntVal Integer
index) -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
index Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
f) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
index) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"list index out of range"
        Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Vector Value
f Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
V.! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
index
      (Value
_, Value
_) -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  NameTrg VarName'
x -> VarName' -> m Value
forall (m :: * -> *).
(MonadState Local m, MonadError Error m) =>
VarName' -> m Value
lookupLocal VarName'
x
  TupleTrg [Target']
xs -> [Value] -> Value
TupleVal ([Value] -> Value) -> m [Value] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Target' -> m Value) -> [Target'] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Target' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> m Value
evalTarget [Target']
xs

-- | `evalExpr` evaluates exprs of our restricted Python-like language.
--
-- === Rules for \(e_1 \operatorname{boolop} e_2\)
--
-- \[
--     \cfrac{e_1 \mid \mu \Downarrow \mathbf{false}}{e_1 ~\mathbf{and}~ e_2 \mid \mu \Downarrow \mathbf{false}}
-- \]
-- \[
--     \cfrac{e_1 \mid \mu \Downarrow \mathbf{true} \qquad e_2 \mid \mu \Downarrow v}{e_1 ~\mathbf{and}~ e_2 \mid \mu \Downarrow v}
-- \]
-- \[
--     \vdots
-- \]
--
-- === Rules for \(e_1 \operatorname{binop} e_2\)
--
-- \[
--     \cfrac{e_1 \mid \mu \Downarrow v_1 \qquad e_2 \mid \mu \Downarrow v_2}{e_1 + e_2 \mid \mu \Downarrow (v_1 + v_2)}
-- \]
-- \[
--     \vdots
-- \]
--
-- === Rules for \(\operatorname{unaryop} e\)
--
-- === Rules for \(\lambda x _ \tau x _ \tau \dots x _ \tau. e\)
--
-- \[
--     \lambda {x_0} _ {\tau _ 0} {x_1} _ {\tau _ 1} \dots {x _ {n - 1}} _ {\tau _ {n - 1}}. e \mid \mu \Downarrow \lambda _ {\mu} x_0 x_1 \dots x _ {n - 1}. e
-- \]
--
-- === Rules for \(\mathbf{if}~ e ~\mathbf{then}~ e ~\mathbf{else}~ e\)
--
-- === Rules for \(\lbrack e ~\mathbf{for}~ y ~\mathbf{in}~ e ~(\mathbf{if}~ e)? \rbrack\)
--
-- === Rules for \(e \operatorname{cmpop} e\)
--
-- === Rules for \(e (e, e, \dots, e)\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \lambda _ {\mu'} x_0 x_1 \dots x _ {n - 1}. e'
--         \qquad e_0 \mid \mu \Downarrow v_0
--         \qquad e_1 \mid \mu \Downarrow v_1
--         \qquad \dots
--         \qquad e _ {n - 1} \mid \mu \Downarrow v _ {n - 1}
--         \qquad e' \mid (x_0 \mapsto v_0; x_1 \mapsto v_1; \dots; x _ {n - 1} \mapsto v _ {n - 1}; \mu') \Downarrow v
--     }{
--         e(e_0, e_1, \dots, e _ {n - 1}) \mid \mu \Downarrow v
--     }
-- \]
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow b
--         \qquad e_0 \mid \mu \Downarrow v_0
--         \qquad e_1 \mid \mu \Downarrow v_1
--         \qquad \dots
--         \qquad e _ {n - 1} \mid \mu \Downarrow v _ {n - 1}
--     }{
--         e(e_0, e_1, \dots, e _ {n - 1}) \mid \mu \Downarrow b(e_0, e_1, \dots, e _ {n - 1})
--     }
--     \qquad{(b ~\text{is a builtin function})}
-- \]
--
-- === Rules for \(\operatorname{constant}\)
--
-- === Rules for \(e \lbrack e \rbrack\)
--
-- === Rules for \(x\)
--
-- \[
--     x \mid \mu \Downarrow \mu(x)
-- \]
--
-- === Rules for \(\lbrack e, e, \dots, e \rbrack _ \tau\)
--
-- === Rules for \(e \lbrack e? \colon e? \colon e? \rbrack\)
evalExpr :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Expr' -> m Value
evalExpr :: Expr' -> m Value
evalExpr Expr'
e0 = Maybe Loc -> m Value -> m Value
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 Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ case Expr' -> Expr
forall a. WithLoc' a -> a
value' Expr'
e0 of
  BoolOp Expr'
e1 BoolOp
op Expr'
e2 -> do
    Value
v1 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e1
    case (Value
v1, BoolOp
op) of
      (BoolVal Bool
False, BoolOp
And) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal Bool
False
      (BoolVal Bool
True, BoolOp
And) -> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
      (BoolVal Bool
False, BoolOp
Or) -> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
      (BoolVal Bool
True, BoolOp
Or) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal Bool
True
      (BoolVal Bool
False, BoolOp
Implies) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal Bool
True
      (BoolVal Bool
True, BoolOp
Implies) -> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
      (Value
_, BoolOp
_) -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  BinOp Expr'
e1 Operator
op Expr'
e2 -> do
    Value
v1 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e1
    Value
v2 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
    Value -> Operator -> Value -> m Value
forall (m :: * -> *).
MonadError Error m =>
Value -> Operator -> Value -> m Value
evalBinOp Value
v1 Operator
op Value
v2
  UnaryOp UnaryOp
op Expr'
e -> do
    Value
v <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    case (UnaryOp
op, Value
v) of
      (UnaryOp
Invert, IntVal Integer
v) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
IntVal (Integer -> Integer
forall a. Bits a => a -> a
complement Integer
v)
      (UnaryOp
Not, BoolVal Bool
v) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal (Bool -> Bool
not Bool
v)
      (UnaryOp
UAdd, IntVal Integer
v) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
IntVal Integer
v
      (UnaryOp
USub, IntVal Integer
v) -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
IntVal (- Integer
v)
      (UnaryOp
_, Value
_) -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  Lambda [(VarName', Type)]
args Expr'
body -> do
    Local
savedLocal <- m Local
forall s (m :: * -> *). MonadState s m => m s
get
    Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Local -> [(VarName, Type)] -> [Statement] -> Value
ClosureVal Local
savedLocal (((VarName', Type) -> (VarName, Type))
-> [(VarName', Type)] -> [(VarName, Type)]
forall a b. (a -> b) -> [a] -> [b]
map ((VarName' -> VarName) -> (VarName', Type) -> (VarName, Type)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first VarName' -> VarName
forall a. WithLoc' a -> a
value') [(VarName', Type)]
args) [Expr' -> Statement
Return Expr'
body]
  IfExp Expr'
e1 Expr'
e2 Expr'
e3 -> do
    Value
v1 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e1
    case Value
v1 of
      BoolVal Bool
True -> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
      BoolVal Bool
False -> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e3
      Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  ListComp Expr'
e (Comprehension Target'
x Expr'
iter Maybe Expr'
pred) -> do
    Value
iter <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
iter
    case Value
iter of
      ListVal Vector Value
iter -> do
        Local
savedLocal <- m Local
forall s (m :: * -> *). MonadState s m => m s
get
        Vector (Maybe Value)
vs <- Vector Value
-> (Value -> m (Maybe Value)) -> m (Vector (Maybe Value))
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Value
iter ((Value -> m (Maybe Value)) -> m (Vector (Maybe Value)))
-> (Value -> m (Maybe Value)) -> m (Vector (Maybe Value))
forall a b. (a -> b) -> a -> b
$ \Value
it -> do
          Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
it
          Maybe Value
pred <- (Expr' -> m Value) -> Maybe Expr' -> m (Maybe Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Maybe Expr'
pred
          case Maybe Value
pred of
            Just (BoolVal Bool
False) -> Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
            Maybe Value
_ -> Value -> Maybe Value
forall a. a -> Maybe a
Just (Value -> Maybe Value) -> m Value -> m (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
        Local -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Local
savedLocal
        Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Vector Value -> Value
ListVal (Vector (Maybe Value) -> Vector Value
forall a. Vector (Maybe a) -> Vector a
V.catMaybes Vector (Maybe Value)
vs)
      Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  Compare Expr'
e1 CmpOp'
op Expr'
e2 -> do
    Value
v1 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e1
    Value
v2 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
    case CmpOp'
op of
      CmpOp' CmpOp
In Type
_ -> do
        Vector Value
v2 <- Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value
v2
        Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal (Value
v1 Value -> Vector Value -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Vector Value
v2)
      CmpOp' CmpOp
NotIn Type
_ -> do
        Vector Value
v2 <- Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value
v2
        Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
BoolVal (Value
v1 Value -> Vector Value -> Bool
forall a. Eq a => a -> Vector a -> Bool
`V.elem` Vector Value
v2)
      CmpOp' CmpOp
op Type
_ -> do
        Ordering
ordering <- m Ordering
-> (Ordering -> m Ordering) -> Maybe Ordering -> m Ordering
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m Ordering
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"something wrong") Ordering -> m Ordering
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> Value -> Maybe Ordering
compareValues Value
v1 Value
v2)
        Bool -> Value
BoolVal (Bool -> Value) -> m Bool -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case CmpOp
op of
          CmpOp
Eq' -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
          CmpOp
NotEq -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
          CmpOp
Lt -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
LT
          CmpOp
LtE -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
GT
          CmpOp
Gt -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT
          CmpOp
GtE -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
LT
          CmpOp
Is -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
          CmpOp
IsNot -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Ordering
ordering Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
/= Ordering
EQ
          CmpOp
_ -> String -> m Bool
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"something wrong"
  Call Expr'
f [Expr']
args -> Expr' -> [Expr'] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> [Expr'] -> m Value
evalCall Expr'
f [Expr']
args
  Constant Constant
const ->
    Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ case Constant
const of
      Constant
ConstNone -> [Value] -> Value
TupleVal []
      ConstInt Integer
v -> Integer -> Value
IntVal Integer
v
      ConstBool Bool
v -> Bool -> Value
BoolVal Bool
v
      ConstBuiltin Builtin
v -> Builtin -> Value
BuiltinVal Builtin
v
  Attribute Expr'
e Attribute'
a -> Value -> Attribute -> Value
AttributeVal (Value -> Attribute -> Value) -> m Value -> m (Attribute -> Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e m (Attribute -> Value) -> m Attribute -> m Value
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Attribute -> m Attribute
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Attribute' -> Attribute
forall a. WithLoc' a -> a
value' Attribute'
a)
  Subscript Expr'
e1 Expr'
e2 -> do
    Value
v1 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e1
    Value
v2 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e2
    case (Value
v1, Value
v2) of
      (ListVal Vector Value
v1, IntVal Integer
v2) -> do
        Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v2 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0 Bool -> Bool -> Bool
|| Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
v1) Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
v2) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
          String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"list index out of range"
        Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Vector Value
v1 Vector Value -> Int -> Value
forall a. Vector a -> Int -> a
V.! Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
v2
      (Value, Value)
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  Starred Expr'
_ ->
    String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"cannot evaluate starred expr"
  Name VarName'
x -> do
    Local
local <- m Local
forall s (m :: * -> *). MonadState s m => m s
get
    case VarName -> Map VarName Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) (Local -> Map VarName Value
unLocal Local
local) of
      Just Value
v -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
      Maybe Value
Nothing -> do
        Global
global <- m Global
forall r (m :: * -> *). MonadReader r m => m r
ask
        case VarName -> Map VarName Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) (Global -> Map VarName Value
unGlobal Global
global) of
          Just Value
v -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
          Maybe Value
Nothing -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)
  List Type
_ [Expr']
es -> Vector Value -> Value
ListVal (Vector Value -> Value)
-> ([Value] -> Vector Value) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Value) -> m [Value] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr' -> m Value) -> [Expr'] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr [Expr']
es
  Tuple [Expr']
es -> [Value] -> Value
TupleVal ([Value] -> Value) -> m [Value] -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Expr' -> m Value) -> [Expr'] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr [Expr']
es
  SubscriptSlice Expr'
e Maybe Expr'
from Maybe Expr'
to Maybe Expr'
step -> do
    Value
v <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    Maybe Value
from <- (Expr' -> m Value) -> Maybe Expr' -> m (Maybe Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Maybe Expr'
from
    Maybe Value
to <- (Expr' -> m Value) -> Maybe Expr' -> m (Maybe Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Maybe Expr'
to
    Maybe Value
step <- (Expr' -> m Value) -> Maybe Expr' -> m (Maybe Value)
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Maybe Expr'
step
    case Value
v of
      ListVal Vector Value
v ->
        Vector Value -> Value
ListVal (Vector Value -> Value) -> m (Vector Value) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> case (Maybe Value
from, Maybe Value
to, Maybe Value
step) of
          (Maybe Value
_, Maybe Value
_, Just Value
_) -> String -> m (Vector Value)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"slice with step is TODO"
          (Maybe Value
Nothing, Maybe Value
Nothing, Maybe Value
Nothing) -> Vector Value -> m (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Vector Value
v
          (Maybe Value
Nothing, Just (IntVal Integer
to), Maybe Value
Nothing) -> Vector Value -> m (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> m (Vector Value))
-> Vector Value -> m (Vector Value)
forall a b. (a -> b) -> a -> b
$ Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
to) Vector Value
v
          (Just (IntVal Integer
from), Maybe Value
Nothing, Maybe Value
Nothing) -> Vector Value -> m (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> m (Vector Value))
-> Vector Value -> m (Vector Value)
forall a b. (a -> b) -> a -> b
$ Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
from) Vector Value
v
          (Just (IntVal Integer
from), Just (IntVal Integer
to), Maybe Value
Nothing) -> Vector Value -> m (Vector Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Vector Value -> m (Vector Value))
-> Vector Value -> m (Vector Value)
forall a b. (a -> b) -> a -> b
$ Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.drop (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
from) (Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.take (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
to) Vector Value
v)
          (Maybe Value
_, Maybe Value
_, Maybe Value
_) -> String -> m (Vector Value)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
      Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"

evalCall :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Expr' -> [Expr'] -> m Value
evalCall :: Expr' -> [Expr'] -> m Value
evalCall Expr'
f [Expr']
args = Maybe Loc -> m Value -> m Value
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
f) (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
  Value
f <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
f
  [Value]
args <- (Expr' -> m Value) -> [Expr'] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr [Expr']
args
  Value -> [Value] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> [Value] -> m Value
evalCall' Value
f [Value]
args

evalCall' :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Value -> [Value] -> m Value
evalCall' :: Value -> [Value] -> m Value
evalCall' Value
f [Value]
actualArgs = case Value
f of
  AttributeVal Value
v Attribute
a -> do
    Value -> Attribute -> [Value] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> Attribute -> [Value] -> m Value
evalAttribute Value
v Attribute
a [Value]
actualArgs
  BuiltinVal Builtin
b -> do
    Builtin -> [Value] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Builtin -> [Value] -> m Value
evalBuiltin Builtin
b [Value]
actualArgs
  ClosureVal Local
local [(VarName, Type)]
formalArgs [Statement]
body -> do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([(VarName, Type)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(VarName, Type)]
formalArgs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
actualArgs) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"wrong number of arguments"
    Local
savedLocal <- m Local
forall s (m :: * -> *). MonadState s m => m s
get
    Local -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Local
local
    ((VarName, Value) -> m ()) -> [(VarName, Value)] -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ((VarName -> Value -> m ()) -> (VarName, Value) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry VarName -> Value -> m ()
forall (m :: * -> *).
MonadState Local m =>
VarName -> Value -> m ()
assign) ([VarName] -> [Value] -> [(VarName, Value)]
forall a b. [a] -> [b] -> [(a, b)]
zip (((VarName, Type) -> VarName) -> [(VarName, Type)] -> [VarName]
forall a b. (a -> b) -> [a] -> [b]
map (VarName, Type) -> VarName
forall a b. (a, b) -> a
fst [(VarName, Type)]
formalArgs) [Value]
actualArgs)
    Maybe Value
v <- [Statement] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Statement] -> m (Maybe Value)
evalStatements [Statement]
body
    Local -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put Local
savedLocal
    case Maybe Value
v of
      Just Value
v -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
v
      Maybe Value
Nothing -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"it reaches the end of function without return"
  Value
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"type error"

-- | `evalStatement` evaluates statements of our restricted Python-like language.
-- When a statement is evaluated, it returns a value \(v\), doesn't return anything \(\mathbf{stop}\), or fails \(\mathbf{err}\).
-- Also it updates the environment function \(\mu\) from variables to values.
--
-- === Rules for \(\mathbf{return}~ e\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow v
--     }{
--         \mathbf{return}~ e \mid \mu \Downarrow v \mid \mu
--     }
-- \]
--
-- === Rules for \(y \operatorname{binop} = e\)
--
-- \[
--     \cfrac{
--         y \operatorname{binop} e \mid \mu \Downarrow v
--     }{
--         y \operatorname{binop} = e \mid \mu \Downarrow \mathbf{stop} \mid (y \mapsto v; \mu)
--     }
-- \]
--
-- === Rules for \(y := e\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow v
--      }{
--          y \operatorname{binop} = e \mid \mu \Downarrow \mathbf{stop} \mid (y \mapsto v; \mu)
--      }
-- \]
--
-- === Rules for \(\mathbf{for}~ y ~\mathbf{in}~ e \colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt}\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{nil}
--     }{
--         (\mathbf{for}~ y ~\mathbf{in}~ e \colon~ \vec{\mathrm{stmt}}) \mid \mu \Downarrow \mathbf{stop} \mid \mu
--     }
-- \]
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{cons}(v_1, v_2)
--         \qquad \vec{\mathrm{stmt}} \mid (y \mapsto v_1; \mu) \Downarrow v \mid \mu'
--     }{
--         (\mathbf{for}~ y ~\mathbf{in}~ e \colon~ \vec{\mathrm{stmt}}) \mid \mu \Downarrow v \mid \mu'
--     }
-- \]
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{cons}(v_1, v_2)
--         \qquad \vec{\mathrm{stmt}} \mid (y \mapsto v_1; \mu) \Downarrow \mathbf{stop} \mid \mu'
--         \qquad (\mathbf{for}~ y ~\mathbf{in}~ v_2 \colon~ \vec{\mathrm{stmt}}) \mid \mu' \Downarrow a \mid \mu''
--     }{
--         (\mathbf{for}~ y ~\mathbf{in}~ e \colon~ \vec{\mathrm{stmt}}) \mid \mu \Downarrow a \mid \mu''
--     }
--     \qquad{(a \in \lbrace v, \mathbf{stop} \rbrace)}
-- \]
--
-- It assumes the program is properly alpha-converted, i.e. `doesntHaveLeakOfLoopCounters`. So it leaks loop counters to out of loops.
--
-- === Rules for \(\mathbf{if}~ e \colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt};\quad \mathbf{else}\colon\quad \mathrm{stmt}; \mathrm{stmt}; \dots; \mathrm{stmt}\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{true}
--         \qquad \vec{\mathrm{stmt}} _ 1 \mid \mu \Downarrow a \mid \mu'
--     }{
--         (\mathbf{if}~ e \colon~ \vec{\mathrm{stmt}} _ 1 ~\mathbf{else}\colon~ \vec{\mathrm{stmt}} _ 2) \mid \mu \Downarrow a \mid \mu'
--     }
--     \qquad{(a \in \lbrace v, \mathbf{stop} \rbrace)}
-- \]
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{false}
--         \qquad \vec{\mathrm{stmt}} _ 2 \mid \mu \Downarrow a \mid \mu'
--     }{
--         (\mathbf{if}~ e \colon~ \vec{\mathrm{stmt}} _ 1 ~\mathbf{else}\colon~ \vec{\mathrm{stmt}} _ 2) \mid \mu \Downarrow a \mid \mu'
--     }
--     \qquad{(a \in \lbrace v, \mathbf{stop} \rbrace)}
-- \]
--
-- === Rules for \(\mathbf{assert}~ e\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{true}
--     }{
--         \mathbf{assert}~ e \mid \mu \Downarrow \mathbf{stop}
--     }
-- \]
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow \mathbf{false}
--     }{
--         \mathbf{assert}~ e \mid \mu \Downarrow \mathbf{err}
--     }
-- \]
--
-- === Rules for \(e\)
--
-- \[
--     \cfrac{
--         e \mid \mu \Downarrow v
--     }{
--         x.\mathrm{append}(e) \mid \mu \Downarrow \mathbf{stop} \mid (x \mapsto \mathrm{snoc}(\mu(x), v); \mu)
--     }
-- \]
evalStatement :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Statement -> m (Maybe Value)
evalStatement :: Statement -> m (Maybe Value)
evalStatement = \case
  Return Expr'
e -> do
    Value
v <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
  AugAssign Target'
x Operator
op Expr'
e -> do
    Value
v1 <- Target' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> m Value
evalTarget Target'
x
    Value
v2 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    Value
v <- Value -> Operator -> Value -> m Value
forall (m :: * -> *).
MonadError Error m =>
Value -> Operator -> Value -> m Value
evalBinOp Value
v1 Operator
op Value
v2
    Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
v
    Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
  AnnAssign Target'
x Type
_ Expr'
e -> do
    Value
v <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
v
    Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
  For Target'
x Expr'
iter [Statement]
body -> do
    Value
iter <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
iter
    case Value
iter of
      ListVal Vector Value
iter -> do
        let go :: [Value] -> m (Maybe Value)
go [] = Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
            go (Value
it : [Value]
iter) = do
              Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
it
              Maybe Value
v <- [Statement] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Statement] -> m (Maybe Value)
evalStatements [Statement]
body
              case Maybe Value
v of
                Just Value
v -> Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
                Maybe Value
Nothing -> [Value] -> m (Maybe Value)
go [Value]
iter
        [Value] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Value] -> m (Maybe Value)
go (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
iter)
      Value
_ -> Maybe Loc -> m (Maybe Value) -> m (Maybe Value)
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Target' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Target'
x) (m (Maybe Value) -> m (Maybe Value))
-> m (Maybe Value) -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
        String -> m (Maybe Value)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
  If Expr'
pred [Statement]
body1 [Statement]
body2 -> do
    Value
pred <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
pred
    if Value
pred Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Value
BoolVal Bool
False
      then [Statement] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Statement] -> m (Maybe Value)
evalStatements [Statement]
body1
      else [Statement] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Statement] -> m (Maybe Value)
evalStatements [Statement]
body2
  Assert Expr'
e -> Maybe Loc -> m (Maybe Value) -> m (Maybe Value)
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> m a -> m a
wrapAt' (Expr' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' Expr'
e) (m (Maybe Value) -> m (Maybe Value))
-> m (Maybe Value) -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
    Value
v <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Bool -> Value
BoolVal Bool
False) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"assertion failure"
    Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
  Append Maybe Loc
loc Type
_ Expr'
x Expr'
e -> case Expr' -> Maybe Target'
exprToTarget Expr'
x of
    Maybe Target'
Nothing -> Maybe Loc -> String -> m (Maybe Value)
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSemanticErrorAt' Maybe Loc
loc String
"wrong `append` method"
    Just Target'
x -> do
      Value
v1 <- Target' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> m Value
evalTarget Target'
x
      Value
v2 <- Expr' -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e
      Value
v <- Vector Value -> Value
ListVal (Vector Value -> Value) -> m (Vector Value) -> m Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Vector Value -> Value -> Vector Value
forall a. Vector a -> a -> Vector a
V.snoc (Vector Value -> Value -> Vector Value)
-> m (Vector Value) -> m (Value -> Vector Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value
v1 m (Value -> Vector Value) -> m Value -> m (Vector Value)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v2)
      Target' -> Value -> m ()
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Target' -> Value -> m ()
assignTarget Target'
x Value
v
      Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
  Expr' Expr'
e -> Maybe Loc -> String -> m (Maybe Value)
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
"wrong expr-statement"

-- | `evalStatements` evaluates sequences of statements of our restricted Python-like language.
--
-- \[
--     \cfrac{\mathrm{stmt} _ 0 \mid \mu \Downarrow v \mid \mu'}{\mathrm{stmt} _ 0; \mathrm{stmt} _ 1; \dots; \mathrm{stmt} _ {n-1} \mid \mu \Downarrow v \mid \mu'}
-- \]
--
-- \[
--     \cfrac{\mathrm{stmt} _ 0 \mid \mu \Downarrow \mathbf{stop} \mid \mu' \qquad \mathrm{stmt} _ 1; \dots; \mathrm{stmt} _ {n-1} \mid \mu' \Downarrow a \mid \mu''}{\mathrm{stmt} _ 0; \mathrm{stmt} _ 1; \dots; \mathrm{stmt} _ {n-1} \mid \mu \Downarrow a \mid \mu''}
--     \qquad{(a \in \lbrace v, \mathbf{stop} \rbrace)}
-- \]
--
-- \[
--     \epsilon \mid \mu \Downarrow \mathbf{stop} \mid \mu
-- \]
evalStatements :: (MonadReader Global m, MonadState Local m, MonadError Error m) => [Statement] -> m (Maybe Value)
evalStatements :: [Statement] -> m (Maybe Value)
evalStatements [] = Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
evalStatements (Statement
stmt : [Statement]
stmts) = do
  Maybe Value
v <- Statement -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Statement -> m (Maybe Value)
evalStatement Statement
stmt
  case Maybe Value
v of
    Just Value
v -> Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
v
    Maybe Value
Nothing -> [Statement] -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
[Statement] -> m (Maybe Value)
evalStatements [Statement]
stmts

execToplevelStatement :: (MonadState Global m, MonadError Error m) => ToplevelStatement -> m ()
execToplevelStatement :: ToplevelStatement -> m ()
execToplevelStatement = \case
  ToplevelAnnAssign VarName'
x Type
_ Expr'
e -> do
    Global
global <- m Global
forall s (m :: * -> *). MonadState s m => m s
get
    Value
v <- Global -> Expr' -> m Value
forall (m :: * -> *).
MonadError Error m =>
Global -> Expr' -> m Value
runWithGlobal Global
global Expr'
e
    Global -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Global -> m ()) -> Global -> m ()
forall a b. (a -> b) -> a -> b
$ Map VarName Value -> Global
Global (VarName -> Value -> Map VarName Value -> Map VarName Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) Value
v (Global -> Map VarName Value
unGlobal Global
global))
  ToplevelFunctionDef VarName'
f [(VarName', Type)]
args Type
_ [Statement]
body -> do
    Global
global <- m Global
forall s (m :: * -> *). MonadState s m => m s
get
    let v :: Value
v = Local -> [(VarName, Type)] -> [Statement] -> Value
ClosureVal (Map VarName Value -> Local
Local Map VarName Value
forall k a. Map k a
M.empty) (((VarName', Type) -> (VarName, Type))
-> [(VarName', Type)] -> [(VarName, Type)]
forall a b. (a -> b) -> [a] -> [b]
map ((VarName' -> VarName) -> (VarName', Type) -> (VarName, Type)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first VarName' -> VarName
forall a. WithLoc' a -> a
value') [(VarName', Type)]
args) [Statement]
body
    Global -> m ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (Global -> m ()) -> Global -> m ()
forall a b. (a -> b) -> a -> b
$ Map VarName Value -> Global
Global (VarName -> Value -> Map VarName Value -> Map VarName Value
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
f) Value
v (Global -> Map VarName Value
unGlobal Global
global))
  ToplevelAssert Expr'
e -> do
    Global
global <- m Global
forall s (m :: * -> *). MonadState s m => m s
get
    Value
v <- Global -> Expr' -> m Value
forall (m :: * -> *).
MonadError Error m =>
Global -> Expr' -> m Value
runWithGlobal Global
global Expr'
e
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value
v Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool -> Value
BoolVal Bool
True) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      String -> m ()
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"assertion failure"

newtype Global = Global
  { Global -> Map VarName Value
unGlobal :: M.Map VarName Value
  }
  deriving (Global -> Global -> Bool
(Global -> Global -> Bool)
-> (Global -> Global -> Bool) -> Eq Global
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Global -> Global -> Bool
$c/= :: Global -> Global -> Bool
== :: Global -> Global -> Bool
$c== :: Global -> Global -> Bool
Eq, Eq Global
Eq Global
-> (Global -> Global -> Ordering)
-> (Global -> Global -> Bool)
-> (Global -> Global -> Bool)
-> (Global -> Global -> Bool)
-> (Global -> Global -> Bool)
-> (Global -> Global -> Global)
-> (Global -> Global -> Global)
-> Ord Global
Global -> Global -> Bool
Global -> Global -> Ordering
Global -> Global -> Global
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Global -> Global -> Global
$cmin :: Global -> Global -> Global
max :: Global -> Global -> Global
$cmax :: Global -> Global -> Global
>= :: Global -> Global -> Bool
$c>= :: Global -> Global -> Bool
> :: Global -> Global -> Bool
$c> :: Global -> Global -> Bool
<= :: Global -> Global -> Bool
$c<= :: Global -> Global -> Bool
< :: Global -> Global -> Bool
$c< :: Global -> Global -> Bool
compare :: Global -> Global -> Ordering
$ccompare :: Global -> Global -> Ordering
$cp1Ord :: Eq Global
Ord, Int -> Global -> String -> String
[Global] -> String -> String
Global -> String
(Int -> Global -> String -> String)
-> (Global -> String)
-> ([Global] -> String -> String)
-> Show Global
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Global] -> String -> String
$cshowList :: [Global] -> String -> String
show :: Global -> String
$cshow :: Global -> String
showsPrec :: Int -> Global -> String -> String
$cshowsPrec :: Int -> Global -> String -> String
Show, ReadPrec [Global]
ReadPrec Global
Int -> ReadS Global
ReadS [Global]
(Int -> ReadS Global)
-> ReadS [Global]
-> ReadPrec Global
-> ReadPrec [Global]
-> Read Global
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Global]
$creadListPrec :: ReadPrec [Global]
readPrec :: ReadPrec Global
$creadPrec :: ReadPrec Global
readList :: ReadS [Global]
$creadList :: ReadS [Global]
readsPrec :: Int -> ReadS Global
$creadsPrec :: Int -> ReadS Global
Read)

initialGlobal :: Global
initialGlobal :: Global
initialGlobal = Map VarName Value -> Global
Global Map VarName Value
forall k a. Map k a
M.empty

lookupGlobal :: MonadError Error m => VarName' -> Global -> m Value
lookupGlobal :: VarName' -> Global -> m Value
lookupGlobal VarName'
x Global
global =
  case VarName -> Map VarName Value -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x) (Global -> Map VarName Value
unGlobal Global
global) of
    Just Value
y -> Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
y
    Maybe Value
Nothing -> Maybe Loc -> String -> m Value
forall (m :: * -> *) a.
MonadError Error m =>
Maybe Loc -> String -> m a
throwSymbolErrorAt' (VarName' -> Maybe Loc
forall a. WithLoc' a -> Maybe Loc
loc' VarName'
x) (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"undefined variable: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ VarName -> String
unVarName (VarName' -> VarName
forall a. WithLoc' a -> a
value' VarName'
x)

runWithGlobal :: MonadError Error m => Global -> Expr' -> m Value
runWithGlobal :: Global -> Expr' -> m Value
runWithGlobal Global
global Expr'
e = do
  ReaderT Global m Value -> Global -> m Value
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT Local (ReaderT Global m) Value
-> Local -> ReaderT Global m Value
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Expr' -> StateT Local (ReaderT Global m) Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Expr' -> m Value
evalExpr Expr'
e) (Map VarName Value -> Local
Local Map VarName Value
forall k a. Map k a
M.empty)) Global
global

runWithGlobal' :: MonadError Error m => Global -> Value -> [Value] -> m Value
runWithGlobal' :: Global -> Value -> [Value] -> m Value
runWithGlobal' Global
global Value
solve [Value]
args = do
  ReaderT Global m Value -> Global -> m Value
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (StateT Local (ReaderT Global m) Value
-> Local -> ReaderT Global m Value
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (Value -> [Value] -> StateT Local (ReaderT Global m) Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> [Value] -> m Value
evalCall' Value
solve [Value]
args) (Map VarName Value -> Local
Local Map VarName Value
forall k a. Map k a
M.empty)) Global
global

-- | `makeGlobal` packs toplevel definitions into `Global`.
-- This assumes `doesntHaveLeakOfLoopCounters`.
makeGlobal :: MonadError Error m => Program -> m Global
makeGlobal :: Program -> m Global
makeGlobal Program
prog = do
  Program -> m ()
forall (m :: * -> *). MonadError Error m => Program -> m ()
ensureDoesntHaveLeakOfLoopCounters Program
prog
  StateT Global m () -> Global -> m Global
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT ((ToplevelStatement -> StateT Global m ())
-> Program -> StateT Global m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ToplevelStatement -> StateT Global m ()
forall (m :: * -> *).
(MonadState Global m, MonadError Error m) =>
ToplevelStatement -> m ()
execToplevelStatement Program
prog) Global
initialGlobal

run :: MonadError Error m => Program -> [Value] -> m Value
run :: Program -> [Value] -> m Value
run Program
prog [Value]
args = String -> m Value -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' String
"Jikka.RestrictedPython.Evaluate" (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
  Global
global <- Program -> m Global
forall (m :: * -> *). MonadError Error m => Program -> m Global
makeGlobal Program
prog
  Value
solve <- VarName' -> Global -> m Value
forall (m :: * -> *).
MonadError Error m =>
VarName' -> Global -> m Value
lookupGlobal (VarName -> VarName'
forall a. a -> WithLoc' a
withoutLoc (String -> VarName
VarName String
"solve")) Global
global
  Global -> Value -> [Value] -> m Value
forall (m :: * -> *).
MonadError Error m =>
Global -> Value -> [Value] -> m Value
runWithGlobal' Global
global Value
solve [Value]
args

evalBinOp :: MonadError Error m => Value -> Operator -> Value -> m Value
evalBinOp :: Value -> Operator -> Value -> m Value
evalBinOp Value
v1 Operator
op Value
v2 = String -> m Value -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' (String
"calculating " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Operator -> String
formatOperator Operator
op String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" operator") (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
  Integer
v1 <- Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value
v1
  Integer
v2 <- Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value
v2
  Integer
v <- case (Operator
op, Integer
v2) of
    (Operator
Add, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v2
    (Operator
Sub, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
v2
    (Operator
Mult, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
v2
    (Operator
MatMult, Integer
_) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"matmul operator ('@') is not supported"
    (Operator
Div, Integer
_) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"floatdiv operator ('/') is not supported"
    (Operator
FloorDiv, Integer
0) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero"
    (Operator
FloorDiv, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
v2
    (Operator
FloorMod, Integer
0) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero"
    (Operator
FloorMod, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
v2
    (Operator
CeilDiv, Integer
0) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero"
    (Operator
CeilDiv, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ (Integer
v1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
v2
    (Operator
CeilMod, Integer
0) -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero"
    (Operator
CeilMod, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ (Integer
v1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v2 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
v2
    (Operator
Pow, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
v2
    (Operator
BitLShift, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftL Integer
v1 (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
v2)
    (Operator
BitRShift, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Int -> Integer
forall a. Bits a => a -> Int -> a
shiftR Integer
v1 (Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
v2)
    (Operator
BitOr, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.|. Integer
v2
    (Operator
BitXor, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
`xor` Integer
v2
    (Operator
BitAnd, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
v1 Integer -> Integer -> Integer
forall a. Bits a => a -> a -> a
.&. Integer
v2
    (Operator
Max, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
v1 Integer
v2
    (Operator
Min, Integer
_) -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min Integer
v1 Integer
v2
  Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return (Value -> m Value) -> Value -> m Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
IntVal Integer
v

evalBuiltin :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Builtin -> [Value] -> m Value
evalBuiltin :: Builtin -> [Value] -> m Value
evalBuiltin Builtin
b [Value]
args = String -> m Value -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' (String
"calling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Builtin -> String
formatBuiltin Builtin
b) (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
  let go1' :: (Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go1' Value -> f a
t1 a -> b
ret a -> f a
f = case [Value]
args of
        [Value
v1] -> a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a
f (a -> f a) -> f a -> f a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> f a
t1 Value
v1)
        [Value]
_ -> String -> f b
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> f b) -> String -> f b
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 ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
args)
  let go1 :: (Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> f a
t1 a -> b
ret a -> a
f = (Value -> f a) -> (a -> b) -> (a -> f a) -> f b
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go1' Value -> f a
t1 a -> b
ret (a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> f a) -> (a -> a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
  let go2' :: (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> f a
t1 Value -> f a
t2 a -> b
ret a -> a -> f a
f = case [Value]
args of
        [Value
v1, Value
v2] -> a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a) -> f a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (a -> a -> f a
f (a -> a -> f a) -> f a -> f (a -> f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> f a
t1 Value
v1 f (a -> f a) -> f a -> f (f a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> f a
t2 Value
v2)
        [Value]
_ -> String -> f b
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> f b) -> String -> f b
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 ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
args)
  let go2 :: (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go2 Value -> f a
t1 Value -> f a
t2 a -> b
ret a -> a -> a
f = (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> f a
t1 Value -> f a
t2 a -> b
ret ((a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> f a) -> (a -> a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> a) -> a -> f a) -> (a -> a -> a) -> a -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
f)
  let go3 :: (Value -> f a)
-> (Value -> f a)
-> (Value -> f a)
-> (a -> b)
-> (a -> a -> a -> a)
-> f b
go3 Value -> f a
t1 Value -> f a
t2 Value -> f a
t3 a -> b
ret a -> a -> a -> a
f = case [Value]
args of
        [Value
v1, Value
v2, Value
v3] -> a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> a -> a -> a
f (a -> a -> a -> a) -> f a -> f (a -> a -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> f a
t1 Value
v1 f (a -> a -> a) -> f a -> f (a -> a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> f a
t2 Value
v2 f (a -> a) -> f a -> f a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> f a
t3 Value
v3)
        [Value]
_ -> String -> f b
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> f b) -> String -> f b
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 ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
args)
  let goN' :: (Value -> f b) -> (a -> b) -> ([b] -> f a) -> f b
goN' Value -> f b
t a -> b
ret [b] -> f a
f = a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([b] -> f a
f ([b] -> f a) -> f [b] -> f a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Value -> f b) -> [Value] -> f [b]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> f b
t [Value]
args)
  let goN :: (Value -> f b) -> (a -> b) -> ([b] -> a) -> f b
goN Value -> f b
t a -> b
ret [b] -> a
f = (Value -> f b) -> (a -> b) -> ([b] -> f a) -> f b
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> f a) -> f b
goN' Value -> f b
t a -> b
ret (a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> f a) -> ([b] -> a) -> [b] -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [b] -> a
f)
  let zipN :: [[a]] -> [[a]] -> [[a]]
zipN [[a]]
acc [] = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
acc
      zipN [[a]]
acc [[a]]
xss | ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[a]]
xss = [[a]] -> [[a]]
forall a. [a] -> [a]
reverse [[a]]
acc
      zipN [[a]]
acc [[a]]
xss = [[a]] -> [[a]] -> [[a]]
zipN (([a] -> a) -> [[a]] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> a
forall a. [a] -> a
head [[a]]
xss [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
acc) (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
tail [[a]]
xss)
  case Builtin
b of
    Builtin
BuiltinAbs -> (Value -> m Integer)
-> (Integer -> Value) -> (Integer -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal Integer -> Integer
forall a. Num a => a -> a
abs
    Builtin
BuiltinPow -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go2 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
(^)
    Builtin
BuiltinModPow -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> Integer -> Integer)
-> m Value
forall (f :: * -> *) a a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a)
-> (Value -> f a)
-> (a -> b)
-> (a -> a -> a -> a)
-> f b
go3 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> Integer -> Integer) -> m Value)
-> (Integer -> Integer -> Integer -> Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
x Integer
k Integer
m -> (Integer
x Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
k) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
m
    Builtin
BuiltinAll -> (Value -> m (Vector Bool))
-> (Bool -> Value) -> (Vector Bool -> Bool) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Bool)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Bool)
toBoolList Bool -> Value
BoolVal Vector Bool -> Bool
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum
    Builtin
BuiltinAny -> (Value -> m (Vector Bool))
-> (Bool -> Value) -> (Vector Bool -> Bool) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Bool)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Bool)
toBoolList Bool -> Value
BoolVal Vector Bool -> Bool
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum
    Builtin
BuiltinDivMod -> (Value -> m Integer)
-> (Value -> m Integer)
-> ([Value] -> Value)
-> (Integer -> Integer -> m [Value])
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt [Value] -> Value
TupleVal ((Integer -> Integer -> m [Value]) -> m Value)
-> (Integer -> Integer -> m [Value]) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b -> case Integer
b of
      Integer
0 -> String -> m [Value]
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero"
      Integer
_ -> [Value] -> m [Value]
forall (m :: * -> *) a. Monad m => a -> m a
return [Integer -> Value
IntVal (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
b), Integer -> Value
IntVal (Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
b)]
    BuiltinSorted Type
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Vector Value -> Vector Value)
-> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value)
-> (Vector Value -> [Value]) -> Vector Value -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Value -> Ordering) -> [Value] -> [Value]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy Value -> Value -> Ordering
compareValues' ([Value] -> [Value])
-> (Vector Value -> [Value]) -> Vector Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList)
    BuiltinEnumerate Type
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Vector Value -> Vector Value)
-> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value)
-> (Vector Value -> [Value]) -> Vector Value -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Value -> Value) -> [Integer] -> [Value] -> [Value]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Integer
i Value
x -> [Value] -> Value
TupleVal [Integer -> Value
IntVal Integer
i, Value
x]) [Integer
0 ..] ([Value] -> [Value])
-> (Vector Value -> [Value]) -> Vector Value -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList)
    BuiltinBool Type
_ -> (Value -> m Value)
-> (Bool -> Value) -> (Value -> m Bool) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go1' Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool -> Value
BoolVal ((Value -> m Bool) -> m Value) -> (Value -> m Bool) -> m Value
forall a b. (a -> b) -> a -> b
$ \case
      IntVal Integer
n -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0
      BoolVal Bool
p -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
p
      ListVal Vector Value
xs -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not (Vector Value -> Bool
forall a. Vector a -> Bool
V.null Vector Value
xs)
      TupleVal [Value]
xs -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Bool
not ([Value] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Value]
xs)
      Value
_ -> String -> m Bool
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
    BuiltinInt Type
_ -> (Value -> m Value)
-> (Integer -> Value) -> (Value -> m Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go1' Value -> m Value
forall (m :: * -> *) a. Monad m => a -> m a
return Integer -> Value
IntVal ((Value -> m Integer) -> m Value)
-> (Value -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \case
      IntVal Integer
n -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return Integer
n
      BoolVal Bool
p -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ if Bool
p then Integer
1 else Integer
0
      Value
_ -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
    BuiltinTuple [Type]
_ -> (Value -> m Value)
-> ([Value] -> Value) -> ([Value] -> [Value]) -> m Value
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> a) -> f b
goN Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure [Value] -> Value
TupleVal [Value] -> [Value]
forall a. a -> a
id
    Builtin
BuiltinSum -> (Value -> m (Vector Integer))
-> (Integer -> Value) -> (Vector Integer -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Integer)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Integer)
toIntList Integer -> Value
IntVal Vector Integer -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
    BuiltinZip [Type]
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> ([Vector Value] -> Vector Value)
-> m Value
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> a) -> f b
goN Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal ([Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value)
-> ([Vector Value] -> [Value]) -> [Vector Value] -> Vector Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Value] -> Value) -> [[Value]] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map [Value] -> Value
TupleVal ([[Value]] -> [Value])
-> ([Vector Value] -> [[Value]]) -> [Vector Value] -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Value]] -> [[Value]] -> [[Value]]
forall a. [[a]] -> [[a]] -> [[a]]
zipN [] ([[Value]] -> [[Value]])
-> ([Vector Value] -> [[Value]]) -> [Vector Value] -> [[Value]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Vector Value -> [Value]) -> [Vector Value] -> [[Value]]
forall a b. (a -> b) -> [a] -> [b]
map Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList)
    BuiltinFilter Type
_ -> (Value -> m Value)
-> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Value -> Vector Value -> m (Vector Value))
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal ((Value -> Vector Value -> m (Vector Value)) -> m Value)
-> (Value -> Vector Value -> m (Vector Value)) -> m Value
forall a b. (a -> b) -> a -> b
$ \Value
f Vector Value
xs -> do
      let go :: Value -> m (Maybe Value)
go Value
x = do
            Value
pred <- Value -> [Value] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> [Value] -> m Value
evalCall' Value
f [Value
x]
            case Value
pred of
              BoolVal Bool
True -> Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Value -> m (Maybe Value)) -> Maybe Value -> m (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Value -> Maybe Value
forall a. a -> Maybe a
Just Value
x
              BoolVal Bool
False -> Maybe Value -> m (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
              Value
_ -> String -> m (Maybe Value)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
      (Value -> m (Maybe Value)) -> Vector Value -> m (Vector Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> Vector a -> m (Vector b)
V.mapMaybeM Value -> m (Maybe Value)
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> m (Maybe Value)
go Vector Value
xs
    BuiltinLen Type
_ -> (Value -> m (Vector Value))
-> (Integer -> Value) -> (Vector Value -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Integer -> Value
IntVal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer)
-> (Vector Value -> Int) -> Vector Value -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Int
forall a. Vector a -> Int
V.length)
    BuiltinList Type
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Vector Value -> Vector Value)
-> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal Vector Value -> Vector Value
forall a. a -> a
id
    Builtin
BuiltinRange1 -> (Value -> m Integer)
-> (Vector Value -> Value) -> (Integer -> Vector Value) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Vector Value -> Value
ListVal ((Integer -> Vector Value) -> m Value)
-> (Integer -> Vector Value) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
to -> [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ((Integer -> Value) -> [Integer] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Value
IntVal [Integer
0 .. Integer
to Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1])
    Builtin
BuiltinRange2 -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Vector Value -> Value)
-> (Integer -> Integer -> Vector Value)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go2 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Vector Value -> Value
ListVal ((Integer -> Integer -> Vector Value) -> m Value)
-> (Integer -> Integer -> Vector Value) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
from Integer
to -> [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ((Integer -> Value) -> [Integer] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Value
IntVal [Integer
from .. Integer
to Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1])
    Builtin
BuiltinRange3 -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Value -> m Integer)
-> (Vector Value -> Value)
-> (Integer -> Integer -> Integer -> Vector Value)
-> m Value
forall (f :: * -> *) a a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a)
-> (Value -> f a)
-> (a -> b)
-> (a -> a -> a -> a)
-> f b
go3 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Vector Value -> Value
ListVal ((Integer -> Integer -> Integer -> Vector Value) -> m Value)
-> (Integer -> Integer -> Integer -> Vector Value) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
from Integer
to Integer
step -> [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ((Integer -> Value) -> [Integer] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> Value
IntVal [Integer
from, Integer
from Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
step .. Integer
to Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1])
    BuiltinMap [Type]
_ Type
_ -> (Value -> m Value)
-> (Vector Value -> Value)
-> ([Value] -> m (Vector Value))
-> m Value
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> f a) -> f b
goN' Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Vector Value -> Value
ListVal (([Value] -> m (Vector Value)) -> m Value)
-> ([Value] -> m (Vector Value)) -> m Value
forall a b. (a -> b) -> a -> b
$ \case
      [] -> String -> m (Vector Value)
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"type error"
      Value
f : [Value]
args -> do
        [Vector Value]
args <- (Value -> m (Vector Value)) -> [Value] -> m [Vector Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList [Value]
args
        [Value] -> Vector Value
forall a. [a] -> Vector a
V.fromList ([Value] -> Vector Value) -> m [Value] -> m (Vector Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Value] -> m Value) -> [[Value]] -> m [Value]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Value -> [Value] -> m Value
forall (m :: * -> *).
(MonadReader Global m, MonadState Local m, MonadError Error m) =>
Value -> [Value] -> m Value
evalCall' Value
f) ([[Value]] -> [[Value]] -> [[Value]]
forall a. [[a]] -> [[a]] -> [[a]]
zipN [] ((Vector Value -> [Value]) -> [Vector Value] -> [[Value]]
forall a b. (a -> b) -> [a] -> [b]
map Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList [Vector Value]
args))
    BuiltinReversed Type
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Vector Value -> Vector Value)
-> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal Vector Value -> Vector Value
forall a. Vector a -> Vector a
V.reverse
    BuiltinMin1 Type
_ -> (Value -> m (Vector Value))
-> (Value -> Value) -> (Vector Value -> Value) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value -> Value
forall a. a -> a
id ((Value -> Value -> Ordering) -> Vector Value -> Value
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Value -> Value -> Ordering
compareValues')
    BuiltinMin Type
_ Int
_ -> (Value -> m Value)
-> (Value -> Value) -> ([Value] -> Value) -> m Value
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> a) -> f b
goN Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value -> Value
forall a. a -> a
id ((Value -> Value -> Ordering) -> [Value] -> Value
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy Value -> Value -> Ordering
compareValues')
    BuiltinMax1 Type
_ -> (Value -> m (Vector Value))
-> (Value -> Value) -> (Vector Value -> Value) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value -> Value
forall a. a -> a
id ((Value -> Value -> Ordering) -> Vector Value -> Value
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Value -> Value -> Ordering
compareValues')
    BuiltinMax Type
_ Int
_ -> (Value -> m Value)
-> (Value -> Value) -> ([Value] -> Value) -> m Value
forall (f :: * -> *) b a b.
Monad f =>
(Value -> f b) -> (a -> b) -> ([b] -> a) -> f b
goN Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value -> Value
forall a. a -> a
id ((Value -> Value -> Ordering) -> [Value] -> Value
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy Value -> Value -> Ordering
compareValues')
    BuiltinArgMax Type
_ -> (Value -> m (Vector Value))
-> (Integer -> Value) -> (Vector Value -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Integer -> Value
IntVal ((Vector Value -> Integer) -> m Value)
-> (Vector Value -> Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Vector Value
xs -> (Value, Integer) -> Integer
forall a b. (a, b) -> b
snd (((Value, Integer) -> (Value, Integer) -> Ordering)
-> [(Value, Integer)] -> (Value, Integer)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
maximumBy (\(Value
x, Integer
i) (Value
y, Integer
j) -> Value -> Value -> Ordering
compareValues' Value
x Value
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i Integer
j) ([Value] -> [Integer] -> [(Value, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
xs) [Integer
0 ..]))
    BuiltinArgMin Type
_ -> (Value -> m (Vector Value))
-> (Integer -> Value) -> (Vector Value -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Integer -> Value
IntVal ((Vector Value -> Integer) -> m Value)
-> (Vector Value -> Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Vector Value
xs -> (Value, Integer) -> Integer
forall a b. (a, b) -> b
snd (((Value, Integer) -> (Value, Integer) -> Ordering)
-> [(Value, Integer)] -> (Value, Integer)
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (\(Value
x, Integer
i) (Value
y, Integer
j) -> Value -> Value -> Ordering
compareValues' Value
x Value
y Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Integer -> Integer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Integer
i Integer
j) ([Value] -> [Integer] -> [(Value, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Vector Value -> [Value]
forall a. Vector a -> [a]
V.toList Vector Value
xs) [Integer
0 ..]))
    Builtin
BuiltinCeilDiv -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b -> if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero" else Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
b
    Builtin
BuiltinCeilMod -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b -> if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero" else Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ (Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
b Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
b
    Builtin
BuiltinFloorDiv -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b -> if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero" else Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
b
    Builtin
BuiltinFloorMod -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
a Integer
b -> if Integer
b Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 then String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"division by zero" else Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer
a Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
b
    Builtin
BuiltinGcd -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go2 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
gcd
    Builtin
BuiltinLcm -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go2 Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
lcm
    Builtin
BuiltinModInv -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
_ Integer
_ -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError String
"Jikka.RestrictedPython.Evaluate.evalBuiltin: TODO"
    Builtin
BuiltinProduct -> (Value -> m (Vector Integer))
-> (Integer -> Value) -> (Vector Integer -> Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go1 Value -> m (Vector Integer)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Integer)
toIntList Integer -> Value
IntVal Vector Integer -> Integer
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product
    Builtin
BuiltinFact -> (Value -> m Integer)
-> (Integer -> Value) -> (Integer -> m Integer) -> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go1' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> m Integer) -> m Value)
-> (Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
n -> if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer
forall a. Integral a => a -> a
fact Integer
n else String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"invalid argument"
    Builtin
BuiltinChoose -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
n Integer
r -> if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
r Bool -> Bool -> Bool
&& Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
choose Integer
n Integer
r else String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"invalid argument"
    Builtin
BuiltinPermute -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
n Integer
r -> if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
r Bool -> Bool -> Bool
&& Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
permute Integer
n Integer
r else String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"invalid argument"
    Builtin
BuiltinMultiChoose -> (Value -> m Integer)
-> (Value -> m Integer)
-> (Integer -> Value)
-> (Integer -> Integer -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go2' Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Value -> m Integer
forall (m :: * -> *). MonadError Error m => Value -> m Integer
toInt Integer -> Value
IntVal ((Integer -> Integer -> m Integer) -> m Value)
-> (Integer -> Integer -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Integer
n Integer
r -> if Integer
0 Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
r Bool -> Bool -> Bool
&& Integer
r Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
n then Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> m Integer) -> Integer -> m Integer
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
multichoose Integer
n Integer
r else String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError String
"invalid argument"
    Builtin
BuiltinInput -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `input' out of main function"
    BuiltinPrint [Type]
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `print' out of main function"

evalAttribute :: (MonadReader Global m, MonadState Local m, MonadError Error m) => Value -> Attribute -> [Value] -> m Value
evalAttribute :: Value -> Attribute -> [Value] -> m Value
evalAttribute Value
v0 Attribute
a [Value]
args = String -> m Value -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a -> m a
wrapError' (String
"calling " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Attribute -> String
formatAttribute Attribute
a) (m Value -> m Value) -> m Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
  let go0' :: (Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go0' Value -> f a
t0 a -> b
ret a -> f a
f = case [Value]
args of
        [] -> a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f a
f (a -> f a) -> f a -> f a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Value -> f a
t0 Value
v0)
        [Value]
_ -> String -> f b
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> f b) -> String -> f 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 ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
args)
  let go0 :: (Value -> f a) -> (a -> b) -> (a -> a) -> f b
go0 Value -> f a
t0 a -> b
ret a -> a
f = (Value -> f a) -> (a -> b) -> (a -> f a) -> f b
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> f a) -> f b
go0' Value -> f a
t0 a -> b
ret (a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> f a) -> (a -> a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a
f)
  let go1' :: (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go1' Value -> f a
t0 Value -> f a
t1 a -> b
ret a -> a -> f a
f = case [Value]
args of
        [Value
v1] -> a -> b
ret (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (f a) -> f a
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (a -> a -> f a
f (a -> a -> f a) -> f a -> f (a -> f a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> f a
t0 Value
v0 f (a -> f a) -> f a -> f (f a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> f a
t1 Value
v1)
        [Value]
_ -> String -> f b
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> f b) -> String -> f b
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 ([Value] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Value]
args)
  let go1 :: (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go1 Value -> f a
t0 Value -> f a
t1 a -> b
ret a -> a -> a
f = (Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go1' Value -> f a
t0 Value -> f a
t1 a -> b
ret ((a -> f a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> f a) -> (a -> a) -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((a -> a) -> a -> f a) -> (a -> a -> a) -> a -> a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> a -> a
f)
  case Attribute
a of
    UnresolvedAttribute AttributeName
a -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwInternalError (String -> m Value) -> String -> m Value
forall a b. (a -> b) -> a -> b
$ String
"Jikka.RestrictedPython.Evaluate.evalAttribute: unresolved attribute: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ AttributeName -> String
unAttributeName AttributeName
a
    BuiltinCount Type
_ -> (Value -> m (Vector Value))
-> (Value -> m Value)
-> (Integer -> Value)
-> (Vector Value -> Value -> Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> a) -> f b
go1 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Value
IntVal ((Vector Value -> Value -> Integer) -> m Value)
-> (Vector Value -> Value -> Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Vector Value
xs Value
x -> Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Vector Value -> Int
forall a. Vector a -> Int
V.length ((Value -> Bool) -> Vector Value -> Vector Value
forall a. (a -> Bool) -> Vector a -> Vector a
V.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
== Value
x) Vector Value
xs))
    BuiltinIndex Type
_ -> (Value -> m (Vector Value))
-> (Value -> m Value)
-> (Integer -> Value)
-> (Vector Value -> Value -> m Integer)
-> m Value
forall (f :: * -> *) a a a b.
MonadError Error f =>
(Value -> f a)
-> (Value -> f a) -> (a -> b) -> (a -> a -> f a) -> f b
go1' Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Value -> m Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer -> Value
IntVal ((Vector Value -> Value -> m Integer) -> m Value)
-> (Vector Value -> Value -> m Integer) -> m Value
forall a b. (a -> b) -> a -> b
$ \Vector Value
xs Value
x -> case Value -> Vector Value -> Maybe Int
forall a. Eq a => a -> Vector a -> Maybe Int
V.elemIndex Value
x Vector Value
xs of
      Maybe Int
Nothing -> String -> m Integer
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwRuntimeError (String -> m Integer) -> String -> m Integer
forall a b. (a -> b) -> a -> b
$ String
"not in list: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
formatValue Value
x
      Just Int
i -> Integer -> m Integer
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
i)
    BuiltinCopy Type
_ -> (Value -> m (Vector Value))
-> (Vector Value -> Value)
-> (Vector Value -> Vector Value)
-> m Value
forall (f :: * -> *) a a b.
MonadError Error f =>
(Value -> f a) -> (a -> b) -> (a -> a) -> f b
go0 Value -> m (Vector Value)
forall (m :: * -> *).
MonadError Error m =>
Value -> m (Vector Value)
toList Vector Value -> Value
ListVal Vector Value -> Vector Value
forall a. a -> a
id
    BuiltinAppend Type
_ -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `append' out of expr-statements"
    Attribute
BuiltinSplit -> String -> m Value
forall (m :: * -> *) a. MonadError Error m => String -> m a
throwSemanticError String
"cannot use `split' out of main function"