X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FStringBuffer.lhs;h=0fdaa47192edbb733e5ee1839f5a845c8dd4562d;hb=ca9afbf6a0bec76522cca846b78189f6bffa65f1;hp=0175a2bfffbe619ba0a937e0fccbd131b7e7c86f;hpb=2773693e5f92c285ef17aa8720d89ce8689add6e;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 0175a2b..0fdaa47 100644
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -6,15 +6,13 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
-#include "HsVersions.h"
-
+{-# OPTIONS -fno-prune-tydecls #-}
 module StringBuffer
        (
         StringBuffer,
 
 	 -- creation
         hGetStringBuffer,  -- :: FilePath       -> IO StringBuffer
-	freeStringBuffer,  -- :: StringBuffer   -> IO ()
 
          -- Lookup
 	currentChar,      -- :: StringBuffer -> Char
@@ -56,106 +54,116 @@ module StringBuffer
         lexemeToBuffer,     -- :: StringBuffer -> StringBuffer
 
         FastString,
-	_ByteArray
+	ByteArray
        ) where
 
-#if __GLASGOW_HASKELL__ <= 200
-import PreludeGlaST
-import PreludeGlaMisc
-import HandleHack
-import Ubiq
-#else
+#include "HsVersions.h"
+
 import GlaExts
+import Addr 		( Addr(..) )
 import Foreign
-import IOBase
-import IOHandle
 import ST
-import STBase
-import Char (isDigit)
-# if __GLASGOW_HASKELL__ == 202
-import PrelBase ( Char(..) )
-# endif
+import IO		( openFile, hFileSize, hClose, IOMode(..)
+#if __GLASGOW_HASKELL__ >= 303
+		        , slurpFile
 #endif
+		        )
+#if __GLASGOW_HASKELL__ < 301
+import IOBase		( IOError(..), IOErrorType(..) )
+import IOHandle		( readHandle, writeHandle, filePtr )
+import PackBase 	( unpackCStringBA )
+#else
+import PrelIOBase	( IOError(..), IOErrorType(..), haFO__ )
+import PrelHandle	( readHandle, writeHandle )
+import PrelPack		( unpackCStringBA )
+#endif
+
 import PrimPacked
 import FastString
-
+import Char 		(isDigit)
 \end{code} 
 
 \begin{code}
 data StringBuffer
  = StringBuffer
      Addr#
---     ForeignObj#  -- the data
      Int#         -- length
      Int#         -- lexeme start
      Int#         -- current pos
 \end{code}
 
 \begin{code}
+instance Text StringBuffer where
+	showsPrec _ s = showString ""
+\end{code}
 
+\begin{code}
 hGetStringBuffer :: FilePath -> IO StringBuffer
 hGetStringBuffer fname =
---    trace ("Renamer: opening " ++ fname) $
+#if __GLASGOW_HASKELL__ >= 303
+    slurpFile fname  >>= \ (a , read) ->
+    let (A# a#) = a
+        (I# read#) = read
+    in
+    _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' a (I# (read# -# 1#)) >>= \ () ->
+    return (StringBuffer a# read# 0# 0#)
+#else
     openFile fname ReadMode >>= \ hndl ->
     hFileSize hndl          >>= \ len@(J# _ _ d#) ->
     let len_i = fromInteger len in
       -- Allocate an array for system call to store its bytes into.
       -- ToDo: make it robust
 --    trace (show ((len_i::Int)+1)) $
-    (_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int))  `CCALL_THEN` \ arr@(A# a#) ->
+    _casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int)  >>= \ arr@(A# a#) ->
     if addr2Int# a# ==# 0# then
-       failWith MkIOError(hndl,UserError,("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
+       fail (userError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
     else
-
---   _casm_ `` %r=NULL; ''		                     `thenPrimIO` \ free_p ->
---    makeForeignObj arr free_p		                     `thenPrimIO` \ fo@(_ForeignObj fo#) ->
-     _readHandle hndl        >>= \ hndl_ ->
-     _writeHandle hndl hndl_ >>
-     let ptr = _filePtr hndl_ in
-     _ccall_ fread arr (1::Int) len_i ptr                     `CCALL_THEN` \  (I# read#) ->
---     trace ("DEBUG: opened " ++ fname ++ show (I# read#)) $
+    readHandle hndl        >>= \ hndl_ ->
+    writeHandle hndl hndl_ >>
+     let ptr = filePtr hndl_ in
+#if __GLASGOW_HASKELL__ <= 302
+     _ccall_ fread arr (1::Int) len_i (ptr::ForeignObj)               >>= \  (I# read#) ->
+#else
+     _ccall_ fread arr (1::Int) len_i (ptr::Addr)                     >>= \  (I# read#) ->
+#endif
      hClose hndl		     >>
-     if read# ==# 0# then -- EOF or other error
-        failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error")
+     if read# ==# 0# then -- EOF or some other error
+        fail (userError ("hGetStringBuffer: failed to slurp in interface file "++fname))
      else
         -- Add a sentinel NUL
-        _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `CCALL_THEN` \ () ->
+        _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) >>= \ () ->
         return (StringBuffer a# read# 0# 0#)
 
-freeStringBuffer :: StringBuffer -> IO ()
-freeStringBuffer (StringBuffer a# _ _ _) =
- _casm_ `` free((char *)%0); '' (A# a#) `CCALL_THEN` \ () ->
- return ()
+#endif
 
 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
- unsafePerformPrimIO (
-   _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) `thenPrimIO` \ () ->
-   returnPrimIO s)
-
+ unsafePerformIO (
+   _casm_ `` ((char *)%0)[(int)%1]=(char)%2; '' (A# a) (I# i#) (C# ch#) >>= \ () ->
+   return s
+ )
 \end{code}
 
 Lookup
 
 \begin{code}
-currentChar# :: StringBuffer -> Char#
-currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
-
 currentChar  :: StringBuffer -> Char
 currentChar sb = case currentChar# sb of c -> C# c
 
-indexSBuffer# :: StringBuffer -> Int# -> Char#
-indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
+lookAhead :: StringBuffer -> Int  -> Char
+lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
 
 indexSBuffer :: StringBuffer -> Int -> Char
 indexSBuffer sb (I# i#) = case indexSBuffer# sb i# of c -> C# c
 
- -- relative lookup, i.e, currentChar = lookAhead 0
+currentChar# :: StringBuffer -> Char#
+indexSBuffer# :: StringBuffer -> Int# -> Char#
 lookAhead# :: StringBuffer -> Int# -> Char#
-lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
+currentChar# (StringBuffer fo# _ _ current#) = indexCharOffAddr# fo# current#
+indexSBuffer# (StringBuffer fo# _ _ _) i# = indexCharOffAddr# fo# i#
 
-lookAhead :: StringBuffer -> Int  -> Char
-lookAhead sb (I# i#) = case lookAhead# sb i# of c -> C# c
+ -- relative lookup, i.e, currentChar = lookAhead 0
+lookAhead# (StringBuffer fo# _ _ c#) i# = indexCharOffAddr# fo# (c# +# i#)
 
 \end{code}
 
@@ -193,6 +201,7 @@ stepOnTo# :: StringBuffer -> Int# -> StringBuffer
 stepOnTo# (StringBuffer fo l _ _) s# = StringBuffer fo l s# s#
 
 stepOnUntil :: (Char -> Bool) -> StringBuffer -> StringBuffer
+
 stepOnUntil pred (StringBuffer fo l# s# c#) =
  loop c#
   where
@@ -232,11 +241,12 @@ expandUntilMatch (StringBuffer fo l# s# c#) str =
   loop c# str
   where
    loop c# [] = StringBuffer fo l# s# c#
-   loop c# ((C# x#):xs) =
-     if indexCharOffAddr# fo c# `eqChar#` x# then
-	loop (c# +# 1#) xs
-     else
-	loop (c# +# 1#) str
+   loop c# ((C# x#):xs)
+      | indexCharOffAddr# fo c# `eqChar#` x#
+      = loop (c# +# 1#) xs
+      | otherwise 
+      = loop (c# +# 1#) str
+	
 \end{code}
 
 \begin{code}
@@ -253,27 +263,29 @@ prefixMatch (StringBuffer fo l# s# c#) str =
   loop c# str
   where
    loop c# [] = Just (StringBuffer fo l# s# c#)
-   loop c# ((C# x#):xs) =
-     if indexCharOffAddr# fo c# `eqChar#` x# then
-	loop (c# +# 1#) xs
-     else
-        Nothing
+   loop c# ((C# x#):xs)
+     | indexCharOffAddr# fo c# `eqChar#` x#
+     = loop (c# +# 1#) xs
+     | otherwise
+     = Nothing
 
 untilEndOfString# :: StringBuffer -> StringBuffer
 untilEndOfString# (StringBuffer fo l# s# c#) = 
  loop c# 
  where
+  getch# i# = indexCharOffAddr# fo i#
+
   loop c# =
-   case indexCharOffAddr# fo c# of
+   case getch# c# of
     '\"'# ->
-       case indexCharOffAddr# fo (c# -# 1#) of
+      case getch# (c# -# 1#) of
 	'\\'# ->       
                   -- looks like an escaped something or other to me,
 		  -- better count the number of "\\"s that are immediately
 		  -- preceeding to decide if the " is escaped.
 	      let
 	       odd_slashes flg i# =
-	        case indexCharOffAddr# fo i# of
+	        case getch# i# of
 	         '\\'# -> odd_slashes (not flg) (i# -# 1#)
 	         _     -> flg
               in
@@ -295,12 +307,14 @@ untilEndOfChar# :: StringBuffer -> StringBuffer
 untilEndOfChar# (StringBuffer fo l# s# c#) = 
  loop c# 
  where
+  getch# i# = indexCharOffAddr# fo i#
+
   loop c# =
-   case indexCharOffAddr# fo c# of
+   case getch# c# of
     '\''# ->
-       case indexCharOffAddr# fo (c# -# 1#) of
+       case getch# (c# -# 1#) of
 	'\\'# ->
-	   case indexCharOffAddr# fo (c# -# 2#) of 	
+	   case getch# (c# -# 2#) of 	
 	     '\\'# -> -- end of char
 		   StringBuffer fo l# s# c#
              _ -> loop (c# +# 1#) -- false alarm
@@ -316,11 +330,11 @@ untilChar# :: StringBuffer -> Char# -> StringBuffer
 untilChar# (StringBuffer fo l# s# c#) x# = 
  loop c# 
  where
-  loop c# =
-   if indexCharOffAddr# fo c# `eqChar#` x# then
-      StringBuffer fo l# s# c#
-   else
-      loop (c# +# 1#)
+  loop c#
+   | indexCharOffAddr# fo c# `eqChar#` x#
+   = StringBuffer fo l# s# c#
+   | otherwise
+   = loop (c# +# 1#)
 
          -- conversion
 lexemeToString :: StringBuffer -> String
@@ -328,8 +342,7 @@ lexemeToString (StringBuffer fo _ start_pos# current#) =
  if start_pos# ==# current# then
     ""
  else
-    byteArrayToString (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
-
+    unpackCStringBA (copySubStr (A# fo) (I# start_pos#) (I# (current# -# start_pos#)))
     
 lexemeToByteArray :: StringBuffer -> _ByteArray Int
 lexemeToByteArray (StringBuffer fo _ start_pos# current#) =