Polymorphic lists...

[MR K P SCHUPKE]

Didn't know If I should post it straight away... its quite long and I dont do
attachments (well not If I can help it. I am aware Dynamic can model heterogenious lists
(thanks for correct terminology) - but I need static typing. Thats the clever thing about
this code - the list is heterogenious but statically typed.

So... for your perusal - and If its not up to being included in the libraries I would
value any comments/code review for my own edification.

The module is called "Relation" as I am modelling Relational Algebra... but if anyone can
think of a better name...

First some examples:

putStrLn $ show (rIndex two rel1) -- show the third item in rel1
putStrLn $ show (rHead r)
putStrLn $ show (rTail r)
putStrLn $ show (rLast r)
putStrLn $ show (rInit r)
putStrLn $ show (r `rEnqueue` "TEST3") -- insert the string into the last (not head) position
putStrLn $ show ((3 :: Int) `RCons` r) -- insert the Int into the head of the list
r = toTuple (( 1.1 :: Double) `RCons` (fromTuple ("hello",1,"World")))


And the code:

{-# OPTIONS -fglasgow-exts #-}
{-# OPTIONS -fallow-undecidable-instances #-}
{-# OPTIONS -fallow-overlapping-instances #-}

module Lib.DBC.Relation where

------------------------------------------------------------------------------
-- (c) 2004 Keean Schupke, All Rights Reserved.
------------------------------------------------------------------------------

data Zero = Zero deriving Show
data Suc n = Suc n deriving Show

class Nat n
instance Nat Zero
instance Nat n => Nat (Suc n)

zero :: Zero
zero = Zero

one :: Suc Zero
one = Suc zero

two :: Suc (Suc Zero)
two = Suc one

three :: Suc (Suc (Suc Zero))
three = Suc two

four :: Suc (Suc (Suc (Suc Zero)))
four = Suc three

five :: Suc (Suc (Suc (Suc (Suc Zero))))
five = Suc four

------------------------------------------------------------------------------

infixr 1 `RCons`
data RNil = RNil deriving Show
data RCons a r = a `RCons` r deriving Show

------------------------------------------------------------------------------

class Relation r where
   rHead :: a `RCons` r -> a
   rTail :: a `RCons` r -> r
   rIsEmpty :: r -> Bool
instance Relation RNil where
   rHead (x `RCons` _) = x
   rTail (_ `RCons` _) = RNil
   rIsEmpty RNil = True
instance Relation r => Relation (a `RCons` r) where
   rHead (x `RCons` _) = x
   rTail (_ `RCons` xs) = xs
   rIsEmpty (_ `RCons` _) = False

class RLast r a | r -> a where
   rLast :: r -> a
instance RLast (a `RCons` RNil) a where
   rLast (x `RCons` RNil) = x
instance RLast r b => RLast (a `RCons` r) b where
   rLast (_ `RCons` xs) = rLast xs

class RInit r1 r2 | r1 -> r2 where
   rInit :: r1 -> r2
instance RInit (a `RCons` RNil) RNil where
   rInit (_ `RCons` RNil) = RNil
instance RInit (b `RCons` r1) r2 => RInit (a `RCons` b `RCons` r1) (a `RCons` r2) where
   rInit (x `RCons` xs) = x `RCons` rInit xs

class REnqueue r1 r2 a | r1 a -> r2 where
   rEnqueue :: r1 -> a -> r2
instance REnqueue RNil (a `RCons` RNil) a where
   rEnqueue RNil y = y `RCons` RNil
instance REnqueue r1 r2 b => REnqueue (a `RCons` r1) (a `RCons` r2) b where
   rEnqueue (x `RCons` xs) y = x `RCons` rEnqueue xs y

class (Nat n,Relation r) => RIndex n r a | n r -> a where
   rIndex :: n -> r -> a
instance Relation r => RIndex Zero (a `RCons` r) a where
   rIndex Zero (x `RCons` _) = x
instance RIndex n r b => RIndex (Suc n) (a `RCons` r) b where
   rIndex (Suc n) (_ `RCons` xs) = rIndex n xs

infixl 2 `rProduct`
class (Relation r1,Relation r2,Relation r3) => RProduct r1 r2 r3 | r1 r2 -> r3 where
   rProduct :: r1 -> r2 -> r3
instance RProduct RNil RNil RNil where
   rProduct RNil RNil = RNil
instance Relation r => RProduct RNil r r where
   rProduct RNil r = r
instance RProduct r1 r2 r3 => RProduct (a `RCons` r1) r2 (a `RCons` r3) where
   rProduct (x `RCons` xs) y = x `RCons` (xs `rProduct` y)

------------------------------------------------------------------------------

class Relation r => RTuple t r | t -> r , r -> t where
   fromTuple :: t -> r
   toTuple :: r -> t

instance RTuple (a,b) (a `RCons` b `RCons` RNil) where
   fromTuple (a,b) = a `RCons` b `RCons` RNil
   toTuple (a `RCons` b `RCons` RNil) = (a,b)

instance RTuple (a,b,c) (a `RCons` b `RCons` c `RCons` RNil) where
   fromTuple (a,b,c) = a `RCons` b `RCons` c `RCons` RNil
   toTuple (a `RCons` b `RCons` c `RCons` RNil) = (a,b,c)

instance RTuple (a,b,c,d) (a `RCons` b `RCons` c `RCons` d `RCons` RNil) where
   fromTuple (a,b,c,d) = a `RCons` b `RCons` c `RCons` d `RCons` RNil
   toTuple (a `RCons` b `RCons` c `RCons` d `RCons` RNil) = (a,b,c,d)

instance RTuple (a,b,c,d,e) (a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` RNil) where
   fromTuple (a,b,c,d,e) = a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` RNil
   toTuple (a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` RNil) = (a,b,c,d,e)

instance RTuple (a,b,c,d,e,f) (a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` f `RCons` RNil) where
   fromTuple (a,b,c,d,e,f) = a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` f `RCons` RNil
   toTuple (a `RCons` b `RCons` c `RCons` d `RCons` e `RCons` f `RCons` RNil) = (a,b,c,d,e,f)

------------------------------------------------------------------------------