From 11cd0a569124682dc32fa1ffcd702760be8bf5f6 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 10 Mar 2009 13:49:40 +0000
Subject: [PATCH] fixed tracing in the teaching languages

svn: r14026
---
 collects/lang/htdp-langs.ss  |  6 ++----
 collects/trace/stacktrace.ss | 29 ++++++++++++++++++-----------
 2 files changed, 20 insertions(+), 15 deletions(-)

diff --git a/collects/lang/htdp-langs.ss b/collects/lang/htdp-langs.ss
index c205b937b8..c956ee557c 100644
--- a/collects/lang/htdp-langs.ss
+++ b/collects/lang/htdp-langs.ss
@@ -267,7 +267,6 @@
                                   (string-constant use-pretty-printer-label)
                                   output-panel
                                   void)]
-               #;
                [tracing (new check-box%
                              (parent output-panel)
                              (label sc-tracing)
@@ -306,7 +305,7 @@
               (and allow-sharing-config? (send show-sharing get-value))
               (send insert-newlines get-value)
               'none
-              #f ;; (send tracing get-value) -- disabled tracing
+              (send tracing get-value)
               tps)]
             [(settings)
              (send case-sensitive set-value (drscheme:language:simple-settings-case-sensitive settings))
@@ -341,8 +340,7 @@
                                [parent tp-panel]
                                [label (format "~s" tp)]))
                   tps))
-             ;; disabled tracing
-             #; (send tracing set-value (htdp-lang-settings-tracing? settings))
+             (send tracing set-value (htdp-lang-settings-tracing? settings))
              (void)])))
       
       (define simple-htdp-language%
diff --git a/collects/trace/stacktrace.ss b/collects/trace/stacktrace.ss
index 33558c9e09..931e8e0513 100644
--- a/collects/trace/stacktrace.ss
+++ b/collects/trace/stacktrace.ss
@@ -42,22 +42,26 @@
         (kernel-syntax-case stx #f
           [(define-values (var ...) expr)
            (let ([var-list (syntax->list #'(var ...))])
-             (cond [(= (length var-list) 1) #`(define-values (var ...) #,(expr-iterator #'expr (car var-list) (current-code-inspector)))]
-                   [else #`(define-values (var ...) #,(expr-iterator #'expr #f (current-code-inspector)))]))]
+             (cond [(= (length var-list) 1) #`(define-values (var ...) 
+                                                #,(expr-iterator #'expr 
+                                                                 (car var-list)
+                                                                 (current-code-inspector)
+                                                                 #f))]
+                   [else #`(define-values (var ...) #,(expr-iterator #'expr #f (current-code-inspector) #f))]))]
           [(define-syntaxes (var ...) expr)
-           #`(define-syntaxes (var ...) #,(expr-iterator #'expr #f (current-code-inspector)))]
+           #`(define-syntaxes (var ...) #,(expr-iterator #'expr #f (current-code-inspector) #t))]
           [(begin . top-level-exprs)
            #`(begin #,@(map top-level-expr-iterator (syntax->list #'top-level-exprs)))]
           [(#%require . require-specs)
            stx]
           [else
-           (expr-iterator stx #f (current-code-inspector))]))
+           (expr-iterator stx #f (current-code-inspector) #f)]))
   
-      (define (expr-iterator stx potential-name insp)
+      (define (expr-iterator stx potential-name insp trans?-expr)
         (let* ([name-guess (or (syntax-property stx 'inferred-name) potential-name)]
-               [recur-tail (lambda (expr) (expr-iterator expr name-guess insp))]
-               [recur-non-tail (lambda (expr) (expr-iterator expr #f insp))]
-               [recur-with-name (lambda (expr name) (expr-iterator expr name insp))]
+               [recur-tail (lambda (expr) (expr-iterator expr name-guess insp trans?-expr))]
+               [recur-non-tail (lambda (expr) (expr-iterator expr #f insp trans?-expr))]
+               [recur-with-name (lambda (expr name) (expr-iterator expr name insp trans?-expr))]
                [recur-on-sequence (lambda (exprs) 
                                     (let loop ([remaining exprs])
                                       (cond [(null? remaining) null]
@@ -112,7 +116,7 @@
                             ;(syntax->datum stx)
                             )]))]) 
           (syntax-recertify
-           (kernel-syntax-case stx #f
+           (kernel-syntax-case stx trans?-expr
              [var-stx
               (identifier? (syntax var-stx))
               stx]
@@ -149,8 +153,11 @@
              [(#%top . var)
               stx]
              [else
-              (error 'expr-iterator "unknown expr: ~a" 
-                     (syntax->datum stx))])
+              (if trans?-expr
+                  stx
+                  (error 'expr-iterator "unknown expression: ~s ~s" 
+                         stx
+                         (syntax->datum stx)))])
            stx
            insp
            #f)))