From: Mart Lubbers <mart@martlubbers.net>
Date: Mon, 7 Sep 2015 17:04:44 +0000 (+0200)
Subject: started with a2
X-Git-Tag: assignment2~6
X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=701c1bfbc2c2a3d18304eec53d840f96ca01359c;p=ap2015.git

started with a2
---

diff --git a/a2/a2.pdf b/a2/a2.pdf
new file mode 100644
index 0000000..171fa7e
Binary files /dev/null and b/a2/a2.pdf differ
diff --git a/a2/mart/skeleton2.icl b/a2/mart/skeleton2.icl
new file mode 100644
index 0000000..13895ac
--- /dev/null
+++ b/a2/mart/skeleton2.icl
@@ -0,0 +1,177 @@
+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
+//import 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
+
+instance Container [] where
+	Cinsert e x = [e:x]
+
+	Ccontains e x = isMember e x
+
+	Cshow x = map toString x
+
+	Cnew = []
+
+instance Container Tree where
+	Cinsert e Tip = Bin Tip e Tip
+	Cinsert e (Bin l x r)
+	| e < x = Cinsert e l
+	| otherwise = Cinsert e r
+
+	Ccontains e Tip = False
+	Ccontains e (Bin l x r)
+	| e == x = True
+	| e < x = Ccontains e l
+	| otherwise = Ccontains e r
+
+	Cshow Tip = []
+	Cshow (Bin l x r) = Cshow l ++ [toString x] ++ Cshow r
+
+	Cnew = Tip
+
+
+/**************** Part 2 ******************************/
+/*
+Intlist	: *
+List	: *→*
+Tree	: *→*→*
+T1	: (*→*)→* 
+T2	: (((*→*)→*)→*)→*
+T3	: (*→*→*)→*
+T4	: ((*→*)→*)→*
+*/
+/***************** Part 3 *******************************/
+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 s x) c = ["CONS", s:show_ x c]
+
+instance show_ [a] | show_ a where
+	show_ x c = show_ (fromList x) c
+
+fromTree :: (Tree a) -> TreeG a
+fromTree Tip = LEFT (CONS "Tip" UNIT)
+fromTree (Bin l x r) = RIGHT (CONS "Bin" (PAIR x (PAIR l r)))
+
+instance show_ (Tree a) | show_ a where
+	show_ x c = show_ (fromTree x) c
+
+fromTuple :: (a, b) -> TupG a b	
+fromTuple (x, y) = CONS "Tuple" (PAIR x y)
+
+instance show_ (a, b) | show_ a & show_ b where
+	show_ x c = show_ (fromTuple x) c
+
+Start = [
+	show [1, 2, 3],
+	show (Bin Tip 5 Tip),
+	show ([1, 2], 5) ]
+
+///**************** 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) where
+//	parse ["PAIR":r] = Match r
+	parse _ = Fail
+instance parse (EITHER a b) where
+//	parse ["EITHER":r] = Match r
+	parse _ = Fail
+instance parse (CONS a) where
+//	parse ["CONS",s:r]
+	parse_ = Fail
+
+instance parse (Tree a) | parse a where parse list = Fail // should be improved
+
+:: T = C
+
+///**************** 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)