mijn uitwerking

diff --git a/a1/charlie/skeleton1.icl b/a1/charlie/skeleton1.icl
new file mode 100755 (executable)
index 0000000..3a5e8d4
--- /dev/null
+++ b/a1/charlie/skeleton1.icl
@@ -0,0 +1,213 @@
+/* assignment 1
+ *
+ * Charlie Gerhardus, s3050009
+ * Mart Lubbers s4109503
+ */
+
+module skeleton1
+
+/*
+       Course I00032 Advanced Programming 2014
+       Skeleton for assignment 1
+       Pieter Koopman
+*/
+
+import StdEnv
+
+/**************** 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 [] ]
+
+/* our two comparison lists */
+cmp1 :: [Ordering]
+cmp1 = [[1..3] >< [1..2], [1..2] >< [1..5], (1,2) >< (1,2), (1,3) >-< (1,2), Red >< Yellow, Yellow >< Blue, tree1 >< tree1, tree1 >< tree2, tree2 >< tree1, rose1 >< rose1, rose1 >< rose2, rose2 >< rose1]
+cmp2 :: [Ordering]
+cmp2 = [[1..3] >-< [1..2], [1..2] >-< [1..5], (1,2) >-< (1,2), (1,3) >-< (1,2), Red >-< Yellow, Yellow >-< Blue, tree1 >-< tree1, tree1 >-< tree2, tree2 >-< tree1, rose1 >-< rose1, rose1 >-< rose2, rose2 >-< rose1]
+
+/* entry point */
+Start = ([cmp1, cmp2], cmp1 == cmp2)