3 ;;; Anaphoric extensions
5 ;;; (c) 2005 Straylight/Edgeware
8 ;;;----- Licensing notice ---------------------------------------------------
10 ;;; This program is free software; you can redistribute it and/or modify
11 ;;; it under the terms of the GNU General Public License as published by
12 ;;; the Free Software Foundation; either version 2 of the License, or
13 ;;; (at your option) any later version.
15 ;;; This program is distributed in the hope that it will be useful,
16 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;;; GNU General Public License for more details.
20 ;;; You should have received a copy of the GNU General Public License
21 ;;; along with this program; if not, write to the Free Software Foundation,
22 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
24 (defpackage #:anaphora
25 (:use #:common-lisp #:mdw.base))
26 (in-package #:anaphora)
31 (defmacro aif (cond then &optional else)
32 "Bind `it' to result of COND when evaluating THEN or ELSE."
34 (if it ,then ,@(and else (list else)))))
37 (defmacro aif2 (cond then &optional else)
38 "Bind `it' to first value of COND; switch on second."
40 `(multiple-value-bind (it ,tmp) ,cond
41 (declare (ignorable it))
42 (if ,tmp ,then ,@(and else (list else))))))
45 (defmacro awhen (cond &body body)
46 "Bind `it' to result of COND when evaluating BODY."
51 (defmacro awhen2 (cond &body body)
52 "Bind `it' to first value of COND; switch on second."
54 `(multiple-value-bind (it ,tmp) ,cond
55 (declare (ignorable it))
59 (defmacro aand (&rest things)
60 "Like `and', with `it' bound to previous value."
61 (labels ((foo (things)
63 `(let ((it ,(car things)))
64 (if it ,(foo (cdr things))))
71 (defmacro awhile (cond &body body)
72 "Like `while', with `it' bound to value of COND in BODY."
79 (defmacro asetf (&rest pairs)
80 "Set PLACE to value of FORM; in FORM, `it' is bound to current value of
82 `(progn ,@(do ((list nil)
83 (pairs pairs (cddr pairs)))
84 ((endp pairs) (nreverse list))
86 (error "Odd number of arguments to `asetf'."))
87 (push (with-places/gensyms ((place (car pairs)))
89 (declare (ignorable it))
90 (setf ,place ,(cadr pairs))))
94 (defmacro acond (&rest clauses)
95 "Like `cond', but in each clause the consequent has `it' bound to the value
97 (labels ((foo (clauses)
100 (clause (car clauses)))
101 `(let ((,tmp ,(car clause)))
104 (declare (ignorable it))
106 ,(foo (cdr clauses))))))))
109 ;;;----- That's all, folks --------------------------------------------------