diff --git a/collects/macro-debugger/model/deriv-parser.ss b/collects/macro-debugger/model/deriv-parser.ss index d9d0ff5..6cc9ed9 100644 --- a/collects/macro-debugger/model/deriv-parser.ss +++ b/collects/macro-debugger/model/deriv-parser.ss @@ -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 diff --git a/collects/macro-debugger/model/hiding-policies.ss b/collects/macro-debugger/model/hiding-policies.ss index 68e81fa..5529cc9 100644 --- a/collects/macro-debugger/model/hiding-policies.ss +++ b/collects/macro-debugger/model/hiding-policies.ss @@ -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])))) ) \ No newline at end of file diff --git a/collects/macro-debugger/model/reductions.ss b/collects/macro-debugger/model/reductions.ss index f4ff65d..aa05de6 100644 --- a/collects/macro-debugger/model/reductions.ss +++ b/collects/macro-debugger/model/reductions.ss @@ -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) diff --git a/collects/macro-debugger/model/trace.ss b/collects/macro-debugger/model/trace.ss index c66ca43..3d12d62 100644 --- a/collects/macro-debugger/model/trace.ss +++ b/collects/macro-debugger/model/trace.ss @@ -13,6 +13,7 @@ trace trace/result trace+reductions + current-expand-observe (all-from "reductions.ss")) (define current-expand-observe