@@ -0,0 +1,100 @@
1+diff -ru orig/Data/Unique/Id.hs new/Data/Unique/Id.hs
2+--- orig/Data/Unique/Id.hs 2014-04-14 09:11:35.637516354 +0300
3++++ new/Data/Unique/Id.hs 2014-04-14 09:11:35.000000000 +0300
4+@@ -1,3 +1,4 @@
5++{-# LANGUAGE CPP #-}
6+ {-# LANGUAGE MagicHash #-}
7+
8+ -- | This module provides splittable supplies for unique identifiers.
9+@@ -13,6 +14,86 @@
10+
11+ ) where
12+
13++#if MIN_VERSION_base(4,7,0)
14++
15++import GHC.Exts
16++import GHC.IO ( unsafeDupableInterleaveIO )
17++
18++import Data.IORef
19++import System.IO.Unsafe ( unsafePerformIO )
20++
21++-- | Unique identifiers are of type 'Id' and can be hashed to an 'Int'
22++-- usning the function 'hashedId'.
23++newtype Id = Id { hashedId :: Int }
24++
25++-- | Supplies for unique identifiers are of type 'IdSupply' and can be
26++-- split into two new supplies or yield a unique identifier.
27++data IdSupply = IdSupply Int# IdSupply IdSupply
28++
29++-- | Generates a new supply of unique identifiers. The given character
30++-- is prepended to generated numbers.
31++initIdSupply :: Char -> IO IdSupply
32++initIdSupply (C# c) =
33++ case uncheckedIShiftL# (ord# c) (unboxedInt 24) of
34++ mask ->
35++ let mkSupply =
36++ unsafeDupableInterleaveIO (
37++ nextInt >>= \ (I# u) ->
38++ mkSupply >>= \ l ->
39++ mkSupply >>= \ r ->
40++ return (IdSupply (word2Int# (or# (int2Word# mask) (int2Word# u))) l r))
41++ in mkSupply
42++
43++-- | Splits a supply of unique identifiers to yield two of them.
44++splitIdSupply :: IdSupply -> (IdSupply,IdSupply)
45++splitIdSupply (IdSupply _ l r) = (l,r)
46++
47++-- | Splits a supply of unique identifiers to yield an infinite list of them.
48++splitIdSupplyL :: IdSupply -> [IdSupply]
49++splitIdSupplyL ids = ids1 : splitIdSupplyL ids2
50++ where
51++ (ids1, ids2) = splitIdSupply ids
52++
53++-- | Yields the unique identifier from a supply.
54++idFromSupply :: IdSupply -> Id
55++idFromSupply (IdSupply n _ _) = Id (I# n)
56++
57++instance Eq Id where Id (I# x) == Id (I# y) = I# (x ==# y) /= 0
58++
59++instance Ord Id
60++ where
61++ Id (I# x) < Id (I# y) = I# (x <# y) /= 0
62++ Id (I# x) <= Id (I# y) = I# (x <=# y) /= 0
63++
64++ compare (Id (I# x)) (Id (I# y)) =
65++ if I# (x ==# y) /= 0 then EQ else if I# (x <# y) /= 0 then LT else GT
66++
67++instance Show Id
68++ where
69++ showsPrec _ i s = case unpackId i of (c,n) -> c:show n++s
70++
71++
72++
73++
74++unboxedInt :: Int -> Int#
75++unboxedInt (I# x) = x
76++
77++global :: IORef Int
78++global = unsafePerformIO (newIORef 0)
79++
80++nextInt :: IO Int
81++nextInt = do
82++ n <- readIORef global
83++ writeIORef global (succ n)
84++ return n
85++
86++unpackId :: Id -> (Char,Int)
87++unpackId (Id (I# i)) =
88++ let tag = C# (chr# (uncheckedIShiftRL# i (unboxedInt 24)))
89++ num = I# (word2Int# (and# (int2Word# i)
90++ (int2Word# (unboxedInt 16777215))))
91++ in (tag, num)
92++#else
93+ import GHC.Exts
94+ import GHC.IOBase ( unsafeDupableInterleaveIO )
95+
96+@@ -90,3 +171,4 @@
97+ num = I# (word2Int# (and# (int2Word# i)
98+ (int2Word# (unboxedInt 16777215))))
99+ in (tag, num)
100++#endif