[project @ 2002-04-24 16:31:37 by simonmar]
[packages/base.git] / Data / Dynamic.hs
1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
3 -- |
4 -- Module : Data.Dynamic
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
7 --
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
11 --
12 -- $Id: Dynamic.hs,v 1.6 2002/04/24 16:31:39 simonmar Exp $
13 --
14 -- The Dynamic interface provides basic support for dynamic types.
15 --
16 -- Operations for injecting values of arbitrary type into
17 -- a dynamically typed value, Dynamic, are provided, together
18 -- with operations for converting dynamic values into a concrete
19 -- (monomorphic) type.
20 --
21 -- The Dynamic implementation provided is closely based on code
22 -- contained in Hugs library of the same name.
23 --
24 -----------------------------------------------------------------------------
25
26 module Data.Dynamic
27 (
28 -- dynamic type
29 Dynamic -- abstract, instance of: Show, Typeable
30 , toDyn -- :: Typeable a => a -> Dynamic
31 , fromDyn -- :: Typeable a => Dynamic -> a -> a
32 , fromDynamic -- :: Typeable a => Dynamic -> Maybe a
33
34 -- type representation
35
36 , Typeable(
37 typeOf) -- :: a -> TypeRep
38
39 -- Dynamic defines Typeable instances for the following
40 -- Prelude types: [a], (), (a,b), (a,b,c), (a,b,c,d),
41 -- (a,b,c,d,e), (a->b), (Array a b), Bool, Char,
42 -- (Complex a), Double, (Either a b), Float, Handle,
43 -- Int, Integer, (IO a), (Maybe a), Ordering
44
45 , TypeRep -- abstract, instance of: Eq, Show, Typeable
46 , TyCon -- abstract, instance of: Eq, Show, Typeable
47
48 -- type representation constructors/operators:
49 , mkTyCon -- :: String -> TyCon
50 , mkAppTy -- :: TyCon -> [TypeRep] -> TypeRep
51 , mkFunTy -- :: TypeRep -> TypeRep -> TypeRep
52 , applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep
53
54 --
55 -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
56 -- [fTy,fTy,fTy])
57 --
58 -- returns "(Foo,Foo,Foo)"
59 --
60 -- The TypeRep Show instance promises to print tuple types
61 -- correctly. Tuple type constructors are specified by a
62 -- sequence of commas, e.g., (mkTyCon ",,,,") returns
63 -- the 5-tuple tycon.
64 ) where
65
66
67 import Data.Maybe
68 import Data.Either
69 import Data.Int
70 import Data.Word
71 import Foreign.Ptr
72 import Foreign.StablePtr
73
74 #ifdef __GLASGOW_HASKELL__
75 import GHC.Base
76 import GHC.Show
77 import GHC.Err
78 import GHC.Num
79 import GHC.Float
80 import GHC.IOBase
81 #endif
82
83 #ifdef __GLASGOW_HASKELL__
84 unsafeCoerce :: a -> b
85 unsafeCoerce = unsafeCoerce#
86 #endif
87
88 #include "Dynamic.h"
89
90 -- The dynamic type is represented by Dynamic, carrying
91 -- the dynamic value along with its type representation:
92
93 data Dynamic = Dynamic TypeRep Obj
94
95 instance Show Dynamic where
96 -- the instance just prints the type representation.
97 showsPrec _ (Dynamic t _) =
98 showString "<<" .
99 showsPrec 0 t .
100 showString ">>"
101
102 data Obj = Obj
103 -- dummy type to hold the dynamically typed value.
104
105 data TypeRep
106 = App TyCon [TypeRep]
107 | Fun TypeRep TypeRep
108 deriving ( Eq )
109
110 instance Show TypeRep where
111 showsPrec p (App tycon tys) =
112 case tys of
113 [] -> showsPrec p tycon
114 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
115 xs
116 | isTupleTyCon tycon -> showTuple tycon xs
117 | otherwise ->
118 showParen (p > 9) $
119 showsPrec p tycon .
120 showChar ' ' .
121 showArgs tys
122
123 showsPrec p (Fun f a) =
124 showParen (p > 8) $
125 showsPrec 9 f . showString " -> " . showsPrec 8 a
126
127 -- type constructors are
128 data TyCon = TyCon Int String
129
130 instance Eq TyCon where
131 (TyCon t1 _) == (TyCon t2 _) = t1 == t2
132
133 instance Show TyCon where
134 showsPrec _ (TyCon _ s) = showString s
135
136 -- Operations for going to and from Dynamic:
137
138 toDyn :: Typeable a => a -> Dynamic
139 toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
140
141 fromDyn :: Typeable a => Dynamic -> a -> a
142 fromDyn (Dynamic t v) def
143 | typeOf def == t = unsafeCoerce v
144 | otherwise = def
145
146 fromDynamic :: Typeable a => Dynamic -> Maybe a
147 fromDynamic (Dynamic t v) =
148 case unsafeCoerce v of
149 r | t == typeOf r -> Just r
150 | otherwise -> Nothing
151
152 -- To make it possible to convert values with user-defined types
153 -- into type Dynamic, we need a systematic way of getting
154 -- the type representation of an arbitrary type. A type
155 -- class provides just the ticket,
156
157 class Typeable a where
158 typeOf :: a -> TypeRep
159
160 -- NOTE: The argument to the overloaded `typeOf' is only
161 -- used to carry type information, and Typeable instances
162 -- should *never* *ever* look at its value.
163
164 isTupleTyCon :: TyCon -> Bool
165 isTupleTyCon (TyCon _ (',':_)) = True
166 isTupleTyCon _ = False
167
168 -- If we enforce the restriction that there is only one
169 -- @TyCon@ for a type & it is shared among all its uses,
170 -- we can map them onto Ints very simply. The benefit is,
171 -- of course, that @TyCon@s can then be compared efficiently.
172
173 -- Provided the implementor of other @Typeable@ instances
174 -- takes care of making all the @TyCon@s CAFs (toplevel constants),
175 -- this will work.
176
177 -- If this constraint does turn out to be a sore thumb, changing
178 -- the Eq instance for TyCons is trivial.
179
180 mkTyCon :: String -> TyCon
181 mkTyCon str = unsafePerformIO $ do
182 v <- readIORef uni
183 writeIORef uni (v+1)
184 return (TyCon v str)
185
186 {-# NOINLINE uni #-}
187 uni :: IORef Int
188 uni = unsafePerformIO ( newIORef 0 )
189
190 -- Some (Show.TypeRep) helpers:
191
192 showArgs :: Show a => [a] -> ShowS
193 showArgs [] = id
194 showArgs [a] = showsPrec 10 a
195 showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
196
197 showTuple :: TyCon -> [TypeRep] -> ShowS
198 showTuple (TyCon _ str) args = showChar '(' . go str args
199 where
200 go [] [a] = showsPrec 10 a . showChar ')'
201 go _ [] = showChar ')' -- a failure condition, really.
202 go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
203 go _ _ = showChar ')'
204
205
206 mkAppTy :: TyCon -> [TypeRep] -> TypeRep
207 mkAppTy tyc args = App tyc args
208
209 mkFunTy :: TypeRep -> TypeRep -> TypeRep
210 mkFunTy f a = Fun f a
211
212 -- Auxillary functions
213
214 -- (f::(a->b)) `dynApply` (x::a) = (f a)::b
215 dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
216 dynApply (Dynamic t1 f) (Dynamic t2 x) =
217 case applyTy t1 t2 of
218 Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
219 Nothing -> Nothing
220
221 dynApp :: Dynamic -> Dynamic -> Dynamic
222 dynApp f x = case dynApply f x of
223 Just r -> r
224 Nothing -> error ("Type error in dynamic application.\n" ++
225 "Can't apply function " ++ show f ++
226 " to argument " ++ show x)
227
228 applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
229 applyTy (Fun t1 t2) t3
230 | t1 == t3 = Just t2
231 applyTy _ _ = Nothing
232
233 -- Prelude types
234
235 listTc :: TyCon
236 listTc = mkTyCon "[]"
237
238 instance Typeable a => Typeable [a] where
239 typeOf ls = mkAppTy listTc [typeOf ((undefined:: [a] -> a) ls)]
240
241 unitTc :: TyCon
242 unitTc = mkTyCon "()"
243
244 instance Typeable () where
245 typeOf _ = mkAppTy unitTc []
246
247 tup2Tc :: TyCon
248 tup2Tc = mkTyCon ","
249
250 instance (Typeable a, Typeable b) => Typeable (a,b) where
251 typeOf tu = mkAppTy tup2Tc [typeOf ((undefined :: (a,b) -> a) tu),
252 typeOf ((undefined :: (a,b) -> b) tu)]
253
254 tup3Tc :: TyCon
255 tup3Tc = mkTyCon ",,"
256
257 instance ( Typeable a , Typeable b , Typeable c) => Typeable (a,b,c) where
258 typeOf tu = mkAppTy tup3Tc [typeOf ((undefined :: (a,b,c) -> a) tu),
259 typeOf ((undefined :: (a,b,c) -> b) tu),
260 typeOf ((undefined :: (a,b,c) -> c) tu)]
261
262 tup4Tc :: TyCon
263 tup4Tc = mkTyCon ",,,"
264
265 instance ( Typeable a
266 , Typeable b
267 , Typeable c
268 , Typeable d) => Typeable (a,b,c,d) where
269 typeOf tu = mkAppTy tup4Tc [typeOf ((undefined :: (a,b,c,d) -> a) tu),
270 typeOf ((undefined :: (a,b,c,d) -> b) tu),
271 typeOf ((undefined :: (a,b,c,d) -> c) tu),
272 typeOf ((undefined :: (a,b,c,d) -> d) tu)]
273
274 tup5Tc :: TyCon
275 tup5Tc = mkTyCon ",,,,"
276
277 instance ( Typeable a
278 , Typeable b
279 , Typeable c
280 , Typeable d
281 , Typeable e) => Typeable (a,b,c,d,e) where
282 typeOf tu = mkAppTy tup5Tc [typeOf ((undefined :: (a,b,c,d,e) -> a) tu),
283 typeOf ((undefined :: (a,b,c,d,e) -> b) tu),
284 typeOf ((undefined :: (a,b,c,d,e) -> c) tu),
285 typeOf ((undefined :: (a,b,c,d,e) -> d) tu),
286 typeOf ((undefined :: (a,b,c,d,e) -> e) tu)]
287
288 instance (Typeable a, Typeable b) => Typeable (a -> b) where
289 typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
290 (typeOf ((undefined :: (a -> b) -> b) f))
291
292 INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
293 INSTANCE_TYPEABLE0(Char,charTc,"Char")
294 INSTANCE_TYPEABLE0(Float,floatTc,"Float")
295 INSTANCE_TYPEABLE0(Double,doubleTc,"Double")
296 INSTANCE_TYPEABLE0(Int,intTc,"Int")
297 INSTANCE_TYPEABLE0(Integer,integerTc,"Integer")
298 INSTANCE_TYPEABLE2(Either,eitherTc,"Either")
299 INSTANCE_TYPEABLE1(IO,ioTc,"IO")
300 INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe")
301 INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering")
302 INSTANCE_TYPEABLE0(Handle,handleTc,"Handle")
303 INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr")
304 INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr")
305
306 INSTANCE_TYPEABLE0(Int8,int8Tc, "Int8")
307 INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
308 INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
309 INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
310
311 INSTANCE_TYPEABLE0(Word8,word8Tc, "Word8" )
312 INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
313 INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
314 INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
315
316 INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
317 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
318 INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")