Commit 1bb5f845 authored by Job Cuppen's avatar Job Cuppen

somewhat better

parent b7f48832
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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment