From 9d093d11da012724253e1a3b31d3f1af94b4e1bd Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Wed, 28 Nov 2018 09:06:31 +0100 Subject: [PATCH] afp10 --- afp/a10/a10.icl | 50 ++++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 30 deletions(-) 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 -- 2.20.1