Commit b13befee by Job Cuppen

### all

parent 50c4f265
week12_job/12.icl 0 → 100644
 module ex12 import StdEnv, StdMaybe, StdDebug import Data.Functor, Control.Applicative, Control.Monad ::BM a b = {t:: a -> b ,f:: b -> a } bm :: BM a a bm = {f = id ,t = id } :: Action a b i j x y = MoveToShip (BM a High) (BM b High) (BM i j) (BM x Quay) (BM y Ship) // move the crane to the ship | MoveToQuay (BM a High) (BM b High) (BM i j) (BM x Ship) (BM y Quay) // move the crane to the quay | MoveUp (BM a Low) (BM b High) (BM i j) (BM x y) // moves the crane up | MoveDown (BM a High) (BM b Low) (BM i j) (BM x y) // moves the crane down | Lock (BM a Low) (BM b Low) (BM i Empty) (BM j Full) (BM x y) // locks the top container of the stack under the crane | Unlock (BM a Low) (BM b Low) (BM i Full) (BM j Empty) (BM x y) // unlocks the container the crane is carrying, put it on the stack | Wait (BM a b) (BM i j) (BM x y) // do nothing | E.c k z:(:.) infixl 1 (Action a c i k x z) (Action c b k j z y) // sequence of two actions | WhileContainerBelow (Action High High Empty Empty Quay Quay) // repeat action while there is a container at current position :: High = High :: Low = Low :: Quay = Quay :: Ship = Ship :: Full = Full :: Empty = Empty :: Result r = Res r | Err String :: State = {onShip :: [Container] ,onQuay :: [Container] ,craneOnQuay :: Bool ,craneUp :: Bool ,locked :: Maybe Container } :: Container :== String initialState = {onShip = [] ,onQuay = ["apples", "beer", "camera"] ,craneOnQuay = True ,craneUp = True ,locked = Nothing } moveDown :: Action High Low i i x x moveDown = MoveDown bm bm bm bm moveUp :: Action Low High i i x x moveUp = MoveUp bm bm bm bm moveToShip :: Action High High i i Quay Ship moveToShip = MoveToShip bm bm bm bm bm moveToQuay :: Action High High i i Ship Quay moveToQuay = MoveToQuay bm bm bm bm bm lock :: Action Low Low Empty Full x x lock = Lock bm bm bm bm bm test :: Action High High Empty Full Quay Quay test = moveUp :. lock wait :: Action a a i i x x wait = Wait bm bm bm unlock :: Action Low Low Full Empty x x unlock = Unlock bm bm bm bm bm whileContainerBelow :: (Action High High Empty Empty Quay Quay) -> Action High High Empty Empty Quay Quay whileContainerBelow a = WhileContainerBelow a loadShip :: Action High High Empty Empty Quay Quay loadShip = whileContainerBelow ( moveDown:. lock:. moveUp:. moveToShip:. wait:. moveDown:. wait:. unlock:. moveUp:. moveToQuay ) highError :: String -> Result State highError str = Err ("Can not do '" +++ str +++ "', crane is high!") eval :: (Action a b i j x y) State -> Result State eval (MoveUp _ _ _ _) st = Res {st & craneUp = True} eval (MoveDown _ _ _ _) st = Res {st & craneUp = False} eval (Unlock _ _ _ _ _) st = if st.craneUp (highError "Unlock") case st.locked of (Just a) -> if st.craneOnQuay (unlockResultQuay a) (unlockResultShip a) (Nothing) -> (Err "Crane is empty!") where unlockResultShip a = Res {st & locked = Nothing, onShip = [a:st.onShip] } unlockResultQuay a = Res {st & locked = Nothing, onQuay = [a:st.onQuay] } eval (Lock _ _ _ _ _) st = if st.craneUp (highError "Lock") if (isJust st.locked) (Err "Crane is full!") if st.craneOnQuay lockResultQuay lockResultShip where lockResultShip = case st.onShip of [x:xs] -> (Res {st & locked = Just x, onShip = xs}) [] -> (Err "No crates left on ship") lockResultQuay = case st.onQuay of [x:xs] -> (Res {st & locked = Just x, onQuay = xs }) [] -> (Err "No crates left on quay") eval (MoveToShip _ _ _ _ _) st = if (not st.craneOnQuay) (Err "Can not move to Ship already on Ship") (Res {st & craneOnQuay = False }) eval (MoveToQuay _ _ _ _ _) st = if st.craneOnQuay (Err "Can not move to Quay already on Quay") (Res {st & craneOnQuay = True }) eval (Wait _ _ _) st = Res st eval (:. a b) st = case eval a st of Res st1 -> eval b st1 Err str -> Err str eval (WhileContainerBelow a) st = if (containerBelow st) iteration (Res st) where iteration = case eval a st of (Res st1) -> eval (WhileContainerBelow a) st1 (Err str) -> Err str isNotEmpty = (not o isEmpty) containerBelow :: State -> Bool containerBelow s = if s.craneOnQuay (isNotEmpty s.onQuay) (isNotEmpty s.onShip) print :: (Action a b i j x y) -> [String] print (MoveToShip _ _ _ _ _) = ["moveToShip"] print (MoveToQuay _ _ _ _ _) = ["moveToQuay"] print (MoveUp _ _ _ _) = ["moveUp"] print (MoveDown _ _ _ _) = ["moveDown"] print (Lock _ _ _ _ _) = ["lock"] print (Unlock _ _ _ _ _) = ["unlock"] print (Wait _ _ _) = ["wait"] print (:. a b) = print a ++ [":.":"\n": print b ] print (WhileContainerBelow a) = ["whileContainerBelow":"(":"\n": (print a ++ [")"])] //Start = optimize (wait:.moveUp) Start = eval loadShip initialState //Start = print loadShip
week12_job/ex12 0 → 100755