extra/pairs/pairs.factor

   1 ! Copyright (C) 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: hashtables kernel assocs accessors math arrays sequences ;
   4 IN: pairs
   5
   6 TUPLE: pair value key hash ;
   7
   8 : <pair> ( value key -- assoc )
   9     f pair boa ; inline
  10
  11 : if-hash ( pair true-quot false-quot -- )
  12     [ dup hash>> ] 2dip ?if ; inline
  13
  14 M: pair assoc-size
  15     [ assoc-size 1 + ] [ drop 1 ] if-hash ; inline
  16
  17 : if-key ( key pair true-quot false-quot -- )
  18     [ [ 2dup key>> eq? ] dip [ nip ] prepose ] dip if ; inline
  19
  20 M: pair at*
  21     [ value>> t ] [
  22         [ at* ] [ 2drop f f ] if-hash
  23     ] if-key ; inline
  24
  25 M: pair set-at
  26     [ value<< ] [
  27         [ set-at ]
  28         [ [ associate ] dip swap >>hash drop ] if-hash
  29     ] if-key ; inline
  30
  31 ERROR: cannot-delete-key pair ;
  32
  33 M: pair delete-at
  34     [ cannot-delete-key ] [
  35         [ delete-at ] [ 2drop ] if-hash
  36     ] if-key ; inline
  37
  38 M: pair >alist
  39     [ hash>> >alist ] [ [ key>> ] [ value>> ] bi 2array ] bi suffix ; inline
  40
  41 INSTANCE: pair assoc