summaryrefslogtreecommitdiffstats
path: root/place.tl
diff options
context:
space:
mode:
Diffstat (limited to 'place.tl')
-rw-r--r--place.tl47
1 files changed, 47 insertions, 0 deletions
diff --git a/place.tl b/place.tl
index 85b0a55f..086f2708 100644
--- a/place.tl
+++ b/place.tl
@@ -481,6 +481,53 @@
(progn (errno ,val-sym) ,val-sym)))))
,body)))
+ (defplace (fun sym) body
+ (getter setter
+ ^(macrolet ((,getter () ^(fun ,',sym))
+ (,setter (val) ^(sys:setqf ,',sym ,val)))
+ ,*body))
+ :
+ (deleter
+ ^(macrolet ((,deleter (:env env)
+ (when (lexical-fun-p env ',sym)
+ (sys:eval-err "~s is a lexical function, \
+ \ thus not deletable"
+ ',sym))
+ ^(fmakunbound ',',sym)))
+ ,*body)))
+
+ (defun sys:get-fb (sym)
+ (or (gethash sys:top-fb sym)
+ (sys:eval-err "unbound function ~s" sym)))
+
+ (defplace (symbol-function sym-expr) body
+ (getter setter
+ (with-gensyms (binding-sym)
+ ^(let ((,binding-sym (sys:get-fb ,sym-expr)))
+ (macrolet ((,getter () ^(cdr ,',binding-sym))
+ (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
+ ,*body))))
+ :
+ (deleter
+ ^(macrolet ((,deleter () ^(fmakunbound ,',sym-expr)))
+ ,*body)))
+
+ (defun sys:get-vb (sym)
+ (or (gethash sys:top-vb sym)
+ (sys:eval-err "unbound variable ~s" sym)))
+
+ (defplace (symbol-value sym-expr) body
+ (getter setter
+ (with-gensyms (binding-sym)
+ ^(let ((,binding-sym (sys:get-vb ,sym-expr)))
+ (macrolet ((,getter () ^(cdr ,',binding-sym))
+ (,setter (val) ^(sys:rplacd ,',binding-sym ,val)))
+ ,*body))))
+ :
+ (deleter
+ ^(macrolet ((,deleter () ^(makunbound ,',sym-expr)))
+ ,*body)))
+
(macro-time
(each ((from '(car cdr))
(to '(first rest)))