diff --git a/test-uncover-locals.scm b/test-uncover-locals.scm new file mode 100644 index 0000000..149cb03 --- /dev/null +++ b/test-uncover-locals.scm @@ -0,0 +1,15 @@ +#lang racket + +(require "uncover-locals.scm") +(require "test-util.scm") + +(define programs + (list + `(program () + ((start . (seq (assign x.1 20) (seq (assign x.2 3) (return (+ x.1 x.2))))))))) + +(test-eq + (cadr (uncover-locals (list-ref programs 0))) + `(locals . (x.1 x.2))) + + diff --git a/uncover-locals.scm b/uncover-locals.scm new file mode 100644 index 0000000..b24b6e7 --- /dev/null +++ b/uncover-locals.scm @@ -0,0 +1,22 @@ +#lang racket + +(provide uncover-locals) + +(define (uncover-locals p) + (match p + [`(program ,data ,c0-blocks) + `(program ,(append data (cons `locals (uncover-locals-blocks c0-blocks))) c0-blocks)])) + +(define (uncover-locals-blocks c0-blocks) + (if (empty? c0-blocks) + `() + (append (uncover-locals-block (car c0-blocks)) (uncover-locals-blocks (cdr c0-blocks))))) + +(define (uncover-locals-block c0-block) + (match c0-block + [`(,label . ,tail) (uncover-locals-tail tail)])) + +(define (uncover-locals-tail c0-tail) + (match c0-tail + [`(return ,exp) `()] + [`(seq (assign ,var ,exp) ,next) (cons var (uncover-locals-tail next))]))