hash-sets: add intern

diff --git a/core/hash-sets/hash-sets-docs.factor b/core/hash-sets/hash-sets-docs.factor
index a5d24f034f464e473141cebdf4aaf528ff3d3ae7..51520387238af106ef35a20c78a621025f1131f8 100644 (file)
--- a/core/hash-sets/hash-sets-docs.factor
+++ b/core/hash-sets/hash-sets-docs.factor
@@ -1,4 +1,4 @@
-USING: help.markup help.syntax math sequences sets ;
+USING: assocs help.markup help.syntax kernel math sequences sets ;
 IN: hash-sets
 
 ARTICLE: "hash-sets" "Hash sets"
@@ -20,3 +20,9 @@ HELP: <hash-set>
 HELP: >hash-set
 { $values { "members" sequence } { "hash-set" hash-set } }
 { $description "Creates a new hash set with the given members." } ;
+
+HELP: intern
+{ $values { "obj" object } { "hash-set" hash-set } { "obj'" "a previously retained or the original " { $link object } } }
+{ $description "If a value equal to " { $snippet "obj" } " is present in the " { $snippet "hash-set" } ", return the copy from the set, otherwise add " { $snippet "obj" } " to the " { $snippet "hash-set" } " and return the original. When used with strings, this word can be used to implement string interning, see https://en.wikipedia.org/wiki/String_interning." }
+{ $side-effects "hash-set" }
+{ $see-also cache } ;

diff --git a/core/hash-sets/hash-sets-tests.factor b/core/hash-sets/hash-sets-tests.factor
index 90e4f4ac59468dd562b290a4afe9d63727e02238..3bb17599a1d2a9d4f6a21ab35052d1010c67de51 100644 (file)
--- a/core/hash-sets/hash-sets-tests.factor
+++ b/core/hash-sets/hash-sets-tests.factor
@@ -59,3 +59,7 @@ sets sorting tools.test ;
 
 ! non-integer capacity not allowed
 [ 0.75 <hash-set> ] must-fail
+
+{ t } [ "test" dup HS{ } clone intern eq? ] unit-test
+{ t } [ "aoeu" dup clone HS{ } clone intern = ] unit-test
+{ t } [ "snth" dup clone HS{ } clone intern eq? not ] unit-test

diff --git a/core/hash-sets/hash-sets.factor b/core/hash-sets/hash-sets.factor
index 4e9a948c38d19a6ce90c3f08dabc6baa995f5558..9b22c403e8e737382496807af8adf74f8800b735 100644 (file)
--- a/core/hash-sets/hash-sets.factor
+++ b/core/hash-sets/hash-sets.factor
@@ -137,6 +137,9 @@ M: hash-set equal?
 M: hash-set set-like
     drop dup hash-set? [ ?members >hash-set ] unless ; inline
 
+: intern ( obj hash-set -- obj' )
+    2dup key@ [ swap nth 2nip ] [ 2drop [ adjoin ] keepd ] if ;
+
 INSTANCE: hash-set set
 
 ! Overrides for performance