Move `Maybe`-typedef into GHC.Base
[ghc.git] / libraries / base / Data / Typeable / Internal.hs
1 {-# LANGUAGE Unsafe #-}
2 {-# LANGUAGE BangPatterns #-}
3
4 -----------------------------------------------------------------------------
5 -- |
6 -- Module : Data.Typeable.Internal
7 -- Copyright : (c) The University of Glasgow, CWI 2001--2011
8 -- License : BSD-style (see the file libraries/base/LICENSE)
9 --
10 -- The representations of the types TyCon and TypeRep, and the
11 -- function mkTyCon which is used by derived instances of Typeable to
12 -- construct a TyCon.
13 --
14 -----------------------------------------------------------------------------
15
16 {-# LANGUAGE CPP
17 , NoImplicitPrelude
18 , OverlappingInstances
19 , ScopedTypeVariables
20 , FlexibleInstances
21 , MagicHash
22 , KindSignatures
23 , PolyKinds
24 , ConstraintKinds
25 , DeriveDataTypeable
26 , DataKinds
27 , UndecidableInstances
28 , StandaloneDeriving #-}
29
30 module Data.Typeable.Internal (
31 Proxy (..),
32 TypeRep(..),
33 Fingerprint(..),
34 typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,
35 Typeable1, Typeable2, Typeable3, Typeable4, Typeable5, Typeable6, Typeable7,
36 TyCon(..),
37 typeRep,
38 mkTyCon,
39 mkTyCon3,
40 mkTyConApp,
41 mkAppTy,
42 typeRepTyCon,
43 Typeable(..),
44 mkFunTy,
45 splitTyConApp,
46 funResultTy,
47 typeRepArgs,
48 showsTypeRep,
49 tyConString,
50 listTc, funTc
51 ) where
52
53 import GHC.Base
54 import GHC.Word
55 import GHC.Show
56 import GHC.Read ( Read )
57 import Data.Proxy
58 import GHC.Num
59 import GHC.Real
60 -- import GHC.IORef
61 -- import GHC.IOArray
62 -- import GHC.MVar
63 import GHC.ST ( ST, STret )
64 import GHC.STRef ( STRef )
65 import GHC.Ptr ( Ptr, FunPtr )
66 -- import GHC.Stable
67 import GHC.Arr ( Array, STArray, Ix )
68 import GHC.TypeLits ( Nat, Symbol, KnownNat, KnownSymbol, natVal', symbolVal' )
69 import Data.Type.Coercion
70 import Data.Type.Equality
71 import Text.ParserCombinators.ReadP ( ReadP )
72 import Text.Read.Lex ( Lexeme, Number )
73 import Text.ParserCombinators.ReadPrec ( ReadPrec )
74 import GHC.Float ( FFFormat, RealFloat, Floating )
75 import Data.Bits ( Bits, FiniteBits )
76 import GHC.Enum ( Bounded, Enum )
77 import Control.Monad ( MonadPlus )
78 -- import Data.Int
79
80 import GHC.Fingerprint.Type
81 import {-# SOURCE #-} GHC.Fingerprint
82 -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable
83 -- Better to break the loop here, because we want non-SOURCE imports
84 -- of Data.Typeable as much as possible so we can optimise the derived
85 -- instances.
86
87 -- | A concrete representation of a (monomorphic) type. 'TypeRep'
88 -- supports reasonably efficient equality.
89 data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [TypeRep]
90
91 -- Compare keys for equality
92 instance Eq TypeRep where
93 (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
94
95 instance Ord TypeRep where
96 (TypeRep k1 _ _) <= (TypeRep k2 _ _) = k1 <= k2
97
98 -- | An abstract representation of a type constructor. 'TyCon' objects can
99 -- be built using 'mkTyCon'.
100 data TyCon = TyCon {
101 tyConHash :: {-# UNPACK #-} !Fingerprint,
102 tyConPackage :: String, -- ^ /Since: 4.5.0.0/
103 tyConModule :: String, -- ^ /Since: 4.5.0.0/
104 tyConName :: String -- ^ /Since: 4.5.0.0/
105 }
106
107 instance Eq TyCon where
108 (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2
109
110 instance Ord TyCon where
111 (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2
112
113 ----------------- Construction --------------------
114
115 #include "MachDeps.h"
116
117 -- mkTyCon is an internal function to make it easier for GHC to
118 -- generate derived instances. GHC precomputes the MD5 hash for the
119 -- TyCon and passes it as two separate 64-bit values to mkTyCon. The
120 -- TyCon for a derived Typeable instance will end up being statically
121 -- allocated.
122
123 #if WORD_SIZE_IN_BITS < 64
124 mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
125 #else
126 mkTyCon :: Word# -> Word# -> String -> String -> String -> TyCon
127 #endif
128 mkTyCon high# low# pkg modl name
129 = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name
130
131 -- | Applies a type constructor to a sequence of types
132 mkTyConApp :: TyCon -> [TypeRep] -> TypeRep
133 mkTyConApp tc@(TyCon tc_k _ _ _) []
134 = TypeRep tc_k tc [] -- optimisation: all derived Typeable instances
135 -- end up here, and it helps generate smaller
136 -- code for derived Typeable.
137 mkTyConApp tc@(TyCon tc_k _ _ _) args
138 = TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc args
139 where
140 arg_ks = [k | TypeRep k _ _ <- args]
141
142 -- | A special case of 'mkTyConApp', which applies the function
143 -- type constructor to a pair of types.
144 mkFunTy :: TypeRep -> TypeRep -> TypeRep
145 mkFunTy f a = mkTyConApp funTc [f,a]
146
147 -- | Splits a type constructor application
148 splitTyConApp :: TypeRep -> (TyCon,[TypeRep])
149 splitTyConApp (TypeRep _ tc trs) = (tc,trs)
150
151 -- | Applies a type to a function type. Returns: @'Just' u@ if the
152 -- first argument represents a function of type @t -> u@ and the
153 -- second argument represents a function of type @t@. Otherwise,
154 -- returns 'Nothing'.
155 funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
156 funResultTy trFun trArg
157 = case splitTyConApp trFun of
158 (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
159 _ -> Nothing
160
161 -- | Adds a TypeRep argument to a TypeRep.
162 mkAppTy :: TypeRep -> TypeRep -> TypeRep
163 mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr])
164 -- Notice that we call mkTyConApp to construct the fingerprint from tc and
165 -- the arg fingerprints. Simply combining the current fingerprint with
166 -- the new one won't give the same answer, but of course we want to
167 -- ensure that a TypeRep of the same shape has the same fingerprint!
168 -- See Trac #5962
169
170 -- | Builds a 'TyCon' object representing a type constructor. An
171 -- implementation of "Data.Typeable" should ensure that the following holds:
172 --
173 -- > A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'
174 --
175
176 --
177 mkTyCon3 :: String -- ^ package name
178 -> String -- ^ module name
179 -> String -- ^ the name of the type constructor
180 -> TyCon -- ^ A unique 'TyCon' object
181 mkTyCon3 pkg modl name =
182 TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name
183
184 ----------------- Observation ---------------------
185
186 -- | Observe the type constructor of a type representation
187 typeRepTyCon :: TypeRep -> TyCon
188 typeRepTyCon (TypeRep _ tc _) = tc
189
190 -- | Observe the argument types of a type representation
191 typeRepArgs :: TypeRep -> [TypeRep]
192 typeRepArgs (TypeRep _ _ args) = args
193
194 -- | Observe string encoding of a type representation
195 {-# DEPRECATED tyConString "renamed to 'tyConName'; 'tyConModule' and 'tyConPackage' are also available." #-} -- deprecated in 7.4
196 tyConString :: TyCon -> String
197 tyConString = tyConName
198
199 -------------------------------------------------------------
200 --
201 -- The Typeable class and friends
202 --
203 -------------------------------------------------------------
204
205 -- | The class 'Typeable' allows a concrete representation of a type to
206 -- be calculated.
207 class Typeable a where
208 typeRep# :: Proxy# a -> TypeRep
209
210 -- | Takes a value of type @a@ and returns a concrete representation
211 -- of that type.
212 --
213 -- /Since: 4.7.0.0/
214 typeRep :: forall proxy a. Typeable a => proxy a -> TypeRep
215 typeRep _ = typeRep# (proxy# :: Proxy# a)
216 {-# INLINE typeRep #-}
217
218 -- Keeping backwards-compatibility
219 typeOf :: forall a. Typeable a => a -> TypeRep
220 typeOf _ = typeRep (Proxy :: Proxy a)
221
222 typeOf1 :: forall t (a :: *). Typeable t => t a -> TypeRep
223 typeOf1 _ = typeRep (Proxy :: Proxy t)
224
225 typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep
226 typeOf2 _ = typeRep (Proxy :: Proxy t)
227
228 typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t
229 => t a b c -> TypeRep
230 typeOf3 _ = typeRep (Proxy :: Proxy t)
231
232 typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t
233 => t a b c d -> TypeRep
234 typeOf4 _ = typeRep (Proxy :: Proxy t)
235
236 typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t
237 => t a b c d e -> TypeRep
238 typeOf5 _ = typeRep (Proxy :: Proxy t)
239
240 typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *).
241 Typeable t => t a b c d e f -> TypeRep
242 typeOf6 _ = typeRep (Proxy :: Proxy t)
243
244 typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)
245 (g :: *). Typeable t => t a b c d e f g -> TypeRep
246 typeOf7 _ = typeRep (Proxy :: Proxy t)
247
248 type Typeable1 (a :: * -> *) = Typeable a
249 type Typeable2 (a :: * -> * -> *) = Typeable a
250 type Typeable3 (a :: * -> * -> * -> *) = Typeable a
251 type Typeable4 (a :: * -> * -> * -> * -> *) = Typeable a
252 type Typeable5 (a :: * -> * -> * -> * -> * -> *) = Typeable a
253 type Typeable6 (a :: * -> * -> * -> * -> * -> * -> *) = Typeable a
254 type Typeable7 (a :: * -> * -> * -> * -> * -> * -> * -> *) = Typeable a
255
256 {-# DEPRECATED Typeable1 "renamed to 'Typeable'" #-} -- deprecated in 7.8
257 {-# DEPRECATED Typeable2 "renamed to 'Typeable'" #-} -- deprecated in 7.8
258 {-# DEPRECATED Typeable3 "renamed to 'Typeable'" #-} -- deprecated in 7.8
259 {-# DEPRECATED Typeable4 "renamed to 'Typeable'" #-} -- deprecated in 7.8
260 {-# DEPRECATED Typeable5 "renamed to 'Typeable'" #-} -- deprecated in 7.8
261 {-# DEPRECATED Typeable6 "renamed to 'Typeable'" #-} -- deprecated in 7.8
262 {-# DEPRECATED Typeable7 "renamed to 'Typeable'" #-} -- deprecated in 7.8
263
264 -- | Kind-polymorphic Typeable instance for type application
265 instance (Typeable s, Typeable a) => Typeable (s a) where
266 -- See Note [The apparent incoherence of Typable]
267 typeRep# = \_ -> rep -- Note [Memoising typeOf]
268 where !ty1 = typeRep# (proxy# :: Proxy# s)
269 !ty2 = typeRep# (proxy# :: Proxy# a)
270 !rep = ty1 `mkAppTy` ty2
271
272 {- Note [Memoising typeOf]
273 ~~~~~~~~~~~~~~~~~~~~~~~~~~
274 See #3245, #9203
275
276 IMPORTANT: we don't want to recalculate the TypeRep once per call with
277 the proxy argument. This is what went wrong in #3245 and #9203. So we
278 help GHC by manually keeping the 'rep' *outside* the lambda.
279 -}
280
281 ----------------- Showing TypeReps --------------------
282
283 instance Show TypeRep where
284 showsPrec p (TypeRep _ tycon tys) =
285 case tys of
286 [] -> showsPrec p tycon
287 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
288 [a,r] | tycon == funTc -> showParen (p > 8) $
289 showsPrec 9 a .
290 showString " -> " .
291 showsPrec 8 r
292 xs | isTupleTyCon tycon -> showTuple xs
293 | otherwise ->
294 showParen (p > 9) $
295 showsPrec p tycon .
296 showChar ' ' .
297 showArgs (showChar ' ') tys
298
299 showsTypeRep :: TypeRep -> ShowS
300 showsTypeRep = shows
301
302 instance Show TyCon where
303 showsPrec _ t = showString (tyConName t)
304
305 isTupleTyCon :: TyCon -> Bool
306 isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True
307 isTupleTyCon _ = False
308
309 -- Some (Show.TypeRep) helpers:
310
311 showArgs :: Show a => ShowS -> [a] -> ShowS
312 showArgs _ [] = id
313 showArgs _ [a] = showsPrec 10 a
314 showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as
315
316 showTuple :: [TypeRep] -> ShowS
317 showTuple args = showChar '('
318 . showArgs (showChar ',') args
319 . showChar ')'
320
321 listTc :: TyCon
322 listTc = typeRepTyCon (typeOf [()])
323
324 funTc :: TyCon
325 funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->)))
326
327 -------------------------------------------------------------
328 --
329 -- Instances of the Typeable classes for Prelude types
330 --
331 -------------------------------------------------------------
332
333 deriving instance Typeable ()
334 deriving instance Typeable []
335 deriving instance Typeable Maybe
336 deriving instance Typeable Ratio
337 deriving instance Typeable (->)
338 deriving instance Typeable IO
339
340 deriving instance Typeable Array
341
342 deriving instance Typeable ST
343 deriving instance Typeable STret
344 deriving instance Typeable STRef
345 deriving instance Typeable STArray
346
347 deriving instance Typeable (,)
348 deriving instance Typeable (,,)
349 deriving instance Typeable (,,,)
350 deriving instance Typeable (,,,,)
351 deriving instance Typeable (,,,,,)
352 deriving instance Typeable (,,,,,,)
353
354 deriving instance Typeable Ptr
355 deriving instance Typeable FunPtr
356
357 -------------------------------------------------------
358 --
359 -- Generate Typeable instances for standard datatypes
360 --
361 -------------------------------------------------------
362
363 deriving instance Typeable Bool
364 deriving instance Typeable Char
365 deriving instance Typeable Float
366 deriving instance Typeable Double
367 deriving instance Typeable Int
368 deriving instance Typeable Word
369 deriving instance Typeable Integer
370 deriving instance Typeable Ordering
371
372 deriving instance Typeable Word8
373 deriving instance Typeable Word16
374 deriving instance Typeable Word32
375 deriving instance Typeable Word64
376
377 deriving instance Typeable TyCon
378 deriving instance Typeable TypeRep
379 deriving instance Typeable Fingerprint
380
381 deriving instance Typeable RealWorld
382 deriving instance Typeable Proxy
383 deriving instance Typeable KProxy
384 deriving instance Typeable (:~:)
385 deriving instance Typeable Coercion
386
387 deriving instance Typeable ReadP
388 deriving instance Typeable Lexeme
389 deriving instance Typeable Number
390 deriving instance Typeable ReadPrec
391
392 deriving instance Typeable FFFormat
393
394 -------------------------------------------------------
395 --
396 -- Generate Typeable instances for standard classes
397 --
398 -------------------------------------------------------
399
400 deriving instance Typeable (~)
401 deriving instance Typeable Coercible
402 deriving instance Typeable TestEquality
403 deriving instance Typeable TestCoercion
404
405 deriving instance Typeable Eq
406 deriving instance Typeable Ord
407
408 deriving instance Typeable Bits
409 deriving instance Typeable FiniteBits
410 deriving instance Typeable Num
411 deriving instance Typeable Real
412 deriving instance Typeable Integral
413 deriving instance Typeable Fractional
414 deriving instance Typeable RealFrac
415 deriving instance Typeable Floating
416 deriving instance Typeable RealFloat
417
418 deriving instance Typeable Bounded
419 deriving instance Typeable Enum
420 deriving instance Typeable Ix
421
422 deriving instance Typeable Show
423 deriving instance Typeable Read
424
425 deriving instance Typeable Functor
426 deriving instance Typeable Monad
427 deriving instance Typeable MonadPlus
428
429 deriving instance Typeable Typeable
430
431
432
433 --------------------------------------------------------------------------------
434 -- Instances for type literals
435
436 {- Note [Potential Collisions in `Nat` and `Symbol` instances]
437
438 Kinds resulting from lifted types have finitely many type-constructors.
439 This is not the case for `Nat` and `Symbol`, which both contain *infinitely*
440 many type constructors (e.g., `Nat` has 0, 1, 2, 3, etc.). One might think
441 that this would increase the chance of hash-collisions in the type but this
442 is not the case because the fingerprint stored in a `TypeRep` identifies
443 the whole *type* and not just the type constructor. This is why the chance
444 of collisions for `Nat` and `Symbol` is not any worse than it is for other
445 lifted types with infinitely many inhabitants. Indeed, `Nat` is
446 isomorphic to (lifted) `[()]` and `Symbol` is isomorphic to `[Char]`.
447 -}
448
449 {- Note [The apparent incoherence of Typable] See Trac #9242
450 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
451 The reason we have INCOHERENT on Typeable (n:Nat) and Typeable (s:Symbol)
452 because we also have an instance Typable (f a). Now suppose we have
453 [Wanted] Typeable (a :: Nat)
454 we should pick the (x::Nat) instance, even though the instance
455 matching rules would worry that 'a' might later be instantiated to
456 (f b), for some f and b. But we type theorists know that there are no
457 type constructors f of kind blah -> Nat, so this can never happen and
458 it's safe to pick the second instance. -}
459
460
461 instance {-# INCOHERENT #-} KnownNat n => Typeable (n :: Nat) where
462 -- See Note [The apparent incoherence of Typable]
463 -- See #9203 for an explanation of why this is written as `\_ -> rep`.
464 typeRep# = \_ -> rep
465 where
466 rep = mkTyConApp tc []
467 tc = TyCon
468 { tyConHash = fingerprintString (mk pack modu nm)
469 , tyConPackage = pack
470 , tyConModule = modu
471 , tyConName = nm
472 }
473 pack = "base"
474 modu = "GHC.TypeLits"
475 nm = show (natVal' (proxy# :: Proxy# n))
476 mk a b c = a ++ " " ++ b ++ " " ++ c
477
478
479 instance {-# INCOHERENT #-} KnownSymbol s => Typeable (s :: Symbol) where
480 -- See Note [The apparent incoherence of Typable]
481 -- See #9203 for an explanation of why this is written as `\_ -> rep`.
482 typeRep# = \_ -> rep
483 where
484 rep = mkTyConApp tc []
485 tc = TyCon
486 { tyConHash = fingerprintString (mk pack modu nm)
487 , tyConPackage = pack
488 , tyConModule = modu
489 , tyConName = nm
490 }
491 pack = "base"
492 modu = "GHC.TypeLits"
493 nm = show (symbolVal' (proxy# :: Proxy# s))
494 mk a b c = a ++ " " ++ b ++ " " ++ c
495