(herald (synclo expand)                                     ; -*- T -*-
        (env t
             (synclo synclo)))

;;;;;; Syntactic closures for T
;;;;;; Syntax expander

;;; Taylor Campbell wrote this code; he places it in the public domain.

;;; Entry points

(define (syntax form env)
  (syntax* (list form) env))

(define (syntax* forms env)
  (cond ((locale? env)
         (syntax-top-level-forms forms
                                 (make-top-level-syntactic-env env)))
        ((top-level-syntactic-env? env)
         (syntax-top-level-forms forms env))
        ((syntactic-env? env)
         (syntax-form-sequence forms env))
        (else
         (syntax* forms
                  (error '("illegal syntactic env"
                           "**~10T~S")
                         env)))))

(define (syntax-top-level-forms forms env)
  (iterate loop ((forms forms) (scanned-forms '()))
    (if (null? forms)
        (output/sequence
         (reverse-map (lambda (scanned-form)
                        (expand-scanned scanned-form env))
                      scanned-forms))
        (let ((form (scan-form (car forms) env))
              (more (cdr forms)))
          (xcase (car form)
            ((DEFINITION)               ; FORM is (DEFINITION <variant>
             (let ((id (caddr form)))   ; <id> . <exp>).
               (set (syntactic-env-entry env id)
                    ;; This magic incantation will get a new top-level
                    ;; variable with a vcell from ENV's locale.
                    (env id '#t)))
             (loop more (cons form scanned-forms)))
            ((SYNTAX-DEFINITION)
             (let ((id (cadr form)))
               (set (syntactic-env-entry env id)
                    (process-transformer id (cddr form) env)))
             (loop more scanned-forms))
            ((SEQUENCE)
             (loop (append (cdr form) more)
                   scanned-forms))
            ((COMBINATION VARIABLE LITERAL SPECIAL-FORM)
             (loop more (cons form scanned-forms))))))))

(define (syntax-form-sequence forms env)
  (iterate loop ((forms forms) (expanded-forms '()))
    (if (null? forms)
        (output/sequence (reverse expanded-forms))
        (loop (cdr forms)
              (cons (expand (car forms) env)
                    expanded-forms)))))

;;; Random list-processing utility.

(define (reverse-map fn list)
  (iterate loop ((l list) (tail '()))
    (if (pair? l)
        (loop (cdr l)
              (cons (fn (car l)) tail))
        tail)))



;;; --------------------
;;; A variety of recursive descenders

;;; SCAN-FORM is used on top-level forms, where the type of the form
;;; needs to be determined before it can be descended into.  This is
;;; necessary for forward macro references to work.  It returns a pair
;;; (<type> . <data>).

(define (scan-form form env)
  (cond ((pair? form)
         (receive (keyword? operator)
                  (expand-operator (car form) env)
           (xcond ((not keyword?)
                   (if (proper-list? (cdr form))
                       (cons 'COMBINATION (cons operator (cdr form)))
                       (scan-form
                        (syntax-error
                         '("illegal combination (not a proper list)~%"
                           "**     ~S")
                         form)
                        env)))
                  ((definer-keyword? operator)
                   (receive (variant id exp)
                            (expand-definition operator form)
                     (cons 'DEFINITION
                           (cons variant (cons id exp)))))
                  ((syntax-definer-keyword? operator)
                   (receive (id exp)
                            (expand-syntax-definition operator form
                                                      env)
                     (cons 'SYNTAX-DEFINITION (cons id exp))))
                  ((sequence-keyword? operator)
                   (cons 'SEQUENCE (cdr form)))
                  ((special-form-keyword? operator)
                   (cons 'SPECIAL-FORM (cons operator (cdr form))))
                  ((transformer-keyword? operator)
                   (scan-form (operator (cons operator (cdr form))
                                        env)
                              env)))))
        ;; The identifier case must precede the syntactic closure case,
        ;; since identifiers may be themselves syntactic closures
        ;; (synthetic identifiers).
        ((identifier? form)
         (let ((denotation (syntactic-env-entry env form)))
           (if (variable? denotation)
               (cons 'VARIABLE denotation)
               (scan-form
                (syntax-error '("illegal variable reference~%"
                                "**     ~S")
                              form)
                env))))
        ((syntactic-closure? form)
         (scan-form (syntactic-closure-form form)
                    (filter-syntactic-env (syntactic-closure-env  form)
                                          (syntactic-closure-free form)
                                          env)))
        ((self-evaluating? form)
         (cons 'LITERAL form))
        (else
         (scan-form (syntax-error '("illegal top-level form~%"
                                    "**     ~S")
                                  form)
                    env))))

;;; EXPAND-SCANNED is used after scanning all of the top-level forms.
;;; It expands the first layer, which has been scanned; for anything
;;; deeper, it just uses EXPAND.  Note the absence of SEQUENCE and
;;; SYNTAX-DEFINITION from the XCASE clauses: SYNTAX-TOP-LEVEL-FORMS
;;; should have folded or processed & removed such forms, respectively.

(define (expand-scanned form env)
  (xcase (car form)                     ; (CDR FORM) is...
    ((SPECIAL-FORM)                     ;   ...the form (with keyword).
     ((cadr form) (cdr form) env))      ;
    ((DEFINITION)                       ;   ...(<type> <id> . <exp>).
     (output/definition (cadr form)     ;
                        (variable-id    ;
                         (syntactic-env-entry env (caddr form)))
                        (expand (cdddr form) env)))
    ((COMBINATION)                      ;   ...the form, whose operator
     (output/combination (cadr form)    ;    has already been expanded.
                         (map (lambda (operand-form)
                                (expand operand-form env))
                              (cddr form))))
    ((VARIABLE)                         ;   ...the variable.
     (expand-reference (cdr form)))     ;
    ((LITERAL)                          ;   ...the literal datum.
     (output/literal (cdr form)))))

;;; EXPAND is the main form expander.

(define (expand form env)
  (cond ((pair? form)
         (receive (keyword? operator)
                  (expand-operator (car form) env)
           (expand-pair form keyword? operator (cdr form) env
                        output/combination
                        (lambda (keyword form env)
                          (keyword form env))
                        expand)))
        ((identifier? form)
         (let ((denotation (syntactic-env-entry env form)))
           (if (variable? denotation)
               (expand-reference denotation)
               (expand (syntax-error '("illegal variable reference~%"
                                       "**     ~S")
                                     form)
                       env))))
        ((syntactic-closure? form)
         (expand (syntactic-closure-form form)
                 (filter-syntactic-env (syntactic-closure-env  form)
                                       (syntactic-closure-free form)
                                       env)))
        ((self-evaluating? form)
         (output/literal form))
        (else
         (expand (syntax-error '("illegal expression~%"
                                 "**     ~S")
                               form)
                 env))))

(define-integrable (expand-list list env)
  (map (lambda (subform) (expand subform env))
       list))

;;; This would be the place to insert support for internal definitions.

(define-integrable (expand-body body env)
  (if (null? (cdr body))
      (expand (car body) env)
      (output/sequence (expand-list body env))))

;;; EXPAND-OPERATOR expands a form in an operator position.  It returns
;;; two values: the first is a boolean that is true if the operator was
;;; a keyword and false if it simply expanded it; the second is the
;;; keyword if the boolean was true or the expanded output if not.

(define (expand-operator form env)
  (cond ((pair? form)
         (receive (keyword? operator)
                  (expand-operator (car form) env)
           (expand-pair form keyword? operator (cdr form) env
                        (lambda (operator operands)
                          (return '#f (output/combination operator
                                                          operands)))
                        (lambda (keyword form env)
                          (return '#f (keyword form env)))
                        expand-operator)))
        ((identifier? form)
         (let ((denotation (syntactic-env-entry env form)))
           (xcond ((variable? denotation)
                   (return '#f (expand-reference denotation)))
                  ((keyword? denotation)
                   (return '#t denotation)))))
        ((syntactic-closure? form)
         (expand-operator (syntactic-closure-form form)
                          (filter-syntactic-env
                           (syntactic-closure-env  form)
                           (syntactic-closure-free form)
                           env)))
        ((self-evaluating? form)
         (return '#f (output/literal form)))
        (else
         (expand-operator (syntax-error '("illegal expression~%"
                                          "**     ~S")
                                        form)
                          env))))

;;; EXPAND-PAIR expands a pair, dispatching on the operator type.

(define (expand-pair form keyword? operator operand-forms env
                     output/combination
                     expand-special-form
                     expand)
  (xcond ((not keyword?)
          (if (proper-list? (cdr form))
              (output/combination operator
                                  (expand-list (cdr form) env))
              (expand (syntax-error
                       '("illegal combination (not a proper list)~%"
                         "**     ~S")
                       form)
                      env)))
         ((transformer-keyword? operator)
          (expand (operator (cons operator (cdr form)) env)
                  env))
         ((special-form-keyword? operator)
          (expand-special-form operator (cons operator operand-forms)
                               env))))

;;; EXPAND-REFERENCE dispatches on the type of variable to reference &
;;; calls the respective output routine.

(define (expand-reference var)
  (let ((id (variable-id var)))
    (cond ((variable-local? var)
           (output/local-reference id))
          ((variable-vcell var)
           => (lambda (vcell)
                (output/top-level-reference id vcell)))
          (else
           (output/free-reference id)))))