diff options
| -rw-r--r-- | assignment-10/sets.icl | 106 |
1 files changed, 55 insertions, 51 deletions
diff --git a/assignment-10/sets.icl b/assignment-10/sets.icl index de4a62a..ecdcad6 100644 --- a/assignment-10/sets.icl +++ b/assignment-10/sets.icl @@ -32,49 +32,51 @@ hasElem :: (a [a] -> Bool) | Eq a hasElem = isMember :: Expression a - = New (Bimap a [Int]) [Int] - | Elem (Bimap a Int) Int - | E.b: Variable (Bimap a b) Ident - | Size (Bimap a Int) Set - | (+.) infixl 6 (Expression a) (Expression a) & + a - | AddElemAndSet (Bimap a [Int]) Elem Set - | AddSetAndElem (Bimap a [Int]) Set Elem - | (-.) infixl 6 (Expression a) (Expression a) & - a - | RemoveFromSet (Bimap a [Int]) Set Elem - | (*.) infixl 7 (Expression a) (Expression a) & * a - | MulElemAndSet (Bimap a [Int]) Elem Set - | (=.) infixl 2 Ident (Expression a) - - | Logical (Bimap a Bool) Bool - | Not (Bimap a Bool) Logical - | Or (Bimap a Bool) Logical Logical - | And (Bimap a Bool) Logical Logical - | In (Bimap a Bool) Elem Set - | E.b: Eq (Bimap a Bool) (Expression b) (Expression b) & TC, == b - | E.b: Le (Bimap a Bool) (Expression b) (Expression b) & TC, Ord b - - | If Logical (Expression a) (Expression a) - | For (Bimap a [Int]) Ident Set (Expression Int) - | E.b: (:.) infixl 1 (Expression b) (Expression a) & TC b + = E.b: New (Bimap a [b]) [b] + | Elem a + | Variable Ident + | E.b: Size (Bimap a Int) (Set b) & TC b + | (+.) infixl 6 (Expression a) (Expression a) & + a + | E.b: AddElemAndSet (Bimap a [b]) (Elem b) (Set b) & TC, Eq b + | E.b: AddSetAndElem (Bimap a [b]) (Set b) (Elem b) & TC, Eq b + | (-.) infixl 6 (Expression a) (Expression a) & - a + | E.b: RemoveFromSet (Bimap a [b]) (Set b) (Elem b) & TC, Eq b + | (*.) infixl 7 (Expression a) (Expression a) & * a + | E.b: MulElemAndSet (Bimap a [b]) (Elem b) (Set b) & TC, * b + | (=.) infixl 2 Ident (Expression a) + + | Not (Bimap a Bool) (Elem Bool) + | Or (Bimap a Bool) (Elem Bool) (Elem Bool) + | And (Bimap a Bool) (Elem Bool) (Elem Bool) + | E.b: In (Bimap a Bool) (Elem b) (Set b) & TC, Eq b + | E.b: Eq (Bimap a Bool) (Expression b) (Expression b) & TC, Eq b + | E.b: Le (Bimap a Bool) (Expression b) (Expression b) & TC, Ord b + + | If (Elem Bool) (Expression a) (Expression a) + | E.b c: For (Bimap a [b]) Ident (Set c) (Expression b) & TC b & TC c + | E.b: (:.) infixl 1 (Expression b) (Expression a) & TC b // Convenience new :== New bimapId -elem :== Elem bimapId -var :== Variable bimapId +elem :== Elem +var :== Variable size :== Size bimapId for :== For bimapId -(+:) infixl 6; (+:) :== AddSetAndElem bimapId -(:+) infixl 6; (:+) :== AddElemAndSet bimapId -(-:) infixl 6; (-:) :== RemoveFromSet bimapId -(:*) infixl 7; (:*) :== MulElemAndSet bimapId +(+:) infixl 6; (+:) :== AddSetAndElem bimapId +(:+) infixl 6; (:+) :== AddElemAndSet bimapId +(-:) infixl 6; (-:) :== RemoveFromSet bimapId +(:*) infixl 7; (:*) :== MulElemAndSet bimapId +(==.) infix 4; (==.) :== Eq bimapId +(<=.) infix 4; (<=.) :== Le bimapId +(||.) infixr 2; (||.) :== Or bimapId +(&&.) infixr 3; (&&.) :== And bimapId :: SetState :== 'M'.Map Ident Dynamic :: Sem a :== StateT SetState (MaybeError String) a -:: Set :== Expression [Int] -:: Elem :== Expression Int -:: Logical :== Expression Bool +:: Set a :== Expression [a] +:: Elem a :== Expression a :: Ident :== String fail :: (String -> StateT s (MaybeError String) a) @@ -90,28 +92,30 @@ read i = gets ('M'.get i) >>= \v -> case v of Nothing -> fail $ "unknown variable '" <+ i <+ "'" eval :: (Expression a) -> Sem a | TC a -eval (New bm xs) = pure $ bm.map_from xs -eval (Elem bm x) = pure $ bm.map_from x -eval (Variable bm id) = read id -eval (Size bm s) = bm.map_from <$> length <$> eval s -eval (+. x y) = (liftA2 (+) `on` eval) x y +eval (New bm xs) = pure $ bm.map_from xs +eval (Elem x) = pure x +eval (Variable id) = read id +eval (Size bm s) = bm.map_from <$> length <$> eval s +eval (+. x y) = (liftA2 (+) `on` eval) x y eval (AddElemAndSet bm e s) = bm.map_from <$> liftA2 addElem (eval e) (eval s) eval (AddSetAndElem bm s e) = bm.map_from <$> liftA2 addElem (eval e) (eval s) -eval (-. x y) = (liftA2 (-) `on` eval) x y +eval (-. x y) = (liftA2 (-) `on` eval) x y eval (RemoveFromSet bm s e) = bm.map_from <$> liftA2 removeElem (eval e) (eval s) -eval (*. x y) = (liftA2 (*) `on` eval) x y +eval (*. x y) = (liftA2 (*) `on` eval) x y eval (MulElemAndSet bm e s) = bm.map_from <$> liftA2 (map o (*)) (eval e) (eval s) -eval (=. id e) = eval e >>= store id -eval (Logical bm b) = pure $ bm.map_from b -eval (Not bm l) = bm.map_from <$> not <$> eval l -eval (Or bm x y) = bm.map_from <$> (liftA2 (||) `on` eval) x y -eval (And bm x y) = bm.map_from <$> (liftA2 (&&) `on` eval) x y -eval (In bm e s) = bm.map_from <$> liftA2 hasElem (eval e) (eval s) -eval (Eq bm x y) = bm.map_from <$> liftA2 (==) (eval x) (eval y) -eval (Le bm x y) = bm.map_from <$> liftA2 (<=) (eval x) (eval y) -eval (If b t e) = eval b >>= \b -> eval $ if b t e -eval (For bm id s e) = bm.map_from <$> (eval s >>= mapM (\x -> store id x >>| eval e)) -eval (s :. t) = eval s >>| eval t +eval (=. id e) = eval e >>= store id +eval (Not bm l) = bm.map_from <$> not <$> eval l +eval (Or bm x y) = bm.map_from <$> (liftA2 (||) `on` eval) x y +eval (And bm x y) = bm.map_from <$> (liftA2 (&&) `on` eval) x y +eval (In bm e s) = bm.map_from <$> liftA2 hasElem (eval e) (eval s) +eval (Eq bm x y) = bm.map_from <$> liftA2 (==) (eval x) (eval y) +eval (Le bm x y) = bm.map_from <$> liftA2 (<=) (eval x) (eval y) +eval (If b t e) = eval b >>= \b -> eval $ if b t e +eval (For bm id s e) = bm.map_from <$> (eval s >>= iterate e) +where + iterate :: (Elem b) -> [a] -> Sem [b] | TC a & TC b + iterate e = mapM (\x -> store id x >>| eval e) +eval (s :. t) = eval s >>| eval t /** * I did not manage to get the iTasks simulator working, because the compiler |