From ffcda4741f1d9194b3bf3c47175c6ccf9fa681ca Mon Sep 17 00:00:00 2001 From: Jay McCarthy Date: Tue, 28 Feb 2012 14:14:26 -0700 Subject: [PATCH] Fixing a safe-for-space error that Robby found --- collects/plai/gc2/mutator.rkt | 20 +++++++++++++------ collects/plai/mutator.rkt | 20 +++++++++++++------ collects/tests/plai/gc/good-mutators/sfs.rkt | 5 +++++ collects/tests/plai/gc2/good-mutators/sfs.rkt | 5 +++++ .../plai/gc2/good-mutators/student-1.rkt | 2 +- 5 files changed, 39 insertions(+), 13 deletions(-) create mode 100644 collects/tests/plai/gc/good-mutators/sfs.rkt create mode 100644 collects/tests/plai/gc2/good-mutators/sfs.rkt diff --git a/collects/plai/gc2/mutator.rkt b/collects/plai/gc2/mutator.rkt index b23d59431c..b365558a20 100644 --- a/collects/plai/gc2/mutator.rkt +++ b/collects/plai/gc2/mutator.rkt @@ -145,16 +145,21 @@ (syntax/loc stx (let*-values ([(tmp ...) (syntax-parameterize ([mutator-env-roots - (list* #'previous-tmp ... - (syntax-parameter-value #'mutator-env-roots))] + (append + (find-referenced-locals + (list #'previous-tmp ...) + #'expr) + (syntax-parameter-value #'mutator-env-roots))] [mutator-tail-call? #f]) expr)] ...) (let-values ([(id ...) (values tmp ...)] ...) (syntax-parameterize ([mutator-env-roots - (list* #'id ... ... - (syntax-parameter-value #'mutator-env-roots))]) + (append (find-referenced-locals + (list #'id ... ...) + #'body-expr) + (syntax-parameter-value #'mutator-env-roots))]) (->address body-expr))))))))] [(_ ([(id ...) expr] ...) @@ -185,8 +190,11 @@ (let ([closure (lambda (free-id ... id ...) (syntax-parameterize ([mutator-env-roots - (list #'id ... - #'free-id ...)] + (append + (find-referenced-locals + (list #'id ...) + #'body) + (list #'free-id ...))] [mutator-tail-call? #t]) (->address body)))]) closure))]) diff --git a/collects/plai/mutator.rkt b/collects/plai/mutator.rkt index d0781db141..69bffd0f58 100644 --- a/collects/plai/mutator.rkt +++ b/collects/plai/mutator.rkt @@ -145,16 +145,21 @@ (syntax/loc stx (let*-values ([(tmp ...) (syntax-parameterize ([mutator-env-roots - (list* #'previous-tmp ... - (syntax-parameter-value #'mutator-env-roots))] + (append + (find-referenced-locals + (list #'previous-tmp ...) + #'expr) + (syntax-parameter-value #'mutator-env-roots))] [mutator-tail-call? #f]) expr)] ...) (let-values ([(id ...) (values tmp ...)] ...) (syntax-parameterize ([mutator-env-roots - (list* #'id ... ... - (syntax-parameter-value #'mutator-env-roots))]) + (append (find-referenced-locals + (list #'id ... ...) + #'body-expr) + (syntax-parameter-value #'mutator-env-roots))]) (->address body-expr))))))))] [(_ ([(id ...) expr] ...) @@ -181,8 +186,11 @@ (quasisyntax/loc stx (let ([closure (lambda (id ...) (syntax-parameterize ([mutator-env-roots - (list #'id ... - #'free-id ...)] + (append + (find-referenced-locals + (list #'id ...) + #'body) + (list #'free-id ...))] [mutator-tail-call? #t]) (->address body)))]) (add-closure-env! closure (list (make-env-root free-id) ...)) diff --git a/collects/tests/plai/gc/good-mutators/sfs.rkt b/collects/tests/plai/gc/good-mutators/sfs.rkt new file mode 100644 index 0000000000..e746eeefe0 --- /dev/null +++ b/collects/tests/plai/gc/good-mutators/sfs.rkt @@ -0,0 +1,5 @@ +#lang plai/mutator +(allocator-setup "../good-collectors/good-collector.rkt" 7) +(let ([x (cons 1 2)]) + (let ([y (cons 3 4)]) + y)) diff --git a/collects/tests/plai/gc2/good-mutators/sfs.rkt b/collects/tests/plai/gc2/good-mutators/sfs.rkt new file mode 100644 index 0000000000..9914f17784 --- /dev/null +++ b/collects/tests/plai/gc2/good-mutators/sfs.rkt @@ -0,0 +1,5 @@ +#lang plai/gc2/mutator +(allocator-setup "../good-collectors/good-collector.rkt" 7) +(let ([x (cons 1 2)]) + (let ([y (cons 3 4)]) + y)) diff --git a/collects/tests/plai/gc2/good-mutators/student-1.rkt b/collects/tests/plai/gc2/good-mutators/student-1.rkt index 5eec435959..b8e1492442 100644 --- a/collects/tests/plai/gc2/good-mutators/student-1.rkt +++ b/collects/tests/plai/gc2/good-mutators/student-1.rkt @@ -15,7 +15,7 @@ ; Finally it runs the sample tests distributed with the assignment -(allocator-setup "../good-collectors/good-collector.rkt" 110) +(allocator-setup "../good-collectors/good-collector.rkt" 112) ; Helper to generate long lists (define (gen-list x)