Added trace-define, trace-let, trace-lambda

In racket/collects/racket/trace.rkt

pkgs/racket-pkgs/racket-doc/scribblings/reference/trace.scrbl

@@ -3,7 +3,8 @@
           scribble/eval)
 
 @(begin (define ev (make-base-eval))
-        (ev '(require racket/trace)))
+        (ev '(require racket/trace))
+        (ev '(require (for-syntax racket/base))))
 
 @title{Tracing}
 
@@ -49,6 +50,79 @@ The result of a @racket[trace] expression is @|void-const|.
 
 }
 
+@defform*[((trace-define id expr)
+           (trace-define (head args) body ...+))]{
+
+The @racket[trace-define] form is short-hand for first defining a
+function then tracing it. This form supports all @racket[define] forms.
+
+@examples[#:eval ev
+(trace-define (f x) (if (zero? x) 0 (add1 (f (sub1 x)))))
+(f 5)
+]
+
+@examples[#:eval ev
+(trace-define ((+n n) x) (+ n x))
+(map (+n 5) (list 1 3 4))
+]}
+
+@defform*[((trace-define-syntax id expr)
+           (trace-define-syntax (head args) body ...+))]{
+
+The @racket[trace-define-syntax] form is short-hand for first defining a
+macro then tracing it. This form supports all @racket[define-syntax] forms.
+
+For example:
+
+@examples[#:eval ev
+(trace-define-syntax fact
+  (syntax-rules ()
+    [(_ x) 120]))
+(fact 5)
+]
+
+By default, @racket[trace] prints out syntax objects when tracing a
+macro. This can result in too much output if you do not need to see,
+e.g., source information. To get more readable output, try this:
+
+@examples[#:eval ev
+  (require (for-syntax racket/trace))
+  (begin-for-syntax
+    (current-trace-print-args
+      (let ([ctpa (current-trace-print-args)])
+        (lambda (s l kw l2 n)
+          (ctpa s (map syntax->datum l) kw l2 n))))
+    (current-trace-print-results
+      (let ([ctpr (current-trace-print-results)])
+        (lambda (s l n)
+         (ctpr s (map syntax->datum l) n)))))
+
+  (trace-define-syntax fact
+  (syntax-rules ()
+    [(_ x) #'120]))
+  (fact 5)]}
+
+@defform[(trace-lambda [#:name id] args expr)]{
+
+The @racket[trace-lambda] form enables tracing an anonymous function. This
+form will attempt to infer a name using
+@racket[syntax-local-infer-name], or a name can be specified using the
+optional @racket[#:name] argument.  A syntax error is raised if a name
+is not given and a name cannot be inferred.
+
+@examples[#:eval ev
+  ((trace-lambda (x) 120) 5)]}
+
+@defform[(trace-let id ([arg expr] ...+) body ...+)]{
+
+The @racket[trace-let] form enables tracing a named let.
+
+@examples[#:eval ev
+  (trace-let f ([x 5])
+    (if (zero? x)
+        1
+        (* x (f (sub1 x)))))]}
+
 @defform[(untrace id ...)]{
 
 Undoes the effects of the @racket[trace] form for each @racket[id],

pkgs/racket-pkgs/racket-test/tests/racket/trace.rktl

@@ -69,4 +69,43 @@
         (list ">(f (1 2 3) #:q #&18)"
               "<((1 2 3) 1)")))
 
+(test
+  (list ">(verbose-fact 2)"
+        "> (verbose-fact 1)"
+        "> >(verbose-fact 0)"
+        "< <1"
+        "> >(verbose-fact 0)"
+        "< <1"
+        "< 1"
+        "> (verbose-fact 1)"
+        "> >(verbose-fact 0)"
+        "< <1"
+        "> >(verbose-fact 0)"
+        "< <1"
+        "< 1"
+        "<2")
+  'trace-define
+  (trace-output
+    (trace-define (verbose-fact x)
+      (if (zero? x)
+        (begin (displayln 1) 1)
+        (begin (displayln (* x (verbose-fact (sub1 x))))
+               (* x (verbose-fact (sub1 x))))))
+    (parameterize ([current-output-port (open-output-nowhere)]) (verbose-fact 2))))
+
+(test
+  (list ">(fact 120)"
+        "<120")
+  'trace-lambda-named
+  (trace-output
+    ((trace-lambda #:name fact (x) x) 120)))
+
+(let ([tout (trace-output ((trace-lambda (x) x) 120))])
+  (local-require racket/match)
+  (test #t
+        'trace-lambda-anonymous
+        (match tout
+          [(list (pregexp #px">\\(.+\\.rktl?:\\d+:\\d+ 120\\)") "<120") #t]
+          [_ #f])))
+
 (report-errs)

racket/collects/racket/trace.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
 
+(module trace-et-al racket/base
   (require racket/pretty
            (for-syntax racket/base))
 
@@ -292,4 +293,57 @@
       [(_ id ...) (check-ids stx #'(id ...))
                   #'(begin (when (traced-proc? id)
                             (set! id (traced-proc-ref id 1)))
-              ...)]))
+                          ...)])))
+
+(module chez-like racket/base
+  (require
+    (only-in (submod ".." trace-et-al) trace)
+    (for-syntax
+      racket/base
+      syntax/define
+      syntax/name
+      syntax/parse
+      (only-in (submod ".." trace-et-al) trace)))
+
+  (provide trace-define trace-lambda trace-let trace-define-syntax)
+
+  (define-syntax (trace-define stx)
+    (syntax-case stx ()
+      [(_ e ...)
+      (let-values ([(name def) (normalize-definition stx #'lambda)])
+        #`(begin (define #,name #,def) (trace #,name)))]))
+
+  (define-syntax trace-let
+    (syntax-rules ()
+      [(_ name ([x* e*] ...) body ...)
+      ((letrec ([name (lambda (x* ...) body ...)]) (trace name) name)
+        e* ...)]))
+
+  (define-syntax (trace-lambda stx)
+    (define (infer-name-or-error)
+      (or (syntax-local-infer-name stx)
+        (raise-syntax-error
+          'trace-lambda
+          "Could not infer name; give a name explicitly using #:name"
+          stx)))
+    (syntax-parse stx
+      [(_ (~optional (~seq #:name name:id) #:defaults ([name #`#,(infer-name-or-error)])) args body:expr ...)
+      #'(let ([name (lambda args body ...)]) (trace name) name)]))
+
+  (define-syntax (trace-define-syntax stx)
+    (syntax-case stx ()
+      [(_ e ...)
+      (let-values ([(name def) (normalize-definition stx #'lambda)])
+        #`(define-syntax #,name
+            (let ([#,name #,def]) (trace #,name) #,name)))])))
+
+(require 'trace-et-al 'chez-like)
+(provide trace untrace
+         current-trace-print-results
+         current-trace-print-args
+         trace-call
+         current-trace-notify
+         current-prefix-out current-prefix-in
+
+         trace-define trace-let trace-lambda
+         trace-define-syntax)