/[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.3 - (hide annotations)
Sun May 19 20:15:21 2002 UTC (11 years, 11 months ago) by kaz
Branch: MAIN
CVS Tags: mcvs-1-0, mcvs-0-24, mcvs-1-0-branch~merged-to-HEAD-1, mcvs-1-0-branch~merged-to-HEAD-0, mcvs-0-20, symlink-branch~branch-point, mcvs-0-22, mcvs-0-23, partial-sandbox-branch~branch-point, mcvs-0-21, old-convert-hacking-branch~branch-point, mcvs-0-95, mcvs-0-99, mcvs-0-98, mcvs-1-0-branch~branch-point, partial-sandbox-branch~merged-to-HEAD-0, mcvs-0-97, mcvs-0-96, mcvs-0-16, mcvs-1-0-11, mcvs-1-0-10, mcvs-1-0-13, mcvs-1-0-12, mcvs-0-15, mcvs-0-14, mcvs-0-17, mcvs-0-13, mcvs-0-19, mcvs-0-18, symlink-branch~merged-to-HEAD-0, mcvs-1-0-9, mcvs-1-0-8, mcvs-1-0-5, mcvs-1-0-4, mcvs-1-0-7, mcvs-1-0-6, mcvs-1-0-1, mcvs-1-0-2
Branch point for: symlink-branch, mcvs-1-0-branch, partial-sandbox-branch, old-convert-hacking-branch
Changes since 1.2: +2 -2 lines
Whitespace fix.
1 kaz 1.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 kaz 1.3 ((symbolp e)
18 kaz 1.1 `(,e (slot-value ,instance-form ',e)))
19 kaz 1.3 (t (error "with-slots-*: slot entry ~a must be a symbol." e))))
20 kaz 1.1 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 kaz 1.2 (with-slot-refs (E-1) I-1 ... ( ... (with-slot-refs (E-N) I-N F) ... ) ...)
26 kaz 1.1 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