diff --git a/a2/a2-handout/src/APL/AST.hs b/a2/a2-handout/src/APL/AST.hs index 1e8eff3..8ceb5b0 100644 --- a/a2/a2-handout/src/APL/AST.hs +++ b/a2/a2-handout/src/APL/AST.hs @@ -22,4 +22,6 @@ data Exp | Apply Exp Exp | TryCatch Exp Exp | Print String Exp + | KvPut Exp Exp + | KvGet Exp deriving (Eq, Show) diff --git a/a2/a2-handout/src/APL/Eval.hs b/a2/a2-handout/src/APL/Eval.hs index ab72bd8..e110ed8 100644 --- a/a2/a2-handout/src/APL/Eval.hs +++ b/a2/a2-handout/src/APL/Eval.hs @@ -17,13 +17,13 @@ data Val type Env = [(VName, Val)] -type State = [String] +type State = ([(Val,Val)],[String]) envEmpty :: Env envEmpty = [] stateEmpty :: State -stateEmpty = [] +stateEmpty = ([],[]) envExtend :: VName -> Val -> Env -> Env envExtend v val env = (v, val) : env @@ -65,11 +65,13 @@ catch (EvalM m1) (EvalM m2) = EvalM $ \env state -> (state', Left _) -> m2 env state' (state', Right x) -> (state', Right x) -runEval :: EvalM a -> (State, Either Error a) -runEval (EvalM m) = m envEmpty stateEmpty +runEval :: EvalM a -> ([String], Either Error a) +runEval (EvalM m) = do + case m envEmpty stateEmpty of + ((_,s),v) -> (s,v) evalPrint :: String -> EvalM () -evalPrint a = EvalM $ \_env state -> (state ++ [a], Right ()) +evalPrint a = EvalM $ \_env (k,s) -> ((k,s++[a]), Right ()) evalIntBinOp :: (Integer -> Integer -> EvalM Integer) -> Exp -> Exp -> EvalM Val evalIntBinOp f e1 e2 = do @@ -85,6 +87,15 @@ evalIntBinOp' f e1 e2 = where f' x y = pure $ f x y +evalKvGet :: Val -> EvalM Val +evalKvGet a = EvalM $ \_env (k,s) -> do + case lookup a k of + (Just v) -> ((k,s), Right v) + (Nothing) -> ((k,s), Left ("Invalid key: "++(show a))) + +evalKvPut :: Val -> Val -> EvalM () +evalKvPut a b = EvalM $ \_env (k,s) -> (((a,b):k,s), Right ()) + eval :: Exp -> EvalM Val eval (CstInt x) = pure $ ValInt x eval (CstBool b) = pure $ ValBool b @@ -147,3 +158,11 @@ eval (Print s e1) = do (ValFun _ _ _) -> do evalPrint (s++": #") pure $ v1 +eval (KvPut e1 e2) = do + v1 <- eval e1 + v2 <- eval e2 + evalKvPut v1 v2 + pure $ v2 +eval (KvGet e) = do + v <- eval e + evalKvGet v diff --git a/a2/a2-handout/src/APL/Eval_Tests.hs b/a2/a2-handout/src/APL/Eval_Tests.hs index c1f35b9..9ab7847 100644 --- a/a2/a2-handout/src/APL/Eval_Tests.hs +++ b/a2/a2-handout/src/APL/Eval_Tests.hs @@ -92,7 +92,17 @@ evalTests = testCase "PrintFun" $ eval' (Print "Test" (Lambda "x" (Mul (Var "x") (Var "x")))) - @?= (["Test: #"], Right (ValFun [] "x" (Mul (Var "x") (Var "x")))) + @?= (["Test: #"], Right (ValFun [] "x" (Mul (Var "x") (Var "x")))), + -- + testCase "KvPut" $ + eval' + (KvPut (CstInt 1) (CstInt 2)) + @?= ([], Right (ValInt 2)), + -- + testCase "KvGet" $ + eval' + (Let "x" (KvPut (CstInt 0) (CstBool True)) (Let "y" (KvPut (CstInt 0) (CstBool False)) (KvGet (CstInt 0)))) + @?= ([], Right (ValBool False)) ] tests :: TestTree diff --git a/a2/a2.pdf b/a2/a2.pdf index e74d2c7..3f4c8ec 100644 Binary files a/a2/a2.pdf and b/a2/a2.pdf differ