[project @ 2000-10-03 08:43:00 by simonpj]

--------------------------------------
	Adding generics		SLPJ Oct 2000
	--------------------------------------

This big commit adds Hinze/PJ-style generic class definitions, based
on work by Andrei Serjantov.  For example:

  class Bin a where
    toBin   :: a -> [Int]
    fromBin :: [Int] -> (a, [Int])

    toBin {| Unit |}    Unit	  = []
    toBin {| a :+: b |} (Inl x)   = 0 : toBin x
    toBin {| a :+: b |} (Inr y)   = 1 : toBin y
    toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y


    fromBin {| Unit |}    bs      = (Unit, bs)
    fromBin {| a :+: b |} (0:bs)  = (Inl x, bs')    where (x,bs') = fromBin bs
    fromBin {| a :+: b |} (1:bs)  = (Inr y, bs')    where (y,bs') = fromBin bs
    fromBin {| a :*: b |} bs  	  = (x :*: y, bs'') where (x,bs' ) = fromBin bs
							  (y,bs'') = fromBin bs'

Now we can say simply

  instance Bin a => Bin [a]

and the compiler will derive the appropriate code automatically.

		(About 9k lines of diffs.  Ha!)


Generic related things
~~~~~~~~~~~~~~~~~~~~~~

* basicTypes/BasicTypes: The EP type (embedding-projection pairs)

* types/TyCon:
	An extra field in an algebraic tycon (genInfo)

* types/Class, and hsSyn/HsBinds:
	Each class op (or ClassOpSig) carries information about whether
	it  	a) has no default method
		b) has a polymorphic default method
		c) has a generic default method
	There's a new data type for this: Class.DefMeth

* types/Generics:
	A new module containing good chunk of the generic-related code
	It has a .hi-boot file (alas).

* typecheck/TcInstDcls, typecheck/TcClassDcl:
	Most of the rest of the generics-related code

* hsSyn/HsTypes:
	New infix type form to allow types of the form
		data a :+: b = Inl a | Inr b

* parser/Parser.y, Lex.lhs, rename/ParseIface.y:
	Deal with the new syntax

* prelude/TysPrim, TysWiredIn:
	Need to generate generic stuff for the wired-in TyCons

* rename/RnSource RnBinds:
	A rather gruesome hack to deal with scoping of type variables
	from a generic patterns.  Details commented in the ClassDecl
	case of RnSource.rnDecl.

	Of course, there are many minor renamer consequences of the
	other changes above.

* lib/std/PrelBase.lhs
	Data type declarations for Unit, :+:, :*:


Slightly unrelated housekeeping
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
* hsSyn/HsDecls:
	ClassDecls now carry the Names for their implied declarations
	(superclass selectors, tycon, etc) in a list, rather than
	laid out one by one.  This simplifies code between the parser
	and the type checker.

* prelude/PrelNames, TysWiredIn:
	All the RdrNames are now together in PrelNames.

* utils/ListSetOps:
	Add finite mappings based on equality and association lists (Assoc a b)
	Move stuff from List.lhs that is related

1 files changed, 42 insertions, 22 deletions

diff --git a/ghc/compiler/hsSyn/HsDecls.lhs b/ghc/compiler/hsSyn/HsDecls.lhs
index 0ed79e2078..0767de0927 100644
--- a/ghc/compiler/hsSyn/HsDecls.lhs
+++ b/ghc/compiler/hsSyn/HsDecls.lhs
@@ -15,7 +15,10 @@ module HsDecls (
 	BangType(..), getBangType,
 	IfaceSig(..),  SpecDataSig(..), 
 	DeprecDecl(..), DeprecTxt,
-	hsDeclName, instDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls, toHsRule
+	hsDeclName, instDeclName, tyClDeclName, isClassDecl, isSynDecl, isDataDecl, countTyClDecls, toHsRule,
+	toClassDeclNameList, 
+	fromClassDeclNameList
+
     ) where
 
 #include "HsVersions.h"
@@ -91,12 +94,13 @@ hsDeclName x				      = pprPanic "HsDecls.hsDeclName" (ppr x)
 
 
 tyClDeclName :: TyClDecl name pat -> name
-tyClDeclName (TyData _ _ name _ _ _ _ _ _)          = name
+tyClDeclName (TyData _ _ name _ _ _ _ _ _ _ _)      = name
 tyClDeclName (TySynonym name _ _ _)                 = name
-tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ _ _ _) = name
+tyClDeclName (ClassDecl _ name _ _ _ _ _ _ _ )      = name
 
 instDeclName :: InstDecl name pat -> name
 instDeclName (InstDecl _ _ _ (Just name) _) = name
+
 \end{code}
 
 \begin{code}
@@ -186,10 +190,12 @@ data TyClDecl name pat
 				 -- expect...
 		(DataPragmas name)
 		SrcLoc
+		name             -- generic converter functions
+		name             -- generic converter functions
 
-  | TySynonym	name		-- type constructor
-		[HsTyVarBndr name]	-- type variables
-		(HsType name)	-- synonym expansion
+  | TySynonym	name		        -- type constructor
+                [HsTyVarBndr name]	-- type variables
+		(HsType name)	        -- synonym expansion
 		SrcLoc
 
   | ClassDecl	(HsContext name)    	-- context...
@@ -199,15 +205,29 @@ data TyClDecl name pat
 		[Sig name]		-- methods' signatures
 		(MonoBinds name pat)	-- default methods
 		(ClassPragmas name)
-		name name name [name]	-- The names of the tycon, datacon wrapper, datacon worker,
-					-- and superclass selectors for this class.
-					-- These are filled in as the ClassDecl is made.
+		[name]	                -- The names of the tycon, datacon 
+					-- wrapper, datacon worker,
+					-- and superclass selectors for this 
+					-- class (the first 3 are at the front 
+					-- of the list in this order)
+					-- These are filled in as the 
+					-- ClassDecl is made.
 		SrcLoc
 
+-- Put type signatures in and explain further!!
+                -- The names of the tycon, datacon 
+					-- wrapper, datacon worker,
+					-- and superclass selectors for this 
+					-- class (the first 3 are at the front 
+					-- of the list in this order)
+					-- These are filled in as the 
+toClassDeclNameList (a,b,c,ds) = a:b:c:ds
+fromClassDeclNameList (a:b:c:ds) = (a,b,c,ds)
+
 instance Ord name => Eq (TyClDecl name pat) where
 	-- Used only when building interface files
-  (==) (TyData nd1 cxt1 n1 tvs1 cons1 _ _ _ _)
-       (TyData nd2 cxt2 n2 tvs2 cons2 _ _ _ _)
+  (==) (TyData nd1 cxt1 n1 tvs1 cons1 _ _ _ _ _ _)
+       (TyData nd2 cxt2 n2 tvs2 cons2 _ _ _ _ _ _)
     = n1 == n2 &&
       nd1 == nd2 &&
       eqWithHsTyVars tvs1 tvs2 (\ env -> 
@@ -220,8 +240,8 @@ instance Ord name => Eq (TyClDecl name pat) where
     =  n1 == n2 &&
        eqWithHsTyVars tvs1 tvs2 (\ env -> eq_hsType env ty1 ty2)
 
-  (==) (ClassDecl cxt1 n1 tvs1 fds1 sigs1 _ _ _ _ _ _ _)
-       (ClassDecl cxt2 n2 tvs2 fds2 sigs2 _ _ _ _ _ _ _)
+  (==) (ClassDecl cxt1 n1 tvs1 fds1 sigs1 _ _ _ _ )
+       (ClassDecl cxt2 n2 tvs2 fds2 sigs2 _ _ _ _ )
     =  n1 == n2 &&
        eqWithHsTyVars tvs1 tvs2 (\ env -> 
 	  eq_hsContext env cxt1 cxt2 &&
@@ -242,7 +262,7 @@ eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
 	-- This is used for comparing declarations before putting
 	-- them into interface files, and the name of the default 
 	-- method isn't relevant
-    (Just (_,explicit_dm1)) `eq_dm` (Just (_,explicit_dm2)) = explicit_dm1 == explicit_dm2
+    (Just (explicit_dm1)) `eq_dm` (Just (explicit_dm2)) = explicit_dm1 == explicit_dm2
     Nothing		    `eq_dm` Nothing		    = True
     dm1			    `eq_dm` dm2			    = False
 \end{code}
@@ -251,9 +271,9 @@ eq_cls_sig env (ClassOpSig n1 dm1 ty1 _) (ClassOpSig n2 dm2 ty2 _)
 countTyClDecls :: [TyClDecl name pat] -> (Int, Int, Int, Int)
 	-- class, data, newtype, synonym decls
 countTyClDecls decls 
- = (length [() | ClassDecl _ _ _ _ _ _ _ _ _ _ _ _ <- decls],
-    length [() | TyData DataType _ _ _ _ _ _ _ _   <- decls],
-    length [() | TyData NewType  _ _ _ _ _ _ _ _   <- decls],
+ = (length [() | ClassDecl _ _ _ _ _ _ _ _ _  <- decls],
+    length [() | TyData DataType _ _ _ _ _ _ _ _ _ _  <- decls],
+    length [() | TyData NewType  _ _ _ _ _ _ _ _ _ _  <- decls],
     length [() | TySynonym _ _ _ _	           <- decls])
 
 isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
@@ -261,10 +281,10 @@ isDataDecl, isSynDecl, isClassDecl :: TyClDecl name pat -> Bool
 isSynDecl (TySynonym _ _ _ _) = True
 isSynDecl other		      = False
 
-isDataDecl (TyData _ _ _ _ _ _ _ _ _) = True
-isDataDecl other		      = False
+isDataDecl (TyData _ _ _ _ _ _ _ _ _ _ _) = True
+isDataDecl other		          = False
 
-isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ _ _ _) = True
+isClassDecl (ClassDecl _ _ _ _ _ _ _ _ _ ) = True
 isClassDecl other		 	        = False
 \end{code}
 
@@ -276,7 +296,7 @@ instance (Outputable name, Outputable pat)
       = hang (ptext SLIT("type") <+> pp_decl_head [] tycon tyvars <+> equals)
 	     4 (ppr mono_ty)
 
-    ppr (TyData new_or_data context tycon tyvars condecls ncons derivings pragmas src_loc)
+    ppr (TyData new_or_data context tycon tyvars condecls ncons derivings pragmas src_loc gen_conv1 gen_conv2) -- The generic names are not printed out ATM
       = pp_tydecl
 		  (ptext keyword <+> pp_decl_head context tycon tyvars <+> equals)
 		  (pp_condecls condecls ncons)
@@ -286,7 +306,7 @@ instance (Outputable name, Outputable pat)
 			NewType  -> SLIT("newtype")
 			DataType -> SLIT("data")
 
-    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ _ _ _ src_loc)
+    ppr (ClassDecl context clas tyvars fds sigs methods pragmas _ src_loc)
       | null sigs	-- No "where" part
       = top_matter