From 2aa1070a9a6095e80e82d66f20e4c6f3b5155b82 Mon Sep 17 00:00:00 2001
From: ross <unknown>
Date: Sat, 20 Mar 2004 12:42:28 +0000
Subject: [PATCH] [project @ 2004-03-20 12:42:27 by ross] Comments (and
 deleted some of the blank lines Ralf is so fond of).

---
 Data/Typeable.hs   |  122 +++++++++++++++++-----------------------------------
 include/Typeable.h |   11 +++++
 2 files changed, 51 insertions(+), 82 deletions(-)

diff --git a/Data/Typeable.hs b/Data/Typeable.hs
index 1151d08..4eef681 100644
--- a/Data/Typeable.hs
+++ b/Data/Typeable.hs
@@ -47,6 +47,7 @@ module Data.Typeable
 	tyconString,	-- :: TyCon   -> String
 
 	-- * The other Typeable classes
+	-- | The general instances are provided for GHC only.
 	Typeable1( typeOf1 ),	-- :: t a -> TypeRep
 	Typeable2( typeOf2 ),	-- :: t a b -> TypeRep
 	Typeable3( typeOf3 ),	-- :: t a b c -> TypeRep
@@ -58,6 +59,8 @@ module Data.Typeable
 	gcast2,			-- :: ... => c (t a b) -> Maybe (c (t' a b))
 
 	-- * Default instances
+	-- | These are not needed by GHC, for which these instances are
+	-- generated by general instance declarations.
 	typeOfDefault,	-- :: (Typeable1 t, Typeable a) => t a -> TypeRep
 	typeOf1Default,	-- :: (Typeable2 t, Typeable a) => t a b -> TypeRep
 	typeOf2Default,	-- :: (Typeable2 t, Typeable a) => t a b c -> TypeRep
@@ -68,7 +71,6 @@ module Data.Typeable
 
   ) where
 
-
 import qualified Data.HashTable as HT
 import Data.Maybe
 import Data.Either
@@ -107,7 +109,6 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 #include "Typeable.h"
 #endif
 
-
 #ifndef __HUGS__
 
 -------------------------------------------------------------
@@ -116,7 +117,6 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 --
 -------------------------------------------------------------
 
-
 -- | A concrete representation of a (monomorphic) type.  'TypeRep'
 -- supports reasonably efficient equality.
 data TypeRep = TypeRep !Key TyCon [TypeRep] 
@@ -145,7 +145,6 @@ instance Eq TyCon where
 	-- sequence of commas, e.g., (mkTyCon ",,,,") returns
 	-- the 5-tuple tycon.
 
-
 ----------------- Construction --------------------
 
 -- | Applies a type constructor to a sequence of types
@@ -155,13 +154,11 @@ mkAppTy tc@(TyCon tc_k _) args
   where
     arg_ks = [k | TypeRep k _ _ <- args]
 
-
 -- | A special case of 'mkAppTy', which applies the function 
 -- type constructor to a pair of types.
 mkFunTy  :: TypeRep -> TypeRep -> TypeRep
 mkFunTy f a = mkAppTy funTc [f,a]
 
-
 -- | Applies a type to a function type.  Returns: @'Just' u@ if the
 -- first argument represents a function of type @t -> u@ and the
 -- second argument represents a function of type @t@.  Otherwise,
@@ -171,14 +168,12 @@ applyTy (TypeRep _ tc [t1,t2]) t3
   | tc == funTc && t1 == t3	= Just t2
 applyTy _ _     		= Nothing
 
-
 -- | Adds a TypeRep argument to a TypeRep.
 popStarTy :: TypeRep -> TypeRep -> TypeRep
 popStarTy (TypeRep tr_k tc trs) arg_tr
   = let (TypeRep arg_k _ _) = arg_tr
      in  TypeRep (appKey tr_k arg_k) tc (trs++[arg_tr])
 
-
 -- If we enforce the restriction that there is only one
 -- @TyCon@ for a type & it is shared among all its uses,
 -- we can map them onto Ints very simply. The benefit is,
@@ -203,26 +198,20 @@ mkTyCon :: String	-- ^ the name of the type constructor (should be unique
 	-> TyCon	-- ^ A unique 'TyCon' object
 mkTyCon str = TyCon (mkTyConKey str) str
 
-
-
 ----------------- Observation ---------------------
 
-
 -- | Observe the type constructor of a type representation
 typerepTyCon :: TypeRep -> TyCon
 typerepTyCon (TypeRep _ tc _) = tc
 
-
 -- | Observe the argument types of a type representation
 typerepArgs :: TypeRep -> [TypeRep]
 typerepArgs (TypeRep _ _ args) = args
 
-
 -- | Observe string encoding of a type representation
 tyconString :: TyCon   -> String
 tyconString  (TyCon _ str) = str
 
-
 ----------------- Showing TypeReps --------------------
 
 instance Show TypeRep where
@@ -248,7 +237,6 @@ isTupleTyCon :: TyCon -> Bool
 isTupleTyCon (TyCon _ (',':_)) = True
 isTupleTyCon _		       = False
 
-
 -- Some (Show.TypeRep) helpers:
 
 showArgs :: Show a => [a] -> ShowS
@@ -264,14 +252,12 @@ showTuple (TyCon _ str) args = showChar '(' . go str args
   go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
   go _ _   = showChar ')'
 
-
 -------------------------------------------------------------
 --
 --	The Typeable class and friends
 --
 -------------------------------------------------------------
 
-
 -- | The class 'Typeable' allows a concrete representation of a type to
 -- be calculated.
 class Typeable a where
@@ -292,14 +278,6 @@ typeOfDefault x = typeOf1 x `popStarTy` typeOf (argType x)
    argType :: t a -> a
    argType =  undefined
 
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable instance for all Typeable1 instances
-instance (Typeable1 s, Typeable a)
-       => Typeable (s a) where
-  typeOf = typeOfDefault
-#endif
-
-
 -- | Variant for binary type constructors
 class Typeable2 t where
   typeOf2 :: t a b -> TypeRep
@@ -311,15 +289,6 @@ typeOf1Default x = typeOf2 x `popStarTy` typeOf (argType x)
    argType :: t a b -> a
    argType =  undefined
 
-
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable1 instance for all Typeable2 instances
-instance (Typeable2 s, Typeable a)
-       => Typeable1 (s a) where
-  typeOf1 = typeOf1Default
-#endif
-
-
 -- | Variant for 3-ary type constructors
 class Typeable3 t where
   typeOf3 :: t a b c -> TypeRep
@@ -331,15 +300,6 @@ typeOf2Default x = typeOf3 x `popStarTy` typeOf (argType x)
    argType :: t a b c -> a
    argType =  undefined
 
-
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable2 instance for all Typeable3 instances
-instance (Typeable3 s, Typeable a)
-       => Typeable2 (s a) where
-  typeOf2 = typeOf2Default
-#endif
-
-
 -- | Variant for 4-ary type constructors
 class Typeable4 t where
   typeOf4 :: t a b c d -> TypeRep
@@ -351,15 +311,6 @@ typeOf3Default x = typeOf4 x `popStarTy` typeOf (argType x)
    argType :: t a b c d -> a
    argType =  undefined
 
-
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable3 instance for all Typeable4 instances
-instance (Typeable4 s, Typeable a)
-       => Typeable3 (s a) where
-  typeOf3 = typeOf3Default
-#endif
-
-
 -- | Variant for 5-ary type constructors
 class Typeable5 t where
   typeOf5 :: t a b c d e -> TypeRep
@@ -371,15 +322,6 @@ typeOf4Default x = typeOf5 x `popStarTy` typeOf (argType x)
    argType :: t a b c d e -> a
    argType =  undefined
 
-
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable4 instance for all Typeable5 instances
-instance (Typeable5 s, Typeable a)
-       => Typeable4 (s a) where
-  typeOf4 = typeOf4Default
-#endif
-
-
 -- | Variant for 6-ary type constructors
 class Typeable6 t where
   typeOf6 :: t a b c d e f -> TypeRep
@@ -391,15 +333,6 @@ typeOf5Default x = typeOf6 x `popStarTy` typeOf (argType x)
    argType :: t a b c d e f -> a
    argType =  undefined
 
-
-#ifdef __GLASGOW_HASKELL__
--- | One Typeable5 instance for all Typeable6 instances
-instance (Typeable6 s, Typeable a)
-       => Typeable5 (s a) where
-  typeOf5 = typeOf5Default
-#endif
-
-
 -- | Variant for 7-ary type constructors
 class Typeable7 t where
   typeOf7 :: t a b c d e f g -> TypeRep
@@ -411,15 +344,49 @@ typeOf6Default x = typeOf7 x `popStarTy` typeOf (argType x)
    argType :: t a b c d e f g -> a
    argType =  undefined
 
-
 #ifdef __GLASGOW_HASKELL__
+-- Given a @Typeable@/n/ instance for an /n/-ary type constructor,
+-- define the instances for partial applications.
+-- Programmers using non-GHC implementations must do this manually
+-- for each type constructor.
+-- (The INSTANCE_TYPEABLE/n/ macros in Typeable.h include this.)
+
+-- | One Typeable instance for all Typeable1 instances
+instance (Typeable1 s, Typeable a)
+       => Typeable (s a) where
+  typeOf = typeOfDefault
+
+-- | One Typeable1 instance for all Typeable2 instances
+instance (Typeable2 s, Typeable a)
+       => Typeable1 (s a) where
+  typeOf1 = typeOf1Default
+
+-- | One Typeable2 instance for all Typeable3 instances
+instance (Typeable3 s, Typeable a)
+       => Typeable2 (s a) where
+  typeOf2 = typeOf2Default
+
+-- | One Typeable3 instance for all Typeable4 instances
+instance (Typeable4 s, Typeable a)
+       => Typeable3 (s a) where
+  typeOf3 = typeOf3Default
+
+-- | One Typeable4 instance for all Typeable5 instances
+instance (Typeable5 s, Typeable a)
+       => Typeable4 (s a) where
+  typeOf4 = typeOf4Default
+
+-- | One Typeable5 instance for all Typeable6 instances
+instance (Typeable6 s, Typeable a)
+       => Typeable5 (s a) where
+  typeOf5 = typeOf5Default
+
 -- | One Typeable6 instance for all Typeable7 instances
 instance (Typeable7 s, Typeable a)
        => Typeable6 (s a) where
   typeOf6 = typeOf6Default
-#endif
-
 
+#endif /* __GLASGOW_HASKELL__ */
 
 -------------------------------------------------------------
 --
@@ -435,7 +402,6 @@ cast x = r
                then Just $ unsafeCoerce x
 	       else Nothing
 
-
 -- | A flexible variation parameterised in a type constructor
 gcast :: (Typeable a, Typeable b) => c a -> Maybe (c b)
 gcast x = r
@@ -446,8 +412,6 @@ gcast x = r
   getArg :: c x -> x 
   getArg = undefined
 
-
-
 -- | Cast for * -> *
 gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a)) 
 gcast1 x = r
@@ -458,7 +422,6 @@ gcast1 x = r
   getArg :: c x -> x 
   getArg = undefined
 
-
 -- | Cast for * -> * -> *
 gcast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b)) 
 gcast2 x = r
@@ -469,8 +432,6 @@ gcast2 x = r
   getArg :: c x -> x 
   getArg = undefined
 
-
-
 -------------------------------------------------------------
 --
 --	Instances of the Typeable classes for Prelude types
@@ -493,21 +454,18 @@ tup4Tc = mkTyCon ",,,"
 instance Typeable4 (,,,) where
   typeOf4 tu = mkAppTy tup4Tc []
 
-
 tup5Tc :: TyCon
 tup5Tc = mkTyCon ",,,,"
 
 instance Typeable5 (,,,,) where
   typeOf5 tu = mkAppTy tup5Tc []
 
-
 tup6Tc :: TyCon
 tup6Tc = mkTyCon ",,,,,"
 
 instance Typeable6 (,,,,,) where
   typeOf6 tu = mkAppTy tup6Tc []
 
-
 tup7Tc :: TyCon
 tup7Tc = mkTyCon ",,,,,"
 
diff --git a/include/Typeable.h b/include/Typeable.h
index 364641f..9e3bd86 100644
--- a/include/Typeable.h
+++ b/include/Typeable.h
@@ -1,5 +1,13 @@
 /* ----------------------------------------------------------------------------
  * Macros to help make Typeable instances.
+ *
+ * INSTANCE_TYPEABLEn(tc,tcname,"tc") defines
+ *
+ *	instance Typeable/n/ tc
+ *	instance Typeable a => Typeable/n-1/ (tc a)
+ *	instance (Typeable a, Typeable b) => Typeable/n-2/ (tc a b)
+ *	...
+ *	instance (Typeable a1, ..., Typeable an) => Typeable (tc a1 ... an)
  * -------------------------------------------------------------------------- */
 
 #define INSTANCE_TYPEABLE0(tycon,tcname,str) \
@@ -8,6 +16,9 @@ instance Typeable tycon where { typeOf _ = mkAppTy tcname [] }
 
 #ifdef __GLASGOW_HASKELL__
 
+/* For GHC, the extra instances follow from general instance declarations
+ * defined in Data.Typeable. */
+
 #define INSTANCE_TYPEABLE1(tycon,tcname,str) \
 tcname = mkTyCon str; \
 instance Typeable1 tycon where { typeOf1 _ = mkAppTy tcname [] }
-- 
1.7.10.4