hashtables.numbers: adding number-hashcode version of hashtables.

db4
John Benediktsson 2013-04-17 14:07:49 -07:00
parent e751fbf78b
commit b5f2fb891e
4 changed files with 70 additions and 0 deletions

View File

@ -0,0 +1 @@
John Benediktsson

View File

@ -0,0 +1,22 @@
! Copyright (C) 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: assocs hashtables.numbers kernel literals sequences
tools.test ;
IN: hashtables.numbers.tests
[ 1000 ] [ 3/2 NH{ { 1.5 1000 } } at ] unit-test
[ 1001 ] [
1001 1.5 NH{ { 3/2 1000 } }
[ set-at ] [ at ] 2bi
] unit-test
[ 1001 ] [
NH{ } clone 1001 1.5 pick set-at
3/2 of
] unit-test
[ { { 1.0 1000 } } ] [ NH{ { 1.0 1000 } } >alist ] unit-test

View File

@ -0,0 +1,39 @@
! Copyright (C) 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: accessors assocs combinators hashtables
hashtables.wrapped kernel math math.hashcodes parser
vocabs.loader ;
IN: hashtables.numbers
TUPLE: number-wrapper < wrapped-key ;
C: <number-wrapper> number-wrapper
M: number-wrapper equal?
over number-wrapper?
[ [ underlying>> ] bi@ number= ]
[ 2drop f ] if ; inline
M: number-wrapper hashcode*
nip underlying>> number-hashcode ; inline
TUPLE: number-hashtable < wrapped-hashtable ;
: <number-hashtable> ( n -- shashtable )
<hashtable> number-hashtable boa ; inline
M: number-hashtable wrap-key drop <number-wrapper> ;
M: number-hashtable clone
underlying>> clone number-hashtable boa ; inline
: >number-hashtable ( assoc -- shashtable )
[ assoc-size <number-hashtable> ] keep assoc-union! ;
M: number-hashtable new-assoc drop <number-hashtable> ;
SYNTAX: NH{ \ } [ >number-hashtable ] parse-literal ;
{ "hashtables.numbers" "prettyprint" } "hashtables.numbers.prettyprint" require-when

View File

@ -0,0 +1,8 @@
! Copyright (C) 2013 John Benediktsson
! See http://factorcode.org/license.txt for BSD license
USING: hashtables.numbers kernel prettyprint.custom ;
IN: hashtables.numbers
M: number-hashtable pprint-delims drop \ NH{ \ } ;