Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/767f73e341aeded08705a4401921141f552e67f1 >--------------------------------------------------------------- commit 767f73e341aeded08705a4401921141f552e67f1 Author: Jose Pedro Magalhaes <[email protected]> Date: Mon Nov 19 11:16:41 2012 +0000 Do not deprecate typeOf and friends >--------------------------------------------------------------- Data/Dynamic.hs | 18 +++++++++--------- Data/Typeable/Internal.hs | 2 +- 2 files changed, 10 insertions(+), 10 deletions(-) diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs index 2e7a831..11501b8 100644 --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -1,7 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} #ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, ScopedTypeVariables #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} #endif ----------------------------------------------------------------------------- @@ -124,33 +124,33 @@ data Obj = Obj -- -- > toDyn (id :: Int -> Int) -- -toDyn :: forall a. Typeable a => a -> Dynamic -toDyn v = Dynamic (typeRep (Proxy :: Proxy a)) (unsafeCoerce v) +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 :: forall a. Typeable a +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 - | typeRep (Proxy :: Proxy a) == t = unsafeCoerce v - | otherwise = 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 - :: forall a. Typeable a + :: Typeable a => Dynamic -- ^ the dynamically-typed object -> 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) = case unsafeCoerce v of - r | t == typeRep (Proxy :: Proxy a) -> Just r - | otherwise -> Nothing + r | t == typeOf r -> Just r + | otherwise -> Nothing -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic diff --git a/Data/Typeable/Internal.hs b/Data/Typeable/Internal.hs index 8994293..fc548e4 100644 --- a/Data/Typeable/Internal.hs +++ b/Data/Typeable/Internal.hs @@ -197,7 +197,7 @@ class Typeable a where -- ^ Takes a value of type @a@ and returns a concrete representation -- of that type. -{-# DEPRECATED typeOf, typeOf1, typeOf2, typeOf3, typeOf4, typeOf5, typeOf6, typeOf7 "Use typeRep instead" #-} +-- Keeping backwards-compatibility typeOf :: forall a. Typeable a => a -> TypeRep typeOf _ = typeRep (Proxy :: Proxy a) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
