From ea26c3f5ef14cf1eb188cc4344042ff9de9fbaef Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Fri, 9 Feb 2007 08:27:02 +0000
Subject: [PATCH] Macro stepper:   fixed bugs re: internal define-syntax  
 de-unitized hiding again, disabled extra navigation for now   fixed bug in
 letrec-syntaxes w/o var bindings   fixed bugs in block splicing  
 distinguished booleans and keywords in syntax browser

svn: r5578

original commit: ca3c367aab7ba9aadc2d1a7f006655eff4911cff
---
 collects/macro-debugger/model/deriv-parser.ss   |  2 +-
 collects/macro-debugger/model/reductions.ss     | 17 +++++++++++------
 .../syntax-browser/pretty-helper.ss             | 16 ++++++++++------
 3 files changed, 22 insertions(+), 13 deletions(-)

diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss
index 393aba6..9ea259c 100644
--- a/collects/macro-debugger/model/deriv-parser.ss
+++ b/collects/macro-debugger/model/deriv-parser.ss
@@ -484,7 +484,7 @@
         (make-b:defvals $3 $4)]
        [(next NoError renames-block CheckImmediateMacro
               prim-define-syntaxes (? BindSyntaxes 'bind))
-        (make-b:defstx $3 $4 $5)])
+        (make-b:defstx $3 $4 $6)])
 
       ;; BindSyntaxes Answer = Derivation
       (BindSyntaxes
diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss
index 21894c0..0299ccd 100644
--- a/collects/macro-debugger/model/reductions.ss
+++ b/collects/macro-debugger/model/reductions.ss
@@ -375,11 +375,13 @@
                           (cons head-rs rss)))]
                  [(AnyQ b:defstx (renames head rhs))
                   (let* ([estx (deriv-e2 head)]
-                         [estx2 (with-syntax ([(?ds ?vars ?rhs) estx]
-                                              [?rhs* (deriv-e2 rhs)])
-                                             ;;FIXME
-                                  (datum->syntax-object estx `(,#'?ds ,#'?vars ,#'?rhs*) estx estx))])
-                    (loop next (cdr suffix) (cons estx2 prefix)
+                         [estx2 (and (deriv? rhs)
+                                     (with-syntax ([(?ds ?vars ?rhs) estx]
+                                                   [?rhs* (deriv-e2 rhs)])
+                                       (datum->syntax-object estx
+                                                             `(,#'?ds ,#'?vars ,#'?rhs*)
+                                                             estx estx)))])
+                    (loop next (stx-cdr suffix) (cons estx2 prefix)
                           (with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
                             (cons (with-context (CC (?ds ?vars ?rhs) estx ?rhs)
                                     (reductions rhs))
@@ -433,7 +435,10 @@
                           (append (with-context the-context
                                     (append (reductions head)
                                             (reductions prim)))
-                                  (let ([estx (and (deriv? head) (deriv-e2 head))])
+                                  (let ([estx 
+                                         (if prim
+                                             (lift/deriv-e2 prim)
+                                             (and (deriv? head) (deriv-e2 head)))])
                                     (loop next (stx-cdr suffix) (cons estx prefix))))]
                          [(ErrW mod:splice (head stxs) exn)
                           (append (with-context the-context (reductions head))
diff --git a/collects/macro-debugger/syntax-browser/pretty-helper.ss b/collects/macro-debugger/syntax-browser/pretty-helper.ss
index 12766e0..38f7070 100644
--- a/collects/macro-debugger/syntax-browser/pretty-helper.ss
+++ b/collects/macro-debugger/syntax-browser/pretty-helper.ss
@@ -77,16 +77,20 @@
                    lp-datum)]
                 [(pair? obj)
                  (pairloop obj)]
-                [(vector? obj) 
-                 (list->vector (map loop (vector->list obj)))]
                 [(symbol? obj)
                  (unintern obj)]
-                [(number? obj)
-                 (make-syntax-dummy obj)]
-                [(box? obj)
-                 (box (loop (unbox obj)))]
                 [(null? obj)
                  (make-syntax-dummy obj)]
+                [(boolean? obj)
+                 (make-syntax-dummy obj)]
+                [(number? obj)
+                 (make-syntax-dummy obj)]
+                [(keyword? obj)
+                 (make-syntax-dummy obj)]
+                [(vector? obj) 
+                 (list->vector (map loop (vector->list obj)))]
+                [(box? obj)
+                 (box (loop (unbox obj)))]
                 [else obj]))
         (define (pairloop obj)
           (cond [(pair? obj)