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
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
) where
-
import qualified Data.HashTable as HT
import Data.Maybe
import Data.Either
#include "Typeable.h"
#endif
-
#ifndef __HUGS__
-------------------------------------------------------------
--
-------------------------------------------------------------
-
-- | A concrete representation of a (monomorphic) type. 'TypeRep'
-- supports reasonably efficient equality.
data TypeRep = TypeRep !Key TyCon [TypeRep]
-- sequence of commas, e.g., (mkTyCon ",,,,") returns
-- the 5-tuple tycon.
-
----------------- Construction --------------------
-- | Applies a type constructor to a sequence of types
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,
| 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,
-> 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
isTupleTyCon (TyCon _ (',':_)) = True
isTupleTyCon _ = False
-
-- Some (Show.TypeRep) helpers:
showArgs :: Show a => [a] -> ShowS
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
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
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
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
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
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
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
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__ */
-------------------------------------------------------------
--
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
getArg :: c x -> x
getArg = undefined
-
-
-- | Cast for * -> *
gcast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a))
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
getArg :: c x -> x
getArg = undefined
-
-
-------------------------------------------------------------
--
-- Instances of the Typeable classes for Prelude types
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 ",,,,,"
projects / ghc-base.git / commitdiff