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:
Ryan Culpepper 2006-08-13 03:28:43 +00:00
parent 06aad5203a
commit 3a22aab8af
4 changed files with 28 additions and 9 deletions

View File

@ -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

View File

@ -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]))))
)

View File

@ -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)

View File

@ -13,6 +13,7 @@
trace
trace/result
trace+reductions
current-expand-observe
(all-from "reductions.ss"))
(define current-expand-observe