Assignment 1

1 files changed, 126 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.