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
9 GENERIC: get-ref ( ref -- obj )
10 GENERIC: set-ref ( obj ref -- )
11 GENERIC: delete-ref ( ref -- )
13 ! works like >>slot words
14 : set-ref* ( ref obj -- ref ) over set-ref ;
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-+@ ;
26 [ get-ref ] [ delete-ref ] bi ;
28 ! delete-ref defaults to setting ref to f
29 M: ref delete-ref ref-off ;
33 M: obj-ref get-ref obj>> ;
34 M: obj-ref set-ref obj<< ;
39 M: var-ref get-ref var>> get ;
40 M: var-ref set-ref var>> set ;
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
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
58 M: box delete-ref box> drop ;
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 ;
65 TUPLE: key-ref < assoc-ref ;
67 M: key-ref get-ref key>> ;
68 M: key-ref set-ref >assoc-ref< rename-at ;
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