;; lexical analysis phase of the compiler
;; (c) 1996-7 Sebastian Good
;; (c) 1997-8 PLT, Rice University

;; For closures, variable sets, such as the free variables,
;;  are computed.
;; Constants are transformed into varrefs to top-level
;;  constant definitions. A list of these is kept, and
;;  code is generated to create the constants and prefixed
;;  onto the output code. See also const.ss.
;; Global and primitive varrefs are collected into a list,
;;  so they can all be looked up once.
;; Letrec expressions that don't just bind procedures are
;;  changed to let+set!. Letrecs that remain after this
;;  phase are well-behaved procedure binders.
;; Some simple arity checks are performed, and return-arity
;;  information is kept for closures. Ultimately, the return-
;;  arity information is used to compile away some return
;;  value count checks.
;; Constants are propagated.
;; Constant let-bound variables are eliminated (unless they
;;   are improperly used in the let body).
;; Procedure applications are inlined.
;; Compounding and invoking structures are computed.

;;; Annotatitons: ----------------------------------------------
;;    binding - `binding' structure: UPDATED occasionally:
;;         rec? field for letrec bindings
;;         known-but-used? field for ill-used bindings
;;    quote - zodiac:varref (global var containing a constructed 
;;         constant) or an immediate constant
;;    app - `app' structure: UPDATED tail? flag
;;    lambda - `procedure-code' structure
;;    unit - `unit-code' structure: UPDATED with var set info
;;    class - `class-code' structure: UPDATED with var set info
;;    compound - `compound-info' structure
;;    invoke - `invoke-info' structure
;;    with-continuation-mark - might set annotation to #f, which
;;         indicates that begin0-like handling is not needed
;;; ------------------------------------------------------------

(unit/sig compiler:analyze^
  (import (compiler:option : compiler:option^)
	  compiler:library^
	  compiler:cstructs^
	  (zodiac : zodiac:system^)
	  compiler:zlayer^
	  compiler:prephase^
	  compiler:anorm^
	  compiler:known^
	  compiler:const^
	  compiler:rep^
	  compiler:driver^
	  mzlib:function^
	  (mrspidey : compiler:mrspidey^))
  
  (define compiler:global-symbols (make-hash-table))
  (define compiler:add-global-varref!
    (lambda (varref)
      (let ([v (zodiac:varref-var varref)])
	(hash-table-put! compiler:global-symbols v v))))
  
  (define compiler:primitive-refs empty-set)
  (define compiler:add-primitive-varref!
    (lambda (varref)
      (set! compiler:primitive-refs
	    (set-union-singleton compiler:primitive-refs
				 (zodiac:varref-var varref)))))
  
  (define compiler:compounds null) ; built backwards, as usual
  (define (compiler:add-compound-unit! c)
    (begin0
     (length compiler:compounds)
     (set! compiler:compounds (cons c compiler:compounds))))
  
  (define compiler:interfaces null) ; built backwards, as usual
  (define (compiler:add-interface! c)
    (begin0
     (length compiler:interfaces)
     (set! compiler:interfaces (cons c compiler:interfaces))))
  
  (define compiler:max-arity-allowed 11739) ; meant to be a sane limit
  
  (define compiler:define-list null)
  (define compiler:per-load-define-list null)
  (define compiler:local-define-list null)
  (define compiler:local-per-load-define-list null)
  
  (define (compiler:init-define-lists!)
    (set! compiler:define-list null)
    (set! compiler:per-load-define-list null)
    (set! compiler:global-symbols (make-hash-table))
    (set! compiler:primitive-refs empty-set)
    (set! compiler:compounds null)
    (set! compiler:interfaces null))
  
  (define (compiler:add-local-per-load-define-list! def)
    (set! compiler:local-per-load-define-list 
	  (cons def compiler:local-per-load-define-list)))
  (define (compiler:add-local-define-list! def)
    (set! compiler:local-define-list 
	  (cons def compiler:local-define-list)))

  ;; Temporary structure used in building up case-lambda info
  (define-struct case-info 
    (body case-code global-vars used-vars captured-vars max-arity return-multi))

  (define (list->zodiac:quote l ast)
    (zodiac:make-quote-form
     (zodiac:zodiac-origin ast)
     (zodiac:zodiac-start ast)
     (zodiac:zodiac-finish ast)
     (make-empty-box)
     (zodiac:structurize-syntax l ast)))

  ;; Turns a virtual set-values! into an expression using normal
  ;; set!s. The result must be a-normalized, have the right
  ;; binding annotations, and the right known-value links.
  (define letrec-multiple-set!->single-set!
    (lambda (orig-zbindings vars val ast)
      (cond
       [(null? vars)
	; zero value set!  -- weirdos
	(mrspidey:copy-annotations!
	 (zodiac:make-let-values-form
	  (zodiac:zodiac-origin ast)
	  (zodiac:zodiac-start ast)
	  (zodiac:zodiac-finish ast)
	  (make-empty-box)
	  (list null)
	  (list val)
	  (zodiac:make-special-constant 'void))
	 ast)]
       
       [else
	; single or multiple value set! 
	(let* ([names (map (lambda (_) (gensym)) vars)]
	       [zbindings (map (lambda (name orig-zbinding)
				 (let ([zb (zodiac:make-lexical-binding
					    (zodiac:zodiac-origin ast)
					    (zodiac:zodiac-start ast)
					    (zodiac:zodiac-finish ast)
					    (make-empty-box)
					    name
					    name)])
				   (let ([old-binding (get-annotation orig-zbinding)]
					 [new-binding (make-unknown-letbound-binding #f)])
				     (set-annotation! zb new-binding)
				     ; Copy known info from the old binding to the new one.
				     (when (binding-known? old-binding)
				       (set-binding-known?! new-binding #t)
				       (set-binding-val! new-binding (binding-val old-binding))))
				   zb))
			       names orig-zbindings)])
	  ;; The original bindings will be set!ed, so they must now be marked as
	  ;;  a special kind of "mutable" for boxing.
	  (map (lambda (zb) (set-binding-letrec-set?! (get-annotation zb) #t)) orig-zbindings)
	  ;; If it's one binding, make sure known? is set:
	  (when (= 1 (length zbindings))
	    (let ([binding (get-annotation (car zbindings))])
	      (unless (binding-known? binding)
		(set-binding-known?! binding #t)
		(set-binding-val! binding val))))
	  ;; Make the new expession
	  (mrspidey:copy-annotations!
	   (zodiac:make-let-values-form
	    (zodiac:zodiac-origin ast)
	    (zodiac:zodiac-start ast)
	    (zodiac:zodiac-finish ast)
	    (make-empty-box)
	    (list zbindings)
	    (list val)
	    (let ([set!s (let loop ([zbindings zbindings] [vars vars])
			   (if (null? zbindings)
			       null
			       (cons
				(zodiac:make-set!-form
				 (zodiac:zodiac-origin ast)
				 (zodiac:zodiac-start ast)
				 (zodiac:zodiac-finish ast)
				 (make-empty-box)
				 (car vars)
				 (zodiac:binding->lexical-varref
				  (car zbindings)))
				(loop (cdr zbindings) (cdr vars)))))])
	      (if (= 1 (length set!s))
		  (car set!s)
		  (zodiac:make-begin-form
		   (zodiac:zodiac-origin ast)
		   (zodiac:zodiac-start ast)
		   (zodiac:zodiac-finish ast)
		   (zodiac:parsed-back ast)
		   set!s))))
	   ast))])))

  ;; turns a 'bad' letrec into let+set!, also returning a procedure
  ;; to set! the body to the correct form, to avoid re-analyzing it
  ;; the 'body' is set to #%void 
  (define letrec->let+set!
    (lambda (ast)
      (let* ([body
	      (zodiac:make-begin-form
	       (zodiac:zodiac-origin ast)
	       (zodiac:zodiac-start ast)
	       (zodiac:zodiac-finish ast)
	       (make-empty-box)
	       (let linearize-set! ([varses (zodiac:letrec-values-form-vars ast)]
				    [vals (zodiac:letrec-values-form-vals ast)])
		 (if (null? varses)
		     (list (zodiac:letrec-values-form-body ast))
		     (let* ([vars (car varses)] 
			    [val (car vals)])
		       (cons
			; must turn set!-values into set! form
			(letrec-multiple-set!->single-set!
			 vars
			 (map zodiac:binding->lexical-varref vars)
			 val
			 ast)
			(linearize-set! (cdr varses) (cdr vals)))))))]
	     [let-form
	      ; In this phase, we must only construct let-vales forms with one clause
	      (let loop ([varses (zodiac:letrec-values-form-vars ast)])
		(if (null? varses)
		    body
		    (let ([vars (car varses)])
		      (zodiac:make-let-values-form 
		       (zodiac:zodiac-origin ast)
		       (zodiac:zodiac-start ast)
		       (zodiac:zodiac-finish ast)
		       (make-empty-box) ; (zodiac:parsed-back ast)
		       (list vars)
		       (list
			(if (= 1 (length vars))
			    (zodiac:make-special-constant 'undefined)
			    (compiler:make-const-constructor 
			     ast
			     '#%values
			     (map (lambda (_) (zodiac:make-special-constant 
					       'undefined))
				  vars))))
		       (loop (cdr varses))))))])
	let-form)))

  ;; Tells us which constants we can replace directly with their text
  (define (can-propagate-constant? ast)
    (or (zodiac:quote-form? ast)
	;(zodiac:lexical-varref? ast) to do this, we must put renamed vars in
	; environments as their old name...
	(and (zodiac:top-level-varref? ast)
	     (or (varref:has-attribute? ast varref:primitive)
		 (varref:has-attribute? ast varref:static)))))

  ;; Which expressions can we drop entirely (e.g., RHS of a let when the value is known)?
  (define (can-drop-expression? ast)
    (or (zodiac:quote-form? ast)
	(zodiac:bound-varref? ast)
	(and (zodiac:top-level-varref? ast)
	     (varref:has-attribute? ast varref:static))))

  (define (or-multi a-multi b-multi)
    (case a-multi
      [(#f) b-multi]
      [(possible) (or b-multi 'possible)]
      [(#t) #t]))

  ;;----------------------------------------------------------------------
  ;; INLINING

  ;; Only inline fairly simple things; also check for variables needed
  ;;  that are not in the destination scope
  (define (expression-inline-cost body env init-size)
    (let loop ([body body][env env][size init-size][k (lambda (x) x)])
      (if (>= size (compiler:option:max-inline-size))
	  size
	  (cond
	   [(zodiac:quote-form? body) (k size)]
	   [(zodiac:bound-varref? body)
	    (if (memq (zodiac:bound-varref-binding body) env)
		(k size)
		; Out of scope - no inling
		(* 2 (compiler:option:max-inline-size)))]
	   [(zodiac:varref? body) (k size)]
	   [(zodiac:app? body) (loop (zodiac:app-fun body) 
				     env
				     (+ size  (length (zodiac:app-args body)) 1)
				     (lambda (size)
				       (let kloop ([l (zodiac:app-args body)][size size])
					 (if (null? l)
					     (k size)
					     (loop (car l) env size
						   (lambda (size)
						     (kloop (cdr l) size)))))))]
	   [(zodiac:if-form? body) (loop (zodiac:if-form-test body) env (+ size 3)
					 (lambda (size)
					   (loop (zodiac:if-form-else body) env size
						 (lambda (size)
						   (loop (zodiac:if-form-then body) env size k)))))]
	   [(zodiac:set!-form? body) (loop (zodiac:set!-form-val body) env (+ size 3) k)]
	   [(zodiac:let-values-form? body) (loop (car (zodiac:let-values-form-vals body)) 
						 env
						 (+ size 3)
						 (lambda (size)
						   (loop (zodiac:let-values-form-body body)
							 (append (car (zodiac:let-values-form-vars body)) env)
							 size k)))]
	   [(zodiac:begin-form? body) (let bloop ([size size][exprs (zodiac:begin-form-bodies body)])
					(if (null? exprs)
					    (k size)
					    (loop (car exprs)
						  env
						  (+ size 1)
						  (lambda (size)
						    (bloop size (cdr exprs))))))]
	   [else (* 2 (compiler:option:max-inline-size))]))))

  ; We copy inlined bodies to generate unique structure values
  ;  for every distinct program point. But we don't copy
  ;  quote forms, so the same run-time value will be used for
  ;  the quote form in all its instantiations. We also don't
  ;  know whether it's been analyzed in this phase, yet.
  (define (copy-inlined-binding ast)
    (let ([b (zodiac:make-lexical-binding
	      (zodiac:zodiac-origin ast)
	      (zodiac:zodiac-start ast)
	      (zodiac:zodiac-finish ast)
	      (make-empty-box)
	      (gensym (string-append (symbol->string (zodiac:binding-var ast)) "i"))
	      (zodiac:binding-orig-name ast))]
	  [a (get-annotation ast)])
      (set-annotation! b (copy-binding a))
      (mrspidey:copy-annotations! b ast)))
  (define (copy-inlined-body ast binding-map)
    (mrspidey:copy-annotations!
     (cond
      [(or (and (zodiac:lexical-varref? ast) 
		zodiac:make-lexical-varref)
	   (and (zodiac:supervar-varref? ast) 
		zodiac:make-supervar-varref)
	   (and (zodiac:superinit-varref? ast) 
		zodiac:make-superinit-varref)
	   (and (zodiac:public-varref? ast) 
		zodiac:make-public-varref)
	   (and (zodiac:override-varref? ast) 
		zodiac:make-override-varref)
	   (and (zodiac:private-varref? ast) 
		zodiac:make-private-varref)
	   (and (zodiac:rename-varref? ast) 
		zodiac:make-rename-varref)
	   (and (zodiac:inherit-varref? ast) 
		zodiac:make-inherit-varref))
       =>
       (lambda (f)
	 (let* ([binding (let* ([binding (zodiac:bound-varref-binding ast)]
				[remapped (assq binding binding-map)])
			   (if remapped
			       (cdr remapped)
			       binding))]
		[new-ast (f (zodiac:zodiac-origin ast)
			    (zodiac:zodiac-start ast)
			    (zodiac:zodiac-finish ast)
			    (make-empty-box)
			    (zodiac:binding-var binding)
			    binding)])
	   ;; Copy attribute set:
	   (set-annotation! new-ast (get-annotation ast))
	   new-ast))]
      [(zodiac:top-level-varref/bind? ast)
       (let ([new-ast (zodiac:make-top-level-varref/bind
		       (zodiac:zodiac-origin ast)
		       (zodiac:zodiac-start ast)
		       (zodiac:zodiac-finish ast)
		       (make-empty-box)
		       (zodiac:varref-var ast)
		       (zodiac:top-level-varref/bind-slot ast))])
	 ;; Copy attribute set:
	 (set-annotation! new-ast (get-annotation ast))
	 new-ast)]
      [(zodiac:top-level-varref? ast)
       (let ([new-ast (zodiac:make-top-level-varref
		       (zodiac:zodiac-origin ast)
		       (zodiac:zodiac-start ast)
		       (zodiac:zodiac-finish ast)
		       (make-empty-box)
		       (zodiac:varref-var ast))])
	 ;; Copy attribute set:
	 (set-annotation! new-ast (get-annotation ast))
	 new-ast)]
      [(zodiac:quote-form? ast) ast]
      [(zodiac:app? ast)
       (let ([new-ast (zodiac:make-app
		       (zodiac:zodiac-origin ast)
		       (zodiac:zodiac-start ast)
		       (zodiac:zodiac-finish ast)
		       (make-empty-box)
		       (copy-inlined-body (zodiac:app-fun ast) binding-map)
		       (map (lambda (x) (copy-inlined-body x binding-map)) (zodiac:app-args ast)))]
	     [appinfo (get-annotation ast)])
	 (set-annotation! new-ast
			  (make-app #f
				    (app-prim? appinfo)
				    (app-prim-name appinfo)))
	 (mrspidey:copy-annotations! new-ast ast)
	 new-ast)]
      [(zodiac:if-form? ast)
       (mrspidey:copy-annotations! 
	(zodiac:make-if-form
	 (zodiac:zodiac-origin ast)
	 (zodiac:zodiac-start ast)
	 (zodiac:zodiac-finish ast)
	 (make-empty-box)
	 (copy-inlined-body (zodiac:if-form-test ast) binding-map)
	 (copy-inlined-body (zodiac:if-form-then ast) binding-map)
	 (copy-inlined-body (zodiac:if-form-else ast) binding-map))
	ast)]
      [(zodiac:set!-form? ast)
       (mrspidey:copy-annotations! 
	(zodiac:make-set!-form
	 (zodiac:zodiac-origin ast)
	 (zodiac:zodiac-start ast)
	 (zodiac:zodiac-finish ast)
	 (make-empty-box)
	 (copy-inlined-body (zodiac:set!-form-var ast) binding-map)
	 (copy-inlined-body (zodiac:set!-form-val ast) binding-map))
	ast)]
      [(zodiac:let-values-form? ast)
       (let* ([vars (car (zodiac:let-values-form-vars ast))]
	      [val (car (zodiac:let-values-form-vals ast))]
	      [new-val (copy-inlined-body val binding-map)]
	      [new-vars (map copy-inlined-binding vars)]
	      [new-binding-map (append (map cons vars new-vars) binding-map)]
	      [new-body (copy-inlined-body (zodiac:let-values-form-body ast) new-binding-map)])
	 
	 ;; Update known-value information; if it was known to be = to a varref or binding,
	 ;; we may have replaced it with a new varref or binding.
	 (when (= 1 (length new-vars))
	   (let ([binding (get-annotation (car new-vars))])
	     (when (binding-known? binding)
	       (let ([known (binding-val binding)])
		 (when (or (zodiac:bound-varref? known)
			   (zodiac:binding? known))
		   (let* ([known-zbinding (if (zodiac:binding? known)
					      known
					      (zodiac:bound-varref-binding known))]
			  [found (assq known-zbinding binding-map)])
		     (when found
		       ;; Yep - that varref/binding was replaced
		       (set-binding-val! binding (cdr found)))))))))
	 
	 (mrspidey:copy-annotations! 
	  (zodiac:make-let-values-form
	   (zodiac:zodiac-origin ast)
	   (zodiac:zodiac-start ast)
	   (zodiac:zodiac-finish ast)
	   (make-empty-box)
	   (list new-vars)
	   (list new-val)
	   new-body)
	  ast))]
      [(zodiac:begin-form? ast)
       (mrspidey:copy-annotations! 
	(zodiac:make-begin-form
	 (zodiac:zodiac-origin ast)
	 (zodiac:zodiac-start ast)
	 (zodiac:zodiac-finish ast)
	 (make-empty-box)
	 (map (lambda (x) (copy-inlined-body x binding-map))
	      (zodiac:begin-form-bodies ast)))
	ast)]
      [else (compiler:internal-error
	     ast
	     (format "copy-inlined-body: can't copy ~a"
		     ast))])
     ast))

  (define (check-for-inlining ast env inlined tail? inline dont-inline)
    (if (>= inlined (compiler:option:max-inline-size))
	(dont-inline "depth")
	(let ([c (zodiac:app-fun ast)])
	  (if (not (zodiac:bound-varref? c))
	      (dont-inline `(format "not a varref: ~a" ,c))
	      (let* ([val (extract-varref-known-val c)])
		(if (not (zodiac:case-lambda-form? val))
		    (dont-inline `(format "not a lambda: ~a" ,val))
		    ;; We're going to inline the body if the arg count matches
		    (let loop ([argses (zodiac:case-lambda-form-args val)]
			       [bodies (zodiac:case-lambda-form-bodies val)])
		      (cond
		       [(null? argses) (dont-inline "no arg match")]
		       [(and (zodiac:list-arglist? (car argses))
			     (= (length (zodiac:app-args ast))
				(length (zodiac:arglist-vars (car argses)))))
			;; Inline if lexical scope of destination includes the lexical
			;;  scope of the source, and simple enough
			(let* ([body (car bodies)]
			       [orig-vars (zodiac:arglist-vars (car argses))]
			       [new-size (expression-inline-cost 
					  body (append orig-vars env) 
					  (if tail?
					      (max 5 inlined)
					      inlined))])
			  (if (< new-size (compiler:option:max-inline-size))
			      (let* ([vars (map copy-inlined-binding orig-vars)]
				     [vals (zodiac:app-args ast)]
				     [new-body (copy-inlined-body body (map cons orig-vars vars))]
				     [v (let loop ([vars vars][vals vals])
					  (mrspidey:copy-annotations!
					   (if (null? vars)
					       new-body
					       (zodiac:make-let-values-form
						(zodiac:zodiac-origin ast)
						(zodiac:zodiac-start ast)
						(zodiac:zodiac-finish ast)
						(make-empty-box)
						(list (list (car vars)))
						(list (car vals))
						(loop (cdr vars) (cdr vals))))
					   ast))])
				;; Unless mutable, the new bindings have known
				;;  value expressions
				(for-each
				 (lambda (var val)
				   (let ([binding (get-annotation var)])
				     (unless (binding-mutable? binding)
				       (set-binding-known?! binding #t)
				       (set-binding-val! binding val))))
				 vars (extract-ast-known-value vals))
				(inline v new-size))
			      (dont-inline "too complex")))]
		       [else (loop (cdr argses) (cdr bodies))]))))))))
  

  ;;----------------------------------------------------------------------
  ;; analyze-expression takes 4 arguments
  ;;  1) an AST to transform
  ;;  2) a set of bound variables (the lexical environment)
  ;;  3) tail?
  ;;
  ;; it returns 6 values
  ;;  1) a destructively altered AST
  ;;  2) a set of variables occurring free in that expression [free-vars]
  ;;  3) a set of variables which are bound by lets in that expression [local-vars]
  ;;  4) global variables and mutable `constants' used in the expression [global-vars]
  ;;  5) local variables (including given bound set) that are used directly or captured by nested closures [used-vars]
  ;;  6) free and local variables that are captured by nested closures [captured-vars]
  ;;  7) a list of `code' structures
  ;;  8) maximum arity to a call made in this expression
  ;;  9) returns multiple values?: #t, 'possible, or #f
  ;;
  (define analyze-expression!
    (lambda (ast just-bound-vars env tail?)
      (let ([local-vars just-bound-vars]
	    [locals-used empty-set]
	    [captured-vars empty-set]
	    [free-vars empty-set]
	    [global-vars empty-set]
	    [codes null]
	    [max-arity 1])
	(letrec
	    ([add-local-var! (lambda (var)
			       (set! local-vars
				     (set-union-singleton local-vars var)))]
	     [remove-local-var! (lambda (var)
				  (set! local-vars
					(set-minus local-vars (make-singleton-set var))))]
	     [add-free-var! (lambda (var)
			      (set! free-vars
				    (set-union-singleton free-vars var)))]
	     [add-used-var! (lambda (var)
			      (set! locals-used
				    (set-union-singleton locals-used var)))]
	     [add-global-var! (lambda (var)
				(set! global-vars
				      (set-union-singleton global-vars var)))]
	     [add-child-code! (lambda (c)
				(set! codes (cons c codes)))]
	     [register-arity! (lambda (n) (set! max-arity (max n max-arity)))]  
	     [register-code-vars!
	      (lambda (code can-lift?)
		; all variables which are free in nested closures are
		; free in this closure (since we need them in the
		; environment) except those that are already in the
		; environment: just-bound-vars (typically the arguments)
		; and local-vars. New captured variables are also
		; added: free variables and captured variables in
		; nested closures. (Captured variables are always
		; a subset of free + used.)
		(set! free-vars
		      (set-union (set-minus (code-free-vars code)
					    local-vars)
				 free-vars))
		(set! locals-used
		      (set-union (set-intersect local-vars
						(code-free-vars code))
				 locals-used))
		(set! captured-vars
		      (set-union (set-minus (code-free-vars code)
					    local-vars)
				 captured-vars))
		(set! global-vars
		      (set-union (code-global-vars code) global-vars)))]
	     [analyze-code-body!
	      (lambda (ast locals env tail? code)
		(add-child-code! code)
		(let-values ([(body free-vars
				    local-vars 
				    global-vars 
				    used-vars
				    captured-vars
				    children
				    L-max-arity
				    multi)
			      (analyze-expression! ast
						   locals
						   (append (set->list locals) env)
						   tail?)])
		  
		  (set-code-free-vars! code (set-union free-vars
						       (code-free-vars code)))
		  (set-code-local-vars! code (set-union local-vars
							(code-local-vars code)))
		  (set-code-global-vars! code (set-union global-vars
							 (code-global-vars code)))
		  (set-code-used-vars! code (set-union used-vars
						       (code-used-vars code)))
		  (set-code-captured-vars! code (set-union captured-vars
							   (code-captured-vars code)))
		  (set-code-children! code children)
		  (for-each (lambda (c) (set-code-parent! c code)) children)
		  (set-closure-code-max-arity! code (max L-max-arity
							 (closure-code-max-arity code)))
		  (set-closure-code-return-multi! code multi)
		  
		  body))]
	     [analyze-varref!
	      (lambda (ast env tail? need-varref?)
		(cond
		 
		 ;;-----------------------------------------------------------------
		 ;; VARIABLE REFERENCES (A-VALUES)
		 ;;
		 ;;    We need to catalogue which variables are used in this 
		 ;;    expression.  if a lexical varref is not in the 
		 ;;    environment, it is free
		 ;;
		 ;;    if the bound structure indicates this variable is known at
		 ;;    compile time, replace the varref with the const-ref
		 ;;    since we can propagate varrefs, we need to make sure we
		 ;;    capture the right name in closures.
		 ;;
		 [(zodiac:bound-varref? ast)
		  
		  ; check to see if it's known.  If so, just return the known value.
		  
		  (let* ([zbinding (zodiac:bound-varref-binding ast)]
			 [binding (compiler:bound-varref->binding ast)]
			 [known-value (extract-varref-known-val ast)])
		
		    ;; Extra checking for debugging:
		    ; (unless (memq zbinding env) (compiler:internal-error ast "unbound variable"))
    
		    ; While we're at it, make sure MrSpidey and mzc agree on the
		    ; mutability of variables.
		    '(when (compiler:option:use-mrspidey)
		       (unless (eq? (mrspidey:binding-mutated zbinding)
				    (binding-mutable? binding))
			 (compiler:internal-error
			  ast
			  (format "mutable according to MrSpidey: ~a; mutable according to mzc: ~a"
				  (mrspidey:binding-mutated zbinding)
				  (binding-mutable? binding)))))
		    
		    (cond 
		     [(and (compiler:option:propagate-constants)
			   known-value 
			   (can-propagate-constant? known-value)
			   (not need-varref?))
		      
		      ; Propogate a mzc-determined constant!
		      ; This could be a quote-form that was installed
		      ; as a known unit value before it was
		      ; analyzed. If so, extract the constructed
		      ; constant from the backbox.
		      ; In any case, check for adding PLS to the closure.
		      (let ([c (if (zodiac:quote-form? known-value)
				   
				   (let ([a (get-annotation known-value)])
				     (if (zodiac:varref? a)
					 a
					 (analyze-quote! known-value #f)))

				   known-value)])
			
			(when (and (zodiac:varref? c)
				   (varref:has-attribute? c varref:per-load-static))
			  (add-global-var! const:the-per-load-statics-table))
			
			c)]
		     
		     [(and #f ; MrSpidey doesn't work.
			   (compiler:option:propagate-constants)
			   (not need-varref?)
			   (let-values ([(const? c) (mrspidey:constant-value ast)])
			     (and const?
				  (or (symbol? c) (number? c) (char? c)
				      (boolean? c))
				  (list c))))
		      
		      ; A MrSpidey-computed constant
		      ; Structurize it and try again
		      =>
		      (lambda (sdl-const)
			(compiler:warning
			 ast
			 (format "Using MrSpidey-determined constant: ~s = ~e" 
				 (zodiac:binding-orig-name zbinding) 
				 (car sdl-const)))
			(let* ([c (car sdl-const)]
			       [zc (zodiac:make-quote-form
				    (zodiac:zodiac-origin ast)
				    (zodiac:zodiac-start ast)
				    (zodiac:zodiac-finish ast)
				    (make-empty-box)
				    (zodiac:structurize-syntax c ast))])
			  (analyze-quote! zc #f)))]
		     
		     
		     [else   
		      ; otherwise we don't know the value -- therefore just
		      ; do the normal free-variable analysis
		      
		      (if (not (set-memq? (zodiac:bound-varref-binding ast)
					  local-vars))
			  
			  (begin 
			    (add-free-var! (zodiac:bound-varref-binding ast))
			    (varref:add-attribute! ast varref:env)
			    
			    ; If this variable has an anchor, include it in the list of free vars
			    (let ([a (binding-anchor (get-annotation (zodiac:bound-varref-binding ast)))])
			      (when a
				(add-free-var! a)))
			    
			    ast)
			  
			  (begin
			    (add-used-var! (zodiac:bound-varref-binding ast))
			    
			    ; If this variable has an anchor, include it in the list of used vars
			    (let ([a (binding-anchor (get-annotation (zodiac:bound-varref-binding ast)))])
			      (when a
				(add-used-var! a)))
			    
			    ast))]))]
		 
		 [(zodiac:top-level-varref? ast)
		  (cond
		   [(varref:has-attribute? ast varref:primitive)
		    (compiler:add-primitive-varref! ast)]
		   [(varref:has-attribute? ast varref:per-load-static)
		    (add-global-var! const:the-per-load-statics-table)]
		   [(varref:has-attribute? ast varref:static)
		    (void)]
		   [else
		    (add-global-var! (zodiac:varref-var ast))])
		  (compiler:add-global-varref! ast)
		  ast]
		 
		 [else (compiler:internal-error 
			ast
			"analyze: expected a variable; got ~a" ast)]))]
	     
	     ;;-----------------------------------------------------------------
	     ;; CONSTANTS (A-VALUES)
	     ;;   literal constants -- send them off to the constant
	     ;;   constructors!!  This produces code in b-normal form
	     ;;   and adds defines to the local-define-list. This list
	     ;;   must be reversed since the dependencies are backwards
	     ;;   ahh, the excitement of multiple values...
	     [analyze-quote!
	      (lambda (ast known-immutable?)
		(set! compiler:local-define-list null)
		(set! compiler:local-per-load-define-list null)
		(let ([ret (compiler:construct-const-code! 
			    (zodiac:quote-form-expr ast)
			    (or known-immutable?
				(eq? 'immutable (get-annotation ast))))])
		  ; Put a pointer to the constructed constant in the quote-form's backbox
		  (set-annotation! ast ret)
		  
		  (set! compiler:define-list
			(append! compiler:define-list 
				 (reverse! compiler:local-define-list)))
		  (set! compiler:per-load-define-list
			(append! compiler:per-load-define-list 
				 (reverse! compiler:local-per-load-define-list)))
		  
		  ;; If this `constant' is mutable, register the per-load
		  ;; statics pointer as a `global'
		  (when (and (zodiac:top-level-varref/bind? ret)
			     (varref:has-attribute? ret varref:per-load-static))
		    (add-global-var! const:the-per-load-statics-table))
		  
		  ret))]
	     
	     [analyze!-ast
	      ;; Like analyze, but drop the multi-return info in the result
	      (lambda (ast env inlined)
		(let-values ([(ast multi) (analyze! ast env inlined #f #f)])
		  ast))]
	     
	     [analyze!-sv
	      ;; Like analyze, but make sure the expression is not definitely
	      ;;  multi-valued
	      (lambda (ast env inlined)
		(let-values ([(ast multi) (analyze! ast env inlined #f #f)])
		  (when (eq? multi #t)
		    ((if (compiler:option:stupid) compiler:warning compiler:error)
		     ast
		     "returning zero or multiple values to a context expecting 1 value"))
		  ast))]
	     
	     [analyze!
	      ;; Returns (values ast multi)
	      ;;    where multi = #f, #t, 'possible
	      (lambda (ast env inlined tail? wcm-tail?)
		(when (compiler:option:debug)
		  (zodiac:print-start! debug:port ast)
		  (newline debug:port))
		
		'(let* ([sdltype (mrspidey:SDL-type ast)])
		   (when sdltype
		     (printf "Type for ~a: ~a~n" ast sdltype)))
		
		(cond
		 
		 ;;-----------------------------------------------------------------
		 ;; CONSTANTS (A-VALUES)
		 [(zodiac:quote-form? ast)
		  (values (analyze-quote! ast #f) #f)]
		 
		 ;;-----------------------------------------------------------------
		 ;; VARIABLE REFERENCES (A-VALUES)
		 ;;
		 ;;    We need to catalogue which variables are used in this 
		 ;;    expression.  if a lexical varref is not in the 
		 ;;    environment, it is free
		 ;;
		 ;;    if the bound structure indicates this variable is known at
		 ;;    compile time, replace the varref with the const-ref
		 ;;    since we can propagate varrefs, we need to make sure we
		 ;;    capture the right name in closures.
		 ;;
		 [(zodiac:bound-varref? ast) 
		  (values (analyze-varref! ast env tail? #f) #f)]

		 [(zodiac:top-level-varref? ast)
		  (values (analyze-varref! ast env tail? #f) #f)]
		 
		 ;;--------------------------------------------------------------------
		 ;; LAMBDA EXPRESSIONS
		 ;;    with lambda, we need to make a recursive call.  We
		 ;;    extend the lexical environment with everything that's
		 ;;    been declared locally so far.  From the analyze-expression
		 ;;    we have information about what free variables they use	
		 ;;
		 [(zodiac:case-lambda-form? ast)
		  (let* ([code
			  (make-procedure-code empty-set empty-set empty-set empty-set empty-set
					       'unknown-proc-parent #f null
					       #f #f #f #f 0 #f (get-annotation ast) ; ann. = name
					       'unknown-case-infos #f 
					       'unknown-liftable)]
			 [case-infos
			  (map
			   (lambda (args body)
			     (let ([args (zodiac:arglist-vars args)])
			       
			       (let-values 
				   ([(lambda-body free-lambda-vars
						  local-lambda-vars 
						  global-lambda-vars 
						  used-lambda-vars
						  captured-lambda-vars
						  children-codes
						  L-max-arity
						  multi)
				     
				     (let ([just-bound (improper-list->set args)])
				       (analyze-expression! body
							    just-bound
							    (append (set->list just-bound) env)
							    #t))])
				 
				 (let ([case-code (make-case-code
						   free-lambda-vars
						   local-lambda-vars
						   global-lambda-vars
						   used-lambda-vars
						   captured-lambda-vars
						   code #f children-codes
						   #f)])
				   (for-each (lambda (c) (set-code-case-parent! c case-code))
					     children-codes)
				   (make-case-info lambda-body case-code 
						   global-lambda-vars
						   used-lambda-vars 
						   captured-lambda-vars 
						   L-max-arity
						   multi)))))
			   (zodiac:case-lambda-form-args ast)
			   (zodiac:case-lambda-form-bodies ast))]
			 [case-codes (map case-info-case-code case-infos)]
			 [all-children (apply append (map code-children case-codes))])
		    (set-procedure-code-case-codes! code case-codes)
		    (set-code-children! code all-children)
		    (for-each (lambda (c) (set-code-parent! c code)) all-children)
		    (add-child-code! code)
		    (let loop ([l case-infos])
		      (if (null? l)
			  (begin
			    ; set the body
			    (zodiac:set-case-lambda-form-bodies! ast (map case-info-body case-infos))

			    ; now annotate this lambda form with the code
			    (set-annotation! ast code)

			    ; Propogate free, used, and captured vars:
			    (register-code-vars! code #t)

			    ; finally return it
			    (values ast #f))
			  
			  (begin
			    (set-code-free-vars! 
			     code
			     (set-union (code-free-vars
					 (case-info-case-code (car l)))
					(code-free-vars code)))
			    (set-code-local-vars! 
			     code
			     (set-union (code-local-vars
					 (case-info-case-code (car l)))
					(code-local-vars code)))
			    (set-code-global-vars!
			     code
			     (set-union (case-info-global-vars (car l))
					(code-global-vars code)))
			    (set-code-used-vars!
			     code
			     (set-union (case-info-used-vars (car l))
					(code-used-vars code)))
			    (set-code-captured-vars!
			     code
			     (set-union (case-info-captured-vars (car l))
					(code-captured-vars code)))
			    (set-closure-code-max-arity!
			     code
			     (max (closure-code-max-arity code)
				  (case-info-max-arity (car l))))
			    (set-closure-code-return-multi! 
			     code
			     (or-multi (closure-code-return-multi code)
				       (case-info-return-multi (car l))))
			    (loop (cdr l))))))]
		 
		 ;;--------------------------------------------------------------
		 ;; LET EXPRESSIONS
		 ;;    keep track of the bindings introduced so that each
		 ;;    expression can keep track of all the bindings it needs
		 ;;    this flattens environments
		 ;;    Several values may be bound at once.
		 ;;
		 ;;    in let, variables are assumed to be
		 ;;    immutable and known; we store this information
		 ;;    in the binding structure in the compiler:bound structure..
		 ;;
		 ;;    (let ([x (set! y A)]) M) ->
		 ;;      (begin (set! y A) (let ([x #%void]) M))
		 ;;
		 ;;    if the variable bound is constant, the let is discarded,
		 ;;    and the value is naturally propagated.
		 ;;
		 [(zodiac:let-values-form? ast)
		  (let*-values ([(val val-multi) 
				 (analyze! (car (zodiac:let-values-form-vals ast)) env inlined #f #f)]
				[(vars) (car (zodiac:let-values-form-vars ast))]
				[(convert-set!-val)
				 (lambda ()   
				   (set-car! (zodiac:let-values-form-vals ast)
					     (zodiac:make-special-constant 
					      'void))
				   (zodiac:make-begin-form 	   
				    (zodiac:zodiac-origin ast)
				    (zodiac:zodiac-start ast)
				    (zodiac:zodiac-finish ast)
				    (make-empty-box)
				    (list val ast)))])
		    
		    (if (= 1 (length (car (zodiac:let-values-form-vars ast))))
			
			; this is a one-value binding let
			(let* ([var (car vars)]
			       [binding (get-annotation var)])
			  
			  (when (eq? val-multi #t)
			    ((if (compiler:option:stupid) compiler:warning compiler:error)
			     ast
			     "returning zero or multiple values to a context expecting 1 value"))
			  
			  (add-local-var! var)
			  
			  (let-values ([(body body-multi)
					(analyze! (zodiac:let-values-form-body ast) 
						  (cons var env)
						  inlined tail? wcm-tail?)]
				       [(known-val) (extract-varref-known-val var)])
			    
			    (if (and (compiler:option:propagate-constants)
				     (not (binding-mutable? binding))
				     known-val
				     (can-propagate-constant? known-val)
				     (can-drop-expression? val)
				     ; can't eliminiate if used by invoke:
				     (not (binding-unit-i/e? binding))
				     ; can't eliminiate if a letrec->let variable
				     (not (binding-letrec-set? binding))
				     ; can't eliminate if it is used by a bad application
				     ;   or by invoke
				     (not (binding-known-but-used? binding)))
				
				; discard the let:
				(begin
				  (remove-local-var! var)
				  (values body body-multi))

				; otherwise, process normally
				(begin
				  
				  (set-car! (car (zodiac:let-values-form-vars ast)) 
					    var)
				  (zodiac:set-let-values-form-body! ast body)
				  
				  (if (zodiac:set!-form? val)
				      
				      ; if we're binding the result of a set!-form, 
				      ; turn it into
				      ; a void.
				      (values (convert-set!-val) #f)
				      
				      ; if it's any other expression, we're done.
				      (begin
					(set-car! (zodiac:let-values-form-vals ast)
						  val)
					(values ast body-multi)))))))
			
			; this is a multiple (or zero) value binding let
			; the values are unknown to simple analysis so skip
			; that stuff
			(begin
			  (set-car! (zodiac:let-values-form-vars ast) vars)
			  ; these are all new bindings
			  (for-each add-local-var! vars)
			  ; analyze the body
			  (let-values ([(body body-multi) 
					(analyze! (zodiac:let-values-form-body ast)
						  (append vars env)
						  inlined
						  tail? wcm-tail?)])
			    (zodiac:set-let-values-form-body! ast body)
			    
			    (if (zodiac:set!-form? val)
				(begin
				  ((if (compiler:option:stupid) compiler:warning compiler:error)
				   val
				   (format
				    "returning 1 value (void) to a context expecting ~a values"
				    (length vars)))
				  (when (compiler:option:stupid)
				    (values (convert-set!-val) #f)))
				; if it's any other option, we're done
				(begin
				  (set-car! (zodiac:let-values-form-vals ast) val)
				  (values ast body-multi)))))
			
			))]

		 ;;-----------------------------------------------------------------
		 ;; LETREC EXPRESSIONS
		 ;;
		 ;; if the letrec form binds only lambda values and those bindings
		 ;; are not mutable, we keep this as a letrec, otherwise we 
		 ;; transform it to a let+set! combination as R4RS.
		 ;;
		 [(zodiac:letrec-values-form? ast)

		  (if (and 
		       ;; Well-behaved if everything's a closure
		       (andmap zodiac:case-lambda-form? 
			       (zodiac:letrec-values-form-vals ast))
		       ;; and all are one-variable bindings
		       (andmap (lambda (l) (= 1 (length l))) 
			       (zodiac:letrec-values-form-vars ast))
		       ;; and all are immutable
		       (andmap (lambda (l)
				 (not (binding-mutable? (get-annotation (car l)))))
			       (zodiac:letrec-values-form-vars ast)))
		      
		      ;-----------------------------------------------------------
		      ; WELL-BEHAVED LETREC (incomplete bindings never exposed)
		      ;  mark appropriate variables as letrec bound
		      ;
		      (let* ([vars (map car (zodiac:letrec-values-form-vars ast))])
			(set! local-vars (set-union (list->set vars) local-vars))
			(let ([new-env (append vars env)])
			  (let-values ([(vals) (map (lambda (val)
						      (analyze!-sv val new-env inlined))
						    (zodiac:letrec-values-form-vals ast))]
				       [(body body-multi) (analyze! 
							   (zodiac:letrec-values-form-body ast) 
							   new-env
							   inlined
							   tail? wcm-tail?)]
				       [(vars) (map car (zodiac:letrec-values-form-vars ast))])
			    
			    (for-each (lambda (var) (set-binding-rec?! (get-annotation var) #t))
				      vars)
			    (zodiac:set-letrec-values-form-vals! ast vals)
			    (zodiac:set-letrec-values-form-body! ast body)
			    
			    (values ast body-multi))))
		      
		      ;-----------------------------------------------------------
		      ; POSSIBLY POORLY BEHAVED LETREC
		      ;   rewrite as let+set!
		      ;
		      (begin
			(compiler:warning ast "letrec will be rewritten with set!")
			(debug "rewriting letrec~n")
			(let ([new-ast (letrec->let+set! ast)])
			  (debug "reanalyzing...~n")
			  (analyze! new-ast env inlined tail? wcm-tail?))))]

		 ;;-----------------------------------------------------
		 ;; IF EXPRESSIONS
		 ;;
		 ;; just analyze the 3 branches.  Very easy
		 [(zodiac:if-form? ast)
		  (zodiac:set-if-form-test! ast (analyze!-sv (zodiac:if-form-test ast) env inlined))
		  (let-values ([(then then-multi) (analyze! (zodiac:if-form-then ast) env inlined tail? wcm-tail?)]
			       [(else else-multi) (analyze! (zodiac:if-form-else ast) env inlined tail? wcm-tail?)])
		    (zodiac:set-if-form-then! ast then)
		    (zodiac:set-if-form-else! ast else)
		    
		    (values ast (or-multi then-multi else-multi)))]
		 
		 ;;--------------------------------------------------------
		 ;; BEGIN EXPRESSIONS
		 ;;
		 ;; analyze the branches
		 [(zodiac:begin-form? ast)

		  (let ([last-multi
			 (let loop ([bodies (zodiac:begin-form-bodies ast)])
			   (if (null? (cdr bodies))
			       (let-values ([(e last-multi) (analyze! (car bodies) env inlined tail? wcm-tail?)])
				 (set-car! bodies e)
				 last-multi)
			       (begin
				 (set-car! bodies (analyze!-ast (car bodies) env inlined))
				 (loop (cdr bodies)))))])

		    (values ast last-multi))]
		 
		 
		 ;;--------------------------------------------------------
		 ;; BEGIN0 EXPRESSIONS
		 ;;
		 ;; analyze the branches
		 [(zodiac:begin0-form? ast)
		  (let-values ([(0expr 0expr-multi) (analyze! (zodiac:begin0-form-first ast) env inlined #f #f)])
		    (zodiac:set-begin0-form-first! ast 0expr)
		    (zodiac:set-begin0-form-rest! ast (analyze!-ast (zodiac:begin0-form-rest ast) env inlined))
		    (let ([var (get-annotation ast)])
		      (add-local-var! var))
		    (values ast 0expr-multi))]
		 
		 ;;--------------------------------------------------------
		 ;; SET! EXPRESSIONS
		 ;;
		 ;; we analyze the target, which will register it as being
		 ;; mutable or used, as necessary.  Then we analyze the value.
		 ;;
		 [(zodiac:set!-form? ast)

		  (let ([target (analyze-varref! (zodiac:set!-form-var ast) env #f #t)])
		    (zodiac:set-set!-form-var! ast target)
		    (zodiac:set-set!-form-val! 
		     ast 
		     (analyze!-sv (zodiac:set!-form-val ast) env inlined)))
		  
		  (values ast #f)]
		 
		 ;;---------------------------------------------------------
		 ;; DEFINE EXPRESSIONS
		 ;;
		 ;; defines are very tricky, eh what?
		 ;;
		 [(zodiac:define-values-form? ast)
		  (zodiac:set-define-values-form-vars!
		   ast
		   (map (lambda (v) (analyze-varref! v env #f #t)) 
			(zodiac:define-values-form-vars ast)))
		  (zodiac:set-define-values-form-val! 
		   ast
		   (analyze!-ast (zodiac:define-values-form-val ast) env inlined))
		  (values ast #f)]
		 
		 ;;-------------------------------------------------------------------
		 ;; APPLICATIONS
		 ;;   analyze all the parts.  replace with a compiler:app
		 ;;    annotated with tail?
		 ;;  If this is a call to a primitive, check the arity.
		 ;;
		 [(zodiac:app? ast)
		  (check-for-inlining
		   ast
		   env
		   inlined
		   tail?
		   (lambda (new-ast new-inlined)
		     (when (compiler:option:verbose)
		       (compiler:warning ast "inlining procedure call"))
		     ; We inlined - analyze the new form
		     (analyze! new-ast env new-inlined tail? wcm-tail?))
		   (lambda (why)
		     '(begin
			(zodiac:print-start! (current-output-port) ast) 
			(printf "no inlining: ~a~n" (eval why)))
		     (let* ([fun (let ([v (analyze!-sv (zodiac:app-fun ast) env inlined)])
				   (if (zodiac:varref? v)
				       v
				       ; known non-procedure!
				       (let ([var (zodiac:app-fun ast)])
					 ((if (compiler:option:stupid)
					      compiler:warning 
					      compiler:error)
					  ast 
					  "application of a non-procedure")
					 (set-binding-known-but-used?! 
					  (get-annotation (zodiac:bound-varref-binding var)) 
					  #t)
					 (analyze-varref! var env #f #t))))]
			    [primfun (app-prim-name (get-annotation ast))]
			    [multi (if primfun
				       (let ([a (primitive-result-arity 
						 (global-defined-value primfun))])
					 (cond
					  [(and (number? a) (= a 1)) #f]
					  [(number? a) #t]
					  [else 'possible]))
				       'possible)]
			    [args (map (lambda (arg)
					 (analyze!-sv arg env inlined))
				       (zodiac:app-args ast))])
		       
		       ; for all functions, do this stuff
		       (zodiac:set-app-fun! ast fun)
		       (zodiac:set-app-args! ast args)
		       (set-app-tail?! (get-annotation ast) tail?)

		       (register-arity! (length args))

		       (values ast multi))))]
		 
		 ;;-------------------------------------------------------------------
		 ;; STRUCT
		 ;;
		 ;; nothing much to do except analyze the super position
		 ;;
		 [(zodiac:struct-form? ast)
		  (let ([super (zodiac:struct-form-super ast)])
		    (when super
		      (zodiac:set-struct-form-super! ast (analyze!-sv super env inlined)))
		    (values ast #t))]

		 ;;--------------------------------------------------------------------
		 ;; UNIT
		 ;;    with unit, we need to make a recursive call.  We
		 ;;    extend the lexical environment with variables defined
		 ;;    in the unit and imported variables. Collect the free
		 ;;    variable information.
		 ;;
		 [(zodiac:unit-form? ast)

		  (let* ([code (get-annotation ast)]
			 [defines (unit-code-defines code)]
			 [import-anchors (unit-code-import-anchors code)]
			 [export-anchors (unit-code-export-anchors code)]
			 [anchors (append import-anchors export-anchors)]
			 [imports (zodiac:unit-form-imports ast)]
			 [body (car (zodiac:unit-form-clauses ast))])
		    
		    ;; recur on the body
		    (let ([body (analyze-code-body! body
						    (list->set (append imports defines anchors))
						    env
						    #t
						    code)])
		      (register-code-vars! code #t)
		      (set-car! (zodiac:unit-form-clauses ast) body))

		    (unless (set-empty? (set-minus (code-global-vars code)
						   (make-singleton-set
						    const:the-per-load-statics-table)))
		      (compiler:internal-error
		       ast
		       "global variables used in unit: ~s"
		       (set->list (code-global-vars code))))
		    
		    (values ast #f))]
		 
		 ;;-------------------------------------------------------------------
		 ;; COMPOUND UNIT
		 ;;
		 ;; analyze the contituent exprs, and build up the import
		 ;;  and export lists. Generate the map for linking
		 ;;
		 [(zodiac:compound-unit-form? ast)
		  (for-each (lambda (link)
			      (set-car! (cdr link)
					(analyze!-sv (cadr link) env inlined)))
			    (zodiac:compound-unit-form-links ast))
		  
		  (register-arity! (length (zodiac:compound-unit-form-links ast)))

		  (let* ([import-symbols
			  (map zodiac:binding-orig-name (zodiac:compound-unit-form-imports ast))]
			 [export-symbols (map (lambda (e) (list*
							   (zodiac:read-object (car e))
							   (zodiac:read-object (cadr e))
							   (zodiac:read-object (cddr e))))
					      (zodiac:compound-unit-form-exports ast))]
			 [link-symbols (map (lambda (link) 
					      (cons (zodiac:read-object (car link))
						    (map (lambda (l)
							   (if (zodiac:bound-varref? l)
							       (zodiac:binding-orig-name (zodiac:bound-varref-binding l))
							       (cons (zodiac:read-object (car l))
								     (zodiac:read-object (cdr l)))))
							 (cddr link))))
					    (zodiac:compound-unit-form-links ast))]

			 ; Precompute refs to import names and refs to tags as integers
			 ; instead of names
			 [tags (map car link-symbols)]
			 [find-pos (lambda (s l)
				     (let loop ([l l][p 0])
				       (cond
					[(null? l)
					 (compiler:internal-error
					  ast
					  (format "can't find id ~a for building compound assembly" s))]
					[(eq? s (car l)) p]
					[else (loop (cdr l) (add1 p))])))]
			 
			 [export-symbols
			  (map (lambda (tri)
				 (cons (find-pos (car tri) tags) 
				       (let ([p (cdr tri)]) ; abbrev (a . a) as a
					 (if (eq? (car p) (cdr p))
					     (car p)
					     p))))
			       export-symbols)]
			 [link-symbols
			  (map (lambda (link)
				 (cons (car link)
				       (map (lambda (l)
					      (if (symbol? l)
						  (find-pos l import-symbols)
						  (cons (find-pos (car l) tags)
							(cdr l))))
					    (cdr link))))
			       link-symbols)]

			 [exports (analyze-quote! 
				   (list->zodiac:quote export-symbols ast)
				   #t)]
			 [imports (analyze-quote! 
				   (list->zodiac:quote (length import-symbols) ast)
				   #t)]
			 [links (analyze-quote! 
				 (list->zodiac:quote link-symbols ast)
				 #t)])
		    
		    (let ([info (make-compound-info (compiler:add-compound-unit! ast)
						    imports
						    exports
						    links)])
		      (set-annotation! ast info)))
		  
		  (values ast #f)]

		 ;;-----------------------------------------------------------
		 ;; INVOKE
		 ;;
		 ;; mark bindings as unit/i-e and remember anchors
		 ;; 
		 [(zodiac:invoke-unit-form? ast)
		  (zodiac:set-invoke-unit-form-unit!
		   ast 
		   (analyze!-sv (zodiac:invoke-unit-form-unit ast) env inlined))

		  (set-annotation!
		   ast
		   (make-invoke-info
		    (map 
		     (lambda (v)
		       (let ([v (analyze-varref! v env #f #t)])
			 (if (zodiac:bound-varref? v)
			     (let* ([zbinding (zodiac:bound-varref-binding v)]
				    [binding (get-annotation zbinding)])
			       (when (binding-known? binding)
				 (set-binding-known-but-used?! binding #t))
			       (let ([anchor (binding-anchor binding)])
				 (when anchor
				   ; mark var as captured so its anchor gets
				   ; unpacked by this expression's
				   ; procedure (if we happen to be in a procedure)
				   (set! captured-vars (set-union-singleton captured-vars zbinding)))
				 anchor))
			     v)))
		     (zodiac:invoke-unit-form-variables ast))))
		  
		  ; unit + vars + anchors as args:
		  (register-arity! (+ 1 (* 2 (length (zodiac:invoke-unit-form-variables ast)))))
		  
		  (values ast 'possible)]

		 ;;-----------------------------------------------------------
		 ;; CLASS
		 ;;
		 [(zodiac:class*/names-form? ast)
		  (let* ([code (get-annotation ast)]
			 [public-lookup-bindings (class-code-public-lookup-bindings code)]
			 [public-define-bindings (class-code-public-define-bindings code)]
			 [override-lookup-bindings (class-code-override-lookup-bindings code)]
			 [override-define-bindings (class-code-override-define-bindings code)]
			 [private-bindings (class-code-private-bindings code)]
			 [inherit-bindings (class-code-inherit-bindings code)]
			 [rename-bindings (class-code-rename-bindings code)]
			 [bindings (append (list (zodiac:class*/names-form-this ast)
						 (zodiac:class*/names-form-super-init ast))
					   (map
					    (lambda (b) (if (pair? b) (car b) b))
					    (zodiac:paroptarglist-vars
					     (zodiac:class*/names-form-init-vars ast)))
					   public-lookup-bindings
					   public-define-bindings
					   override-lookup-bindings
					   override-define-bindings
					   private-bindings
					   inherit-bindings
					   rename-bindings)])
		    
		    ; Analyze super-expr & interfaces
		    (zodiac:set-class*/names-form-super-expr! 
		     ast 
		     (analyze!-sv (zodiac:class*/names-form-super-expr ast) env inlined))
		    (zodiac:set-class*/names-form-interfaces! 
		     ast
		     (map (lambda (i) (analyze!-sv i env inlined))
			  (zodiac:class*/names-form-interfaces ast)))
		    
		    ; To create the class assembly, super + interfaces are collected as args
		    (register-arity! (add1 (length (zodiac:class*/names-form-interfaces ast))))

		    ; Now body, collecting closure info
		    (let ([l (zodiac:sequence-clause-exprs
			      (car (zodiac:class*/names-form-inst-clauses ast)))])
		      (set-car! l
				(analyze-code-body! (car l)
						    (list->set bindings)
						    env
						    #f
						    code)))

		    ; Now init args, collecting more closure info
		    (class-init-defaults-map!
		     ast
		     (lambda (var ast)
		       (analyze-code-body! ast
					   (list->set bindings)
					   env
					   #f
					   code)))
		    
		    (register-code-vars! code #f)

		    (values ast #f))]

		 ;;-------------------------------------------------------------------
		 ;; INTERFACE
		 ;;
		 ;; analyze the super exprs, register arity, and build assembly
		 ;;
		 [(zodiac:interface-form? ast)
		  (zodiac:set-interface-form-super-exprs!
		   ast
		   (map (lambda (expr) (analyze!-sv expr env inlined))
			(zodiac:interface-form-super-exprs ast)))

		  (register-arity! (length (zodiac:interface-form-super-exprs ast)))
		  
		  (set-interface-info-assembly! (get-annotation ast) 
						(compiler:add-interface! ast))
		  
		  (values ast #f)]

		 ;;-------------------------------------------------------------------
		 ;; WITH-CONTINUATION-MARK
		 ;;
		 ;; analyze the key, val, and body
		 ;;
		 [(zodiac:with-continuation-mark-form? ast)
		  
		  (zodiac:set-with-continuation-mark-form-key!
		   ast
		   (analyze!-sv (zodiac:with-continuation-mark-form-key ast) env inlined))
		 
		  (zodiac:set-with-continuation-mark-form-val!
		   ast
		   (analyze!-sv (zodiac:with-continuation-mark-form-val ast) env inlined))
		 
		  (let-values ([(body body-multi) 
				(analyze! (zodiac:with-continuation-mark-form-body ast) env inlined tail? #t)])
		    
		    (if (or tail? wcm-tail?)
			; No frame push, so no need for begin0-like handling
			(set-annotation! ast #f)
			
			(let ([var (get-annotation ast)])
			  (add-local-var! var)))
		    
		    (values ast body-multi))]
		 
		 [else (compiler:internal-error
			ast
			(format "unsupported syntactic form (~a)"
				(if (struct? ast)
				    (vector-ref (struct->vector ast) 0)
				    ast)))]))])
	  
	  ;; analyze the expression and return it with the local variables
	  ;; it creates.  
	  (let-values ([(ast multi) (analyze! ast env 0 tail? #f)])
	    (values ast
		    free-vars
		    local-vars
		    global-vars
		    locals-used
		    captured-vars
		    codes
		    max-arity
		    multi))))))

  )
