Commit 98cab5ce authored by Reg Huijben's avatar Reg Huijben

AARGGHH

parent 0e9d51c7
......@@ -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 )
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment