From 4e9b1c1e87f3818602de8a18be181c8a0f0e2433 Mon Sep 17 00:00:00 2001
From: Charlie Gerhardus <charlie.gerhardus@somedomain.something>
Date: Fri, 11 Sep 2015 19:09:00 +0200
Subject: [PATCH] assignment 2, with experimental tree printer. without
 question 2.

---
 a2/charlie/skeleton2.icl | 286 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 286 insertions(+)
 create mode 100755 a2/charlie/skeleton2.icl

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