add 'values' to plai/gc2/mutator language
This commit is contained in:
parent
13bcb73050
commit
0e6975fb2c
|
@ -14,6 +14,7 @@
|
|||
(for-syntax scheme/stxparam-exptime))
|
||||
|
||||
(provide else require provide #%top
|
||||
values
|
||||
test/location=?
|
||||
test/value=?
|
||||
(rename-out
|
||||
|
@ -355,13 +356,46 @@
|
|||
(case-lambda
|
||||
[() (void)]
|
||||
[(result-addr)
|
||||
(show-one-result result-addr)]
|
||||
[result-addrs
|
||||
(show-multiple-results result-addrs)])))]))
|
||||
|
||||
(define (show-one-result result-addr)
|
||||
(cond
|
||||
[(procedure? result-addr)
|
||||
(printf "Imported procedure:\n")
|
||||
result-addr]
|
||||
[(location? result-addr)
|
||||
(printf "Value at location ~a:\n" result-addr)
|
||||
(gc->scheme result-addr)]))
|
||||
|
||||
(define (show-multiple-results results)
|
||||
(define addrs
|
||||
(for/list ([result-addr (in-list results)]
|
||||
#:when (location? result-addr))
|
||||
result-addr))
|
||||
|
||||
(printf "Values at locations ")
|
||||
(cond
|
||||
[(= (length addrs) 2)
|
||||
(printf "~a and ~a:\n" (car addrs) (cadr addrs))]
|
||||
[else
|
||||
(let loop ([addr (car addrs)]
|
||||
[addrs (cdr addrs)])
|
||||
(cond
|
||||
[(null? addrs)
|
||||
(printf "and ~a:\n" addr)]
|
||||
[else
|
||||
(printf "~a, " addr)
|
||||
(loop (car addrs) (cdr addrs))]))])
|
||||
(apply values
|
||||
(for/list ([result (in-list results)])
|
||||
(cond
|
||||
[(procedure? result-addr)
|
||||
(printf "Imported procedure:\n")
|
||||
result-addr]
|
||||
[(location? result-addr)
|
||||
(printf "Value at location ~a:\n" result-addr)
|
||||
(gc->scheme result-addr)])])))]))
|
||||
[(procedure? result)
|
||||
result]
|
||||
[(location? result)
|
||||
(gc->scheme result)]))))
|
||||
|
||||
|
||||
; Module Begin
|
||||
(define-for-syntax (allocator-setup-internal stx)
|
||||
|
|
13
collects/tests/plai/gc2/good-mutators/mv.rkt
Normal file
13
collects/tests/plai/gc2/good-mutators/mv.rkt
Normal file
|
@ -0,0 +1,13 @@
|
|||
#lang plai/gc2/mutator
|
||||
(allocator-setup "../good-collectors/good-collector.rkt" 40)
|
||||
|
||||
(define (f x y)
|
||||
(values (+ x 11) (+ y 3)))
|
||||
|
||||
(let-values ([(x y) (values 1 2)])
|
||||
(let-values ([(a b) (f x y)])
|
||||
(let-values ([(a b) (f a b)])
|
||||
(+ a b))))
|
||||
|
||||
(values 1 2)
|
||||
(values 3 4 5 6 7)
|
|
@ -64,4 +64,23 @@ END
|
|||
|
||||
(test-mutator (build-path here "other-mutators" "quote.rkt"))
|
||||
=error> "alloc: out of space"
|
||||
)
|
||||
|
||||
(when (run-good?)
|
||||
(test
|
||||
(capture-output (test-mutator (build-path here "good-mutators" "mv.rkt")))
|
||||
=>
|
||||
#<<END
|
||||
Value at location 23:
|
||||
31
|
||||
Values at locations 25 and 27:
|
||||
1
|
||||
2
|
||||
Values at locations 29, 31, 33, 35, and 37:
|
||||
3
|
||||
4
|
||||
5
|
||||
6
|
||||
7
|
||||
|
||||
END
|
||||
)))
|
||||
|
|
Loading…
Reference in New Issue
Block a user