Merged 4023:4047 from /branches/ryanc/md1
- Fixed macro hiding for letrec-syntaxes+values - Fixed module tracing (prevented required modules from being traced) - Better auto-scroll in gui - Fixed reductions bug in letrec-syntaxes+values - Added hide library syntax option svn: r4048 original commit: adb230f3c3f6bbd7915c5cebc8797158a209d523
This commit is contained in:
parent
06aad5203a
commit
3a22aab8af
|
@ -347,8 +347,6 @@
|
|||
[(prim-letrec-values ! renames-let (? NextEEs 'rhss) next-group (? EB 'body))
|
||||
(make-p:letrec-values e1 e2 rs $3 $4 $6)])
|
||||
|
||||
;; Might have to deal with let*-values
|
||||
|
||||
(PrimLetrecSyntaxes+Values
|
||||
(#:args e1 e2 rs)
|
||||
[(prim-letrec-syntaxes+values (! 'bad-syntax) renames-letrec-syntaxes
|
||||
|
|
|
@ -5,17 +5,23 @@
|
|||
(provide (all-defined))
|
||||
|
||||
(define-struct hiding-policy
|
||||
(opaque-modules opaque-ids opaque-kernel transparent-ids))
|
||||
(opaque-modules opaque-ids opaque-kernel opaque-libs transparent-ids))
|
||||
|
||||
(define (policy-hide-module p m)
|
||||
(hash-table-put! (hiding-policy-opaque-modules p) m #t))
|
||||
(define (policy-unhide-module p m)
|
||||
(hash-table-remove! (hiding-policy-opaque-modules p) m))
|
||||
|
||||
(define (policy-hide-kernel p)
|
||||
(set-hiding-policy-opaque-kernel! p #t))
|
||||
(define (policy-unhide-kernel p)
|
||||
(set-hiding-policy-opaque-kernel! p #f))
|
||||
|
||||
(define (policy-hide-libs p)
|
||||
(set-hiding-policy-opaque-libs! p #t))
|
||||
(define (policy-unhide-libs p)
|
||||
(set-hiding-policy-opaque-libs! p #f))
|
||||
|
||||
(define (policy-hide-id p id)
|
||||
(policy-unshow-id p id)
|
||||
(module-identifier-mapping-put! (hiding-policy-opaque-ids p) id #t))
|
||||
|
@ -32,11 +38,13 @@
|
|||
(make-hiding-policy (make-hash-table)
|
||||
(make-module-identifier-mapping)
|
||||
#f
|
||||
#f
|
||||
(make-module-identifier-mapping)))
|
||||
|
||||
(define (new-standard-hiding-policy)
|
||||
(let ([p (new-hiding-policy)])
|
||||
(policy-hide-kernel p)
|
||||
(policy-hide-libs p)
|
||||
p))
|
||||
|
||||
;; ---
|
||||
|
@ -57,6 +65,7 @@
|
|||
[(struct hiding-policy (opaque-modules
|
||||
opaque-identifiers
|
||||
opaque-kernel
|
||||
opaque-libs
|
||||
transparent-identifiers))
|
||||
(let ([binding (identifier-binding id)])
|
||||
(if (list? binding)
|
||||
|
@ -67,7 +76,9 @@
|
|||
[in-kernel?
|
||||
(and (symbol? srcmod)
|
||||
(eq? #\# (string-ref (symbol->string srcmod) 0)))]
|
||||
[not-opaque-id
|
||||
[in-lib-module?
|
||||
(lib-module? srcmod)]
|
||||
[not-opaque-id
|
||||
(not (module-identifier-mapping-get opaque-identifiers id /false))]
|
||||
[transparent-id
|
||||
(module-identifier-mapping-get transparent-identifiers id /false)])
|
||||
|
@ -75,7 +86,14 @@
|
|||
(and (not opaque-srcmod)
|
||||
(not opaque-nommod)
|
||||
(not (and in-kernel? opaque-kernel))
|
||||
(not (and in-lib-module? opaque-libs))
|
||||
not-opaque-id))))
|
||||
#f))]))
|
||||
|
||||
(define (lib-module? mpi)
|
||||
(and (module-path-index? mpi)
|
||||
(let-values ([(path rel) (module-path-index-split mpi)])
|
||||
(cond [(pair? path) (memq (car path) '(lib planet))]
|
||||
[(string? path) (lib-module? rel)]
|
||||
[else #f]))))
|
||||
)
|
|
@ -207,11 +207,13 @@
|
|||
(syntax->list #'(?svars* ...))
|
||||
"Rename bound variables"]
|
||||
[Expr (?srhs ...) srhss]
|
||||
[#:bind (([?vvars** ?vrhs**] ...) . ?body**) vrenames]
|
||||
[#:walk (syntax/skeleton e1 (?lsv ([?svars* ?srhs*] ...) ([?vars** ?vrhs**] ...) . ?body**))
|
||||
(syntax->list #'(?vvars* ...))
|
||||
(syntax->list #'(?vvars** ...))
|
||||
"Rename bound variables"]
|
||||
;; If vrenames is #f, no var bindings to rename
|
||||
[#:if vrenames
|
||||
[#:bind (([?vvars** ?vrhs**] ...) . ?body**) vrenames]
|
||||
[#:walk (syntax/skeleton e1 (?lsv ([?svars* ?srhs*] ...) ([?vars** ?vrhs**] ...) . ?body**))
|
||||
(syntax->list #'(?vvars* ...))
|
||||
(syntax->list #'(?vvars** ...))
|
||||
"Rename bound variables"]]
|
||||
[Expr (?vrhs ...) vrhss]
|
||||
[Block ?body body]
|
||||
=> (lambda (mid)
|
||||
|
|
|
@ -13,6 +13,7 @@
|
|||
trace
|
||||
trace/result
|
||||
trace+reductions
|
||||
current-expand-observe
|
||||
(all-from "reductions.ss"))
|
||||
|
||||
(define current-expand-observe
|
||||
|
|
Loading…
Reference in New Issue
Block a user