Artifact 086f16caf947c9f48ec79ca1e5aa553c7f1faa45d87db5fe1b34217cb7df9759:

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

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

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Association.SL - Mutable Association Lists
%
% Author:      Alan Snyder
%              Hewlett-Packard/CRC
% Date:        21 July 1982
%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

(BothTimes (load common))

(defun association-create ()
  % Create an empty association list (that is mutable!).
  (list (cons '*DUMMY* '*DUMMY*)))

(defun association-bind (alist indicator value)
  % Change or extend the ALIST to map INDICATOR to VALUE.
  (let ((pair (atsoc indicator alist)))
    (if pair
	(rplacd pair value)
	% ELSE
	(aconc alist (cons indicator value))
	(setq pair (car alist))
	(if (and (eq (car pair) '*DUMMY*)
		 (eq (cdr pair) '*DUMMY*))
	    (progn (rplacw pair (cadr alist)) (rplacd alist (cddr alist)))
	    )
	)))

(defun association-lookup (alist indicator)
  % Return the value attached to the given indicator (using EQ for
  % comparing indicators).  If there is no attached value, return NIL.

  (let ((pair (atsoc indicator alist)))
    (if pair (cdr pair) NIL)))

(defmacro map-over-association ((alist indicator-var value-var) . body)
  % Execute the body once for each indicator in the alist, binding
  % the specified indicator-var to the indicator and the specified
  % value-var to the attached value.  Return the result of the body
  % (implicit PROGN).

  `(for (in ***PAIR*** ,alist)
	(with ***RESULT***)
	(do (let ((,indicator-var (car ***PAIR***))
		  (,value-var (cdr ***PAIR***))
		  )
	      (cond ((not (eq ,indicator-var '*DUMMY*))
		     (setf ***RESULT*** (progn ,@body))
		       ))))
	(returns ***RESULT***)
	))