Add solution for HW5.

Did it on paper first!

KarelExamples.hs

@@ -0,0 +1,103 @@
+-- | This module defines some example worlds and programs for testing
+--   your Karel interpreter.
+module KarelExamples where
+
+import Prelude hiding (Either(..))
+import KarelSyntax
+import KarelState
+
+
+--
+-- * Trivial worlds
+--
+
+-- | A world that is all walls.
+wallWorld :: World
+wallWorld = const Nothing
+
+-- | A world that is completely empty of walls and beepers.
+emptyWorld :: World
+emptyWorld = const (Just 0)
+
+-- | A robot that starts at the origin, facing north, with the
+--   given number of beepers.
+originBot :: Int -> Robot
+originBot b = ((0,0),North,b)
+
+
+--
+-- * Demo world
+--
+
+-- | A 10x5 room with some beepers in a line, illustrated below.
+--
+--       XXXXXXXXXXXX
+--       X          X
+--       X          X
+--       X          X
+--       X @  2 3 4 X
+--       X          X
+--       XXXXXXXXXXXX
+-- 
+--   The @ symbol is coordinate (1,1).
+--   Clear spaces are from (0,0) to (9,4).
+--   There are beepers at the following locations:
+--    * 2 beepers at (4,1)
+--    * 3 beepers at (6,1)
+--    * 4 beepers at (8,1)
+-- 
+demoWorld :: World
+demoWorld (4,1) = Just 2
+demoWorld (6,1) = Just 3
+demoWorld (8,1) = Just 4
+demoWorld (x,y) | x >= 0 && x < 10 &&
+                  y >= 0 && y < 5      = Just 0
+                | otherwise            = Nothing
+
+-- | An initial robot state for the demo world. The robot starts at
+--   (1,1), facing East, with 1 beeper in its bag.
+demoBot :: Robot
+demoBot = ((1,1),East,1)
+
+
+--
+-- * Program generators
+--
+
+-- | Generate a program that does the following n times:
+--     1. moves in a straight line until it finds a beeper
+--     2. picks it up
+--     3. returns to its original position and facing.
+fetcher :: Int -> Prog
+fetcher n = ([("fetch",fetch)], main)
+  where
+    fetch = Block
+      [ While (Not Beeper)   -- do until we find a beeper:
+          (If (Clear Front)    -- can we move forward?
+              Move             -- if yes, then do it
+              Shutdown)        -- if not, shut down
+      , PickBeeper ]
+    main = Block
+      [ Iterate n $ Block  -- repeat n times:
+         [ PutBeeper         -- put a beeper down to mark our place
+         , Move              -- move forward one space
+         , Call "fetch"      -- go get a new beeper
+         , Turn Back         -- turn around
+         , Move              -- move forward one space
+         , Call "fetch"      -- go back to where we started
+         , Turn Back ]       -- turn back to our initial facing
+      , Shutdown ]
+
+-- | Generates a statement that moves the robot in a rectangle of
+--   the given dimensions.
+rectangle :: Int -> Int -> Stmt
+rectangle w h = Block
+  [ While (Not (Facing North)) (Turn Right)
+  , Iterate h Move
+  , Turn Right
+  , Iterate w Move
+  , Turn Right
+  , Iterate h Move
+  , Turn Right
+  , Iterate w Move
+  , Turn Right ]

KarelSemantics.hs

@@ -0,0 +1,53 @@
+module KarelSemantics where
+
+import Prelude hiding (Either(..))
+import Data.Function (fix)
+
+import KarelSyntax
+import KarelState
+
+
+-- | Valuation function for Test.
+test :: Test -> World -> Robot -> Bool
+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
+stmt Shutdown   _ _ r = Done r
+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 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
+prog (m,s) w r = stmt s m w r

KarelState.hs

@@ -0,0 +1,167 @@
+-- | This module defines the state of a running Karel program.
+module KarelState where
+
+import Prelude hiding (Either(..))
+import KarelSyntax
+
+
+--
+-- * Positions and directions
+--
+
+-- | A cartesian coordinate, representing a position in the world.
+type Pos = (Int,Int)
+
+-- | Get the position next to the given position, offset by one square
+--   in the indicated *cardinal* direction.
+neighbor :: Card -> Pos -> Pos
+neighbor North (x,y) = (x,y+1)
+neighbor South (x,y) = (x,y-1)
+neighbor East  (x,y) = (x+1,y)
+neighbor West  (x,y) = (x-1,y)
+
+-- | Get a cardinal direction relative to the current one.
+cardTurn :: Dir -> Card -> Card
+cardTurn Front c     = c
+cardTurn Back  North = South
+cardTurn Back  South = North
+cardTurn Back  East  = West
+cardTurn Back  West  = East
+cardTurn Left  North = West
+cardTurn Left  South = East
+cardTurn Left  East  = North
+cardTurn Left  West  = South
+cardTurn Right North = East
+cardTurn Right South = West
+cardTurn Right East  = South
+cardTurn Right West  = North
+
+
+--
+-- * World state
+--
+
+-- | The state of the world is represented by a function that returns
+--   for each position:
+--    * Nothing, if the position is a wall
+--    * Just k, if the position is clear and has k beepers
+--   You can assume k is always >= 0.
+type World = Pos -> Maybe Int
+
+-- | Is the given position clear?
+isClear :: Pos -> World -> Bool
+isClear p w = w p /= Nothing
+
+-- | Is there a beeper at the given position?
+hasBeeper :: Pos -> World -> Bool
+hasBeeper p w = maybe False (>0) (w p)
+
+-- | Increment the number of beepers at the given position.
+incBeeper :: Pos -> World -> World
+incBeeper p w = \q -> if p == q 
+                         then case w q of
+                                Nothing -> Just 1
+                                Just i  -> Just (i+1)
+                         else w q
+
+-- | Decrement the number of beepers at the given position. Note that this
+--   function can yield a world with negative beepers, so you should make
+--   sure to only decrement the beepers at a position after first checking
+--   to make sure there is at least one beeper there (using `hasBeeper`).
+decBeeper :: Pos -> World -> World
+decBeeper p w = \q -> if p == q then fmap (subtract 1) (w q) else w q
+
+
+--
+-- * Robot state
+--
+
+-- | The state of the robot is represented by a triple containing:
+--    * the current position
+--    * the current facing (cardinal direction)
+--    * the number of beepers in the beeper bag
+type Robot = (Pos,Card,Int)
+
+
+-- ** Robot position
+
+-- | The robot's position.
+getPos :: Robot -> Pos
+getPos (p,_,_) = p
+
+-- | Get a position relative to the robot's current facing and position.
+relativePos :: Dir -> Robot -> Pos
+relativePos d (p,c,_) = neighbor (cardTurn d c) p
+
+-- | Set the robot's position.
+setPos :: Pos -> Robot -> Robot
+setPos p (_,c,b) = (p,c,b)
+
+-- | Update the robot's position using an update function.
+updatePos :: (Pos -> Pos) -> Robot -> Robot
+updatePos f (p,c,b) = (f p,c,b)
+
+
+-- ** Robot facing
+
+-- | The robot's facing (cardinal direction).
+getFacing :: Robot -> Card
+getFacing (_,c,_) = c
+
+-- | Set the robot's facing.
+setFacing :: Card -> Robot -> Robot
+setFacing c (p,_,b) = (p,c,b)
+
+-- | Update the robot's facing using an update function.
+updateFacing :: (Card -> Card) -> Robot -> Robot
+updateFacing f (p,c,b) = (p,f c,b)
+
+
+-- ** Beeper bag
+
+-- | The number of beepers in the beeper bag.
+getBag :: Robot -> Int
+getBag (_,_,b) = b
+
+-- | Is the beeper bag empty?
+isEmpty :: Robot -> Bool
+isEmpty (_,_,b) = b <= 0
+
+-- | Increment the number of beepers in the bag.
+incBag :: Robot -> Robot
+incBag (p,c,b) = (p,c,b+1)
+
+-- | Decrement the number of beepers in the bag.
+decBag :: Robot -> Robot
+decBag (p,c,b) = (p,c,b-1)
+
+
+--
+-- * Statement results
+--
+
+-- | The result of executing a statement.
+-- 
+--     * OK: The statement executed successfully, so return the updated state
+--       of the world and the robot. OK to execute the next statement.
+--
+--     * Done: Produced only by the Shutdown statement. This returns the final
+--       state of the robot. No further statements should be executed.
+--
+--     * Error: An error occurred. Includes a string for reporting error messages.
+--       No further statements should be executed.
+--
+data Result = OK    World Robot
+            | Done  Robot
+            | Error String
+
+instance Show Result where
+  show (OK _ r)  = "OK: " ++ show r
+  show (Done r)  = "Done: " ++ show r
+  show (Error s) = "Error: " ++ s
+
+-- | Applies a function to the result if its an OK, otherwise returns
+--   the result unchanged.
+onOK :: (World -> Robot -> Result) -> Result -> Result
+onOK f (OK w r) = f w r
+onOK _ result   = result

KarelSyntax.hs

@@ -0,0 +1,40 @@
+-- | This module defines the syntax of the Karel language.
+module KarelSyntax where
+
+
+-- | A Karel program is a list of macro definitions and a statement to
+--   use as the body of the "main" function.
+type Prog = (Defs,Stmt)
+
+-- | A macro name.
+type Macro = String
+
+-- | A list of macro definitions.
+type Defs = [(Macro,Stmt)]
+
+-- | Cardinal directions.
+data Card = North | South | East  | West  deriving (Eq,Show)
+
+-- | Directions relative to the current facing.
+data Dir  = Front | Back  | Right | Left  deriving (Eq,Show)
+
+-- | Environment queries.
+data Test = Not    Test   -- boolean negation
+          | Facing Card   -- am I facing the given cardinal direction?
+          | Clear  Dir    -- can I move in the given relative direction?
+          | Beeper        -- is there a beeper here?
+          | Empty         -- is my beeper bag empty?
+  deriving (Eq,Show)
+
+-- | Statements.
+data Stmt = Shutdown                 -- end the program
+          | Move                     -- move forward
+          | PickBeeper               -- take a beeper
+          | PutBeeper                -- leave a beeper
+          | Turn    Dir              -- rotate in place
+          | Call    Macro            -- invoke a macro
+          | Iterate Int  Stmt        -- fixed repetition loop
+          | If      Test Stmt Stmt   -- conditional branch
+          | While   Test Stmt        -- conditional loop
+          | Block   [Stmt]           -- statement block
+  deriving (Eq,Show)

KarelTests.hs

@@ -0,0 +1,122 @@
+-- | A module that contains several doctests for testing your interpreter.
+--   Note that if you want the tests to pass, you'll need to reverse engineer
+--   the error messages.
+--
+--   If you add your own tests, make sure to do that in the HW5 file, since you
+--   will not submit this file.
+module KarelTests where
+
+import Prelude hiding (Either(..))
+
+import KarelSyntax
+import KarelState
+import KarelSemantics
+import KarelExamples
+
+
+-- | Basic tests for move, turn, pick, and put.
+--
+--   >>> prog ([],Move) emptyWorld (originBot 0)
+--   OK: ((0,1),North,0)
+--
+--   >>> prog ([],Block [Turn Right,Move]) emptyWorld (originBot 0)
+--   OK: ((1,0),East,0)
+--
+--   >>> prog ([],Block [PutBeeper,PutBeeper]) emptyWorld (originBot 5)
+--   OK: ((0,0),North,3)
+--
+--   >>> prog ([],Block [PutBeeper,PickBeeper]) emptyWorld (originBot 5)
+--   OK: ((0,0),North,5)
+--   
+--   >>> prog ([],Block [PutBeeper,Move,Turn Back,Move,PickBeeper]) emptyWorld (originBot 5)
+--   OK: ((0,0),South,5)
+--
+--   >>> prog ([],Move) wallWorld (originBot 0)
+--   Error: Blocked at: (0,1)
+--
+--   >>> prog ([],Block [PutBeeper,PutBeeper]) emptyWorld (originBot 1)
+--   Error: No beeper to put.
+--
+--   >>> prog ([],PickBeeper) emptyWorld (originBot 5)
+--   Error: No beeper to pick at: (0,0)
+--
+--   >>> prog ([],Block [PutBeeper,Move,PickBeeper]) emptyWorld (originBot 5)
+--   Error: No beeper to pick at: (0,1)
+
+
+-- | Conditional tests.
+--
+--   >>> prog ([],If Beeper (Turn Left) (Turn Right)) emptyWorld (originBot 0)
+--   OK: ((0,0),East,0)
+--   
+--   >>> prog ([],If (Not Beeper) (Turn Left) (Turn Right)) emptyWorld (originBot 0)
+--   OK: ((0,0),West,0)
+--   
+--   >>> prog ([],Block [PutBeeper,If Beeper (Turn Left) (Turn Right)]) emptyWorld (originBot 3)
+--   OK: ((0,0),West,2)
+--
+--   >>> prog ([],Block [PutBeeper,PickBeeper,If Beeper (Turn Left) (Turn Right)]) emptyWorld (originBot 3)
+--   OK: ((0,0),East,3)
+--
+--   >>> prog ([],If (Facing North) (Turn Left) (Turn Right)) emptyWorld (originBot 0)
+--   OK: ((0,0),West,0)
+--
+--   >>> prog ([],If (Facing South) (Turn Left) (Turn Right)) emptyWorld (originBot 0)
+--   OK: ((0,0),East,0)
+--
+--   >>> prog ([],If (Not Empty) PutBeeper Move) emptyWorld (originBot 3)
+--   OK: ((0,0),North,2)
+--
+--   >>> prog ([],If (Not Empty) PutBeeper Move) emptyWorld (originBot 0)
+--   OK: ((0,1),North,0)
+--
+--   >>> prog ([],If (Clear Front) Move Shutdown) emptyWorld (originBot 0)
+--   OK: ((0,1),North,0)
+--
+--   >>> prog ([],If (Clear Front) Move Shutdown) wallWorld (originBot 0)
+--   Done: ((0,0),North,0)
+
+
+-- | Test macros.
+--   
+--   >>> prog ([("A",Turn Right),("B",Turn Left)],Call "A") emptyWorld (originBot 0)
+--   OK: ((0,0),East,0)
+--
+--   >>> prog ([("A",Turn Right),("B",Turn Left)],Call "B") emptyWorld (originBot 0)
+--   OK: ((0,0),West,0)
+--
+--   >>> prog ([("A",Turn Right),("B",Turn Left)],Call "C") emptyWorld (originBot 0)
+--   Error: Undefined macro: C
+
+
+-- | Test looping constructs.
+--
+--   >>> prog ([],Iterate 8 Move) demoWorld demoBot
+--   OK: ((9,1),East,1)
+--
+--   >>> prog ([],Iterate 9 Move) demoWorld demoBot
+--   Error: Blocked at: (10,1)
+--
+--   >>> prog ([],While (Clear Front) Move) demoWorld demoBot
+--   OK: ((9,1),East,1)
+--
+--   >>> prog ([],Block [Iterate 7 Move, While Beeper PickBeeper]) demoWorld demoBot
+--   OK: ((8,1),East,5)
+
+
+-- | Larger tests.
+--
+--   >>> prog (fetcher 4) demoWorld demoBot
+--   Done: ((1,1),East,5)
+--
+--   >>> prog (fetcher 9) demoWorld demoBot
+--   Done: ((1,1),East,10)
+-- 
+--   >>> prog (fetcher 10) demoWorld demoBot
+--   Done: ((9,1),East,9)
+--
+--   >>> prog ([],rectangle 8 3) demoWorld demoBot
+--   OK: ((1,1),North,1)
+--
+--   >>> prog ([],rectangle 3 8) demoWorld demoBot
+--   Error: Blocked at: (1,5)