Paste: linked (not cleaned up yet, and there is a subtle design issue)

! Copyright (C) 2008 Marc Fauconneau.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel arrays math accessors sequences sequences.private math.private fry 
       locals math.bitwise assocs math.ranges kernel.private combinators syntax parser 
       mlists ;
IN: hashtables.linked

TUPLE: linked
    { assoc }
    { list } ;

: list>precursors ( list -- seq ) [ list>cursors ] keep zero>> prefix but-last ;

: <linked> ( assoc -- linked-assoc )
    [ linked new dup ] dip
    [ keys >mlist [ >>list drop ] keep list>precursors ]
    [ [ assoc-size ] keep new-assoc [ >>assoc drop ] keep ]
    [ nip ] 2tri
    '[ [ [ index>> ] [ next>> value>> ] bi _ set-at ] [ next>> dup value>> _ at >>value drop ] bi ] each ;

: linked>alist ( linked -- alist )
    [ [ list>> count>> f <array> ] [ assoc>> ] bi [ 2/ rot [ set-nth ] keep ] assoc-each ] keep
    list>> list>precursors [ [ index>> 2/ over nth ] [ next>> value>> ] bi 2array ] map nip ;

: linked-at* ( key linked -- value/f ? )
    tuck assoc>> at* [ swap list>> <cursor> next>> value>> t ] [ nip f ] if ;

: linked-delete-at ( key linked -- ) 
    2dup assoc>> at* 
    [ [ drop assoc>> delete-at ] [ swap list>> <cursor> delete-next ] 2bi ] [ 3drop ] if ;
     
: linked-set-at ( value key linked -- )
    2dup assoc>> at* 
    [ swap list>> <cursor> nip swap >>value drop ]
    [ drop [ list>> last>> nip [ insert-after ] keep index>> ] [ assoc>> set-at ] 2bi ] if ;
  
: tl { { 1 f } { 3 t } } ;

M: linked clear-assoc ( linked -- ) <mlist> >>list assoc>> clear-assoc ;

M: linked delete-at ( key linked -- ) linked-delete-at ;
M: linked assoc-size ( linked -- n ) assoc>> assoc-size ;
M: linked at* ( key linked -- value ? ) linked-at* ;
M: linked set-at ( value key linked -- ) linked-set-at ;

M: linked >alist linked>alist ;
M: linked equal? assoc>> equal? ;
M: linked new-assoc assoc>> new-assoc <linked> ;
M: linked assoc-like assoc>> assoc-like <linked> ;

INSTANCE: linked assoc