]> gitweb.factorcode.org Git - factor.git/commitdiff
Add inc-at word to core, and update some usages of at+ to use it instead
authorSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 22:54:48 +0000 (16:54 -0600)
committerSlava Pestov <slava@slava-pestovs-macbook-pro.local>
Tue, 9 Dec 2008 22:54:48 +0000 (16:54 -0600)
basis/compiler/tree/debugger/debugger.factor
basis/compiler/tree/propagation/inlining/inlining.factor
basis/locals/locals-docs.factor
basis/logging/analysis/analysis.factor
basis/tools/memory/memory.factor
core/assocs/assocs-docs.factor
core/assocs/assocs.factor

index 8a2823010dc41ac54f5986ee9330bda54e211c0c..e75e7f60469af5bf79589e34d418917a04ee4b71 100644 (file)
@@ -151,14 +151,14 @@ SYMBOL: node-count
         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
index e35eb02604e73dfb313ab4bc7d7e8fe8829909e7..bd6d65744243b5e8800770656bd3aeb8f3fbace2 100644 (file)
@@ -152,7 +152,7 @@ DEFER: (flat-length)
 SYMBOL: history
 
 : remember-inlining ( word -- )
-    [ [ 1 ] dip inlining-count get at+ ]
+    [ inlining-count get inc-at ]
     [ history [ swap suffix ] change ]
     bi ;
 
index e9e1bfa16ab99133a334754074d9baa97471eb43..77b87d1b49f2969d944f7a9cfad37f8614112782 100644 (file)
@@ -67,6 +67,8 @@ HELP: :>
 { $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:"
index d84e49f784cb63781bcf1c18e414e9ae1fde1d2b..24810a6c3e0a574b73ce0886e80b64d2acd24c56 100644 (file)
@@ -13,10 +13,10 @@ SYMBOL: message-histogram
 \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
index 8c35ae25a84e506eae48ace6e116d0340b99a290..2ad16a4d8d6d34cff4886ff4e64c133b4a81e638 100644 (file)
@@ -53,7 +53,7 @@ IN: tools.memory
 
 : 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>
index 662d6674853a432116b5527c83c7c5f5101fe538..2f486cd948786180506a079eda810bb2a12c0a8c 100644 (file)
@@ -90,6 +90,7 @@ ARTICLE: "assocs-mutation" "Storing keys and values in assocs"
 { $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"
@@ -349,6 +350,11 @@ HELP: at+
 { $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." }
index 76745cc0151f99055c778d87e5861ddf2f85be4e..320e370ec980bad11cc5363e10104cdcc05d70e3 100644 (file)
@@ -141,8 +141,9 @@ M: assoc assoc-clone-like ( assoc exemplar -- newassoc )
 : 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