diff options
Diffstat (limited to 'ghc/lib/hbc/NameSupply.hs')
| -rw-r--r-- | ghc/lib/hbc/NameSupply.hs | 67 |
1 files changed, 67 insertions, 0 deletions
diff --git a/ghc/lib/hbc/NameSupply.hs b/ghc/lib/hbc/NameSupply.hs new file mode 100644 index 0000000000..6d14d225b9 --- /dev/null +++ b/ghc/lib/hbc/NameSupply.hs @@ -0,0 +1,67 @@ +module NameSupply(NameSupply, initialNameSupply, splitNameSupply, getName, listNameSupply, Name(..) +#if defined(__YALE_HASKELL__) + , Symbol +#endif + ) where + +#if defined(__YALE_HASKELL__) +import Symbol +type Name = Symbol + +#else +# if defined(__GLASGOW_HASKELL__) +import PreludeGlaST +type Name = Int + +# else +import LMLgensym +type Name = Int +# endif +#endif + +data NameSupply = NameSupply Name NameSupply NameSupply + +splitNameSupply :: NameSupply -> (NameSupply,NameSupply) +getName :: NameSupply -> Name +listNameSupply :: NameSupply -> [NameSupply] + +#if defined(__YALE_HASKELL__) +initialNameSupply :: IO NameSupply +#else +initialNameSupply :: NameSupply +#endif + +#if defined(__GLASGOW_HASKELL__) +initialNameSupply = unsafePerformPrimIO mk_supply# -- GHC-specific + where + mk_supply# + = unsafeInterleavePrimIO (_ccall_ genSymZh) + `thenPrimIO` \ u -> + unsafeInterleavePrimIO mk_supply# `thenPrimIO` \ s1 -> + unsafeInterleavePrimIO mk_supply# `thenPrimIO` \ s2 -> + returnPrimIO (NameSupply u s1 s2) +#endif + +#if defined(__YALE_HASKELL__) +initialNameSupply :: IO NameSupply +initialNameSupply + = let + mk_supply = + unsafeInterleaveIO (genSymbol "NameSupply") >>= \ sym -> + unsafeInterleaveIO mk_supply >>= \ supply1 -> + unsafeInterleaveIO mk_supply >>= \ supply2 -> + return (NameSupply sym supply1 supply2) + in + mk_supply +#endif + +#if defined(__HBC__) +initialNameSupply = gen () + where gen n = NameSupply (__gensym n) (gen n) (gen n) +#endif + +splitNameSupply (NameSupply _ s1 s2) = (s1, s2) + +getName (NameSupply k _ _) = k + +listNameSupply (NameSupply _ s1 s2) = s1 : listNameSupply s2 |