[project @ 1997-05-18 04:50:40 by sof]

Made 2.0x bootable

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index b2b52e6..508c409 100644 (file)
--- a/ghc/compiler/utils/PrimPacked.lhs
+++ b/ghc/compiler/utils/PrimPacked.lhs
@@ -9,6 +9,8 @@ GHC internally, the code generator and the prelude
 libraries.
 
 \begin{code}
+#include "HsVersions.h"
+
 module PrimPacked
        (
         strLength,          -- :: _Addr -> Int
@@ -30,8 +32,17 @@ module PrimPacked
         indexCharOffFO#     -- :: ForeignObj# -> Int# -> Char#
        ) where
 
+#if __GLASGOW_HASKELL__ <= 201
 import PreludeGlaST
 import PreludeGlaMisc
+#else
+import GlaExts
+import Foreign
+import GHC
+import ArrBase
+import ST
+import STBase
+#endif
 
 \end{code} 
 
@@ -159,18 +170,21 @@ new_ps_array      :: Int# -> _ST s (_MutableByteArray s Int)
 write_ps_array :: _MutableByteArray s Int -> Int# -> Char# -> _ST s () 
 freeze_ps_array :: _MutableByteArray s Int -> _ST s (_ByteArray Int)
 
-new_ps_array size (S# s) =
+new_ps_array size =
+    MkST ( \ (S# s) ->
     case (newCharArray# size s)          of { StateAndMutableByteArray# s2# barr# ->
-    (_MutableByteArray (0,I# (size -# 1#)) barr#, S# s2#)}
+    (_MutableByteArray (0, max 0 (I# (size -# 1#))) barr#, S# s2#)})
 
-write_ps_array (_MutableByteArray _ barr#) n ch (S# s#) =
+write_ps_array (_MutableByteArray _ barr#) n ch =
+    MkST ( \ (S# s#) ->
     case writeCharArray# barr# n ch s# of { s2#   ->
-    ((), S# s2#)}
+    ((), S# s2#)})
 
 -- same as unsafeFreezeByteArray
-freeze_ps_array (_MutableByteArray ixs arr#) (S# s#) =
+freeze_ps_array (_MutableByteArray ixs arr#) =
+    MkST ( \ (S# s#) ->
     case unsafeFreezeByteArray# arr# s# of { StateAndByteArray# s2# frozen# ->
-    (_ByteArray ixs frozen#, S# s2#) }
+    (_ByteArray ixs frozen#, S# s2#) })
 \end{code}
 
 Compare two equal-length strings for equality:
@@ -182,6 +196,7 @@ eqStrPrefix a# barr# len# =
    _ccall_ strncmp (A# a#) (_ByteArray bottom barr#) (I# len#) `thenPrimIO` \ (I# x#) ->
    returnPrimIO (x# ==# 0#))
   where
+   bottom :: (Int,Int)
    bottom = error "eqStrPrefix"
 
 eqCharStrPrefix :: Addr# -> Addr# -> Int# -> Bool
@@ -190,6 +205,7 @@ eqCharStrPrefix a1# a2# len# =
    _ccall_ strncmp (A# a1#) (A# a2#) (I# len#) `thenPrimIO` \ (I# x#) ->
    returnPrimIO (x# ==# 0#))
   where
+   bottom :: (Int,Int)
    bottom = error "eqStrPrefix"
 
 eqStrPrefixBA :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
@@ -202,6 +218,7 @@ eqStrPrefixBA b1# b2# start# len# =
           (I# len#)                  `thenPrimIO` \ (I# x#) ->
    returnPrimIO (x# ==# 0#))
   where
+   bottom :: (Int,Int)
    bottom = error "eqStrPrefixBA"
 
 eqCharStrPrefixBA :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
@@ -214,6 +231,7 @@ eqCharStrPrefixBA a# b2# start# len# =
           (I# len#)                  `thenPrimIO` \ (I# x#) ->
    returnPrimIO (x# ==# 0#))
   where
+   bottom :: (Int,Int)
    bottom = error "eqCharStrPrefixBA"
 
 eqStrPrefixFO :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
@@ -226,6 +244,7 @@ eqStrPrefixFO fo# barr# start# len# =
           (I# len#)                  `thenPrimIO` \ (I# x#) ->
    returnPrimIO (x# ==# 0#))
   where
+   bottom :: (Int,Int)
    bottom = error "eqStrPrefixFO"
 \end{code}
 

diff --git a/ghc/compiler/utils/SST.lhs b/ghc/compiler/utils/SST.lhs
index e574a84..d436384 100644 (file)
--- a/ghc/compiler/utils/SST.lhs
+++ b/ghc/compiler/utils/SST.lhs
@@ -21,8 +21,13 @@ module SST(
 #endif
   ) where
 
-#if __GLASGOW_HASKELL__ >= 200
+#if __GLASGOW_HASKELL__ == 201
 import GHCbase
+#elif __GLASGOW_HASKELL__ >= 202
+import GlaExts
+import STBase
+import ArrBase
+import ST
 #else
 import PreludeGlaST ( MutableVar(..), _MutableArray(..), ST(..) )
 #endif

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 0af3dfc..0e27455 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -6,6 +6,8 @@
 Buffers for scanning string input stored in external arrays.
 
 \begin{code}
+#include "HsVersions.h"
+
 module StringBuffer
        (
         StringBuffer,
@@ -58,8 +60,18 @@ module StringBuffer
        ) where
 
 import Ubiq
+#if __GLASGOW_HASKELL__ <= 200
 import PreludeGlaST
 import PreludeGlaMisc
+#else
+import GlaExts
+import Foreign
+import IOBase
+import IOHandle
+import ST
+import STBase
+import Char (isDigit)
+#endif
 import PrimPacked
 import FastString
 import HandleHack
@@ -87,29 +99,29 @@ hGetStringBuffer fname =
       -- 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))  `thenPrimIO` \ arr@(A# a#) ->
+    (_casm_ `` %r=(char *)malloc(sizeof(char)*(int)%0); '' (len_i::Int))  `CCALL_THEN` \ arr@(A# a#) ->
     if addr2Int# a# ==# 0# then
-       failWith (UserError ("hGetStringBuffer: Could not allocate "++show len_i ++ " bytes"))
+       failWith MkIOError(hndl,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                     `thenPrimIO` \  (I# read#) ->
+     _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#)) $
      hClose hndl                    >>
      if read# ==# 0# then -- EOF or other error
-        failWith (UserError "hGetStringBuffer: EOF reached or some other error")
+        failWith MkIOError(hndl,UserError,"hGetStringBuffer: EOF reached or some other error")
      else
         -- Add a sentinel NUL
-        _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `thenPrimIO` \ () ->
+        _casm_ `` ((char *)%0)[(int)%1]=(char)0; '' arr (I# (read# -# 1#)) `CCALL_THEN` \ () ->
         return (StringBuffer a# read# 0# 0#)
 
 freeStringBuffer :: StringBuffer -> IO ()
 freeStringBuffer (StringBuffer a# _ _ _) =
- _casm_ `` free((char *)%0); '' (A# a#) `thenPrimIO` \ () ->
+ _casm_ `` free((char *)%0); '' (A# a#) `CCALL_THEN` \ () ->
  return ()
 
 unsafeWriteBuffer :: StringBuffer -> Int# -> Char# -> StringBuffer
@@ -249,8 +261,21 @@ untilEndOfString# (StringBuffer fo l# s# c#) =
    case indexCharOffAddr# fo c# of
     '\"'# ->
        case indexCharOffAddr# fo (c# -# 1#) of
-       '\\'# -> --escaped, false alarm.
-            loop (c# +# 1#) 
+       '\\'# ->       
+                  -- 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
+                '\\'# -> odd_slashes (not flg) (i# -# 1#)
+                _     -> flg
+              in
+             if odd_slashes True (c# -# 1#) then
+                 -- odd number, " is ecaped.
+                 loop (c# +# 1#)
+             else  -- a real end of string delimiter after all.
+                 StringBuffer fo l# s# c#
         _ -> StringBuffer fo l# s# c#
     _ -> loop (c# +# 1#)
 
@@ -263,8 +288,11 @@ untilEndOfChar# (StringBuffer fo l# s# c#) =
    case indexCharOffAddr# fo c# of
     '\''# ->
        case indexCharOffAddr# fo (c# -# 1#) of
-       '\\'# -> --escaped, false alarm.
-            loop (c# +# 1#) 
+       '\\'# ->
+          case indexCharOffAddr# fo (c# -# 2#) of      
+            '\\'# -> -- end of char
+                  StringBuffer fo l# s# c#
+             _ -> loop (c# +# 1#) -- false alarm
         _ -> StringBuffer fo l# s# c#
     _ -> loop (c# +# 1#)