X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FDynamic.hs;h=275e3186b16a5d494c67390e68201047d32fcc32;hb=4ff607f73bb8d0c32b24bef858610cbdfa85b899;hp=356d08453219c089972f8949dbff89471198a046;hpb=260e7f2ed9a43c6ecf5a556d77817f39ed2893ab;p=ghc-base.git diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs index 356d084..275e318 100644 --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -1,16 +1,14 @@ {-# OPTIONS -fno-implicit-prelude #-} ----------------------------------------------------------------------------- --- +-- | -- Module : Data.Dynamic -- Copyright : (c) The University of Glasgow 2001 --- License : BSD-style (see the file libraries/core/LICENSE) +-- License : BSD-style (see the file libraries/base/LICENSE) -- -- Maintainer : libraries@haskell.org -- Stability : experimental -- Portability : portable -- --- $Id: Dynamic.hs,v 1.4 2001/12/21 15:07:21 simonmar Exp $ --- -- The Dynamic interface provides basic support for dynamic types. -- -- Operations for injecting values of arbitrary type into @@ -18,38 +16,38 @@ -- with operations for converting dynamic values into a concrete -- (monomorphic) type. -- --- The Dynamic implementation provided is closely based on code --- contained in Hugs library of the same name. --- ----------------------------------------------------------------------------- module Data.Dynamic - ( - -- dynamic type - Dynamic -- abstract, instance of: Show, Typeable - , toDyn -- :: Typeable a => a -> Dynamic - , fromDyn -- :: Typeable a => Dynamic -> a -> a - , fromDynamic -- :: Typeable a => Dynamic -> Maybe a + ( + -- * The @Dynamic@ type + Dynamic, -- abstract, instance of: Show, Typeable + + -- * Converting to and from @Dynamic@ + toDyn, -- :: Typeable a => a -> Dynamic + fromDyn, -- :: Typeable a => Dynamic -> a -> a + fromDynamic, -- :: Typeable a => Dynamic -> Maybe a - -- type representation + -- * Applying functions of dynamic type + dynApply, + dynApp, - , Typeable( - typeOf) -- :: a -> TypeRep + -- * Concrete Type Representations + + -- | This section is useful if you need to define your own + -- instances of 'Typeable'. - -- Dynamic defines Typeable instances for the following - -- Prelude types: [a], (), (a,b), (a,b,c), (a,b,c,d), - -- (a,b,c,d,e), (a->b), (Array a b), Bool, Char, - -- (Complex a), Double, (Either a b), Float, Handle, - -- Int, Integer, (IO a), (Maybe a), Ordering + Typeable( + typeOf), -- :: a -> TypeRep - , TypeRep -- abstract, instance of: Eq, Show, Typeable - , TyCon -- abstract, instance of: Eq, Show, Typeable + -- ** Building concrete type representations + TypeRep, -- abstract, instance of: Eq, Show, Typeable + TyCon, -- abstract, instance of: Eq, Show, Typeable - -- type representation constructors/operators: - , mkTyCon -- :: String -> TyCon - , mkAppTy -- :: TyCon -> [TypeRep] -> TypeRep - , mkFunTy -- :: TypeRep -> TypeRep -> TypeRep - , applyTy -- :: TypeRep -> TypeRep -> Maybe TypeRep + mkTyCon, -- :: String -> TyCon + mkAppTy, -- :: TyCon -> [TypeRep] -> TypeRep + mkFunTy, -- :: TypeRep -> TypeRep -> TypeRep + applyTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep -- -- let fTy = mkTyCon "Foo" in show (mkAppTy (mkTyCon ",,") @@ -66,6 +64,10 @@ module Data.Dynamic import Data.Maybe import Data.Either +import Data.Int +import Data.Word +import Foreign.Ptr +import Foreign.StablePtr #ifdef __GLASGOW_HASKELL__ import GHC.Base @@ -74,7 +76,12 @@ import GHC.Err import GHC.Num import GHC.Float import GHC.IOBase -import GHC.Dynamic +#endif + +#ifdef __HUGS__ +import Hugs.IO +import Hugs.IORef +import Hugs.IOExts #endif #ifdef __GLASGOW_HASKELL__ @@ -84,33 +91,34 @@ unsafeCoerce = unsafeCoerce# #include "Dynamic.h" --- The dynamic type is represented by Dynamic, carrying --- the dynamic value along with its type representation: +{-| + A value of type 'Dynamic' is an object encapsulated together with its type. + + A 'Dynamic' may only represent a monomorphic value; an attempt to + create a value of type 'Dynamic' from a polymorphically-typed + expression will result in an ambiguity error (see 'toDyn'). + + 'Show'ing a value of type 'Dynamic' returns a pretty-printed representation + of the object\'s type; useful for debugging. +-} +data Dynamic = Dynamic TypeRep Obj --- the instance just prints the type representation. instance Show Dynamic where + -- the instance just prints the type representation. showsPrec _ (Dynamic t _) = showString "<<" . showsPrec 0 t . showString ">>" --- Operations for going to and from Dynamic: +data Obj = Obj + -- dummy type to hold the dynamically typed value. -toDyn :: Typeable a => a -> Dynamic -toDyn v = Dynamic (typeOf v) (unsafeCoerce v) - -fromDyn :: Typeable a => Dynamic -> a -> a -fromDyn (Dynamic t v) def - | typeOf def == t = unsafeCoerce v - | otherwise = def - -fromDynamic :: Typeable a => Dynamic -> Maybe a -fromDynamic (Dynamic t v) = - case unsafeCoerce v of - r | t == typeOf r -> Just r - | otherwise -> Nothing - --- (Abstract) universal datatype: +-- | A concrete representation of a (monomorphic) type. 'TypeRep' +-- supports reasonably efficient equality. +data TypeRep + = App TyCon [TypeRep] + | Fun TypeRep TypeRep + deriving ( Eq ) instance Show TypeRep where showsPrec p (App tycon tys) = @@ -129,25 +137,67 @@ instance Show TypeRep where showParen (p > 8) $ showsPrec 9 f . showString " -> " . showsPrec 8 a --- To make it possible to convert values with user-defined types --- into type Dynamic, we need a systematic way of getting --- the type representation of an arbitrary type. A type --- class provides just the ticket, +-- | An abstract representation of a type constructor. 'TyCon' objects can +-- be built using 'mkTyCon'. +data TyCon = TyCon Int String + +instance Eq TyCon where + (TyCon t1 _) == (TyCon t2 _) = t1 == t2 + +instance Show TyCon where + showsPrec _ (TyCon _ s) = showString s + + +-- | Converts an arbitrary value into an object of type 'Dynamic'. +-- +-- The type of the object must be an instance of 'Typeable', which +-- ensures that only monomorphically-typed objects may be converted to +-- 'Dynamic'. To convert a polymorphic object into 'Dynamic', give it +-- a monomorphic type signature. For example: +-- +-- > toDyn (id :: Int -> Int) +-- +toDyn :: Typeable a => a -> Dynamic +toDyn v = Dynamic (typeOf v) (unsafeCoerce v) + +-- | Converts a 'Dynamic' object back into an ordinary Haskell value of +-- the correct type. See also 'fromDynamic'. +fromDyn :: Typeable a + => Dynamic -- ^ the dynamically-typed object + -> a -- ^ a default value + -> a -- ^ returns: the value of the first argument, if + -- it has the correct type, otherwise the value of + -- the second argument. +fromDyn (Dynamic t v) def + | typeOf def == t = unsafeCoerce v + | otherwise = def +-- | Converts a 'Dynamic' object back into an ordinary Haskell value of +-- the correct type. See also 'fromDyn'. +fromDynamic + :: Typeable a + => Dynamic -- ^ the dynamically-typed object + -> Maybe a -- ^ returns: @'Just' a@, if the dyanmically-typed + -- object has the correct type (and @a@ is its value), + -- or 'Nothing' otherwise. +fromDynamic (Dynamic t v) = + case unsafeCoerce v of + r | t == typeOf r -> Just r + | otherwise -> Nothing + +-- | The class 'Typeable' allows a concrete representation of a type to +-- be calculated. class Typeable a where typeOf :: a -> TypeRep - --- NOTE: The argument to the overloaded `typeOf' is only --- used to carry type information, and Typeable instances --- should *never* *ever* look at its value. + -- ^ Takes a value of type @a@ and returns a concrete representation + -- of that type. The /value/ of the argument should be ignored by + -- any instance of 'Typeable', so that it is safe to pass 'undefined' as + -- the argument. isTupleTyCon :: TyCon -> Bool isTupleTyCon (TyCon _ (',':_)) = True isTupleTyCon _ = False -instance Show TyCon where - showsPrec _ (TyCon _ s) = showString s - -- If we enforce the restriction that there is only one -- @TyCon@ for a type & it is shared among all its uses, -- we can map them onto Ints very simply. The benefit is, @@ -160,7 +210,21 @@ instance Show TyCon where -- If this constraint does turn out to be a sore thumb, changing -- the Eq instance for TyCons is trivial. -mkTyCon :: String -> TyCon +-- | Builds a 'TyCon' object representing a type constructor. An +-- implementation of "Data.Dynamic" should ensure that the following holds: +-- +-- > mkTyCon "a" == mkTyCon "a" +-- +-- NOTE: GHC\'s implementation is quite hacky, and the above equation +-- does not necessarily hold. For defining your own instances of +-- 'Typeable', try to ensure that only one call to 'mkTyCon' exists +-- for each type constructor (put it at the top level, and annotate the +-- corresponding definition with a @NOINLINE@ pragma). +mkTyCon + :: String -- ^ the name of the type constructor (should be unique + -- in the program, so it might be wise to use the + -- fully qualified name). + -> TyCon -- ^ A unique 'TyCon' object mkTyCon str = unsafePerformIO $ do v <- readIORef uni writeIORef uni (v+1) @@ -186,9 +250,12 @@ showTuple (TyCon _ str) args = showChar '(' . go str args go _ _ = showChar ')' +-- | Applies a type constructor to a sequence of types mkAppTy :: TyCon -> [TypeRep] -> TypeRep mkAppTy tyc args = App tyc args +-- | A special case of 'mkAppTy', which applies the function type constructor to +-- a pair of types. mkFunTy :: TypeRep -> TypeRep -> TypeRep mkFunTy f a = Fun f a @@ -208,6 +275,10 @@ dynApp f x = case dynApply f x of "Can't apply function " ++ show f ++ " to argument " ++ show x) +-- | Applies a type to a function type. Returns: @'Just' u@ if the +-- first argument represents a function of type @t -> u@ and the +-- second argument represents a function of type @t@. Otherwise, +-- returns 'Nothing'. applyTy :: TypeRep -> TypeRep -> Maybe TypeRep applyTy (Fun t1 t2) t3 | t1 == t3 = Just t2 @@ -282,6 +353,19 @@ INSTANCE_TYPEABLE2(Either,eitherTc,"Either") INSTANCE_TYPEABLE1(IO,ioTc,"IO") INSTANCE_TYPEABLE1(Maybe,maybeTc,"Maybe") INSTANCE_TYPEABLE0(Ordering,orderingTc,"Ordering") +INSTANCE_TYPEABLE0(Handle,handleTc,"Handle") +INSTANCE_TYPEABLE1(Ptr,ptrTc,"Ptr") +INSTANCE_TYPEABLE1(StablePtr,stablePtrTc,"StablePtr") + +INSTANCE_TYPEABLE0(Int8,int8Tc, "Int8") +INSTANCE_TYPEABLE0(Int16,int16Tc,"Int16") +INSTANCE_TYPEABLE0(Int32,int32Tc,"Int32") +INSTANCE_TYPEABLE0(Int64,int64Tc,"Int64") + +INSTANCE_TYPEABLE0(Word8,word8Tc, "Word8" ) +INSTANCE_TYPEABLE0(Word16,word16Tc,"Word16") +INSTANCE_TYPEABLE0(Word32,word32Tc,"Word32") +INSTANCE_TYPEABLE0(Word64,word64Tc,"Word64") INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon") INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")