{-# LANGUAGE BangPatterns #-}
import qualified Data.Vector.Storable.ByteString.Char8 as S
import Data.Vector.Storable.ByteString.Internal
import Data.Vector.Storable.ByteString.Unsafe
import Foreign
import Control.Monad
import System.Environment
import System.CPUTime
import Text.Printf
import Foreign.ForeignPtr
time :: Show t => IO t -> IO t
time a = do
start <- getCPUTime
v <- a
v `seq` return ()
end <- getCPUTime
print v
let diff = (fromIntegral (end - start)) / (10^12)
printf "Computation time: %0.3f sec\n" (diff :: Double)
return v
main = do
[f,g,n,m] <- getArgs
x <- S.readFile f
y <- S.readFile g
forM_ [read n .. read m] $ \i -> do
print i
time (-- replicateM_ 100000000 $
return $ S.take i x `compareBytes` S.take i y
)
time (-- replicateM_ 100000000 $
return $ S.take i x `compareBytesC` S.take i y
)
------------------------------------------------------------------------
compareBytes :: ByteString -> ByteString -> Ordering
compareBytes (PS fp1 off1 len1) (PS fp2 off2 len2)
-- | len1 == 0 && len2 == 0 = EQ -- short cut for empty strings
-- | fp1 == fp2 && off1 == off2 && len1 == len2 = EQ -- short cut for the same string
| otherwise = inlinePerformIO $
withForeignPtr fp1 $ \p1 ->
withForeignPtr fp2 $ \p2 ->
cmp (p1 `plusPtr` off1)
(p2 `plusPtr` off2) 0 len1 len2
cmp :: Ptr Word8 -> Ptr Word8 -> Int -> Int -> Int-> IO Ordering
cmp p1 p2 n len1 len2
| n == len1 = if n == len2 then return EQ else return LT
| n == len2 = return GT
| otherwise = do
a <- peekByteOff p1 n :: IO Word8
b <- peekByteOff p2 n
case a `compare` b of
EQ -> cmp p1 p2 (n+1) len1 len2
LT -> return LT
GT -> return GT
compareBytesC (PS x1 s1 l1) (PS x2 s2 l2)
| l1 == 0 && l2 == 0 = EQ -- short cut for empty strings
| x1 == x2 && s1 == s2 && l1 == l2 = EQ -- short cut for the same string
| otherwise = inlinePerformIO $
withForeignPtr x1 $ \p1 ->
withForeignPtr x2 $ \p2 -> do
i <- memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (fromIntegral $ min l1 l2)
return $! case i `compare` 0 of
EQ -> l1 `compare` l2
x -> x
{-# INLINE compareBytes #-}