447b0692930ca4ba62c24fc1c8a7e16f7acd4875
[packages/base.git] / Data / Typeable / Internal.hs
1 {-# LANGUAGE Unsafe #-}
2
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module : Data.Typeable.Internal
6 -- Copyright : (c) The University of Glasgow, CWI 2001--2011
7 -- License : BSD-style (see the file libraries/base/LICENSE)
8 --
9 -- The representations of the types TyCon and TypeRep, and the
10 -- function mkTyCon which is used by derived instances of Typeable to
11 -- construct a TyCon.
12 --
13 -----------------------------------------------------------------------------
14
15 {-# LANGUAGE CPP
16 , NoImplicitPrelude
17 , OverlappingInstances
18 , ScopedTypeVariables
19 , FlexibleInstances
20 , MagicHash
21 , KindSignatures
22 , PolyKinds
23 , DeriveDataTypeable
24 , StandaloneDeriving #-}
25
26 module Data.Typeable.Internal (
27 Proxy (..),
28 TypeRep(..),
29 Fingerprint(..),
30 typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7,
31 TyCon(..),
32 mkTyCon,
33 mkTyCon3,
34 mkTyConApp,
35 mkAppTy,
36 typeRepTyCon,
37 Typeable(..),
38 mkFunTy,
39 splitTyConApp,
40 funResultTy,
41 typeRepArgs,
42 showsTypeRep,
43 tyConString,
44 listTc, funTc
45 ) where
46
47 import GHC.Base
48 import GHC.Word
49 import GHC.Show
50 import Data.Maybe
51 import Data.Proxy
52 import GHC.Num
53 import GHC.Real
54 -- import GHC.IORef
55 -- import GHC.IOArray
56 -- import GHC.MVar
57 import GHC.ST ( ST )
58 import GHC.STRef ( STRef )
59 import GHC.Ptr ( Ptr, FunPtr )
60 -- import GHC.Stable
61 import GHC.Arr ( Array, STArray )
62 import Data.Type.Equality
63 -- import Data.Int
64
65 import GHC.Fingerprint.Type
66 import {-# SOURCE #-} GHC.Fingerprint
67 -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable
68 -- Better to break the loop here, because we want non-SOURCE imports
69 -- of Data.Typeable as much as possible so we can optimise the derived
70 -- instances.
71
72 -- | A concrete representation of a (monomorphic) type. 'TypeRep'
73 -- supports reasonably efficient equality.
74 data TypeRep = TypeRep {-# UNPACK #-} !Fingerprint TyCon [TypeRep]
75
76 -- Compare keys for equality
77 instance Eq TypeRep where
78 (TypeRep k1 _ _) == (TypeRep k2 _ _) = k1 == k2
79
80 instance Ord TypeRep where
81 (TypeRep k1 _ _) <= (TypeRep k2 _ _) = k1 <= k2
82
83 -- | An abstract representation of a type constructor. 'TyCon' objects can
84 -- be built using 'mkTyCon'.
85 data TyCon = TyCon {
86 tyConHash :: {-# UNPACK #-} !Fingerprint,
87 tyConPackage :: String, -- ^ /Since: 4.5.0.0/
88 tyConModule :: String, -- ^ /Since: 4.5.0.0/
89 tyConName :: String -- ^ /Since: 4.5.0.0/
90 }
91
92 instance Eq TyCon where
93 (TyCon t1 _ _ _) == (TyCon t2 _ _ _) = t1 == t2
94
95 instance Ord TyCon where
96 (TyCon k1 _ _ _) <= (TyCon k2 _ _ _) = k1 <= k2
97
98 ----------------- Construction --------------------
99
100 #include "MachDeps.h"
101
102 -- mkTyCon is an internal function to make it easier for GHC to
103 -- generate derived instances. GHC precomputes the MD5 hash for the
104 -- TyCon and passes it as two separate 64-bit values to mkTyCon. The
105 -- TyCon for a derived Typeable instance will end up being statically
106 -- allocated.
107
108 #if WORD_SIZE_IN_BITS < 64
109 mkTyCon :: Word64# -> Word64# -> String -> String -> String -> TyCon
110 #else
111 mkTyCon :: Word# -> Word# -> String -> String -> String -> TyCon
112 #endif
113 mkTyCon high# low# pkg modl name
114 = TyCon (Fingerprint (W64# high#) (W64# low#)) pkg modl name
115
116 -- | Applies a type constructor to a sequence of types
117 mkTyConApp :: TyCon -> [TypeRep] -> TypeRep
118 mkTyConApp tc@(TyCon tc_k _ _ _) []
119 = TypeRep tc_k tc [] -- optimisation: all derived Typeable instances
120 -- end up here, and it helps generate smaller
121 -- code for derived Typeable.
122 mkTyConApp tc@(TyCon tc_k _ _ _) args
123 = TypeRep (fingerprintFingerprints (tc_k : arg_ks)) tc args
124 where
125 arg_ks = [k | TypeRep k _ _ <- args]
126
127 -- | A special case of 'mkTyConApp', which applies the function
128 -- type constructor to a pair of types.
129 mkFunTy :: TypeRep -> TypeRep -> TypeRep
130 mkFunTy f a = mkTyConApp funTc [f,a]
131
132 -- | Splits a type constructor application
133 splitTyConApp :: TypeRep -> (TyCon,[TypeRep])
134 splitTyConApp (TypeRep _ tc trs) = (tc,trs)
135
136 -- | Applies a type to a function type. Returns: @'Just' u@ if the
137 -- first argument represents a function of type @t -> u@ and the
138 -- second argument represents a function of type @t@. Otherwise,
139 -- returns 'Nothing'.
140 funResultTy :: TypeRep -> TypeRep -> Maybe TypeRep
141 funResultTy trFun trArg
142 = case splitTyConApp trFun of
143 (tc, [t1,t2]) | tc == funTc && t1 == trArg -> Just t2
144 _ -> Nothing
145
146 -- | Adds a TypeRep argument to a TypeRep.
147 mkAppTy :: TypeRep -> TypeRep -> TypeRep
148 mkAppTy (TypeRep _ tc trs) arg_tr = mkTyConApp tc (trs ++ [arg_tr])
149 -- Notice that we call mkTyConApp to construct the fingerprint from tc and
150 -- the arg fingerprints. Simply combining the current fingerprint with
151 -- the new one won't give the same answer, but of course we want to
152 -- ensure that a TypeRep of the same shape has the same fingerprint!
153 -- See Trac #5962
154
155 -- | Builds a 'TyCon' object representing a type constructor. An
156 -- implementation of "Data.Typeable" should ensure that the following holds:
157 --
158 -- > A==A' ^ B==B' ^ C==C' ==> mkTyCon A B C == mkTyCon A' B' C'
159 --
160
161 --
162 mkTyCon3 :: String -- ^ package name
163 -> String -- ^ module name
164 -> String -- ^ the name of the type constructor
165 -> TyCon -- ^ A unique 'TyCon' object
166 mkTyCon3 pkg modl name =
167 TyCon (fingerprintString (pkg ++ (' ':modl) ++ (' ':name))) pkg modl name
168
169 ----------------- Observation ---------------------
170
171 -- | Observe the type constructor of a type representation
172 typeRepTyCon :: TypeRep -> TyCon
173 typeRepTyCon (TypeRep _ tc _) = tc
174
175 -- | Observe the argument types of a type representation
176 typeRepArgs :: TypeRep -> [TypeRep]
177 typeRepArgs (TypeRep _ _ args) = args
178
179 -- | Observe string encoding of a type representation
180 {-# DEPRECATED tyConString "renamed to tyConName; tyConModule and tyConPackage are also available." #-} -- deprecated in 7.4
181 tyConString :: TyCon -> String
182 tyConString = tyConName
183
184 -------------------------------------------------------------
185 --
186 -- The Typeable class and friends
187 --
188 -------------------------------------------------------------
189
190 -- | The class 'Typeable' allows a concrete representation of a type to
191 -- be calculated.
192 class Typeable a where
193 typeRep :: proxy a -> TypeRep
194 -- ^ Takes a value of type @a@ and returns a concrete representation
195 -- of that type.
196 --
197 -- /Version: 4.7.0.0/
198
199 -- Keeping backwards-compatibility
200 typeOf :: forall a. Typeable a => a -> TypeRep
201 typeOf _ = typeRep (Proxy :: Proxy a)
202
203 typeOf1 :: forall t (a :: *). Typeable t => t a -> TypeRep
204 typeOf1 _ = typeRep (Proxy :: Proxy t)
205
206 typeOf2 :: forall t (a :: *) (b :: *). Typeable t => t a b -> TypeRep
207 typeOf2 _ = typeRep (Proxy :: Proxy t)
208
209 typeOf3 :: forall t (a :: *) (b :: *) (c :: *). Typeable t
210 => t a b c -> TypeRep
211 typeOf3 _ = typeRep (Proxy :: Proxy t)
212
213 typeOf4 :: forall t (a :: *) (b :: *) (c :: *) (d :: *). Typeable t
214 => t a b c d -> TypeRep
215 typeOf4 _ = typeRep (Proxy :: Proxy t)
216
217 typeOf5 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *). Typeable t
218 => t a b c d e -> TypeRep
219 typeOf5 _ = typeRep (Proxy :: Proxy t)
220
221 typeOf6 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *).
222 Typeable t => t a b c d e f -> TypeRep
223 typeOf6 _ = typeRep (Proxy :: Proxy t)
224
225 typeOf7 :: forall t (a :: *) (b :: *) (c :: *) (d :: *) (e :: *) (f :: *)
226 (g :: *). Typeable t => t a b c d e f g -> TypeRep
227 typeOf7 _ = typeRep (Proxy :: Proxy t)
228
229 -- | Kind-polymorphic Typeable instance for type application
230 instance (Typeable s, Typeable a) => Typeable (s a) where
231 typeRep _ = typeRep (Proxy :: Proxy s) `mkAppTy` typeRep (Proxy :: Proxy a)
232
233
234 ----------------- Showing TypeReps --------------------
235
236 instance Show TypeRep where
237 showsPrec p (TypeRep _ tycon tys) =
238 case tys of
239 [] -> showsPrec p tycon
240 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
241 [a,r] | tycon == funTc -> showParen (p > 8) $
242 showsPrec 9 a .
243 showString " -> " .
244 showsPrec 8 r
245 xs | isTupleTyCon tycon -> showTuple xs
246 | otherwise ->
247 showParen (p > 9) $
248 showsPrec p tycon .
249 showChar ' ' .
250 showArgs (showChar ' ') tys
251
252 showsTypeRep :: TypeRep -> ShowS
253 showsTypeRep = shows
254
255 instance Show TyCon where
256 showsPrec _ t = showString (tyConName t)
257
258 isTupleTyCon :: TyCon -> Bool
259 isTupleTyCon (TyCon _ _ _ ('(':',':_)) = True
260 isTupleTyCon _ = False
261
262 -- Some (Show.TypeRep) helpers:
263
264 showArgs :: Show a => ShowS -> [a] -> ShowS
265 showArgs _ [] = id
266 showArgs _ [a] = showsPrec 10 a
267 showArgs sep (a:as) = showsPrec 10 a . sep . showArgs sep as
268
269 showTuple :: [TypeRep] -> ShowS
270 showTuple args = showChar '('
271 . showArgs (showChar ',') args
272 . showChar ')'
273
274 listTc :: TyCon
275 listTc = typeRepTyCon (typeOf [()])
276
277 funTc :: TyCon
278 funTc = typeRepTyCon (typeRep (Proxy :: Proxy (->)))
279
280 -------------------------------------------------------------
281 --
282 -- Instances of the Typeable classes for Prelude types
283 --
284 -------------------------------------------------------------
285
286 deriving instance Typeable ()
287 deriving instance Typeable []
288 deriving instance Typeable Maybe
289 deriving instance Typeable Ratio
290 deriving instance Typeable (->)
291 deriving instance Typeable IO
292
293 deriving instance Typeable Array
294
295 deriving instance Typeable ST
296 deriving instance Typeable STRef
297 deriving instance Typeable STArray
298
299 deriving instance Typeable (,)
300 deriving instance Typeable (,,)
301 deriving instance Typeable (,,,)
302 deriving instance Typeable (,,,,)
303 deriving instance Typeable (,,,,,)
304 deriving instance Typeable (,,,,,,)
305
306 deriving instance Typeable Ptr
307 deriving instance Typeable FunPtr
308
309 -------------------------------------------------------
310 --
311 -- Generate Typeable instances for standard datatypes
312 --
313 -------------------------------------------------------
314
315 deriving instance Typeable Bool
316 deriving instance Typeable Char
317 deriving instance Typeable Float
318 deriving instance Typeable Double
319 deriving instance Typeable Int
320 deriving instance Typeable Word
321 deriving instance Typeable Integer
322 deriving instance Typeable Ordering
323
324 deriving instance Typeable Word8
325 deriving instance Typeable Word16
326 deriving instance Typeable Word32
327 deriving instance Typeable Word64
328
329 deriving instance Typeable TyCon
330 deriving instance Typeable TypeRep
331
332 deriving instance Typeable RealWorld
333 deriving instance Typeable Proxy
334 deriving instance Typeable (:=:)