{-# OPTIONS -O2 #-}
--
-- Translated from the OCaml version.
--

import Control.Monad
import Data.Char
import Data.Array.IO
import Data.Array.Base
import Data.Bits
import Data.Word
import System
import System.CPUTime
import System.IO
import Text.Printf

iter :: Int
iter = 10
    
main = do
    f         <- getArgs >>= return . head
    (arr,l)   <- slurp f 
    t0        <- getCPUTime
    (arr',l') <- replicateM iter (drop0xx arr (l*8)) >>= return . head
    t1        <- getCPUTime
    printf "%.3f\n" $ (fromInteger (t1 - t0) :: Float) / (fromInteger 10 ^ 12 :: Float)
    dump f arr' (1 + (snd . bounds) arr')

drop0xx = drop0xx' 0 0 0 []

drop0xx' :: Int -> Int -> Int -> [Int] -> Buffer -> Int -> IO (Buffer,Int)
drop0xx' inoff reg shifts acc str len
    | inoff `seq` reg `seq` shifts `seq` acc `seq` str `seq` len `seq` False = undefined
    | inoff' > len  = makeResult (reverse acc) reg shifts
    | otherwise     = do
        triple <- getTriple str inoff
        if triple >= 4 
            then let reg' = (reg `shiftL` 3) .|. triple 
                 in if shifts == 7
                    then drop0xx' inoff' 0    0          (reg':acc) str len
                    else drop0xx' inoff' reg' (shifts+1) acc        str len
            else drop0xx' inoff' reg shifts acc str len

    where inoff' = inoff + 3

getTriple :: Buffer -> Int -> IO Int
getTriple str inoff | str `seq` inoff `seq` False = undefined 
getTriple str inoff = do
    b0 <- str `unsafeRead` bitind     >>= return . fromIntegral
    b1 <- str `unsafeRead` (bitind+1) >>= return . fromIntegral
    return $! (if bitoff < 6
              then  b0 `shiftR` (5-bitoff)
              else (b0 `shiftL` (bitoff-5)) .|. (b1 `shiftR` (13-bitoff)))
          .&. 7

      where bitoff = inoff .&. 7
            bitind = inoff `shiftR` 3

makeResult :: [Int] -> Int -> Int -> IO (Buffer,Int)
makeResult list0 endpiece shifts = do
    arr <- newArray_ (0,triplebytesize + endpiecesize-1) :: IO Buffer

    let packList (triple:rest) ind = do 
             unsafeWrite arr ind     $ fromIntegral $ (triple `shiftR` 16) .&. 255
             unsafeWrite arr (ind+1) $ fromIntegral $ (triple `shiftR`  8) .&. 255
             unsafeWrite arr (ind+2) $ fromIntegral $ triple               .&. 255
             packList rest (ind+3)

        packList [] ind = 
            let c1 = endpiece `shiftL` ((shifts*3 - 8) .&. 255)
                s0 = shifts * 3 - 8
            in case endpiecesize of
                0 -> return ()
                1 -> do unsafeWrite arr ind $ fromIntegral $
                          endpiece `shiftL` (s0 .&. 255)
                2 -> do unsafeWrite arr ind $ fromIntegral $
                          endpiece `shiftL` (s0 .&. 255)
                        unsafeWrite arr (ind+1) $ fromIntegral $
                          endpiece `shiftL` ((s0-8) .&. 255)
    packList list0 0
    return (arr, triplebytesize * 8 + shifts * 3)

    where endpiecesize   = getNeededBytes shifts 
          triplebytesize = 3 * length list0

getNeededBytes shifts | shifts < 3 = 0
                      | shifts < 6 = 1
                      | otherwise  = 2
                      
------------------------------------------------------------------------

type Buffer = IOUArray Int Word8

slurp :: FilePath -> IO (Buffer, Int)
slurp f = do
    h   <- openBinaryFile f ReadMode
    l   <- hFileSize h
    arr <- newArray_ (0,fromIntegral l-1) :: IO Buffer
    hGetArray h arr (fromIntegral l)
    hClose h
    return (arr,fromIntegral l)

dump :: FilePath -> Buffer -> Int -> IO ()
dump f arr l = do
    h <- openBinaryFile (f ++ ".haskell") WriteMode
    hPutArray h arr l
    hClose h