afp10

diff --git a/afp/a10/a10.icl b/afp/a10/a10.icl
index c561796..77445a6 100644 (file)
--- a/afp/a10/a10.icl
+++ b/afp/a10/a10.icl
@@ -50,41 +50,31 @@ state0 =
        }
 
 // ================
-:: Sem a = Sem ((MaybeErrorString State) -> MaybeErrorString State)
-
-
 eval :: (Action i f) State -> MaybeErrorString State
-eval (MoveToShip b1 b2) s = pure {s & craneOnQuay = False}
-eval (MoveToQuay b1 b2) s = pure {s & craneOnQuay = True}
-eval (MoveUp b1 b2)     s = pure {s & craneUp = True}
-eval (MoveDown b1 b2)   s = pure {s & craneUp = False}
-eval (Lock b1 b2) s=:{locked=Nothing}
-       | s.craneOnQuay =  
-                       =
-eval (Lock b1 b2) s=:{locked=Nothing} = Error ("Cannot lock new container, craner contains " + container)
-eval (Lock b1 b2) s=:{locked=(Just _)} = Error ("Cannot lock new container, craner contains " + container)
-       Nothing
-               | s.craneOnQuay
+eval (MoveToShip _ _) s = pure {s & craneOnQuay = False}
+eval (MoveToQuay _ _) s = pure {s & craneOnQuay = True}
+eval (MoveUp _ _)     s = pure {s & craneUp = True}
+eval (MoveDown _ _)   s = pure {s & craneUp = False}
+eval (Lock _ _)       s=:{locked=Nothing}
+       | s.craneOnQuay
                = case s.onQuay of
                        [c:r] = pure {s & onQuay = r, locked = Just c}
                        []    = Error "Cannot lock container on empty quay"
                = case s.onShip of
                        [c:r] = pure {s & onShip = r, locked = Just c}
                        []    = Error "Cannot lock container on empty ship"
-       Just container
-               = Error ("Cannot lock new container, craner contains " + container)
-eval (Unlock b1 b2)     s =case s.locked of
-       Just container | s.craneOnQuay
-                = Result {s & onQuay = [container:s.onQuay], locked = Nothing}
-                        = Result {s & onShip = [container:s.onShip], locked = Nothing}
-                       Nothing = Error "Cannot unlock container, craner contains nothing"
-               Wait bm = Result s
-               a :. b  = eval b (eval a r)
-               WhileContainerBelow bm action
-                       | s.craneOnQuay && not (isEmpty s.onQuay) ||
-                         not s.craneOnQuay && not (isEmpty s.onShip)
-                       = eval (action :. WhileContainerBelow bm action) r
-                       = r
-*/
+eval (Lock _ _)       s=:{locked=(Just c)}
+       = Error ("Cannot lock new container, craner contains " +++ c)
+eval (Unlock _ _)     s=:{locked=(Just c)}
+       | s.craneOnQuay = pure {s & onQuay = [c:s.onQuay], locked = Nothing}
+                       = pure {s & onShip = [c:s.onShip], locked = Nothing}
+eval (Unlock b1 b2)   s=:{locked=Nothing}
+       = Error "Cannot unlock container, crane contains nothing"
+eval (Wait _)         s = Ok s
+eval (a :. b)         s = eval a s >>= eval b
+eval (WhileContainerBelow _ action) s
+       | s.craneOnQuay && not (isEmpty s.onQuay) || not s.craneOnQuay && not (isEmpty s.onShip)
+               = eval (action :. whileContainerBelow action) s
+       = pure s
 
-Start = 42
+Start = moveToShip :. moveDown