Merge branch 'master' into comment-cache
[emacs.git] / lisp / emacs-lisp / gv.el
blobc5c12a6414c89a610fa2d40565a9f3a22eccf248
1 ;;; gv.el --- generalized variables -*- lexical-binding: t -*-
3 ;; Copyright (C) 2012-2017 Free Software Foundation, Inc.
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords: extensions
7 ;; Package: emacs
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24 ;;; Commentary:
26 ;; This is a re-implementation of the setf machinery using a different
27 ;; underlying approach than the one used earlier in CL, which was based on
28 ;; define-setf-expander.
29 ;; `define-setf-expander' makes every "place-expander" return a 5-tuple
30 ;; (VARS VALUES STORES GETTER SETTER)
31 ;; where STORES is a list with a single variable (Common-Lisp allows multiple
32 ;; variables for use with multiple-return-values, but this is rarely used and
33 ;; not applicable to Elisp).
34 ;; It basically says that GETTER is an expression that returns the place's
35 ;; value, and (lambda STORES SETTER) is an expression that assigns the value(s)
36 ;; passed to that function to the place, and that you need to wrap the whole
37 ;; thing within a `(let* ,(zip VARS VALUES) ...).
39 ;; Instead, we use here a higher-order approach: instead
40 ;; of a 5-tuple, a place-expander returns a function.
41 ;; If you think about types, the old approach return things of type
42 ;; {vars: List Var, values: List Exp,
43 ;; stores: List Var, getter: Exp, setter: Exp}
44 ;; whereas the new approach returns a function of type
45 ;; (do: ((getter: Exp, setter: ((store: Exp) -> Exp)) -> Exp)) -> Exp.
46 ;; You can get the new function from the old 5-tuple with something like:
47 ;; (lambda (do)
48 ;; `(let* ,(zip VARS VALUES)
49 ;; (funcall do GETTER (lambda ,STORES ,SETTER))))
50 ;; You can't easily do the reverse, because this new approach is more
51 ;; expressive than the old one, so we can't provide a backward-compatible
52 ;; get-setf-method.
54 ;; While it may seem intimidating for people not used to higher-order
55 ;; functions, you will quickly see that its use (especially with the
56 ;; `gv-letplace' macro) is actually much easier and more elegant than the old
57 ;; approach which is clunky and often leads to unreadable code.
59 ;; Food for thought: the syntax of places does not actually conflict with the
60 ;; pcase patterns. The `cons' gv works just like a `(,a . ,b) pcase
61 ;; pattern, and actually the `logand' gv is even closer since it should
62 ;; arguably fail when trying to set a value outside of the mask.
63 ;; Generally, places are used for destructors (gethash, aref, car, ...)
64 ;; whereas pcase patterns are used for constructors (backquote, constants,
65 ;; vectors, ...).
67 ;;; Code:
69 (require 'macroexp)
71 ;; What we call a "gvar" is basically a function of type "(getter * setter ->
72 ;; code) -> code", where "getter" is code and setter is "code -> code".
74 ;; (defvar gv--macro-environment nil
75 ;; "Macro expanders for generalized variables.")
77 (define-error 'gv-invalid-place "%S is not a valid place expression")
79 ;;;###autoload
80 (defun gv-get (place do)
81 "Build the code that applies DO to PLACE.
82 PLACE must be a valid generalized variable.
83 DO must be a function; it will be called with 2 arguments: GETTER and SETTER,
84 where GETTER is a (copyable) Elisp expression that returns the value of PLACE,
85 and SETTER is a function which returns the code to set PLACE when called
86 with a (not necessarily copyable) Elisp expression that returns the value to
87 set it to.
88 DO must return an Elisp expression."
89 (cond
90 ((symbolp place) (funcall do place (lambda (v) `(setq ,place ,v))))
91 ((not (consp place)) (signal 'gv-invalid-place (list place)))
93 (let* ((head (car place))
94 (gf (function-get head 'gv-expander 'autoload)))
95 (if gf (apply gf do (cdr place))
96 (let ((me (macroexpand-1 place
97 ;; (append macroexpand-all-environment
98 ;; gv--macro-environment)
99 macroexpand-all-environment)))
100 (if (and (eq me place) (get head 'compiler-macro))
101 ;; Expand compiler macros: this takes care of all the accessors
102 ;; defined via cl-defsubst, such as cXXXr and defstruct slots.
103 (setq me (apply (get head 'compiler-macro) place (cdr place))))
104 (if (and (eq me place) (fboundp head)
105 (symbolp (symbol-function head)))
106 ;; Follow aliases.
107 (setq me (cons (symbol-function head) (cdr place))))
108 (if (eq me place)
109 (if (and (symbolp head) (get head 'setf-method))
110 (error "Incompatible place needs recompilation: %S" head)
111 (let* ((setter (gv-setter head)))
112 (gv--defsetter head (lambda (&rest args) `(,setter ,@args))
113 do (cdr place))))
114 (gv-get me do))))))))
116 (defun gv-setter (name)
117 ;; The name taken from Scheme's SRFI-17. Actually, for SRFI-17, the argument
118 ;; could/should be a function value rather than a symbol.
119 "Return the symbol where the (setf NAME) function should be placed."
120 (if (get name 'gv-expander)
121 (error "gv-expander conflicts with (setf %S)" name))
122 ;; FIXME: This is wrong if `name' is uninterned (or interned elsewhere).
123 (intern (format "(setf %s)" name)))
125 ;;;###autoload
126 (defmacro gv-letplace (vars place &rest body)
127 "Build the code manipulating the generalized variable PLACE.
128 GETTER will be bound to a copyable expression that returns the value
129 of PLACE.
130 SETTER will be bound to a function that takes an expression V and returns
131 a new expression that sets PLACE to V.
132 BODY should return some Elisp expression E manipulating PLACE via GETTER
133 and SETTER.
134 The returned value will then be an Elisp expression that first evaluates
135 all the parts of PLACE that can be evaluated and then runs E.
137 \(fn (GETTER SETTER) PLACE &rest BODY)"
138 (declare (indent 2) (debug (sexp form body)))
139 `(gv-get ,place (lambda ,vars ,@body)))
141 ;; Different ways to declare a generalized variable.
142 ;;;###autoload
143 (defmacro gv-define-expander (name handler)
144 "Use HANDLER to handle NAME as a generalized var.
145 NAME is a symbol: the name of a function, macro, or special form.
146 HANDLER is a function which takes an argument DO followed by the same
147 arguments as NAME. DO is a function as defined in `gv-get'."
148 (declare (indent 1) (debug (sexp form)))
149 ;; Use eval-and-compile so the method can be used in the same file as it
150 ;; is defined.
151 ;; FIXME: Just like byte-compile-macro-environment, we should have something
152 ;; like byte-compile-symbolprop-environment so as to handle these things
153 ;; cleanly without affecting the running Emacs.
154 `(eval-and-compile (put ',name 'gv-expander ,handler)))
156 ;;;###autoload
157 (defun gv--defun-declaration (symbol name args handler &optional fix)
158 `(progn
159 ;; No need to autoload this part, since gv-get will auto-load the
160 ;; function's definition before checking the `gv-expander' property.
161 :autoload-end
162 ,(pcase (cons symbol handler)
163 (`(gv-expander . (lambda (,do) . ,body))
164 `(gv-define-expander ,name (lambda (,do ,@args) ,@body)))
165 (`(gv-expander . ,(pred symbolp))
166 `(gv-define-expander ,name #',handler))
167 (`(gv-setter . (lambda (,store) . ,body))
168 `(gv-define-setter ,name (,store ,@args) ,@body))
169 (`(gv-setter . ,(pred symbolp))
170 `(gv-define-simple-setter ,name ,handler ,fix))
171 ;; (`(expand ,expander) `(gv-define-expand ,name ,expander))
172 (_ (message "Unknown %s declaration %S" symbol handler) nil))))
174 ;;;###autoload
175 (or (assq 'gv-expander defun-declarations-alist)
176 (let ((x `(gv-expander
177 ,(apply-partially #'gv--defun-declaration 'gv-expander))))
178 (push x macro-declarations-alist)
179 (push x defun-declarations-alist)))
180 ;;;###autoload
181 (or (assq 'gv-setter defun-declarations-alist)
182 (push `(gv-setter ,(apply-partially #'gv--defun-declaration 'gv-setter))
183 defun-declarations-alist))
185 ;; (defmacro gv-define-expand (name expander)
186 ;; "Use EXPANDER to handle NAME as a generalized var.
187 ;; NAME is a symbol: the name of a function, macro, or special form.
188 ;; EXPANDER is a function that will be called as a macro-expander to reduce
189 ;; uses of NAME to some other generalized variable."
190 ;; (declare (debug (sexp form)))
191 ;; `(eval-and-compile
192 ;; (if (not (boundp 'gv--macro-environment))
193 ;; (setq gv--macro-environment nil))
194 ;; (push (cons ',name ,expander) gv--macro-environment)))
196 (defun gv--defsetter (name setter do args &optional vars)
197 "Helper function used by code generated by `gv-define-setter'.
198 NAME is the name of the getter function.
199 SETTER is a function that generates the code for the setter.
200 NAME accept ARGS as arguments and SETTER accepts (NEWVAL . ARGS).
201 VARS is used internally for recursive calls."
202 (if (null args)
203 (let ((vars (nreverse vars)))
204 (funcall do `(,name ,@vars) (lambda (v) (apply setter v vars))))
205 ;; FIXME: Often it would be OK to skip this `let', but in general,
206 ;; `do' may have all kinds of side-effects.
207 (macroexp-let2 nil v (car args)
208 (gv--defsetter name setter do (cdr args) (cons v vars)))))
210 ;;;###autoload
211 (defmacro gv-define-setter (name arglist &rest body)
212 "Define a setter method for generalized variable NAME.
213 This macro is an easy-to-use substitute for `gv-define-expander' that works
214 well for simple place forms.
215 Assignments of VAL to (NAME ARGS...) are expanded by binding the argument
216 forms (VAL ARGS...) according to ARGLIST, then executing BODY, which must
217 return a Lisp form that does the assignment.
218 The first arg in ARGLIST (the one that receives VAL) receives an expression
219 which can do arbitrary things, whereas the other arguments are all guaranteed
220 to be pure and copyable. Example use:
221 (gv-define-setter aref (v a i) \\=`(aset ,a ,i ,v))"
222 (declare (indent 2) (debug (&define name sexp body)))
223 `(gv-define-expander ,name
224 (lambda (do &rest args)
225 (gv--defsetter ',name (lambda ,arglist ,@body) do args))))
227 ;;;###autoload
228 (defmacro gv-define-simple-setter (name setter &optional fix-return)
229 "Define a simple setter method for generalized variable NAME.
230 This macro is an easy-to-use substitute for `gv-define-expander' that works
231 well for simple place forms. Assignments of VAL to (NAME ARGS...) are
232 turned into calls of the form (SETTER ARGS... VAL).
234 If FIX-RETURN is non-nil, then SETTER is not assumed to return VAL and
235 instead the assignment is turned into something equivalent to
236 (let ((temp VAL))
237 (SETTER ARGS... temp)
238 temp)
239 so as to preserve the semantics of `setf'."
240 (declare (debug (sexp (&or symbolp lambda-expr) &optional sexp)))
241 (when (eq 'lambda (car-safe setter))
242 (message "Use `gv-define-setter' or name %s's setter function" name))
243 `(gv-define-setter ,name (val &rest args)
244 ,(if fix-return
245 `(macroexp-let2 nil v val
246 `(progn
247 (,',setter ,@args ,v)
248 ,v))
249 ``(,',setter ,@args ,val))))
251 ;;; Typical operations on generalized variables.
253 ;;;###autoload
254 (defmacro setf (&rest args)
255 "Set each PLACE to the value of its VAL.
256 This is a generalized version of `setq'; the PLACEs may be symbolic
257 references such as (car x) or (aref x i), as well as plain symbols.
258 For example, (setf (cadr x) y) is equivalent to (setcar (cdr x) y).
259 The return value is the last VAL in the list.
261 \(fn PLACE VAL PLACE VAL ...)"
262 (declare (debug (&rest [gv-place form])))
263 (if (/= (logand (length args) 1) 0)
264 (signal 'wrong-number-of-arguments (list 'setf (length args))))
265 (if (and args (null (cddr args)))
266 (let ((place (pop args))
267 (val (car args)))
268 (gv-letplace (_getter setter) place
269 (funcall setter val)))
270 (let ((sets nil))
271 (while args (push `(setf ,(pop args) ,(pop args)) sets))
272 (cons 'progn (nreverse sets)))))
274 ;; (defmacro gv-pushnew! (val place)
275 ;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
276 ;; Presence is checked with `member'.
277 ;; The return value is unspecified."
278 ;; (declare (debug (form gv-place)))
279 ;; (macroexp-let2 macroexp-copyable-p v val
280 ;; (gv-letplace (getter setter) place
281 ;; `(if (member ,v ,getter) nil
282 ;; ,(funcall setter `(cons ,v ,getter))))))
284 ;; (defmacro gv-inc! (place &optional val)
285 ;; "Increment PLACE by VAL (default to 1)."
286 ;; (declare (debug (gv-place &optional form)))
287 ;; (gv-letplace (getter setter) place
288 ;; (funcall setter `(+ ,getter ,(or val 1)))))
290 ;; (defmacro gv-dec! (place &optional val)
291 ;; "Decrement PLACE by VAL (default to 1)."
292 ;; (declare (debug (gv-place &optional form)))
293 ;; (gv-letplace (getter setter) place
294 ;; (funcall setter `(- ,getter ,(or val 1)))))
296 ;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
297 ;; for normal expressions, and then give it a gv-expander to DTRT.
298 ;; Maybe this should really be in edebug.el rather than here.
300 ;; Autoload this `put' since a user might use C-u C-M-x on an expression
301 ;; containing a non-trivial `push' even before gv.el was loaded.
302 ;;;###autoload
303 (put 'gv-place 'edebug-form-spec 'edebug-match-form)
305 ;; CL did the equivalent of:
306 ;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
307 (put 'edebug-after 'gv-expander
308 (lambda (do before index place)
309 (gv-letplace (getter setter) place
310 (funcall do `(edebug-after ,before ,index ,getter)
311 setter))))
313 ;;; The common generalized variables.
315 (gv-define-simple-setter aref aset)
316 (gv-define-simple-setter car setcar)
317 (gv-define-simple-setter cdr setcdr)
318 ;; FIXME: add compiler-macros for `cXXr' instead!
319 (gv-define-setter caar (val x) `(setcar (car ,x) ,val))
320 (gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
321 (gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
322 (gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
323 (gv-define-setter elt (store seq n)
324 `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
325 (aset ,seq ,n ,store)))
326 (gv-define-simple-setter get put)
327 (gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
329 ;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
330 (put 'nth 'gv-expander
331 (lambda (do idx list)
332 (macroexp-let2 nil c `(nthcdr ,idx ,list)
333 (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
334 (gv-define-simple-setter symbol-function fset)
335 (gv-define-simple-setter symbol-plist setplist)
336 (gv-define-simple-setter symbol-value set)
338 (put 'nthcdr 'gv-expander
339 (lambda (do n place)
340 (macroexp-let2 nil idx n
341 (gv-letplace (getter setter) place
342 (funcall do `(nthcdr ,idx ,getter)
343 (lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
344 (setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
346 ;;; Elisp-specific generalized variables.
348 (gv-define-simple-setter default-value set-default)
349 (gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
350 (gv-define-simple-setter terminal-parameter set-terminal-parameter)
351 (gv-define-simple-setter keymap-parent set-keymap-parent)
352 (gv-define-simple-setter match-data set-match-data 'fix)
353 (gv-define-simple-setter overlay-get overlay-put)
354 (gv-define-setter overlay-start (store ov)
355 `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
356 (gv-define-setter overlay-end (store ov)
357 `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
358 (gv-define-simple-setter process-buffer set-process-buffer)
359 (gv-define-simple-setter process-filter set-process-filter)
360 (gv-define-simple-setter process-sentinel set-process-sentinel)
361 (gv-define-simple-setter process-get process-put)
362 (gv-define-simple-setter window-parameter set-window-parameter)
363 (gv-define-setter window-buffer (v &optional w)
364 (macroexp-let2 nil v v
365 `(progn (set-window-buffer ,w ,v) ,v)))
366 (gv-define-setter window-display-table (v &optional w)
367 (macroexp-let2 nil v v
368 `(progn (set-window-display-table ,w ,v) ,v)))
369 (gv-define-setter window-dedicated-p (v &optional w)
370 `(set-window-dedicated-p ,w ,v))
371 (gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v))
372 (gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v))
373 (gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v))
375 (gv-define-setter buffer-local-value (val var buf)
376 (macroexp-let2 nil v val
377 `(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
379 (gv-define-expander alist-get
380 (lambda (do key alist &optional default remove)
381 (macroexp-let2 macroexp-copyable-p k key
382 (gv-letplace (getter setter) alist
383 (macroexp-let2 nil p `(assq ,k ,getter)
384 (funcall do (if (null default) `(cdr ,p)
385 `(if ,p (cdr ,p) ,default))
386 (lambda (v)
387 (macroexp-let2 nil v v
388 (let ((set-exp
389 `(if ,p (setcdr ,p ,v)
390 ,(funcall setter
391 `(cons (setq ,p (cons ,k ,v))
392 ,getter)))))
393 (cond
394 ((null remove) set-exp)
395 ((or (eql v default)
396 (and (eq (car-safe v) 'quote)
397 (eq (car-safe default) 'quote)
398 (eql (cadr v) (cadr default))))
399 `(if ,p ,(funcall setter `(delq ,p ,getter))))
401 `(cond
402 ((not (eql ,default ,v)) ,set-exp)
403 (,p ,(funcall setter
404 `(delq ,p ,getter)))))))))))))))
407 ;;; Some occasionally handy extensions.
409 ;; While several of the "places" below are not terribly useful for direct use,
410 ;; they can show up as the output of the macro expansion of reasonable places,
411 ;; such as struct-accessors.
413 (put 'progn 'gv-expander
414 (lambda (do &rest exps)
415 (let ((start (butlast exps))
416 (end (car (last exps))))
417 (if (null start) (gv-get end do)
418 `(progn ,@start ,(gv-get end do))))))
420 (let ((let-expander
421 (lambda (letsym)
422 (lambda (do bindings &rest body)
423 `(,letsym ,bindings
424 ,@(macroexp-unprogn
425 (gv-get (macroexp-progn body) do)))))))
426 (put 'let 'gv-expander (funcall let-expander 'let))
427 (put 'let* 'gv-expander (funcall let-expander 'let*)))
429 (put 'if 'gv-expander
430 (lambda (do test then &rest else)
431 (if (or (not lexical-binding) ;The other code requires lexical-binding.
432 (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
433 ;; This duplicates the `do' code, which is a problem if that
434 ;; code is large, but otherwise results in more efficient code.
435 `(if ,test ,(gv-get then do)
436 ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
437 (let ((v (make-symbol "v")))
438 (macroexp-let2 nil
439 gv `(if ,test ,(gv-letplace (getter setter) then
440 `(cons (lambda () ,getter)
441 (lambda (,v) ,(funcall setter v))))
442 ,(gv-letplace (getter setter) (macroexp-progn else)
443 `(cons (lambda () ,getter)
444 (lambda (,v) ,(funcall setter v)))))
445 (funcall do `(funcall (car ,gv))
446 (lambda (v) `(funcall (cdr ,gv) ,v))))))))
448 (put 'cond 'gv-expander
449 (lambda (do &rest branches)
450 (if (or (not lexical-binding) ;The other code requires lexical-binding.
451 (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
452 ;; This duplicates the `do' code, which is a problem if that
453 ;; code is large, but otherwise results in more efficient code.
454 `(cond
455 ,@(mapcar (lambda (branch)
456 (if (cdr branch)
457 (cons (car branch)
458 (macroexp-unprogn
459 (gv-get (macroexp-progn (cdr branch)) do)))
460 (gv-get (car branch) do)))
461 branches))
462 (let ((v (make-symbol "v")))
463 (macroexp-let2 nil
464 gv `(cond
465 ,@(mapcar
466 (lambda (branch)
467 (if (cdr branch)
468 `(,(car branch)
469 ,@(macroexp-unprogn
470 (gv-letplace (getter setter)
471 (macroexp-progn (cdr branch))
472 `(cons (lambda () ,getter)
473 (lambda (,v) ,(funcall setter v))))))
474 (gv-letplace (getter setter)
475 (car branch)
476 `(cons (lambda () ,getter)
477 (lambda (,v) ,(funcall setter v))))))
478 branches))
479 (funcall do `(funcall (car ,gv))
480 (lambda (v) `(funcall (cdr ,gv) ,v))))))))
482 (defmacro gv-synthetic-place (getter setter)
483 "Special place described by its setter and getter.
484 GETTER and SETTER (typically obtained via `gv-letplace') get and
485 set that place. I.e. This macro allows you to do the \"reverse\" of what
486 `gv-letplace' does.
487 This macro only makes sense when used in a place."
488 (declare (gv-expander funcall))
489 (ignore setter)
490 getter)
492 (defmacro gv-delay-error (place)
493 "Special place which delays the `gv-invalid-place' error to run-time.
494 It behaves just like PLACE except that in case PLACE is not a valid place,
495 the `gv-invalid-place' error will only be signaled at run-time when (and if)
496 we try to use the setter.
497 This macro only makes sense when used in a place."
498 (declare
499 (gv-expander
500 (lambda (do)
501 (condition-case err
502 (gv-get place do)
503 (gv-invalid-place
504 ;; Delay the error until we try to use the setter.
505 (funcall do place (lambda (_) `(signal ',(car err) ',(cdr err)))))))))
506 place)
508 ;;; Even more debatable extensions.
510 (put 'cons 'gv-expander
511 (lambda (do a d)
512 (gv-letplace (agetter asetter) a
513 (gv-letplace (dgetter dsetter) d
514 (funcall do
515 `(cons ,agetter ,dgetter)
516 (lambda (v) `(progn
517 ,(funcall asetter `(car ,v))
518 ,(funcall dsetter `(cdr ,v)))))))))
520 (put 'logand 'gv-expander
521 (lambda (do place &rest masks)
522 (gv-letplace (getter setter) place
523 (macroexp-let2 macroexp-copyable-p
524 mask (if (cdr masks) `(logand ,@masks) (car masks))
525 (funcall
526 do `(logand ,getter ,mask)
527 (lambda (v)
528 (funcall setter
529 `(logior (logand ,v ,mask)
530 (logand ,getter (lognot ,mask))))))))))
532 ;;; References
534 ;;;###autoload
535 (defmacro gv-ref (place)
536 "Return a reference to PLACE.
537 This is like the `&' operator of the C language.
538 Note: this only works reliably with lexical binding mode, except for very
539 simple PLACEs such as (symbol-function \\='foo) which will also work in dynamic
540 binding mode."
541 (let ((code
542 (gv-letplace (getter setter) place
543 `(cons (lambda () ,getter)
544 (lambda (gv--val) ,(funcall setter 'gv--val))))))
545 (if (or lexical-binding
546 ;; If `code' still starts with `cons' then presumably gv-letplace
547 ;; did not add any new let-bindings, so the `lambda's don't capture
548 ;; any new variables. As a consequence, the code probably works in
549 ;; dynamic binding mode as well.
550 (eq (car-safe code) 'cons))
551 code
552 (macroexp--warn-and-return
553 "Use of gv-ref probably requires lexical-binding"
554 code))))
556 (defsubst gv-deref (ref)
557 "Dereference REF, returning the referenced value.
558 This is like the `*' operator of the C language.
559 REF must have been previously obtained with `gv-ref'."
560 (funcall (car ref)))
561 ;; Don't use `declare' because it seems to introduce circularity problems:
562 ;; Warning: Eager macro-expansion skipped due to cycle:
563 ;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
564 (gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
566 ;; (defmacro gv-letref (vars place &rest body)
567 ;; (declare (indent 2) (debug (sexp form &rest body)))
568 ;; (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap reasons!
569 ;; (gv-letplace (getter setter) place
570 ;; `(cl-macrolet ((,(nth 0 vars) () ',getter)
571 ;; (,(nth 1 vars) (v) (funcall ',setter v)))
572 ;; ,@body)))
574 (provide 'gv)
575 ;;; gv.el ends here