module Backend.Eval (eval) where

import Data.Map as Map
import Parser
  ( SExpr (..),
  )

data Value
  = Int Integer
  | Str String
  | Boolean Bool
  | Var String
  | Func Context String SExpr
  | FuncGen Value
  deriving (Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

type Context = Map String Value

eval :: SExpr -> IO (Either String Value)
eval :: SExpr -> IO (Either String Value)
eval = Context -> SExpr -> IO (Either String Value)
evaluate Context
forall k a. Map k a
Map.empty

evaluate :: Context -> SExpr -> IO (Either String Value)
evaluate :: Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx (SLetInfer String
name SExpr
value SExpr
next) = do
  Either String Value
value' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
value
  case Either String Value
value' of
    Right Value
value'' -> do
      let ctx' :: Context
ctx' = String -> Value -> Context -> Context
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Value
value'' Context
ctx
      Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx' SExpr
next
    Left String
err -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
evaluate Context
ctx (SLet String
name SExpr
_ SExpr
value SExpr
next) = do
  Either String Value
value' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
value
  case Either String Value
value' of
    Right Value
value'' -> do
      let ctx' :: Context
ctx' = String -> Value -> Context -> Context
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
name Value
value'' Context
ctx
      Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx' SExpr
next
    Left String
err -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
evaluate Context
ctx (STypeAlias String
_ SExpr
_ SExpr
next) = Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
next
evaluate Context
ctx (SDefInfer String
_ (SType String
"Type") SExpr
body) = do
  Either String Value
body' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
body
  case Either String Value
body' of
    Right Value
body'' -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Value -> Value
FuncGen Value
body''
    Left String
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
body'
evaluate Context
ctx (SDefInfer String
param SExpr
_ SExpr
body) = Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Context -> String -> SExpr -> Value
Func Context
ctx String
param SExpr
body
evaluate Context
ctx (SDef String
param SExpr
_ SExpr
_ SExpr
body) = Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Context -> String -> SExpr -> Value
Func Context
ctx String
param SExpr
body
evaluate Context
ctx (SConditional SExpr
condition SExpr
cthen SExpr
celse) = do
  Either String Value
conditional <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
condition
  case Either String Value
conditional of
    Right (Int Integer
0) -> Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
celse
    Right (Str String
"") -> Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
celse
    Right (Boolean Bool
False) -> Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
celse
    Right Value
_ -> Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
cthen
    Left String
err -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
evaluate Context
ctx (SApp SExpr
func SExpr
arg) = do
  Either String Value
func' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
func
  case Either String Value
func' of
    Right (FuncGen Value
body) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right Value
body
    Right (Func Context
ctx' String
param SExpr
body) -> do
      Either String Value
arg' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
arg
      case Either String Value
arg' of
        Right Value
arg'' -> Context -> SExpr -> IO (Either String Value)
evaluate (String -> Value -> Context -> Context
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert String
param Value
arg'' Context
ctx') SExpr
body
        Left String
err -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
    Left String
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
func'
    Either String Value
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Trying to call a non-callable value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SExpr -> String
forall a. Show a => a -> String
show SExpr
func
evaluate Context
ctx (SPlus SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
v), Right (Int Integer
v')) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Int (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
v'
    (Either String Value, Either String Value)
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Calling sum with invalid params: [ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SExpr -> String
forall a. Show a => a -> String
show SExpr
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
evaluate Context
ctx (SMinus SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
v), Right (Int Integer
v')) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Int (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
v'
    (Either String Value, Either String Value)
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Calling subtraction with invalid params: [ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
y' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
evaluate Context
ctx (SDiv SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
v), Right (Int Integer
v')) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Int (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
v'
    (Either String Value, Either String Value)
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Calling division with invalid params: [ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SExpr -> String
forall a. Show a => a -> String
show SExpr
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
evaluate Context
ctx (STimes SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
v), Right (Int Integer
v')) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Int (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer
v Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
v'
    (Either String Value, Either String Value)
_ -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Calling multiplication with invalid params: [ " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
x' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" - " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Either String Value -> String
forall a. Show a => a -> String
show Either String Value
y' String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" ]"
evaluate Context
ctx (SAnd SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
0), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
x'
    (Right (Str String
""), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
x'
    (Right (Boolean Bool
False), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
x'
    (Right Value
_, Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
y'
    (Left String
err, Either String Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
    (Either String Value
_, Left String
err) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
evaluate Context
ctx (SOr SExpr
x SExpr
y) = do
  Either String Value
x' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
x
  Either String Value
y' <- Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
y
  case (Either String Value
x', Either String Value
y') of
    (Right (Int Integer
0), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
y'
    (Right (Str String
""), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
y'
    (Right (Boolean Bool
False), Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
y'
    (Right Value
_, Right Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either String Value
x'
    (Left String
err, Either String Value
_) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
    (Either String Value
_, Left String
err) -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left String
err
evaluate Context
ctx (SBrack SExpr
expr) = Context -> SExpr -> IO (Either String Value)
evaluate Context
ctx SExpr
expr
evaluate Context
ctx (SName String
name) = case String -> Context -> Maybe Value
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
name Context
ctx of
  Just Value
expr -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right Value
expr
  Maybe Value
Nothing -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Variable not initialized: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
name
evaluate Context
_ (SInt Integer
v) = Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Int Integer
v
evaluate Context
_ (SBool Bool
v) = Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ Bool -> Value
Boolean Bool
v
evaluate Context
_ (SString String
v) = Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ Value -> Either String Value
forall a b. b -> Either a b
Right (Value -> Either String Value) -> Value -> Either String Value
forall a b. (a -> b) -> a -> b
$ String -> Value
Str String
v
evaluate Context
_ SExpr
s = do
  Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String Value -> IO (Either String Value))
-> Either String Value -> IO (Either String Value)
forall a b. (a -> b) -> a -> b
$ String -> Either String Value
forall a b. a -> Either a b
Left (String -> Either String Value) -> String -> Either String Value
forall a b. (a -> b) -> a -> b
$ String
"Evaluating invalid node: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ SExpr -> String
forall a. Show a => a -> String
show SExpr
s