💀 renamed A1 pdf and messed around with state

This commit is contained in:
2024-09-19 11:52:54 +02:00
parent b061522fd1
commit fed7756474
4 changed files with 25 additions and 16 deletions

View File

@ -21,4 +21,5 @@ data Exp
| Lambda VName Exp | Lambda VName Exp
| Apply Exp Exp | Apply Exp Exp
| TryCatch Exp Exp | TryCatch Exp Exp
-- | Print String Exp
deriving (Eq, Show) deriving (Eq, Show)

View File

@ -17,9 +17,14 @@ data Val
type Env = [(VName, Val)] type Env = [(VName, Val)]
type State = [String]
envEmpty :: Env envEmpty :: Env
envEmpty = [] envEmpty = []
stateEmpty :: State
stateEmpty = []
envExtend :: VName -> Val -> Env -> Env envExtend :: VName -> Val -> Env -> Env
envExtend v val env = (v, val) : env envExtend v val env = (v, val) : env
@ -28,40 +33,43 @@ envLookup v env = lookup v env
type Error = String type Error = String
newtype EvalM a = EvalM (Env -> Either Error a) newtype EvalM a = EvalM (Env -> State -> (State, Either Error a))
instance Functor EvalM where instance Functor EvalM where
fmap = liftM fmap = liftM
instance Applicative EvalM where instance Applicative EvalM where
pure x = EvalM $ \_env -> Right x pure x = EvalM $ \_env state -> (state, Right x)
(<*>) = ap (<*>) = ap
instance Monad EvalM where instance Monad EvalM where
EvalM x >>= f = EvalM $ \env -> EvalM x >>= f = EvalM $ \env state ->
case x env of case x env state of
Left err -> Left err (state', Left err) -> (state', Left err)
Right x' -> (state', Right x') ->
let EvalM y = f x' let EvalM y = f x'
in y env in y env state'
askEnv :: EvalM Env askEnv :: EvalM Env
askEnv = EvalM $ \env -> Right env askEnv = EvalM $ \env state -> (state, Right env)
localEnv :: (Env -> Env) -> EvalM a -> EvalM a localEnv :: (Env -> Env) -> EvalM a -> EvalM a
localEnv f (EvalM m) = EvalM $ \env -> m (f env) localEnv f (EvalM m) = EvalM $ \env -> m (f env)
failure :: String -> EvalM a failure :: String -> EvalM a
failure s = EvalM $ \_env -> Left s failure s = EvalM $ \_env state -> (state, Left s)
catch :: EvalM a -> EvalM a -> EvalM a catch :: EvalM a -> EvalM a -> EvalM a
catch (EvalM m1) (EvalM m2) = EvalM $ \env -> catch (EvalM m1) (EvalM m2) = EvalM $ \env state ->
case m1 env of case m1 env state of
Left _ -> m2 env (state', Left _) -> m2 env state'
Right x -> Right x (state', Right x) -> (state', Right x)
runEval :: EvalM a -> Either Error a evalPrint :: String -> EvalM ()
runEval (EvalM m) = m envEmpty evalPrint a = undefined
runEval :: EvalM a -> (State, Either Error a)
runEval (EvalM m) = m envEmpty stateEmpty
evalIntBinOp :: (Integer -> Integer -> EvalM Integer) -> Exp -> Exp -> EvalM Val evalIntBinOp :: (Integer -> Integer -> EvalM Integer) -> Exp -> Exp -> EvalM Val
evalIntBinOp f e1 e2 = do evalIntBinOp f e1 e2 = do

View File

@ -5,7 +5,7 @@ import APL.Eval (Error, Val (..), eval, runEval)
import Test.Tasty (TestTree, testGroup) import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (testCase, (@?=)) import Test.Tasty.HUnit (testCase, (@?=))
eval' :: Exp -> Either Error Val eval' :: Exp -> ([String], Either Error Val)
eval' = runEval . eval eval' = runEval . eval
evalTests :: TestTree evalTests :: TestTree