From e5acf767484d1429d87e684284baaa20dae55502 Mon Sep 17 00:00:00 2001
From: Danila Fedorin <danila.fedorin@gmail.com>
Date: Mon, 25 Feb 2019 01:05:56 -0800
Subject: [PATCH] Add solution for HW5. Did it on paper first!

---
 KarelSemantics.hs | 32 ++++++++++++++++++++++++++++++--
 1 file changed, 30 insertions(+), 2 deletions(-)

diff --git a/KarelSemantics.hs b/KarelSemantics.hs
index 6f2d16c..9da81cc 100644
--- a/KarelSemantics.hs
+++ b/KarelSemantics.hs
@@ -9,7 +9,11 @@ import KarelState
 
 -- | Valuation function for Test.
 test :: Test -> World -> Robot -> Bool
-test = undefined
+test (Not t) w r = not $ test t w r
+test (Facing c) w (_, c', _) = c == c'
+test (Clear d) w (p, c, _) = isClear (neighbor (cardTurn d c) p) w
+test Beeper w (p, _, _) = hasBeeper p w
+test Empty w (_, _, i) = i == 0
 
 -- | Valuation function for Stmt.
 stmt :: Stmt -> Defs -> World -> Robot -> Result
@@ -18,7 +22,31 @@ stmt PickBeeper _ w r = let p = getPos r
                         in if hasBeeper p w
                               then OK (decBeeper p w) (incBag r)
                               else Error ("No beeper to pick at: " ++ show p)
-stmt _ _ _ _ = undefined
+stmt Move _ w (p, c, i) =
+    case w np of
+        Just n -> OK w (np, c, i)
+        Nothing -> Error ("Blocked at: " ++ show np)
+    where np = neighbor c p
+stmt PutBeeper _ w (p, c, i) = case i of
+    0 -> Error ("No beeper to put.")
+    n -> OK (incBeeper p w) (p, c, n - 1)
+stmt (Turn d) _ w (p, c, i) = OK w (p, cardTurn d c, i)
+stmt (Call m) e w r = case lookup m e of
+    Just x -> stmt x e w r
+    Nothing -> Error ("Undefined macro: " ++ m)
+stmt (Iterate n s) e w r = several (take n $ cycle [s]) e w r
+stmt (If c t el) e w r =
+    if test c w r
+    then stmt t e w r
+    else stmt el e w r
+stmt (While t es) e w r =
+    if test t w r
+    then onOK (\w' r' -> stmt (While t es) e w' r') (stmt es e w r)
+    else OK w r
+stmt (Block es) e w r = several es e w r
+
+several :: [Stmt] -> Defs -> World -> Robot -> Result
+several xs d w r = foldl (\rs s -> onOK (\w' r' -> stmt s d w' r') rs) (OK w r) xs
     
 -- | Run a Karel program.
 prog :: Prog -> World -> Robot -> Result