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

gui-debugger: update for submodules

Browse Source 
Closes PR 12668
This commit is contained in:
Matthew Flatt 2012-04-04 07:50:10 -06:00
parent 16d65ed251
commit a984f68a46
1 changed files with 23 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/gui-debugger/annotator.rkt
View File

@ -160,19 +160,24 @@
(kernel:kernel-syntax-case/phase
stx (namespace-base-phase)
[(module identifier name mb)
(syntax-case (disarm #'mb) ()
[(plain-module-begin . module-level-exprs)
(with-syntax ([(module . _) stx])
(quasisyntax/loc stx (module identifier name
#,(rearm
#'mb
#`(plain-module-begin
#,@(map (lambda (e) (module-level-expr-iterator
e (list (syntax-e #'identifier)
(syntax-source #'identifier))))
(syntax->list #'module-level-exprs)))))))])]
(module-annotate stx)]
[else-stx
(general-top-level-expr-iterator stx #f)]))
(define (module-annotate stx)
(syntax-case stx ()
[(_ identifier name mb)
(syntax-case (disarm #'mb) ()
[(plain-module-begin . module-level-exprs)
(with-syntax ([(module . _) stx])
(quasisyntax/loc stx (module identifier name
#,(rearm
#'mb
#`(plain-module-begin
#,@(map (lambda (e) (module-level-expr-iterator
e (list (syntax-e #'identifier)
(syntax-source #'identifier))))
(syntax->list #'module-level-exprs)))))))])]))
(define (module-level-expr-iterator stx module-name )
(kernel:kernel-syntax-case
@ -186,7 +191,6 @@
(kernel:kernel-syntax-case
stx #f
[(define-values (var ...) expr)
(begin
(for-each (lambda (v) (record-bound-id 'bind v v))
(syntax->list #'(var ...)))
@ -198,9 +202,7 @@
[() var]
[(v) (set! var v)])) ...)
#'(#%plain-app void))
(#%plain-app void)))
)
]
(#%plain-app void))))]
[(define-syntaxes (var ...) expr)
stx]
[(begin-for-syntax . exprs)
@ -212,6 +214,12 @@
(syntax->list #'top-level-exprs))))]
[(#%require . require-specs)
stx]
[(module . _)
;; a submodule:
(module-annotate stx)]
[(module* . _)
;; a submodule:
(module-annotate stx)]
[else
(annotate stx '() #f module-name )]))