Use the new Any type for dynamics (GHC only)
[ghc-base.git] / Data / Dynamic.hs
index 0a9c116..761f55f 100644 (file)
@@ -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.
@@ -103,16 +99,14 @@ instance Show Dynamic where
          showString ">>"
 
 #ifdef __GLASGOW_HASKELL__
-type Obj = forall a . a
- -- Dummy type to hold the dynamically typed value.
+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
@@ -146,7 +140,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 +151,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 +161,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