54 lines
1.7 KiB
Haskell
54 lines
1.7 KiB
Haskell
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
|