H{ } clone intrinsics-called set
0 swap [
- >r 1+ r>
+ [ 1+ ] dip
dup #call? [
word>> {
{ [ dup "intrinsics" word-prop over "if-intrinsics" word-prop or ] [ intrinsics-called ] }
{ [ dup generic? ] [ generics-called ] }
{ [ dup method-body? ] [ methods-called ] }
[ words-called ]
- } cond 1 -rot get at+
+ } cond inc-at
] [ drop ] if
] each-node
node-count set
SYMBOL: history
: remember-inlining ( word -- )
- [ [ 1 ] dip inlining-count get at+ ]
+ [ inlining-count get inc-at ]
[ history [ swap suffix ] change ]
bi ;
{ $syntax ":> binding" }
{ $description "Introduces a new binding, lexically scoped to the enclosing quotation or definition." }
{ $notes
+ "This word can only be used inside a lambda word, lambda quotation or let binding form."
+ $nl
"Lambda and let forms are really just syntax sugar for " { $link POSTPONE: :> } "."
$nl
"Lambdas desugar as follows:"
\r
: analyze-entry ( entry -- )\r
dup level>> { ERROR CRITICAL } memq? [ dup errors get push ] when\r
- 1 over word-name>> word-histogram get at+\r
+ dup word-name>> word-histogram get inc-at\r
dup word-name>> word-names get member? [\r
- 1 over [ level>> ] [ word-name>> ] [ message>> ] tri 3array\r
- message-histogram get at+\r
+ dup [ level>> ] [ word-name>> ] [ message>> ] tri 3array\r
+ message-histogram get inc-at\r
] when\r
drop ;\r
\r
: heap-stat-step ( obj counts sizes -- )
[ over ] dip
- [ [ [ drop 1 ] [ class ] bi ] dip at+ ]
+ [ [ class ] dip inc-at ]
[ [ [ size ] [ class ] bi ] dip at+ ] 2bi* ;
PRIVATE>
{ $subsection rename-at }
{ $subsection change-at }
{ $subsection at+ }
+{ $subsection inc-at }
{ $see-also set-at delete-at clear-assoc push-at } ;
ARTICLE: "assocs-conversions" "Associative mapping conversions"
{ $description "Adds " { $snippet "n" } " to the value associated with " { $snippet "key" } "; if there is no value, stores " { $snippet "n" } ", thus behaving as if the value was 0." }
{ $side-effects "assoc" } ;
+HELP: inc-at
+{ $values { "key" object } { "assoc" assoc } }
+{ $description "Adds 1 to the value associated with " { $snippet "key" } "; if there is no value, stores 1." }
+{ $side-effects "assoc" } ;
+
HELP: >alist
{ $values { "assoc" assoc } { "newassoc" "an array of key/value pairs" } }
{ $contract "Converts an associative structure into an association list." }
: change-at ( key assoc quot -- )
[ [ at ] dip call ] 3keep drop set-at ; inline
-: at+ ( n key assoc -- )
- [ 0 or + ] change-at ;
+: at+ ( n key assoc -- ) [ 0 or + ] change-at ; inline
+
+: inc-at ( key assoc -- ) [ 1 ] 2dip at+ ; inline
: map>assoc ( seq quot exemplar -- assoc )
[ [ 2array ] compose { } map-as ] dip assoc-like ; inline