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

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))
And we will collect up the heap-allocated literals by replacing them with fresh variables, and then binding the fresh variables at the top of the program with a let:
(cons '(1) '(2 3)) ==> (let ((fresh1 '(1))
                             (fresh2 '(2 3)))
                         (cons fresh1 fresh2))
To generate the fresh variable, use the scheme procedure gensym:
(gensym) --> symbol
generates a symbol guaranteed not to be eq? with any other symbol.
like open-input-string, gensym is not standard Scheme, but is defined in almost every Scheme system.

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))))
> 

ehilsdal@cs.indiana.edu