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: accessors assocs boxes kernel math namespaces
   4 slots.private ;
   5 IN: refs
   6
   7 MIXIN: ref
   8
   9 GENERIC: get-ref ( ref -- obj )
  10 GENERIC: set-ref ( obj ref -- )
  11 GENERIC: delete-ref ( ref -- )
  12
  13 ! works like >>slot words
  14 : set-ref* ( ref obj -- ref ) over set-ref ;
  15
  16 ! very similar to change, on, off, +@, inc, and dec from namespaces
  17 : change-ref ( ref quot -- )
  18     [ [ get-ref ] keep ] dip dip set-ref ; inline
  19 : ref-on ( ref -- ) t swap set-ref ;
  20 : ref-off ( ref -- ) f swap set-ref ;
  21 : ref-+@ ( n ref -- ) [ 0 or + ] change-ref ;
  22 : ref-inc ( ref -- ) 1 swap ref-+@ ;
  23 : ref-dec ( ref -- ) -1 swap ref-+@ ;
  24
  25 : take ( ref -- obj )
  26     [ get-ref ] [ delete-ref ] bi ;
  27
  28 ! delete-ref defaults to setting ref to f
  29 M: ref delete-ref ref-off ;
  30
  31 TUPLE: obj-ref obj ;
  32 C: <obj-ref> obj-ref
  33 M: obj-ref get-ref obj>> ;
  34 M: obj-ref set-ref obj<< ;
  35 INSTANCE: obj-ref ref
  36
  37 TUPLE: var-ref var ;
  38 C: <var-ref> var-ref
  39 M: var-ref get-ref var>> get ;
  40 M: var-ref set-ref var>> set ;
  41 INSTANCE: var-ref ref
  42
  43 TUPLE: global-var-ref var ;
  44 C: <global-var-ref> global-var-ref
  45 M: global-var-ref get-ref var>> get-global ;
  46 M: global-var-ref set-ref var>> set-global ;
  47 INSTANCE: global-var-ref ref
  48
  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 : >assoc-ref< ( assoc-ref -- key value ) [ key>> ] [ assoc>> ] bi ; inline
  63 M: assoc-ref delete-ref >assoc-ref< delete-at ;
  64
  65 TUPLE: key-ref < assoc-ref ;
  66 C: <key-ref> key-ref
  67 M: key-ref get-ref key>> ;
  68 M: key-ref set-ref >assoc-ref< rename-at ;
  69 INSTANCE: key-ref ref
  70
  71 TUPLE: value-ref < assoc-ref ;
  72 C: <value-ref> value-ref
  73 M: value-ref get-ref >assoc-ref< at ;
  74 M: value-ref set-ref >assoc-ref< set-at ;
  75 INSTANCE: value-ref ref