/* assignment 1 * * Charlie Gerhardus, s3050009 * Mart Lubbers, s4109503 */ /* awnsers to questions * * 2.3, [1, 2, 3] has the full generic representation PAIR 1 (PAIR 2 3) * the >-< operator converts the second PAIR on the fly so the initial generic representation * returned by fromList [1, 2, 3] = PAIR 1 [2, 3]. * * 2.4, Its possible to define a class for a generic conversion function: * * class toGen a b :: a -> b * * For every type we want to convert we need to create a instance: * * instance toGen [a] (ListG a) where * toGen x = fromList x * instance toGen (Tree a) (TreeG a) where * toGen x = fromTree x * .... * * Which results in the same code as can be seen later in the assignment, the difference * is that instead of a multitude of different functions (fromList, fromTree...) we end up * with a lot of overloaded functions. * * 3.2, yes the results are identical. This can be verified by compile and running this module. * * 3.3, when we define a new datastructure and provide a function that converts it into a generic * representation we can use our ordering operator on it right away. If we define more operators * for our generic representation we dont have to provide a sepperate implementation of these operators for * every datastructure we introduce. * * 3.4, since we are rewriting the whole datastructure before we can use the operator the programm can * potentionally use more memory and result in more instructions that take care of the conversion. * */ module skeleton1 /* Course I00032 Advanced Programming 2014 Skeleton for assignment 1 Pieter Koopman */ import StdEnv import StdFile /**************** Prelude: *******************************/ // Example types :: Color = Red | Yellow | Blue :: Tree a = Tip | Bin a (Tree a) (Tree a) :: Rose a = Rose a [Rose a] // Binary sums and products (in generic prelude) :: UNIT = UNIT :: PAIR a b = PAIR a b :: EITHER a b = LEFT a | RIGHT b // Generic type representations :: RoseG a :== PAIR a [Rose a] // Conversions fromRose :: (Rose a) -> RoseG a fromRose (Rose a l) = PAIR a l // Oerdering :: Ordering = Smaller | Equal | Bigger class (><) infix 4 a :: !a !a -> Ordering instance >< Int where // Standard ordering for Int (><) x y | x < y = Smaller | x > y = Bigger | otherwise = Equal instance >< Char where // Standard ordering for Char (><) x y | x < y = Smaller | x > y = Bigger | otherwise = Equal instance >< String where // Standard lexicographical ordering (><) x y | x < y = Smaller | x > y = Bigger | otherwise = Equal instance >< Bool where // False is smaller than True (><) False True = Smaller (><) True False = Bigger (><) _ _ = Equal /**************** End Prelude *************************/ /* compare ordering */ instance == Ordering where (==) Equal Equal = True (==) Smaller Smaller = True (==) Bigger Bigger = True (==) _ _ = False /* color to rgb encoding * * Blue = 0x0000FF * Red = 0xFF0000 * Yellow = 0xFFFF00 */ color2RGB :: Color -> Int color2RGB Blue = 0x0000FF color2RGB Red = 0xFF0000 color2RGB Yellow = 0xFFFF00 /* list operator instance */ instance >< [a] | >< a where (><) [] [] = Equal (><) _ [] = Bigger (><) [] _ = Smaller (><) [x:xs] [y:ys] | ( (x >< y) == Equal ) = xs >< ys | otherwise = x >< y /* tuple operator */ instance >< (a, b) | >< a & >< b where (><) (x1, y1) (x2, y2) | ( (x1 >< x2) == Equal ) = y1 >< y2 | otherwise = x1 >< x2 /* color comparison */ instance >< Color where (><) x y = color2RGB x >< color2RGB y /* tree comparison */ instance >< (Tree a) | >< a where (><) Tip Tip = Equal (><) _ Tip = Bigger (><) Tip _ = Smaller (><) (Bin x xl xr) (Bin y yl yr) | ( (x >< y) == Equal ) = (xl, xr) >< (yl, yr) | otherwise = x >< y /* rose comparison */ instance >< (Rose a) | >< a where (><) (Rose x xs) (Rose y ys) = (x, xs) >< (y , ys) /* we take >-< as the generic ordering operator */ class (>-<) infix 4 a :: !a !a -> Ordering /* instances for Int, Char, String and Bool * * instance >-< Int Char String Bool where * (>-<) x y = x >< y * * not possible? */ instance >-< Int where (>-<) x y = x >< y instance >-< Char where (>-<) x y = x >< y instance >-< String where (>-<) x y = x >< y instance >-< Bool where (>-<) x y = x >< y /* for unit */ instance >-< UNIT where (>-<) UNIT UNIT = Equal /* for pair */ instance >-< (PAIR a b) | >-< a & >-< b where (>-<) (PAIR x1 x2) (PAIR y1 y2) | ( (x1 >-< y1) == Equal ) = x2 >-< y2 | otherwise = x1 >-< y1 /* for either */ instance >-< (EITHER a b) | >-< a & >-< b where (>-<) (LEFT x) (LEFT y) = x >-< y (>-<) (RIGHT x) (RIGHT y) = x >-< y (>-<) (LEFT _) (RIGHT _) = Bigger (>-<) (RIGHT _) (LEFT _) = Smaller /* generic representations */ :: ColorG :== EITHER (EITHER UNIT UNIT) UNIT :: ListG a :== EITHER (PAIR a [a]) UNIT :: TupleG a b :== PAIR a b :: TreeG a :== EITHER ( PAIR a ( TupleG (Tree a) (Tree a) ) ) UNIT /* convert color to generic representation */ fromColor :: Color -> ColorG fromColor Yellow = LEFT (LEFT UNIT) fromColor Red = LEFT (RIGHT UNIT) fromColor Blue = RIGHT UNIT /* convert list to generatic representation */ fromList :: [a] -> ListG a fromList [] = RIGHT UNIT fromList [x:xs] = LEFT (PAIR x xs) /* convert tuple to generic representation */ fromTuple :: (a, b) -> TupleG a b fromTuple (x, y) = PAIR x y /* convert tree to generic representation */ fromTree :: (Tree a) -> TreeG a fromTree Tip = RIGHT UNIT fromTree (Bin x l r) = LEFT ( PAIR x ( fromTuple (l, r) ) ) /* generic conversion for >-< operator */ instance >-< Color where (>-<) x y = fromColor x >-< fromColor y instance >-< (a, b) | >-< a & >-< b where (>-<) x y = fromTuple x >-< fromTuple y instance >-< [a] | >-< a where (>-<) x y = fromList x >-< fromList y instance >-< (Rose a) | >-< a where (>-<) x y = fromRose x >-< fromRose y instance >-< (Tree a) | >-< a where (>-<) x y = fromTree x >-< fromTree y /* test trees */ tree1 :: Tree Int tree1 = Bin 1 (Bin 5 Tip Tip) (Bin 6 Tip Tip) tree2 :: Tree Int tree2 = Bin 1 (Bin 5 Tip Tip) (Bin 8 Tip Tip) /* test roses */ rose1 :: Rose Int rose1 = Rose 2 [ Rose 1 [], Rose 2 [], Rose 5 [] ] rose2 :: Rose Int rose2 = Rose 2 [ Rose 1 [], Rose 2 [], Rose 8 [] ] /* apply a ordering operator on two values */ order :: (a a -> Ordering) (a, a) -> Ordering order f (x, y) = f x y /* order a list */ orderList :: (a a -> Ordering) [ (a, a) ] -> [Ordering] orderList f [] = [] orderList f [x:xs] = [ order f x : orderList f xs ] /* tests to perform */ orderSetLists = [([1..3], [1..2]), ([1..2], [1..5]), ([1..2], [1..2])] orderSetTuples = [((1,3), (1,2)), ((1,2), (1,3)), ((1,2),(1,2))] orderSetColors = [(Yellow, Blue), (Blue, Yellow), (Red, Red)] orderSetRoses = [(rose2, rose1), (rose1, rose2), (rose1, rose1)] orderSetTrees = [(tree2, tree1), (tree1, tree2), (tree1, tree1)] /* perform orderings */ test1 = orderList (><) orderSetLists ++ orderList (><) orderSetTuples ++ orderList (><) orderSetLists ++ orderList (><) orderSetRoses ++ orderList (><) orderSetTrees test2 = orderList (>-<) orderSetLists ++ orderList (>-<) orderSetTuples ++ orderList (>-<) orderSetLists ++ orderList (>-<) orderSetRoses ++ orderList (>-<) orderSetTrees /* ordering file output */ instance <<< Ordering where (<<<) file Equal = file <<< "Equal" (<<<) file Bigger = file <<< "Bigger" (<<<) file Smaller = file <<< "Smaller" /* ordering list file output */ instance <<< [Ordering] where (<<<) file [] = file (<<<) file [x:xs] = file <<< x <<< " " <<< xs /* there is no file <<< Bool instance? */ instance <<< Bool where (<<<) file True = file <<< "True" (<<<) file False = file <<< "False" /* entry point */ Start :: !*World -> *World Start world # (file, world) = stdio world # file = file <<< "Test results for ><:\n" # file = file <<< "[" <<< test1 <<< "]\n\n" # file = file <<< "Test results for >-<:\n" # file = file <<< "[" <<< test2 <<< "]\n\n" # file = file <<< "(test1 == test2) = " <<< (test1 == test2) <<< "\n\n" # (ok, world) = fclose file world | otherwise = world