extra/sequences/n-based/n-based.factor

   1 ! (c)2008 Joe Groff, see BSD license etc.
   2 USING: accessors assocs kernel math math.ranges sequences
   3 sequences.private ;
   4 IN: sequences.n-based
   5
   6 TUPLE: n-based-assoc seq base ;
   7 C: <n-based-assoc> n-based-assoc
   8
   9 <PRIVATE
  10
  11 : n-based@ ( key assoc -- n seq )
  12     [ base>> - ] [ nip seq>> ] 2bi ;
  13 : n-based-keys ( assoc -- range )
  14     [ base>> ] [ assoc-size ] bi 1 <range> ;
  15
  16 PRIVATE>
  17
  18 INSTANCE: n-based-assoc assoc
  19 M: n-based-assoc at* ( key assoc -- value ? )
  20     n-based@ 2dup bounds-check?
  21     [ nth-unsafe t ] [ 2drop f f ] if ;
  22 M: n-based-assoc assoc-size ( assoc -- size )
  23     seq>> length ;
  24 M: n-based-assoc >alist ( assoc -- alist )
  25     [ n-based-keys ] [ seq>> ] bi zip ;
  26 M: n-based-assoc set-at ( value key assoc -- )
  27     n-based@ set-nth ;
  28 M: n-based-assoc delete-at ( key assoc -- )
  29     [ f ] 2dip n-based@ set-nth ;
  30 M: n-based-assoc clear-assoc ( assoc -- )
  31     seq>> delete-all ;