Attaching a setterfunction to an object allows us to create encapsulating modules which can have specific module variables modified:
(with (var1 42
fn1 nil)
(def fn1 (x)
(prn var1 ": " x))
(add-attachments
'= (fn (v s)
(case s
var1 (= var1 v)
(err:string "Cannot set module variable: " s)))
'keys (fn () (list 'var1 'fn1)
(fn (s)
(case s
fn1 fn1
var1 var1)))))
Note that the above does not even care about generating its own type, because it's really a one-of table.
Also, making use of lexical environment closures severely reduces the amount of code necessary for accessor functions:
;Using attachments -
(def bidir-table ()
" Creates a bidirectional table. Works like a normal
table but returns keys when queried with values.
See also [[table]] "
(with (k-to-v (table)
v-to-k (table))
(add-attachments
'= (afn (v k)
; determine if delete or assign
(aif
; insert new pair
v
(do
; delete any existing pairs first
(self nil k)
(self nil v)
; add it
; no point assigning this to v-to-k
; if v==k, since k-to-v will return
; that mapping first
(if (isnt k v) (= (v-to-k v) k))
(= (k-to-v k) v))
; deleted k
(k-to-v k)
(= (v-to-k it) nil
(k-to-v k) nil)
; deleted v
(v-to-k k)
(= (k-to-v it) nil
(v-to-k k) nil)))
; Only return items which were assigned as
; keys, so that 'ontable doesn't go over
; pairings twice.
'keys (fn () (keys k-to-v))
(annotate 'table
(fn (k) (or (k-to-v k) (v-to-k k)))))))
;Using defset-type and defcall:
(define bidir-table ()
" Creates a bidirectional table. Works like a normal
table but returns keys when queried with values.
See also [[table]] "
(annotate 'bidir-table (list (table) (table))))
(defcall bidir-table (c k)
(let (k-to-v v-to-k) (rep c)
(or (k-to-v k) (v-to-k k))))
(defset-type bidir-table (c v k)
(let (k-to-v v-to-k) (rep c)
((afn ()
; determine if delete or assign
(aif
; insert new pair
v
(do
; delete any existing pairs first
(self nil k)
(self nil v)
; add it
; no point assigning this to v-to-k
; if v==k, since k-to-v will return
; that mapping first
(if (isnt k v) (= (v-to-k v) k))
(= (k-to-v k) v))
; deleted k
(k-to-v k)
(= (v-to-k it) nil
(k-to-v k) nil)
; deleted v
(v-to-k k)
(= (k-to-v it) nil
(v-to-k k) nil)))))
