X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=ghc%2Fcompiler%2Futils%2FStringBuffer.lhs;h=3f6bd0a18af02d5832656ae7a123053380865eaf;hb=d3a443b331824a1bf046fc7caaa73b3093775916;hp=6fac2356ab2fd41765c20390ab3c5efc56fea066;hpb=a1880d93632bf9a85cc04d30740b032413338b04;p=ghc-hetmet.git

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 6fac235..3f6bd0a 100644
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -1,25 +1,18 @@
 %
-% (c) The GRASP/AQUA Project, Glasgow University, 1997
+% (c) The GRASP/AQUA Project, Glasgow University, 1997-1998
 %
 \section{String buffers}
 
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
-
 {-# OPTIONS -fno-prune-tydecls #-}
--- Don't really understand this!
--- ERROR: Can't see the data constructor(s) for _ccall_/_casm_  argument; 
--- type: ForeignObj(try compiling with -fno-prune-tydecls ..)
-
-
 module StringBuffer
        (
         StringBuffer,
 
 	 -- creation
         hGetStringBuffer,  -- :: FilePath       -> IO StringBuffer
-	freeStringBuffer,  -- :: StringBuffer   -> IO ()
 
          -- Lookup
 	currentChar,      -- :: StringBuffer -> Char
@@ -42,7 +35,8 @@ module StringBuffer
         stepOnUntil,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
         stepOverLexeme,   -- :: StringBuffer   -> StringBuffer
 	scanNumLit,       -- :: Int -> StringBuffer -> (Int, StringBuffer)
-        expandWhile,      -- :: (Char -> Bool) -> StringBuffer -> StringBuffer
+        expandWhile,      -- :: (Char  -> Bool) -> StringBuffer -> StringBuffer
+        expandWhile#,     -- :: (Char# -> Bool) -> StringBuffer -> StringBuffer
         expandUntilMatch, -- :: StrinBuffer -> String -> StringBuffer
          -- at or beyond end of buffer?
         bufferExhausted,  -- :: StringBuffer -> Bool
@@ -69,22 +63,35 @@ module StringBuffer
 import GlaExts
 import Addr 		( Addr(..) )
 import Foreign
-import IOBase
-import IOHandle
 import ST
-import STBase
-import Char 		(isDigit)
-import PackBase 
+
+#if __GLASGOW_HASKELL__ >= 303
+import IO		( slurpFile )
+#else
+import IO		( openFile, hFileSize, hClose, IOMode(..) )
+#endif
+
+#if __GLASGOW_HASKELL__ < 301
+import IOBase		( IOError(..), IOErrorType(..) )
+import IOHandle		( readHandle, writeHandle, filePtr )
+import PackBase 	( unpackCStringBA )
+#else
+# if __GLASGOW_HASKELL__ <= 302
+import PrelIOBase	( IOError(..), IOErrorType(..) )
+import PrelHandle	( readHandle, writeHandle, filePtr )
+# endif
+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
@@ -98,36 +105,41 @@ instance Text StringBuffer where
 \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#) ->
+    hFileSize hndl          >>= \ len ->
     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)  >>= \ 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; ''		                     >>= \ free_p ->
---    makeForeignObj arr free_p		                     >>= \ fo@(_ForeignObj fo#) ->
-     readHandle hndl        >>= \ hndl_ ->
-     writeHandle hndl hndl_ >>
-     let ptr = _filePtr hndl_ in
-     _ccall_ fread arr (1::Int) len_i ptr                     >>= \  (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#)) >>= \ () ->
         return (StringBuffer a# read# 0# 0#)
 
-freeStringBuffer :: StringBuffer -> IO ()
-freeStringBuffer (StringBuffer a# _ _ _) =
- _casm_ `` free((char *)%0); '' (A# a#)
+#endif
 
 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
 unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
@@ -135,30 +147,28 @@ unsafeWriteBuffer s@(StringBuffer a _ _ _) i# ch# =
    _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}
 
@@ -196,6 +206,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
@@ -218,6 +229,15 @@ expandWhile pred (StringBuffer fo l# s# c#) =
 	 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# l# l# -- EOB, return immediately.
          | otherwise     -> StringBuffer fo l# s# c#
 
+expandWhile# :: (Char# -> Bool) -> StringBuffer -> StringBuffer
+expandWhile# pred (StringBuffer fo l# s# c#) =
+ loop c#
+  where
+   loop c# = 
+    case indexCharOffAddr# fo c# of
+     ch# | pred ch# -> loop (c# +# 1#)
+	 | ch# `eqChar#` '\NUL'# && c# >=# l# -> StringBuffer fo l# s# c# -- EOB, return immediately.
+         | otherwise     -> StringBuffer fo l# s# c#
 
 scanNumLit :: Int -> StringBuffer -> (Int,StringBuffer)
 scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
@@ -226,7 +246,7 @@ scanNumLit (I# acc#) (StringBuffer fo l# s# c#) =
    loop acc# c# = 
     case indexCharOffAddr# fo c# of
      ch# | isDigit (C# ch#) -> loop (acc# *# 10# +# (ord# ch# -# ord# '0'#)) (c# +# 1#)
-	 | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# l# l#) -- EOB, return immediately.
+	 | ch# `eqChar#` '\NUL'# && c# >=# l# -> (I# acc#, StringBuffer fo l# s# c#) -- EOB, return immediately.
          | otherwise        -> (I# acc#,StringBuffer fo l# s# c#)
 
 
@@ -235,11 +255,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}
@@ -256,27 +277,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
@@ -298,12 +321,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
@@ -319,11 +344,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