1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Typeable
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/base/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
12 -- The Typeable class reifies types to some extent by associating type
13 -- representations to types. These type representations can be compared,
14 -- and one can in turn define a type-safe cast operation. To this end,
15 -- an unsafe cast is guarded by a test for type (representation)
16 -- equivalence. The module Data.Dynamic uses Typeable for an
17 -- implementation of dynamics. The module Data.Generics uses Typeable
18 -- and type-safe cast (but not dynamics) to support the "Scrap your
19 -- boilerplate" style of generic programming.
21 -----------------------------------------------------------------------------
26 -- * The Typeable class
27 Typeable( typeOf ), -- :: a -> TypeRep
29 -- * Type-safe cast and other clients
30 cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
31 sameType, -- two type values are the same
33 -- * Type representations
34 TypeRep, -- abstract, instance of: Eq, Show, Typeable
35 TyCon, -- abstract, instance of: Eq, Show, Typeable
37 -- * Construction of type representations
38 mkTyCon, -- :: String -> TyCon
39 mkAppTy, -- :: TyCon -> [TypeRep] -> TypeRep
40 mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
41 applyTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
44 TypeVal, -- view type "a" as "a -> ()"
45 typeVal, -- :: TypeVal a
46 typeValOf, -- :: a -> TypeVal a
47 undefinedType, -- :: TypeVal a -> a
48 withType, -- :: a -> TypeVal a -> a
49 argType, -- :: (a -> b) -> TypeVal a
50 resType, -- :: (a -> b) -> TypeVal b
51 paraType, -- :: t a -> TypeVal a
52 TypeFun -- functions on types
57 import qualified Data.HashTable as HT
62 import Data.List( foldl )
64 #ifdef __GLASGOW_HASKELL__
70 import GHC.Real( rem, Ratio )
72 import GHC.Ptr -- So we can give Typeable instance for Ptr
73 import GHC.Stable -- So we can give Typeable instance for StablePtr
83 #ifdef __GLASGOW_HASKELL__
84 unsafeCoerce :: a -> b
85 unsafeCoerce = unsafeCoerce#
89 import NonStdUnsafeCoerce (unsafeCoerce)
90 import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
97 -------------------------------------------------------------
99 -- Type representations
101 -------------------------------------------------------------
104 -- | A concrete representation of a (monomorphic) type. 'TypeRep'
105 -- supports reasonably efficient equality.
106 data TypeRep = TypeRep !Key TyCon [TypeRep]
108 -- Compare keys for equality
109 instance Eq TypeRep where
110 (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
112 -- | An abstract representation of a type constructor. 'TyCon' objects can
113 -- be built using 'mkTyCon'.
114 data TyCon = TyCon !Key String
116 instance Eq TyCon where
117 (TyCon t1 _) == (TyCon t2 _) = t1 == t2
122 -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
125 -- returns "(Foo,Foo,Foo)"
127 -- The TypeRep Show instance promises to print tuple types
128 -- correctly. Tuple type constructors are specified by a
129 -- sequence of commas, e.g., (mkTyCon ",,,,") returns
130 -- the 5-tuple tycon.
132 ----------------- Construction --------------------
134 -- | Applies a type constructor to a sequence of types
135 mkAppTy :: TyCon -> [TypeRep] -> TypeRep
136 mkAppTy tc@(TyCon tc_k _) args
137 = TypeRep (appKeys tc_k arg_ks) tc args
139 arg_ks = [k | TypeRep k _ _ <- args]
144 -- | A special case of 'mkAppTy', which applies the function
145 -- type constructor to a pair of types.
146 mkFunTy :: TypeRep -> TypeRep -> TypeRep
147 mkFunTy f a = mkAppTy funTc [f,a]
149 -- | Applies a type to a function type. Returns: @'Just' u@ if the
150 -- first argument represents a function of type @t -> u@ and the
151 -- second argument represents a function of type @t@. Otherwise,
152 -- returns 'Nothing'.
153 applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
154 applyTy (TypeRep _ tc [t1,t2]) t3
155 | tc == funTc && t1 == t3 = Just t2
156 applyTy _ _ = Nothing
158 -- If we enforce the restriction that there is only one
159 -- @TyCon@ for a type & it is shared among all its uses,
160 -- we can map them onto Ints very simply. The benefit is,
161 -- of course, that @TyCon@s can then be compared efficiently.
163 -- Provided the implementor of other @Typeable@ instances
164 -- takes care of making all the @TyCon@s CAFs (toplevel constants),
167 -- If this constraint does turn out to be a sore thumb, changing
168 -- the Eq instance for TyCons is trivial.
170 -- | Builds a 'TyCon' object representing a type constructor. An
171 -- implementation of "Data.Typeable" should ensure that the following holds:
173 -- > mkTyCon "a" == mkTyCon "a"
176 mkTyCon :: String -- ^ the name of the type constructor (should be unique
177 -- in the program, so it might be wise to use the
178 -- fully qualified name).
179 -> TyCon -- ^ A unique 'TyCon' object
180 mkTyCon str = TyCon (mkTyConKey str) str
184 ----------------- Showing TypeReps --------------------
186 instance Show TypeRep where
187 showsPrec p (TypeRep _ tycon tys) =
189 [] -> showsPrec p tycon
190 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
191 [a,r] | tycon == funTc -> showParen (p > 8) $
192 showsPrec 9 a . showString " -> " . showsPrec 8 r
193 xs | isTupleTyCon tycon -> showTuple tycon xs
200 instance Show TyCon where
201 showsPrec _ (TyCon _ s) = showString s
203 isTupleTyCon :: TyCon -> Bool
204 isTupleTyCon (TyCon _ (',':_)) = True
205 isTupleTyCon _ = False
207 -- Some (Show.TypeRep) helpers:
209 showArgs :: Show a => [a] -> ShowS
211 showArgs [a] = showsPrec 10 a
212 showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
214 showTuple :: TyCon -> [TypeRep] -> ShowS
215 showTuple (TyCon _ str) args = showChar '(' . go str args
217 go [] [a] = showsPrec 10 a . showChar ')'
218 go _ [] = showChar ')' -- a failure condition, really.
219 go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
220 go _ _ = showChar ')'
223 -------------------------------------------------------------
225 -- The Typeable class
227 -------------------------------------------------------------
229 -- | The class 'Typeable' allows a concrete representation of a type to
231 class Typeable a where
232 typeOf :: a -> TypeRep
233 -- ^ Takes a value of type @a@ and returns a concrete representation
234 -- of that type. The /value/ of the argument should be ignored by
235 -- any instance of 'Typeable', so that it is safe to pass 'undefined' as
239 -------------------------------------------------------------
241 -- Type-safe cast and other clients
243 -------------------------------------------------------------
245 -- | The type-safe cast operation
246 cast :: (Typeable a, Typeable b) => a -> Maybe b
249 r = if typeOf x == typeOf (fromJust r) then
250 Just (unsafeCoerce x)
255 -- | Test for type equivalence
256 sameType :: (Typeable a, Typeable b) => TypeVal a -> TypeVal b -> Bool
257 sameType tva tvb = typeOf (undefinedType tva) ==
258 typeOf (undefinedType tvb)
261 -------------------------------------------------------------
263 -- Instances of the Typeable class for Prelude types
265 -------------------------------------------------------------
268 listTc = mkTyCon "[]"
270 instance Typeable a => Typeable [a] where
271 typeOf ls = mkAppTy listTc [typeOf ((undefined :: [a] -> a) ls)]
273 -- typeOf (undefined :: a)
274 -- using scoped type variables, but we use the
275 -- more verbose form here, for compatibility with Hugs
278 unitTc = mkTyCon "()"
280 instance Typeable () where
281 typeOf _ = mkAppTy unitTc []
286 instance (Typeable a, Typeable b) => Typeable (a,b) where
287 typeOf tu = mkAppTy tup2Tc [typeOf ((undefined :: (a,b) -> a) tu),
288 typeOf ((undefined :: (a,b) -> b) tu)]
291 tup3Tc = mkTyCon ",,"
293 instance ( Typeable a , Typeable b , Typeable c) => Typeable (a,b,c) where
294 typeOf tu = mkAppTy tup3Tc [typeOf ((undefined :: (a,b,c) -> a) tu),
295 typeOf ((undefined :: (a,b,c) -> b) tu),
296 typeOf ((undefined :: (a,b,c) -> c) tu)]
299 tup4Tc = mkTyCon ",,,"
301 instance ( Typeable a
304 , Typeable d) => Typeable (a,b,c,d) where
305 typeOf tu = mkAppTy tup4Tc [typeOf ((undefined :: (a,b,c,d) -> a) tu),
306 typeOf ((undefined :: (a,b,c,d) -> b) tu),
307 typeOf ((undefined :: (a,b,c,d) -> c) tu),
308 typeOf ((undefined :: (a,b,c,d) -> d) tu)]
310 tup5Tc = mkTyCon ",,,,"
312 instance ( Typeable a
316 , Typeable e) => Typeable (a,b,c,d,e) where
317 typeOf tu = mkAppTy tup5Tc [typeOf ((undefined :: (a,b,c,d,e) -> a) tu),
318 typeOf ((undefined :: (a,b,c,d,e) -> b) tu),
319 typeOf ((undefined :: (a,b,c,d,e) -> c) tu),
320 typeOf ((undefined :: (a,b,c,d,e) -> d) tu),
321 typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]
323 instance (Typeable a, Typeable b) => Typeable (a -> b) where
324 typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
325 (typeOf ((undefined :: (a -> b) -> b) f))
328 -------------------------------------------------------------
332 -------------------------------------------------------------
336 This group provides a style of encoding types as values and using
337 them. This style is seen as an alternative to the pragmatic style used
338 in Data.Typeable.typeOf and elsewhere, i.e., simply use an "undefined"
339 to denote a type argument. This pragmatic style suffers from lack
340 of robustness: one feels tempted to pattern match on undefineds.
341 Maybe Data.Typeable.typeOf etc. should be rewritten accordingly.
346 -- | Type as values to stipulate use of undefineds
347 type TypeVal a = a -> ()
350 -- | The value that denotes a type
355 -- | Map a value to its type
356 typeValOf :: a -> TypeVal a
357 typeValOf _ = typeVal
360 -- | Stipulate this idiom!
361 undefinedType :: TypeVal a -> a
362 undefinedType _ = undefined
365 -- | Constrain a type
366 withType :: a -> TypeVal a -> a
370 -- | The argument type of a function
371 argType :: (a -> b) -> TypeVal a
375 -- | The result type of a function
376 resType :: (a -> b) -> TypeVal b
380 -- | The parameter type of type constructor
381 paraType :: t a -> TypeVal a
386 -- i.e., functions mapping types to values
388 type TypeFun a r = TypeVal a -> r
392 -------------------------------------------------------
394 -- Generate Typeable instances for standard datatypes
396 -------------------------------------------------------
399 INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
400 INSTANCE_TYPEABLE0(Char,charTc,"Char")
401 INSTANCE_TYPEABLE0(Float,floatTc,"Float")
402 INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
403 INSTANCE_TYPEABLE0(Int,intTc,"Int")
404 INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
405 INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
406 INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
407 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
408 INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
409 INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
410 INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
411 INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
412 INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
414 INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
415 INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
416 INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
417 INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
419 INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )
420 INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
421 INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
422 INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
424 INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
425 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
427 INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")
431 ---------------------------------------------
435 ---------------------------------------------
438 newtype Key = Key Int deriving( Eq )
441 data KeyPr = KeyPr !Key !Key deriving( Eq )
443 hashKP :: KeyPr -> Int32
444 hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime
446 data Cache = Cache { next_key :: !(IORef Key),
447 tc_tbl :: !(HT.HashTable String Key),
448 ap_tbl :: !(HT.HashTable KeyPr Key) }
450 {-# NOINLINE cache #-}
452 cache = unsafePerformIO $ do
453 empty_tc_tbl <- HT.new (==) HT.hashString
454 empty_ap_tbl <- HT.new (==) hashKP
455 key_loc <- newIORef (Key 1)
456 return (Cache { next_key = key_loc,
457 tc_tbl = empty_tc_tbl,
458 ap_tbl = empty_ap_tbl })
460 newKey :: IORef Key -> IO Key
461 newKey kloc = do { k@(Key i) <- readIORef kloc ;
462 writeIORef kloc (Key (i+1)) ;
465 mkTyConKey :: String -> Key
467 = unsafePerformIO $ do
468 let Cache {next_key = kloc, tc_tbl = tbl} = cache
469 mb_k <- HT.lookup tbl str
472 Nothing -> do { k <- newKey kloc ;
473 HT.insert tbl str k ;
476 appKey :: Key -> Key -> Key
478 = unsafePerformIO $ do
479 let Cache {next_key = kloc, ap_tbl = tbl} = cache
480 mb_k <- HT.lookup tbl kpr
483 Nothing -> do { k <- newKey kloc ;
484 HT.insert tbl kpr k ;
489 appKeys :: Key -> [Key] -> Key
490 appKeys k ks = foldl appKey k ks