git.iko.soy/stackage
on 869c80a help sign in
stackage/patching/patches/uniqueid-0.1.1.patch
100 lines 2.9 kB history raw
1diff -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 @@
11 ) where
13+#if MIN_VERSION_base(4,7,0)
15+import GHC.Exts
16+import GHC.IO ( unsafeDupableInterleaveIO )
18+import Data.IORef
19+import System.IO.Unsafe ( unsafePerformIO )
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 }
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
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
43+-- | Splits a supply of unique identifiers to yield two of them.
44+splitIdSupply :: IdSupply -> (IdSupply,IdSupply)
45+splitIdSupply (IdSupply _ l r) = (l,r)
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
53+-- | Yields the unique identifier from a supply.
54+idFromSupply :: IdSupply -> Id
55+idFromSupply (IdSupply n _ _) = Id (I# n)
57+instance Eq Id where Id (I# x) == Id (I# y) = I# (x ==# y) /= 0
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
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
67+instance Show Id
68+ where
69+ showsPrec _ i s = case unpackId i of (c,n) -> c:show n++s
74+unboxedInt :: Int -> Int#
75+unboxedInt (I# x) = x
77+global :: IORef Int
78+global = unsafePerformIO (newIORef 0)
80+nextInt :: IO Int
81+nextInt = do
82+ n <- readIORef global
83+ writeIORef global (succ n)
84+ return n
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 )
96@@ -90,3 +171,4 @@
97 num = I# (word2Int# (and# (int2Word# i)
98 (int2Word# (unboxedInt 16777215))))
99 in (tag, num)
100+#endif