From a1d6b4e143193673a6aa60f18d7b27f8e7fb40e6 Mon Sep 17 00:00:00 2001 From: Reg Huijben Date: Mon, 9 Dec 2019 17:05:34 +0100 Subject: [PATCH] Expressions --- week11-reg/week11_reg.icl | 229 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 229 insertions(+) create mode 100644 week11-reg/week11_reg.icl diff --git a/week11-reg/week11_reg.icl b/week11-reg/week11_reg.icl new file mode 100644 index 0000000..812779b --- /dev/null +++ b/week11-reg/week11_reg.icl @@ -0,0 +1,229 @@ +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]//('iTasks'.Set 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 + (+) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (ares+bres),s) + e = e + e = e + +/*instance + Set where + (+) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (union ares bres),s) + e = e + e = e +*/ + +instance + Set where + (+) a b = (union) <$> a <*> b + +instance - Element where + (-) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (ares-bres),s) + e = e + e = e + +instance - Set where + (-) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (subtractSet ares bres),s) + e = e + e = e + +instance * Element where + (*) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (ares * bres),s) + e = e + e = e + + +instance * Set where + (*) a b = intersect <$> a <*> b + +class ==. a where + (==.) infix 4 :: !a !a -> Sem Bool + +instance ==. Set where + (==.) a b = (equalSet) <$> a <*> b + + +instance ==. Element where + (==.) a b = (==) <$> a <*> b + + + +/*Logical + +iif :: Logical Statement Statement -> Bool +iif log st1 st2 = False +*/ +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)) + //(Res ares,s) = case b s of + // (Res bres, s) = (pure (ares * bres),s) + // e = e + (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) + + + +//(=.) i v = Sem \(State s). (pure v, State ('Map'.put i v s)) + + +class Var a where + var :: Ident -> (Sem a) + +instance Var Int where + var i = Sem \(State s) . case ('Map'.get i s) of + (Just a) -> case a of + (I i) = (pure i, State s) + (S st) = (Err ("Expected int, found set " +++ (toString st)), State s ) + _ -> (Err ("Could not find variable " +++ i), State s ) + +instance Var [Int] where + var i = Sem \(State s) . case ('Map'.get i s) of + (Just a) -> case a of + (I i) = (Err ("Expected set, found int " +++ (toString i)), State s ) + (S st) = (pure st, State s) + _ -> (Err ("Could not find variable " +++ i), State s ) + + + //(==.) infixr 3 :: Set Set -> Sem Bool +//(==.) a b = (equalSet) <$> a <*> b + +/* +(==.) infixr 3 :: Set Set -> Sem Bool +(==.) a b = (equalSet) <$> a <*> b + +(==.) infixr 3 :: Element Element -> Sem Bool +(==.) a b = (==) <$> a <*> b +*/ + +/*(+.) (Sem a) (Sem b) = Sem \s. case a s of + (Res ares,s) = case b s of + (Res bres, s) = (pure (if (elem bres ares) ares ([bres:ares])) ,s) // + (Err e,s) = (Err e, s) + (Err e,s) = (Err e, s) +*/ + + +//(+.) infixr 3 :: Set Element -> Set +//(+.) a b = (\ares bres .( (if (elem bres ares) ares ([bres:ares])) )) <$> a <*> b + + +//(-.) infixr 3 :: Set Element -> Set +//(-.) a b = (\st elm .( (if (elem elm st) (delete elm st) (st)) )) <$> a <*> b + + +subtractSet a b = foldr (\e s. delete e s) a b + +equalSet :: [a] [a] -> Bool | == a +equalSet aset bset = foldr (\a b . (elem a aset) && b) True bset && foldr (\a b . (elem a bset) && b) True aset + //foldr (\a b. a && (elem b aset )) aset bset //foldr (\a b. (a && elem b)) a b + + +//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 vl s = let (Sem f) = vl in f s +//evl :: Stmt State -> (Res (Either Val Bool),State) +//evl e s = let (Sem f) = (stmteval e) in 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" + var "A" //pure [1,2,3] + +//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) ) \ No newline at end of file -- GitLab