Paste: linked assocs

Author: slava
Mode: factor
Date: Sat, 8 Nov 2008 05:35:16
Plain Text | 
IN: linked-assocs

USING: accessors assocs arrays kernel deques dlists sequences ;

TUPLE: linked-assoc assoc dlist ;

: <linked-hash> ( -- assoc )
    0 <hashtable> <dlist> linked-assoc boa ;

M: linked-assoc assoc-size assoc>> assoc-size ;

M: linked-assoc at* assoc>> at* dup [ obj>> ] when ;

M: linked-assoc set-at
    [ [ swap 2array ] dip dlist>> push-back* ] 2keep
    assoc>> set-at ;

M: linked-assoc delete-at
    [ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
    [ assoc>> delete-at ]
    2bi ;

: dlist>seq ( dlist -- seq )
    [ ] pusher [ dlist-each ] dip ;

M: linked-assoc >alist
    dlist>> dlist>seq ;

INSTANCE: linked-assoc assoc

Annotation: updated linked-assocs

Author: jamesnvc
Mode: factor
Date: Tue, 11 Nov 2008 06:38:47
Plain Text | 
! Copyright (C) 2008 Slava Pestov, James Cash.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs arrays kernel deques dlists sequences hashtables fry ;
IN: linked-assocs

TUPLE: linked-assoc assoc dlist ;

: <linked-hash> ( -- assoc )
    0 <hashtable> <dlist> linked-assoc boa ;

M: linked-assoc assoc-size assoc>> assoc-size ;

M: linked-assoc at* assoc>> at* tuck [ obj>> second ] when swap ;

M: linked-assoc delete-at
    [ [ assoc>> ] [ dlist>> ] bi [ at ] dip '[ _ delete-node ] when* ]
    [ assoc>> delete-at ] 2bi ;

<PRIVATE
: add-to-dlist ( value key lassoc -- node )
    [ swap 2array ] dip dlist>> push-back* ;
PRIVATE>

M: linked-assoc set-at
    [ 2dup assoc>> key? [ 2dup delete-at  ] when add-to-dlist ] 2keep
    assoc>> set-at ;

: dlist>seq ( dlist -- seq )
    [ ] pusher [ dlist-each ] dip ;

M: linked-assoc >alist
    dlist>> dlist>seq ;

M: linked-assoc clear-assoc
    [ assoc>> clear-assoc ] [ dlist>> clear-deque ] bi ;

M: linked-assoc clone 
    [ assoc>> clone ] [ dlist>> clone ] bi
    linked-assoc boa ;

INSTANCE: linked-assoc assoc

Annotation: linked-assocs tests

Author: jamesnvc
Mode: factor
Date: Tue, 11 Nov 2008 06:57:32
Plain Text | 
USING: kernel sequences assocs tools.test linked-assocs math ;
IN: linked-assocs.test

{ { 1 2 3 } } [
    <linked-hash> 1 "b" pick set-at
                  2 "c" pick set-at
                  3 "a" pick set-at
    values
] unit-test

{ 2 t } [
    <linked-hash> 1 "b" pick set-at
                  2 "c" pick set-at
                  3 "a" pick set-at
    "c" swap at*
] unit-test

{ { 2 3 4 } { "c" "a" "d" } 3 } [
    <linked-hash> 1 "a" pick set-at
                  2 "c" pick set-at
                  3 "a" pick set-at
                  4 "d" pick set-at
    [ values ] [ keys ] [ assoc-size ] tri
] unit-test 

{ f 1 } [
    <linked-hash> 1 "c" pick set-at
                  2 "b" pick set-at
    "c" over delete-at
    "c" over at swap assoc-size
] unit-test 

{ { } 0 } [
    <linked-hash> 1 "a" pick set-at
                  2 "c" pick set-at
                  3 "a" pick set-at
                  4 "d" pick set-at
    dup clear-assoc [ keys ] [ assoc-size ] bi
] unit-test

{ { } { 1 2 3 } } [
    <linked-hash> dup clone
    1 "c" pick set-at
    2 "q" pick set-at
    3 "a" pick set-at
    [ values ] bi@
] unit-test

{ 9 } [
    <linked-hash>
    { [ 3 * ] [ 1- ] }          "first"   pick set-at
    { [ [ 1- ] bi@ ] [ 2 / ] }  "second"  pick set-at
    4 6 pick values [ first call ] each
    + swap values <reversed> [ second call ] each
] unit-test

New Annotation

Summary:
Author:
Mode:
Body: