AARGGHH

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 )