X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FDynamic.hs;h=df64c389bf786a1a4a0d96a8392cc3e70ae54f9d;hb=4475dcabbc206d1cf0fc3fee88f600a4791d948c;hp=a43cc1872404a150efb83006cbffcde832948c29;hpb=d4039901986f6991c23f0469a40148e8150b0f1e;p=ghc-base.git

diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs
index a43cc18..df64c38 100644
--- a/Data/Dynamic.hs
+++ b/Data/Dynamic.hs
@@ -1,4 +1,8 @@
-{-# OPTIONS -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE DeriveDataTypeable, StandaloneDeriving #-}
+#endif
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Dynamic
@@ -21,32 +25,33 @@
 module Data.Dynamic
   (
 
-	-- Module Data.Typeable re-exported for convenience
-	module Data.Typeable,
+        -- Module Data.Typeable re-exported for convenience
+        module Data.Typeable,
 
-	-- * The @Dynamic@ type
-	Dynamic,	-- abstract, instance of: Show, Typeable
+        -- * 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
-	
-	-- * Applying functions of dynamic type
-	dynApply,
-	dynApp
+        -- * Converting to and from @Dynamic@
+        toDyn,          -- :: Typeable a => a -> Dynamic
+        fromDyn,        -- :: Typeable a => Dynamic -> a -> a
+        fromDynamic,    -- :: Typeable a => Dynamic -> Maybe a
+        
+        -- * Applying functions of dynamic type
+        dynApply,
+        dynApp,
+        dynTypeRep
 
   ) where
 
 
 import Data.Typeable
 import Data.Maybe
+import Unsafe.Coerce
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
 import GHC.Show
-import GHC.Err
-import GHC.Num
+import GHC.Exception
 #endif
 
 #ifdef __HUGS__
@@ -56,13 +61,7 @@ import Hugs.IORef
 import Hugs.IOExts
 #endif
 
-#ifdef __GLASGOW_HASKELL__
-unsafeCoerce :: a -> b
-unsafeCoerce = unsafeCoerce#
-#endif
-
 #ifdef __NHC__
-import NonStdUnsafeCoerce (unsafeCoerce)
 import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 #endif
 
@@ -70,7 +69,7 @@ import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
 
 -------------------------------------------------------------
 --
---		The type Dynamic
+--              The type Dynamic
 --
 -------------------------------------------------------------
 
@@ -94,20 +93,23 @@ instance Show Dynamic where
    -- the instance just prints the type representation.
    showsPrec _ (Dynamic t _) = 
           showString "<<" . 
-	  showsPrec 0 t   . 
-	  showString ">>"
+          showsPrec 0 t   . 
+          showString ">>"
 
 #ifdef __GLASGOW_HASKELL__
-type Obj = forall a . a
- -- Dummy type to hold the dynamically typed value.
+-- here so that it isn't an orphan:
+instance Exception Dynamic
+#endif
+
+#ifdef __GLASGOW_HASKELL__
+type Obj = Any
+ -- Use GHC's primitive 'Any' type to hold the dynamically typed value.
  --
- -- In GHC's new eval/apply execution model this type must
- -- be polymorphic.  It can't be a constructor, because then
- -- GHC will use the constructor convention when evaluating it,
- -- and this will go wrong if the object is really a function.  On
- -- the other hand, if we use a polymorphic type, GHC will use
+ -- In GHC's new eval/apply execution model this type must not look
+ -- like a data type.  If it did, GHC would use the constructor convention 
+ -- when evaluating it, and this will go wrong if the object is really a 
+ -- function.  Using Any forces GHC to use
  -- a fallback convention for evaluating it that works for all types.
- -- (using a function type here would also work).
 #elif !defined(__HUGS__)
 data Obj = Obj
 #endif
@@ -127,11 +129,11 @@ 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.
+        => 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
@@ -139,11 +141,11 @@ fromDyn (Dynamic t v) 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.
+        :: 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
@@ -162,3 +164,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