X-Git-Url: http://git.cielonegro.org/gitweb.cgi?p=Lucu.git;a=blobdiff_plain;f=Network%2FHTTP%2FLucu%2FHeaders.hs;h=b26ddddfc17a0a0fa81eec7bcd5ae0bfba2b4d1d;hp=c97c93cb652156c618d92bab8977fa2627fda117;hb=83db536d11e8efb26848318ad4514b825f412460;hpb=15aa04a569fb13fb0793389f78f52b0255083cef diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs index c97c93c..b26dddd 100644 --- a/Network/HTTP/Lucu/Headers.hs +++ b/Network/HTTP/Lucu/Headers.hs @@ -50,10 +50,12 @@ instance Show NCBS where show (NCBS x) = show x noCaseCmp :: ByteString -> ByteString -> Ordering -noCaseCmp a b = toForeignPtr a `cmp` toForeignPtr b +noCaseCmp a b = a `seq` b `seq` + toForeignPtr a `cmp` toForeignPtr b where cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Ordering cmp (x1, s1, l1) (x2, s2, l2) + | x1 `seq` s1 `seq` l1 `seq` x2 `seq` s2 `seq` l2 `seq` False = undefined | l1 == 0 && l2 == 0 = EQ | x1 == x2 && s1 == s2 && l1 == l2 = EQ | otherwise @@ -61,11 +63,12 @@ noCaseCmp a b = toForeignPtr a `cmp` toForeignPtr b withForeignPtr x1 $ \ p1 -> withForeignPtr x2 $ \ p2 -> noCaseCmp' (p1 `plusPtr` s1) l1 (p2 `plusPtr` s2) l2 -{-# INLINE noCaseCmp #-} + -- もし先頭の文字列が等しければ、短い方が小さい。 noCaseCmp' :: Ptr Word8 -> Int -> Ptr Word8 -> Int -> IO Ordering noCaseCmp' p1 l1 p2 l2 + | p1 `seq` l1 `seq` p2 `seq` l2 `seq` False = undefined | l1 == 0 && l2 == 0 = return EQ | l1 == 0 && l1 /= 0 = return LT | l1 /= 0 && l2 == 0 = return GT @@ -78,10 +81,12 @@ noCaseCmp' p1 l1 p2 l2 noCaseEq :: ByteString -> ByteString -> Bool -noCaseEq a b = toForeignPtr a `cmp` toForeignPtr b +noCaseEq a b = a `seq` b `seq` + toForeignPtr a `cmp` toForeignPtr b where cmp :: (ForeignPtr Word8, Int, Int) -> (ForeignPtr Word8, Int, Int) -> Bool cmp (x1, s1, l1) (x2, s2, l2) + | x1 `seq` s1 `seq` l1 `seq` x2 `seq` s2 `seq` l2 `seq` False = undefined | l1 /= l2 = False | l1 == 0 && l2 == 0 = True | x1 == x2 && s1 == s2 && l1 == l2 = True @@ -94,6 +99,7 @@ noCaseEq a b = toForeignPtr a `cmp` toForeignPtr b noCaseEq' :: Ptr Word8 -> Ptr Word8 -> Int -> IO Bool noCaseEq' p1 p2 l + | p1 `seq` p2 `seq` l `seq` False = undefined | l == 0 = return True | otherwise = do c1 <- peek p1