/[meta-cvs]/meta-cvs/F-2ED287F6C649DBFD20CE8757A9BE1DA5.lisp
ViewVC logotype

Contents of /meta-cvs/F-2ED287F6C649DBFD20CE8757A9BE1DA5.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.2 - (show annotations)
Wed Mar 20 19:17:12 2002 UTC (12 years, 1 month ago) by kaz
Branch: MAIN
CVS Tags: mcvs-0-11, mcvs-0-10, mcvs-0-12, deferred-adds-branch~branch-point
Branch point for: deferred-adds-branch
Changes since 1.1: +1 -1 lines
Docstring change.
1 ;;; This source file is part of the Meta-CVS program,
2 ;;; which is distributed under the GNU license.
3 ;;; Copyright 2002 Kaz Kylheku
4
5 (defmacro with-slot-refs ((&rest slot-entries) instance-form &body forms)
6 "A macro similar to with-slots, except that each occurence of any
7 of the bound variables newly evaluates instance-form."
8 (let ((slot-macrolets
9 (mapcar #'(lambda (e)
10 (cond
11 ((consp e)
12 (when (or (not (= (length e) 2))
13 (not (symbolp (first e)))
14 (not (symbolp (second e))))
15 (error "with-slots-*: slot entry ~a must be two symbols." e))
16 `(,(first e) (slot-value ,instance-form ',(second e))))
17 ((symbolp e)
18 `(,e (slot-value ,instance-form ',e)))
19 (t (error "with-slots-*: slot entry ~a must be a symbol." e))))
20 slot-entries)))
21 `(symbol-macrolet ,slot-macrolets ,@forms)))
22
23 (defmacro with-multi-slot-refs ((&rest refs) &body forms)
24 "Allows nested slot-shorthand invocations to be collapsed. That is:
25 (with-slot-refs (E-1) I-1 ... ( ... (with-slot-refs (E-N) I-N F) ... ) ...)
26 can be rewritten:
27 (with-slot-refs-* ((E-1) I1 ... (E-N) V-N) F)"
28 (let (refs-pairs (expansion forms))
29 (do ((entries (pop refs) (pop refs))
30 (instance (pop refs) (pop refs)))
31 ((null entries))
32 (push (list entries instance) refs-pairs))
33 (if (null refs-pairs)
34 `(progn ,@expansion)
35 (dolist (refs-pair refs-pairs (first expansion))
36 (setf expansion `((with-slot-refs ,@refs-pair ,@expansion)))))))
37

  ViewVC Help
Powered by ViewVC 1.1.5