[project @ 2001-01-12 07:44:50 by qrczak]

Adapt to the Addr/Ptr changes.
Throw away mkFastSubStringFO, mkFastSubStringFO#, eqStrPrefixFO.

diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs
index b4c0597..007f5ac 100644 (file)
--- a/ghc/compiler/utils/FastString.lhs
+++ b/ghc/compiler/utils/FastString.lhs
@@ -14,7 +14,6 @@ module FastString
          --names?
         mkFastString,       -- :: String -> FastString
         mkFastSubString,    -- :: Addr -> Int -> Int -> FastString
-        mkFastSubStringFO,  -- :: ForeignObj -> Int -> Int -> FastString
 
        -- These ones hold on to the Addr after they return, and aren't hashed; 
        -- they are used for literals
@@ -25,7 +24,6 @@ module FastString
        mkFastString#,      -- :: Addr# -> Int# -> FastString
         mkFastSubStringBA#, -- :: ByteArray# -> Int# -> Int# -> FastString
         mkFastSubString#,   -- :: Addr# -> Int# -> Int# -> FastString
-        mkFastSubStringFO#, -- :: ForeignObj# -> Int# -> Int# -> FastString
 
         mkFastStringInt,    -- :: [Int] -> FastString
 
@@ -88,7 +86,12 @@ import PrelIOBase    ( Handle__(..), IOError, IOErrorType(..),
 
 import PrimPacked
 import GlaExts
+#if __GLASGOW_HASKELL__ < 411
 import PrelAddr                ( Addr(..) )
+#else
+import Addr            ( Addr(..) )
+import Ptr             ( Ptr(..) )
+#endif
 #if __GLASGOW_HASKELL__ < 407
 import MutableArray    ( MutableArray(..) )
 #else
@@ -96,13 +99,6 @@ import PrelArr               ( STArray(..), newSTArray )
 import IOExts          ( hPutBufFull, hPutBufBAFull )
 #endif
 
--- ForeignObj is now exported abstractly.
-#if __GLASGOW_HASKELL__ >= 303
-import PrelForeign      ( ForeignObj(..) )
-#else
-import Foreign         ( ForeignObj(..) )
-#endif
-
 import IOExts          ( IORef, newIORef, readIORef, writeIORef )
 import IO
 import Char             ( chr, ord )
@@ -339,52 +335,6 @@ mkFastString# a# len# =
 mkFastSubString# :: Addr# -> Int# -> Int# -> FastString
 mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#)) (I# len#)
 
-mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString
-mkFastSubStringFO# fo# start# len# =
- unsafePerformIO  (
-  readIORef string_table >>= \ ft@(FastStringTable uid# tbl#) ->
-  let
-   h = hashSubStrFO fo# start# len#
-  in
-  lookupTbl ft h       >>= \ lookup_result ->
-  case lookup_result of
-    [] -> 
-       -- no match, add it to table by copying out the
-       -- the string into a ByteArray
-       case copySubStrFO (ForeignObj fo#) (I# start#) (I# len#) of
-#if __GLASGOW_HASKELL__ < 405
-        (ByteArray _ barr#) ->  
-#else
-        (ByteArray _ _ barr#) ->  
-#endif
-          let f_str = FastString uid# len# barr# in
-           updTbl string_table ft h [f_str]       >>
-          return f_str
-    ls -> 
-       -- non-empty `bucket', scan the list looking
-       -- entry with same length and compare byte by byte.
-       case bucket_match ls start# len# fo# of
-        Nothing -> 
-           case copySubStrFO (ForeignObj fo#) (I# start#) (I# len#) of
-#if __GLASGOW_HASKELL__ < 405
-            (ByteArray _ barr#) ->  
-#else
-            (ByteArray _ _ barr#) ->  
-#endif
-              let f_str = FastString uid# len# barr# in
-              updTbl string_table ft  h (f_str:ls) >>
-             ( {- _trace ("new: " ++ show f_str) $ -} return f_str)
-        Just v  -> {- _trace ("re-use: "++show v) $ -} return v)
-  where
-   bucket_match [] _ _ _ = Nothing
-   bucket_match (v@(FastString _ l# barr#):ls) start# len# fo# =
-      if len# ==# l# && eqStrPrefixFO fo# barr# start# len# then
-        Just v
-      else
-        bucket_match ls start# len# fo#
-   bucket_match (UnicodeStr _ _ : ls) start# len# fo# =
-      bucket_match ls start# len# fo#
-
 mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString
 mkFastSubStringBA# barr# start# len# =
  unsafePerformIO  (
@@ -521,10 +471,6 @@ mkFastStringInt str = if all good str
 mkFastSubString :: Addr -> Int -> Int -> FastString
 mkFastSubString (A# a#) (I# start#) (I# len#) =
  mkFastString# (addrOffset# a# start#) len#
-
-mkFastSubStringFO :: ForeignObj -> Int -> Int -> FastString
-mkFastSubStringFO (ForeignObj fo#) (I# start#) (I# len#) =
- mkFastSubStringFO# fo# start# len#
 \end{code}
 
 \begin{code}
@@ -545,23 +491,6 @@ hashStr a# len# =
     c2 = indexCharOffAddr# a# 2#
 -}
 
-hashSubStrFO  :: ForeignObj# -> Int# -> Int# -> Int#
- -- use the FO to produce a hash value between 0 & m (inclusive)
-hashSubStrFO fo# start# len# =
-  case len# of
-   0# -> 0#
-   1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
-   2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# len#) `remInt#` hASH_TBL_SIZE#
-   _  -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
-  where
-    c0 = indexCharOffForeignObj# fo# 0#
-    c1 = indexCharOffForeignObj# fo# (len# `quotInt#` 2# -# 1#)
-    c2 = indexCharOffForeignObj# fo# (len# -# 1#)
-
---    c1 = indexCharOffFO# fo# 1#
---    c2 = indexCharOffFO# fo# 2#
-
-
 hashSubStrBA  :: ByteArray# -> Int# -> Int# -> Int#
  -- use the byte array to produce a hash value between 0 & m (inclusive)
 hashSubStrBA ba# start# len# =
@@ -739,8 +668,10 @@ hPutFS handle (CharStr a# l#)
   | l# ==# 0#  = return ()
 #if __GLASGOW_HASKELL__ < 407
   | otherwise  = hPutBuf handle (A# a#) (I# l#)
-#else
+#elif __GLASGOW_HASKELL__ < 411
   | otherwise  = hPutBufFull handle (A# a#) (I# l#)
+#else
+  | otherwise  = hPutBufFull handle (Ptr a#) (I# l#)
 #endif
 
 #endif

diff --git a/ghc/compiler/utils/PrimPacked.lhs b/ghc/compiler/utils/PrimPacked.lhs
index 250f7bf..f12fe6c 100644 (file)
--- a/ghc/compiler/utils/PrimPacked.lhs
+++ b/ghc/compiler/utils/PrimPacked.lhs
@@ -13,14 +13,12 @@ module PrimPacked
         strLength,          -- :: _Addr -> Int
         copyPrefixStr,      -- :: _Addr -> Int -> ByteArray Int
         copySubStr,         -- :: _Addr -> Int -> Int -> ByteArray Int
-        copySubStrFO,       -- :: ForeignObj -> Int -> Int -> ByteArray Int
         copySubStrBA,       -- :: ByteArray Int -> Int -> Int -> ByteArray Int
 
         eqStrPrefix,        -- :: Addr# -> ByteArray# -> Int# -> Bool
         eqCharStrPrefix,    -- :: Addr# -> Addr# -> Int# -> Bool
         eqStrPrefixBA,      -- :: ByteArray# -> ByteArray# -> Int# -> Int# -> Bool
         eqCharStrPrefixBA,  -- :: Addr# -> ByteArray# -> Int# -> Int# -> Bool
-        eqStrPrefixFO,      -- :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
 
         addrOffset#         -- :: Addr# -> Int# -> Addr# 
        ) where
@@ -31,13 +29,13 @@ module PrimPacked
 #include "HsVersions.h"
 
 import GlaExts
+#if __GLASGOW_HASKELL__ < 411
 import PrelAddr        ( Addr(..) )
+#else
+import Addr    ( Addr(..) )
+#endif
 import ST
 import Foreign
--- ForeignObj is now exported abstractly.
-#if __GLASGOW_HASKELL__ >= 303
-import PrelForeign   ( ForeignObj(..) )
-#endif
 
 #if __GLASGOW_HASKELL__ < 301
 import ArrBase         ( StateAndMutableByteArray#(..), 
@@ -110,33 +108,6 @@ copySubStr a start length =
     _casm_ `` %r= (char *)((char *)%0 + (int)%1); '' a start 
                                                      >>= \ a_start ->
     return (copyPrefixStr a_start length))
-\end{code}
-
-pCopying a sub-string out of a ForeignObj
-
-\begin{code}
-copySubStrFO :: ForeignObj -> Int -> Int -> ByteArray Int
-copySubStrFO (ForeignObj fo) (I# start#) len@(I# length#) =
- runST (
-  {- allocate an array that will hold the string
-    (not forgetting the NUL at the end)
-  -}
-  new_ps_array (length# +# 1#)  >>= \ ch_array ->
-   -- fill in packed string from "addr"
-  fill_in ch_array 0#   >>
-   -- freeze the puppy:
-  freeze_ps_array ch_array length#)
-  where
-    fill_in :: MutableByteArray s Int -> Int# -> ST s ()
-
-    fill_in arr_in# idx
-      | idx ==# length#
-      = write_ps_array arr_in# idx (chr# 0#) >>
-       return ()
-      | otherwise
-      = case (indexCharOffForeignObj# fo (idx +# start#)) of { ch ->
-       write_ps_array arr_in# idx ch >>
-       fill_in arr_in# (idx +# 1#) }
 
 -- step on (char *) pointer by x units.
 addrOffset# :: Addr# -> Int# -> Addr# 
@@ -299,25 +270,4 @@ eqCharStrPrefixBA a# b2# start# len# =
    bot :: Int
 #endif
    bot = error "eqCharStrPrefixBA"
-
-eqStrPrefixFO :: ForeignObj# -> ByteArray# -> Int# -> Int# -> Bool
-eqStrPrefixFO fo# barr# start# len# = 
-  unsafePerformIO (
-   _casm_ ``%r=(int)strncmp((char *)%0+(int)%1,%2,%3); '' 
-         (ForeignObj fo#) 
-         (I# start#) 
-#if __GLASGOW_HASKELL__ < 405
-          (ByteArray bot barr#) 
-#else
-          (ByteArray bot bot barr#) 
-#endif
-          (I# len#)                  >>= \ (I# x#) ->
-   return (x# ==# 0#))
-  where
-#if __GLASGOW_HASKELL__ < 405
-   bot :: (Int,Int)
-#else
-   bot :: Int
-#endif
-   bot = error "eqStrPrefixFO"
 \end{code}

diff --git a/ghc/compiler/utils/StringBuffer.lhs b/ghc/compiler/utils/StringBuffer.lhs
index 91ce638..3e9ebe7 100644 (file)
--- a/ghc/compiler/utils/StringBuffer.lhs
+++ b/ghc/compiler/utils/StringBuffer.lhs
@@ -70,7 +70,11 @@ module StringBuffer
 #include "HsVersions.h"
 
 import GlaExts
+#if __GLASGOW_HASKELL__ < 411
 import PrelAddr        ( Addr(..) )
+#else
+import Addr            ( Addr(..) )
+#endif
 import Foreign
 import Char            ( chr )
 
@@ -90,6 +94,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(..),
@@ -135,7 +142,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