1 {-# OPTIONS -fno-implicit-prelude #-}
2 -----------------------------------------------------------------------------
4 -- Module : Data.Dynamic
5 -- Copyright : (c) The University of Glasgow 2001
6 -- License : BSD-style (see the file libraries/core/LICENSE)
8 -- Maintainer : libraries@haskell.org
9 -- Stability : experimental
10 -- Portability : portable
12 -- $Id: Dynamic.hs,v 1.5 2002/03/14 12:09:49 simonmar Exp $
14 -- The Dynamic interface provides basic support for dynamic types.
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.
21 -- The Dynamic implementation provided is closely based on code
22 -- contained in Hugs library of the same name.
24 -----------------------------------------------------------------------------
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
34 -- type representation
37 typeOf) -- :: a -> TypeRep
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
45 , TypeRep -- abstract, instance of: Eq, Show, Typeable
46 , TyCon -- abstract, instance of: Eq, Show, Typeable
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
55 -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,")
58 -- returns "(Foo,Foo,Foo)"
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
72 import Foreign.StablePtr
74 #ifdef __GLASGOW_HASKELL__
83 #ifdef __GLASGOW_HASKELL__
84 unsafeCoerce :: a -> b
85 unsafeCoerce = unsafeCoerce#
90 -- The dynamic type is represented by Dynamic, carrying
91 -- the dynamic value along with its type representation:
93 data Dynamic = Dynamic TypeRep Obj
95 instance Show Dynamic where
96 -- the instance just prints the type representation.
97 showsPrec _ (Dynamic t _) =
103 -- dummy type to hold the dynamically typed value.
106 = App TyCon [TypeRep]
107 | Fun TypeRep TypeRep
110 instance Show TypeRep where
111 showsPrec p (App tycon tys) =
113 [] -> showsPrec p tycon
114 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
116 | isTupleTyCon tycon -> showTuple tycon xs
123 showsPrec p (Fun f a) =
125 showsPrec 9 f . showString " -> " . showsPrec 8 a
127 -- type constructors are
128 data TyCon = TyCon Int String
130 instance Eq TyCon where
131 (TyCon t1 _) == (TyCon t2 _) = t1 == t2
133 instance Show TyCon where
134 showsPrec _ (TyCon _ s) = showString s
136 -- Operations for going to and from Dynamic:
138 toDyn :: Typeable a => a -> Dynamic
139 toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
141 fromDyn :: Typeable a => Dynamic -> a -> a
142 fromDyn (Dynamic t v) def
143 | typeOf def == t = unsafeCoerce v
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
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,
157 class Typeable a where
158 typeOf :: a -> TypeRep
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.
164 isTupleTyCon :: TyCon -> Bool
165 isTupleTyCon (TyCon _ (',':_)) = True
166 isTupleTyCon _ = False
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.
173 -- Provided the implementor of other @Typeable@ instances
174 -- takes care of making all the @TyCon@s CAFs (toplevel constants),
177 -- If this constraint does turn out to be a sore thumb, changing
178 -- the Eq instance for TyCons is trivial.
180 mkTyCon :: String -> TyCon
181 mkTyCon str = unsafePerformIO $ do
188 uni = unsafePerformIO ( newIORef 0 )
190 -- Some (Show.TypeRep) helpers:
192 showArgs :: Show a => [a] -> ShowS
194 showArgs [a] = showsPrec 10 a
195 showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
197 showTuple :: TyCon -> [TypeRep] -> ShowS
198 showTuple (TyCon _ str) args = showChar '(' . go str args
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 ')'
206 mkAppTy :: TyCon -> [TypeRep] -> TypeRep
207 mkAppTy tyc args = App tyc args
209 mkFunTy :: TypeRep -> TypeRep -> TypeRep
210 mkFunTy f a = Fun f a
212 -- Auxillary functions
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))
221 dynApp :: Dynamic -> Dynamic -> Dynamic
222 dynApp f x = case dynApply f x of
224 Nothing -> error ("Type error in dynamic application.\n" ++
225 "Can't apply function " ++ show f ++
226 " to argument " ++ show x)
228 applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
229 applyTy (Fun t1 t2) t3
231 applyTy _ _ = Nothing
236 listTc = mkTyCon "[]"
238 instance Typeable a => Typeable [a] where
239 typeOf ls = mkAppTy listTc [typeOf ((undefined:: [a] -> a) ls)]
242 unitTc = mkTyCon "()"
244 instance Typeable () where
245 typeOf _ = mkAppTy unitTc []
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)]
255 tup3Tc = mkTyCon ",,"
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)]
263 tup4Tc = mkTyCon ",,,"
265 instance ( Typeable a
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)]
275 tup5Tc = mkTyCon ",,,,"
277 instance ( Typeable a
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)]
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))
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")
306 INSTANCE_TYPEABLE0(Int8,int8Tc, "Int8")
307 INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16")
308 INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32")
309 INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64")
311 INSTANCE_TYPEABLE0(Word8,word8Tc, "Word8" )
312 INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16")
313 INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32")
314 INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64")
316 INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
317 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
318 INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")