suzanne.soy/macro-debugger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Macro stepper:

Browse Source 
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
This commit is contained in:
Ryan Culpepper 2007-02-09 08:27:02 +00:00
parent c5ab275cee
commit ea26c3f5ef
3 changed files with 22 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/macro-debugger/model/deriv-parser.ss
View File

@ -484,7 +484,7 @@
(make-b:defvals $3 $4)] (make-b:defvals $3 $4)]
[(next NoError renames-block CheckImmediateMacro [(next NoError renames-block CheckImmediateMacro
prim-define-syntaxes (? BindSyntaxes 'bind)) prim-define-syntaxes (? BindSyntaxes 'bind))
(make-b:defstx $3 $4 $5)]) (make-b:defstx $3 $4 $6)])
;; BindSyntaxes Answer = Derivation ;; BindSyntaxes Answer = Derivation
(BindSyntaxes (BindSyntaxes

17
collects/macro-debugger/model/reductions.ss
View File

@ -375,11 +375,13 @@
(cons head-rs rss)))] (cons head-rs rss)))]
[(AnyQ b:defstx (renames head rhs)) [(AnyQ b:defstx (renames head rhs))
(let* ([estx (deriv-e2 head)] (let* ([estx (deriv-e2 head)]
[estx2 (with-syntax ([(?ds ?vars ?rhs) estx] [estx2 (and (deriv? rhs)
[?rhs* (deriv-e2 rhs)]) (with-syntax ([(?ds ?vars ?rhs) estx]
;;FIXME [?rhs* (deriv-e2 rhs)])
(datum->syntax-object estx `(,#'?ds ,#'?vars ,#'?rhs*) estx estx))]) (datum->syntax-object estx
(loop next (cdr suffix) (cons estx2 prefix) `(,#'?ds ,#'?vars ,#'?rhs*)
estx estx)))])
(loop next (stx-cdr suffix) (cons estx2 prefix)
(with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix)))) (with-context (lambda (x) (revappend prefix (cons x (stx-cdr suffix))))
(cons (with-context (CC (?ds ?vars ?rhs) estx ?rhs) (cons (with-context (CC (?ds ?vars ?rhs) estx ?rhs)
(reductions rhs)) (reductions rhs))
@ -433,7 +435,10 @@
(append (with-context the-context (append (with-context the-context
(append (reductions head) (append (reductions head)
(reductions prim))) (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))))] (loop next (stx-cdr suffix) (cons estx prefix))))]
[(ErrW mod:splice (head stxs) exn) [(ErrW mod:splice (head stxs) exn)
(append (with-context the-context (reductions head)) (append (with-context the-context (reductions head))

16
collects/macro-debugger/syntax-browser/pretty-helper.ss
View File

@ -77,16 +77,20 @@
lp-datum)] lp-datum)]
[(pair? obj) [(pair? obj)
(pairloop obj)] (pairloop obj)]
[(vector? obj)
(list->vector (map loop (vector->list obj)))]
[(symbol? obj) [(symbol? obj)
(unintern obj)] (unintern obj)]
[(number? obj)
(make-syntax-dummy obj)]
[(box? obj)
(box (loop (unbox obj)))]
[(null? obj) [(null? obj)
(make-syntax-dummy 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])) [else obj]))
(define (pairloop obj) (define (pairloop obj)
(cond [(pair? obj) (cond [(pair? obj)