-----------------------------------------------------------------------------
-- |
-- Module : Data.Typeable
--- Copyright : (c) The University of Glasgow 2001
+-- Copyright : (c) The University of Glasgow, CWI 2001--2004
-- License : BSD-style (see the file libraries/base/LICENSE)
--
-- Maintainer : libraries@haskell.org
-- * Type-safe cast
cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
- castss, -- a cast for kind "* -> *"
- castarr, -- another convenient variation
+ cast0, -- a flexible variation on cast
-- * Type representations
TypeRep, -- abstract, instance of: Eq, Show, Typeable
-- * Observation of type representations
typerepTyCon, -- :: TypeRep -> TyCon
typerepArgs, -- :: TypeRep -> [TypeRep]
- tyconString -- :: TyCon -> String
+ tyconString, -- :: TyCon -> String
+ -- * The Typeable1 class
+ Typeable1( typeOf1 ), -- :: t a -> TyCon
+ Typeable2( typeOf2 ), -- :: t a b -> TyCon
+ cast1, -- :: ... => c (t a) -> Maybe (c (t' a))
+ cast2 -- :: ... => c (t a b) -> Maybe (c (t' a b))
) where
else Nothing
--- | A convenient variation for kind \"* -> *\"
-castss :: (Typeable a, Typeable b) => t a -> Maybe (t b)
-castss x = r
- where
- r = if typeOf (get x) == typeOf (get (fromJust r))
- then Just $ unsafeCoerce x
- else Nothing
- get :: t c -> c
- get = undefined
-
-
--- | Another variation
-castarr :: (Typeable a, Typeable b, Typeable c, Typeable d)
- => (a -> t b) -> Maybe (c -> t d)
-castarr x = r
- where
- r = if typeOf (get x) == typeOf (get (fromJust r))
- then Just $ unsafeCoerce x
- else Nothing
- get :: (e -> t f) -> (e, f)
- get = undefined
-
-{-
-
-The variations castss and castarr are arguably not really needed.
-Let's discuss castss in some detail. To get rid of castss, we can
-require "Typeable (t a)" and "Typeable (t b)" rather than just
-"Typeable a" and "Typeable b". In that case, the ordinary cast would
-work. Eventually, all kinds of library instances should become
-Typeable. (There is another potential use of variations as those given
-above. It allows quantification on type constructors.
+-- | A flexible variation parameterised in a type constructor
+cast0 :: (Typeable a, Typeable b) => c a -> Maybe (c b)
+cast0 x = r
+ where
+ r = if typeOf (getArg x) == typeOf (getArg (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ getArg :: c x -> x
+ getArg = undefined
--}
-------------------------------------------------------------
typeOf ((undefined :: (a,b,c,d,e) -> d) tu),
typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]
+tup6Tc :: TyCon
+tup6Tc = mkTyCon ",,,,"
+
+instance ( Typeable a
+ , Typeable b
+ , Typeable c
+ , Typeable d
+ , Typeable e
+ , Typeable f) => Typeable (a,b,c,d,e,f) where
+ typeOf tu = mkAppTy tup6Tc
+ [typeOf ( (undefined :: (a,b,c,d,e,f) -> a) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f) -> b) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f) -> c) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f) -> d) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f) -> e) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f) -> f) tu)]
+
+tup7Tc :: TyCon
+tup7Tc = mkTyCon ",,,,"
+
+instance ( Typeable a
+ , Typeable b
+ , Typeable c
+ , Typeable d
+ , Typeable e
+ , Typeable f
+ , Typeable g) => Typeable (a,b,c,d,e,f,g) where
+ typeOf tu = mkAppTy tup7Tc
+ [typeOf ( (undefined :: (a,b,c,d,e,f,g) -> a) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> b) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> c) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> d) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> e) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> f) tu),
+ typeOf ((undefined :: (a,b,c,d,e,f,g) -> g) tu)]
+
instance (Typeable a, Typeable b) => Typeable (a -> b) where
typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
(typeOf ((undefined :: (a -> b) -> b) f))
INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")
#endif
+#ifdef __GLASGOW_HASKELL__
+INSTANCE_TYPEABLE0(Word,wordTc,"Word" )
+#endif
+
---------------------------------------------
appKeys :: Key -> [Key] -> Key
appKeys k ks = foldl appKey k ks
+
+
+
+------------------------------------------------------------------------------
+--
+-- Typeable adopted for unary type constructors
+-- This adoption is at an experimental stage.
+--
+------------------------------------------------------------------------------
+
+
+-- | Variant for unary type constructors
+class Typeable1 t where
+ typeOf1 :: t a -> TyCon
+
+
+-- | Variant for binary type constructors
+class Typeable2 t where
+ typeOf2 :: t a b -> TyCon
+
+
+#ifndef __NHC__
+
+-- | Instance for lists
+instance Typeable1 [] where
+ typeOf1 _ = typerepTyCon (typeOf (undefined::[()]))
+
+
+-- | Instance for maybes
+instance Typeable1 Maybe where
+ typeOf1 _ = typerepTyCon (typeOf (undefined::Maybe ()))
+
+
+-- | Instance for ratios
+instance Typeable1 Ratio where
+ typeOf1 _ = typerepTyCon (typeOf (undefined::Ratio ()))
+
+
+-- | Instance for products
+instance Typeable2 (,) where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::((),())))
+
+
+-- | Instance for sums
+instance Typeable2 Either where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::Either () ()))
+
+
+-- | Instance for functions
+instance Typeable2 (->) where
+ typeOf2 _ = typerepTyCon (typeOf (undefined::() -> ()))
+
+#endif
+
+
+-- | Cast for * -> *
+cast1 :: (Typeable1 t, Typeable1 t') => c (t a) -> Maybe (c (t' a))
+cast1 x = r
+ where
+ r = if typeOf1 (getArg x) == typeOf1 (getArg (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ getArg :: c x -> x
+ getArg = undefined
+
+
+-- | Cast for * -> * -> *
+cast2 :: (Typeable2 t, Typeable2 t') => c (t a b) -> Maybe (c (t' a b))
+cast2 x = r
+ where
+ r = if typeOf2 (getArg x) == typeOf2 (getArg (fromJust r))
+ then Just $ unsafeCoerce x
+ else Nothing
+ getArg :: c x -> x
+ getArg = undefined