Commit 00638b92 authored by sof's avatar sof
Browse files

[project @ 1997-03-20 22:30:29 by sof]

Bogus bucket lookup function fixed (bug: arg swap)
parent 5e6684ac
...@@ -190,7 +190,7 @@ mkFastString# a# len# = ...@@ -190,7 +190,7 @@ mkFastString# a# len# =
[] -> [] ->
-- no match, add it to table by copying out the -- no match, add it to table by copying out the
-- the string into a ByteArray -- the string into a ByteArray
-- _trace "empty bucket" $ -- _trace "empty bucket" $
case copyPrefixStr (A# a#) (I# len#) of case copyPrefixStr (A# a#) (I# len#) of
(_ByteArray _ barr#) -> (_ByteArray _ barr#) ->
let f_str = FastString uid# len# barr# in let f_str = FastString uid# len# barr# in
...@@ -199,14 +199,14 @@ mkFastString# a# len# = ...@@ -199,14 +199,14 @@ mkFastString# a# len# =
ls -> ls ->
-- non-empty `bucket', scan the list looking -- non-empty `bucket', scan the list looking
-- entry with same length and compare byte by byte. -- 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 case bucket_match ls len# a# of
Nothing -> Nothing ->
case copyPrefixStr (A# a#) (I# len#) of case copyPrefixStr (A# a#) (I# len#) of
(_ByteArray _ barr#) -> (_ByteArray _ barr#) ->
let f_str = FastString uid# len# barr# in let f_str = FastString uid# len# barr# in
updTbl string_table ft h (f_str:ls) `seqPrimIO` 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) Just v -> {- _trace ("re-use: "++show v) $ -} returnPrimIO v)
where where
bucket_match [] _ _ = Nothing bucket_match [] _ _ = Nothing
...@@ -222,10 +222,8 @@ mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#)) ...@@ -222,10 +222,8 @@ mkFastSubString# a# start# len# = mkFastCharString2 (A# (addrOffset# a# start#))
mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString mkFastSubStringFO# :: ForeignObj# -> Int# -> Int# -> FastString
mkFastSubStringFO# fo# start# len# = mkFastSubStringFO# fo# start# len# =
unsafePerformPrimIO ( unsafePerformPrimIO (
readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) ->
let let h = hashSubStrFO fo# start# len# in
h = hashSubStrFO fo# start# len#
in
case lookupTbl ft h of case lookupTbl ft h of
[] -> [] ->
-- no match, add it to table by copying out the -- no match, add it to table by copying out the
...@@ -233,7 +231,7 @@ mkFastSubStringFO# fo# start# len# = ...@@ -233,7 +231,7 @@ mkFastSubStringFO# fo# start# len# =
case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of case copySubStrFO (_ForeignObj fo#) (I# start#) (I# len#) of
(_ByteArray _ barr#) -> (_ByteArray _ barr#) ->
let f_str = FastString uid# len# barr# in 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 returnPrimIO f_str
ls -> ls ->
-- non-empty `bucket', scan the list looking -- non-empty `bucket', scan the list looking
...@@ -258,34 +256,39 @@ mkFastSubStringFO# fo# start# len# = ...@@ -258,34 +256,39 @@ mkFastSubStringFO# fo# start# len# =
mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString mkFastSubStringBA# :: ByteArray# -> Int# -> Int# -> FastString
mkFastSubStringBA# barr# start# len# = mkFastSubStringBA# barr# start# len# =
unsafePerformPrimIO ( unsafePerformPrimIO (
readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) -> readVar string_table `thenPrimIO` \ ft@(FastStringTable uid# tbl#) ->
let let h = hashSubStrBA barr# start# len# in
h = hashSubStrBA barr# start# len# -- _trace ("hashed(b): "++show (I# h)) $
in
-- _trace ("hashed(b): "++show (I# h)) $
case lookupTbl ft h of case lookupTbl ft h of
[] -> [] ->
-- no match, add it to table by copying out the -- no match, add it to table by copying out the
-- the string into a ByteArray -- the string into a ByteArray
-- _trace "empty bucket(b)" $ -- _trace "empty bucket(b)" $
case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of case copySubStrBA (_ByteArray btm barr#) (I# start#) (I# len#) of
(_ByteArray _ ba#) -> (_ByteArray _ ba#) ->
let f_str = FastString uid# len# ba# in let f_str = FastString uid# len# ba# in
updTbl string_table ft h [f_str] `seqPrimIO` updTbl string_table ft h [f_str] `seqPrimIO`
({- _trace ("new(b): " ++ show f_str) $ -} returnPrimIO f_str) -- _trace ("new(b): " ++ show f_str) $
returnPrimIO f_str
ls -> ls ->
-- non-empty `bucket', scan the list looking -- non-empty `bucket', scan the list looking
-- entry with same length and compare byte by byte. -- entry with same length and compare byte by byte.
-- _trace ("non-empty bucket(b)"++show ls) $ -- _trace ("non-empty bucket(b)"++show ls) $
case bucket_match ls start# len# barr# of case bucket_match ls start# len# barr# of
Nothing -> Nothing ->
case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of case copySubStrBA (_ByteArray (error "") barr#) (I# start#) (I# len#) of
(_ByteArray _ ba#) -> (_ByteArray _ ba#) ->
let f_str = FastString uid# len# ba# in let f_str = FastString uid# len# ba# in
updTbl string_table ft h (f_str:ls) `seqPrimIO` updTbl string_table ft h (f_str:ls) `seqPrimIO`
({- _trace ("new(b): " ++ show f_str) $ -} returnPrimIO f_str) -- _trace ("new(b): " ++ show f_str) $
Just v -> {- _trace ("re-use(b): "++show v) $ -} returnPrimIO v) returnPrimIO f_str
where Just v ->
-- _trace ("re-use(b): "++show v) $
returnPrimIO v
)
where
btm = error ""
bucket_match [] _ _ _ = Nothing bucket_match [] _ _ _ = Nothing
bucket_match (v:ls) start# len# ba# = bucket_match (v:ls) start# len# ba# =
case v of case v of
...@@ -293,7 +296,7 @@ mkFastSubStringBA# barr# start# len# = ...@@ -293,7 +296,7 @@ mkFastSubStringBA# barr# start# len# =
if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then if len# ==# l# && eqStrPrefixBA barr# ba# start# len# then
Just v Just v
else else
bucket_match ls len# start# ba# bucket_match ls start# len# ba#
mkFastCharString :: _Addr -> FastString mkFastCharString :: _Addr -> FastString
mkFastCharString a@(A# a#) = mkFastCharString a@(A# a#) =
...@@ -304,17 +307,15 @@ mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len# ...@@ -304,17 +307,15 @@ mkFastCharString2 a@(A# a#) (I# len#) = CharStr a# len#
mkFastString :: String -> FastString mkFastString :: String -> FastString
mkFastString str = mkFastString str =
(case stringToByteArray str of case stringToByteArray str of
(_ByteArray (_,I# len#) frozen#) -> (_ByteArray (_,I# len#) frozen#) ->
-- mkFastSubStringBA# frozen# 0# len#
-- 0-indexed array, len# == index to one beyond end of string, {- 0-indexed array, len# == index to one beyond end of string,
-- i.e., (0,1) => empty string. i.e., (0,1) => empty string. -}
--
{- _trace (show (str,I# len#)) $ -} mkFastSubStringBA# frozen# 0# len#)
mkFastSubString :: _Addr -> Int -> Int -> FastString mkFastSubString :: _Addr -> Int -> Int -> FastString
mkFastSubString (A# a#) (I# start#) (I# len#) mkFastSubString (A# a#) (I# start#) (I# len#) =
= mkFastString# (addrOffset# a# start#) len# mkFastString# (addrOffset# a# start#) len#
mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString mkFastSubStringFO :: _ForeignObj -> Int -> Int -> FastString
mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) = mkFastSubStringFO (_ForeignObj fo#) (I# start#) (I# len#) =
...@@ -331,7 +332,7 @@ hashStr a# len# = ...@@ -331,7 +332,7 @@ hashStr a# len# =
1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE# 1# -> ((ord# c0 *# 631#) +# len#) `remInt#` hASH_TBL_SIZE#
2# -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# 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# _ -> ((ord# c0 *# 631#) +# (ord# c1 *# 217#) +# (ord# c2 *# 43#) +# len#) `remInt#` hASH_TBL_SIZE#
{- {- Currently UNUSED:
if len# ==# 0# then if len# ==# 0# then
0# 0#
else else
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment