--- /dev/null
+/* assignment 2\r
+ *\r
+ * Charlie Gerhardus, s3050009\r
+ * Mart Lubbers, s4109503\r
+ */\r
+\r
+module skeleton2\r
+\r
+/*\r
+ Skeleton for Exercise 2 of Advanced Programming.\r
+ Works fine with the environment Everything, but you can also use \r
+ StdEnv and manually add StdMaybe from the directory {Application}\Libraries\StdLib.\r
+ \r
+ Pieter Koopman, 2013\r
+*/\r
+\r
+import StdEnv, StdMaybe\r
+\r
+/**************** Prelude *************************/\r
+\r
+// Binary sums and products (in generic prelude)\r
+:: UNIT = UNIT\r
+:: PAIR a b = PAIR a b\r
+:: EITHER a b = LEFT a | RIGHT b\r
+:: CONS a = CONS String a\r
+\r
+// Generic type representations\r
+:: ListG a :== EITHER (CONS UNIT) (CONS (PAIR a [a]))\r
+:: TreeG a :== EITHER (CONS UNIT) (CONS (PAIR a (PAIR (Tree a) (Tree a))))\r
+:: TupG a b :== CONS (PAIR a b)\r
+:: TG :== CONS UNIT\r
+\r
+// Conversions\r
+fromList :: [a] -> ListG a\r
+fromList [] = LEFT (CONS "Nil" UNIT)\r
+fromList [a:as] = RIGHT (CONS "Cons" (PAIR a as))\r
+\r
+toList :: (ListG a) -> [a]\r
+toList (LEFT (CONS "Nil" UNIT)) = []\r
+toList (RIGHT (CONS "Cons" (PAIR a as))) = [a:as]\r
+\r
+/**************** End Prelude *************************/\r
+\r
+/**************** Part 1 *******************************/\r
+\r
+:: Tree a = Tip | Bin (Tree a) a (Tree a)\r
+\r
+class Container t\r
+where\r
+ Cinsert :: a (t a) -> t a | < a\r
+ Ccontains :: a (t a) -> Bool | <, Eq a\r
+ Cshow :: (t a) -> [String] | toString a\r
+ Cnew :: t a\r
+\r
+// unsorted list container\r
+instance Container [] \r
+where\r
+ Cinsert x y = [x] ++ y\r
+ Ccontains x [y:ys] | x == y = True\r
+ | otherwise = Ccontains x ys\r
+ Ccontains _ [] = False\r
+ Cshow [x:xs] = [toString x] ++ Cshow xs\r
+ Cshow [] = []\r
+ Cnew = []\r
+\r
+// unbalanced binairy search tree\r
+instance Container Tree \r
+where\r
+ Cinsert x Tip = Bin Tip x Tip\r
+ Cinsert x (Bin l y r) | x < y = Bin (Cinsert x l) y r\r
+ | otherwise = Bin l y (Cinsert x r)\r
+ Ccontains _ Tip = False\r
+ Ccontains x (Bin l y r) | x == y = True\r
+ | x < y = Ccontains x l\r
+ | otherwise = Ccontains x r\r
+ Cshow Tip = []\r
+ Cshow (Bin l x r) = Cshow l ++ [toString x] ++ Cshow r\r
+ Cnew = Tip\r
+\r
+//list test:\r
+list_container :: [Int]\r
+list_container = Cinsert 3 (Cinsert 12 (Cinsert 8 Cnew))\r
+list_test = (Ccontains 3 list_container,Cshow list_container)\r
+\r
+//tree test:\r
+tree_container :: Tree Int\r
+tree_container = Cinsert 3 (Cinsert 12 (Cinsert 8 Cnew))\r
+tree_test = (Ccontains 3 tree_container,Cshow tree_container)\r
+\r
+//Start = [list_test, tree_test]\r
+\r
+/**************** Part 3 *******************************/\r
+\r
+/* convert tuple to generic representation */\r
+fromTuple :: (a, b) -> TupG a b\r
+fromTuple (x, y) = CONS "Tuple" (PAIR x y)\r
+\r
+toTuple :: (TupG a b) -> (a, b)\r
+toTuple (CONS "Tuple" (PAIR x y)) = (x, y)\r
+\r
+/* convert tree to generic representation */\r
+fromTree :: (Tree a) -> TreeG a\r
+fromTree Tip = LEFT (CONS "Tip" UNIT)\r
+fromTree (Bin l x r) = RIGHT ( CONS "Bin" ( PAIR x ( PAIR l r ) ) )\r
+\r
+toTree :: (TreeG a) -> (Tree a)\r
+toTree (LEFT (CONS "Tip" UNIT)) = Tip\r
+toTree (RIGHT (CONS "Bin" (PAIR x (PAIR l r)))) = Bin l x r\r
+\r
+// Example types\r
+show :: a -> [String] | show_ a\r
+show a = show_ a []\r
+\r
+class show_ a where show_ :: a [String] -> [String]\r
+\r
+instance show_ Int where show_ i c = ["Int" : toString i : c]\r
+instance show_ Bool where show_ b c = ["Bool" : toString b : c]\r
+\r
+instance show_ UNIT where \r
+ show_ _ c = ["UNIT" : c]\r
+\r
+instance show_ (PAIR a b) | show_ a & show_ b where \r
+ show_ (PAIR x y) c = ["PAIR":show_ x (show_ y c)]\r
+\r
+instance show_ (EITHER a b) | show_ a & show_ b where\r
+ show_ (LEFT x) c = ["LEFT":show_ x c]\r
+ show_ (RIGHT x) c = ["RIGHT":show_ x c]\r
+\r
+instance show_ (CONS a) | show_ a where \r
+ show_ (CONS n x) c = ["CONS":n:show_ x c]\r
+\r
+instance show_ [a] | show_ a where\r
+ show_ x c = show_ (fromList x) c\r
+\r
+instance show_ (Tree a) | show_ a where \r
+ show_ x c = show_ (fromTree x) c\r
+\r
+instance show_ (a, b) | show_ a & show_ b where\r
+ show_ x c = show_ (fromTuple x) c\r
+\r
+/**************** Part 4 *******************************/\r
+:: Result a = Fail | Match a [String]\r
+class parse a :: [String] -> Result a\r
+\r
+instance parse Int where\r
+ parse ["Int",i : r] = Match (toInt i) r\r
+ parse _ = Fail\r
+instance parse Bool where\r
+ parse ["Bool",b : r] = Match (b=="True") r\r
+ parse _ = Fail\r
+instance parse UNIT where\r
+ parse ["UNIT" : r] = Match UNIT r\r
+ parse _ = Fail\r
+\r
+instance parse (PAIR a b) | parse a & parse b where\r
+ parse ["PAIR" : r] = Match (PAIR x y) t where\r
+ (Match y t) = parse s;\r
+ (Match x s) = parse r\r
+ parse _ = Fail\r
+\r
+instance parse (EITHER a b) | parse a & parse b where\r
+ parse ["LEFT":r] = Match (LEFT x) s where\r
+ (Match x s) = parse r\r
+ parse ["RIGHT":r] = Match (RIGHT y) s where\r
+ (Match y s) = parse r\r
+ parse _ = Fail\r
+\r
+instance parse (CONS a) | parse a where\r
+ parse ["CONS",n:r] = cons n (parse r) where\r
+ cons n (Match x s) = Match (CONS n x) s\r
+\r
+instance parse [a] | parse a where\r
+ parse r = list (parse r) where\r
+ list (Match x s) = Match (toList x) s\r
+\r
+instance parse (a, b) | parse a & parse b where\r
+ parse r = tuple (parse r) where\r
+ tuple (Match x s) = Match (toTuple x) s\r
+\r
+instance parse (Tree a) | parse a where\r
+ parse r = tree (parse r) where\r
+ tree (Match x s) = Match (toTree x) s\r
+ \r
+:: T = C\r
+\r
+tuple_text = show (8, 9)\r
+tuple_parse :: (Int, Int)\r
+tuple_parse = tuple (parse tuple_text) where\r
+ tuple (Match x s) = x\r
+\r
+list_text = show [1, 2, 3, 112]\r
+list_parse :: [Int]\r
+list_parse = list (parse list_text) where\r
+ list (Match x s) = x\r
+\r
+tree_data :: Tree Int\r
+tree_data = Cinsert 8 (Cinsert 12 (Cinsert 5 (Cinsert 11 Cnew)))\r
+tree_text = show tree_data\r
+tree_parse :: (Tree Int)\r
+tree_parse = tree (parse tree_text) where\r
+ tree (Match x s) = x\r
+\r
+instance <<< [a] | <<< a where\r
+ (<<<) file [x:xs] = (list_print (file <<< "[" <<< x) xs) <<< "]"\r
+\r
+list_print :: !*File [a] -> *File | <<< a\r
+list_print file [x:xs] = list_print (file <<< ", " <<< x) xs\r
+list_print file [] = file\r
+\r
+instance <<< (a, b) | <<< a & <<< b where\r
+ (<<<) file (x, y) = file <<< "(" <<< x <<< ", " <<< y <<< ")"\r
+\r
+instance <<< (Tree a) | <<< a where\r
+ (<<<) file Tip = file <<< "Tip"\r
+ (<<<) file (Bin l x r) = file <<< " {" <<< l <<< " } [" <<< x <<< "] { " <<< r <<< "} "\r
+\r
+:: PTree a = PTip | PBin Int a (PTree a) (PTree a)\r
+\r
+combine2d :: [[a]] [[a]] -> [[a]]\r
+combine2d [x:xs] [y:ys] = [x ++ y] ++ (combine2d xs ys) \r
+combine2d x [] = x\r
+combine2d [] y = y\r
+\r
+tree_depth :: (Tree a) -> Int\r
+tree_depth (Bin l _ r) = 1+(max (tree_depth l) (tree_depth r))\r
+tree_depth Tip = 0\r
+\r
+tree_width :: (Tree a) -> Int\r
+tree_width t = 2^((tree_depth t)-1)\r
+\r
+tree_flatten :: Int Int (Tree a) -> [[(Int, a)]]\r
+tree_flatten pos step (Bin l x r) = [[(pos, x)]] ++ (combine2d (tree_flatten (pos-step) (step/2) l) (tree_flatten (pos+step) (step/2) r))\r
+tree_flatten _ _ Tip = []\r
+\r
+tree_node :: *File Int Int a -> *File | <<< a\r
+tree_node file p np x | p < np = tree_node (file <<< " ") (p+1) np x\r
+ | otherwise = file <<< x\r
+\r
+tree_line :: *File Int [(Int, a)] -> *File | <<< a\r
+tree_line file pos [(npos, x):xs] = tree_line (tree_node file pos npos x) npos xs\r
+tree_line file _ [] = file\r
+\r
+tree_print :: *File [[(Int, a)]] -> *File | <<< a\r
+tree_print file [x:xs] = tree_print ((tree_line file 0 x) <<< "\n") xs\r
+tree_print file [] = file <<< "\n"\r
+\r
+Start :: !*World -> *World\r
+Start world \r
+ # (file, world) = stdio world\r
+ # file = file <<< "Tuple text:\n"\r
+ # file = file <<< tuple_text <<< "\n\n"\r
+ # file = file <<< "parser result: " <<< tuple_parse <<< "\n\n"\r
+ # file = file <<< "List text:\n"\r
+ # file = file <<< list_text <<< "\n\n"\r
+ # file = file <<< "parser result: " <<< list_parse <<< "\n\n"\r
+ # file = file <<< "Tree text:\n"\r
+ # file = file <<< tree_text <<< "\n\n"\r
+ # file = file <<< "parser result: " <<< tree_parse <<< "\n\n"\r
+ # file = file <<< "tree_depth = " <<< (tree_depth tree_data) <<< "\n"\r
+ # file = file <<< "tree_width = " <<< (tree_width tree_data) <<< "\n"\r
+ # file = file <<< "tree_flatten = " <<< (tree_flatten (((tree_width tree_data)*2)+4) ((tree_width tree_data)*2) tree_data) <<< "\n"\r
+ # file = tree_print file (tree_flatten (((tree_width tree_data)*2)+4) ((tree_width tree_data)*2) tree_data)\r
+ # (ok, world) = fclose file world\r
+ | otherwise = world\r
+\r
+/**************** Starts *******************************/\r
+\r
+//Start = ("add your own Start rule!\n", Start4)\r
+\r
+// Possible tests:\r
+//Start1 :: ([String],Result T)\r
+//Start1 = (strings,parse strings) where strings = show C\r
+\r
+//Start2 :: ([String],Result (Int,Bool))\r
+//Start2 = (strings,parse strings) where strings = show (1,False)\r
+\r
+//Start3 :: ([String],Result [Int])\r
+//Start3 = (strings,parse strings) where strings = show l; l :: [Int]; l = [1..4]\r
+\r
+//Start4 :: ([String],Result (Tree Int))\r
+//Start4 = (strings,parse strings)\r
+//where\r
+// strings = show t\r
+ \r
+// t :: Tree Int\r
+// t = Bin (Bin Tip 2 (Bin Tip 3 Tip)) 4 (Bin (Bin Tip 5 Tip) 6 Tip)\r
repositories / ap2015.git / commitdiff