[project @ 1998-01-20 10:20:33 by sof]

[ghc-hetmet.git] / ghc / compiler / basicTypes / UniqSupply.lhs

diff --git a/ghc/compiler/basicTypes/UniqSupply.lhs b/ghc/compiler/basicTypes/UniqSupply.lhs
index 5641107..23bd2c0 100644 (file)
--- a/ghc/compiler/basicTypes/UniqSupply.lhs
+++ b/ghc/compiler/basicTypes/UniqSupply.lhs
@@ -4,15 +4,13 @@
 \section[UniqSupply]{The @UniqueSupply@ data type and a (monadic) supply thereof}
 
 \begin{code}
-#include "HsVersions.h"
-
 module UniqSupply (
 
        UniqSupply,             -- Abstractly
 
        getUnique, getUniques,  -- basic ops
 
-       SYN_IE(UniqSM),         -- type: unique supply monad
+       UniqSM,         -- type: unique supply monad
        initUs, thenUs, returnUs, fixUs,
        mapUs, mapAndUnzipUs, mapAndUnzip3Us,
        thenMaybeUs, mapAccumLUs,
@@ -21,18 +19,15 @@ module UniqSupply (
        splitUniqSupply
   ) where
 
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
 
 import Unique
 import Util
 
-import PreludeGlaST
 
-#if __GLASGOW_HASKELL__ >= 200
-# define WHASH     GHCbase.W#
-#else
-# define WHASH     W#
-#endif
+import GlaExts
+import IOBase  ( IO(..), IOResult(..) )
+import PrelBase ( Char(..) )
 
 w2i x = word2Int# x
 i2w x = int2Word# x
@@ -79,36 +74,19 @@ mkSplitUniqSupply (C# c#)
 
        -- here comes THE MAGIC:
 
+       -- This is one of the most hammered bits in the whole compiler
        mk_supply#
-         = unsafeInterleavePrimIO {-unsafe_interleave-} (
-               mk_unique   `thenPrimIO` \ uniq ->
-               mk_supply#  `thenPrimIO` \ s1 ->
-               mk_supply#  `thenPrimIO` \ s2 ->
-               returnPrimIO (MkSplitUniqSupply uniq s1 s2)
+         = unsafeInterleaveIO (
+               mk_unique   >>= \ uniq ->
+               mk_supply#  >>= \ s1 ->
+               mk_supply#  >>= \ s2 ->
+               return (MkSplitUniqSupply uniq s1 s2)
            )
-         where
-{-
-           -- inlined copy of unsafeInterleavePrimIO;
-           -- this is the single-most-hammered bit of code
-           -- in the compiler....
-           -- Too bad it's not 1.3-portable...
-           unsafe_interleave m s
-             = let
-                   (r, new_s) = m s
-               in
-               (r, s)
--}
-
-       mk_unique = _ccall_ genSymZh            `thenPrimIO` \ (WHASH u#) ->
-                   returnPrimIO (I# (w2i (mask# `or#` u#)))
+
+       mk_unique = _ccall_ genSymZh            >>= \ (W# u#) ->
+                   return (I# (w2i (mask# `or#` u#)))
     in
-#if __GLASGOW_HASKELL__ >= 200
-    primIOToIO mk_supply#      >>= \ s ->
-    return s
-#else
-    mk_supply# `thenPrimIO` \ s ->
-    return s
-#endif
+    mk_supply#
 
 splitUniqSupply (MkSplitUniqSupply _ s1 s2) = (s1, s2)
 \end{code}
@@ -120,7 +98,7 @@ getUniques (I# i) supply = i `get_from` supply
   where
     get_from 0# _ = []
     get_from n (MkSplitUniqSupply (I# u) _ s2)
-      = mkUniqueGrimily u : get_from (n `minusInt#` 1#) s2
+      = mkUniqueGrimily u : get_from (n -# 1#) s2
 \end{code}
 
 %************************************************************************
@@ -134,11 +112,9 @@ type UniqSM result = UniqSupply -> result
 
 -- the initUs function also returns the final UniqSupply
 
-initUs :: UniqSupply -> UniqSM a -> (UniqSupply, a)
+initUs :: UniqSupply -> UniqSM a -> a
 
-initUs init_us m
-  = case (splitUniqSupply init_us) of { (s1, s2) ->
-    (s2, m s1) }
+initUs init_us m = m init_us
 
 {-# INLINE thenUs #-}
 {-# INLINE returnUs #-}