2 % (c) AQUA Project, Glasgow University, 1998
5 Cheap and cheerful dynamic types.
7 The Dynamic interface is part of the Hugs/GHC standard
8 libraries, providing basic support for dynamic types.
10 Operations for injecting values of arbitrary type into
11 a dynamically typed value, Dynamic, are provided, together
12 with operations for converting dynamic values into a concrete
15 The Dynamic implementation provided is closely based on code
16 contained in Hugs library of the same name.
18 NOTE: test code at the end, but commented out.
24 Dynamic -- abstract, instance of: Show (?)
25 , toDyn -- :: Typeable a => a -> Dynamic
26 , fromDyn -- :: Typeable a => Dynamic -> a -> a
27 , fromDynamic -- :: Typeable a => Dynamic -> Maybe a
29 -- type representation
32 -- class Typeable a where { typeOf :: a -> TypeRep }
34 -- Dynamic defines Typeable instances for the following
35 -- Prelude types: Char, Int, Float, Double, Bool
36 -- (), Maybe a, (a->b), [a]
37 -- (a,b) (a,b,c) (a,b,c,d) (a,b,c,d,e)
39 , TypeRep -- abstract, instance of: Eq, Show
40 , TyCon -- abstract, instance of: Eq, Show
42 -- type representation constructors/operators:
43 , mkTyCon -- :: String -> TyCon
44 , mkAppTy -- :: TyCon -> [TypeRep] -> TypeRep
45 , mkFunTy -- :: TypeRep -> TypeRep -> TypeRep
46 , applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep
49 -- let iTy = mkTyCon "Int" in show (mkAppTy (mkTyCon ",,")
52 -- returns "(Int,Int,Int)"
54 -- The TypeRep Show instance promises to print tuple types
55 -- correctly. Tuple type constructors are specified by a
56 -- sequence of commas, e.g., (mkTyCon ",,,,,,") returns
67 IORef, newIORef, readIORef, writeIORef
74 unsafeCoerce = primUnsafeCoerce
78 unsafeCoerce :: a -> b
79 unsafeCoerce = unsafeCoerce#
83 The dynamic type is represented by Dynamic, carrying
84 the dynamic value along with its type representation:
87 -- the instance just prints the type representation.
88 instance Show Dynamic where
89 showsPrec _ (Dynamic t _) =
95 Operations for going to and from Dynamic:
98 toDyn :: Typeable a => a -> Dynamic
99 toDyn v = Dynamic (typeOf v) (unsafeCoerce v)
101 fromDyn :: Typeable a => Dynamic -> a -> a
102 fromDyn (Dynamic t v) def
103 | typeOf def == t = unsafeCoerce v
106 fromDynamic :: Typeable a => Dynamic -> Maybe a
107 fromDynamic (Dynamic t v) =
108 case unsafeCoerce v of
109 r | t == typeOf r -> Just r
110 | otherwise -> Nothing
113 (Abstract) universal datatype:
116 instance Show TypeRep where
117 showsPrec p (App tycon tys) =
119 [] -> showsPrec p tycon
120 [x] | tycon == listTc -> showChar '[' . shows x . showChar ']'
122 | isTupleTyCon tycon -> showTuple tycon xs
129 showsPrec p (Fun f a) =
131 showsPrec 9 f . showString " -> " . showsPrec 8 a
134 To make it possible to convert values with user-defined types
135 into type Dynamic, we need a systematic way of getting
136 the type representation of an arbitrary type. Type class
137 provide a good fit, here
140 class Typeable a where
141 typeOf :: a -> TypeRep
144 NOTE: The argument to the overloaded `typeOf' is only
145 used to carry type information, and Typeable instances
146 should *never* look at its value.
149 isTupleTyCon :: TyCon -> Bool
150 isTupleTyCon (TyCon _ (',':_)) = True
151 isTupleTyCon _ = False
153 instance Show TyCon where
154 showsPrec _ (TyCon _ s) = showString s
157 -- If we enforce the restriction that TyCons are
158 -- shared, we can map them onto Ints very simply
159 -- which allows for efficient comparison.
161 mkTyCon :: String -> TyCon
162 mkTyCon str = unsafePerformIO $ do
168 uni = unsafePerformIO ( newIORef 0 )
171 Some (Show.TypeRep) helpers:
174 showArgs :: Show a => [a] -> ShowS
176 showArgs [a] = showsPrec 10 a
177 showArgs (a:as) = showsPrec 10 a . showString " " . showArgs as
179 showTuple :: TyCon -> [TypeRep] -> ShowS
180 showTuple (TyCon _ str) args = showChar '(' . go str args
182 go [] [a] = showsPrec 10 a . showChar ')'
183 go _ [] = showChar ')' -- a failure condition, really.
184 go (',':xs) (a:as) = showsPrec 10 a . showChar ',' . go xs as
185 go _ _ = showChar ')'
189 mkAppTy :: TyCon -> [TypeRep] -> TypeRep
190 mkAppTy tyc args = App tyc args
192 mkFunTy :: TypeRep -> TypeRep -> TypeRep
193 mkFunTy f a = Fun f a
199 -- (f::(a->b)) `dynApply` (x::a) = (f a)::b
200 dynApply :: Dynamic -> Dynamic -> Maybe Dynamic
201 dynApply (Dynamic t1 f) (Dynamic t2 x) =
202 case applyTy t1 t2 of
203 Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x))
206 dynApp :: Dynamic -> Dynamic -> Dynamic
207 dynApp f x = case dynApply f x of
209 Nothing -> error ("Type error in dynamic application.\n" ++
210 "Can't apply function " ++ show f ++
211 " to argument " ++ show x)
213 applyTy :: TypeRep -> TypeRep -> Maybe TypeRep
214 applyTy (Fun t1 t2) t3
216 applyTy _ _ = Nothing
221 instance Typeable Int where
222 typeOf _ = mkAppTy intTc []
224 instance Typeable Char where
225 typeOf _ = mkAppTy charTc []
227 instance Typeable Bool where
228 typeOf _ = mkAppTy boolTc []
230 instance Typeable Float where
231 typeOf _ = mkAppTy floatTc []
233 instance Typeable Double where
234 typeOf _ = mkAppTy doubleTc []
236 instance Typeable Integer where
237 typeOf _ = mkAppTy integerTc []
239 instance Typeable a => Typeable (IO a) where
240 typeOf action = mkAppTy ioTc [typeOf (doIO action)]
245 instance Typeable a => Typeable [a] where
246 typeOf ls = mkAppTy listTc [typeOf (hd ls)]
251 instance Typeable a => Typeable (Maybe a) where
252 typeOf mb = mkAppTy maybeTc [typeOf (getJ mb)]
257 instance (Typeable a, Typeable b) => Typeable (Either a b) where
258 typeOf ei = mkAppTy maybeTc [typeOf (getL ei), typeOf (getR ei)]
260 getL :: Either a b -> a
262 getR :: Either a b -> a
265 instance (Typeable a, Typeable b) => Typeable (a -> b) where
266 typeOf f = mkFunTy (typeOf (arg f)) (typeOf (res f))
274 instance Typeable () where
275 typeOf _ = mkAppTy unitTc []
277 instance Typeable TypeRep where
278 typeOf _ = mkAppTy typeRepTc []
280 instance Typeable TyCon where
281 typeOf _ = mkAppTy tyConTc []
283 instance Typeable Dynamic where
284 typeOf _ = mkAppTy dynamicTc []
286 instance Typeable Ordering where
287 typeOf _ = mkAppTy orderingTc []
289 instance (Typeable a, Typeable b) => Typeable (a,b) where
290 typeOf tu = mkAppTy tup2Tc [typeOf (fst tu), typeOf (snd tu)]
299 instance ( Typeable a
301 , Typeable c) => Typeable (a,b,c) where
302 typeOf tu = mkAppTy tup3Tc [ typeOf (fst tu)
314 tup3Tc = mkTyCon ",,"
316 instance ( Typeable a
319 , Typeable d) => Typeable (a,b,c,d) where
320 typeOf tu = mkAppTy tup4Tc [ typeOf (fst tu)
326 fst :: (a,b,c,d) -> a
328 snd :: (a,b,c,d) -> b
330 thd :: (a,b,c,d) -> c
332 fth :: (a,b,c,d) -> d
335 tup4Tc = mkTyCon ",,,"
337 instance ( Typeable a
341 , Typeable e) => Typeable (a,b,c,d,e) where
342 typeOf tu = mkAppTy tup5Tc [ typeOf (fst tu)
349 fst :: (a,b,c,d,e) -> a
351 snd :: (a,b,c,d,e) -> b
353 thd :: (a,b,c,d,e) -> c
355 fth :: (a,b,c,d,e) -> d
357 ffth :: (a,b,c,d,e) -> e
360 tup5Tc = mkTyCon ",,,,"
364 @TyCon@s are provided for the following:
368 intTc, charTc, boolTc :: TyCon
369 intTc = mkTyCon "Int"
370 charTc = mkTyCon "Char"
371 boolTc = mkTyCon "Bool"
373 floatTc, doubleTc, integerTc :: TyCon
374 floatTc = mkTyCon "Float"
375 doubleTc = mkTyCon "Double"
376 integerTc = mkTyCon "Integer"
378 ioTc, maybeTc, eitherTc, listTc :: TyCon
380 maybeTc = mkTyCon "Maybe"
381 eitherTc = mkTyCon "Either"
382 listTc = mkTyCon "[]"
384 unitTc, orderingTc, arrayTc, complexTc, handleTc :: TyCon
385 unitTc = mkTyCon "()"
386 orderingTc = mkTyCon "Ordering"
387 arrayTc = mkTyCon "Array"
388 complexTc = mkTyCon "Complex"
389 handleTc = mkTyCon "Handle"
391 -- Hugs/GHC extension lib types:
392 addrTc, stablePtrTc, mvarTc :: TyCon
393 addrTc = mkTyCon "Addr"
394 stablePtrTc = mkTyCon "StablePtr"
395 mvarTc = mkTyCon "MVar"
397 foreignObjTc, stTc :: TyCon
398 foreignObjTc = mkTyCon "ForeignObj"
401 int8Tc, int16Tc, int32Tc, int64Tc :: TyCon
402 int8Tc = mkTyCon "Int8"
403 int16Tc = mkTyCon "Int16"
404 int32Tc = mkTyCon "Int32"
405 int64Tc = mkTyCon "Int64"
407 word8Tc, word16Tc, word32Tc, word64Tc :: TyCon
408 word8Tc = mkTyCon "Word8"
409 word16Tc = mkTyCon "Word16"
410 word32Tc = mkTyCon "Word32"
411 word64Tc = mkTyCon "Word64"
413 tyConTc, typeRepTc, dynamicTc :: TyCon
414 tyConTc = mkTyCon "TyCon"
415 typeRepTc = mkTyCon "Type"
416 dynamicTc = mkTyCon "Dynamic"
420 byteArrayTc, mutablebyteArrayTc, wordTc :: TyCon
421 byteArrayTc = mkTyCon "ByteArray"
422 mutablebyteArrayTc = mkTyCon "MutableByteArray"
423 wordTc = mkTyCon "Word"
429 test1,test2, test3, test4 :: Dynamic
431 test1 = toDyn (1::Int)
432 test2 = toDyn ((+) :: Int -> Int -> Int)
433 test3 = dynApp test2 test1
434 test4 = dynApp test3 test1
436 test5, test6,test7 :: Int
437 test5 = fromDyn test4 0
438 test6 = fromDyn test1 0
439 test7 = fromDyn test2 0
442 test8 = toDyn (mkAppTy listTc)
445 test9 = fromDyn test8 0
447 printf :: String -> [Dynamic] -> IO ()
448 printf str args = putStr (decode str args)
451 decode ('%':'n':cs) (d:ds) =
452 (\ v -> show v++decode cs ds) (fromDyn d (0::Int))
453 decode ('%':'c':cs) (d:ds) =
454 (\ v -> show v++decode cs ds) (fromDyn d ('\0'))
455 decode ('%':'b':cs) (d:ds) =
456 (\ v -> show v++decode cs ds) (fromDyn d (False::Bool))
457 decode (x:xs) ds = x:decode xs ds
460 test10 = printf "%n = %c, that much is %b\n" [toDyn (3::Int),toDyn 'a', toDyn False]