.

[clean-tests.git] / afp / a10 / a10.icl

diff --git a/afp/a10/a10.icl b/afp/a10/a10.icl
deleted file mode 100644 (file)
index 77445a6..0000000
--- a/afp/a10/a10.icl
+++ /dev/null
@@ -1,80 +0,0 @@
-module a10
-
-import StdEnv
-
-import Data.Functor
-import Control.Applicative
-import Control.Monad
-import Data.Maybe
-import Data.Error
-
-:: BM a b = {t :: a->b, f :: b->a, t2 :: A.c t:(t c a)->t c b, f2 :: A.c t:(t b c)->t a c}
-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)
-       | E.i: (:.) infixl 1 (Action b i) (Action i a)
-       | WhileContainerBelow (BM b a) (Action a a)
-:: High = High
-:: Low = Low
-
-moveToShip = MoveToShip bm bm
-moveToQuay = MoveToQuay bm bm
-moveUp     = MoveUp     bm bm
-moveDown   = MoveDown   bm bm
-lock       = Lock       bm bm
-unlock     = Unlock     bm bm
-wait       = Wait       bm
-whileContainerBelow = WhileContainerBelow bm
-
-:: State =
-       { onShip      :: [String]
-       , onQuay      :: [String]
-       , craneUp     :: Bool
-       , craneOnQuay :: Bool
-       , locked      :: Maybe String
-       }
-
-state0 =
-       { onShip = []
-       , onQuay = ["apples","beer","camera's"]
-       , craneUp = True
-       , craneOnQuay = True
-       , locked = Nothing
-       }
-
-// ================
-eval :: (Action i f) State -> MaybeErrorString State
-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"
-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 = moveToShip :. moveDown