summaryrefslogtreecommitdiff
path: root/compiler/utils/BufWrite.hs
diff options
context:
space:
mode:
authorAustin Seipp <austin@well-typed.com>2014-08-20 03:33:02 -0500
committerAustin Seipp <austin@well-typed.com>2014-08-20 03:47:35 -0500
commitfb9bc40af7ced7ede22e91f12b66dc8035f94ff5 (patch)
tree3ddeaa5a0bc0225ec4121adcc85a2cd209f01f30 /compiler/utils/BufWrite.hs
parent96c3599375d040b914d433cda97d532ff0aae3bc (diff)
downloadhaskell-fb9bc40af7ced7ede22e91f12b66dc8035f94ff5.tar.gz
utils: detabify/dewhitespace BufWrite
Signed-off-by: Austin Seipp <austin@well-typed.com>
Diffstat (limited to 'compiler/utils/BufWrite.hs')
-rw-r--r--compiler/utils/BufWrite.hs77
1 files changed, 35 insertions, 42 deletions
diff --git a/compiler/utils/BufWrite.hs b/compiler/utils/BufWrite.hs
index 7eba0753fe..482e9eee42 100644
--- a/compiler/utils/BufWrite.hs
+++ b/compiler/utils/BufWrite.hs
@@ -12,22 +12,15 @@
--
-----------------------------------------------------------------------------
-{-# OPTIONS_GHC -fno-warn-tabs #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and
--- detab the module (please do the detabbing in a separate patch). See
--- http://ghc.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
--- for details
-
module BufWrite (
- BufHandle(..),
- newBufHandle,
- bPutChar,
- bPutStr,
- bPutFS,
- bPutFZS,
- bPutLitString,
- bFlush,
+ BufHandle(..),
+ newBufHandle,
+ bPutChar,
+ bPutStr,
+ bPutFS,
+ bPutFZS,
+ bPutLitString,
+ bFlush,
) where
#include "HsVersions.h"
@@ -36,10 +29,10 @@ import FastString
import FastTypes
import FastMutInt
-import Control.Monad ( when )
+import Control.Monad ( when )
import Data.ByteString (ByteString)
import qualified Data.ByteString.Unsafe as BS
-import Data.Char ( ord )
+import Data.Char ( ord )
import Foreign
import Foreign.C.String
import System.IO
@@ -47,8 +40,8 @@ import System.IO
-- -----------------------------------------------------------------------------
data BufHandle = BufHandle {-#UNPACK#-}!(Ptr Word8)
- {-#UNPACK#-}!FastMutInt
- Handle
+ {-#UNPACK#-}!FastMutInt
+ Handle
newBufHandle :: Handle -> IO BufHandle
newBufHandle hdl = do
@@ -68,11 +61,11 @@ STRICT2(bPutChar)
bPutChar b@(BufHandle buf r hdl) c = do
i <- readFastMutInt r
if (i >= buf_size)
- then do hPutBuf hdl buf buf_size
- writeFastMutInt r 0
- bPutChar b c
- else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)
- writeFastMutInt r (i+1)
+ then do hPutBuf hdl buf buf_size
+ writeFastMutInt r 0
+ bPutChar b c
+ else do pokeElemOff buf i (fromIntegral (ord c) :: Word8)
+ writeFastMutInt r (i+1)
bPutStr :: BufHandle -> String -> IO ()
STRICT2(bPutStr)
@@ -80,15 +73,15 @@ bPutStr (BufHandle buf r hdl) str = do
i <- readFastMutInt r
loop str i
where loop _ i | i `seq` False = undefined
- loop "" i = do writeFastMutInt r i; return ()
- loop (c:cs) i
- | i >= buf_size = do
- hPutBuf hdl buf buf_size
- loop (c:cs) 0
- | otherwise = do
- pokeElemOff buf i (fromIntegral (ord c))
- loop cs (i+1)
-
+ loop "" i = do writeFastMutInt r i; return ()
+ loop (c:cs) i
+ | i >= buf_size = do
+ hPutBuf hdl buf buf_size
+ loop (c:cs) 0
+ | otherwise = do
+ pokeElemOff buf i (fromIntegral (ord c))
+ loop cs (i+1)
+
bPutFS :: BufHandle -> FastString -> IO ()
bPutFS b fs = bPutBS b $ fastStringToByteString fs
@@ -116,14 +109,14 @@ bPutLitString b@(BufHandle buf r hdl) a len_ = a `seq` do
let len = iBox len_
i <- readFastMutInt r
if (i+len) >= buf_size
- then do hPutBuf hdl buf i
- writeFastMutInt r 0
- if (len >= buf_size)
- then hPutBuf hdl a len
- else bPutLitString b a len_
- else do
- copyBytes (buf `plusPtr` i) a len
- writeFastMutInt r (i+len)
+ then do hPutBuf hdl buf i
+ writeFastMutInt r 0
+ if (len >= buf_size)
+ then hPutBuf hdl a len
+ else bPutLitString b a len_
+ else do
+ copyBytes (buf `plusPtr` i) a len
+ writeFastMutInt r (i+len)
bFlush :: BufHandle -> IO ()
bFlush (BufHandle buf r hdl) = do
@@ -133,7 +126,7 @@ bFlush (BufHandle buf r hdl) = do
return ()
#if 0
-myPutBuf s hdl buf i =
+myPutBuf s hdl buf i =
modifyIOError (\e -> ioeSetErrorString e (ioeGetErrorString e ++ ':':s ++ " (" ++ show buf ++ "," ++ show i ++ ")")) $
hPutBuf hdl buf i