pairs: assoc implementation optimized for a single key/value pair

extra/pairs/authors.txt

@@ -0,0 +1 @@
+Slava Pestov

extra/pairs/pairs-tests.factor

@@ -0,0 +1,23 @@
+IN: pairs.tests
+USING: namespaces assocs tools.test pairs ;
+
+SYMBOL: blah
+
+"blah" blah <pair> "b" set
+
+[ "blah" t ] [ blah "b" get at* ] unit-test
+[ f f ] [ "fdaf" "b" get at* ] unit-test
+[ 1 ] [ "b" get assoc-size ] unit-test
+[ { { blah "blah" } } ] [ "b" get >alist ] unit-test
+[ ] [ "bleah" blah "b" get set-at ] unit-test
+[ 1 ] [ "b" get assoc-size ] unit-test
+[ { { blah "bleah" } } ] [ "b" get >alist ] unit-test
+[ "bleah" t ] [ blah "b" get at* ] unit-test
+[ f f ] [ "fdaf" "b" get at* ] unit-test
+[ blah "b" get delete-at ] must-fail
+[ ] [ 1 2 "b" get set-at ] unit-test
+[ "bleah" t ] [ blah "b" get at* ] unit-test
+[ 1 t ] [ 2 "b" get at* ] unit-test
+[ f f ] [ "fdaf" "b" get at* ] unit-test
+[ 2 ] [ "b" get assoc-size ] unit-test
+[ { { 2 1 } { blah "bleah" } } ] [ "b" get >alist ] unit-test

extra/pairs/pairs.factor

@@ -0,0 +1,41 @@
+! Copyright (C) 2010 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: hashtables kernel assocs accessors math arrays sequences ;
+IN: pairs
+
+TUPLE: pair value key hash ;
+
+: <pair> ( value key -- assoc )
+    f pair boa ; inline
+
+: if-hash ( pair true-quot false-quot -- )
+    [ dup hash>> ] 2dip ?if ; inline
+
+M: pair assoc-size
+    [ assoc-size 1 + ] [ drop 1 ] if-hash ; inline
+
+: if-key ( key pair true-quot false-quot -- )
+    [ [ 2dup key>> eq? ] dip [ nip ] prepose ] dip if ; inline
+
+M: pair at*
+    [ value>> t ] [
+        [ at* ] [ 2drop f f ] if-hash
+    ] if-key ; inline
+
+M: pair set-at
+    [ (>>value) ] [
+        [ set-at ]
+        [ [ associate ] dip swap >>hash drop ] if-hash
+    ] if-key ; inline
+
+ERROR: cannot-delete-key pair ;
+
+M: pair delete-at
+    [ cannot-delete-key ] [
+        [ delete-at ] [ 2drop ] if-hash
+    ] if-key ; inline
+
+M: pair >alist
+    [ hash>> >alist ] [ [ key>> ] [ value>> ] bi 2array ] bi suffix ; inline
+
+INSTANCE: pair assoc

extra/pairs/summary.txt

@@ -0,0 +1 @@
+Assoc implementation optimized for a single key/value pair