10
[clean-tests.git] / afp / a10 / a10.icl
index 77445a6..9f4a7a5 100644 (file)
@@ -14,11 +14,11 @@ bm = {t = id, f = id, t2 = id, f2 = id}
 :: Action b a
        = MoveToShip (BM b High) (BM a High)
        | MoveToQuay (BM b High) (BM a High)
-       | MoveUp (BM b Low) (BM a High)
-       | MoveDown (BM b High) (BM a Low)
-       | Lock (BM b Low) (BM a Low)
-       | Unlock (BM b Low) (BM a Low)
-       | Wait (BM b a)
+       | MoveUp     (BM b Low)  (BM a High)
+       | MoveDown   (BM b High) (BM a Low)
+       | Lock       (BM b Low)  (BM a Low)
+       | Unlock     (BM b Low)  (BM a Low)
+       | Wait       (BM b a)
        | E.i: (:.) infixl 1 (Action b i) (Action i a)
        | WhileContainerBelow (BM b a) (Action a a)
 :: High = High
@@ -70,11 +70,28 @@ eval (Unlock _ _)     s=:{locked=(Just c)}
                        = 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 (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 = moveToShip :. moveDown
+Start = loadShip
+p1 = moveToShip :. moveDown
+
+//p2 = moveToShip :. wait :. lock // the required type error
+
+loadShip =
+       whileContainerBelow (
+               moveDown:.
+               lock:.
+               moveUp:.
+               moveToShip:.
+               wait:.
+               moveDown:.
+               wait:.
+               unlock:.
+               moveUp:.
+               moveToQuay 
+       )