From 98cab5ce2d2ff306eea5f59b72b7e1f3217e92a4 Mon Sep 17 00:00:00 2001 From: Reg Huijben Date: Tue, 31 Dec 2019 19:29:57 +0100 Subject: [PATCH] AARGGHH --- week13-reg/week13.icl | 194 +++++++----------------------------------- 1 file changed, 32 insertions(+), 162 deletions(-) diff --git a/week13-reg/week13.icl b/week13-reg/week13.icl index a84ebd2..04687ef 100644 --- a/week13-reg/week13.icl +++ b/week13-reg/week13.icl @@ -7,29 +7,8 @@ import StdMaybe import StdDebug -//import qualified Data.Map as Map import Data.Map => qualified updateAt -/* -:: Action - = MoveToShip // move the crane to the ship - | MoveToQuay // move the crane to the quay - | MoveUp // moves the crane from down to up position - | MoveDown // moves the crane from up to down position - | Lock // locks the top container on the stack under the crane - | Unlock // unlocks the container the crane is carrying, put it on the stack - | Wait // do nothing - | (:.) infixl 1 Action Action // sequence of two actions - | While (Expr Bool) Action // repeat action while expression yields true -*/ - -/*:: Expr - = ContainersBelow :: (Expr Int) // number of containers at current position - | Lit :: t -> Expr t | toString t - | (<.) infix 4 :: (Expr t) (Expr t) -> Expr Bool | <, toString t - | (>.) infix 4 :: (Expr t) (Expr t) -> Expr Bool | <, toString t - | (+.) infix 4 :: (Expr Int) (Expr Int) -> Expr Int - */ class expr v where lit :: a -> v Expr a | type a @@ -54,7 +33,6 @@ instance type Int where instance type Bool where type a = "bool" -//:: RW t = R | W t :: High = High :: Low = Low @@ -78,17 +56,11 @@ class action v where wait :: v Action (Step x x) While :: (v Expr Bool) (v q t) -> v Action () - //(:.) :: (Step a b) (Step b c) -> Step a c - //(:.) (Step a _) (Step _ c) = Step a c -//:: Upd = Upd class var v where (=.) infixr 2 :: (v Var Int) (v Expr Int) -> v Action (Step a a) //| type t var :: (v Var Int) -> (v Expr Int) //| type t int :: (v Expr Int) ((v Var Int) -> (v p u)) -> v p u //| type t - //(v Expr t) ((v Action t) -> v Expr z) -> v Expr y | type t//int :: (v Expr t) ((v Expr t) -> (v Action u)) -> v Action u | type t - //int :: (v Expr t) ((v q t) -> (v p t)) -> v r t | type t //(v Expr t) ((v Action t) -> v Expr z) -> v Expr y | type t - //var :: (v p t) -> v Expr t | type t :: Show p t = Show (SHOW -> (t, SHOW)) :: SHOW = @@ -146,11 +118,11 @@ c :: t -> Show p u | toString t c a = Show \c.(undef, {c & print = [toString a:c.print]}) instance expr Show where - lit a = c"lit " >>!c a // lit :: a -> v Expr a | type a - (+.) x y = x>>!c" +. " <*.>y//x//Expr t//-> v Expr t | type, + t - (<.) x y = x>>!c" <. " <*.>y//x//-> v Expr Bool | type, < t - (>.) x y = x>>!c" >. " <*.>y//x//-> v Expr Bool | type, < t - containersBelow = c "containersBelow"//:: (v Expr Int) + lit a = c"lit " >>!c a + (+.) x y = x>>!c" +. " <*.>y + (<.) x y = x>>!c" <. " <*.>y + (>.) x y = x>>!c" >. " <*.>y + containersBelow = c "containersBelow" instance action Show where moveToShip = c "moveToShip" @@ -186,7 +158,7 @@ unindent = Show \c.let n = max (dec c.indent) 0 in (n, {c & indent = n}) ,craneOnQuay :: Bool ,craneUp :: Bool ,locked :: Maybe Container - ,map :: (Map Int Int) // Map is undefined apparently ...? + ,map :: (Map Int Int) ,vars :: Int } @@ -243,10 +215,7 @@ freshVar = fmap (\n."v" +++ toString n) fresh freshShow :: Show p (Show q t) freshShow = fmap c freshVar -//(>.) x y :== y <. x instance var Show where - //int x f = c (type x) >>! c " " >>! freshShow >>= \v. - // v >>! c " = " >>! c "x" >>! c ";" >>! nl >>! f v var n = c "var " <*.> n (=.) v e = v >>! c " = " <*.> e int e f = c "int" >>! c " " >>! freshShow >>= \v. @@ -254,15 +223,7 @@ instance var Show where -//rvar :: Int State -> (Result Int, State) //| TC a -//rvar n s = (Res a,{s & map = put n a s.map}) -//rvar n s = case get n s.map of -// (Just d) = (Res d,s) -// _ = (Err "undefined",s) -//:: Var = Var Id -//:: Id :== Int -// defined below! :: RW t = R | W t rwvar :: Int (RW Int) State -> (Result Int, State) @@ -274,7 +235,6 @@ rwvar n (W a) s = (Res a,{s & map = put n a s.map}) instance var Eval where - //(=.) infixr 2 :: (v Var t) (v Expr t) -> v Action (Step a a) | type t (=.) v e = Eval \sss. case (unEval v) sss of (Res (h),ss) -> trace h let (Res g,s) = (unEval e) ss in (Res (undef), {s & map = put h g s.map } ) @@ -287,21 +247,6 @@ instance var Eval where case (get g ss.map) of Nothing -> (Err "undef var", ss) Just(a)-> ((Res a),ss) - //(=.) v e = e >>- \a.Eval \r s.unEval v a s - - // This needs to return a (State -> (Result v0, State)) - - //int e f = Eval \s. let (Res rslt,s) = ((unEval e) s) in (f (Eval \s.rwtvar s.vars rslt s)) s - - - // int :: (v Expr t) ((v Var t) -> (v p u)) -> v p u | type t - - - /*int x f = Eval \s. unEval f (rvar s.vars) - (Res rslt,zz) -> unEval ( (f (Eval (rvar zz.vars )) )) - {zz & vars = inc zz.vars, map = put zz.vars rslt zz.map} -*/ -// int x f = Eval \r s. unEval (f (Eval (rwvar s.vars) )) R s int x f = Eval \s. let (Res rslt,zz) = ((unEval x) s) in (unEval (f (Eval \z.(rwvar z.vars (W z.vars) z) ))) @@ -310,72 +255,30 @@ instance var Eval where -//:: Eval p t = Eval (State -> (Result t, State)) - - //{s & vars = inc s.vars, map = put s.vars x s.map} - - - - - //let (rslt,zz) = ((unEval x) s) in - // unEval ( (f (Eval (rvar zz.vars )) )) {zz & vars = inc zz.vars, map = put zz.vars rslt zz.map} - //{s} - - - //Eval \r s.unEval (f (Eval (rwtvar s.vars))) - //{s & vars = inc s.vars, map = put s.vars x s.map} - - - - // /*Now, rslt is the lefthand side, use that to update s*/ trace rslt undef - //Eval \s. let (a,s) = x s in (Err "f",{s & vars = inc s.vars, map = put s.vars ( dynamic a ) s.map})//s.//(undef,s)//(undef,snd( x s)) //Eval \z. - //int x f = - // Eval \r s. unEval (f (Eval (s.vars))) {s & vars = inc s.vars, map = put s.vars ( dynamic x ) s.map} - - //var e = e//:: (v p t) -> v Expr t | type t - //var2 f = - // Eval \r s. let (x In (Eval rest)) = f (Eval (rwvar s.vars)) in - // rest R {s & vars = inc s.vars, map = put s.vars ( dynamic x ) s.map} - instance expr Eval where - lit a = pure a // lit :: a -> v Expr a | type a - (+.) x y = pure(+) <*.> x <*.> y//x//Expr t//-> v Expr t | type, + t - (<.) x y = pure(<) <*.> x <*.> y//x>>!c" <. " <*.>y//x//-> v Expr Bool | type, < t - (>.) x y = pure( \a b. b < a) <*.> x <*.> y//x>>!c" >. " <*.>y//x//-> v Expr Bool | type, < t - containersBelow = Eval \s. (pure if s.craneOnQuay (length s.onQuay) (length s.onShip),s)//c "containersBelow"//:: (v Expr Int) + lit a = pure a + (+.) x y = pure(+) <*.> x <*.> y + (<.) x y = pure(<) <*.> x <*.> y + (>.) x y = pure( \a b. b < a) <*.> x <*.> y + containersBelow = Eval \s. (pure if s.craneOnQuay (length s.onQuay) (length s.onShip),s) instance action Eval where moveToShip = Eval \s. (Res (Step High High), ( {s & craneOnQuay = False})) moveToQuay = Eval \s. (Res (Step High High), ( {s & craneOnQuay = True})) - //While a b = Eval \s. (undef, s) - /*While (Eval e) (Eval a) = (Eval \s. let (Res cond, s2) = e s in if cond - (let (_,s3) = a s2 in - While (Eval e) (Eval a) - ) - - (undef,s2) - ) -*/ + While (Eval c) (Eval a) = Eval \s. case (c s) of (Res True,s) -> case (a s) of - (Res _,s) -> let (Eval z) = (While (Eval c) (Eval a)) in z s //case ((While (Eval c) (Eval a)) s) of //(Res (),s) + (Res _,s) -> let (Eval z) = (While (Eval c) (Eval a)) in z s (Err e, g) -> (Err e, g) (Res False,s) -> (Res (), s) (Err e, g) -> (Err e, g) - -// (:.) (Eval x) (Eval y) = (Eval \s. (undef, snd(y (snd(x s)) ))) - //(:.) (Eval x) (Eval y) = (Eval \s. let (Res (Step a b),ss) = (x s) in let (Res (Step c d),sss) = (y ss) in (Res (Step a d),sss) ) (:.) (Eval x) (Eval y) = Eval \s. case x s of (Res (Step a b),ss) -> case y ss of (Res (Step c d),sss) -> (Res (Step a d),sss) (Err e, g) -> (Err e, g) (Err e, g) -> (Err e, g) - /* */ -// (:.) (Eval x) (Eval y) = (Eval \s. (y (snd(x s)) )) - //(:.) (Eval x) (Eval y) = Eval (\s. y (snd (x s) )) - //(:.) s t = s >>- \_. t lock = Eval \s. @@ -388,7 +291,7 @@ instance action Eval where case s.onShip of [x:xs] -> case s.locked of Just(c) = (Err "Cannot lock container, crane occupied",s) - Nothing = (undef, {s & onShip = xs, locked = (Just x) }) + Nothing = (Res (Step Low Low), {s & onShip = xs, locked = (Just x) }) [] -> (Err "Cannot lock container, none on ship",s) @@ -402,73 +305,40 @@ instance action Eval where case s.locked of Just c -> (Res (Step Low Low),{s & onShip = [c:s.onShip], locked = Nothing }) Nothing -> (Err "Cannot unlock container, no container on crane",s) - //c "unlock" - moveDown = Eval \s. (Res (Step High Low),{s & craneUp = False}) //c "moveDown" - moveUp = Eval \s. (Res (Step Low High),{s & craneUp = True}) // c "moveUp" - wait = Eval \s. (undef , s)//Eval \s. (pure (),s) //c "wait" + + moveDown = Eval \s. (Res (Step High Low),{s & craneUp = False}) + moveUp = Eval \s. (Res (Step Low High),{s & craneUp = True}) + wait = Eval \s. (Res (Step undef undef ) , s) :: Var = Var Id :: Id :== Int +loadShip1 = // =. and var do not properly work + While (containersBelow >. lit 0) ( + moveDown:. + lock:. + moveUp:. moveToShip:. + wait:. + moveDown:. + wait:. + unlock:. + moveUp:. moveToQuay + ) - - -/*loadShip = While (containersBelow >. lit 0) ( - moveToShip:. - moveToQuay:. - moveToShip:. wait :. - moveToQuay:. - moveToShip:. - moveToQuay - )*/ loadShip = moveDown :. lock :. moveUp:. moveToShip :. moveDown :. unlock :. moveUp:. moveToQuay - -loadShipw = int (lit 5) \s. int (lit 0) \n. While (var n <. containersBelow) ( - moveDown :. lock :. moveUp:. moveToShip :. moveDown :. unlock :. moveUp:. moveToQuay :. (n =. (lit 5)) - ) - -//loadShipvar = int containersBelow \n. -//loadShipvar :: Eval Expr Int -loadShipvar = int (lit 1) \n. moveDown :. moveUp //trace n//lit 1 -/* While (/*var n*/lit 0 >. lit 0) ( - moveDown:. lock :. moveUp//:. moveToShip :. moveDown :. unlock :. moveUp:. moveToQuay// :. - //n =. var n +. lit -1 - ) -*/ -test = moveUp :. moveDown - -//Start :: Int - -//zoep :: Show Expr Bool -zoep :: Eval Expr Int -//zoep = containersBelow >. lit 60 -zoep = containersBelow// >. lit 60 -//zoep = lit 60 - -foef = moveDown:.lock:. moveUp //moveDown :. lock:. moveUp:. moveToShip :. moveDown :. unlock - + zoepie :: [String] -> String zoepie [a:r] = a +++ zoepie r zoepie [] = "" - -loadShipzzz = int (lit 6) \z. int (lit 7) \s. (var s) //int ((lit 9) +. (lit 4)) \n. (var n) +. (lit 5) //int (lit 9) \z. int (lit 5) (\n. int (var n +. lit 70) \x. lit 6 ) -loadShipzz = int (lit 5) \n. var n +. lit 1//int (lit 5) \s. int (lit 0) \n. While (var n <. containersBelow) ( - //moveDown :. lock :. moveUp:. moveToShip :. moveDown :. unlock :. moveUp:. moveToQuay :. (n =. (lit 5)) - //) - - -Start = let (Show f) = loadShipw in zoepie (reverse (snd( f s0)).print) -//Start = let (Eval f) = loadShipzzz in - //get 0 (snd ( f initialState)).map -// (f initialState) +Start = let (Show f) = loadShip1 in zoepie (reverse (snd( f s0)).print) +//Start = let (Eval f) = loadShip1 in snd (f initialState) -//Start = snd ((unShow zoep) s0 ) -- GitLab