Commit 537e0524 authored by Reg Huijben's avatar Reg Huijben

w12 including printing

parent 1bb5f845
module week12reg
import StdEnv, StdMaybe
::BM a b = {t::a -> b,f::b -> a} //bimap
bm :: BM a a
bm = {f = id, t = id}
:: Action a b
= Lock (BM a Low) (BM b Low)
| Unlock (BM a Low) (BM b Low)
| MoveToShip (BM a High) (BM b High)
| MoveToKey (BM a High) (BM b High)
| MoveUp (BM a Low) (BM b High)
| MoveDown (BM a High) (BM b Low)
| E.c:(:.) infixl 1 (Action a c) (Action c b)
| Wait (BM a b) (BM a b)
| WhileContainerBelow (Action High High)
:: High = High
:: Low = Low
lock = Lock bm bm
unlock = Unlock bm bm
up = MoveUp bm bm
down = MoveDown bm bm
wait :: Action a a
wait = Wait bm bm
moveToQuay = MoveToKey bm bm
moveToShip = MoveToShip bm bm
whileContainerBelow :: (Action High High) -> (Action High High)
whileContainerBelow a = WhileContainerBelow a
t1 :: Action High High
t1 = whileContainerBelow (down :. lock :. up :. down :. unlock :. up) //lock :. up
//t1 :: Action High High
//t1 = down :. lock :. up :. down :. unlock :. up
:: Res r e = Error e | Result r
:: State =
{ onShip :: [Container]
, onQuay:: [Container]
, craneUp :: Bool
, craneOnQuay :: Bool
, locked :: Maybe Container
}
:: Container :== String
initialState =
{ onShip = []
, onQuay = ["apples","beer","camera’s"]
, craneUp = True
, craneOnQuay = True
, locked = Nothing
}
/*
eval (Lock {f} {t}) st
| st.craneOnQuay   = Res {st & locked = Just (hd st.onQuay), onQuay = tl st.onQuay }
| otherwise        = Res {st & locked = Just (hd st.onShip), onShip = tl st.onShip }
eval (Unlock {f} {t}) st
| st.craneOnQuay    = Res {st & locked = Nothing, onQuay = [fromJust st.locked:st.onQuay] }
| otherwise         = Res {st & locked = Nothing, onShip = [fromJust st.locked:st.onShip] }
*/
eval :: (Action a b) State -> (Res State String)
eval (MoveUp {f} {t}) s = Result {s & craneUp = True}
eval (MoveDown {f} {t}) s = Result {s & craneUp = False}
eval (Lock {f} {t}) s = if s.craneOnQuay
case s.onQuay of
[x:xs] -> case s.locked of
Just(c) = Error "Cannot lock container, crane occupied"
Nothing = Result {s & onQuay = xs, locked = (Just x) }
[] -> Error "Cannot lock container, none on quay"
case s.onShip of
[x:xs] -> case s.locked of
Just(c) = Error "Cannot lock container, crane occupied"
Nothing = Result {s & onShip = xs, locked = (Just x) }
[] -> Error "Cannot lock container, none on ship"
//(Error "Cannot lock container, crane not on quay") // should never happen
eval (Unlock {f} {t}) s = if s.craneOnQuay
// (Error "Cannot unlock container, crane not on ship")
case s.locked of
Just c -> Result {s & onQuay = [c:s.onQuay], locked = Nothing }
Nothing -> Error "Cannot unlock container, no container on crane"
case s.locked of
Just c -> Result {s & onShip = [c:s.onShip], locked = Nothing }
Nothing -> Error "Cannot unlock container, no container on crane"
eval (MoveToShip {f} {t}) s = if s.craneOnQuay
(Result {s & craneOnQuay = False})
(Error "Cannot move to ship, crane is already on ship")
eval (MoveToKey {f} {t}) s = if s.craneOnQuay
(Error "Cannot move to quay, crane is already on quay")
(Result {s & craneOnQuay = True})
eval (Wait {f} {t}) s = Result s
eval (:. a b) s = case (eval a s) of
Result s -> (eval b s)
e -> e
eval (WhileContainerBelow a) s = if (containerBelow s)
case (eval a s) of
(Result s2) -> (eval (WhileContainerBelow a) s2)
e -> e
(Result s)
containerBelow :: State -> Bool
containerBelow s = case s.locked of
(Just s) = True
Nothing = if s.craneOnQuay
(length s.onQuay > 0)
(length s.onShip > 0)
/* = Lock (BM a Low) (BM b Low)
| Unlock (BM a Low) (BM b Low)
| MoveToShip (BM a High) (BM b High)
| MoveToKey (BM a High) (BM b High)
| MoveUp (BM a Low) (BM b High)
| MoveDown (BM a High) (BM b Low)
| E.c:(:.) infixl 1 (Action a c) (Action c b)
| Wait (BM a b) (BM a b)
| WhileContainerBelow (Action High High)
*/
//asd//(Result s)
print :: (Action a b) -> [String]
print (MoveToShip {f} {t}) = ["moveToShip"]
print (MoveToKey {f} {t}) = ["moveToQuay"]
print (MoveUp {f} {t}) = ["moveUp"]
print (MoveDown {f} {t}) = ["moveDown"]
print (Lock {f} {t}) = ["lock"]
print (Unlock {f} {t}) = ["unlock"]
print (Wait {f} {t}) = ["wait"]
print (:. a b) = print a ++ [":.":"\n": print b ]
print (WhileContainerBelow a) = ["whileContainerBelow":"(":"\n": (print a ++ [")"])]
t2 :: Action Low Low
t2 = lock :. up :. down :. unlock
Start = print loadShip //eval loadShip initialState
loadShip = whileContainerBelow (
down:.
lock:.
up:.
moveToShip:.
wait:.
down:.
wait:.
unlock:.
up:.
moveToQuay
)
//Start = loadShip //t1
//Start = g2 (G id)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment