Artifact e477afa82993fcde9e297154c27de0a4f3671d0d9020aaf2fa879f5c4079f1ba:

• File psl-1983/3-1/util/iter-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: 3131) [annotate] [blame] [check-ins using] [more...]

• File psl-1983/util/iter-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: 3131) [annotate] [blame] [check-ins using]

% ITER-MACROS.SL - macros for generalized iteration
%
% 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>ITER-MACROS.SL.9, 15-Sep-82 17:06:49, Edit by BENSON
% Fixed typo, ((null (cdr result) nil)) ==> ((null (cdr result)) nil)

(defmacro do (iterators result . body)
  (let (vars steps)
    (setq vars
      (foreach U in iterators collect
	(if (and (pairp U) (cdr U) (cddr U))
	  (progn
	    (setq steps (cons
			  (if (atom (car U)) (car U) (caar U))
			  (cons (caddr U) steps)))
	    (list (car U) (cadr U)))
	  U)))
    (let ((form `(prog ()
		   ***DO-LABEL***
		   (cond
		     (,(car result)
		       (return ,(cond
				  ((null (cdr result)) nil)
				  ((and
				     (pairp (cdr result))
				     (null (cddr result)))
				    (cadr result))
				  (t `(progn ,@(cdr result)))))))
		   ,@body
		   (psetq ,.steps)
		   (go ***DO-LABEL***))))
      (if vars `(let ,vars ,form) form))))

(defmacro do* (iterators result . body)
  (let (vars steps)
    (setq vars
      (foreach U in iterators collect
	(if (and (pairp U) (cdr U) (cddr U))
	  (progn
	    (push
	      `(setq ,(if (atom (car U)) (car U) (caar U)) ,(caddr U))
	      steps)
	    (list (car U) (cadr U)))
	  U)))
    (let ((form `(prog ()
		   ***DO-LABEL***
		   (cond
		     (,(car result)
		       (return ,(cond
				  ((null (cdr result)) nil)
				  ((and
				     (pairp (cdr result))
				     (null (cddr result)))
				    (cadr result))
				  (t `(progn ,@(cdr result)))))))
		   ,@body
		   ,.(reversip steps)
		   (go ***DO-LABEL***))))
      (if vars `(let* ,vars ,form) form))))

(defmacro do-loop (iterators prologue result . body)
  (let (vars steps)
    (setq vars
      (foreach U in iterators collect
	(if (and (pairp U) (cdr U) (cddr U))
	  (progn
	    (setq steps (cons
			  (if (atom (car U)) (car U) (caar U))
			  (cons (caddr U) steps)))
	    (list (car U) (cadr U)))
	  U)))
    (let ((form `(prog ()
		   ,@prologue
		   ***DO-LABEL***
		   (cond
		     (,(car result)
		       (return ,(cond
				  ((null (cdr result)) nil)
				  ((and
				     (pairp (cdr result))
				     (null (cddr result)))
				    (cadr result))
				  (t `(progn ,@(cdr result)))))))
		   ,@body
		   (psetq ,.steps)
		   (go ***DO-LABEL***))))
      (if vars `(let ,vars ,form) form))))

(defmacro do-loop* (iterators prologue result . body)
  (let (vars steps)
    (setq vars
      (foreach U in iterators collect
	(if (and (pairp U) (cdr U) (cddr U))
	  (progn
	    (push
	      `(setq ,(if (atom (car U)) (car U) (caar U)) ,(caddr U))
	      steps)
	    (list (car U) (cadr U)))
	  U)))
    (let ((form `(prog ()
		   ,@prologue
		   ***DO-LABEL***
		   (cond
		     (,(car result)
		       (return ,(cond
				  ((null (cdr result)) nil)
				  ((and
				     (pairp (cdr result))
				     (null (cddr result)))
				    (cadr result))
				  (t `(progn ,@(cdr result)))))))
		   ,@body
		   ,.(reversip steps)
		   (go ***DO-LABEL***))))
      (if vars `(let* ,vars ,form) form))))