diff options
Diffstat (limited to 'assignment-9')
| -rw-r--r-- | assignment-9/sets.icl | 204 |
1 files changed, 138 insertions, 66 deletions
diff --git a/assignment-9/sets.icl b/assignment-9/sets.icl index e545687..4f996bd 100644 --- a/assignment-9/sets.icl +++ b/assignment-9/sets.icl @@ -2,7 +2,7 @@ module sets import StdBool import StdEnum -from StdFunc import const, flip, o +from StdFunc import const, flip, id, o import StdList import StdOrdList import StdOverloaded @@ -18,7 +18,7 @@ import qualified Data.List as L from Data.List import instance Functor [] import qualified Data.Map as M import Data.Maybe -from Text import <+ +from Text import <+, class Text(concat), instance Text String // It's been a long time since I worked with dynamics so I thought it would be // nice to do that again. @@ -42,20 +42,37 @@ read id type = gets ('M'.get id) >>= \v -> case v of Just d -> fail $ "Expected " <+ type <+ " for '" <+ id <+ "'; got " <+ typeCodeOfDynamic d Nothing -> fail $ "Unknown variable '" <+ id <+ "'" +eval :: ((Sem a) -> MaybeError String a) +eval = flip evalStateT 'M'.newMap + :: Element :== Sem Int :: Set :== Sem [Int] :: Logical :== Sem Bool +:: Print :== [String] -> [String] + +// Convenience +INT :: (Element -> Element); INT = id +SET :: (Set -> Set); SET = id +BOOL :: (Logical -> Logical); BOOL = id +PRINT :: (Print -> Print); PRINT = id +intvar :: (String -> Element); intvar = variable +setvar :: (String -> Set); setvar = variable + // -- Integer expressions -- -integer :: (Int -> Element) -integer = pure +class integer a :: (Int -> a) +class set a :: ([Int] -> a) +class size a b :: (a -> b) -set :: ([Int] -> Set) -set = pure +class (+:) infixl 6 a b :: (a b -> b) +class (:+) infixl 6 a b :: (a b -> a) +class (:-) infixl 6 a b :: (a b -> a) +class (*:) infixl 7 a b :: (a b -> b) -size :: (Set -> Element) -size = fmap length +instance integer Element where integer = pure +instance set Set where set = pure +instance size Set Element where size = fmap length instance + Element where + a b = liftA2 (+) a b instance - Element where - a b = liftA2 (-) a b @@ -65,85 +82,140 @@ instance + Set where + a b = liftA2 'L'.union a b instance - Set where - a b = liftA2 'L'.difference a b instance * Set where * a b = liftA2 'L'.intersect a b -(+:) infixl 6 :: (Element Set -> Set); (+:) = (+) o fmap pure -(:+) infixl 6 :: (Set Element -> Set); (:+) = flip (+:) +instance +: Element Set where +: = (+) o fmap pure +instance :+ Set Element where :+ = flip (+:) +instance :- Set Element where :- = flip $ flip (-) o fmap pure +instance *: Element Set where *: = liftA2 $ map o (*) -(:-) infixl 6 :: (Set Element -> Set); (:-) = flip $ flip (-) o fmap pure -(*:) infixl 6 :: (Element Set -> Set); (*:) = liftA2 $ map o (*) +instance integer Print where integer = \i st -> ["integer ":toString i:st] +instance set Print where set = \xs st -> ["set [":'L'.intersperse "," (map toString xs)] ++ ["]":st] +instance size Print Print where size = \s st -> ["size (":s [")":st]] -eval :: ((Sem a) -> MaybeError String a) -eval = flip evalStateT 'M'.newMap +instance + Print where + a b = \st -> ["(":a [" + ":b [")":st]]] +instance - Print where - a b = \st -> ["(":a [" - ":b [")":st]]] +instance * Print where * a b = \st -> ["(":a [" * ":b [")":st]]] -// -- Set expressions -- +instance +: Print Print where +: = \a b st -> ["(":a [" +: ":b [")":st]]] +instance :+ Print Print where :+ = \a b st -> ["(":a [" :+ ":b [")":st]]] +instance :- Print Print where :- = \a b st -> ["(":a [" :- ":b [")":st]]] +instance *: Print Print where *: = \a b st -> ["(":a [" *: ":b [")":st]]] -class variable a :: (String -> a) +// -- Set expressions -- -instance variable Element where variable = flip read "Int" -instance variable Set where variable = flip read "[Int]" +class Variable a +where + variable :: (String -> a) + (=.) infix 2 :: (Ident a -> a) -// Convenience -intvar :: (String -> Element); intvar = variable -setvar :: (String -> Set); setvar = variable +instance Variable Element +where + variable = flip read "Int" + =. = (=<<) o store -class (=.) infix 2 a :: (Ident a -> a) +instance Variable Set +where + variable = flip read "[Int]" + =. = (=<<) o store -instance =. Element where =. = (=<<) o store -instance =. Set where =. = (=<<) o store +instance Variable Print +where + variable = \id st -> [id:st] + =. = \id x st -> [id:" =. ":x st] // -- Logical expressions -- -true :: Logical -true = pure True - -false :: Logical -false = pure False - -(In) infix :: (Element Set -> Logical) -(In) = liftA2 isMember - -class (==.) infix 4 a :: (a a -> Logical) -instance ==. Element where ==. = liftA2 (==) -instance ==. Set where ==. = liftA2 ((==) `on` sort) - -class (<=.) infix 4 a :: (a a -> Logical) -instance <=. Element where <=. = liftA2 (<=) -instance <=. Set where <=. = liftA2 (flip (all o flip isMember)) - -Not :: (Logical -> Logical) -Not = fmap not - -(||.) infixr 2 :: (Logical Logical -> Logical) -(||.) = liftA2 (||) - -(&&.) infixr 3 :: (Logical Logical -> Logical) -(&&.) = liftA2 (&&) +class Logic a +where + true :: a + false :: a + Not :: (a -> a) + (||.) infixr 2 :: (a a -> a) + (&&.) infixr 3 :: (a a -> a) + +class Compare a b +where + (==.) infix 4 :: (a a -> b) + (<=.) infix 4 :: (a a -> b) + +class (In) infix a b c :: (a b -> c) + +instance Logic Logical +where + true = pure True + false = pure False + Not = fmap not + (||.) = liftA2 (||) + (&&.) = liftA2 (&&) + +instance Compare Element Logical +where + ==. = liftA2 (==) + <=. = liftA2 (<=) + +instance Compare Set Logical +where + ==. = liftA2 ((==) `on` sort) + <=. = liftA2 (flip (all o flip isMember)) + +instance In Element Set Logical where In = liftA2 isMember + +instance Logic Print +where + true = \st -> ["true":st] + false = \st -> ["false":st] + Not = \b st -> ["not (":b [")":st]] + (||.) = \a b st -> ["(":a [" ||. ": b [")":st]]] + (&&.) = \a b st -> ["(":a [" &&. ": b [")":st]]] + +instance Compare Print Print +where + ==. = \a b st -> a [" ==. ":b st] + <=. = \a b st -> a [" <=. ":b st] + +instance In Print Print Print where In = \e s st -> e [" in ":s st] // -- Statements -- // The Expression and Logical from last week are not needed; we can just use // Sem Int, Sem [Int] and Sem Bool in the same pipeline. -If :: Logical (Sem a) (Sem a) -> Sem a -If b t e = b >>= \b -> if b t e +class If a b :: a b b -> b +class for a b c :: Ident a b -> c + +instance If Logical (Sem a) where If b t e = b >>= \b -> if b t e +instance for Set Element Set where for k xs body = xs >>= mapM (flip (>>|) body o store k) +instance for Element Element Set where for k n body = n >>= \n -> for k (SET (set [0..n-1])) body -class for a :: Ident a Element -> Set -instance for Set where for k xs body = xs >>= mapM (flip (>>|) body o store k) -instance for Element where for k n body = n >>= \n -> for k (set [0..n-1]) body +instance If Print Print where If b t e = \st -> ["if (":b [") {":t ["} else {":e ["}":st]]]] +instance for Print Print Print where for x l b = \st -> ["for ":x:" in ":l [" {":b ["}":st]]] (:.) infixl 1 (:.) :== (>>|) +print :: ([String] -> [String]) -> String +print f = concat (f []) + +//Start = +// ( "\n", print $ integer 5 +// , "\n", print $ set [1,2,3,4,5] +// , "\n", print $ size (PRINT (set [1..10])) +// , "\n", print $ PRINT (set [1..3]) +: PRINT (integer 5 * integer 10) +// , "\n", print $ "x" =. integer 5 +// , "\n", print $ factorial 5 +// , "\n" +// ) + Start = - ( "\n", eval $ for "x" (set [0,1,2,3,4]) (variable "x" * integer 5) - , "\n", eval $ "y" =. integer 5 :. for "x" (intvar "y") (variable "x" * integer 5) - , "\n", eval $ factorial 5 + ( "\n", eval $ SET (for "x" (SET (set [0,1,2,3,4])) (variable "x" * INT (integer 5))) + , "\n", eval $ "y" =. INT (integer 5) :. SET (for "x" (intvar "y") (variable "x" * INT (integer 5))) + //, "\n", eval $ factorial 5 , "\n") -factorial :: Int -> Element -factorial n = - "k" =. integer n :. - "r" =. integer 1 :. - for "x" (intvar "k") - (If (variable "x" ==. integer 0) - (variable "r") // for type-checking - ("r" =. variable "r" * variable "x")) :. - variable "r" +//factorial :: Int -> a b +//factorial n = +// "k" =. integer n :. +// "r" =. integer 1 :. +// for "x" (variable "k") +// (If (variable "x" ==. integer 0) +// (variable "r") // for type-checking +// ("r" =. variable "r" * variable "x")) :. +// variable "r" |