Paste: limited-assoc

Author: Leif K-Brooks
Mode: factor
Date: Sun, 5 Apr 2009 03:37:09
Plain Text |
TUPLE: limited-assoc limit assoc queue ;

: <limited-assoc> ( limit exemplar -- limited-assoc )
    clone <dlist> limited-assoc boa ;

: <limited-hashtable> ( limit -- limited-assoc )
    H{ } <limited-assoc> ;

M: limited-assoc at*
    assoc>> at* ;

M: limited-assoc assoc-size
    assoc>> assoc-size ;

M: limited-assoc >alist
    assoc>> >alist ;

: unqueue-key ( key limited-assoc -- )
    queue>> [ = ] with delete-node-if drop ; inline

: possibly-delete-key ( limited-assoc -- )
    dup [ assoc>> assoc-size ] [ limit>> ] bi >= [
        [ queue>> pop-front ] [ assoc>> delete-at ] bi 
    ] [ drop ] if ;

: queue-key ( key limited-assoc -- )
    queue>> push-back ; inline

M: limited-assoc set-at
    2dup assoc>> key? [
        2dup unqueue-key
    ] [
        dup possibly-delete-key
    ] if
    [ queue>> push-back ] [ assoc>> set-at ] 2bi ;

M: limited-assoc delete-at
    [ unqueue-key ] [ assoc>> delete-at ] 2bi ;

M: limited-assoc clear-assoc
    [ assoc>> clear-assoc ] [ queue>> clear-deque ] bi ;

INSTANCE: limited-assoc assoc

New Annotation

Summary:
Author:
Mode:
Body: