Add test-uncover-locals

This commit is contained in:
Enrico Lumetti 2021-05-01 00:38:17 +02:00
parent 4c67b0f18d
commit 85dbf65800
2 changed files with 37 additions and 0 deletions

15
test-uncover-locals.scm Normal file
View File

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

22
uncover-locals.scm Normal file
View File

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