From: qrczak Date: Fri, 12 Jan 2001 07:44:50 +0000 (+0000) Subject: [project @ 2001-01-12 07:44:50 by qrczak] X-Git-Tag: Approximately_9120_patches~2939 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=615584090bf68cdf5ab6301d8df9e877c7ffbae7;p=ghc-hetmet.git [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 --- 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 --- 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 --- 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