(comment) 
;;; Ad on page 47 of the Boston Globe, 2 June 1981

(defun ad (want-job challenging boston-area)
  (cond
   ((not (equal want-job 'yes)) nil)
   ((not (equal boston-area 'yes)) nil)
   ((lessp challenging 7) nil)
   (t (append ((defun nf (a c)
		 (cond ((null c) nil)
		       ((atom (car c))
			(append (list (eval (list 'getchar
						  (list (car c)
							'a)
						  (cadr c))))
				(nf a (cddr c))))
		       (t (append (list(implode (nf a (car c))))
				  (nf a (cdr c))))))
	       (get 'ad 'expr)
	       '((caaddr 1 caadr 2 car 1 car 1)
		 (car 5
		      cadadr
		      9
		      cadadr
		      8
		      cadadr
		      9
		      caadr
		      4
		      car
		      2
		      car
		      1)
		 (car 2 caadr 4)))
	      (list '851-5071x2661))
      )))

;;; Rest of the ad was the sentence:
;;;     "We are an affirmative action employer."

(ad 'yes 7 'yes)


;;;-----------------

;;Comments added, and code hand-grindef'd (formatted), by JonL 4 June 1981

(defun NF (a c)
   ;;'NF', for "No-Fault" programming.  Don't blame me, I'm only the coder!
   ;; 'a' is a data-base of symbolic-expressions over words;
   ;; 'c' is an instruction paradigm for selecting some letters out of
   ;;     the data-base, which are then formed into words.
   ;;Cons-free programming!!
   ;;  note how we've substituted (APPEND (LIST x) y)  for (CONS x y)
  (cond ((null c) 
	   ;; Nihil ex Nihil
	  () )
	((atom (car c))
	   ;;Now, (car c) is a selector function, like "CAADDR" which
	   ;; will be applied to our only data-base, namely the lisp code
	   ;; for the cretinous function AD.
	  (append (list (eval (list 'getchar (list (car c) 'a) (cadr c))
			 ;;(let ((carcdr-fun (car c))
			 ;;      (letter-number (cadr c)))
			 ;;  (eval `(GETCHAR (,carcdr-fun A) ,i)))
			 ;; Which means that we grab the "letter-number"'th 
			 ;; letter of the word selected by the carcdr function.
			 ;;Another way of saying the same things is
			 ;;  (GETCHAR (FUNCALL (CAR C) A) (CADR C))
		    ))
		  ;; Now we cons this letter onto the list of remaining letters
		 (nf a (cddr c))))
	(t ;;If the "Constructor-instruction" list doesn' have an instruction
	   ;; at its beginning, then it must be a list of instructions for
	   ;; building one word.  So build it (by IMPLODE) and cons it onto
	   ;; the remainder of the words to be found.
	 (append (list (implode (nf a (car c))))
		 (nf a (cdr c))))))

(defun AD (want-job challenging boston-area)
  (cond 
   ((or (not (equal want-job 'yes))
	(not (equal boston-area 'yes))
	(lessp challenging 7))
      ;;Select out the non-ambitious losers, and give them a nil.
     () )
   (t (append (nf  ;;At one time, NF was a 'local' function, and was
	           ;; DEFUN'd here.  but who needs it? 
		   ;;First argument to NF is just a 'data-base' of symbolic
		   ;; expressions;  some operations will extract letters.
		   ;; The database of letter selectors should match as follows
		   ;;  '((caaddr 1 caadr 2 car 1 car 1)
		   ;;	    C         A      L     L
		   ;;	 (car 5 cadadr 9 cadadr 8 cadadr 9 caadr 4 car 2 car 1)
		   ;;	    D      I        G        I       T       A     L
		   ;;	 (car 2 caadr 4))
		   ;;	    A      T
	          (get 'ad 'expr)
		  '((caaddr 1 caadr 2 car 1 car 1)
		    (car 5 cadadr 9 cadadr 8 cadadr 9 caadr 4 car 2 car 1)
		    (car 2 caadr 4)))
	       ;; message words get appended to telephone number list
	      (list '851-5071x2661)))))


;;A trace of the letters selected:

;(LAmbDa 	      {caLL DigitAl At} <car 1> <car 1> <car 5> <car 2> <car 2>
;    (wAnT-job	      {cAll digiTal aT} <caadr 2> <caadr 4> <caadr 4>
;	challenGIng   {call dIGItal at} <cadadr 9> <cadadr 8> <cadadr 9>
;	boston-area)
;    (Cond (...	      {Call digital at}