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
30 cast, -- :: (Typeable a, Typeable b) => a -> Maybe b
31 castss, -- a cast for kind "* -> *"
32 castarr, -- another convenient variation
34 -- * Type representations
35 TypeRep, -- abstract, instance of: Eq, Show, Typeable
36 TyCon, -- abstract, instance of: Eq, Show, Typeable
38 -- * Construction of type representations
39 mkTyCon, -- :: String -> TyCon
40 mkAppTy, -- :: TyCon -> [TypeRep] -> TypeRep
41 mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep
42 applyTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep
44 -- * Observation of type representations
45 typerepTyCon, -- :: TypeRep -> TyCon
46 typerepArgs, -- :: TypeRep -> [TypeRep]
47 tyconString -- :: TyCon -> String
53 import qualified Data.HashTable as HT
58 import Data.List( foldl )
60 #ifdef __GLASGOW_HASKELL__
66 import GHC.Real( rem, Ratio )
68 import GHC.Ptr -- So we can give Typeable instance for Ptr
69 import GHC.Stable -- So we can give Typeable instance for StablePtr
79 #ifdef __GLASGOW_HASKELL__
80 unsafeCoerce :: a -> b
81 unsafeCoerce = unsafeCoerce#
85 import NonStdUnsafeCoerce (unsafeCoerce)
86 import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
93 -------------------------------------------------------------
95 -- Type representations
97 -------------------------------------------------------------
100 -- | A concrete representation of a (monomorphic) type. 'TypeRep'
101 -- supports reasonably efficient equality.
102 data TypeRep = TypeRep !Key TyCon [TypeRep]
104 -- Compare keys for equality
105 instance Eq TypeRep where
106 (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
108 -- | An abstract representation of a type constructor. 'TyCon' objects can
109 -- be built using 'mkTyCon'.
110 data TyCon = TyCon !Key String
112 instance Eq TyCon where
113 (TyCon t1 _) == (TyCon t2 _) = t1 == t2
118 -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
121 -- returns "(Foo,Foo,Foo)"
123 -- The TypeRep Show instance promises to print tuple types
124 -- correctly. Tuple type constructors are specified by a
125 -- sequence of commas, e.g., (mkTyCon ",,,,") returns
126 -- the 5-tuple tycon.
128 ----------------- Construction --------------------
130 -- | Applies a type constructor to a sequence of types
131 mkAppTy :: TyCon -> [TypeRep] -> TypeRep
132 mkAppTy tc@(TyCon tc_k _) args
133 = TypeRep (appKeys tc_k arg_ks) tc args
135 arg_ks = [k | TypeRep k _ _ <- args]
140 -- | A special case of 'mkAppTy', which applies the function
141 -- type constructor to a pair of types.
142 mkFunTy :: TypeRep -> TypeRep -> TypeRep
143 mkFunTy f a = mkAppTy funTc [f,a]
145 -- | Applies a type to a function type. Returns: @'Just' u@ if the
146 -- first argument represents a function of type @t -> u@ and the
147 -- second argument represents a function of type @t@. Otherwise,
148 -- returns 'Nothing'.
149 applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
150 applyTy (TypeRep _ tc [t1,t2]) t3
151 | tc == funTc && t1 == t3 = Just t2
152 applyTy _ _ = Nothing
154 -- If we enforce the restriction that there is only one
155 -- @TyCon@ for a type & it is shared among all its uses,
156 -- we can map them onto Ints very simply. The benefit is,
157 -- of course, that @TyCon@s can then be compared efficiently.
159 -- Provided the implementor of other @Typeable@ instances
160 -- takes care of making all the @TyCon@s CAFs (toplevel constants),
163 -- If this constraint does turn out to be a sore thumb, changing
164 -- the Eq instance for TyCons is trivial.
166 -- | Builds a 'TyCon' object representing a type constructor. An
167 -- implementation of "Data.Typeable" should ensure that the following holds:
169 -- > mkTyCon "a" == mkTyCon "a"
172 mkTyCon :: String -- ^ the name of the type constructor (should be unique
173 -- in the program, so it might be wise to use the
174 -- fully qualified name).
175 -> TyCon -- ^ A unique 'TyCon' object
176 mkTyCon str = TyCon (mkTyConKey str) str
180 ----------------- Observation ---------------------
183 -- | Observe the type constructor of a type representation
184 typerepTyCon :: TypeRep -> TyCon
185 typerepTyCon (TypeRep _ tc _) = tc
188 -- | Observe the argument types of a type representation
189 typerepArgs :: TypeRep -> [TypeRep]
190 typerepArgs (TypeRep _ _ args) = args
193 -- | Observe string encoding of a type representation
194 tyconString :: TyCon -> String
195 tyconString (TyCon _ str) = str
198 ----------------- Showing TypeReps --------------------
200 instance Show TypeRep where
201 showsPrec p (TypeRep _ tycon tys) =
203 [] -> showsPrec p tycon
204 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
205 [a,r] | tycon == funTc -> showParen (p > 8) $
206 showsPrec 9 a . showString " -> " . showsPrec 8 r
207 xs | isTupleTyCon tycon -> showTuple tycon xs
214 instance Show TyCon where
215 showsPrec _ (TyCon _ s) = showString s
217 isTupleTyCon :: TyCon -> Bool
218 isTupleTyCon (TyCon _ (',':_)) = True
219 isTupleTyCon _ = False
221 -- Some (Show.TypeRep) helpers:
223 showArgs :: Show a => [a] -> ShowS
225 showArgs [a] = showsPrec 10 a
226 showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
228 showTuple :: TyCon -> [TypeRep] -> ShowS
229 showTuple (TyCon _ str) args = showChar '(' . go str args
231 go [] [a] = showsPrec 10 a . showChar ')'
232 go _ [] = showChar ')' -- a failure condition, really.
233 go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
234 go _ _ = showChar ')'
237 -------------------------------------------------------------
239 -- The Typeable class
241 -------------------------------------------------------------
243 -- | The class 'Typeable' allows a concrete representation of a type to
245 class Typeable a where
246 typeOf :: a -> TypeRep
247 -- ^ Takes a value of type @a@ and returns a concrete representation
248 -- of that type. The /value/ of the argument should be ignored by
249 -- any instance of 'Typeable', so that it is safe to pass 'undefined' as
253 -------------------------------------------------------------
257 -------------------------------------------------------------
259 -- | The type-safe cast operation
260 cast :: (Typeable a, Typeable b) => a -> Maybe b
263 r = if typeOf x == typeOf (fromJust r)
264 then Just $ unsafeCoerce x
268 -- | A convenient variation for kind \"* -> *\"
269 castss :: (Typeable a, Typeable b) => t a -> Maybe (t b)
272 r = if typeOf (get x) == typeOf (get (fromJust r))
273 then Just $ unsafeCoerce x
279 -- | Another variation
280 castarr :: (Typeable a, Typeable b, Typeable c, Typeable d)
281 => (a -> t b) -> Maybe (c -> t d)
284 r = if typeOf (get x) == typeOf (get (fromJust r))
285 then Just $ unsafeCoerce x
287 get :: (e -> t f) -> (e, f)
292 The variations castss and castarr are arguably not really needed.
293 Let's discuss castss in some detail. To get rid of castss, we can
294 require "Typeable (t a)" and "Typeable (t b)" rather than just
295 "Typeable a" and "Typeable b". In that case, the ordinary cast would
296 work. Eventually, all kinds of library instances should become
297 Typeable. (There is another potential use of variations as those given
298 above. It allows quantification on type constructors.
303 -------------------------------------------------------------
305 -- Instances of the Typeable class for Prelude types
307 -------------------------------------------------------------
310 listTc = mkTyCon "[]"
312 instance Typeable a => Typeable [a] where
313 typeOf ls = mkAppTy listTc [typeOf ((undefined :: [a] -> a) ls)]
315 -- typeOf (undefined :: a)
316 -- using scoped type variables, but we use the
317 -- more verbose form here, for compatibility with Hugs
320 unitTc = mkTyCon "()"
322 instance Typeable () where
323 typeOf _ = mkAppTy unitTc []
328 instance (Typeable a, Typeable b) => Typeable (a,b) where
329 typeOf tu = mkAppTy tup2Tc [typeOf ((undefined :: (a,b) -> a) tu),
330 typeOf ((undefined :: (a,b) -> b) tu)]
333 tup3Tc = mkTyCon ",,"
335 instance ( Typeable a , Typeable b , Typeable c) => Typeable (a,b,c) where
336 typeOf tu = mkAppTy tup3Tc [typeOf ((undefined :: (a,b,c) -> a) tu),
337 typeOf ((undefined :: (a,b,c) -> b) tu),
338 typeOf ((undefined :: (a,b,c) -> c) tu)]
341 tup4Tc = mkTyCon ",,,"
343 instance ( Typeable a
346 , Typeable d) => Typeable (a,b,c,d) where
347 typeOf tu = mkAppTy tup4Tc [typeOf ((undefined :: (a,b,c,d) -> a) tu),
348 typeOf ((undefined :: (a,b,c,d) -> b) tu),
349 typeOf ((undefined :: (a,b,c,d) -> c) tu),
350 typeOf ((undefined :: (a,b,c,d) -> d) tu)]
352 tup5Tc = mkTyCon ",,,,"
354 instance ( Typeable a
358 , Typeable e) => Typeable (a,b,c,d,e) where
359 typeOf tu = mkAppTy tup5Tc [typeOf ((undefined :: (a,b,c,d,e) -> a) tu),
360 typeOf ((undefined :: (a,b,c,d,e) -> b) tu),
361 typeOf ((undefined :: (a,b,c,d,e) -> c) tu),
362 typeOf ((undefined :: (a,b,c,d,e) -> d) tu),
363 typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]
365 instance (Typeable a, Typeable b) => Typeable (a -> b) where
366 typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
367 (typeOf ((undefined :: (a -> b) -> b) f))
371 -------------------------------------------------------
373 -- Generate Typeable instances for standard datatypes
375 -------------------------------------------------------
378 INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
379 INSTANCE_TYPEABLE0(Char,charTc,"Char")
380 INSTANCE_TYPEABLE0(Float,floatTc,"Float")
381 INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
382 INSTANCE_TYPEABLE0(Int,intTc,"Int")
383 INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
384 INSTANCE_TYPEABLE1(Ratio,ratioTc,"Ratio")
385 INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
386 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
387 INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
388 INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
389 INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
390 INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
391 INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
393 INSTANCE_TYPEABLE0(Int8,int8Tc,"Int8")
394 INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
395 INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
396 INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
398 INSTANCE_TYPEABLE0(Word8,word8Tc,"Word8" )
399 INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
400 INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
401 INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
403 INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
404 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
406 INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")
411 ---------------------------------------------
415 ---------------------------------------------
418 newtype Key = Key Int deriving( Eq )
421 data KeyPr = KeyPr !Key !Key deriving( Eq )
423 hashKP :: KeyPr -> Int32
424 hashKP (KeyPr (Key k1) (Key k2)) = (HT.hashInt k1 + HT.hashInt k2) `rem` HT.prime
426 data Cache = Cache { next_key :: !(IORef Key),
427 tc_tbl :: !(HT.HashTable String Key),
428 ap_tbl :: !(HT.HashTable KeyPr Key) }
430 {-# NOINLINE cache #-}
432 cache = unsafePerformIO $ do
433 empty_tc_tbl <- HT.new (==) HT.hashString
434 empty_ap_tbl <- HT.new (==) hashKP
435 key_loc <- newIORef (Key 1)
436 return (Cache { next_key = key_loc,
437 tc_tbl = empty_tc_tbl,
438 ap_tbl = empty_ap_tbl })
440 newKey :: IORef Key -> IO Key
441 #ifdef __GLASGOW_HASKELL__
442 newKey kloc = do i <- genSym; return (Key i)
444 newKey kloc = do { k@(Key i) <- readIORef kloc ;
445 writeIORef kloc (Key (i+1)) ;
449 #ifdef __GLASGOW_HASKELL__
450 -- In GHC we use the RTS's genSym function to get a new unique,
451 -- because in GHCi we might have two copies of the Data.Typeable
452 -- library running (one in the compiler and one in the running
453 -- program), and we need to make sure they don't share any keys.
455 -- This is really a hack. A better solution would be to centralise the
456 -- whole mutable state used by this module, i.e. both hashtables. But
457 -- the current solution solves the immediate problem, which is that
458 -- dynamics generated in one world with one type were erroneously
459 -- being recognised by the other world as having a different type.
460 foreign import ccall unsafe "genSymZh"
464 mkTyConKey :: String -> Key
466 = unsafePerformIO $ do
467 let Cache {next_key = kloc, tc_tbl = tbl} = cache
468 mb_k <- HT.lookup tbl str
471 Nothing -> do { k <- newKey kloc ;
472 HT.insert tbl str k ;
475 appKey :: Key -> Key -> Key
477 = unsafePerformIO $ do
478 let Cache {next_key = kloc, ap_tbl = tbl} = cache
479 mb_k <- HT.lookup tbl kpr
482 Nothing -> do { k <- newKey kloc ;
483 HT.insert tbl kpr k ;
488 appKeys :: Key -> [Key] -> Key
489 appKeys k ks = foldl appKey k ks