Homework/KarelSemantics.hs

54 lines
1.7 KiB
Haskell
Raw Normal View History

2019-02-25 01:05:39 -08:00
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
2019-02-25 01:05:39 -08:00
-- | 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
2019-02-25 01:05:39 -08:00
-- | Run a Karel program.
prog :: Prog -> World -> Robot -> Result
prog (m,s) w r = stmt s m w r