[project @ 2000-03-06 08:42:56 by andy]

Adding prelude changes require for the new libs, include IOExts.
Reintroducing ptr equality into HugsSTG.

ghc/includes/options.h

@@ -7,8 +7,8 @@
  * Hugs version 1.4, December 1997
  *
  * $RCSfile: options.h,v $
- * $Revision: 1.17 $
- * $Date: 2000/02/25 10:53:53 $
+ * $Revision: 1.18 $
+ * $Date: 2000/03/06 08:42:56 $
  * ------------------------------------------------------------------------*/
 
 
@@ -172,6 +172,7 @@
 #undef  PROVIDE_PTREQUALITY
 #undef  PROVIDE_COERCE
 
+#define PROVIDE_PTREQUALITY 1
 
 /* Set to 1 to use a non-GMP implementation of integer, in the
    standalone Hugs.  Set to 0 in the combined GHC-Hugs system,

ghc/interpreter/lib/Prelude.hs

@@ -104,14 +104,24 @@ module Prelude (
 
     , MVar, newEmptyMVar, newMVar, putMVar, takeMVar, readMVar, swapMVar
     , ThreadId, forkIO
-    ,trace
+    , trace
 
+
+    , ST(..)
     , STRef, newSTRef, readSTRef, writeSTRef
     , IORef, newIORef, readIORef, writeIORef
+    , PrimMutableArray, PrimMutableByteArray
+    , RealWorld
 
     -- This lot really shouldn't be exported, but are needed to
     -- implement various libs.
+    , runST , fixST, unsafeInterleaveST 
+    , stToIO , ioToST
+    , unsafePerformIO
+    , primReallyUnsafePtrEquality
     ,hugsprimCompAux,PrimArray,primRunST,primNewArray,primWriteArray
+    ,primReadArray, primIndexArray, primSizeMutableArray
+    ,primSizeArray
     ,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
     ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
     ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
@@ -1801,7 +1811,7 @@ primGetEnv v
      nh_getenv ptr                >>= \ptr2 ->
      nh_free ptr                  >>
      if   isNullAddr ptr2
-     then return []
+     then ioError (IOError "getEnv failed")
      else
      copy_cstring_to_String ptr2  >>= \result ->
      return result
@@ -1813,18 +1823,40 @@ primGetEnv v
 
 newtype ST s a = ST (s -> (a,s))
 
-data RealWorld
-type IO a = ST RealWorld a
-
---primRunST :: (forall s. ST s a) -> a
 primRunST :: ST RealWorld a -> a
 primRunST m = fst (unST m theWorld)
    where
       theWorld :: RealWorld
       theWorld = error "primRunST: entered the RealWorld"
 
+runST :: (__forall s . ST s a) -> a
+runST m = fst (unST m alpha)
+   where
+      alpha = error "primRunST: entered the RealWorld"
+
+fixST :: (a -> ST s a) -> ST s a
+fixST m = ST (\ s -> 
+		let 
+		   (r,s) = unST (m r) s
+		in
+		   (r,s))
+
 unST (ST a) = a
 
+data RealWorld
+-- Should IO not be abstract? 
+-- Is "instance (IO a)" allowed, for example ?
+type IO a = ST RealWorld a
+
+stToIO	      :: ST RealWorld a -> IO a
+stToIO = id
+
+ioToST	      :: IO a -> ST RealWorld a
+ioToST = id
+
+unsafePerformIO :: IO a -> a
+unsafePerformIO m = primRunST (ioToST m)
+
 instance Functor (ST s) where
    fmap f x  = x >>= (return . f)
 

ghc/lib/hugs/Prelude.hs

@@ -104,14 +104,24 @@ module Prelude (
 
     , MVar, newEmptyMVar, newMVar, putMVar, takeMVar, readMVar, swapMVar
     , ThreadId, forkIO
-    ,trace
+    , trace
 
+
+    , ST(..)
     , STRef, newSTRef, readSTRef, writeSTRef
     , IORef, newIORef, readIORef, writeIORef
+    , PrimMutableArray, PrimMutableByteArray
+    , RealWorld
 
     -- This lot really shouldn't be exported, but are needed to
     -- implement various libs.
+    , runST , fixST, unsafeInterleaveST 
+    , stToIO , ioToST
+    , unsafePerformIO
+    , primReallyUnsafePtrEquality
     ,hugsprimCompAux,PrimArray,primRunST,primNewArray,primWriteArray
+    ,primReadArray, primIndexArray, primSizeMutableArray
+    ,primSizeArray
     ,primUnsafeFreezeArray,primIndexArray,primGetRawArgs,primGetEnv
     ,nh_stdin,nh_stdout,nh_stderr,copy_String_to_cstring,nh_open
     ,nh_free,nh_close,nh_errno,nh_flush,nh_read,primIntToChar
@@ -1801,7 +1811,7 @@ primGetEnv v
      nh_getenv ptr                >>= \ptr2 ->
      nh_free ptr                  >>
      if   isNullAddr ptr2
-     then return []
+     then ioError (IOError "getEnv failed")
      else
      copy_cstring_to_String ptr2  >>= \result ->
      return result
@@ -1813,18 +1823,40 @@ primGetEnv v
 
 newtype ST s a = ST (s -> (a,s))
 
-data RealWorld
-type IO a = ST RealWorld a
-
---primRunST :: (forall s. ST s a) -> a
 primRunST :: ST RealWorld a -> a
 primRunST m = fst (unST m theWorld)
    where
       theWorld :: RealWorld
       theWorld = error "primRunST: entered the RealWorld"
 
+runST :: (__forall s . ST s a) -> a
+runST m = fst (unST m alpha)
+   where
+      alpha = error "primRunST: entered the RealWorld"
+
+fixST :: (a -> ST s a) -> ST s a
+fixST m = ST (\ s -> 
+		let 
+		   (r,s) = unST (m r) s
+		in
+		   (r,s))
+
 unST (ST a) = a
 
+data RealWorld
+-- Should IO not be abstract? 
+-- Is "instance (IO a)" allowed, for example ?
+type IO a = ST RealWorld a
+
+stToIO	      :: ST RealWorld a -> IO a
+stToIO = id
+
+ioToST	      :: IO a -> ST RealWorld a
+ioToST = id
+
+unsafePerformIO :: IO a -> a
+unsafePerformIO m = primRunST (ioToST m)
+
 instance Functor (ST s) where
    fmap f x  = x >>= (return . f)