From cff378736b303a602b289e74a113891f6f023810 Mon Sep 17 00:00:00 2001 From: sof Date: Fri, 14 Aug 1998 13:03:51 +0000 Subject: [PATCH] [project @ 1998-08-14 13:03:51 by sof] Removed old file I/O junk; bugfixes --- ghc/lib/misc/PackedString.lhs | 156 ++++------------------------------------- 1 file changed, 14 insertions(+), 142 deletions(-) diff --git a/ghc/lib/misc/PackedString.lhs b/ghc/lib/misc/PackedString.lhs index 2334b2f..b733435 100644 --- a/ghc/lib/misc/PackedString.lhs +++ b/ghc/lib/misc/PackedString.lhs @@ -29,11 +29,8 @@ module PackedString ( unpackNBytesPS, -- :: PackedString -> Int -> [Char] unpackPSIO, -- :: PackedString -> IO [Char] -{-LATER: hPutPS, -- :: Handle -> PackedString -> IO () - putPS, -- :: FILE -> PackedString -> PrimIO () -- ToDo: more sensible type - getPS, -- :: FILE -> Int -> PrimIO PackedString --} + nilPS, -- :: PackedString consPS, -- :: Char -> PackedString -> PackedString headPS, -- :: PackedString -> Char @@ -92,6 +89,7 @@ import PrelArr ( StateAndMutableByteArray#(..) , StateAndByteArray#(..) ) import PrelST import ST import IOExts ( unsafePerformIO ) +import IO import Ix import Char (isSpace) @@ -368,6 +366,7 @@ unpackPS (CPS addr len) unpackNBytesPS :: PackedString -> Int -> [Char] unpackNBytesPS ps len@(I# l#) | len < 0 = error ("PackedString.unpackNBytesPS: negative length "++ show len) + | len == 0 = [] | otherwise = case ps of PS bytes len# has_null -> unpackPS (PS bytes (min# len# l#) has_null) @@ -395,139 +394,18 @@ unpackPSIO (CPS addr len) Output a packed string via a handle: \begin{code} -{- LATER: hPutPS :: Handle -> PackedString -> IO () -hPutPS handle ps = - let - len = - case ps of - PS _ len _ -> len - CPS _ len -> len - in - if len ==# 0# then - return () - else - _readHandle handle >>= \ htype -> - case htype of - _ErrorHandle ioError -> - _writeHandle handle htype >> - failWith ioError - _ClosedHandle -> - _writeHandle handle htype >> - failWith (IllegalOperation "handle is closed") - _SemiClosedHandle _ _ -> - _writeHandle handle htype >> - failWith (IllegalOperation "handle is closed") - _ReadHandle _ _ _ -> - _writeHandle handle htype >> - failWith (IllegalOperation "handle is not open for writing") - other -> - _getBufferMode other >>= \ other -> - (case _bufferMode other of - Just LineBuffering -> - writeLines (_filePtr other) - Just (BlockBuffering (Just size)) -> - writeBlocks (_filePtr other) size - Just (BlockBuffering Nothing) -> - writeBlocks (_filePtr other) ``BUFSIZ'' - _ -> -- Nothing is treated pessimistically as NoBuffering - writeChars (_filePtr other) 0# - ) >>= \ success -> - _writeHandle handle (_markHandle other) >> - if success then - return () - else - _constructError "hPutStr" >>= \ ioError -> - failWith ioError - +hPutPS handle (CPS a# len#) = hPutBuf handle (A# a#) (I# len#) +hPutPS handle (PS ba# len# _) = hPutBufBA handle (ByteArray bottom ba#) (I# len#) where - 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 () + bottom = error "hPutPS" \end{code} The dual to @_putPS@, note that the size of the chunk specified is the upper bound of the size of the chunk returned. \begin{code} +{- getPS :: _FILE -> Int -> IO PackedString getPS file len@(I# len#) | len# <=# 0# = return nilPS -- I'm being kind here. @@ -629,19 +507,12 @@ nullPS :: PackedString -> Bool nullPS (PS _ i _) = i ==# 0# nullPS (CPS _ i) = i ==# 0# -{- (ToDo: some non-lousy implementations...) - - Old : _appendPS xs ys = packString (unpackPS xs ++ unpackPS ys) - --} appendPS :: PackedString -> PackedString -> PackedString appendPS xs ys | nullPS xs = ys | nullPS ys = xs | otherwise = concatPS [xs,ys] -{- OLD: mapPS f xs = packString (map f (unpackPS xs)) -} - mapPS :: (Char -> Char) -> PackedString -> PackedString {-or String?-} mapPS f xs = if nullPS xs then @@ -1114,14 +985,15 @@ unpackCStringIO addr unpackCStringLenIO :: Addr -> Int -> IO String unpackCStringLenIO addr l@(I# len#) | len# <# 0# = fail (userError ("PackedString.unpackCStringLenIO: negative length (" ++ show l ++ ")")) - | otherwise = unpack len# + | len# ==# 0# = return "" + | otherwise = unpack [] (len# -# 1#) where - unpack 0# = return [] - unpack nh = do + unpack acc 0# = do + ch <- readCharOffAddr addr (I# 0#) + return (ch:acc) + unpack acc nh = do ch <- readCharOffAddr addr (I# nh) - ls <- unpack (nh -# 1#) - return (ch : ls) - + unpack (ch:acc) (nh -# 1#) unpackCString2# addr len -- This one is called by the compiler to unpack literal strings with NULs in them; rare. -- 1.7.10.4