git.iko.soy/elk
on master help sign in
Add Ord and Binary instances for Data.Utf8
75f0ef4Evan Czaplicki
compiler/src/Data/Utf8.hs+63−1
compare with master
unifiedsplit
@@ -9,7 +9,11 @@ module Data.Utf8
9 where
9 where
10
10
11
11
12+import Data.Binary (Binary(..), Get)
13+import Data.Binary.Put (putBuilder)
14+import Data.Binary.Get.Internal (readN)
12import Data.Bits ((.&.), shiftR)
15import Data.Bits ((.&.), shiftR)
16+import qualified Data.ByteString.Internal as B
13import qualified Data.ByteString.Builder.Internal as B
17import qualified Data.ByteString.Builder.Internal as B
14import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)
18import Foreign.ForeignPtr (ForeignPtr, touchForeignPtr)
15import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
19import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
@@ -25,7 +29,7 @@ import GHC.Exts
25 , writeWord8Array#, writeWord16Array#
29 , writeWord8Array#, writeWord16Array#
26 )
30 )
27import GHC.IO
31import GHC.IO
28−import GHC.ST (ST(ST))
32+import GHC.ST (ST(ST), runST)
29import GHC.Prim
33import GHC.Prim
30import GHC.Word (Word8(W8#), Word16(W16#))
34import GHC.Word (Word8(W8#), Word16(W16#))
31
35
@@ -54,6 +58,64 @@ instance Eq Utf8 where
54
58
55
59
56
60
61+-- COMPARE
62+
63+
64+instance Ord Utf8 where
65+ compare (Utf8 ba1#) (Utf8 ba2#) =
66+ let
67+ !len1# = sizeofByteArray# ba1#
68+ !len2# = sizeofByteArray# ba2#
69+ !len# = if isTrue# (len1# <# len2#) then len1# else len2#
70+ !cmp# = compareByteArrays# ba1# 0# ba2# 0# len#
71+ in
72+ case () of
73+ _ | isTrue# (cmp# <# 0#) -> LT
74+ | isTrue# (cmp# ># 0#) -> GT
75+ | isTrue# (len1# <# len2#) -> LT
76+ | isTrue# (len1# ># len2#) -> GT
77+ | True -> EQ
78+
79+
80+
81+-- BINARY
82+
83+
84+instance Binary Utf8 where
85+ put utf8@(Utf8 ba#) =
86+ put (I# (sizeofByteArray# ba#)) <> putBuilder (toBuilder utf8)
87+ get =
88+ get >>= getUtf8
89+
90+
91+{-# INLINE getUtf8 #-}
92+getUtf8 :: Int -> Get Utf8
93+getUtf8 n =
94+ if n > 0 then
95+ readN n (fromByteString n)
96+ else
97+ return empty
98+
99+
100+-- TODO add inline?
101+fromByteString :: Int -> B.ByteString -> Utf8
102+fromByteString len (B.PS fptr offset _) =
103+ unsafeDupablePerformIO
104+ (
105+ do mba <- stToIO (newByteArray len)
106+ stToIO (copyFromPtr (unsafeForeignPtrToPtr fptr `plusPtr` offset) mba 0 len)
107+ touchForeignPtr fptr
108+ stToIO (unsafeFreeze mba)
109+ )
110+
111+
112+{-# NOINLINE empty #-}
113+empty :: Utf8
114+empty =
115+ runST (unsafeFreeze =<< newByteArray 0)
116+
117+
118+
57-- CHUNKS
119-- CHUNKS
58
120
59
121