basis/refs/refs.factor

   1 ! Copyright (C) 2007, 2008 Slava Pestov, 2009 Alex Chapman
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel assocs accessors boxes math namespaces ;
   4 IN: refs
   5
   6 MIXIN: ref
   7
   8 GENERIC: get-ref ( ref -- obj )
   9 GENERIC: set-ref ( obj ref -- )
  10 GENERIC: delete-ref ( ref -- )
  11
  12 ! works like >>slot words
  13 : set-ref* ( ref obj -- ref ) over set-ref ;
  14
  15 ! very similar to change, on, off, +@, inc, and dec from namespaces
  16 : change-ref ( ref quot -- )
  17     [ [ get-ref ] keep ] dip dip set-ref ; inline
  18 : ref-on ( ref -- ) t swap set-ref ;
  19 : ref-off ( ref -- ) f swap set-ref ;
  20 : ref-+@ ( n ref -- ) [ 0 or + ] change-ref ;
  21 : ref-inc ( ref -- ) 1 swap ref-+@ ;
  22 : ref-dec ( ref -- ) -1 swap ref-+@ ;
  23
  24 : take ( ref -- obj )
  25     dup get-ref swap delete-ref ;
  26
  27 ! delete-ref defaults to setting ref to f
  28 M: ref delete-ref ref-off ;
  29
  30 TUPLE: obj-ref obj ;
  31 C: <obj-ref> obj-ref
  32 M: obj-ref get-ref obj>> ;
  33 M: obj-ref set-ref obj<< ;
  34 INSTANCE: obj-ref ref
  35
  36 TUPLE: var-ref var ;
  37 C: <var-ref> var-ref
  38 M: var-ref get-ref var>> get ;
  39 M: var-ref set-ref var>> set ;
  40 INSTANCE: var-ref ref
  41
  42 TUPLE: global-var-ref var ;
  43 C: <global-var-ref> global-var-ref
  44 M: global-var-ref get-ref var>> get-global ;
  45 M: global-var-ref set-ref var>> set-global ;
  46 INSTANCE: global-var-ref ref
  47
  48 USE: slots.private
  49 TUPLE: slot-ref tuple slot ;
  50 C: <slot-ref> slot-ref
  51 : >slot-ref< ( slot-ref -- tuple slot ) [ tuple>> ] [ slot>> ] bi ; inline
  52 M: slot-ref get-ref >slot-ref< slot ;
  53 M: slot-ref set-ref >slot-ref< set-slot ;
  54 INSTANCE: slot-ref ref
  55
  56 M: box get-ref box> ;
  57 M: box set-ref >box ;
  58 M: box delete-ref box> drop ;
  59 INSTANCE: box ref
  60
  61 TUPLE: assoc-ref assoc key ;
  62
  63 : >assoc-ref< ( assoc-ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
  64
  65 M: assoc-ref delete-ref ( assoc-ref -- ) >assoc-ref< delete-at ;
  66
  67 TUPLE: key-ref < assoc-ref ;
  68 C: <key-ref> key-ref
  69 M: key-ref get-ref key>> ;
  70 M: key-ref set-ref >assoc-ref< rename-at ;
  71 INSTANCE: key-ref ref
  72
  73 TUPLE: value-ref < assoc-ref ;
  74 C: <value-ref> value-ref
  75 M: value-ref get-ref >assoc-ref< at ;
  76 M: value-ref set-ref >assoc-ref< set-at ;
  77 INSTANCE: value-ref ref