diff --git a/basis/hashtables/identity/identity.factor b/basis/hashtables/identity/identity.factor index 5f1aeca636..88f4de5c92 100644 --- a/basis/hashtables/identity/identity.factor +++ b/basis/hashtables/identity/identity.factor @@ -1,10 +1,10 @@ ! (c)2010 Joe Groff bsd license -USING: accessors arrays assocs fry hashtables kernel parser -sequences vocabs.loader ; +USING: accessors arrays assocs hashtables hashtables.wrapped +kernel parser sequences vocabs.loader ; IN: hashtables.identity -TUPLE: identity-wrapper - { underlying read-only } ; +TUPLE: identity-wrapper < wrapped-key ; + C: identity-wrapper M: identity-wrapper equal? @@ -15,46 +15,21 @@ M: identity-wrapper equal? M: identity-wrapper hashcode* nip underlying>> identity-hashcode ; inline -TUPLE: identity-hashtable - { underlying hashtable read-only } ; +TUPLE: identity-hashtable < wrapped-hashtable ; : ( n -- ihash ) identity-hashtable boa ; inline - ] [ underlying>> ] bi* ; inline -PRIVATE> +M: identity-hashtable wrap-key drop ; -M: identity-hashtable at* - identity@ at* ; inline - -M: identity-hashtable clear-assoc - underlying>> clear-assoc ; inline - -M: identity-hashtable delete-at - identity@ delete-at ; inline - -M: identity-hashtable assoc-size - underlying>> assoc-size ; inline - -M: identity-hashtable set-at - identity@ set-at ; inline +M: identity-hashtable clone + underlying>> clone identity-hashtable boa ; inline : identity-associate ( value key -- hash ) 2 [ set-at ] keep ; inline -M: identity-hashtable >alist - underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ; - -M: identity-hashtable clone - underlying>> clone identity-hashtable boa ; inline - -M: identity-hashtable equal? - over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ; - : >identity-hashtable ( assoc -- ihashtable ) - dup assoc-size [ '[ swap _ set-at ] assoc-each ] keep ; + [ assoc-size ] keep assoc-union! ; SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ; diff --git a/basis/hashtables/identity/prettyprint/prettyprint.factor b/basis/hashtables/identity/prettyprint/prettyprint.factor index 15a4849257..e2dbd0b972 100644 --- a/basis/hashtables/identity/prettyprint/prettyprint.factor +++ b/basis/hashtables/identity/prettyprint/prettyprint.factor @@ -1,12 +1,8 @@ -! (c)2010 Joe Groff bsd license -USING: assocs continuations hashtables.identity kernel -namespaces prettyprint.backend prettyprint.config -prettyprint.custom ; +! Copyright (C) 2010-2011 Joe Groff +! See http://factorcode.org/license.txt for BSD license + +USING: hashtables.identity kernel prettyprint.custom ; + IN: hashtables.identity.prettyprint -M: identity-hashtable >pprint-sequence >alist ; M: identity-hashtable pprint-delims drop \ IH{ \ } ; - -M: identity-hashtable pprint* - nesting-limit inc - [ pprint-object ] [ nesting-limit dec ] [ ] cleanup ; diff --git a/basis/hashtables/sequences/authors.txt b/basis/hashtables/sequences/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/hashtables/sequences/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/hashtables/sequences/prettyprint/prettyprint.factor b/basis/hashtables/sequences/prettyprint/prettyprint.factor new file mode 100644 index 0000000000..8b80399a39 --- /dev/null +++ b/basis/hashtables/sequences/prettyprint/prettyprint.factor @@ -0,0 +1,8 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: hashtables.sequences kernel prettyprint.custom ; + +IN: hashtables.sequences.prettyprint + +M: sequence-hashtable pprint-delims drop \ SH{ \ } ; diff --git a/basis/hashtables/sequences/sequences-tests.factor b/basis/hashtables/sequences/sequences-tests.factor new file mode 100644 index 0000000000..7fe68ccf02 --- /dev/null +++ b/basis/hashtables/sequences/sequences-tests.factor @@ -0,0 +1,22 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: assocs hashtables.sequences kernel literals sequences +tools.test ; + +IN: hashtables.identity.tests + +[ 1000 ] [ 0 4 "asdf" SH{ { "asdf" 1000 } } at ] unit-test + +[ 1001 ] [ + 1001 0 4 "asdf" SH{ { "asdf" 1000 } } + [ set-at ] [ at ] 2bi +] unit-test + +[ 1001 ] [ + SH{ } clone 1001 0 4 "asdf" pick set-at + "asdf" swap at +] unit-test + +[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test + diff --git a/basis/hashtables/sequences/sequences.factor b/basis/hashtables/sequences/sequences.factor new file mode 100644 index 0000000000..fed14608ed --- /dev/null +++ b/basis/hashtables/sequences/sequences.factor @@ -0,0 +1,36 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors assocs combinators hashtables +hashtables.wrapped kernel parser sequences vocabs.loader ; + +IN: hashtables.sequences + +TUPLE: sequence-wrapper < wrapped-key ; + +C: sequence-wrapper + +M: sequence-wrapper equal? + over sequence-wrapper? + [ [ underlying>> ] bi@ sequence= ] + [ 2drop f ] if ; inline + +M: sequence-wrapper hashcode* + underlying>> [ sequence-hashcode ] recursive-hashcode ; inline + +TUPLE: sequence-hashtable < wrapped-hashtable ; + +: ( n -- ihash ) + sequence-hashtable boa ; inline + +M: sequence-hashtable wrap-key drop ; + +M: sequence-hashtable clone + underlying>> clone sequence-hashtable boa ; inline + +: >sequence-hashtable ( assoc -- shashtable ) + [ assoc-size ] keep assoc-union! ; + +SYNTAX: SH{ \ } [ >sequence-hashtable ] parse-literal ; + +{ "hashtables.sequences" "prettyprint" } "hashtables.sequences.prettyprint" require-when diff --git a/basis/hashtables/wrapped/authors.txt b/basis/hashtables/wrapped/authors.txt new file mode 100644 index 0000000000..e091bb8164 --- /dev/null +++ b/basis/hashtables/wrapped/authors.txt @@ -0,0 +1 @@ +John Benediktsson diff --git a/basis/hashtables/wrapped/wrapped.factor b/basis/hashtables/wrapped/wrapped.factor new file mode 100644 index 0000000000..09a4d94fba --- /dev/null +++ b/basis/hashtables/wrapped/wrapped.factor @@ -0,0 +1,45 @@ +! Copyright (C) 2011 John Benediktsson +! See http://factorcode.org/license.txt for BSD license + +USING: accessors arrays assocs fry hashtables kernel parser +sequences vocabs.loader ; + +IN: hashtables.wrapped + +TUPLE: wrapped-key + { underlying read-only } ; + +TUPLE: wrapped-hashtable + { underlying hashtable read-only } ; + +GENERIC: wrap-key ( key wrapped-hash -- wrapped-key ) + +> ] 2bi ; inline + +PRIVATE> + +M: wrapped-hashtable at* + wrapper@ at* ; inline + +M: wrapped-hashtable clear-assoc + underlying>> clear-assoc ; inline + +M: wrapped-hashtable delete-at + wrapper@ delete-at ; inline + +M: wrapped-hashtable assoc-size + underlying>> assoc-size ; inline + +M: wrapped-hashtable set-at + wrapper@ set-at ; inline + +M: wrapped-hashtable >alist + underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ; + +M: wrapped-hashtable equal? + over wrapped-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ; + +{ "hashtables.wrapped" "prettyprint" } "hashtables.wrapped.prettyprint" require-when