[project @ 2000-11-17 16:53:27 by simonmar]

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

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 8fe48e0..eea0af2 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -11,8 +11,10 @@ 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
@@ -175,6 +177,27 @@ unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
 \end{code}
 
 -----------------------------------------------------------------------------
+-- Turn a String into a StringBuffer
+
+\begin{code}
+stringToStringBuffer :: String -> IO StringBuffer
+stringToStringBuffer str =
+  do let sz@(I# sz#) = length str + 1
+     (Ptr a@(A# a#)) <- mallocBytes sz
+     fill_in str a
+     writeCharOffAddr a (sz-1) '\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 -> IO ()
+freeStringBuffer (StringBuffer a# _ _ _) = Foreign.free (Ptr (A# a#))
+\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