Slight changes

darcs-hash:20071006053111-62b54-66a2cb75afcd688194e7b1c7d7817e9fcdc7fd45.gz

diff --git a/Network/HTTP/Lucu/Headers.hs b/Network/HTTP/Lucu/Headers.hs
index c97c93cb652156c618d92bab8977fa2627fda117..b26ddddfc17a0a0fa81eec7bcd5ae0bfba2b4d1d 100644 (file)
--- 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

diff --git a/Network/HTTP/Lucu/Interaction.hs b/Network/HTTP/Lucu/Interaction.hs
index 34452196a6148f0e0ac147c1c42174b6f78d21eb..4c0735a3f54e3da532101c27c5e2b28bf0a10811 100644 (file)
--- a/Network/HTTP/Lucu/Interaction.hs
+++ b/Network/HTTP/Lucu/Interaction.hs
@@ -34,8 +34,6 @@ data Interaction = Interaction {
     , itrRequest      :: !(TVar (Maybe Request))
     , itrResponse     :: !(TVar Response)
 
-    -- FIXME: この三つは本來 TVar であるべきでないので、唯の Bool にす
-    -- るに越した事は無いが、それは重要でない。
     , itrRequestHasBody    :: !(TVar Bool)
     , itrRequestIsChunked  :: !(TVar Bool)
     , itrExpectedContinue  :: !(TVar Bool)
@@ -122,8 +120,8 @@ newInteraction conf addr req
                     , itrRequest      = request
                     , itrResponse     = responce
 
-                    , itrRequestHasBody    = requestHasBody
-                    , itrRequestIsChunked  = requestIsChunked
+                    , itrRequestHasBody   = requestHasBody
+                    , itrRequestIsChunked = requestIsChunked
                     , itrExpectedContinue = expectedContinue
 
                     , itrReqChunkLength    = reqChunkLength

diff --git a/Network/HTTP/Lucu/Parser.hs b/Network/HTTP/Lucu/Parser.hs
index c40cacd0d4c17521817c7e3e8d2fb6c79394731d..44cf1558584932f6f71f59609069b3da4a5fa949 100644 (file)
--- a/Network/HTTP/Lucu/Parser.hs
+++ b/Network/HTTP/Lucu/Parser.hs
@@ -144,7 +144,7 @@ allowEOF f = f `seq`
 satisfy :: (Char -> Bool) -> Parser Char
 satisfy f = f `seq`
             do c <- anyChar
-               if f c then
+               if f $! c then
                    return c
                  else
                    failP