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:

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

To generate the fresh variable, use the scheme procedure(cons '(1) '(2 3)) ==> (let ((fresh1 '(1)) (fresh2 '(2 3))) (cons fresh1 fresh2))

`gensym`

:
like`(gensym)`

-->symbol

generates a symbol guaranteed not to beeq?with any other symbol.

`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 ...))))]))

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

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