Changeset 6793

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.

Location:
src
Files:
33 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-} 
  • src/Main.hs

    r5815 r6793  
    249249        env <- liftSTM $ readTVar menv 
    250250        return $ envBody $ parseProgram env "<interactive>" $ 
    251           (decodeUTF8 prog) 
     251          (decodeUTF8 prog) 
    252252    theEnv = do 
    253253        ref <- if runOptSeparately opts 
     
    327327 
    328328printConfigInfo (item:_) = do 
    329         putStrLn $ createConfigLine item 
     329        putStrLn $ createConfigLine item 
    330330 
    331331compPIR :: String -> IO () 
  • src/Pugs/AST/Internals.hs

    r6672 r6793  
    702702instance Show VJunc where 
    703703    show (MkJunc jtype _ set) = 
    704         (show jtype) ++ "(" ++ 
    705             (foldl (\x y -> 
    706                 if x == "" then show y 
    707                 else x ++ "," ++ show y) 
    708             "" $ Set.elems set) ++ ")" 
     704        (show jtype) ++ "(" ++ 
     705            (foldl (\x y -> 
     706                if x == "" then show y 
     707                else x ++ "," ++ show y) 
     708            "" $ Set.elems set) ++ ")" 
    709709 
    710710{-| 
     
    10991099 
    11001100lookupPad key (MkPad map) = case Map.lookup (possiblyFixOperatorName key) map of 
    1101         Just xs -> Just [tvar | (_, tvar) <- xs] 
    1102         Nothing -> Nothing 
     1101        Just xs -> Just [tvar | (_, tvar) <- xs] 
     1102        Nothing -> Nothing 
    11031103 
    11041104{-| 
     
    16541654        , rxGlobal    :: !Bool  -- ^ Flag indicating \'global\' (match-all) 
    16551655        , rxNumSubs   :: !Int   -- ^ The number of subpatterns present. 
    1656             , rxStringify :: !Bool 
     1656            , rxStringify :: !Bool 
    16571657        , rxRuleStr   :: !String -- ^ The rule string, for user reference. 
    16581658        , rxAdverbs   :: !Val 
     
    16621662        { rxRule      :: !String -- ^ The rule string 
    16631663        , rxGlobal    :: !Bool   -- ^ Flag indicating \'global\' (match-all) 
    1664             , rxStringify :: !Bool 
     1664            , rxStringify :: !Bool 
    16651665        , rxAdverbs   :: !Val 
    16661666        } 
  • src/Pugs/Class.hs

    r5892 r6793  
    170170  Package := MetaClass where clsName = "Package" 
    171171  Package.clsProperties = 
    172         { pkgName = MetaProperty { type = Symbol }  
    173         , pkgIsGlobal = MetaProperty { type = Bool  } 
    174         , pkgStash = MetaProperty { type = Map (sigil, Symbol) Object } 
    175         } 
     172        { pkgName = MetaProperty { type = Symbol }  
     173        , pkgIsGlobal = MetaProperty { type = Bool  } 
     174        , pkgStash = MetaProperty { type = Map (sigil, Symbol) Object } 
     175        } 
    176176 
    177177  -- Package->has_many("pkgChildren" => Package) 
    178178  -- Package->maybe_has_one("pkgParent" => Package) 
    179179  Package.clsCats = 
    180         { pkgChildren =  
     180        { pkgChildren =  
    181181              (Public, MetaAssoc 
    182182                { catIsComposite = true, 
     
    188188                  }, 
    189189                }) 
    190         } 
     190        } 
    191191 
    192192{- 
     
    207207  Module := MetaClass where clsName = "Module" 
    208208  Module.clsProperties = 
    209         { modVersion = MetaProperty { type = Version } 
    210         , modAuthorizer = MetaProperty { type = String } 
    211         } 
     209        { modVersion = MetaProperty { type = Version } 
     210        , modAuthorizer = MetaProperty { type = String } 
     211        } 
    212212 
    213213  Module.clsMethods = 
    214         { modName = MetaMethod 
    215               { methodInvoke = ( self.pkgName 
     214        { modName = MetaMethod 
     215              { methodInvoke = ( self.pkgName 
    216216                               ~ "-" ~ self.modVersion 
    217                                ~ "-" ~ self.modAuthorizer ) } 
    218         } 
     217                               ~ "-" ~ self.modAuthorizer ) } 
     218        } 
    219219 
    220220  Module.clsAssocs = 
    221         { modTraits = (Public, MetaAssoc 
     221        { modTraits = (Public, MetaAssoc 
    222222                      { catIsComposite = true, 
    223223                        catRange = (Zero, Many), 
     
    228228                                       catRange = (One, One) } ), 
    229229                      }) 
    230         } 
     230        } 
    231231   
    232232  Class := MetaClass where clsName = "Class" 
  • src/Pugs/Cont/CC_2CPST.hs

    r2786 r6793  
    3535instance MonadTrans (CC r) where 
    3636    lift m = CC (\ (Cont k) ->  
    37                 MC (\mk -> lift (m >>= (\a -> let MC mc = k a 
    38                                                in PromptTR.runP (mc mk))))) 
     37                MC (\mk -> lift (m >>= (\a -> let MC mc = k a 
     38                                               in PromptTR.runP (mc mk))))) 
    3939 
    4040instance (MonadIO m) => MonadIO (CC r m) where 
     
    7676     
    7777letSubCont :: Monad m =>  
    78               Prompt r b -> (SubCont r m a b -> CC r m b) -> CC r m a 
     78              Prompt r b -> (SubCont r m a b -> CC r m b) -> CC r m a 
    7979letSubCont p f =  
    8080    CC (\k -> MC (\mk ->  
  • src/Pugs/Embed/Parrot.hsc

    r6248 r6793  
    6161        let nameStr = escape name 
    6262            ruleStr = escape rule 
    63         hPutStrLn inp $ unwords 
     63        hPutStrLn inp $ unwords 
    6464            ["add_rule", show (length nameStr), show (length ruleStr)] 
    65         hPutStrLn inp nameStr 
    66         hPutStrLn inp ruleStr 
     65        hPutStrLn inp nameStr 
     66        hPutStrLn inp ruleStr 
    6767    let matchStr = escape match 
    6868        ruleStr  = escape rule 
     
    7474    rv <- hGetLine out 
    7575    case rv of 
    76         ('O':'K':' ':sizeStr) -> do 
    77             size <- readIO sizeStr 
    78             rv  <- sequence (replicate size (hGetChar out)) 
    79             ln  <- hGetLine out 
    80             return $ rv ++ ln 
    81         _ -> do 
    82             errMsg  <- hGetContents err 
    83             rv      <- waitForProcess pid 
    84             writeIORef _ParrotInterp Nothing 
    85             let msg | null errMsg = show rv 
    86                     | otherwise   = errMsg 
    87             fail $ "*** Running external 'parrot' failed:\n" ++ msg 
     76        ('O':'K':' ':sizeStr) -> do 
     77            size <- readIO sizeStr 
     78            rv  <- sequence (replicate size (hGetChar out)) 
     79            ln  <- hGetLine out 
     80            return $ rv ++ ln 
     81        _ -> do 
     82            errMsg  <- hGetContents err 
     83            rv      <- waitForProcess pid 
     84            writeIORef _ParrotInterp Nothing 
     85            let msg | null errMsg = show rv 
     86                    | otherwise   = errMsg 
     87            fail $ "*** Running external 'parrot' failed:\n" ++ msg 
    8888    where 
    8989    escape "" = ""