Analysis

This pass converts the core form into an annotated analyzed form.

The real purpose of this pass is to collect up information which we will use in later passes to simplify the program. To that end, we need to know

• Which bound variables (from the formals) in each lambda-expression are assigned with set! (used when we remove the set! from from the program, in the assignment elimination pass)
• Which heap-allocated literals -- quoted symbols, strings, vectors and lists -- are used in the program
• The free variables of each lambda expression (used when we assign locations to variables in the code-generation form pass)

We will annotate each lambda with the free and assigned variables of the lambda by using ``dead'' quote expressions in the body of the lambdas:

(lambda (x)   ==> (lambda (x)
  (set! x 3))       (quote (assigned x)) (quote (free))
                    (set! x 3))
        
(lambda (x)   ==> (lambda (x)
  (lambda (y)       (quote (assigned)) (quote (free))
    x))             (lambda (y)
                      (quote (assigned)) (quote (free x))
                      x))

(cons '(1) '(2 3)) ==> (let ((fresh1 '(1))
                             (fresh2 '(2 3)))
                         (cons fresh1 fresh2))

(gensym) --> symbol
generates a symbol guaranteed not to be eq? with any other symbol.

In order to make this pass intelligible, you may wish to use Scheme's multiple-values mechanism, allowing expressions to return more than one value (four values, in this case: the expression plus the three sets of analyzed values). To assist in this, you may want to use the following macro to implement multiple-valued let:

(define-syntax mv-let
  (syntax-rules ()
    [(_ () b0 b1 ...)
     (begin b0 b1 ...)]
    [(_ ((formals e) decl ...) b0 b1 ...)
     (let ((t (lambda () e)))
       (mv-let (decl ...)
	 (call-with-values t (lambda formals b0 b1 ...))))]))

Skeleton

(define *prim-names*
  '(+ - * / = < boolean? car cdr char? char->integer cons eq?
     integer? string->uninterned-symbol not null? pair? procedure?
     string string? string-length string-ref
     vector vector? vector-length vector-ref
     vector-set! symbol? symbol->string))

(define analyzed-form
  (lambda (exp)
    (mv-let ([(exp quotes assigned free)
	      (analyze exp '())])
      `(let ,quotes ,exp))))

(define analyze  ;; returns: exp, quote-pairs, assigned, free
  (lambda (exp env)
    (if (not (pair? exp))
	...
	(record-case exp
	  ...
	  [if (t c a)
	    (mv-let ([(t-exp t-quotes t-poked t-free) (analyze t env)]
		     [(c-exp c-quotes c-poked c-free) (analyze c env)]
		     [(a-exp a-quotes a-poked a-free) (analyze a env)])
	      (values `(if ,t-exp ,c-exp ,a-exp)
		(append t-quotes c-quotes a-quotes)
		(union (union t-poked c-poked) a-poked)
		(union (union t-free c-free) a-free)))]
	  ...
	  ))))

(define analyze-list ;; returns: list-of-exps, quote-pairs, assigned, free
  (lambda (ls env)
    (if (null? ls)
	(values '() '() '() '())
	(mv-let ([(head-exp head-quoted head-assigned head-free)
		  (analyze (car ls) env)]
		 [(tail-exps tail-quoted tail-assigned tail-free)
		  (analyze-list (cdr ls) env)])
	  (values (cons head-exp tail-exps)
	    (append head-quoted tail-quoted)
	    (union head-assigned tail-assigned)
	    (union head-free tail-free))))))

(define union
  (lambda (a b)
    (cond
      [(null? a) b]
      [(memq (car a) b) (union (cdr a) b)]
      [else (cons (car a) (union (cdr a) b))])))

(define difference
  (lambda (a b)
    (cond
      [(null? a) '()]
      [(memq (car a) b) (difference (cdr a) b)]
      [else (cons (car a) (difference (cdr a) b))])))

(define intersection
  (lambda (a b)
    (cond
      [(null? a) '()]
      [(memq (car a) b) (cons (car a) (intersection (cdr a) b))]
      [else (intersection (cdr a) b)])))

(define unit-set
  (lambda (item)
    (list item)))

(define set?
  (lambda (ls)
    (or (null? ls)
	(and (not (memq (car ls) (cdr ls)))
	     (set? (cdr ls))))))

Examples

> (analyzed-form '(lambda (x) x))
(let () (lambda (x) '(assigned) '(free) x))
> (analyzed-form '(lambda () '(1 2)))
(let ([#:g16 '(1 2)])
  (lambda () '(assigned) '(free #:g16) #:g16))
> (analyzed-form '(lambda (x) (begin (set! x '3) x)))
(let ()
  (lambda (x) '(assigned x) '(free) (begin (set! x '3) x)))
> (analyzed-form '(lambda (x) (lambda (y) x)))
(let ()
  (lambda (x)
    '(assigned)
    '(free)
    (lambda (y) '(assigned) '(free x) x)))
> (analyzed-form '(lambda (x) (lambda (y) (set! x y))))
(let ()
  (lambda (x)
    '(assigned x)
    '(free)
    (lambda (y) '(assigned) '(free x) (set! x y))))
>