(define-record-type syntax-wrap
  (make-syntax-wrap* wrapped-exp pending-substs pending-marks)
  syntax-wrap?
  (wrapped-exp syntax-wrap-wrapped-exp*)
  (pending-substs syntax-wrap-pending-substs*)
  (pending-marks syntax-wrap-pending-marks*))

(define-record-type syntax-substitution
  (make-syntax-substitution old-sym old-marks new-sym)
  syntax-substitution?
  (old-sym syntax-substitution-old-sym)
  (old-marks syntax-substitution-old-marks)
  (new-sym syntax-substitution-new-sym))

(define (syntax-wrap-wrapped-exp x)
  (if (syntax-wrap? x)
      (syntax-wrap-wrapped-exp* x)
      x))

(define (syntax-wrap-pending-substs x)
  (if (syntax-wrap? x)
      (syntax-wrap-pending-substs* x)
      '()))

(define (syntax-wrap-pending-marks x)
  (if (syntax-wrap? x)
      (syntax-wrap-pending-marks* x)
      '()))

(define (identifier? x)
  (symbol? (syntax-wrap-wrapped-exp x)))

(define (syntax-pair? x)
  (pair? (syntax-wrap-wrapped-exp x)))

(define (bound-identifier=? x y)
  (and (eq? (syntax-wrap-wrapped-exp x)
	    (syntax-wrap-wrapped-exp y))
       (lset= =
	      (syntax-wrap-pending-marks x)
	      (syntax-wrap-pending-marks y))))

(define (free-identifier=? x y)
  (and (eq? (syntax-wrap-wrapped-exp x)
	    (syntax-wrap-wrapped-exp y))
       (eq? (resolve x)
	    (resolve y))))

;; Future: Will probably need literal-identifier=? (see the psyntax
;; documentation) once we sprout a module system

(define make-syntax-wrap
  (letrec ((exp-checker (lambda (x) (not (syntax-wrap? x))))
	   (marks-checker (list-of-type number?))
	   (substs-checker (lambda (x)
			     (or (null? x)
				 (syntax-substitution? x)
				 (and (pair? x)
				      (or (and (eq? (car x) 'mark)
					       (every number? (cadr x))
					       (null? (cdddr x))
					       (substs-checker (caddr x)))
					  (and (substs-checker (car x))
					       (substs-checker (cdr x)))))))))
    (lambda (exp substs marks)
      (if (and (exp-checker exp)
	       (substs-checker substs)
	       (marks-checker marks))
	  (make-syntax-wrap* exp substs marks)
	  (error "Illegal argument supplied to make-syntax-wrap"
		 (list exp substs marks))))))

(define (syntax-error message stx . more)
  (apply error message (syntax-object->datum stx) stx more))

(define wrap-stx
  (let ()
    (define (mark-substitutions substs marks)
      (cond
       ((or (null? marks)
	    (null? substs))
	substs)
       ((and (pair? substs)
	     (eq? (car substs) 'mark))
	(mark-substitutions (caddr substs) (lset-xor = marks (cadr substs))))
       (else
	(list 'mark marks substs))))
    (define (merge-pending-substs substs-new substs-old)
      (cond ((null? substs-new) substs-old)
	    ((null? substs-old) substs-new)
	    ;; New before old!
	    (else (cons substs-new substs-old))))
    (define (merge-pending-marks marks1 marks2)
      (lset-xor = marks1 marks2))
    (lambda (stx wrap)
      (if (syntax-wrap? wrap)
	  (let ((exp (syntax-wrap-wrapped-exp stx)))
	    (if (syntax-wrap? exp)
		(error "Invariant violated: wrapped expression must not be a wrap"
		       stx wrap)
		(make-syntax-wrap exp
				  (merge-pending-substs (syntax-wrap-pending-substs wrap)
							(mark-substitutions
							 (syntax-wrap-pending-substs stx)
							 (syntax-wrap-pending-marks wrap)))
				  (merge-pending-marks (syntax-wrap-pending-marks wrap)
						       (syntax-wrap-pending-marks stx)))))
	  stx))))

(define (expose stx)
  (let ((exp (syntax-wrap-wrapped-exp stx)))
    (cond
     ((pair? exp) (cons (wrap-stx (car exp) stx)
			(wrap-stx (cdr exp) stx)))
     (else exp))))

(define (syntax-pair-fields p k k-nonpair)
  (let ((exp (syntax-wrap-wrapped-exp p)))
    (if (pair? exp)
	(k (wrap-stx (car exp) p)
	   (wrap-stx (cdr exp) p))
	(k-nonpair exp))))

(define (syntax-null? x)
  (null? (syntax-wrap-wrapped-exp x)))

(define (mark datum m)
  (wrap-stx datum (make-syntax-wrap* '()
				     '()
				     (list m))))

(define (resolve stx)
  (let ((sym (syntax-wrap-wrapped-exp stx)))
    (let search-substs ((substitution (syntax-wrap-pending-substs stx))
			(marks (syntax-wrap-pending-marks stx))
			(k-fail (lambda () sym)))
      (cond
       ((null? substitution) (k-fail))
       ((syntax-substitution? substitution)
	(if (and (eq? sym (syntax-substitution-old-sym substitution))
		 (lset= = marks (syntax-substitution-old-marks substitution)))
	    (syntax-substitution-new-sym substitution)
	    (k-fail)))
       ((pair? substitution)
	(if (eq? (car substitution) 'mark)
	    (let ((modified-marks (lset-xor = marks (cadr substitution))))
	      (search-substs (caddr substitution) modified-marks k-fail))
	    (search-substs (car substitution)
			   marks
			   (lambda ()
			     (search-substs (cdr substitution) marks k-fail)))))
       (else (error "Internal error in expander: invalid substitution environment"
		    substitution))))))

(define (subst datum id-sym-map)
  (wrap-stx datum (make-syntax-wrap* '()
				     id-sym-map
				     '())))

(define (syntax-object->datum datum)
  (let ((exp (syntax-wrap-wrapped-exp datum)))
    (cond
     ((pair? exp)
      (cons (syntax-object->datum (car exp))
	    (syntax-object->datum (cdr exp))))
     ((vector? exp)
      (list->vector (map syntax-object->datum (vector->list exp))))
     (else exp))))

(define (syntax->list datum)
  (let loop ((x datum))
    (syntax-pair-fields x
      (lambda (a d) (cons a (loop d)))
      (lambda (exp) exp))))

(define (make-global-identifier name) name)

(define (datum->syntax-object id-or-false datum)
  (cond
   ((syntax-wrap? id-or-false)
    (if (not (symbol? (syntax-wrap-wrapped-exp id-or-false)))
	(error "datum->syntax-object: needs an identifier to clone"
	       id-or-false datum)
	(wrap-stx datum id-or-false)))
   ((or (symbol? id-or-false)
	(not id-or-false))
    datum)
   (else (error "datum->syntax-object: needs an identifier, or false"
		id-or-false datum))))

(define (initial-eenv)
  `((quote special . quote)
    (lambda special . lambda)
    (plambda special . plambda)
    (syntax special . syntax)
    (let-syntax special . let-syntax)
    (letrec-syntax special . letrec-syntax)
    (syntax-case special . syntax-case)
    (begin special . begin)
    (if special . if)
    (define special . define)
    (set! special . set!)))

(define expand
  (let ()
    (define (illegal-use-of-pattern-variable stx)
      (syntax-error "use of pattern-variable in expression context" stx))

    (define make-fresh-sym gensym)

    (define make-fresh-mark
      (let ((counter 0))
	(lambda ()
	  (let ((result counter))
	    (set! counter (+ counter 1))
	    result))))

    (define (maybe-make-begin exprs)
      (if (and (pair? exprs)
	       (null? (cdr exprs)))
	  (car exprs)
	  (make-begin exprs)))

    (define (eenv-bind sym kind value eenv)
      (alist-cons sym (cons kind value)
		  eenv))

    (define (eenv-lookup sym eenv k)
      (cond
       ((assq sym eenv) =>
	(lambda (cell)
	  (let ((kind (cadr cell))
		(denoted-value (cddr cell)))
	    (if (not (memq kind '(variable pattern-variable transformer id-transformer special)))
		(error "illegal denoted-value kind in eenv-lookup" sym kind denoted-value))
	    (k kind denoted-value))))
       (else
	(k 'variable 'no-sensible-value-for-unbound-global-variables))))

    (define (syntax-list-map fn synlist)
      (let loop ((x synlist))
	(syntax-pair-fields x
	  (lambda (a d) (cons (fn a) (loop d)))
	  (lambda (exp) exp))))

    (define (expand-variable resolved-name)
      (make-variable resolved-name))

    (define (expand-symbolic-data value)
      (make-symbolic-data value))

    (define (expand-syntax-data exp)
      (make-symbolic-data exp))

    (define (perform-macro-application transformer tail)
      (let ((m (make-fresh-mark)))
	(mark (transformer (mark tail m)) m)))

    (define (make-fresh-subst-map identifiers)
      (map (lambda (id) (make-syntax-substitution (syntax-wrap-wrapped-exp id)
						  (syntax-wrap-pending-marks id)
						  (make-fresh-sym)))
	   identifiers))

    (define (expand-body body-forms-synlist outer-substitution-map eenv)
      (define (expand-until-non-macro-application stx)
	(let ((exp (expose stx)))
	  (if (pair? exp)
	      (if (identifier? (car exp))
		  (eenv-lookup (resolve (car exp)) eenv
		    (lambda (kind denoted-value)
		      (case kind
			((special) (case denoted-value
				     ((define) (cons #t (cdr exp)))
				     (else (cons #f exp))))
			((transformer) (expand-until-non-macro-application
					(perform-macro-application denoted-value exp)))
			((id-transformer) (expand-until-non-macro-application
					   (cons (perform-macro-application denoted-value (car exp))
						 (cdr exp))))
			(else (cons #f exp)))))
		  (let* ((head-stx (cdr (expand-until-non-macro-application (car exp))))
			 (result (cons head-stx (cdr exp))))
		    (if (identifier? head-stx)
			(expand-until-non-macro-application result)
			(cons #f result))))
	      (cons #f stx))))
      (define (parse-define exposed-def-and-rest)
	(syntax-pair-fields exposed-def-and-rest
	  (lambda (definition rest)
	    (syntax-pair-fields definition
	      (lambda (def-name def-args)
		(cons def-name (cons (make-global-identifier 'lambda) (cons def-args rest))))
	      (lambda (def-name)
		(if (symbol? def-name)
		    (cons definition (syntax-pair-fields rest
				       (lambda (a d) a)
				       (lambda (_) (syntax-error "Missing body in definition"
								 definition))))
		    (syntax-error "Definition must be variable or function def"
				  definition rest)))))
	  (lambda (_) (syntax-error "Illegal syntax for definition" exposed-def-and-rest))))
      (define (collect-defs defs elements)
	(cond
	 ((null? elements) (syntax-error "No expression in body"))
	 ((caar elements) (collect-defs (cons (parse-define (cdar elements)) defs)
					(cdr elements)))
	 (else (process-body defs (map (lambda (element)
					 (if (car element)
					     (syntax-error "Define only valid at start of block"
							   (cdr element))
					     (cdr element)))
				       elements)))))
      (define (process-body defs forms)
	(if (null? defs)
	    (maybe-make-begin (map (lambda (form) (expand form eenv)) forms))
	    (let* ((substitution-map (make-fresh-subst-map (map car defs)))
		   (new-eenv (fold (lambda (substitution acc-eenv)
				     (eenv-bind (syntax-substitution-new-sym substitution)
						'variable
						'no-sensible-value-for-letrecs
						acc-eenv))
				   eenv
				   substitution-map))
		   (expand* (lambda (form) (expand (subst form substitution-map) new-eenv))))
	      (make-letrec (map syntax-substitution-new-sym substitution-map)
			   (map (lambda (def) (expand* (cdr def))) defs)
			   (maybe-make-begin (map expand* forms))))))
      (let* ((substed-forms (syntax-list-map (lambda (bodyexp)
					       (subst bodyexp outer-substitution-map))
					     body-forms-synlist))
	     (body-elements (map expand-until-non-macro-application substed-forms)))
	(collect-defs '() body-elements)))

    ;;(trace expand-body)

    (lambda (stx0 eenv)
      (define (expand-application headstx tailstx)
	(make-application (expand-internal headstx)
			  (syntax-list-map expand-internal tailstx)))

      (define (expand-object-or-syntax-function formals bodystx)
	(let* ((substitution-map (make-fresh-subst-map (map car formals)))
	       (new-names (map syntax-substitution-new-sym substitution-map))
	       (new-eenv (fold (lambda (new-name entry eenv)
				 (eenv-bind new-name
					    (cadr entry)
					    (caddr entry)
					    eenv))
			       eenv
			       new-names
			       formals)))
	  (make-function new-names (expand-body bodystx substitution-map new-eenv))))

      (define (expand-function formals body)
	(expand-object-or-syntax-function
	 (syntax-list-map (lambda (formal)
			    (list formal
				  'variable
				  'no-sensible-value-for-lexicals))
			  formals)
	 body))

      (define (expand-pfunction formals body)
	(expand-object-or-syntax-function
	 (syntax-list-map (lambda (formal)
			    (apply (lambda (formal-id formal-level)
				     (list formal-id
					   'pattern-variable
					   (syntax-object->datum formal-level)))
				   (syntax->list formal)))
			  formals)
	 body))

      (define (expand-macro transformer stx)
	(expand-internal (perform-macro-application transformer stx)))

      (define (expand-syntax-binding is-recursive bindings-synlist body)
	(let* ((bindings-list (syntax-list-map syntax->list bindings-synlist))
	       (substitution-map (make-fresh-subst-map (map car bindings-list)))
	       (new-eenv (fold (lambda (binding substitution acc-eenv)
				 (let* ((name (syntax-substitution-new-sym substitution))
					(unexpanded (if is-recursive
							(subst (cadr binding) substitution-map)
							(cadr binding)))
					(transformer (parsed-exp-eval
						      (expand-internal unexpanded))))
				   (cond
				    ((and (pair? transformer)
					  (eq? (car transformer) 'macro!)
					  (procedure? (cdr transformer)))
				     (eenv-bind name 'id-transformer (cdr transformer) acc-eenv))
				    ((procedure? transformer)
				     (eenv-bind name 'transformer transformer acc-eenv))
				    (else (syntax-error "Invalid transformer in macro binding"
							binding)))))
			       eenv
			       bindings-list
			       substitution-map)))
	  (expand-body body substitution-map new-eenv)))

      (define (expand-begin body)
	(maybe-make-begin (syntax-list-map expand-internal body)))

      (define (expand-if exp testsyn branches-synlist)
	(let ((branches (syntax->list branches-synlist)))
	  (case (length branches)
	    ((0) (syntax-error "if needs at least one branch" exp))
	    ((1 2) 'ok)
	    (else (syntax-error "if needs two or fewer alternative branches" exp)))
	  (make-if (expand-internal testsyn)
		   (expand-internal (car branches))
		   (if (null? (cdr branches))
		       (make-symbolic-data #f)
		       (expand-internal (cadr branches))))))

      (define (expand-set! exp id rest)
	(if (not (identifier? id))
	    (syntax-error "set!: needs identifier to set" exp)
	    (let ((resolved-id (resolve id)))
	      (eenv-lookup resolved-id eenv
		(lambda (kind denoted-value)
		  (case kind
		    ((special) (syntax-error "use of special form identifier in set!" exp))
		    ((transformer) (syntax-error "use of macro-transformer identifier in set!" exp))
		    ((id-transformer) (expand-macro denoted-value exp))
		    ((pattern-variable) (illegal-use-of-pattern-variable exp))
		    ((variable)
		     (make-set resolved-id
			       (expand-internal (syntax-pair-fields rest
						  (lambda (a d)
						    (if (syntax-null? d)
							a
							(syntax-error "too many expressions in set!"
								      id rest)))
						  (lambda (_)
						    (syntax-error "missing expression in set!"
								  id rest))))))))))))

      (define (expand-literal-syntax-identifier name resolved-id marks)
	(make-application
	 (make-variable 'make-syntax-wrap)
	 (list (make-symbolic-data name)
	       (if (eq? name resolved-id)
		   (make-symbolic-data '())
		   (make-application
		    (make-variable 'list)
		    (list (make-application
			   (make-variable 'make-syntax-substitution)
			   (list (make-symbolic-data name)
				 (make-symbolic-data marks)
				 (make-symbolic-data resolved-id))))))
	       (make-symbolic-data marks))))

      ;; (expand-literal-syntax form current-level k)
      ;;
      ;; form - syntax-constructor to expand
      ;; current-level - current depth of ellipsis nesting
      ;; k - receiver of computed result.
      ;;
      ;; The basic idea is that expand-literal-syntax not only
      ;; produces an expression for constructing a piece of syntax,
      ;; but also a datum describing the pattern variables used in the
      ;; piece of syntax, and how deeply their uses are nested.
      ;;
      ;; The continuation, k, takes two arguments as a result: the
      ;; first is the expanded expression and the second is a set of
      ;; pairs, each pair with car equal to a resolved-name of a
      ;; pattern variable that is referenced by the expanded
      ;; expression, and the cdr equal to the level of the pattern
      ;; variable.
      ;;
      (define (expand-literal-syntax form current-level k)
	(if (ellipsis? form)
	    (syntax-error "Ellipsis not preceded by template"))
	(let ((exp (expose form)))
	  (cond
	   ((symbol? exp)
	    (let ((resolved-id (resolve form)))
	      (eenv-lookup resolved-id eenv
		(lambda (ikind ivalue)
		  (case ikind
		    ((pattern-variable)
		     (if (> ivalue current-level)
			 (syntax-error "pattern variable used with too few ellipses" form)
			 (k (expand-variable resolved-id)
			    (if (> ivalue 0)
				(list (cons resolved-id ivalue))
				'()))))
		    (else (k (expand-literal-syntax-identifier exp
							       resolved-id
							       (syntax-wrap-pending-marks form))
			     '())))))))
	   ((pair? exp)
	    (let ((rest (expose (cdr exp))))
	      (if (and (pair? rest)
		       (ellipsis? (car rest)))
		  (let ((tailstx (cdr rest)))
		    (if (and (syntax-null? tailstx)
			     (ellipsis? (car exp)))
			(k (make-symbolic-data '...)
			   '())
			(expand-literal-syntax (car exp) (+ current-level 1)
			  (lambda (expanded ids)
			    (let* ((this-level (filter (lambda (x) (>= (cdr x) current-level))
						       ids))
				   (this-level-ids (map car this-level))
				   (remaining (filter (lambda (x) (not (= (cdr x) current-level)))
						      ids))
				   (map-expr (make-application (make-variable 'map)
							       (cons (make-function this-level-ids
										    expanded)
								     (map make-variable
									  this-level-ids)))))
			      (cond
			       ((null? this-level-ids)
				(syntax-error "Template ellipsis closes no variables"))
			       ((syntax-null? tailstx)
				(k map-expr remaining))
			       (else
				(expand-literal-syntax tailstx current-level
				  (lambda (expanded-tail ids-tail)
				    (k (make-application (make-variable 'append)
							 (list map-expr
							       expanded-tail))
				       (lset-union equal? remaining ids-tail)))))))))))
		  (expand-literal-syntax (car exp) current-level
		    (lambda (exp-a ids-a)
		      (expand-literal-syntax (cdr exp) current-level
			(lambda (exp-b ids-b)
			  (k (make-application (make-variable 'cons)
					       (list exp-a exp-b))
			     (lset-union equal? ids-a ids-b)))))))))
	   ((vector? exp)
	    (expand-literal-syntax
		(wrap-stx (vector->list exp) form)
		current-level
	      (lambda (expanded ids)
		(k (make-application (make-variable 'list->vector)
				     (list expanded))
		   ids))))
	   (else (k (make-symbolic-data exp)
		    '())))))

      (define (illegal-syntax-case-clause clause)
	(syntax-error "Illegal syntax case clause" clause))

      (define (expand-syntax-case-clauses stxvar keywords clauses)
	(if (null? clauses)
	    (make-application (make-variable 'syntax-error)
			      (list (make-symbolic-data "nonexhaustive match failure")
				    (make-variable stxvar)))
	    (let* ((clause (syntax->list (car clauses)))
		   (pattern-stx (if (pair? clause)
				    (car clause)
				    (illegal-syntax-case-clause clause)))
		   (pattern (stx->syntax-pattern keywords pattern-stx)))
	      (if (not (pair? (cdr clause)))
		  (illegal-syntax-case-clause clause)
		  (let* ((pattern-variables (syntax-pattern-result-levels pattern))
			 (has-guard (pair? (cddr clause)))
			 (guard (and has-guard (cadr clause)))
			 (expression (if has-guard (caddr clause) (cadr clause))))
		    (cond
		     ((not (null? (if has-guard
				      (cdddr clause)
				      (cddr clause))))
		      (syntax-error "Too many forms in syntax-case clause" clause))
		     ((let* ((var-names (map car pattern-variables))
			     (unique-names (delete-duplicates var-names eq?)))
			(not (= (length var-names) (length unique-names))))
		      (syntax-error "Duplicate pattern-variable names in syntax-case clause"
				    clause))
		     (else
		      (let* ((result-list-sym (make-fresh-sym))
			     (make-result-extractor
			      (lambda (receiver)
				(make-application (make-variable 'apply)
						  (list (expand-pfunction pattern-variables
									  (list receiver))
							(make-variable result-list-sym))))))
			(make-application
			 (make-function (list result-list-sym)
					(make-if (if has-guard
						     (make-if (make-variable result-list-sym)
							      (make-result-extractor guard)
							      (make-symbolic-data #f))
						     (make-variable result-list-sym))
						 (make-result-extractor expression)
						 (expand-syntax-case-clauses stxvar
									     keywords
									     (cdr clauses))))
			 (list (make-application (make-variable 'syntax-dispatch)
						 (list (make-variable stxvar)
						       (make-symbolic-data (syntax-pattern-strip
									    pattern))))))))))))))

      (define (expand-syntax-case stxexp rest-synlist)
	(let* ((rest (syntax->list rest-synlist))
	       (keywords (syntax->list (car rest))))
	  (if (or (not (every identifier? keywords))
		  (find ellipsis? keywords))
	      (syntax-error "Illegal keyword list in syntax-case" keywords)
	      (let* ((clauses (cdr rest))
		     (stxvar (make-fresh-sym))
		     (clauses-code (expand-syntax-case-clauses stxvar keywords clauses)))
		(make-application (make-function (list stxvar) clauses-code)
				  (list (expand-internal stxexp)))))))

      (define (expand-identifier-form exp resolved-head)
	(eenv-lookup resolved-head eenv
	  (lambda (kind denoted-value)
	    (case kind
	      ((variable) (expand-application (car exp) (cdr exp)))
	      ((pattern-variable) (illegal-use-of-pattern-variable (car exp)))
	      ((transformer) (expand-macro denoted-value exp))
	      ((id-transformer) (expand-internal
				 (cons (perform-macro-application denoted-value (car exp))
				       (cdr exp))))
	      ((special)
	       (syntax-pair-fields (cdr exp)
		 (lambda (next rest)
		   (case denoted-value
		     ((quote)
		      (if (not (syntax-null? rest))
			  (syntax-error "quote expects single form" exp))
		      (expand-symbolic-data (syntax-object->datum next)))
		     ((lambda) (expand-function next rest))
		     ((plambda) (expand-pfunction next rest))
		     ((syntax)
		      (if (not (syntax-null? rest))
			  (syntax-error "syntax expects single form" exp))
		      (expand-literal-syntax next 0 (lambda (expanded ids) expanded)))
		     ((let-syntax)
		      (expand-syntax-binding #f next rest))
		     ((letrec-syntax)
		      (expand-syntax-binding #t next rest))
		     ((syntax-case)
		      (expand-syntax-case next rest))
		     ((begin)
		      (expand-begin (cdr exp)))
		     ((if)
		      (expand-if exp next rest))
		     ((define)
		      (syntax-error "illegal location for definition" exp))
		     ((set!)
		      (expand-set! exp next rest))
		     (else (error "illegal special denoted-value"
				  denoted-value exp))))
		 (lambda (_) (syntax-error "Illegal syntax in special form" exp))))))))

      (define (expand-internal stx)
	(let ((exp (expose stx)))
	  (cond
	   ((pair? exp)
	    (let ((head (expose (car exp))))
	      (cond
	       ((symbol? head) (expand-identifier-form exp (resolve (car exp))))
	       (else (expand-application (car exp) (cdr exp))))))
	   ((symbol? exp)
	    (let ((resolved-name (resolve stx)))
	      (eenv-lookup resolved-name eenv
		(lambda (kind value)
		  (case kind
		    ((variable) (expand-variable resolved-name))
		    ((pattern-variable) (illegal-use-of-pattern-variable stx))
		    ((transformer)
		     (syntax-error "use of macro-transformer identifier as expression" stx))
		    ((id-transformer)
		     (expand-macro value stx))
		    ((special) (syntax-error "use of special-form as expression" stx)))))))
	   (else (expand-symbolic-data exp)))))

;       (trace expand-internal expand-identifier-form expand-literal-syntax
; 	     expand-set! expand-if expand-begin expand-syntax-binding
; 	     expand-macro expand-object-or-syntax-function
; 	     expand-application)

      (expand-internal stx0))))

;;; Local Variables:
;;; eval: (put 'syntax-pair-fields 'scheme-indent-function 1)
;;; eval: (put 'eenv-lookup 'scheme-indent-function 2)
;;; eval: (put 'expand-literal-syntax 'scheme-indent-function 2)
;;; End: