Assignment 1

2 files changed, 190 insertions, 0 deletions

diff --git a/assignment-1/program1.icl b/assignment-1/program1.icl
new file mode 100644
index 0000000..79e9102
--- /dev/null
+++ b/assignment-1/program1.icl
@@ -0,0 +1,126 @@
+module program1
+
+import StdBool
+import StdEnum
+from StdFunc import flip, o, seq
+import StdList
+import StdString
+import StdTuple
+
+import Control.Applicative
+import Control.Monad
+import Control.Monad.State
+import Data.Functor
+import Data.List
+import Data.Maybe
+
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+:: Rose a = Rose a [Rose a]
+
+instance == (Bin a) | == a
+where
+	== Leaf Leaf = True
+	== (Bin la xa ra) (Bin lb xb rb) = xa == xb && la == lb && ra == rb
+	== _ _ = False
+
+instance == (Rose a) | == a
+where
+	== (Rose x xs) (Rose y ys) = x == y && xs == ys
+
+class serialize a
+where
+	write :: a [String] -> [String]
+	read :: [String] -> Maybe (a, [String])
+
+sread :== StateT read
+
+instance serialize Bool
+where
+	write b c = [toString b:c]
+	read ["True": r] = Just (True,  r)
+	read ["False":r] = Just (False, r)
+	read _           = Nothing
+
+instance serialize String
+where
+	write s c = [s:c]
+	read [s:r] = Just (s,r)
+	read _     = Nothing
+
+instance serialize Int
+where
+	write i c = write (toString i) c
+	read ["0":r] = Just (0, r)
+	read [i:r] = case toInt i of
+		0 -> Nothing
+		i -> Just (i, r)
+	read _ = Nothing
+
+instance serialize [a] | serialize a
+where
+	// We don't actually need to start with [, but this gives some type safety.
+	// The ] is necessary to recognise the end of the list.
+	write xs c = write "[" (seq (map write xs) (write "]" c))
+	read ["[":r] = readElements [] r
+	where
+		readElements :: [a] [String] -> Maybe ([a], [String]) | serialize a
+		readElements xs ["]":r] = Just (xs, r)
+		readElements xs s = read s >>= \(x,r) -> readElements [x:xs] r
+	read _ = Nothing
+
+instance serialize (Bin a) | serialize a
+where
+	// Here, it is necessary to start with "Bin", to be able to parse
+	// ["Leaf":_] unambiguously.
+	write Leaf c = write "Leaf" c
+	write (Bin l x r) c = write "Bin" (write l (write x (write r c)))
+	read ["Leaf":r] = Just (Leaf, r)
+	read ["Bin":r] = runStateT (liftM3 Bin sread sread sread) r
+	read _ = Nothing
+
+instance serialize (Rose a) | serialize a
+where
+	// Other than for [], we don't include the constructor here (it is not
+	// necessary because there is only one constructor).
+	write (Rose x xs) c = write xs (write x c)
+	read s = runStateT (liftM2 (flip Rose) sread sread) s
+
+test :: a -> (Bool, [String]) | serialize, == a
+test a = (isJust r && fst jr == a && isEmpty (tl (snd jr)), s)
+where
+	s = write a [""]
+	r = read s
+	jr = fromJust r
+
+Start :: [([Rose (Bin Bool)], Bool)] // Change the first type of the tuple to test other expressions.
+Start = filter (not o snd) testn // Should be [].
+
+testn :: [(a, Bool)] | serialize, ==, someExprs a
+testn = [(x, fst (test x)) \\ x <- someExprs]
+
+class someExprs a :: [a]
+
+instance someExprs Bool where someExprs = [True,False]
+instance someExprs Int where someExprs = [-3..3]
+instance someExprs [a] | someExprs a where someExprs = tails someExprs
+instance someExprs (Bin a) | someExprs a
+where
+	someExprs =
+		[ Leaf
+		, Bin Leaf (es!!0) Leaf
+		, Bin (Bin (Bin (Bin Leaf (es!!1) Leaf) (es!!2) Leaf) (es!!3) Leaf) (es!!4) Leaf
+		, Bin (Bin Leaf (es!!7) Leaf) (es!!6) (Bin Leaf (es!!5) Leaf)
+		, Bin Leaf (es!!8) (Bin (Bin (Bin Leaf (es!!9) Leaf) (es!!10) Leaf) (es!!11) Leaf)
+		] // Looking forward to using Gast.
+	where
+		es = cycle someExprs
+instance someExprs (Rose a) | someExprs a
+where
+	someExprs = level1 ++ level2 ++ level3
+	where
+		level1 = [Rose x [] \\ x <- someExprs]
+		level2 = [Rose x rs \\ x <- someExprs, rs <- tails level1]
+		level3 = [Rose x rs \\ x <- someExprs, rs <- tails (level1 ++ level2)]
+		// Would be better to use (a) permutations / subsequences or (b) do
+		// something more intelligent, but (a) takes too much memory and (b)
+		// requires thinking.
diff --git a/assignment-1/program2.icl b/assignment-1/program2.icl
new file mode 100644
index 0000000..304699a
--- /dev/null
+++ b/assignment-1/program2.icl
@@ -0,0 +1,64 @@
+module program2
+
+/**
+ * Kinds:
+ *
+ * Bool     *
+ * Bin      *->*
+ * Rose     *->*
+ * Bin Int  *
+ * Tree     *->*->*
+ * T1       (*->*)->*->*
+ * T2       (*->*)->(*->*)->*->*
+ * T3       (a->b->*)->a->b->*
+ *  - For instance, C3 (1,2) with a = b = *
+ *  - Or, C3 (Box [1,2,3]) with a = *->*, b = * (:: Box t u = Box (t u))
+ * T4       (b->*)->(a->b)->a->*
+ *  - For instance, C4 [[1]] with a = *, b = *
+ *  - Or, C4 (IntBox (Box [5])) with a = *->*, b = *->* (:: IntBox t = IntBox (t Int))
+ */
+
+import StdEnum
+import StdFunc
+import StdList
+import StdString
+
+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
+
+:: Bin a = Leaf | Bin (Bin a) a (Bin a)
+
+instance Container []
+where
+	Cinsert x xs = [x:xs]
+	Ccontains x xs = isMember x xs
+		// It would be nice if it were possible to write functions with arity
+		// that does not match the type, especially for classes where it is not
+		// easy to change the type. This can be implemented as sugar.
+	Cshow xs = map toString xs
+	Cnew = []
+
+instance Container Bin
+where
+	Cinsert x Leaf = Bin Leaf x Leaf
+	Cinsert x b=:(Bin l y r)
+	| x < y     = Bin (Cinsert x l) y r
+	| x > y     = Bin l y (Cinsert x r)
+	| otherwise = b // Assuming that we don't want to store a value multiple times
+	Ccontains _ Leaf = False
+	Ccontains x (Bin l y r)
+	| x == y    = True
+	| x <  y    = Ccontains x l
+	| otherwise = Ccontains x r
+	Cshow Leaf = []
+	Cshow (Bin l x r) = Cshow l ++ [toString x:Cshow r] // Terrible complexity, but easiest implementation
+	Cnew = Leaf
+
+Start = (Ccontains 3 c, Cshow c)
+where
+	c :: Bin Int // Change to [Int] for testing the [] instance
+	c = seq (map Cinsert [10..20]) Cnew