extra/biassocs/biassocs.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel assocs accessors ;
   4 IN: biassocs
   5
   6 TUPLE: biassoc from to ;
   7
   8 : <biassoc> ( exemplar -- biassoc )
   9     [ clone ] [ clone ] bi biassoc boa ;
  10
  11 : <bihash> ( -- biassoc )
  12     H{ } <biassoc> ;
  13
  14 M: biassoc assoc-size from>> assoc-size ;
  15
  16 M: biassoc at* from>> at* ;
  17
  18 M: biassoc value-at* to>> at* ;
  19
  20 : once-at ( value key assoc -- )
  21     2dup key? [ 3drop ] [ set-at ] if ;
  22
  23 M: biassoc set-at
  24     [ from>> set-at ] [ swapd to>> once-at ] 3bi ;
  25
  26 M: biassoc delete-at
  27     "biassocs do not support deletion" throw ;
  28
  29 M: biassoc >alist
  30     from>> >alist ;
  31
  32 M: biassoc clear-assoc
  33     [ from>> clear-assoc ] [ to>> clear-assoc ] bi ;
  34
  35 INSTANCE: biassoc assoc