Squashed commit of the following:
commit 7b6b0bdf21bca0856bfefc1859618e6e36b35d25 Author: John Benediktsson <mrjbq7@gmail.com> Date: Mon Sep 26 21:09:07 2011 -0700 hashtables.wrapped: cleanup common prettyprint code. commit aaed81f93dcfa295bd3dfd8102a5c39511209934 Author: John Benediktsson <mrjbq7@gmail.com> Date: Sun Sep 25 15:58:55 2011 -0700 hashtables.wrapped: cleaner >foo-hashtable. commit bb0f8379480935d1dcf482170e8e2a4a519d81d3 Author: John Benediktsson <mrjbq7@gmail.com> Date: Sun Sep 25 15:39:41 2011 -0700 hashtables.identity: migrate to use hashtables.wrapped. commit 2e71b3324f0803c15a55429acddc13f06b4876ae Author: John Benediktsson <mrjbq7@gmail.com> Date: Sun Sep 25 15:39:19 2011 -0700 hashtables.sequences: wrapped hashtable that uses "sequence=" for key comparison. commit 040f33b40c424887d596af5c3bd9de0eef9a682e Author: John Benediktsson <mrjbq7@gmail.com> Date: Sun Sep 25 15:39:05 2011 -0700 hashtables.wrapped: base class for "wrapped hashtables".db4
parent
fe31c534ea
commit
79c1715b4d
|
@ -1,10 +1,10 @@
|
||||||
! (c)2010 Joe Groff bsd license
|
! (c)2010 Joe Groff bsd license
|
||||||
USING: accessors arrays assocs fry hashtables kernel parser
|
USING: accessors arrays assocs hashtables hashtables.wrapped
|
||||||
sequences vocabs.loader ;
|
kernel parser sequences vocabs.loader ;
|
||||||
IN: hashtables.identity
|
IN: hashtables.identity
|
||||||
|
|
||||||
TUPLE: identity-wrapper
|
TUPLE: identity-wrapper < wrapped-key ;
|
||||||
{ underlying read-only } ;
|
|
||||||
C: <identity-wrapper> identity-wrapper
|
C: <identity-wrapper> identity-wrapper
|
||||||
|
|
||||||
M: identity-wrapper equal?
|
M: identity-wrapper equal?
|
||||||
|
@ -15,46 +15,21 @@ M: identity-wrapper equal?
|
||||||
M: identity-wrapper hashcode*
|
M: identity-wrapper hashcode*
|
||||||
nip underlying>> identity-hashcode ; inline
|
nip underlying>> identity-hashcode ; inline
|
||||||
|
|
||||||
TUPLE: identity-hashtable
|
TUPLE: identity-hashtable < wrapped-hashtable ;
|
||||||
{ underlying hashtable read-only } ;
|
|
||||||
|
|
||||||
: <identity-hashtable> ( n -- ihash )
|
: <identity-hashtable> ( n -- ihash )
|
||||||
<hashtable> identity-hashtable boa ; inline
|
<hashtable> identity-hashtable boa ; inline
|
||||||
|
|
||||||
<PRIVATE
|
M: identity-hashtable wrap-key drop <identity-wrapper> ;
|
||||||
: identity@ ( key ihash -- ikey hash )
|
|
||||||
[ <identity-wrapper> ] [ underlying>> ] bi* ; inline
|
|
||||||
PRIVATE>
|
|
||||||
|
|
||||||
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
|
|
||||||
|
|
||||||
: identity-associate ( value key -- hash )
|
|
||||||
2 <identity-hashtable> [ set-at ] keep ; inline
|
|
||||||
|
|
||||||
M: identity-hashtable >alist
|
|
||||||
underlying>> >alist [ [ first underlying>> ] [ second ] bi 2array ] map ;
|
|
||||||
|
|
||||||
M: identity-hashtable clone
|
M: identity-hashtable clone
|
||||||
underlying>> clone identity-hashtable boa ; inline
|
underlying>> clone identity-hashtable boa ; inline
|
||||||
|
|
||||||
M: identity-hashtable equal?
|
: identity-associate ( value key -- hash )
|
||||||
over identity-hashtable? [ [ underlying>> ] bi@ = ] [ 2drop f ] if ;
|
2 <identity-hashtable> [ set-at ] keep ; inline
|
||||||
|
|
||||||
: >identity-hashtable ( assoc -- ihashtable )
|
: >identity-hashtable ( assoc -- ihashtable )
|
||||||
dup assoc-size <identity-hashtable> [ '[ swap _ set-at ] assoc-each ] keep ;
|
[ assoc-size <identity-hashtable> ] keep assoc-union! ;
|
||||||
|
|
||||||
SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ;
|
SYNTAX: IH{ \ } [ >identity-hashtable ] parse-literal ;
|
||||||
|
|
||||||
|
|
|
@ -1,12 +1,8 @@
|
||||||
! (c)2010 Joe Groff bsd license
|
! Copyright (C) 2010-2011 Joe Groff
|
||||||
USING: assocs continuations hashtables.identity kernel
|
! See http://factorcode.org/license.txt for BSD license
|
||||||
namespaces prettyprint.backend prettyprint.config
|
|
||||||
prettyprint.custom ;
|
USING: hashtables.identity kernel prettyprint.custom ;
|
||||||
|
|
||||||
IN: hashtables.identity.prettyprint
|
IN: hashtables.identity.prettyprint
|
||||||
|
|
||||||
M: identity-hashtable >pprint-sequence >alist ;
|
|
||||||
M: identity-hashtable pprint-delims drop \ IH{ \ } ;
|
M: identity-hashtable pprint-delims drop \ IH{ \ } ;
|
||||||
|
|
||||||
M: identity-hashtable pprint*
|
|
||||||
nesting-limit inc
|
|
||||||
[ pprint-object ] [ nesting-limit dec ] [ ] cleanup ;
|
|
||||||
|
|
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -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{ \ } ;
|
|
@ -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" <slice> SH{ { "asdf" 1000 } } at ] unit-test
|
||||||
|
|
||||||
|
[ 1001 ] [
|
||||||
|
1001 0 4 "asdf" <slice> SH{ { "asdf" 1000 } }
|
||||||
|
[ set-at ] [ at ] 2bi
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ 1001 ] [
|
||||||
|
SH{ } clone 1001 0 4 "asdf" <slice> pick set-at
|
||||||
|
"asdf" swap at
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ { { "asdf" 1000 } } ] [ SH{ { "asdf" 1000 } } >alist ] unit-test
|
||||||
|
|
|
@ -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> 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 ;
|
||||||
|
|
||||||
|
: <sequence-hashtable> ( n -- ihash )
|
||||||
|
<hashtable> sequence-hashtable boa ; inline
|
||||||
|
|
||||||
|
M: sequence-hashtable wrap-key drop <sequence-wrapper> ;
|
||||||
|
|
||||||
|
M: sequence-hashtable clone
|
||||||
|
underlying>> clone sequence-hashtable boa ; inline
|
||||||
|
|
||||||
|
: >sequence-hashtable ( assoc -- shashtable )
|
||||||
|
[ assoc-size <sequence-hashtable> ] keep assoc-union! ;
|
||||||
|
|
||||||
|
SYNTAX: SH{ \ } [ >sequence-hashtable ] parse-literal ;
|
||||||
|
|
||||||
|
{ "hashtables.sequences" "prettyprint" } "hashtables.sequences.prettyprint" require-when
|
|
@ -0,0 +1 @@
|
||||||
|
John Benediktsson
|
|
@ -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 )
|
||||||
|
|
||||||
|
<PRIVATE
|
||||||
|
|
||||||
|
: wrapper@ ( key wrapped-hash -- wrapped-key hash )
|
||||||
|
[ wrap-key ] [ nip underlying>> ] 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
|
Loading…
Reference in New Issue