From: sof Date: Thu, 20 Mar 1997 22:30:29 +0000 (+0000) Subject: [project @ 1997-03-20 22:30:29 by sof] X-Git-Tag: Approximately_1000_patches_recorded~756 X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=00638b9287b045767d0edea797abd92639ee6f42;p=ghc-hetmet.git [project @ 1997-03-20 22:30:29 by sof] Bogus bucket lookup function fixed (bug: arg swap) --- diff --git a/ghc/compiler/utils/FastString.lhs b/ghc/compiler/utils/FastString.lhs index 21f61fd..985c083 100644 --- a/ghc/compiler/utils/FastString.lhs +++ b/ghc/compiler/utils/FastString.lhs @@ -190,7 +190,7 @@ mkFastString# a# len# = [] -> -- no match, add it to table by copying out the -- the string into a ByteArray --- _trace "empty bucket" $ + -- _trace "empty bucket" $ case copyPrefixStr (A# a#) (I# len#) of (_ByteArray _ barr#) -> let f_str = FastString uid# len# barr# in @@ -199,14 +199,14 @@ mkFastString# a# len# = ls -> -- non-empty `bucket', scan the list looking -- entry with same length and compare byte by byte. --- _trace ("non-empty bucket"++show ls) $ + -- _trace ("non-empty bucket"++show ls) $ case bucket_match ls len# a# of Nothing -> case copyPrefixStr (A# a#) (I# len#) of (_ByteArray _ barr#) -> let f_str = FastString uid# len# barr# in updTbl string_table ft h (f_str:ls) `seqPrimIO` - ( {- _trace ("new: " ++ show f_str) $ -} returnPrimIO f_str) + ( {- _trace ("new: " ++ show f_str) $ -} returnPrimIO f_str) Just v -> {- _trace ("re-use: "++show v) $ -} returnPrimIO v) where bucket_match [] _ _ = Nothing @@ -222,10 +222,8 @@ mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#)) mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString mkFastSubStringFO# fo# start# len# = unsafePerformPrimIO ( - readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> - let - h = hashSubStrFO fo# start# len# - in + readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> + let h = hashSubStrFO fo# start# len# in case lookupTbl ft h of [] -> -- no match, add it to table by copying out the @@ -233,7 +231,7 @@ mkFastSubStringFO# fo# start# len# = case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of (_ByteArray _ barr#) -> let f_str = FastString uid# len# barr# in - updTbl string_table ft h [f_str] `seqPrimIO` + updTbl string_table ft h [f_str] `seqPrimIO` returnPrimIO f_str ls -> -- non-empty `bucket', scan the list looking @@ -258,34 +256,39 @@ mkFastSubStringFO# fo# start# len# = mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString mkFastSubStringBA# barr# start# len# = unsafePerformPrimIO ( - readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> - let - h = hashSubStrBA barr# start# len# - in --- _trace ("hashed(b): "++show (I# h)) $ + readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> + let h = hashSubStrBA barr# start# len# in + -- _trace ("hashed(b): "++show (I# h)) $ case lookupTbl ft h of [] -> -- no match, add it to table by copying out the -- the string into a ByteArray --- _trace "empty bucket(b)" $ - case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of + -- _trace "empty bucket(b)" $ + case copySubStrBA (_ByteArray btm barr#) (I# start#) (I# len#) of (_ByteArray _ ba#) -> let f_str = FastString uid# len# ba# in - updTbl string_table ft h [f_str] `seqPrimIO` - ({- _trace ("new(b): " ++ show f_str) $ -} returnPrimIO f_str) + updTbl string_table ft h [f_str] `seqPrimIO` + -- _trace ("new(b): " ++ show f_str) $ + returnPrimIO f_str ls -> -- non-empty `bucket', scan the list looking - -- entry with same length and compare byte by byte. --- _trace ("non-empty bucket(b)"++show ls) $ + -- entry with same length and compare byte by byte. + -- _trace ("non-empty bucket(b)"++show ls) $ case bucket_match ls start# len# barr# of Nothing -> case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of (_ByteArray _ ba#) -> let f_str = FastString uid# len# ba# in updTbl string_table ft h (f_str:ls) `seqPrimIO` - ({- _trace ("new(b): " ++ show f_str) $ -} returnPrimIO f_str) - Just v -> {- _trace ("re-use(b): "++show v) $ -} returnPrimIO v) - where + -- _trace ("new(b): " ++ show f_str) $ + returnPrimIO f_str + Just v -> + -- _trace ("re-use(b): "++show v) $ + returnPrimIO v + ) + where + btm = error "" + bucket_match [] _ _ _ = Nothing bucket_match (v:ls) start# len# ba# = case v of @@ -293,7 +296,7 @@ mkFastSubStringBA# barr# start# len# = if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then Just v else - bucket_match ls len# start# ba# + bucket_match ls start# len# ba# mkFastCharString :: _Addr -> FastString mkFastCharString a@(A# a#) = @@ -304,17 +307,15 @@ mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len# mkFastString :: String -> FastString mkFastString str = - (case stringToByteArray str of - (_ByteArray (_,I# len#) frozen#) -> - -- - -- 0-indexed array, len# == index to one beyond end of string, - -- i.e., (0,1) => empty string. - -- - {- _trace (show (str,I# len#)) $ -} mkFastSubStringBA# frozen# 0# len#) + case stringToByteArray str of + (_ByteArray (_,I# len#) frozen#) -> + mkFastSubStringBA# frozen# 0# len# + {- 0-indexed array, len# == index to one beyond end of string, + i.e., (0,1) => empty string. -} mkFastSubString :: _Addr -> Int -> Int -> FastString -mkFastSubString (A# a#) (I# start#) (I# len#) - = mkFastString# (addrOffset# a# start#) len# +mkFastSubString (A# a#) (I# start#) (I# len#) = + mkFastString# (addrOffset# a# start#) len# mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) = @@ -331,7 +332,7 @@ hashStr a# len# = 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# -{- +{- Currently UNUSED: if len# ==# 0# then 0# else