💀 renamed A1 pdf and messed around with state
This commit is contained in:
@ -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)
|
||||||
|
@ -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
|
||||||
|
@ -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
|
||||||
|
Reference in New Issue
Block a user