From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 28 Nov 2018 08:06:31 +0000 (+0100)
Subject: afp10
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=9d093d11da012724253e1a3b31d3f1af94b4e1bd;p=clean-tests.git

afp10
---

diff --git a/afp/a10/a10.icl b/afp/a10/a10.icl
index c561796..77445a6 100644
--- 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