61798f478e
Fixed macro hiding on applications Stepper font depends on framework settings Fixed hiding policies and gui wrt lexical vs global bindings Macro hiding removes renaming steps Better handling of nonlinear subterms & local actions Automatic pretty-print resizing Handled local-bind action (partial?) Enabled module language Disabled struct contracts for faster compilation Fixed syntax-browser on boxes, 3d syntax; normalized print params Fixed PR 8246: syntax-browser mishandled non-ascii characters svn: r4178
100 lines
3.7 KiB
Scheme
100 lines
3.7 KiB
Scheme
|
|
(module hiding-policies mzscheme
|
|
(require (lib "plt-match.ss")
|
|
(lib "boundmap.ss" "syntax"))
|
|
(provide (all-defined))
|
|
|
|
(define-struct hiding-policy
|
|
(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))
|
|
(define (policy-unhide-id p id)
|
|
(module-identifier-mapping-put! (hiding-policy-opaque-ids p) id #f))
|
|
|
|
(define (policy-show-id p id)
|
|
(policy-unhide-id p id)
|
|
(module-identifier-mapping-put! (hiding-policy-transparent-ids p) id #t))
|
|
(define (policy-unshow-id p id)
|
|
(module-identifier-mapping-put! (hiding-policy-transparent-ids p) id #f))
|
|
|
|
(define (new-hiding-policy)
|
|
(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))
|
|
|
|
;; ---
|
|
|
|
(define-syntax inline
|
|
(syntax-rules ()
|
|
[(inline ([name expr] ...) . body)
|
|
(let-syntax ([name
|
|
(lambda (x)
|
|
(syntax-case x ()
|
|
[xx (identifier? #'xx) #'expr]))] ...)
|
|
. body)]))
|
|
|
|
(define (/false) #f)
|
|
|
|
(define (policy-show-macro? policy id)
|
|
(match policy
|
|
[(struct hiding-policy (opaque-modules
|
|
opaque-identifiers
|
|
opaque-kernel
|
|
opaque-libs
|
|
transparent-identifiers))
|
|
(inline ([not-opaque-id
|
|
(not (module-identifier-mapping-get opaque-identifiers id /false))]
|
|
[transparent-id
|
|
(module-identifier-mapping-get transparent-identifiers id /false)])
|
|
(let ([binding (identifier-binding id)])
|
|
(if (list? binding)
|
|
(let-values ([(srcmod srcname nommod nomname _) (apply values binding)])
|
|
(inline ([opaque-srcmod (hash-table-get opaque-modules srcmod /false)]
|
|
[opaque-nommod (hash-table-get opaque-modules nommod /false)]
|
|
;; FIXME
|
|
[in-kernel?
|
|
(and (symbol? srcmod)
|
|
(eq? #\# (string-ref (symbol->string srcmod) 0)))]
|
|
[in-lib-module?
|
|
(lib-module? srcmod)])
|
|
(or transparent-id
|
|
(and (not opaque-srcmod)
|
|
(not opaque-nommod)
|
|
(not (and in-kernel? opaque-kernel))
|
|
(not (and in-lib-module? opaque-libs))
|
|
not-opaque-id))))
|
|
(or transparent-id
|
|
not-opaque-id))))]))
|
|
|
|
(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]))))
|
|
) |