From 717a61840f5e80816d4b3a6079d21b4524143e61 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 11 Apr 2011 10:00:01 -0600
Subject: [PATCH] racket/trace: fix for expr-style printing (i.e., default
 `print' mode)

---
 collects/racket/trace.rkt        | 35 +++++++++++++++++++++++++++-----
 collects/tests/racket/trace.rktl | 17 ++++++++++++++++
 2 files changed, 47 insertions(+), 5 deletions(-)

diff --git a/collects/racket/trace.rkt b/collects/racket/trace.rkt
index aa40405b5e..d759781670 100644
--- a/collects/racket/trace.rkt
+++ b/collects/racket/trace.rkt
@@ -1,7 +1,7 @@
-#lang scheme/base
+#lang racket/base
 
-(require scheme/pretty
-         (for-syntax scheme/base))
+(require racket/pretty
+         (for-syntax racket/base))
 
 (provide trace untrace
          current-trace-print-results
@@ -86,6 +86,10 @@
      (lambda ()
        ((current-trace-print-args) name args kws kw-vals level)))))
 
+(struct plain (val)
+  #:property prop:custom-write (lambda (p port mode)
+                                 (write (plain-val p) port)))
+
 (define current-trace-print-args
   (make-parameter
    (lambda (name args kws kw-vals level)
@@ -103,8 +107,29 @@
                                  (string-length first)
                                  (string-length rest))
                              0))))
-         (pretty-print (append (cons name args)
-                               (apply append (map list kws kw-vals)))))))))
+         ;; Printing the function call in a way that adapts to
+         ;; different value printing --- currently a hack
+         (cond
+          [(print-as-expression)
+           ;; In expression mode, represent a function call as a
+           ;; transparent structure, so that it prints as a constructor
+           ;; application. Also, protect keywords for keyword arguments
+           ;; so that they print without quoting.
+           (let ([args (append args
+                               (apply append (map (lambda (kw val)
+                                                    (list (plain kw) val))
+                                                  kws 
+                                                  kw-vals)))])
+             (let-values ([(struct: make- ? -ref -set!) 
+                           (make-struct-type name #f
+                                             (length args) 0 #f
+                                             null #f #f null #f
+                                             name)])
+               (pretty-print (apply make- args))))]
+          [else
+           ;; In non-expression mode, just use `write':
+           (pretty-write (append (cons name args)
+                                 (apply append (map list kws kw-vals))))]))))))
 
 (define -:trace-print-results
   (lambda (name results level)
diff --git a/collects/tests/racket/trace.rktl b/collects/tests/racket/trace.rktl
index 4a04d675cf..f14e10926a 100644
--- a/collects/tests/racket/trace.rktl
+++ b/collects/tests/racket/trace.rktl
@@ -51,3 +51,20 @@
             "> (a 1)"
             "< 1"
             "<2"))
+
+(test (trace-output
+       (define (f x #:q w) (list x 1))
+       (trace f)
+       (f #:q (box 18) '(1 2 3)))
+      'trace-quotes
+      (list ">(f '(1 2 3) #:q '#&18)"
+            "<'((1 2 3) 1)"))
+
+(parameterize ([print-as-expression #f])
+  (test (trace-output
+         (define (f x #:q w) (list x 1))
+         (trace f)
+         (f #:q (box 18) '(1 2 3)))
+        'trace-quotes
+        (list ">(f (1 2 3) #:q #&18)"
+              "<((1 2 3) 1)")))