X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2FbasicTypes%2FUniqSupply.lhs;h=98e288860fb57d582ba355c182dc1479e83d95e0;hb=6a4714dea79820500374e0dd654b87a5d752bc39;hp=3cb2ca724e4664f1970cb98a56e6d96640cbbc09;hpb=5eb1c77c795f92ed0f4c8023847e9d4be1a4fd0d;p=ghc-hetmet.git diff --git a/ghc/compiler/basicTypes/UniqSupply.lhs b/ghc/compiler/basicTypes/UniqSupply.lhs index 3cb2ca7..98e2888 100644 --- a/ghc/compiler/basicTypes/UniqSupply.lhs +++ b/ghc/compiler/basicTypes/UniqSupply.lhs @@ -13,7 +13,7 @@ module UniqSupply ( getUnique, getUniques, -- basic ops SYN_IE(UniqSM), -- type: unique supply monad - initUs, thenUs, returnUs, + initUs, thenUs, returnUs, fixUs, mapUs, mapAndUnzipUs, mapAndUnzip3Us, thenMaybeUs, mapAccumLUs, @@ -26,11 +26,16 @@ IMP_Ubiq(){-uitous-} import Unique import Util -import PreludeGlaST -#if __GLASGOW_HASKELL__ >= 200 +#if __GLASGOW_HASKELL__ == 201 +import PreludeGlaST # define WHASH GHCbase.W# +#elif __GLASGOW_HASKELL__ >= 202 +import GlaExts +import STBase +# define WHASH GlaExts.W# #else +import PreludeGlaST # define WHASH W# #endif @@ -80,24 +85,26 @@ mkSplitUniqSupply (C# c#) -- here comes THE MAGIC: mk_supply# - = unsafeInterleavePrimIO {-unsafe_interleave-} ( + = unsafe_interleave ( mk_unique `thenPrimIO` \ uniq -> mk_supply# `thenPrimIO` \ s1 -> mk_supply# `thenPrimIO` \ s2 -> returnPrimIO (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) --} + unsafe_interleave m = + MkST ( \ s -> + let + (MkST m') = m + (r, new_s) = m' s + in + (r, s)) +-- mk_unique = _ccall_ genSymZh `thenPrimIO` \ (WHASH u#) -> returnPrimIO (I# (w2i (mask# `or#` u#))) @@ -120,7 +127,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 +141,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 #-} @@ -147,6 +152,10 @@ initUs init_us m @thenUs@ is where we split the @UniqSupply@. \begin{code} +fixUs :: (a -> UniqSM a) -> UniqSM a +fixUs m us + = r where r = m r us + thenUs :: UniqSM a -> (a -> UniqSM b) -> UniqSM b thenUs expr cont us