From: Mart Lubbers <mart@martlubbers.net>
Date: Fri, 30 Oct 2015 19:14:50 +0000 (+0100)
Subject: started with 7, till 1.3 done
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=057b2aa093c75cd0cbf1d99c834bbbd6afe78f2a;p=ap2015.git

started with 7, till 1.3 done
---

diff --git a/a7/mart/skeleton7.icl b/a7/mart/skeleton7.icl
index 50f7e82..4d73431 100644
--- 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