macro-debugger:
fixed bug re (maybe?) lazy phase 1 initialization fixed popup-menu bug in syntax browser cleaned up signal mapping svn: r18331 original commit: ea19a1bda345fee2d998e7b3f5120659ce6f4f50
This commit is contained in:
Ryan Culpepper
parent
3ce3c33b95
commit
f392ff8d8f
|
|
@ -169,6 +169,6 @@
|
|||
|
||||
|
||||
;; ECTE represents expand/compile-time-evals
|
||||
;; (make-ecte stx ?stx Deriv Deriv)
|
||||
;; (make-ecte stx ?stx (listof LocalAction) Deriv Deriv)
|
||||
|
||||
(define-struct (ecte deriv) (first second) #:transparent)
|
||||
(define-struct (ecte deriv) (locals first second) #:transparent)
|
||||
|
|
|
|||
|
|
@ -68,18 +68,19 @@
|
|||
(productions/I
|
||||
|
||||
(ExpandCTE
|
||||
[(visit start (? CheckImmediateMacro/Lifts) top-non-begin start (? EE) return)
|
||||
(make ecte $1 $7 $3 $6)]
|
||||
[(visit start CheckImmediateMacro/Lifts top-begin (? NextExpandCTEs) return)
|
||||
;; The 'Eval' is there for---I believe---lazy phase 1 initialization.
|
||||
[(visit start (? Eval) (? CheckImmediateMacro/Lifts) top-non-begin start (? EE) return)
|
||||
(make ecte $1 $8 $3 $4 $7)]
|
||||
[(visit start Eval CheckImmediateMacro/Lifts top-begin (? NextExpandCTEs) return)
|
||||
(begin
|
||||
(unless (list? $5)
|
||||
(error "NextExpandCTEs returned non-list ~s" $5))
|
||||
(make ecte $1 $6 $3
|
||||
(make p:begin $4 $6 (list (stx-car $4)) #f
|
||||
(make lderiv (cdr (stx->list $4))
|
||||
(and $6 (cdr (stx->list $6)))
|
||||
(unless (list? $6)
|
||||
(error "NextExpandCTEs returned non-list ~s" $6))
|
||||
(make ecte $1 $7 $3 $4
|
||||
(make p:begin $5 $7 (list (stx-car $5)) #f
|
||||
(make lderiv (cdr (stx->list $5))
|
||||
(and $7 (cdr (stx->list $7)))
|
||||
#f
|
||||
$5))))])
|
||||
$6))))])
|
||||
|
||||
(CheckImmediateMacro/Lifts
|
||||
[((? CheckImmediateMacro))
|
||||
|
|
|
|||
|
|
@ -86,102 +86,104 @@
|
|||
;; ** Signals to tokens
|
||||
|
||||
(define signal-mapping
|
||||
`((EOF . EOF)
|
||||
(error . ,token-syntax-error)
|
||||
(0 . ,token-visit)
|
||||
(1 . ,token-resolve)
|
||||
(2 . ,token-return)
|
||||
(3 . ,token-next)
|
||||
(4 . ,token-enter-list)
|
||||
(5 . ,token-exit-list)
|
||||
(6 . ,token-enter-prim)
|
||||
(7 . ,token-exit-prim)
|
||||
(8 . ,token-enter-macro)
|
||||
(9 . ,token-exit-macro)
|
||||
(10 . ,token-enter-block)
|
||||
(11 . ,token-splice)
|
||||
(12 . ,token-block->list)
|
||||
(13 . ,token-next-group)
|
||||
(14 . ,token-block->letrec)
|
||||
(16 . ,token-renames-let)
|
||||
(17 . ,token-renames-lambda)
|
||||
(18 . ,token-renames-case-lambda)
|
||||
(19 . ,token-renames-letrec-syntaxes)
|
||||
(20 . phase-up)
|
||||
(21 . ,token-macro-pre-transform)
|
||||
(22 . ,token-macro-post-transform)
|
||||
(23 . ,token-module-body)
|
||||
(24 . ,token-renames-block)
|
||||
;; (number/#f symbol [token-constructor])
|
||||
`(;; Emitted from Scheme
|
||||
(#f EOF)
|
||||
(#f error ,token-syntax-error)
|
||||
(#f start ,token-start)
|
||||
(#f top-begin ,token-top-begin)
|
||||
(#f top-non-begin ,token-top-non-begin)
|
||||
|
||||
(100 . prim-stop)
|
||||
(101 . prim-module)
|
||||
(102 . prim-#%module-begin)
|
||||
(103 . prim-define-syntaxes)
|
||||
(104 . prim-define-values)
|
||||
(105 . prim-if)
|
||||
(106 . prim-wcm)
|
||||
(107 . prim-begin)
|
||||
(108 . prim-begin0)
|
||||
(109 . prim-#%app)
|
||||
(110 . prim-lambda)
|
||||
(111 . prim-case-lambda)
|
||||
(112 . prim-let-values)
|
||||
(113 . prim-letrec-values)
|
||||
(114 . prim-letrec-syntaxes+values)
|
||||
(115 . prim-#%datum)
|
||||
(116 . prim-#%top)
|
||||
(117 . prim-quote)
|
||||
(118 . prim-quote-syntax)
|
||||
(119 . prim-require)
|
||||
(120 . prim-require-for-syntax)
|
||||
(121 . prim-require-for-template)
|
||||
(122 . prim-provide)
|
||||
(123 . prim-set!)
|
||||
(124 . prim-let*-values)
|
||||
(125 . ,token-variable)
|
||||
(126 . ,token-enter-check)
|
||||
(127 . ,token-exit-check)
|
||||
(128 . ,token-lift-loop)
|
||||
(129 . ,token-lift)
|
||||
(130 . ,token-enter-local)
|
||||
(131 . ,token-exit-local)
|
||||
(132 . ,token-local-pre)
|
||||
(133 . ,token-local-post)
|
||||
(134 . ,token-lift-statement)
|
||||
(135 . ,token-module-lift-end-loop)
|
||||
(136 . ,token-lift/let-loop)
|
||||
(137 . ,token-module-lift-loop)
|
||||
(138 . prim-expression)
|
||||
(141 . ,token-start)
|
||||
(142 . ,token-tag)
|
||||
(143 . ,token-local-bind)
|
||||
(144 . ,token-enter-bind)
|
||||
(145 . ,token-exit-bind)
|
||||
(146 . ,token-opaque)
|
||||
(147 . ,token-rename-list)
|
||||
(148 . ,token-rename-one)
|
||||
(149 . prim-varref)
|
||||
(150 . ,token-lift-require)
|
||||
(151 . ,token-lift-provide)
|
||||
;; Standard signals
|
||||
(0 visit ,token-visit)
|
||||
(1 resolve ,token-resolve)
|
||||
(2 return ,token-return)
|
||||
(3 next ,token-next)
|
||||
(4 enter-list ,token-enter-list)
|
||||
(5 exit-list ,token-exit-list)
|
||||
(6 enter-prim ,token-enter-prim)
|
||||
(7 exit-prim ,token-exit-prim)
|
||||
(8 enter-macro ,token-enter-macro)
|
||||
(9 exit-macro ,token-exit-macro)
|
||||
(10 enter-block ,token-enter-block)
|
||||
(11 splice ,token-splice)
|
||||
(12 block->list ,token-block->list)
|
||||
(13 next-group ,token-next-group)
|
||||
(14 block->letrec ,token-block->letrec)
|
||||
(16 renames-let ,token-renames-let)
|
||||
(17 renames-lambda ,token-renames-lambda)
|
||||
(18 renames-case-lambda ,token-renames-case-lambda)
|
||||
(19 renames-letrec-syntaxes ,token-renames-letrec-syntaxes)
|
||||
(20 phase-up)
|
||||
(21 macro-pre-transform ,token-macro-pre-transform)
|
||||
(22 macro-post-transform ,token-macro-post-transform)
|
||||
(23 module-body ,token-module-body)
|
||||
(24 renames-block ,token-renames-block)
|
||||
|
||||
;; Emitted from Scheme
|
||||
(start . ,token-start)
|
||||
(visit . ,token-visit)
|
||||
(return . ,token-return)
|
||||
(next . ,token-next)
|
||||
(top-begin . ,token-top-begin)
|
||||
(top-non-begin . ,token-top-non-begin)
|
||||
(100 prim-stop)
|
||||
(101 prim-module)
|
||||
(102 prim-#%module-begin)
|
||||
(103 prim-define-syntaxes)
|
||||
(104 prim-define-values)
|
||||
(105 prim-if)
|
||||
(106 prim-wcm)
|
||||
(107 prim-begin)
|
||||
(108 prim-begin0)
|
||||
(109 prim-#%app)
|
||||
(110 prim-lambda)
|
||||
(111 prim-case-lambda)
|
||||
(112 prim-let-values)
|
||||
(113 prim-letrec-values)
|
||||
(114 prim-letrec-syntaxes+values)
|
||||
(115 prim-#%datum)
|
||||
(116 prim-#%top)
|
||||
(117 prim-quote)
|
||||
(118 prim-quote-syntax)
|
||||
(119 prim-require)
|
||||
(120 prim-require-for-syntax)
|
||||
(121 prim-require-for-template)
|
||||
(122 prim-provide)
|
||||
(123 prim-set!)
|
||||
(124 prim-let*-values)
|
||||
(125 variable ,token-variable)
|
||||
(126 enter-check ,token-enter-check)
|
||||
(127 exit-check ,token-exit-check)
|
||||
(128 lift-loop ,token-lift-loop)
|
||||
(129 lift ,token-lift)
|
||||
(130 enter-local ,token-enter-local)
|
||||
(131 exit-local ,token-exit-local)
|
||||
(132 local-pre ,token-local-pre)
|
||||
(133 local-post ,token-local-post)
|
||||
(134 lift-statement ,token-lift-statement)
|
||||
(135 lift-end-loop ,token-module-lift-end-loop)
|
||||
(136 lift/let-loop ,token-lift/let-loop)
|
||||
(137 module-lift-loop ,token-module-lift-loop)
|
||||
(138 prim-expression)
|
||||
(141 start ,token-start)
|
||||
(142 tag ,token-tag)
|
||||
(143 local-bind ,token-local-bind)
|
||||
(144 enter-bind ,token-enter-bind)
|
||||
(145 exit-bind ,token-exit-bind)
|
||||
(146 opaque ,token-opaque)
|
||||
(147 rename-list ,token-rename-list)
|
||||
(148 rename-one ,token-rename-one)
|
||||
(149 prim-varref)
|
||||
(150 lift-require ,token-lift-require)
|
||||
(151 lift-provide ,token-lift-provide)
|
||||
))
|
||||
|
||||
(define (tokenize sig-n val pos)
|
||||
(let ([p (assv sig-n signal-mapping)])
|
||||
(if (pair? p)
|
||||
(make-position-token
|
||||
(cond [(procedure? (cdr p)) ((cdr p) val)]
|
||||
[(symbol? (cdr p)) (cdr p)])
|
||||
pos
|
||||
pos)
|
||||
(error 'tokenize "bad signal: ~s" sig-n))))
|
||||
(define (signal->symbol sig)
|
||||
(if (symbol? sig)
|
||||
sig
|
||||
(cadr (assv sig signal-mapping))))
|
||||
|
||||
(define (signal->symbol sig-n)
|
||||
(cdr (assv sig-n signal-mapping)))
|
||||
(define token-mapping (map cdr signal-mapping))
|
||||
|
||||
(define (tokenize sig val pos)
|
||||
(let ([p (assv sig token-mapping)])
|
||||
(cond [(not p)
|
||||
(error 'tokenize "bad signal: ~s" sig)]
|
||||
[(null? (cdr p))
|
||||
(make-position-token sig pos pos)]
|
||||
[else
|
||||
(make-position-token ((cadr p) val) pos pos)])))
|
||||
|
|
|
|||
|
|
@ -280,9 +280,10 @@
|
|||
|
||||
;; expand/compile-time-evals
|
||||
|
||||
[(Wrap ecte (e1 e2 first second))
|
||||
[(Wrap ecte (e1 e2 locals first second))
|
||||
(R [#:pattern ?form]
|
||||
[#:pass1]
|
||||
[LocalActions ?form locals]
|
||||
[Expr ?form first]
|
||||
[#:pass2]
|
||||
[Expr ?form second])]
|
||||
|
|
|
|||
|
|
@ -43,7 +43,7 @@
|
|||
|
||||
;; events->token-generator : (list-of event) -> (-> token)
|
||||
(define (events->token-generator events)
|
||||
(let ([pos 0])
|
||||
(let ([pos 1])
|
||||
(lambda ()
|
||||
(define sig+val (car events))
|
||||
(set! events (cdr events))
|
||||
|
|
@ -64,7 +64,7 @@
|
|||
(define events null)
|
||||
(define counter 0)
|
||||
(define (add! x y)
|
||||
(set! events (cons (cons x y) events)))
|
||||
(set! events (cons (cons (signal->symbol x) y) events)))
|
||||
(define add!/check
|
||||
(let ([limit (trace-macro-limit)]
|
||||
[handler (trace-limit-handler)])
|
||||
|
|
|
|||
|
|
@ -91,6 +91,17 @@
|
|||
(lambda (i e)
|
||||
(call-function "copy-syntax-as-text" i e))))
|
||||
(new separator-menu-item% (parent menu))
|
||||
(new menu-item%
|
||||
(label "Clear selection")
|
||||
(parent menu)
|
||||
(demand-callback
|
||||
(lambda (i)
|
||||
(send i enable (and (selected-syntax) #t))))
|
||||
(callback
|
||||
(lambda (i e)
|
||||
(call-function "clear-syntax-selection" i e))))
|
||||
(menu-option/notify-box menu "View syntax properties"
|
||||
(get-field props-shown? config))
|
||||
(let ([pretty-menu
|
||||
(new menu%
|
||||
(label "Change layout")
|
||||
|
|
@ -108,19 +119,8 @@
|
|||
(demand-callback
|
||||
(lambda (i)
|
||||
(let ([stx (selected-syntax)])
|
||||
(when stx
|
||||
(send i set-label
|
||||
(format "Format ~s ~a" (syntax-e stx) (cadr sym+desc))))))
|
||||
(format "Format ~s ~a" (syntax-e stx) (cadr sym+desc)))))))
|
||||
(callback
|
||||
(pretty-print-as (car sym+desc))))))
|
||||
(new menu-item%
|
||||
(label "Clear selection")
|
||||
(parent menu)
|
||||
(demand-callback
|
||||
(lambda (i)
|
||||
(send i enable (and (selected-syntax) #t))))
|
||||
(callback
|
||||
(lambda (i e)
|
||||
(call-function "clear-syntax-selection" i e))))
|
||||
(menu-option/notify-box menu "View syntax properties"
|
||||
(get-field props-shown? config)))))
|
||||
|
||||
(pretty-print-as (car sym+desc)))))))))
|
||||
|
|
|
|||
|
|
@ -433,11 +433,11 @@
|
|||
(and first
|
||||
(let ([e1 (wderiv-e1 first)])
|
||||
(make-lift-deriv e1 e2 first lifted-stx second))))]
|
||||
[(Wrap ecte (e1 e2 first second))
|
||||
[(Wrap ecte (e1 e2 locals first second))
|
||||
(let ([first (adjust-deriv/lift first)])
|
||||
(and first
|
||||
(let ([e1 (wderiv-e1 first)])
|
||||
(make ecte e1 e2 first second))))]
|
||||
(make ecte e1 e2 locals first second))))]
|
||||
[else (adjust-deriv/top deriv)]))
|
||||
|
||||
;; adjust-deriv/top : Derivation -> Derivation
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user