X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Data%2FDynamic.hs;h=2ca46895a6b5713dae2def4f6594fddb06270407;hb=64ee6872ac48f2c60949746010a531aa9d334f66;hp=c67ea20ea1ea96f3a3a4b1857eba1fa7a23adc04;hpb=bfdd52de414c485c3173b4c899d4a58b67dc725c;p=ghc-base.git

diff --git a/Data/Dynamic.hs b/Data/Dynamic.hs
index c67ea20..2ca4689 100644
--- a/Data/Dynamic.hs
+++ b/Data/Dynamic.hs
@@ -79,6 +79,7 @@ import GHC.IOBase
 #endif
 
 #ifdef __HUGS__
+import Hugs.Prelude
 import Hugs.IO
 import Hugs.IORef
 import Hugs.IOExts
@@ -89,7 +90,12 @@ unsafeCoerce :: a -> b
 unsafeCoerce = unsafeCoerce#
 #endif
 
+#ifdef __NHC__
+import NonStdUnsafeCoerce (unsafeCoerce)
+import NHC.IOExtras (IORef,newIORef,readIORef,writeIORef,unsafePerformIO)
+#else
 #include "Dynamic.h"
+#endif
 
 {-|
   A value of type 'Dynamic' is an object encapsulated together with its type.
@@ -101,7 +107,9 @@ unsafeCoerce = unsafeCoerce#
   'Show'ing a value of type 'Dynamic' returns a pretty-printed representation
   of the object\'s type; useful for debugging.
 -}
+#ifndef __HUGS__
 data Dynamic = Dynamic TypeRep Obj
+#endif
 
 instance Show Dynamic where
    -- the instance just prints the type representation.
@@ -110,15 +118,29 @@ instance Show Dynamic where
 	  showsPrec 0 t   . 
 	  showString ">>"
 
-data Obj = Obj  
- -- dummy type to hold the dynamically typed value.
+#ifdef __GLASGOW_HASKELL__
+type Obj = forall a . a
+ -- Dummy 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
+ -- 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
 
 -- | A concrete representation of a (monomorphic) type.  'TypeRep'
 -- supports reasonably efficient equality.
+#ifndef __HUGS__
 data TypeRep
  = App TyCon   [TypeRep] 
  | Fun TypeRep TypeRep
    deriving ( Eq )
+#endif
 
 instance Show TypeRep where
   showsPrec p (App tycon tys) =
@@ -139,10 +161,12 @@ instance Show TypeRep where
 
 -- | An abstract representation of a type constructor.  'TyCon' objects can
 -- be built using 'mkTyCon'.
+#ifndef __HUGS__
 data TyCon = TyCon Int String
 
 instance Eq TyCon where
   (TyCon t1 _) == (TyCon t2 _) = t1 == t2
+#endif
 
 instance Show TyCon where
   showsPrec _ (TyCon _ s) = showString s
@@ -343,6 +367,7 @@ instance (Typeable a, Typeable b) => Typeable (a -> b) where
   typeOf f = mkFunTy (typeOf ((undefined :: (a -> b) -> a) f))
 		     (typeOf ((undefined :: (a -> b) -> b) f))
 
+#ifndef __NHC__
 INSTANCE_TYPEABLE0(Bool,boolTc,"Bool")
 INSTANCE_TYPEABLE0(Char,charTc,"Char")
 INSTANCE_TYPEABLE0(Float,floatTc,"Float")
@@ -371,7 +396,6 @@ INSTANCE_TYPEABLE0(TyCon,tyconTc,"TyCon")
 INSTANCE_TYPEABLE0(TypeRep,typeRepTc,"TypeRep")
 INSTANCE_TYPEABLE0(Dynamic,dynamicTc,"Dynamic")
 
-#ifndef __NHC__
 #include "Dynamic.h"
 INSTANCE_TYPEABLE1(IORef,ioRefTc,"IORef")
 #endif