www

commit ea26c3f5ef14cf1eb188cc4344042ff9de9fbaef
parent c5ab275cee079976bef7108a5a2de6d402a39676
Author: Ryan Culpepper <ryanc@racket-lang.org>
Date:   Fri,  9 Feb 2007 08:27:02 +0000

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

Diffstat:
M
collects/macro-debugger/model/deriv-parser.ss
 | 
2
+-
M
collects/macro-debugger/model/reductions.ss
 | 
17
+++++++++++------
M
collects/macro-debugger/syntax-browser/pretty-helper.ss
 | 
12
++++++++----

3 files changed, 20 insertions(+), 11 deletions(-)
diff --git 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
@@ -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
@@ -77,16 +77,20 @@
                    lp-datum)]
                 [(pair? obj)
                  (pairloop obj)]
-                [(vector? obj) 
-                 (list->vector (map loop (vector->list obj)))]
                 [(symbol? obj)
                  (unintern 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)))]
-                [(null? obj)
-                 (make-syntax-dummy obj)]
                 [else obj]))
         (define (pairloop obj)
           (cond [(pair? obj)