started with a2

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