1 files changed, 72 insertions, 0 deletions

diff --git a/testdata/typeclass.lc b/testdata/typeclass.lc
new file mode 100644
index 00000000..7f432f64
--- /dev/null
+++ b/testdata/typeclass.lc
@@ -0,0 +1,72 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+import Internals
+
+data List a = Nil | Cons a (List a)
+
+infix 4 ==, /=, <
+infixr 3 &&
+infixr 2 ||
+
+not True = False
+not False = True
+
+True && a = a
+False && _ = False
+
+False || a = a
+True || _ = True
+
+class Eq a where
+    (==) :: a -> a -> Bool
+
+a /= b = not (a == b)
+
+instance Eq Bool where
+    True == a = a
+    False == a = not a
+
+instance Eq t => Eq [t] where
+    []   == []   = True
+    (==) (a:as) (b:bs) = a == b -- && as == bs
+    -- TODO  a:as == b:bs = a == b && as == bs
+    _    == _    = False
+{-
+Ord = \a -> Eq a & Ord' a       -- so this is an alias, always subst.
+
+cosmetics:
+
+-   subst. Ord' with Ord when presented to the user
+-   omit Eq whereever possible
+    -   mark Ord-stemmed Eq as 'derived'
+    -   'derived' Eq overcomes other Eq
+    -   eliminate all 'derived' Eq
+
+Ord' Bool = 'Unit
+Ord' [a] = Ord a
+
+todo: mutual recursion
+-}
+{-
+class Eq a => Ord a where
+    (<) :: a -> a -> Bool
+
+instance Ord Bool where
+    _ < False = False
+    b < True = not b
+
+instance Ord a => Ord [a] where
+    a:as < b:bs  =  a < b || a == b && as < bs
+    _ < []   = False
+    [] < _   = True
+
+
+main = [False, True] == [False, True]
+  &&   [False, True] /= [False, False]
+  &&   [False, True] /= [False]
+  &&   False < True
+  &&   not (False < False)
+  &&   [False] < [False, True]
+  &&   [[False]] < [[False], []]
+-}
+
+