[project @ 2001-05-03 12:33:50 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..8f79d2b 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -6,13 +6,15 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
-{-# OPTIONS -fno-prune-tydecls #-}
+
 module StringBuffer
        (
         StringBuffer,
 
-        -- creation
-        hGetStringBuffer,  -- :: FilePath       -> IO StringBuffer
+        -- creation/destruction
+        hGetStringBuffer,     -- :: FilePath     -> IO StringBuffer
+       stringToStringBuffer, -- :: String       -> IO StringBuffer
+       freeStringBuffer,     -- :: StringBuffer -> IO ()
 
          -- Lookup
        currentChar,      -- :: StringBuffer -> Char
@@ -37,6 +39,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 +54,6 @@ module StringBuffer
         -- matching
         prefixMatch,       -- :: StringBuffer -> String -> Bool
        untilEndOfString#, -- :: StringBuffer -> Int#
-       untilChar#,        -- :: StringBuffer -> Char# -> Int#
 
          -- conversion
         lexemeToString,     -- :: StringBuffer -> String
@@ -66,16 +68,24 @@ module StringBuffer
 #include "HsVersions.h"
 
 import GlaExts
-import Addr            ( Addr(..) )
+#if __GLASGOW_HASKELL__ < 411
+import PrelAddr        ( Addr(..) )
+#else
+import Addr            ( Addr(..) )
+#endif
 import Foreign
-import ST
 import Char            ( chr )
+import Panic           ( panic )
 
 -- urk!
 #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
@@ -83,6 +93,9 @@ import Addr
 import IO              ( openFile, hFileSize, hClose, IOMode(..) )
 import Addr
 #endif
+#if __GLASGOW_HASKELL__ >= 411
+import Ptr             ( Ptr(..) )
+#endif
 
 #if __GLASGOW_HASKELL__ < 301
 import IOBase          ( Handle, IOError(..), IOErrorType(..),
@@ -119,7 +132,7 @@ data StringBuffer
 \end{code}
 
 \begin{code}
-instance Text StringBuffer where
+instance Show StringBuffer where
        showsPrec _ s = showString ""
 \end{code}
 
@@ -128,7 +141,13 @@ hGetStringBuffer :: Bool -> FilePath -> IO StringBuffer
 hGetStringBuffer expand_tabs fname = do
    (a, read) <- if expand_tabs 
                                then slurpFileExpandTabs fname 
+#if __GLASGOW_HASKELL__ < 411
                                else slurpFile fname
+#else
+                               else do
+                                   (Ptr a#, read) <- slurpFile fname
+                                   return (A# a#, read)
+#endif
 
    let (A# a#) = a;  (I# read#) = read
 
@@ -172,6 +191,34 @@ unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
 \end{code}
 
 -----------------------------------------------------------------------------
+-- Turn a String into a StringBuffer
+
+\begin{code}
+stringToStringBuffer :: String -> IO StringBuffer
+freeStringBuffer :: StringBuffer -> IO ()
+
+#if __GLASGOW_HASKELL__ >= 411
+stringToStringBuffer str =
+  do let sz@(I# sz#) = length str
+     (Ptr a#) <- mallocBytes (sz+1)
+     fill_in str (A# a#)
+     writeCharOffAddr (A# a#) sz '\0'          -- sentinel
+     return (StringBuffer a# sz# 0# 0#)
+ where
+  fill_in [] _ = return ()
+  fill_in (c:cs) a = do
+    writeCharOffAddr a 0 c 
+    fill_in cs (a `plusAddr` 1)
+
+freeStringBuffer (StringBuffer a# _ _ _) = Foreign.free (Ptr a#)
+#else
+stringToStringBuffer = panic "stringToStringBuffer: not implemented"
+freeStringBuffer sb  = return ()
+#endif
+
+\end{code}
+
+-----------------------------------------------------------------------------
 This very disturbing bit of code is used for expanding the tabs in a
 file before we start parsing it.  Expanding the tabs early makes the
 lexer a lot simpler: we only have to record the beginning of the line
@@ -289,13 +336,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 +461,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 +528,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 +546,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"