[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 8fe48e0..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
@@ -66,9 +68,14 @@ module StringBuffer
 #include "HsVersions.h"
 
 import GlaExts
+#if __GLASGOW_HASKELL__ < 411
 import PrelAddr        ( Addr(..) )
+#else
+import Addr            ( Addr(..) )
+#endif
 import Foreign
 import Char            ( chr )
+import Panic           ( panic )
 
 -- urk!
 #include "../lib/std/cbits/stgerror.h"
@@ -86,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(..),
@@ -131,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
 
@@ -175,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