basis/biassocs/biassocs.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel assocs accessors summary hashtables ;
   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* ; inline
  17
  18 M: biassoc value-at* to>> at* ; inline
  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 ERROR: no-biassoc-deletion ;
  27
  28 M: no-biassoc-deletion summary
  29     drop "biassocs do not support deletion" ;
  30
  31 M: biassoc delete-at
  32     no-biassoc-deletion ;
  33
  34 M: biassoc >alist from>> >alist ;
  35
  36 M: biassoc keys from>> keys ;
  37
  38 M: biassoc values from>> values ;
  39
  40 M: biassoc clear-assoc
  41     [ from>> clear-assoc ] [ to>> clear-assoc ] bi ;
  42
  43 M: biassoc new-assoc
  44     drop [ <hashtable> ] [ <hashtable> ] bi biassoc boa ;
  45
  46 INSTANCE: biassoc assoc
  47
  48 : >biassoc ( assoc -- biassoc )
  49     T{ biassoc } assoc-clone-like ;
  50
  51 M: biassoc clone
  52     [ from>> ] [ to>> ] bi [ clone ] bi@ biassoc boa ;