Artifact 207f0631485187de29322e390a8dd84175e4bab5f45e397491a46f6d547373ba:

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

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

% MACROEXPAND.SL - tools for expanding macros in forms
%
% 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>MACROEXPAND.SL.15,  2-Sep-82 10:32:10, Edit by BENSON
%  Fixed multiple argument SETQ macro expansion

(defmacro macroexpand (form . macros)
 `(macroexpand1 ,form (list ,@macros)))

(fluid '(macroexpand-signal*))

(de macroexpand1 (U L)
  (let ((macroexpand-signal* nil)(*macro-displace nil))
    (while (null macroexpand-signal*)
      (setq macroexpand-signal* t)
      (setq U (macroexpand2 U L))))
  U)
    
(de macroexpand2 (U L)
  (cond
    ((or (atom U) (constantp (car U))) U)
    ((eqcar (car U) 'lambda)
      `((lambda ,(cadar U) ,.(foreach V in (cddar U)
			       collect (macroexpand2 V L)))
	 ,.(foreach V in (cdr U) collect (macroexpand2 V L))))
    ((not (idp (car U))) U)
    (t
      (let ((fn (getd (car U)))(spfn (get (car U) 'macroexpand-func)))
	(cond
	  (spfn (apply spfn (list U L)))
	  ((eqcar fn 'fexpr) U)
	  ((and (eqcar fn 'macro) (or (null L) (memq (car U) L)))
	    (setq macroexpand-signal* nil)
	    (apply (cdr fn) (list U)))
	  (t
	    (cons
	      (car U)
	      (foreach  V in (cdr U) collect (macroexpand2 V L)))))))))

(de macroexpand-cond (U L)
  (cons 'cond (foreach V in (cdr U) collect
		(foreach W in V collect (macroexpand2 W L)))))

(de macroexpand-prog (U L)
  `(prog ,(cadr U) ,.(foreach V in (cddr U) collect (macroexpand2 V L))))

(de macroexpand-random (U L)
  (cons (car U) (foreach V in (cdr U) collect (macroexpand2 V L))))

(deflist '( % Should probably add a bunch more...
  (prog macroexpand-prog)
  (progn macroexpand-random)
  (cond macroexpand-cond)
  (and macroexpand-random)
  (or macroexpand-random)
  (setq macroexpand-random)
  (function macroexpand-random)
           ) 'macroexpand-func)

(de macroexpand-loop ()
  (catch 'macroexpand-loop
    `(toploop
       ',(and toploopread* #'read)
       ',#'prettyprint
       ',#'(lambda (u) (if (atom u) (throw 'macroexpand-loop) (macroexpand u)))
       "expand"
       ',(bldmsg
	   "Entering macroexpand loop (atomic input forces exit) %w..."
	   (if (and
		 toploopread*
		 (idp toploopread*)
		 (not (eq toploopread* 'read)))
	     (bldmsg "[reading with %w]" toploopread*)
	     ""))))
    (printf "... Leaving macroexpand loop."))