Repository : ssh://darcs.haskell.org//srv/darcs/packages/base On branch : new-typeable
http://hackage.haskell.org/trac/ghc/changeset/c7d40efbc3b5b1c437b08ded2db59b1f0d923bc5 >--------------------------------------------------------------- commit c7d40efbc3b5b1c437b08ded2db59b1f0d923bc5 Author: Jose Pedro Magalhaes <[email protected]> Date: Wed Oct 3 15:31:53 2012 +0100 Remove warnings >--------------------------------------------------------------- Data/Dynamic.hs | 18 +++++++++--------- Data/OldTypeable.hs | 2 +- Data/Typeable.hs | 13 ------------- 3 files changed, 10 insertions(+), 23 deletions(-) diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs index 11501b8..2e7a831 100644 --- a/Data/Dynamic.hs +++ b/Data/Dynamic.hs @@ -1,7 +1,7 @@ {-# LANGUAGE Trustworthy #-} {-# LANGUAGE CPP, NoImplicitPrelude #-} #ifdef __GLASGOW_HASKELL__ -{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-} +{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving, ScopedTypeVariables #-} #endif ----------------------------------------------------------------------------- @@ -124,33 +124,33 @@ data Obj = Obj -- -- > toDyn (id :: Int -> Int) -- -toDyn :: Typeable a => a -> Dynamic -toDyn v = Dynamic (typeOf v) (unsafeCoerce v) +toDyn :: forall a. Typeable a => a -> Dynamic +toDyn v = Dynamic (typeRep (Proxy :: Proxy a)) (unsafeCoerce v) -- | Converts a 'Dynamic' object back into an ordinary Haskell value of -- the correct type. See also 'fromDynamic'. -fromDyn :: Typeable a +fromDyn :: forall a. 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 + | typeRep (Proxy :: Proxy a) == 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 + :: forall 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 == typeOf r -> Just r - | otherwise -> Nothing + r | t == typeRep (Proxy :: Proxy a) -> Just r + | otherwise -> Nothing -- (f::(a->b)) `dynApply` (x::a) = (f a)::b dynApply :: Dynamic -> Dynamic -> Maybe Dynamic diff --git a/Data/OldTypeable.hs b/Data/OldTypeable.hs index ba37c97..f2e0b19 100644 --- a/Data/OldTypeable.hs +++ b/Data/OldTypeable.hs @@ -6,7 +6,7 @@ , ForeignFunctionInterface , FlexibleInstances #-} -{-# OPTIONS_GHC -funbox-strict-fields #-} +{-# OPTIONS_GHC -funbox-strict-fields -fno-warn-warnings-deprecations #-} -- The -XOverlappingInstances flag allows the user to over-ride -- the instances for Typeable given here. In particular, we provide an instance diff --git a/Data/Typeable.hs b/Data/Typeable.hs index 4d58e16..e0bd6f3 100644 --- a/Data/Typeable.hs +++ b/Data/Typeable.hs @@ -77,9 +77,6 @@ module Data.Typeable funResultTy, -- :: TypeRep -> TypeRep -> Maybe TypeRep typeRepTyCon, -- :: TypeRep -> TyCon typeRepArgs, -- :: TypeRep -> [TypeRep] - -- typeRepKey, -- :: TypeRep -> IO TypeRepKey - TypeRepKey, -- abstract, instance of Eq, Ord - ) where import Data.Typeable.Internal hiding (mkTyCon) @@ -90,16 +87,6 @@ import Data.Maybe import GHC.Base import GHC.Err (undefined) -import {-# SOURCE #-} GHC.Fingerprint - -- loop: GHC.Fingerprint -> Foreign.Ptr -> Data.Typeable - -- Better to break the loop here, because we want non-SOURCE imports - -- of Data.Typeable as much as possible so we can optimise the derived - -- instances. - - -newtype TypeRepKey = TypeRepKey Fingerprint - deriving (Eq,Ord) - ------------------------------------------------------------- -- -- Type-safe cast _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
