Changeset 6793 for src/DrIFT/Binary.hs

Show
Ignore:
Timestamp:
09/06/05 14:11:41 (3 years ago)
Author:
autrijus
Message:

* massive retab for src/, expanding all tabs into spaces,

except for the generated PIL1.hs.

Files:
1 modified

Legend:

Unmodified
Added
Removed

  • src/DrIFT/Binary.hs

    r6359 r6793  
    4444   putByteArray, 
    4545 
    46    --getBinFileWithDict,        -- :: Binary a => FilePath -> IO a 
    47    --putBinFileWithDict,        -- :: Binary a => FilePath -> ModuleName -> a -> IO () 
     46   --getBinFileWithDict,        -- :: Binary a => FilePath -> IO a 
     47   --putBinFileWithDict,        -- :: Binary a => FilePath -> ModuleName -> a -> IO () 
    4848 
    4949  ) where 
    … …  
    5656import Data.Word 
    5757import Data.IORef 
    58 import Data.Char                ( ord, chr ) 
    59 import Control.Monad            ( when ) 
    60 import Control.Exception        ( throwDyn ) 
     58import Data.Char                ( ord, chr ) 
     59import Control.Monad            ( when ) 
     60import Control.Exception        ( throwDyn ) 
    6161import System.IO as IO 
    62 import System.IO.Unsafe         ( unsafeInterleaveIO ) 
    63 import System.IO.Error          ( mkIOError, eofErrorType ) 
    64 import GHC.Real                 ( Ratio(..) ) 
     62import System.IO.Unsafe         ( unsafeInterleaveIO ) 
     63import System.IO.Error          ( mkIOError, eofErrorType ) 
     64import GHC.Real                 ( Ratio(..) ) 
    6565import GHC.Exts 
    66 import GHC.IOBase               ( IO(..) ) 
    67 import GHC.Word                 ( Word8(..) ) 
    68 import System.IO                ( openBinaryFile ) 
     66import GHC.IOBase               ( IO(..) ) 
     67import GHC.Word                 ( Word8(..) ) 
     68import System.IO                ( openBinaryFile ) 
    6969import UTF8.PackedString 
    7070--import Atom 
    … …  
    9393  = IOException (IOError maybe_hdl t location "" 
    9494#if __GLASGOW_HASKELL__ > 411 
    95                          maybe_filename 
     95                         maybe_filename 
    9696#endif 
    97                 ) 
     97                ) 
    9898eofErrorType = EOF 
    9999 
    … …  
    112112type BinArray = IOUArray Int Word8 
    113113--------------------------------------------------------------- 
    114 --              BinHandle 
     114--              BinHandle 
    115115--------------------------------------------------------------- 
    116116 
    117117data BinHandle 
    118   = BinMem {            -- binary data stored in an unboxed array 
    119      off_r :: !FastMutInt,              -- the current offset 
    120      sz_r  :: !FastMutInt,              -- size of the array (cached) 
    121      arr_r :: !(IORef BinArray)         -- the array (bounds: (0,size-1)) 
     118  = BinMem {            -- binary data stored in an unboxed array 
     119     off_r :: !FastMutInt,              -- the current offset 
     120     sz_r  :: !FastMutInt,              -- size of the array (cached) 
     121     arr_r :: !(IORef BinArray)         -- the array (bounds: (0,size-1)) 
    122122    } 
    123         -- XXX: should really store a "high water mark" for dumping out 
    124         -- the binary data to a file. 
    125  
    126   | BinIO {             -- binary data stored in a file 
    127      off_r :: !FastMutInt,              -- the current offset (cached) 
    128      hdl   :: !IO.Handle                -- the file handle (must be seekable) 
     123        -- XXX: should really store a "high water mark" for dumping out 
     124        -- the binary data to a file. 
     125 
     126  | BinIO {             -- binary data stored in a file 
     127     off_r :: !FastMutInt,              -- the current offset (cached) 
     128     hdl   :: !IO.Handle                -- the file handle (must be seekable) 
    129129   } 
    130         -- cache the file ptr in BinIO; using hTell is too expensive 
    131         -- to call repeatedly.  If anyone else is modifying this Handle 
    132         -- at the same time, we'll be screwed. 
     130        -- cache the file ptr in BinIO; using hTell is too expensive 
     131        -- to call repeatedly.  If anyone else is modifying this Handle 
     132        -- at the same time, we'll be screwed. 
    133133 
    134134--getUserData :: BinHandle -> UserData 
    … …  
    140140 
    141141--------------------------------------------------------------- 
    142 --              Bin 
     142--              Bin 
    143143--------------------------------------------------------------- 
    144144 
    … …  
    150150 
    151151--------------------------------------------------------------- 
    152 --              class Binary 
     152--              class Binary 
    153153--------------------------------------------------------------- 
    154154 
    … …  
    202202  sz <- readFastMutInt sz_r 
    203203  if (p >= sz) 
    204         then do expandBin h p; writeFastMutInt ix_r p 
    205         else writeFastMutInt ix_r p 
     204        then do expandBin h p; writeFastMutInt ix_r p 
     205        else writeFastMutInt ix_r p 
    206206 
    207207isEOFBin :: BinHandle -> IO Bool 
    … …  
    251251   return () 
    252252expandBin (BinIO  _ _) _ = return () 
    253         -- no need to expand a file, we'll assume they expand by themselves. 
     253        -- no need to expand a file, we'll assume they expand by themselves. 
    254254 
    255255-- ----------------------------------------------------------------------------- 
    … …  
    260260    ix <- readFastMutInt ix_r 
    261261    sz <- readFastMutInt sz_r 
    262         -- double the size of the array if it overflows 
     262        -- double the size of the array if it overflows 
    263263    if (ix >= sz)  
    264264        then do  
    … …  
    273273putWord8 (BinIO  ix_r h) w = do 
    274274    ix <- readFastMutInt ix_r 
    275     hPutChar h (chr (fromIntegral w))   -- XXX not really correct 
     275    hPutChar h (chr (fromIntegral w))   -- XXX not really correct 
    276276    writeFastMutInt ix_r (ix+1) 
    277277    return () 
    … …  
    282282    sz <- readFastMutInt sz_r 
    283283    when (ix >= sz)  $ 
    284         ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) 
     284        ioError (mkIOError eofErrorType "Data.Binary.getWord8" Nothing Nothing) 
    285285    arr <- readIORef arr_r 
    286286    w <- unsafeRead arr ix 
    … …  
    291291    c <- hGetChar h 
    292292    writeFastMutInt ix_r (ix+1) 
    293     return $! (fromIntegral (ord c))    -- XXX not really correct 
     293    return $! (fromIntegral (ord c))    -- XXX not really correct 
    294294 
    295295{-# INLINE putByte #-} 
    … …  
    330330    w4 <- getWord8 h 
    331331    return $! ((fromIntegral w1 `shiftL` 24) .|.  
    332                (fromIntegral w2 `shiftL` 16) .|.  
    333                (fromIntegral w3 `shiftL`  8) .|.  
    334                (fromIntegral w4)) 
     332               (fromIntegral w2 `shiftL` 16) .|.  
     333               (fromIntegral w3 `shiftL`  8) .|.  
     334               (fromIntegral w4)) 
    335335 
    336336 
    … …  
    355355    w8 <- getWord8 h 
    356356    return $! ((fromIntegral w1 `shiftL` 56) .|.  
    357                (fromIntegral w2 `shiftL` 48) .|.  
    358                (fromIntegral w3 `shiftL` 40) .|.  
    359                (fromIntegral w4 `shiftL` 32) .|.  
    360                (fromIntegral w5 `shiftL` 24) .|.  
    361                (fromIntegral w6 `shiftL` 16) .|.  
    362                (fromIntegral w7 `shiftL`  8) .|.  
    363                (fromIntegral w8)) 
     357               (fromIntegral w2 `shiftL` 48) .|.  
     358               (fromIntegral w3 `shiftL` 40) .|.  
     359               (fromIntegral w4 `shiftL` 32) .|.  
     360               (fromIntegral w5 `shiftL` 24) .|.  
     361               (fromIntegral w6 `shiftL` 16) .|.  
     362               (fromIntegral w7 `shiftL`  8) .|.  
     363               (fromIntegral w8)) 
    364364 
    365365-- ----------------------------------------------------------------------------- 
    … …  
    404404    put_ bh i = put_ bh (fromIntegral i :: Int32) 
    405405    get  bh = do 
    406         x <- get bh 
    407         return $! (fromIntegral (x :: Int32)) 
     406        x <- get bh 
     407        return $! (fromIntegral (x :: Int32)) 
    408408--  #elif SIZEOF_HSINT == 8 
    409409--    put_ bh i = put_ bh (fromIntegral i :: Int64) 
    410410--    get  bh = do 
    411 --      x <- get bh 
    412 --      return $! (fromIntegral (x :: Int64)) 
     411--      x <- get bh 
     412--      return $! (fromIntegral (x :: Int64)) 
    413413--  #else 
    414414--  #error "unsupported sizeof(HsInt)" 
    … …  
    417417instance Binary ClockTime where 
    418418    put_ bh ct = do 
    419         let t = toUTCTime ct 
    420         put_ bh (ctYear t) 
    421         put_ bh (fromEnum $ ctMonth t) 
    422         put_ bh (ctDay t) 
    423         put_ bh (ctHour t) 
    424         put_ bh (ctMin t) 
    425         put_ bh (ctSec t) 
     419        let t = toUTCTime ct 
     420        put_ bh (ctYear t) 
     421        put_ bh (fromEnum $ ctMonth t) 
     422        put_ bh (ctDay t) 
     423        put_ bh (ctHour t) 
     424        put_ bh (ctMin t) 
     425        put_ bh (ctSec t) 
    426426    get bh = do 
    427         year <- get bh 
    428         month <- fmap toEnum $ get bh  
    429         day <- get bh  
    430         hour <- get bh  
    431         min <- get bh  
    432         sec <- get bh  
    433         return $ toClockTime $ (toUTCTime epoch) {ctYear = year, ctDay = day, ctMonth = month, ctHour = hour, ctMin = min, ctSec = sec} 
     427        year <- get bh 
     428        month <- fmap toEnum $ get bh  
     429        day <- get bh  
     430        hour <- get bh  
     431        min <- get bh  
     432        sec <- get bh  
     433        return $ toClockTime $ (toUTCTime epoch) {ctYear = year, ctDay = day, ctMonth = month, ctHour = hour, ctMin = min, ctSec = sec} 
    434434epoch = toClockTime $ CalendarTime { ctYear = 1970, ctMonth = January, ctDay = 0, ctHour = 0, ctMin = 0, ctSec = 0, ctTZ = 0, ctPicosec = 0, ctWDay = undefined, ctYDay = undefined, ctTZName = undefined, ctIsDST = undefined} 
    435435 
    … …  
    564564    put_ bh (S# i#) = do putByte bh 0; put_ bh (I# i#) 
    565565    put_ bh (J# s# a#) = do 
    566         p <- putByte bh 1; 
    567         put_ bh (I# s#) 
    568         let sz# = sizeofByteArray# a#  -- in *bytes* 
    569         put_ bh (I# sz#)  -- in *bytes* 
    570         putByteArray bh a# sz# 
     566        p <- putByte bh 1; 
     567        put_ bh (I# s#) 
     568        let sz# = sizeofByteArray# a#  -- in *bytes* 
     569        put_ bh (I# sz#)  -- in *bytes* 
     570        putByteArray bh a# sz# 
    571571    
    572572    get bh = do  
    573         b <- getByte bh 
    574         case b of 
    575           0 -> do (I# i#) <- get bh 
    576                   return (S# i#) 
    577           _ -> do (I# s#) <- get bh 
    578                   sz <- get bh 
    579                   (BA a#) <- getByteArray bh sz 
    580                   return (J# s# a#) 
     573        b <- getByte bh 
     574        case b of 
     575          0 -> do (I# i#) <- get bh 
     576                  return (S# i#) 
     577          _ -> do (I# s#) <- get bh 
     578                  sz <- get bh 
     579                  (BA a#) <- getByteArray bh sz 
     580                  return (J# s# a#) 
    581581 
    582582putByteArray :: BinHandle -> ByteArray# -> Int# -> IO () 
    583583putByteArray bh a s# = loop 0# 
    584584  where loop n#  
    585            | n# ==# s# = return () 
    586            | otherwise = do 
    587                 putByte bh (indexByteArray a n#) 
    588                 loop (n# +# 1#) 
     585           | n# ==# s# = return () 
     586           | otherwise = do 
     587                putByte bh (indexByteArray a n#) 
     588                loop (n# +# 1#) 
    589589 
    590590getByteArray :: BinHandle -> Int -> IO ByteArray 
    … …  
    592592  (MBA arr) <- newByteArray sz  
    593593  let loop n 
    594            | n ==# sz = return () 
    595            | otherwise = do 
    596                 w <- getByte bh  
    597                 writeByteArray arr n w 
    598                 loop (n +# 1#) 
     594           | n ==# sz = return () 
     595           | otherwise = do 
     596                w <- getByte bh  
     597                writeByteArray arr n w 
     598                loop (n +# 1#) 
    599599  loop 0# 
    600600  freezeByteArray arr 
    … …  
    636636lazyPut :: Binary a => BinHandle -> a -> IO () 
    637637lazyPut bh a = do 
    638         -- output the obj with a ptr to skip over it: 
     638        -- output the obj with a ptr to skip over it: 
    639639    pre_a <- tellBin bh 
    640     put_ bh pre_a       -- save a slot for the ptr 
    641     put_ bh a           -- dump the object 
    642     q <- tellBin bh     -- q = ptr to after object 
    643     putAt bh pre_a q    -- fill in slot before a with ptr to q 
    644     seekBin bh q        -- finally carry on writing at q 
     640    put_ bh pre_a       -- save a slot for the ptr 
     641    put_ bh a           -- dump the object 
     642    q <- tellBin bh     -- q = ptr to after object 
     643    putAt bh pre_a q    -- fill in slot before a with ptr to q 
     644    seekBin bh q        -- finally carry on writing at q 
    645645 
    646646lazyGet :: Binary a => BinHandle -> IO a 
    647647lazyGet bh = do 
    648     p <- get bh         -- a BinPtr 
     648    p <- get bh         -- a BinPtr 
    649649    p_a <- tellBin bh 
    650650    a <- unsafeInterleaveIO (getAt bh p_a) 
    … …  
    655655{- 
    656656--------------------------------------------------------- 
    657 --              Reading and writing FastStrings 
     657--              Reading and writing FastStrings 
    658658--------------------------------------------------------- 
    659659 
    … …  
    662662  putByteArray bh ba l 
    663663putFS bh s = error ("Binary.put_(FastString): " ++ unpackFS s) 
    664         -- Note: the length of the FastString is *not* the same as 
    665         -- the size of the ByteArray: the latter is rounded up to a 
    666         -- multiple of the word size. 
     664        -- Note: the length of the FastString is *not* the same as 
     665        -- the size of the ByteArray: the latter is rounded up to a 
     666        -- multiple of the word size. 
    667667   
    668668{- -- possible faster version, not quite there yet: 
    … …  
    682682  put_ bh f@(FastString id l ba) = 
    683683    case getUserData bh of {  
    684         UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do 
     684        UserData { ud_next = j_r, ud_map = out_r, ud_dict = dict} -> do 
    685685    out <- readIORef out_r 
    686686    let uniq = getUnique f 
    687687    case lookupUFM out uniq of 
    688         Just (j,f)  -> put_ bh j 
    689         Nothing -> do 
    690            j <- readIORef j_r 
    691            put_ bh j 
    692            writeIORef j_r (j+1) 
    693            writeIORef out_r (addToUFM out uniq (j,f)) 
     688        Just (j,f)  -> put_ bh j 
     689        Nothing -> do 
     690           j <- readIORef j_r 
     691           put_ bh j 
     692           writeIORef j_r (j+1) 
     693           writeIORef out_r (addToUFM out uniq (j,f)) 
    694694    } 
    695695  put_ bh s = error ("Binary.put_(FastString): " ++ show (unpackFS s)) 
    696696 
    697697  get bh = do  
    698         j <- get bh 
    699         return $! (ud_dict (getUserData bh) ! j) 
     698        j <- get bh 
     699        return $! (ud_dict (getUserData bh) ! j) 
    700700-} 
    701701-}