somewhat better

week11-reg/week11_reg_job_edit.icl

+module week11_reg
+
+
+import iTasks => qualified return, >>=, >>|, sequence, forever, :: Set
+
+import Data.Functor, Control.Applicative, Control.Monad, Data.List
+import Data.Tuple
+import qualified Data.Map as Map
+
+instance Functor Sem where
+  fmap f (Sem g) = Sem \s.case g s of
+	  (Res a,s) = (Res (f a), s) 
+	  (Err e,s) = (Err e, s) 
+
+instance <*> Sem where
+  (<*>) (Sem f) (Sem g) = Sem \s.case f s of
+    (Res f, s) = case g s of
+      (Res a,s) = (Res (f a),s)
+      (Err e,s) = (Err e, s) 
+   	(Err e,s) = (Err e, s) 
+
+unres :: (Sem a) -> (State -> (Res a, State))
+unres (Sem f) = f 
+
+instance Monad Sem where // !(m a) (a -> m b) -> m b
+  bind (Sem f) g = Sem \s. case f s of 
+    (Res a, s) = unres (g a) s
+    (Err e,s) = (Err e, s) 
+
+
+instance pure Sem where
+  pure a = Sem \s.(pure a, s)
+
+instance pure Res where
+  pure a = (Res a)
+
+//:: SetA   :== Expression
+//:: Elem  :== Expression
+:: Ident :== String
+
+:: Res a = Res a | Err String
+:: Sem a = Sem (State -> (Res a, State))
+
+:: State = State (Map Ident Val)
+:: Val   = I Int | S [Int]
+
+:: Element :== Sem Int 
+:: Set     :== Sem [Int]
+
+int :: Int -> Element
+int i = pure i
+Size :: Set -> Element
+Size se = fmap length se
+
+instance + Element where
+	(+) a b = (+) <$> a <*> b
+instance + Set where
+	(+) a b = union <$> a <*> b 
+
+instance - Set where
+	(-) a b = difference <$> a <*> b
+instance - Element where
+	(-) a b = (-) <$> a <*> b
+
+instance * Set where
+  (*) a b = intersect <$> a <*> b
+instance * Element where
+	(*) a b = (*) <$> a <*> b
+
+class ==. a where
+	(==.) infix 4 :: !a !a -> Sem Bool
+
+instance ==. Set where
+	(==.) a b = (\x y->difference x y == []) <$> a <*> b
+instance ==. Element where
+	(==.) a b = (==) <$> a <*> b	
+
+If :: (Sem Bool) (Sem a) (Sem b) -> Sem ()
+If cond st1 st2 = cond >>= \bool
+	| bool 		  = st1 >>| pure ()
+	| otherwise = st2 >>| pure ()
+
+// This sucks, surely there is a sane way to do this? 
+For :: Ident Set (Sem a) -> Sem ()
+For i (Sem st) (Sem stmt) = Sem \s. case st s of
+	(Res [a:aa], State s) = case stmt (State ('Map'.put i (I a) s)) of 
+		(Res _, s) = let (Sem f) =  (For i (pure aa) (Sem stmt)) in f s
+		(Err e,s) = (Err e, s) 
+	(Res [],s) = (Res (), s) 
+	(Err e,s) = (Err e, s)
+
+
+While :: (Sem Bool) (Sem a) -> Sem ()
+While cond stmt = cond >>= \x.if x (stmt >>| While cond stmt) (pure ())
+
+(In) infix 4 :: (Element) (Set) -> Sem Bool
+(In) e s = (elem) <$> e <*> s
+
+/*Logical*/
+class =. a where
+	(=.) infixl 2 :: Ident (Sem a) -> (Sem a)
+
+instance =. [Int] where
+	(=.) i (Sem a) = Sem \s. case a s of 
+		(Res ares, State s) = (pure (ares), State ('Map'.put i (S ares) s))
+		(Err e, s) = (Err e, s)
+
+instance =. Int where
+	(=.) i (Sem a) =  Sem \s. case a s of 
+		(Res ares, State s) = (pure (ares), State ('Map'.put i (I ares) s))
+		(Err e, s) = (Err e, s)
+
+fromMaybe :: (Maybe a) -> (Res a)
+fromMaybe (Just a)  = Res a
+fromMaybe (Nothing) = Err "ERROR while getting from state"
+
+class Var a where
+	Var :: Ident -> (Sem a)
+
+instance Var Int where
+	Var i = Sem \(State s)-> case fromMaybe ('Map'.get i s) of
+		(Res (I a)) -> (Res a, State s) 
+		(Err e) -> (Err e, State s)
+
+instance Var [Int] where
+	Var i = Sem \(State s)-> case fromMaybe ('Map'.get i s) of
+		(Res (S a)) -> (Res a, State s)
+		(Err e) -> (Err e, State s)
+
+(<=.) infix 4 :: Element Element -> Sem Bool
+(<=.) e1 e2 = (<=) <$> e1 <*> e2
+
+(||.) infixr 2 :: (Sem Bool) (Sem Bool) -> Sem Bool
+(||.) e1 e2 = (||) <$> e1 <*> e2
+
+(&&.) infixr 2 :: (Sem Bool) (Sem Bool) -> Sem Bool
+(&&.) e1 e2 = (&&) <$> e1 <*> e2
+
+Not :: (Sem Bool) -> (Sem Bool)
+Not s = not <$> s
+
+TRUE :: (Sem Bool)
+TRUE = pure True
+
+FALSE :: (Sem Bool)
+FALSE = pure False
+
+//Start = subtractSet [1,6,23,3,4] [1,5]
+
+//size (Sem sf) = Sem \s ->  ( length sf ,s) // pure (length s)
+
+//  M a p Ident Val,
+
+//:: State = State (Map Ident Val)
+//:: Val = I Int | S [Int]
+emptyState = State 'Map'.newMap
+
+evl :: (Sem a) State -> ((Res a),State)//-> (Res (Either Val Bool),State)
+evl (Sem f) s = f s
+
+
+zoepzoef :: Set
+zoepzoef = pure [1,6,23,3,4]
+zof = int 8 + int 9
+
+
+zofset = pure [1,6,23,3,4] - pure[6]
+
+//zoefs :: (Sem [Int])
+zfl :: Set
+zfl = pure [9,3,2]
+zfr :: (Sem [Int])//Set
+zfr = pure [9,2,3]
+//zoefs = (zfl) ==. (zfr)
+zoefs = "A" =. (zfr)
+//zoefs = int 8 ==. int 8
+zoefss = Var "A" + int 8 //var "A" //pure [1,2,3]
+
+New :: [Int] -> Set
+New s = pure s
+Elem :: Int -> Element
+Elem i = int i
+
+hetProgramma = If (Elem 4 In New [1,2,3]) ("A" =. New [6]) ("B" =. Elem 6)
+
+hetProgramma2 = If (New [4] ==. New [1,2,3]) ("A" =. New [6]) ("B" =. Elem 6)
+hetProgramma3 = If ((Size (New [4])) ==. Elem 1) ("A" =. New [6]) ("B" =. Elem 6)
+hetProgramma4 = Elem 3 In New [7] ||. Elem 8 <=. Elem 7
+
+//Start = equalSet [9,2,3] [9,3,2,1] || equalSet  [9,3,2,1] [9,2,3]
+
+//Start = let ((a,b) = evl zoefs emptyState) in evl zoefss  b
+//Start =  evl zoefss  (snd (evl zoefs emptyState) )
+//Start =  evl (IF (pure True) ("A" =. zfr) ("B" =. zfr) )  emptyState
+//Start =  evl (For "A" (New [1,2,3,8]) (If (Var "A" ==. Elem 3) ("Z" =. Var "A" + Elem 0) (Elem 8)))  emptyState
+
+someSt = State ('Map'.put "A" (I 0) 'Map'.newMap)
+//Start = evl (While (Var "A" <=. Elem 3) ("A" =. (Var "A" + Elem 1))) someSt
+Start = evl (If FALSE ("i" =. int 3) ("g" =. New [1,2,3])) emptyState
+
+
+
+
+
+
+