quasiquote implementation

[Kent Dybvig <dyb%indiana.csnet@CSNET-RELAY.ARPA>]

Back when JAR first suggested making quasiquote standard, I transcribed
my quasiquote implementation from the C-coded reader into Scheme-coded
syntactic-extensions.  I promised to send the code to David Bartley at
TI and figured some of the rest of you might be interested as well.

I believe that this gives different results from JAR's, because it can
actually fold up explicit calls to "list" and "list*" (for better or for
worse).  It also insists that quasiquote, unquote, and unquote-splice
forms be well-formed, rather than ignoring those that aren't.  As with
JAR's, nested quasiquotes work properly.

Because quasiquote and company are expanded at compile time rather than
read time, it is reasonable to write code that produces quasiquote forms.  

"list*" (Common Lisp's name) is the same as JAR's "cons*".  The meaning
of everything else should be obvious.

(let ((check
         (lambda (x)
            (unless (and (pair? (cdr x)) (null? (cddr x)))
               (ferror (car x) "invalid form ~s" x)))))
   (define-macro! quasiquote (x)
      (recur f ((x x))
         (cond
            ((not (pair? x)) `',x)
            ((eq? (car x) 'quasiquote) (check x) (f (f (cadr x))))
            ((eq? (car x) 'unquote) (check x) (cadr x))
            ((eq? (car x) 'unquote-splice)
             (ferror 'unquote-splice "invalid context for ~s" x))
            ((and (pair? (car x)) (eq? (caar x) 'unquote-splice))
             (check (car x))
             (let ((d (f (cdr x))))
                (if (equal? d '(quote ()))
                    (cadar x)
                    `(append ,(cadar x) ,d))))
            (else
             (let ((a (f (car x))) (d (f (cdr x))))
                (if (pair? d)
                    (if (eq? (car d) 'quote)
                        (if (and (pair? a) (eq? (car a) 'quote))
                            `'(,(cadr a) . ,(cadr d))
                            (if (null? (cadr d))
                                `(list ,a)
                                `(list* ,a ,d)))
                        (if (memq (car d) '(list list*))
                            `(,(car d) ,a ,@(cdr d))
                            `(list* ,a ,d)))
                   `(list* ,a ,d))))))))

(define-macro! unquote (x)
   (ferror 'unquote
      "unquote form ,~s not valid outside of quasiquote"
      x))

(define-macro! unquote-splice (x)
   (ferror 'unquote
      "unquote-splice form ,@~s not valid outside of quasiquote"
      x))