From c4bddedf0c7dc0de0e1509fa0655b0fd6f3fa963 Mon Sep 17 00:00:00 2001
From: Mart Lubbers <mart@martlubbers.net>
Date: Wed, 9 Sep 2015 19:48:11 +0200
Subject: [PATCH] finished a2

---
 a2/mart/skeleton2.icl | 81 +++++++++++++++++++++++--------------------
 1 file changed, 43 insertions(+), 38 deletions(-)

diff --git a/a2/mart/skeleton2.icl b/a2/mart/skeleton2.icl
index 13895ac..4e0ec84 100644
--- a/a2/mart/skeleton2.icl
+++ b/a2/mart/skeleton2.icl
@@ -122,11 +122,6 @@ 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
@@ -140,38 +135,48 @@ instance parse Bool where
 instance parse UNIT where
 	parse ["UNIT" : r]   = Match UNIT r
 	parse _              = Fail
-instance parse (PAIR a b) where
-//	parse ["PAIR":r] = Match r
+
+instance parse (PAIR a b) | parse a & parse b where
+	parse ["PAIR":r] = case parse r of
+		Match a rs = case parse rs of
+			Match a2 rs2 = Match (PAIR a a2) rs2
+			_ = Fail
+		_ = Fail
 	parse _ = Fail
-instance parse (EITHER a b) where
-//	parse ["EITHER":r] = Match r
+
+instance parse (EITHER a b) | parse a & parse b where
+	parse ["LEFT":r] = case parse r of
+		Match a rs = Match (LEFT a) rs
+		_ = Fail
+	parse ["RIGHT":r] = case parse r of
+		Match a rs = Match (RIGHT a) rs
+		_ = Fail
+	parse _ = Fail
+
+instance parse (CONS a) | parse a where
+	parse ["CONS",s:r] = case parse r of
+		Match a rs = Match (CONS s a) rs
+		_ = Fail
 	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)
+
+toTree :: (TreeG a) -> Tree a
+toTree (LEFT (CONS _ UNIT)) = Tip
+toTree (RIGHT (CONS _ (PAIR a (PAIR l r)))) = Bin l a r
+
+instance parse (Tree a) | parse a where
+	parse x = case parse x of
+		Match a r = Match (toTree a) r
+		_ = Fail
+
+instance parse [a] | parse a where
+	parse x = case parse x of
+		Match a r = Match (toList a) r
+		_ = Fail
+
+toTuple :: (TupG a b) -> (a, b)
+toTuple (CONS "Tuple" (PAIR a b)) = (a, b)
+
+instance parse (a, b) | parse a & parse b where
+	parse x = case parse x of
+		Match a r = Match (toTuple a) r
+		_ = Fail
-- 
2.20.1