diff --git a/core/assocs/assocs-docs.factor b/core/assocs/assocs-docs.factor index e5c43f3ed6..9576a41b7b 100755 --- a/core/assocs/assocs-docs.factor +++ b/core/assocs/assocs-docs.factor @@ -58,6 +58,7 @@ ARTICLE: "assocs-lookup" "Lookup and querying of assocs" "Utility operations built up from the " { $link "assocs-protocol" } ":" { $subsection key? } { $subsection at } +{ $subsection ?at } { $subsection assoc-empty? } { $subsection keys } { $subsection values } @@ -188,12 +189,16 @@ HELP: key? { $values { "key" object } { "assoc" assoc } { "?" "a boolean" } } { $description "Tests if an assoc contains a key." } ; -{ at at* key? } related-words +{ at at* key? ?at } related-words HELP: at { $values { "key" "an object" } { "assoc" assoc } { "value/f" "the value associated to the key, or " { $link f } " if the key is not present in the assoc" } } { $description "Looks up the value associated with a key. This word makes no distinction between a missing value and a value set to " { $link f } "; if the difference is important, use " { $link at* } "." } ; +HELP: ?at +{ $values { "key" "an object" } { "assoc" assoc } { "value/key" "the value associated to the key, or the key if the key is not present in the assoc" } { "?" "a boolean" } } +{ $description "Looks up the value associated with a key. If the key was not present, an error can be thrown without extra stack shuffling. This word handles assocs that store " { $link f } "." } ; + HELP: assoc-each { $values { "assoc" assoc } { "quot" { $quotation "( key value -- )" } } } { $description "Applies a quotation to each entry in the assoc." } diff --git a/core/assocs/assocs-tests.factor b/core/assocs/assocs-tests.factor index 5617888148..fc74df6d45 100644 --- a/core/assocs/assocs-tests.factor +++ b/core/assocs/assocs-tests.factor @@ -138,4 +138,7 @@ unit-test { "c" [ 3 ] } { "d" [ 4 ] } } [ nip first even? ] assoc-partition -] unit-test \ No newline at end of file +] unit-test + +[ 1 f ] [ 1 H{ } ?at ] unit-test +[ 2 t ] [ 1 H{ { 1 2 } } ?at ] unit-test diff --git a/core/assocs/assocs.factor b/core/assocs/assocs.factor index e46bb7abb6..fdaa02e6c4 100755 --- a/core/assocs/assocs.factor +++ b/core/assocs/assocs.factor @@ -19,6 +19,9 @@ GENERIC: >alist ( assoc -- newassoc ) M: assoc assoc-like drop ; +: ?at ( key assoc -- value/key ? ) + dupd at* [ [ nip ] [ drop ] if ] keep ; inline + at* drop ; inline : at-default ( key assoc -- value/key ) - 2dup at* [ 2nip ] [ 2drop ] if ; inline + ?at drop ; inline M: assoc assoc-clone-like ( assoc exemplar -- newassoc ) [ dup assoc-size ] dip new-assoc