Adding prelude changes require for the new libs, include IOExts.
Reintroducing ptr equality into HugsSTG.
* 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 $
* ------------------------------------------------------------------------*/
#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,
, 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
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
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)
, 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
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
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)