[project @ 2000-10-30 09:52:14 by simonpj]

[ghc-hetmet.git] / ghc / compiler / utils / StringBuffer.lhs

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 115d36c..84bfeb3 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -37,6 +37,7 @@ module StringBuffer
         stepOnBy#,        -- :: StringBuffer -> Int# -> StringBuffer
         stepOnTo#,        -- :: StringBuffer -> Int# -> StringBuffer
         stepOnUntil,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
+       stepOnUntilChar#, -- :: StringBuffer -> Char# -> StringBuffer
         stepOverLexeme,   -- :: StringBuffer   -> StringBuffer
        scanNumLit,       -- :: Int -> StringBuffer -> (Int, StringBuffer)
        squeezeLexeme,    -- :: StringBuffer -> Int# -> StringBuffer
@@ -51,7 +52,6 @@ module StringBuffer
         -- matching
         prefixMatch,       -- :: StringBuffer -> String -> Bool
        untilEndOfString#, -- :: StringBuffer -> Int#
-       untilChar#,        -- :: StringBuffer -> Char# -> Int#
 
          -- conversion
         lexemeToString,     -- :: StringBuffer -> String
@@ -66,7 +66,7 @@ module StringBuffer
 #include "HsVersions.h"
 
 import GlaExts
-import Addr            ( Addr(..) )
+import PrelAddr        ( Addr(..) )
 import Foreign
 import ST
 import Char            ( chr )
@@ -75,7 +75,11 @@ import Char          ( chr )
 #include "../lib/std/cbits/stgerror.h"
 
 #if __GLASGOW_HASKELL__ >= 303
-import IO              ( openFile, slurpFile )
+import IO              ( openFile
+#if __GLASGOW_HASKELL__ < 407
+                        , slurpFile   -- comes from PrelHandle or IOExts now
+#endif
+                        )
 import PrelIOBase
 import PrelHandle
 import Addr
@@ -119,7 +123,7 @@ data StringBuffer
 \end{code}
 
 \begin{code}
-instance Text StringBuffer where
+instance Show StringBuffer where
        showsPrec _ s = showString ""
 \end{code}
 
@@ -289,13 +293,12 @@ reAllocMem ptr sz = do
 
 allocMem :: Int -> IO Addr
 allocMem sz = do
-#if __GLASGOW_HASKELL__ < 303
    chunk <- _ccall_ malloc sz
+#if __GLASGOW_HASKELL__ < 303
    if chunk == nullAddr 
       then fail (userError "allocMem")
       else return chunk
 #else
-   chunk <- _ccall_ allocMemory__ sz
    if chunk == nullAddr 
       then constructErrorAndFail "allocMem"
       else return chunk
@@ -415,16 +418,16 @@ scanNumLit acc (StringBuffer fo l# s# c#) =
          | otherwise        -> (acc,StringBuffer fo l# s# c#)
 
 
-expandUntilMatch :: StringBuffer -> String -> StringBuffer
+expandUntilMatch :: StringBuffer -> String -> Maybe StringBuffer
 expandUntilMatch (StringBuffer fo l# s# c#) str =
   loop c# str
   where
-   loop c# [] = StringBuffer fo l# s# c#
-   loop c# ((C# x#):xs)
-      | indexCharOffAddr# fo c# `eqChar#` x#
-      = loop (c# +# 1#) xs
-      | otherwise 
-      = loop (c# +# 1#) str
+   loop c# [] = Just (StringBuffer fo l# s# c#)
+   loop c# ((C# x#):xs) =
+    case indexCharOffAddr# fo c# of
+      ch# | ch# `eqChar#` '\NUL'# && c# >=# l# -> Nothing
+         | ch# `eqChar#` x# -> loop (c# +# 1#) xs
+          | otherwise        -> loop (c# +# 1#) str
        
 \end{code}
 
@@ -482,13 +485,13 @@ untilEndOfString# (StringBuffer fo l# s# c#) =
     _ -> loop (c# +# 1#)
 
 
-untilChar# :: StringBuffer -> Char# -> StringBuffer
-untilChar# (StringBuffer fo l# s# c#) x# = 
+stepOnUntilChar# :: StringBuffer -> Char# -> StringBuffer
+stepOnUntilChar# (StringBuffer fo l# s# c#) x# = 
  loop c# 
  where
   loop c#
    | c# >=# l# || indexCharOffAddr# fo c# `eqChar#` x#
-   = StringBuffer fo l# s# c#
+   = StringBuffer fo l# c# c#
    | otherwise
    = loop (c# +# 1#)
 
@@ -500,7 +503,7 @@ lexemeToString (StringBuffer fo _ start_pos# current#) =
  else
     unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
     
-lexemeToByteArray :: StringBuffer -> _ByteArray Int
+lexemeToByteArray :: StringBuffer -> ByteArray Int
 lexemeToByteArray (StringBuffer fo _ start_pos# current#) = 
  if start_pos# ==# current# then
     error "lexemeToByteArray"