;;; gv.el --- generalized variables -*- lexical-binding: t -*-
-;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
+;; Copyright (C) 2012-2016 Free Software Foundation, Inc.
;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
;; Keywords: extensions
;; (defvar gv--macro-environment nil
;; "Macro expanders for generalized variables.")
+(define-error 'gv-invalid-place "%S is not a valid place expression")
+
;;;###autoload
(defun gv-get (place do)
"Build the code that applies DO to PLACE.
with a (not necessarily copyable) Elisp expression that returns the value to
set it to.
DO must return an Elisp expression."
- (if (symbolp place)
- (funcall do place (lambda (v) `(setq ,place ,v)))
+ (cond
+ ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
+ ((not (consp place)) (signal 'gv-invalid-place (list place)))
+ (t
(let* ((head (car place))
(gf (function-get head 'gv-expander 'autoload)))
(if gf (apply gf do (cdr place))
(if (eq me place)
(if (and (symbolp head) (get head 'setf-method))
(error "Incompatible place needs recompilation: %S" head)
- (error "%S is not a valid place expression" place))
- (gv-get me do)))))))
+ (let* ((setter (gv-setter head)))
+ (gv--defsetter head (lambda (&rest args) `(,setter ,@args))
+ do (cdr place))))
+ (gv-get me do))))))))
+
+(defun gv-setter (name)
+ ;; The name taken from Scheme's SRFI-17. Actually, for SRFI-17, the argument
+ ;; could/should be a function value rather than a symbol.
+ "Return the symbol where the (setf NAME) function should be placed."
+ (if (get name 'gv-expander)
+ (error "gv-expander conflicts with (setf %S)" name))
+ ;; FIXME: This is wrong if `name' is uninterned (or interned elsewhere).
+ (intern (format "(setf %s)" name)))
;;;###autoload
(defmacro gv-letplace (vars place &rest body)
;;;###autoload
(or (assq 'gv-expander defun-declarations-alist)
- (push `(gv-expander ,(apply-partially #'gv--defun-declaration 'gv-expander))
- defun-declarations-alist))
+ (let ((x `(gv-expander
+ ,(apply-partially #'gv--defun-declaration 'gv-expander))))
+ (push x macro-declarations-alist)
+ (push x defun-declarations-alist)))
;;;###autoload
(or (assq 'gv-setter defun-declarations-alist)
(push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
The first arg in ARGLIST (the one that receives VAL) receives an expression
which can do arbitrary things, whereas the other arguments are all guaranteed
to be pure and copyable. Example use:
- (gv-define-setter aref (v a i) `(aset ,a ,i ,v))"
+ (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
(declare (indent 2) (debug (&define name sexp body)))
`(gv-define-expander ,name
(lambda (do &rest args)
If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
instead the assignment is turned into something equivalent to
- \(let ((temp VAL))
+ (let ((temp VAL))
(SETTER ARGS... temp)
temp)
so as to preserve the semantics of `setf'."
\(fn PLACE VAL PLACE VAL ...)"
(declare (debug (&rest [gv-place form])))
+ (if (/= (logand (length args) 1) 0)
+ (signal 'wrong-number-of-arguments (list 'setf (length args))))
(if (and args (null (cddr args)))
(let ((place (pop args))
(val (car args)))
;; containing a non-trivial `push' even before gv.el was loaded.
;;;###autoload
(put 'gv-place 'edebug-form-spec 'edebug-match-form)
+
;; CL did the equivalent of:
;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
-
(put 'edebug-after 'gv-expander
(lambda (do before index place)
(gv-letplace (getter setter) place
(funcall do `(funcall (car ,gv))
(lambda (v) `(funcall (cdr ,gv) ,v))))))))
+(defmacro gv-synthetic-place (getter setter)
+ "Special place described by its setter and getter.
+GETTER and SETTER (typically obtained via `gv-letplace') get and
+set that place. I.e. This macro allows you to do the \"reverse\" of what
+`gv-letplace' does.
+This macro only makes sense when used in a place."
+ (declare (gv-expander funcall))
+ (ignore setter)
+ getter)
+
+(defmacro gv-delay-error (place)
+ "Special place which delays the `gv-invalid-place' error to run-time.
+It behaves just like PLACE except that in case PLACE is not a valid place,
+the `gv-invalid-place' error will only be signaled at run-time when (and if)
+we try to use the setter.
+This macro only makes sense when used in a place."
+ (declare
+ (gv-expander
+ (lambda (do)
+ (condition-case err
+ (gv-get place do)
+ (gv-invalid-place
+ ;; Delay the error until we try to use the setter.
+ (funcall do place (lambda (_) `(signal ',(car err) ',(cdr err)))))))))
+ place)
+
;;; Even more debatable extensions.
(put 'cons 'gv-expander
"Return a reference to PLACE.
This is like the `&' operator of the C language.
Note: this only works reliably with lexical binding mode, except for very
-simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
+simple PLACEs such as (function-symbol \\='foo) which will also work in dynamic
binding mode."
(let ((code
(gv-letplace (getter setter) place