Eval.hs

{-# Language ImportQualifiedPost #-}

module Eval where

import Data.Map.Strict qualified as Map
import Data.Map.Strict (Map)
import Control.Monad.Reader

import Expression

data Result = RString String
            | RNumber Integer
            | RBoolean Bool
            | RLambda Integer Expression (Map Integer Result)
            deriving (Show)

eval :: Expression -> Reader (Map Integer Result) Result
eval (Negate e) = (\(RNumber e') -> RNumber $ negate e') <$> eval e
eval (Not e) = (\(RBoolean e') -> RBoolean $ not e') <$> eval e
-- -- eval (StringToInt
-- -- eval IntToString
eval (Add a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RNumber $ a'' + b''
eval (Sub a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RNumber $ a'' - b''
eval (Mul a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RNumber $ a'' * b''
eval (Div a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RNumber $ a'' `div` b''
eval (Mod a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RNumber $ a'' `mod` b''
eval (Gt a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RBoolean $ a'' > b''
eval (Lt a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RBoolean $ a'' < b''
eval (Eq a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RNumber b'') -> return . RBoolean $ a'' == b''
        (RString a'', RString b'') -> return . RBoolean $ a'' == b''
        (RBoolean a'', RBoolean b'') -> return . RBoolean $ a'' == b''
        (_, _) -> return . RBoolean $ False
eval (Or a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RBoolean a'', RBoolean b'') -> return . RBoolean $ a'' || b''
eval (And a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RBoolean a'', RBoolean b'') -> return . RBoolean $ a'' && b''
eval (Concat a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RString a'', RString b'') -> return . RString $ a'' ++ b''
eval (Take a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RString b'')
            -> return . RString $ take (fromInteger a'') b''
eval (Drop a b) = do
    a' <- eval a
    b' <- eval b
    case (a', b') of
        (RNumber a'', RString b'')
            -> return . RString $ drop (fromInteger a'') b''

eval (Apply proc arg) = do
    proc' <- eval proc
    arg' <- eval arg

    case proc' of
        RLambda arg_no body env -> do
            local (Map.insert arg_no arg' . Map.union env) $
                eval body

eval (Lambda arg body) = RLambda arg body <$> ask

eval (If a b c) = do
    a' <- eval a
    b' <- eval b
    c' <- eval c
    case a' of
        RBoolean True  -> return b'
        RBoolean False -> return c'

eval (Variable x) = (Map.! x) <$> ask

eval (Boolean b) = return $ RBoolean b
eval (Number x)  = return $ RNumber x
eval (Str s)     = return $ RString s