X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FDynamic.hs;h=933224c9e32c55fbc82ff6efa3ce91f6ad0e235d;hb=df3788f0f093c337a4ea1a30b06c33687fd041c7;hp=0a9c116c75275628f2bc630e806c7d31733b53eb;hpb=acd78d6dbda0108ffa899cb585114a21c5ed7499;p=ghc-base.git diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs index 0a9c116..933224c 100644 --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -1,4 +1,4 @@ -{-# OPTIONS -fno-implicit-prelude #-} +{-# OPTIONS_GHC -fno-implicit-prelude #-} ----------------------------------------------------------------------------- -- | -- Module : Data.Dynamic @@ -34,7 +34,8 @@ module Data.Dynamic -- * Applying functions of dynamic type dynApply, - dynApp + dynApp, + dynTypeRep ) where @@ -47,9 +48,6 @@ import GHC.Base import GHC.Show import GHC.Err import GHC.Num -import GHC.Float -import GHC.Real( rem ) -import GHC.IOBase #endif #ifdef __HUGS__ @@ -67,10 +65,10 @@ unsafeCoerce = unsafeCoerce# #ifdef __NHC__ import NonStdUnsafeCoerce (unsafeCoerce) import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) -#else -#include "Typeable.h" #endif +#include "Typeable.h" + ------------------------------------------------------------- -- -- The type Dynamic @@ -91,9 +89,7 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO) data Dynamic = Dynamic TypeRep Obj #endif -#ifndef __NHC__ INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic") -#endif instance Show Dynamic where -- the instance just prints the type representation. @@ -146,7 +142,7 @@ fromDyn (Dynamic t v) def fromDynamic :: Typeable a => Dynamic -- ^ the dynamically-typed object - -> Maybe a -- ^ returns: @'Just' a@, if the dyanmically-typed + -> Maybe a -- ^ returns: @'Just' a@, if the dynamically-typed -- object has the correct type (and @a@ is its value), -- or 'Nothing' otherwise. fromDynamic (Dynamic t v) = @@ -157,7 +153,7 @@ fromDynamic (Dynamic t v) = -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic dynApply (Dynamic t1 f) (Dynamic t2 x) = - case applyTy t1 t2 of + case funResultTy t1 t2 of Just t3 -> Just (Dynamic t3 ((unsafeCoerce f) x)) Nothing -> Nothing @@ -167,3 +163,6 @@ dynApp f x = case dynApply f x of Nothing -> error ("Type error in dynamic application.\n" ++ "Can't apply function " ++ show f ++ " to argument " ++ show x) + +dynTypeRep :: Dynamic -> TypeRep +dynTypeRep (Dynamic tr _) = tr