From b46ff2a045c340ec593aaed8fb30203a70abf7b1 Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Tue, 30 Aug 2011 16:51:05 -0400
Subject: [PATCH] repairing damage from introducing that traced-app into shared

---
 lang/private/shared-body.rkt | 31 ++++++++++++++++++-------------
 lang/private/shared.rkt      |  3 ++-
 lang/private/traced-app.rkt  |  2 +-
 3 files changed, 21 insertions(+), 15 deletions(-)

diff --git a/lang/private/shared-body.rkt b/lang/private/shared-body.rkt
index 8d6b460..2ed370e 100644
--- a/lang/private/shared-body.rkt
+++ b/lang/private/shared-body.rkt
@@ -25,21 +25,26 @@
 	  stx
 	  dup)))
      (let ([exprs (map (lambda (expr)
-                         (printf "before: ~s\n" (syntax->datum expr))
-                         (let ([result
-                           (let ([e (local-expand
-                                     expr
-                                     'expression
-                                     (append
-                                      (kernel-form-identifier-list)
-                                      names))])
+                         (let ([e (local-expand
+                                   expr
+                                   'expression
+                                   (append
+                                    (kernel-form-identifier-list)
+                                    names))])
+                           
+                           ;; Remove traced app if present
+                           (let ([removing-traced-app
+                                  (syntax-case (syntax-disarm e code-insp) (with-continuation-mark traced-app-key)
+                                    [(with-continuation-mark traced-app-key val body)
+                                     (syntax/loc e body)]
+                                    [else 
+                                     e])])
+                             
                              ;; Remove #%app if present...
-                             (syntax-case (syntax-disarm e code-insp) (#%plain-app)
+                             (syntax-case (syntax-disarm removing-traced-app code-insp) (#%plain-app)
                                [(#%plain-app a ...)
-                                (syntax/loc e (a ...))]
-                               [_else e]))])
-                           (printf "expanded to: ~s\n" (syntax->datum result))
-                           result))
+                                (syntax/loc removing-traced-app (a ...))]
+                               [_else removing-traced-app]))))
 		       exprs)]
            [temp-ids (generate-temporaries names)]
            [placeholder-ids (generate-temporaries names)]
diff --git a/lang/private/shared.rkt b/lang/private/shared.rkt
index faf6137..7411515 100644
--- a/lang/private/shared.rkt
+++ b/lang/private/shared.rkt
@@ -5,7 +5,8 @@
                      syntax/kerncase
                      syntax/struct
                      racket/struct-info
-                     scheme/include))
+                     scheme/include)
+         "traced-app.rkt")
 
 (provide shared)
 
diff --git a/lang/private/traced-app.rkt b/lang/private/traced-app.rkt
index efb64d2..ef595c1 100644
--- a/lang/private/traced-app.rkt
+++ b/lang/private/traced-app.rkt
@@ -19,6 +19,6 @@
                                    (syntax-span stx))])
          (syntax/loc stx
            (with-continuation-mark key 'pos
-                                   (#%app operator operands ...))))]
+                                   (#%plain-app operator operands ...))))]
       [else
        stx])))