File psl-1983/util/association.sl artifact 086f16caf9 part of check-in 6f3f9aca4c


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% 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***)
	))


REDUCE Historical
REDUCE Sourceforge Project | Historical SVN Repository | GitHub Mirror | SourceHut Mirror | NotABug Mirror | Chisel Mirror | Chisel RSS ]