]> code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/gv.el
bed9024e037b25a2bb34df1ab5861f1d616a1880
[gnu-emacs] / lisp / emacs-lisp / gv.el
1 ;;; gv.el --- generalized variables -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2012-2015 Free Software Foundation, Inc.
4
5 ;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
6 ;; Keywords: extensions
7 ;; Package: emacs
8
9 ;; This file is part of GNU Emacs.
10
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.
15
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.
20
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/>.
23
24 ;;; Commentary:
25
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) ...).
38 ;;
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.
53 ;;
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.
58
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, ...).
66
67 ;;; Code:
68
69 (require 'macroexp)
70
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".
73
74 ;; (defvar gv--macro-environment nil
75 ;; "Macro expanders for generalized variables.")
76
77 (define-error 'gv-invalid-place "%S is not a valid place expression")
78
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)))
92 (t
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))))))))
115
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)))
124
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.
136
137 \(fn (GETTER SETTER) PLACE &rest BODY)"
138 (declare (indent 2) (debug (sexp form body)))
139 `(gv-get ,place (lambda ,vars ,@body)))
140
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)))
155
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))))
173
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))
184
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)))
195
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)))))
209
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))))
226
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).
233
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))))
250
251 ;;; Typical operations on generalized variables.
252
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.
260
261 \(fn PLACE VAL PLACE VAL ...)"
262 (declare (debug (&rest [gv-place form])))
263 (if (and args (null (cddr args)))
264 (let ((place (pop args))
265 (val (car args)))
266 (gv-letplace (_getter setter) place
267 (funcall setter val)))
268 (let ((sets nil))
269 (while args (push `(setf ,(pop args) ,(pop args)) sets))
270 (cons 'progn (nreverse sets)))))
271
272 ;; (defmacro gv-pushnew! (val place)
273 ;; "Like `gv-push!' but only adds VAL if it's not yet in PLACE.
274 ;; Presence is checked with `member'.
275 ;; The return value is unspecified."
276 ;; (declare (debug (form gv-place)))
277 ;; (macroexp-let2 macroexp-copyable-p v val
278 ;; (gv-letplace (getter setter) place
279 ;; `(if (member ,v ,getter) nil
280 ;; ,(funcall setter `(cons ,v ,getter))))))
281
282 ;; (defmacro gv-inc! (place &optional val)
283 ;; "Increment PLACE by VAL (default to 1)."
284 ;; (declare (debug (gv-place &optional form)))
285 ;; (gv-letplace (getter setter) place
286 ;; (funcall setter `(+ ,getter ,(or val 1)))))
287
288 ;; (defmacro gv-dec! (place &optional val)
289 ;; "Decrement PLACE by VAL (default to 1)."
290 ;; (declare (debug (gv-place &optional form)))
291 ;; (gv-letplace (getter setter) place
292 ;; (funcall setter `(- ,getter ,(or val 1)))))
293
294 ;; For Edebug, the idea is to let Edebug instrument gv-places just like it does
295 ;; for normal expressions, and then give it a gv-expander to DTRT.
296 ;; Maybe this should really be in edebug.el rather than here.
297
298 ;; Autoload this `put' since a user might use C-u C-M-x on an expression
299 ;; containing a non-trivial `push' even before gv.el was loaded.
300 ;;;###autoload
301 (put 'gv-place 'edebug-form-spec 'edebug-match-form)
302
303 ;; CL did the equivalent of:
304 ;;(gv-define-macroexpand edebug-after (lambda (before index place) place))
305 (put 'edebug-after 'gv-expander
306 (lambda (do before index place)
307 (gv-letplace (getter setter) place
308 (funcall do `(edebug-after ,before ,index ,getter)
309 setter))))
310
311 ;;; The common generalized variables.
312
313 (gv-define-simple-setter aref aset)
314 (gv-define-simple-setter car setcar)
315 (gv-define-simple-setter cdr setcdr)
316 ;; FIXME: add compiler-macros for `cXXr' instead!
317 (gv-define-setter caar (val x) `(setcar (car ,x) ,val))
318 (gv-define-setter cadr (val x) `(setcar (cdr ,x) ,val))
319 (gv-define-setter cdar (val x) `(setcdr (car ,x) ,val))
320 (gv-define-setter cddr (val x) `(setcdr (cdr ,x) ,val))
321 (gv-define-setter elt (store seq n)
322 `(if (listp ,seq) (setcar (nthcdr ,n ,seq) ,store)
323 (aset ,seq ,n ,store)))
324 (gv-define-simple-setter get put)
325 (gv-define-setter gethash (val k h &optional _d) `(puthash ,k ,val ,h))
326
327 ;; (gv-define-expand nth (lambda (idx list) `(car (nthcdr ,idx ,list))))
328 (put 'nth 'gv-expander
329 (lambda (do idx list)
330 (macroexp-let2 nil c `(nthcdr ,idx ,list)
331 (funcall do `(car ,c) (lambda (v) `(setcar ,c ,v))))))
332 (gv-define-simple-setter symbol-function fset)
333 (gv-define-simple-setter symbol-plist setplist)
334 (gv-define-simple-setter symbol-value set)
335
336 (put 'nthcdr 'gv-expander
337 (lambda (do n place)
338 (macroexp-let2 nil idx n
339 (gv-letplace (getter setter) place
340 (funcall do `(nthcdr ,idx ,getter)
341 (lambda (v) `(if (<= ,idx 0) ,(funcall setter v)
342 (setcdr (nthcdr (1- ,idx) ,getter) ,v))))))))
343
344 ;;; Elisp-specific generalized variables.
345
346 (gv-define-simple-setter default-value set-default)
347 (gv-define-simple-setter frame-parameter set-frame-parameter 'fix)
348 (gv-define-simple-setter terminal-parameter set-terminal-parameter)
349 (gv-define-simple-setter keymap-parent set-keymap-parent)
350 (gv-define-simple-setter match-data set-match-data 'fix)
351 (gv-define-simple-setter overlay-get overlay-put)
352 (gv-define-setter overlay-start (store ov)
353 `(progn (move-overlay ,ov ,store (overlay-end ,ov)) ,store))
354 (gv-define-setter overlay-end (store ov)
355 `(progn (move-overlay ,ov (overlay-start ,ov) ,store) ,store))
356 (gv-define-simple-setter process-buffer set-process-buffer)
357 (gv-define-simple-setter process-filter set-process-filter)
358 (gv-define-simple-setter process-sentinel set-process-sentinel)
359 (gv-define-simple-setter process-get process-put)
360 (gv-define-simple-setter window-parameter set-window-parameter)
361 (gv-define-setter window-buffer (v &optional w)
362 (macroexp-let2 nil v v
363 `(progn (set-window-buffer ,w ,v) ,v)))
364 (gv-define-setter window-display-table (v &optional w)
365 (macroexp-let2 nil v v
366 `(progn (set-window-display-table ,w ,v) ,v)))
367 (gv-define-setter window-dedicated-p (v &optional w)
368 `(set-window-dedicated-p ,w ,v))
369 (gv-define-setter window-hscroll (v &optional w) `(set-window-hscroll ,w ,v))
370 (gv-define-setter window-point (v &optional w) `(set-window-point ,w ,v))
371 (gv-define-setter window-start (v &optional w) `(set-window-start ,w ,v))
372
373 (gv-define-setter buffer-local-value (val var buf)
374 (macroexp-let2 nil v val
375 `(with-current-buffer ,buf (set (make-local-variable ,var) ,v))))
376
377 (gv-define-expander alist-get
378 (lambda (do key alist &optional default remove)
379 (macroexp-let2 macroexp-copyable-p k key
380 (gv-letplace (getter setter) alist
381 (macroexp-let2 nil p `(assq ,k ,getter)
382 (funcall do (if (null default) `(cdr ,p)
383 `(if ,p (cdr ,p) ,default))
384 (lambda (v)
385 (macroexp-let2 nil v v
386 (let ((set-exp
387 `(if ,p (setcdr ,p ,v)
388 ,(funcall setter
389 `(cons (setq ,p (cons ,k ,v))
390 ,getter)))))
391 (cond
392 ((null remove) set-exp)
393 ((or (eql v default)
394 (and (eq (car-safe v) 'quote)
395 (eq (car-safe default) 'quote)
396 (eql (cadr v) (cadr default))))
397 `(if ,p ,(funcall setter `(delq ,p ,getter))))
398 (t
399 `(cond
400 ((not (eql ,default ,v)) ,set-exp)
401 (,p ,(funcall setter
402 `(delq ,p ,getter)))))))))))))))
403
404
405 ;;; Some occasionally handy extensions.
406
407 ;; While several of the "places" below are not terribly useful for direct use,
408 ;; they can show up as the output of the macro expansion of reasonable places,
409 ;; such as struct-accessors.
410
411 (put 'progn 'gv-expander
412 (lambda (do &rest exps)
413 (let ((start (butlast exps))
414 (end (car (last exps))))
415 (if (null start) (gv-get end do)
416 `(progn ,@start ,(gv-get end do))))))
417
418 (let ((let-expander
419 (lambda (letsym)
420 (lambda (do bindings &rest body)
421 `(,letsym ,bindings
422 ,@(macroexp-unprogn
423 (gv-get (macroexp-progn body) do)))))))
424 (put 'let 'gv-expander (funcall let-expander 'let))
425 (put 'let* 'gv-expander (funcall let-expander 'let*)))
426
427 (put 'if 'gv-expander
428 (lambda (do test then &rest else)
429 (if (or (not lexical-binding) ;The other code requires lexical-binding.
430 (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
431 ;; This duplicates the `do' code, which is a problem if that
432 ;; code is large, but otherwise results in more efficient code.
433 `(if ,test ,(gv-get then do)
434 ,@(macroexp-unprogn (gv-get (macroexp-progn else) do)))
435 (let ((v (make-symbol "v")))
436 (macroexp-let2 nil
437 gv `(if ,test ,(gv-letplace (getter setter) then
438 `(cons (lambda () ,getter)
439 (lambda (,v) ,(funcall setter v))))
440 ,(gv-letplace (getter setter) (macroexp-progn else)
441 `(cons (lambda () ,getter)
442 (lambda (,v) ,(funcall setter v)))))
443 (funcall do `(funcall (car ,gv))
444 (lambda (v) `(funcall (cdr ,gv) ,v))))))))
445
446 (put 'cond 'gv-expander
447 (lambda (do &rest branches)
448 (if (or (not lexical-binding) ;The other code requires lexical-binding.
449 (macroexp-small-p (funcall do 'dummy (lambda (_) 'dummy))))
450 ;; This duplicates the `do' code, which is a problem if that
451 ;; code is large, but otherwise results in more efficient code.
452 `(cond
453 ,@(mapcar (lambda (branch)
454 (if (cdr branch)
455 (cons (car branch)
456 (macroexp-unprogn
457 (gv-get (macroexp-progn (cdr branch)) do)))
458 (gv-get (car branch) do)))
459 branches))
460 (let ((v (make-symbol "v")))
461 (macroexp-let2 nil
462 gv `(cond
463 ,@(mapcar
464 (lambda (branch)
465 (if (cdr branch)
466 `(,(car branch)
467 ,@(macroexp-unprogn
468 (gv-letplace (getter setter)
469 (macroexp-progn (cdr branch))
470 `(cons (lambda () ,getter)
471 (lambda (,v) ,(funcall setter v))))))
472 (gv-letplace (getter setter)
473 (car branch)
474 `(cons (lambda () ,getter)
475 (lambda (,v) ,(funcall setter v))))))
476 branches))
477 (funcall do `(funcall (car ,gv))
478 (lambda (v) `(funcall (cdr ,gv) ,v))))))))
479
480 (defmacro gv-synthetic-place (getter setter)
481 "Special place described by its setter and getter.
482 GETTER and SETTER (typically obtained via `gv-letplace') get and
483 set that place. I.e. This macro allows you to do the \"reverse\" of what
484 `gv-letplace' does.
485 This macro only makes sense when used in a place."
486 (declare (gv-expander funcall))
487 (ignore setter)
488 getter)
489
490 (defmacro gv-delay-error (place)
491 "Special place which delays the `gv-invalid-place' error to run-time.
492 It behaves just like PLACE except that in case PLACE is not a valid place,
493 the `gv-invalid-place' error will only be signaled at run-time when (and if)
494 we try to use the setter.
495 This macro only makes sense when used in a place."
496 (declare
497 (gv-expander
498 (lambda (do)
499 (condition-case err
500 (gv-get place do)
501 (gv-invalid-place
502 ;; Delay the error until we try to use the setter.
503 (funcall do place (lambda (_) `(signal ',(car err) ',(cdr err)))))))))
504 place)
505
506 ;;; Even more debatable extensions.
507
508 (put 'cons 'gv-expander
509 (lambda (do a d)
510 (gv-letplace (agetter asetter) a
511 (gv-letplace (dgetter dsetter) d
512 (funcall do
513 `(cons ,agetter ,dgetter)
514 (lambda (v) `(progn
515 ,(funcall asetter `(car ,v))
516 ,(funcall dsetter `(cdr ,v)))))))))
517
518 (put 'logand 'gv-expander
519 (lambda (do place &rest masks)
520 (gv-letplace (getter setter) place
521 (macroexp-let2 macroexp-copyable-p
522 mask (if (cdr masks) `(logand ,@masks) (car masks))
523 (funcall
524 do `(logand ,getter ,mask)
525 (lambda (v)
526 (funcall setter
527 `(logior (logand ,v ,mask)
528 (logand ,getter (lognot ,mask))))))))))
529
530 ;;; References
531
532 ;;;###autoload
533 (defmacro gv-ref (place)
534 "Return a reference to PLACE.
535 This is like the `&' operator of the C language.
536 Note: this only works reliably with lexical binding mode, except for very
537 simple PLACEs such as (function-symbol 'foo) which will also work in dynamic
538 binding mode."
539 (let ((code
540 (gv-letplace (getter setter) place
541 `(cons (lambda () ,getter)
542 (lambda (gv--val) ,(funcall setter 'gv--val))))))
543 (if (or lexical-binding
544 ;; If `code' still starts with `cons' then presumably gv-letplace
545 ;; did not add any new let-bindings, so the `lambda's don't capture
546 ;; any new variables. As a consequence, the code probably works in
547 ;; dynamic binding mode as well.
548 (eq (car-safe code) 'cons))
549 code
550 (macroexp--warn-and-return
551 "Use of gv-ref probably requires lexical-binding"
552 code))))
553
554 (defsubst gv-deref (ref)
555 "Dereference REF, returning the referenced value.
556 This is like the `*' operator of the C language.
557 REF must have been previously obtained with `gv-ref'."
558 (funcall (car ref)))
559 ;; Don't use `declare' because it seems to introduce circularity problems:
560 ;; Warning: Eager macro-expansion skipped due to cycle:
561 ;; … => (load "gv.el") => (macroexpand-all (defsubst gv-deref …)) => (macroexpand (defun …)) => (load "gv.el")
562 (gv-define-setter gv-deref (v ref) `(funcall (cdr ,ref) ,v))
563
564 ;; (defmacro gv-letref (vars place &rest body)
565 ;; (declare (indent 2) (debug (sexp form &rest body)))
566 ;; (require 'cl-lib) ;Can't require cl-lib at top-level for bootstrap reasons!
567 ;; (gv-letplace (getter setter) place
568 ;; `(cl-macrolet ((,(nth 0 vars) () ',getter)
569 ;; (,(nth 1 vars) (v) (funcall ',setter v)))
570 ;; ,@body)))
571
572 (provide 'gv)
573 ;;; gv.el ends here