- pslen = lengthPS# ps
-
- writeLines :: Addr -> IO Bool
- writeLines = writeChunks ``BUFSIZ'' True
-
- writeBlocks :: Addr -> Int -> IO Bool
- writeBlocks fp size = writeChunks size False fp
-
- {-
- The breaking up of output into lines along \n boundaries
- works fine as long as there are newlines to split by.
- Avoid the splitting up into lines altogether (doesn't work
- for overly long lines like the stuff that showsPrec instances
- normally return). Instead, we split them up into fixed size
- chunks before blasting them off to the Real World.
-
- Hacked to avoid multiple passes over the strings - unsightly, but
- a whole lot quicker. -- SOF 3/96
- -}
-
- writeChunks :: Int -> Bool -> Addr -> IO Bool
- writeChunks (I# bufLen) chopOnNewLine fp =
- newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
- let
- shoveString :: Int# -> Int# -> IO Bool
- shoveString n i
- | i ==# pslen = -- end of string
- if n ==# 0# then
- return True
- else
- _ccall_ writeFile arr fp (I# n) >>= \rc ->
- return (rc==0)
- | otherwise =
- (\ (S# s#) ->
- case writeCharArray# arr# n (indexPS# ps i) s# of
- s1# ->
- {- Flushing lines - should we bother? -}
- (if n ==# bufLen then
- _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \rc ->
- if rc == 0 then
- shoveString 0# (i +# 1#)
- else
- return False
- else
- shoveString (n +# 1#) (i +# 1#)) (S# s1#))
- in
- shoveString 0# 0#
-
- writeChars :: Addr -> Int# -> IO Bool
- writeChars fp i
- | i ==# pslen = return True
- | otherwise =
- _ccall_ filePutc fp (ord (C# (indexPS# ps i))) >>= \ rc ->
- if rc == 0 then
- writeChars fp (i +# 1#)
- else
- return False
-
----------------------------------------------
-
-putPS :: _FILE -> PackedString -> IO ()
-putPS file ps@(PS bytes len has_null)
- | len ==# 0#
- = return ()
- | otherwise
- = let
- byte_array = ByteArray (0, I# (len -# 1#)) bytes
- in
- _ccall_ fwrite byte_array (1::Int){-size-} (I# len) file
- >>= \ (I# written) ->
- if written ==# len then
- return ()
- else
- error "putPS: fwrite failed!\n"
-
-putPS file (CPS addr len)
- | len ==# 0#
- = return ()
- | otherwise
- = _ccall_ fputs (A# addr) file >>= \ (I# _){-force type-} ->
- return ()