diff --git a/week11-reg/week11_reg_job_edit.icl b/week11-reg/week11_reg_job_edit.icl new file mode 100644 index 0000000000000000000000000000000000000000..2f4e2ac9540e7b5170108a30f7d45a45f57860c7 --- /dev/null +++ b/week11-reg/week11_reg_job_edit.icl @@ -0,0 +1,206 @@ +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 + + + + + + +