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
This commit is contained in:
parent
c5ab275cee
commit
ea26c3f5ef
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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)
|
||||
|
|
Loading…
Reference in New Issue
Block a user