1%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 2% 3% File: PU:BIND-MACROS.SL 4% Description: convenient macros for binding variables 5% Author: Don Morrison, Hewlett-Packard CRC 6% Created: Wednesday, 12 May 1982 7% Modified: 9 May 1984 2056-PDT (Nancy Kendzierski) 8% Status: Open Source: BSD License 9% Mode: Lisp 10% Package: Utilities 11% Compiletime: PL:BACKQUOTE.B PL:READ-MACROS.B PL:DEFMACRO.B PL:COND-MACROS.B 12% Runtime: 13% 14% (c) Copyright 1983, Hewlett-Packard Company, see the file 15% HP_disclaimer at the root of the PSL file tree 16% 17% (c) Copyright 1982, University of Utah 18% 19% Redistribution and use in source and binary forms, with or without 20% modification, are permitted provided that the following conditions are met: 21% 22% * Redistributions of source code must retain the relevant copyright 23% notice, this list of conditions and the following disclaimer. 24% * Redistributions in binary form must reproduce the above copyright 25% notice, this list of conditions and the following disclaimer in the 26% documentation and/or other materials provided with the distribution. 27% 28% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 29% AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, 30% THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR 31% PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNERS OR 32% CONTRIBUTORS 33% BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR 34% CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF 35% SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS 36% INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 37% CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 38% ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 39% POSSIBILITY OF SUCH DAMAGE. 40% 41%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 42% 43% Revisions: 44% 45% 6 May 1984 1640-PDT (Nancy Kendzierski) 46% Changed compiletime loads requirements to allow separate compilation of 47% USEFUL modules. 48% 09-Feb-84 15:37:52 (Cris Perdue) 49% Added compiletime load useful so this can be compiled by itself. 50% 19 Jan 1984 1429-PST (Brian Beach) 51% Added standard header. 52% 18-Oct-82 14:31:17, Edit by BENSON 53% Reversed vars and vals after collecting them in LET, so that the order 54% of things in the LAMBDA is the same as the LET. Not necessary, 55% but it makes it easier to follow macroexpanded things. 56% 57%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% 58 59(compiletime (load backquote read-macros defmacro cond-macros)) 60 61(defmacro prog1 (first . body) 62 (if (null body) 63 first 64 `((lambda (***PROG1-VAR***) ,@body ***PROG1-VAR***) ,first))) 65 66(defmacro let (specs . body) 67 (if (null specs) 68 (cond 69 ((null body) nil) 70 ((and (pairp body) (null (cdr body))) (car body)) 71 (t `(progn ,@body))) 72 (prog (vars vals) 73 (foreach U in specs do 74 (cond ((atom U) 75 (setq vars (cons U vars)) 76 (setq vals (cons nil vals))) 77 (t 78 (setq vars (cons (car U) vars)) 79 (setq vals (cons (and (cdr U) (cadr U)) vals))))) 80 (return `((lambda ,(reversip vars) ,@body ) ,@(reversip vals)))))) 81 82(defmacro let* (specs . body) 83 (if (null specs) 84 (cond 85 ((null body) nil) 86 ((and (pairp body) (null (cdr body))) (car body)) 87 (t `(progn ,@body))) 88 (let*1 specs body))) 89 90(de let*1 (specs body) 91 (let ((s (car specs))(specs (cdr specs))) 92 `((lambda (,(if (atom s) s (car s))) 93 ,@(if specs (list (let*1 specs body)) body)) 94 ,(if (and (pairp s) (cdr s)) (cadr s) nil)))) 95 96