diff options
| -rw-r--r-- | assignment-9/sets.icl | 146 |
1 files changed, 91 insertions, 55 deletions
diff --git a/assignment-9/sets.icl b/assignment-9/sets.icl index 4f996bd..94beddb 100644 --- a/assignment-9/sets.icl +++ b/assignment-9/sets.icl @@ -25,9 +25,6 @@ from Text import <+, class Text(concat), instance Text String :: SetState :== 'M'.Map Ident Dynamic :: Ident :== String -// Like in the previous assignment: we can also use something like -// :: Sem a = Sem (SetState -> MaybeErrorString (a, SetState)) -// and implement the monad functionality like that of StateT. :: Sem a :== StateT SetState (MaybeError String) a fail :: (String -> Sem a) @@ -51,6 +48,21 @@ eval = flip evalStateT 'M'.newMap :: Print :== [String] -> [String] +pr :: a -> Print | toString a +pr x = \st -> [toString x:st] + +prsperse :: a [b] -> Print | toString a & toString b +prsperse g xs = (++) ('L'.intersperse (toString g) (map toString xs)) + +between :: a Print Print -> Print | toString a +between g x y = x o pr g o y + +surround :: a b Print -> Print | toString a & toString b +surround x y p = pr x o p o pr y + +parens :: (Print -> Print) +parens = surround "(" ")" + // Convenience INT :: (Element -> Element); INT = id SET :: (Set -> Set); SET = id @@ -87,18 +99,18 @@ instance :+ Set Element where :+ = flip (+:) instance :- Set Element where :- = flip $ flip (-) o fmap pure instance *: Element Set where *: = 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]] +instance integer Print where integer = pr +instance set Print where set = \xs -> pr "[" o prsperse "," xs o pr "]" +instance size Print Print where size = surround "size (" ")" -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]]] +instance + Print where + a b = parens (between " + " a b) +instance - Print where - a b = parens (between " - " a b) +instance * Print where * a b = parens (between " * " a b) -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]]] +instance +: Print Print where +: = \a b -> parens (between " +: " a b) +instance :+ Print Print where :+ = \a b -> parens (between " :+ " a b) +instance :- Print Print where :- = \a b -> parens (between " :- " a b) +instance *: Print Print where *: = \a b -> parens (between " *: " a b) // -- Set expressions -- @@ -119,8 +131,8 @@ where instance Variable Print where - variable = \id st -> [id:st] - =. = \id x st -> [id:" =. ":x st] + variable = pr + =. = between " =. " o pr // -- Logical expressions -- @@ -161,61 +173,85 @@ 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]]] + true = pr "true" + false = pr "false" + Not = surround "not (" ")" + (||.) = \a b -> parens (between " ||. " a b) + (&&.) = \a b -> parens (between " ||. " a b) instance Compare Print Print where - ==. = \a b st -> a [" ==. ":b st] - <=. = \a b st -> a [" <=. ":b st] + ==. = between " ==. " + <=. = between " <=. " -instance In Print Print Print where In = \e s st -> e [" in ":s st] +instance In Print Print Print where In = between " in " // -- 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. class If a b :: a b b -> b -class for a b c :: Ident a b -> c +class For a b c :: Ident a b -> c +class (:.) infixl 1 a b :: (a b -> b) 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 -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]]] +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 + +instance :. (Sem a) (Sem b) where :. = (>>|) + +instance If Print Print +where + If b t e = pr "If (" o b o pr ") {" o t o pr "} else {" o e o pr "}" + +instance For Print Print Print +where + For x l b = pr "For " o pr x o pr " in " o l o pr " {" o b o pr "}" -(:.) infixl 1 -(:.) :== (>>|) +instance :. Print Print where :. = between " :. " 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 $ 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 -> 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" +import GenPrint +derive gPrint MaybeError + +// Run with -b +Start = map (\x -> printToString x +++ "\n") + [ print $ integer 5 + , print $ set [1,2,3,4,5] + , print $ size (PRINT (set [1..10])) + , print $ PRINT (set [1..3]) +: PRINT (integer 5 * integer 10) + , print $ "x" =. integer 5 + , print $ factorial PRINT PRINT PRINT 5 + , printToString $ eval $ SET (For "x" (SET (set [0,1,2,3,4])) (variable "x" * INT (integer 5))) + , printToString $ eval $ "y" =. INT (integer 5) :. SET (For "x" (intvar "y") (variable "x" * INT (integer 5))) + , printToString $ eval $ factorial INT SET BOOL 5 + ] + +/** + * @param cast for integers + * @param cast for sets + * @param cast for booleans + * @param integer to compute factorial for + */ +factorial :: (a -> a) (b -> b) (c -> c) Int -> a + | Variable, integer, * a + & :. a a & :. a b & :. b a + & Compare a c + & If c a + & For a a b +factorial castint castset castlog n = + "k" =. castint (integer n) :. + "r" =. castint (integer 1) :. + castset (For "x" (castint (variable "k")) + (If (castlog (castint (variable "x") ==. castint (integer 0))) + (variable "r") // for type-checking + ("r" =. castint (variable "r") * castint (variable "x")))) :. + castint (variable "r") |