diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_hi b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_hi index a560af1..1c8cf5f 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_hi and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_hi differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_o b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_o index 510e00c..f08b3dd 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_o and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.dyn_o differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.hi b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.hi index a560af1..1c8cf5f 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.hi and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.hi differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.o b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.o index 510e00c..f08b3dd 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.o and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/InterpIO.o differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_hi b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_hi index b2c5ead..75cb162 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_hi and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_hi differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_o b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_o index 3c1def9..4da39b9 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_o and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.dyn_o differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.hi b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.hi index b2c5ead..75cb162 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.hi and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.hi differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.o b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.o index 3c1def9..4da39b9 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.o and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/APL/Interp_Tests.o differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace-ghc9.2.8.so b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace-ghc9.2.8.so index 423e45c..b1d109f 100755 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace-ghc9.2.8.so and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace-ghc9.2.8.so differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace.a b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace.a index 70b92fb..b7bc8c1 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace.a and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/build/libHSa4-1.0.0.0-inplace.a differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/cache/build b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/cache/build index 272d881..a084222 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/cache/build and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/cache/build differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test index 17b8a1c..d5fb075 100755 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test-tmp/Main.dyn_hi b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test-tmp/Main.dyn_hi index 8f09f78..0e9a85a 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test-tmp/Main.dyn_hi and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/build/a4-test/a4-test-tmp/Main.dyn_hi differ diff --git a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/cache/build b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/cache/build index 2799101..ddccbf5 100644 Binary files a/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/cache/build and b/a4/dist-newstyle/build/x86_64-linux/ghc-9.2.8/a4-1.0.0.0/t/a4-test/cache/build differ diff --git a/a4/src/APL/InterpIO.hs b/a4/src/APL/InterpIO.hs index 4d44b0f..5706c91 100644 --- a/a4/src/APL/InterpIO.hs +++ b/a4/src/APL/InterpIO.hs @@ -62,9 +62,30 @@ runEvalIO evalm = do runEvalIO' :: Env -> FilePath -> EvalM a -> IO (Either Error a) runEvalIO' _ _ (Pure x) = pure $ pure x runEvalIO' r db (Free (ReadOp k)) = runEvalIO' r db $ k r - runEvalIO' r db (Free (StateGetOp k)) = error "TODO in Task 3" - runEvalIO' r db (Free (StatePutOp s m)) = error "TODO in Task 3" + runEvalIO' r db (Free (StateGetOp k)) = do + result <- readDB db + case result of + Right s -> runEvalIO' r db $ k s + Left e -> pure $ Left e + runEvalIO' r db (Free (StatePutOp s m)) = do + writeDB db s + runEvalIO' r db m runEvalIO' r db (Free (PrintOp p m)) = do putStrLn p runEvalIO' r db m + runEvalIO' r db (Free (KvGetOp key k)) = do + result <- readDB db + case result of + Right s -> case (lookup key s) of + Just val -> runEvalIO' r db $ k val + Nothing -> pure $ Left "Cannot find key :)" + Left e -> pure $ Left e + runEvalIO' r db (Free (KvPutOp key val m)) = do + result <- readDB db + case result of + Right dbState -> do + let dbState' = (key,val):dbState + writeDB db dbState' + runEvalIO' r db m + Left e -> pure $ Left e runEvalIO' _ _ (Free (ErrorOp e)) = pure $ Left e diff --git a/a4/src/APL/Interp_Tests.hs b/a4/src/APL/Interp_Tests.hs index eacb4dd..e190e88 100644 --- a/a4/src/APL/Interp_Tests.hs +++ b/a4/src/APL/Interp_Tests.hs @@ -113,12 +113,37 @@ ioTests = evalPrint s1 evalPrint s2 (out, res) @?= ([s1, s2], Right ()), - testCase "print 2" $ do - (out, res) <- - captureIO [] $ - evalIO' $ - Print "This is also 1" $ - Print "This is 1" $ - CstInt 1 - (out, res) @?= (["This is 1: 1", "This is also 1: 1"], Right $ ValInt 1) + --- + testCase "print 2" $ do + (out, res) <- + captureIO [] $ + evalIO' $ + Print "This is also 1" $ + Print "This is 1" $ + CstInt 1 + (out, res) @?= (["This is 1: 1", "This is also 1: 1"], Right $ ValInt 1), + --- + testCase "State" $ do + r <- runEvalIO $ do + putState [(ValInt 0, ValInt 1)] + modifyState $ map (\(key, _) -> (key, ValInt 5)) + getState + + r @?= Right [(ValInt 0, ValInt 5)], + -- + testCase "KvPutOp" $ do + r <- evalIO' (KvPut (CstInt 1) (CstInt 2)) + r @?= Right (ValInt 2), + -- + testCase "KvGetOp" $ do + r <- evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (KvGet (CstInt 1))) + r @?= Right (ValInt 2), + -- + testCase "KvGetOp shadowing" $ do + r <- evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (Let "_" (KvPut (CstInt 1) (CstInt 3)) (KvGet (CstInt 1)))) + r @?= Right (ValInt 3), + -- + testCase "KvGetOp fail" $ do + r <- evalIO' (KvGet (CstInt 1)) + r @?= Left "Cannot find key :)" ]