basis: Try to fix the build. My profiler is hanging, but I can't figure out why. See if the build farm has the same is

sue.
db4
Doug Coleman 2012-11-27 12:47:05 -06:00
parent 5b5ee71a6a
commit 516549b52c
3 changed files with 15 additions and 16 deletions

View File

@ -134,42 +134,41 @@ HELP: sorted-histogram
HELP: sequence>assoc HELP: sequence>assoc
{ $values { $values
{ "seq" sequence } { "map-quot" { $quotation "( x -- ..y )" } } { "insert-quot" { $quotation "( ..y assoc -- )" } } { "exemplar" "an exemplar assoc" } { "seq" sequence } { "map-quot" $quotation } { "insert-quot" quotation } { "exemplar" "an exemplar assoc" }
{ "assoc" assoc } { "assoc" assoc }
} }
{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." } { $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
{ $examples { $examples
{ $example "! Iterate over a sequence and increment the count at each element" { $example "! Iterate over a sequence and increment the count at each element"
"! The first quotation has stack effect ( key -- key ), a no-op" "! The first quotation has stack effect ( key -- key ), a no-op"
"USING: assocs prettyprint math.statistics ;" "USING: assocs prettyprint kernel math.statistics ;"
"\"aaabc\" [ ] [ inc-at ] H{ } sequence>assoc ." "\"aaabc\" [ ] [ nip inc-at ] H{ } sequence>assoc ."
"H{ { 97 3 } { 98 1 } { 99 1 } }" "H{ { 97 3 } { 98 1 } { 99 1 } }"
} }
} ; } ;
HELP: sequence>assoc! HELP: sequence>assoc!
{ $values { $values
{ "assoc" assoc } { "seq" sequence } { "map-quot" { $quotation "( x -- ..y )" } } { "insert-quot" { $quotation "( ..y assoc -- )" } } { "assoc" assoc } { "seq" sequence } { "map-quot" quotation } { "insert-quot" quotation } }
}
{ $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." } { $description "Iterates over a sequence, allowing elements of the sequence to be added to an existing " { $snippet "assoc" } ". The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
{ $examples { $examples
{ $example "! Iterate over a sequence and add the counts to an existing assoc" { $example "! Iterate over a sequence and add the counts to an existing assoc"
"USING: assocs prettyprint math.statistics kernel ;" "USING: assocs prettyprint math.statistics kernel ;"
"H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ ] [ inc-at ] sequence>assoc! ." "H{ { 97 2 } { 98 1 } } clone \"aaabc\" [ ] [ nip inc-at ] sequence>assoc! ."
"H{ { 97 5 } { 98 2 } { 99 1 } }" "H{ { 97 5 } { 98 2 } { 99 1 } }"
} }
} ; } ;
HELP: sequence>hashtable HELP: sequence>hashtable
{ $values { $values
{ "seq" sequence } { "map-quot" { $quotation "( x -- ..y )" } } { "insert-quot" { $quotation "( ..y assoc -- )" } } { "seq" sequence } { "map-quot" quotation } { "insert-quot" quotation }
{ "hashtable" hashtable } { "hashtable" hashtable }
} }
{ $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created hashtable. The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." } { $description "Iterates over a sequence, allowing elements of the sequence to be added to a newly created hashtable. The " { $snippet "map-quot" } " gets passed each element from the sequence. Its outputs are passed along with the assoc being constructed to the " { $snippet "insert-quot" } ", which can modify the assoc in response." }
{ $examples { $examples
{ $example "! Count the number of times an element occurs in a sequence" { $example "! Count the number of times an element occurs in a sequence"
"USING: assocs prettyprint math.statistics ;" "USING: assocs kernel prettyprint math.statistics ;"
"\"aaabc\" [ ] [ inc-at ] sequence>hashtable ." "\"aaabc\" [ ] [ nip inc-at ] sequence>hashtable ."
"H{ { 97 3 } { 98 1 } { 99 1 } }" "H{ { 97 3 } { 98 1 } { 99 1 } }"
} }
} ; } ;

View File

@ -241,14 +241,14 @@ PRIVATE>
: normalized-histogram ( seq -- alist ) : normalized-histogram ( seq -- alist )
[ histogram ] [ length ] bi '[ _ / ] assoc-map ; [ histogram ] [ length ] bi '[ _ / ] assoc-map ;
: collect-pairs ( seq quot: ( x y -- v k y ) -- hashtable ) : collect-at ( seq quot -- hashtable )
[ [ nip ] dip push-at ] sequence>hashtable ; inline [ push-at ] sequence>hashtable ; inline
: collect-index-by ( seq quot: ( x -- x' ) -- hashtable ) : collect-index-by ( seq quot -- hashtable )
[ swap dup ] prepose collect-pairs ; inline [ swap ] prepose collect-at ; inline
: collect-by ( seq quot: ( x -- x' ) -- hashtable ) : collect-by ( seq quot -- hashtable )
[ dup ] prepose collect-pairs ; inline [ drop dup ] prepose collect-at ; inline
: equal-probabilities ( n -- array ) : equal-probabilities ( n -- array )
dup recip <array> ; inline dup recip <array> ; inline

View File

@ -98,7 +98,7 @@ CONSTANT: zero-counts { 0 0 0 0 0 }
] [ f ] if ; inline ] [ f ] if ; inline
:: collect-tops ( samples max-depth depth -- node ) :: collect-tops ( samples max-depth depth -- node )
samples [ unclip-callstack ] collect-pairs [ samples [ drop unclip-callstack ] collect-at [
[ sum-counts ] [ sum-counts ]
[ max-depth depth [ max-depth depth 1 + collect-tops ] (collect-subtrees) ] bi [ max-depth depth [ max-depth depth 1 + collect-tops ] (collect-subtrees) ] bi
depth <profile-node> depth <profile-node>