started with 7, till 1.3 done

diff --git a/a7/mart/skeleton7.icl b/a7/mart/skeleton7.icl
index 50f7e82..4d73431 100644 (file)
--- a/a7/mart/skeleton7.icl
+++ b/a7/mart/skeleton7.icl
@@ -1,39 +1,14 @@
 module skeleton7
 
-from iTasks import always,
-       hasValue,
-       :: TaskValue(..),
-       :: Task,
-       :: Stability,
-       :: TaskCont(..),
-       :: Action,
-       updateInformation,
-       viewInformation,
-       class descr,
-       instance descr String,
-       :: UpdateOption,
-       :: ViewOption(..),
-       -||-,
-       -||,
-       ||-,
-       startEngine,
-       class Publishable,
-       >>*,
-       class TFunctor,
-       instance TFunctor Task,
-       class TApplicative,
-       instance TApplicative Task,
-       instance Publishable Task,
-       Void
-import Data.Tuple,
-       StdClass,
-       StdList,
-       iTasks._Framework.Generic,
-       Text.JSON,
-       Data.Functor,
-       Control.Applicative,
-       Control.Monad,
-       Data.Map
+from iTasks import 
+       always, hasValue, :: TaskValue(..), :: Task, :: Stability,
+       :: TaskCont(..), :: Action, updateInformation, viewInformation, 
+       class descr, instance descr String, :: UpdateOption, :: ViewOption(..),
+       -||-, -||, ||-, startEngine, class Publishable, >>*, class TFunctor,
+       instance TFunctor Task, class TApplicative, instance TApplicative Task,
+       instance Publishable Task, Void
+import Data.Tuple, StdClass, StdList, iTasks._Framework.Generic, Text.JSON,
+       Data.Functor, Control.Applicative, Control.Monad, Data.Map, Data.Either
 import qualified iTasks
 import qualified Text
 from Text import class Text, instance Text String
@@ -64,6 +39,33 @@ e = Insert New (Oper New +. (Union (Integer 7) (Size (Integer 9))))
 :: Val = Int Int | Set Set
 :: State :== Map String Val
 
+:: Sem a = Sem (State -> (Either String a, State)) 
+
+unsem :: (Sem a) -> (State -> (Either String a, State))
+unsem (Sem a) = a
+
+instance Functor Sem where
+       fmap f s = Sem \st.let (a, st`)=unsem s st in (fmap f a, st`)
+
+instance Applicative Sem where
+       pure s = Sem \st.(pure s, st)
+       (<*>) a f = ap a f
+
+instance Monad Sem where
+       bind (Sem s) f = Sem \st.case s st of
+               (Right v, st`) = unsem (f v) st`
+               (Left e, st`) = (Left e, st`)
+
+store :: Ident Val -> Sem Val
+store i v = Sem \st.(pure v, put i v st)
+
+read :: Ident -> Sem Val
+read i = Sem \st.case get i st of
+               (Just v) = (Right v, st)
+               _ = unsem (fail "variable not found") st
+
+fail :: String -> Sem a
+fail s = Sem \st.(Left s,st)
 
 // === semantics