Parse OPTIONS properly and cache the result.

Use the lexer to parse OPTIONS, LANGUAGE and INCLUDE pragmas.
This gives us greater flexibility and far better error
messages. However, I had to make a few quirks:
  * The token parser is written manually since Happy doesn't
    like lexer errors (we need to extract options before the
    buffer is passed through 'cpp'). Still better than
    manually parsing a String, though.
  * The StringBuffer API has been extended so files can be
    read in blocks.
I also made a new field in ModSummary called ms_hspp_opts
which stores the updated DynFlags. Oh, and I took the liberty
of moving 'getImports' into HeaderInfo together with
'getOptions'.

1 files changed, 30 insertions, 1 deletions

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 70d708d4d9..e52e7e78da 100644
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -13,6 +13,8 @@ module StringBuffer
 
 	 -- * Creation\/destruction
         hGetStringBuffer,
+        hGetStringBufferBlock,
+        appendStringBuffers,
 	stringToStringBuffer,
 
 	-- * Inspection
@@ -40,7 +42,8 @@ import Encoding
 import FastString		( FastString,mkFastString,mkFastStringBytes )
 
 import Foreign
-import System.IO		( hGetBuf, hFileSize,IOMode(ReadMode), hClose )
+import System.IO		( hGetBuf, hFileSize,IOMode(ReadMode), hClose
+                                , Handle, hTell )
 
 import GHC.Ptr			( Ptr(..) )
 import GHC.Exts
@@ -102,6 +105,32 @@ hGetStringBuffer fname = do
 		 -- sentinels for UTF-8 decoding
 	  return (StringBuffer buf size 0)
 
+hGetStringBufferBlock :: Handle -> Int -> IO StringBuffer
+hGetStringBufferBlock handle wanted
+    = do size_i <- hFileSize handle
+         offset_i <- hTell handle
+         let size = min wanted (fromIntegral $ size_i-offset_i)
+         buf <- mallocForeignPtrArray (size+3)
+         withForeignPtr buf $ \ptr ->
+             do r <- if size == 0 then return 0 else hGetBuf handle ptr size
+                if r /= size
+                   then ioError (userError $ "short read of file: "++show(r,size,fromIntegral size_i,handle))
+                   else do pokeArray (ptr `plusPtr` size :: Ptr Word8) [0,0,0]
+                           return (StringBuffer buf size 0)
+
+appendStringBuffers :: StringBuffer -> StringBuffer -> IO StringBuffer
+appendStringBuffers sb1 sb2
+    = do newBuf <- mallocForeignPtrArray (size+3)
+         withForeignPtr newBuf $ \ptr ->
+          withForeignPtr (buf sb1) $ \sb1Ptr ->
+           withForeignPtr (buf sb2) $ \sb2Ptr ->
+             do copyArray (sb1Ptr `advancePtr` cur sb1) ptr (calcLen sb1)
+                copyArray (sb2Ptr `advancePtr` cur sb2) (ptr `advancePtr` cur sb1) (calcLen sb2)
+                pokeArray (ptr `advancePtr` size) [0,0,0]
+                return (StringBuffer newBuf size 0)
+    where calcLen sb = len sb - cur sb
+          size = calcLen sb1 + calcLen sb2
+
 stringToStringBuffer :: String -> IO StringBuffer
 stringToStringBuffer str = do
   let size = utf8EncodedLength str