
UNITED STATES OF AMERICA

Department of Mental Hygiene

Office of the Sturgeon General


       To:   Dr. Kook (eyes only)
       From: Nap Olean, in protective custody
       Date: 5 April 1993
       Re:   Macrology

       The following is a particularly addictive and dangerous idea from the
       world of computer-language interpreters.  This specimen was collected
       at the Massachusetts Institute of Technology.  We may have to
       quarantine that place.

       ;;; We make syntactic extensions to the language by introducing new
       ;;; special forms.  DEFINE-MACRO is a new special form intended to
       ;;; give the user an automatic way of easily defining a limited class 
       ;;; of his own new special forms.  The user specifies his special form
       ;;; by writing a macro.  The macro has a pattern and a template.
       ;;; The pattern has the keyword for the new special form in the
       ;;; operator position.  When the evaluator encounters the new keyword
       ;;; in evaluation, it substitutes the expressions matching the other
       ;;; slotnames in the pattern for the instances of those slotnames in
       ;;; the template and then executes the instantiated template.

       ;;; For example, to define the special form IF in terms of the special
       ;;; form COND one could write:

       ;;;  (define-macro (if predicate consequent alternative)
       ;;;    (cond (predicate consequent)
       ;;;          (else alternative)))

       ;;; To allow users to make such definitions of syntactic forms we
       ;;; supply the following implementation of the DEFINE-MACRO form.

       (define (eval-macro-definition definition-expression useless-env)
	 (let ((keyword (caadr definition-expression))
	       (slotnames (cdadr definition-expression))
	       (template (caddr definition-expression)))
	   (define (expander exp env)
	     (mini-eval (substitute (cdr exp) slotnames template)
			env))
	   (add-syntax! keyword expander)
	   'done))

       (add-syntax! 'define-macro eval-macro-definition)

       (define (substitute expressions slotnames template)
	 (define (walk template)
	   (if (pair? template)
	       (cons (walk (car template)) (walk (cdr template)))
	       (let ((vcell (2-rail-lookup template slotnames expressions)))
		 (if vcell (car vcell) template))))
	 (walk template))

       (define (2-rail-lookup key keys values)
	 (cond ((null? keys) false)
	       ((eq? key (car keys)) values)
	       (else (2-rail-lookup key (cdr keys) (cdr values)))))
