Artifact 124e1f6a592839904eb69dd8574d3604a55447a564812a68ee301dd72cb8354a:

• File psl-1983/3-1/util/bind-macros.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1532) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/bind-macros.sl — part of check-in [eb17ceb7f6] at 2020-04-21 19:40:01 on branch master — Add Reduce 3.0 to the historical section of the archive, and some more
  files relating to version sof PSL from the early 1980s. Thanks are due to
  Paul McJones and Nelson Beebe for these, as well as to all the original
  authors.

  git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/historical@5328 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 1532) [annotate] [blame] [check-ins using]

%
% BIND-MACROS.SL - convenient macros for binding variables
%
% Author:      Don Morrison
%	       Symbolic Computation Group
%              Computer Science Dept.
%              University of Utah
% Date:        Wednesday, 12 May 1982
% Copyright (c) 1981 University of Utah

% <PSL.UTIL>BIND-MACROS.SL.2, 18-Oct-82 14:31:17, Edit by BENSON
% Reversed vars and vals after collecting them in LET, so that the order
%  of things in the LAMBDA is the same as the LET.  Not necessary,
%  but it makes it easier to follow macroexpanded things.

(defmacro prog1 (first . body)
  (if (null body)
    first
    `((lambda (***PROG1-VAR***) ,@body ***PROG1-VAR***) ,first)))

(defmacro let (specs . body)
 (if (null specs)
   (cond
     ((null body) nil)
     ((and (pairp body) (null (cdr body))) (car body))
     (t `(progn ,@body)))
   (prog (vars vals)
     (foreach U in specs do
       (cond ((atom U)
	       (setq vars (cons U vars))
	       (setq vals (cons nil vals)))
	 (t
	   (setq vars (cons (car U) vars))
	   (setq vals (cons (and (cdr U) (cadr U)) vals)))))
     (return `((lambda ,(reversip vars) ,@body ) ,@(reversip vals))))))

(defmacro let* (specs . body)
 (if (null specs)
   (cond
     ((null body) nil)
     ((and (pairp body) (null (cdr body))) (car body))
     (t `(progn ,@body)))
   (let*1 specs body)))

(de let*1 (specs body)
 (let ((s (car specs))(specs (cdr specs)))
  `((lambda (,(if (atom s) s (car s)))
      ,@(if specs (list (let*1 specs body)) body))
    ,(if (and (pairp s) (cdr s)) (cadr s) nil))))