= eval (action :. whileContainerBelow action) s
= pure s
+opt :: (Action a b) -> Action a b
+opt (WhileContainerBelow b a) = WhileContainerBelow b (opt a)
+opt (Wait bm :. b) = opt (bm.f2 b)
+opt (a :. Wait bm) = opt (bm.t2 a)
+opt (a :. b) = opt a :. opt b
+opt x = x
+
+Start = opt (moveToShip :. wait :. moveDown)
+ //print :: (Action i f) [String] -> [String]
+ //print (MoveToShip _ _) s = ["Move to ship":s]
+ //print (MoveToQuay _ _) s = ["Move to quay":s]
+ //print (MoveUp _ _) s = ["Move up":s]
+ //print (MoveDown _ _) s = ["Move down":s]
+ //print (Lock _ _) s = ["Lock":s]
+ //print (Unlock _ _) s = ["Unlock":s]
+ //print (Wait _) s = ["Wait":s]
+ //print (a :. b) s = print a ["\n":print b s]
+ //print (WhileContainerBelow _ a) s
+ // = ["While container below (":indent ["\n":print a [")":s]]]
+ //where
+ // indent s = map (\s->if (s.[0] == '\n') (s +++ "\t") s)
+ //
+
+ print :: (Action i f) String [String] -> [String]
+ print (MoveToShip _ _) i s = [i,"Move to ship":s]
+ print (MoveToQuay _ _) i s = [i,"Move to quay":s]
+ print (MoveUp _ _) i s = [i,"Move up":s]
+ print (MoveDown _ _) i s = [i,"Move down":s]
+ print (Lock _ _) i s = [i,"Lock":s]
+ print (Unlock _ _) i s = [i,"Unlock":s]
+ print (Wait _) i s = [i,"Wait":s]
+ print (a :. b) i s = print a i ["\n":print b i s]
+ print (WhileContainerBelow _ a) i s
+ = [i,"While container below (\n":print a ("\t"+++i) ["\n",i,")":s]]
+
+ Start = print loadShip "" []
+
+ p1 = moveToShip :. moveDown
+
+ //p2 = moveToShip :. wait :. lock // the required type error
+
+ loadShip =
+ whileContainerBelow (
+ moveDown:.
+ lock:.
+ moveUp:.
+ moveToShip:.
+ wait:.
+ moveDown:.
+ wait:.
+ unlock:.
+ moveUp:.
+ moveToQuay
+ ) :. wait
module test
- import StdMisc
+ import StdEnv
+:: Zero = Zero
+:: Succ a = Succ a
+:: Ar3 a b c :== (a -> b -> c)
+
+class succ a ~b :: a -> b
+instance succ Zero (Succ Zero) where succ Zero = Succ Zero
+instance succ a (Succ a) where succ a = Succ a
+
+class plus a b | succ a b :: a b
+instance plus Zero a a
+where
+ plus a b = b
+instance plus (Succ a) b c | plus a (Succ b) c
+where
+ plus (Succ a) b = plus a (Succ b)
+
+Start :: Int
+Start = 42
++
+ class fmap t :: (a -> b) (t a) -> t b
+
+ instance fmap ((,)a) where fmap f (a, b) = (a, f b)
+
+ Start = fmap inc (42, 37)