From 0e6975fb2c0816071e8e4a7ecc35385d72c31244 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Thu, 21 Mar 2013 21:38:34 -0500
Subject: [PATCH] add 'values' to plai/gc2/mutator language

---
 collects/plai/gc2/mutator.rkt                | 46 +++++++++++++++++---
 collects/tests/plai/gc2/good-mutators/mv.rkt | 13 ++++++
 collects/tests/plai/gc2/run-test.rkt         | 21 ++++++++-
 3 files changed, 73 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/plai/gc2/good-mutators/mv.rkt

diff --git a/collects/plai/gc2/mutator.rkt b/collects/plai/gc2/mutator.rkt
index 45ff8e63c3..dc6b0b5f1f 100644
--- a/collects/plai/gc2/mutator.rkt
+++ b/collects/plai/gc2/mutator.rkt
@@ -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)
diff --git a/collects/tests/plai/gc2/good-mutators/mv.rkt b/collects/tests/plai/gc2/good-mutators/mv.rkt
new file mode 100644
index 0000000000..ffa93dea28
--- /dev/null
+++ b/collects/tests/plai/gc2/good-mutators/mv.rkt
@@ -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)
\ No newline at end of file
diff --git a/collects/tests/plai/gc2/run-test.rkt b/collects/tests/plai/gc2/run-test.rkt
index de3e2fda6d..d6be378698 100644
--- a/collects/tests/plai/gc2/run-test.rkt
+++ b/collects/tests/plai/gc2/run-test.rkt
@@ -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
+    )))