diff --git a/compiler-lib/compiler/decompile.rkt b/compiler-lib/compiler/decompile.rkt index b32d002882..524ce7a7b1 100644 --- a/compiler-lib/compiler/decompile.rkt +++ b/compiler-lib/compiler/decompile.rkt @@ -126,7 +126,7 @@ (define (decompile-prefix a-prefix stx-ht) (match a-prefix - [(struct prefix (num-lifts toplevels stxs)) + [(struct prefix (num-lifts toplevels stxs src-insp-desc)) (let ([lift-ids (for/list ([i (in-range num-lifts)]) (gensym 'lift))] [stx-ids (map (lambda (i) (gensym 'stx)) @@ -169,12 +169,14 @@ (length toplevels) (length stxs) num-lifts) - (map (lambda (stx id) - `(define ,id ,(if stx - `(#%decode-syntax - ,(decompile-stx (stx-encoded stx) stx-ht)) - #f))) - stxs stx-ids)))] + (cons + `(quote inspector ,src-insp-desc) + (map (lambda (stx id) + `(define ,id ,(if stx + `(#%decode-syntax + ,(decompile-stx (stx-encoded stx) stx-ht)) + #f))) + stxs stx-ids))))] [else (error 'decompile-prefix "huh?: ~e" a-prefix)])) (define (decompile-stx stx stx-ht) @@ -216,7 +218,8 @@ (define (decompile-module mod-form orig-stack stx-ht mod-name) (match mod-form - [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported + [(struct mod (name srcname self-modidx + prefix provides requires body syntax-bodies unexported max-let-depth dummy lang-info internal-context binding-names flags pre-submodules post-submodules)) diff --git a/compiler-lib/compiler/demodularizer/merge.rkt b/compiler-lib/compiler/demodularizer/merge.rkt index 2bbaa5344b..71202724f2 100644 --- a/compiler-lib/compiler/demodularizer/merge.rkt +++ b/compiler-lib/compiler/demodularizer/merge.rkt @@ -54,12 +54,13 @@ (define (merge-prefix root-prefix mod-prefix) (match root-prefix - [(struct prefix (root-num-lifts root-toplevels root-stxs)) + [(struct prefix (root-num-lifts root-toplevels root-stxs root-src-insp-desc)) (match mod-prefix - [(struct prefix (mod-num-lifts mod-toplevels mod-stxs)) + [(struct prefix (mod-num-lifts mod-toplevels mod-stxs src-insp-desc)) (make-prefix (+ root-num-lifts mod-num-lifts) (append root-toplevels mod-toplevels) - (append root-stxs mod-stxs))])])) + (append root-stxs mod-stxs) + root-src-insp-desc)])])) (struct toplevel-offset-rewriter (rewrite-fun meta) #:transparent) @@ -121,7 +122,8 @@ (define (merge-module max-let-depth top-prefix mod-form) (match mod-form - [(struct mod (name srcname self-modidx mod-prefix provides requires body syntax-bodies + [(struct mod (name srcname self-modidx + mod-prefix provides requires body syntax-bodies unexported mod-max-let-depth dummy lang-info internal-context binding-names flags pre-submodules post-submodules)) diff --git a/compiler-lib/compiler/demodularizer/nodep.rkt b/compiler-lib/compiler/demodularizer/nodep.rkt index 5db811eb4b..59995fc9e0 100644 --- a/compiler-lib/compiler/demodularizer/nodep.rkt +++ b/compiler-lib/compiler/demodularizer/nodep.rkt @@ -139,7 +139,8 @@ (define (nodep-module mod-form phase) (match mod-form - [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies + [(struct mod (name srcname self-modidx + prefix provides requires body syntax-bodies unexported max-let-depth dummy lang-info internal-context binding-names flags pre-submodules post-submodules)) @@ -158,7 +159,8 @@ (append (requires->modlist requires phase) (if (and phase (zero? phase)) (begin (log-debug (format "[~S] lang-info : ~S" name lang-info)) ; XXX Seems to always be #f now - (list (make-mod name srcname self-modidx new-prefix provides requires body empty + (list (make-mod name srcname self-modidx + new-prefix provides requires body empty unexported max-let-depth dummy lang-info internal-context #hash() empty empty empty))) (begin (log-debug (format "[~S] Dropping module @ ~S" name phase)) diff --git a/zo-lib/compiler/zo-marshal.rkt b/zo-lib/compiler/zo-marshal.rkt index a05642fa37..de99445d5d 100644 --- a/zo-lib/compiler/zo-marshal.rkt +++ b/zo-lib/compiler/zo-marshal.rkt @@ -639,12 +639,13 @@ (let ([pos ((out-shared-index out) v #:error? #t)]) (out-number pos out) (out-anything lam out))] - [(struct prefix (num-lifts toplevels stxs)) + [(struct prefix (num-lifts toplevels stxs src-insp-desc)) (out-marshaled prefix-type-num - (cons num-lifts - (cons (list->vector toplevels) - (list->vector stxs))) + (list* src-insp-desc + num-lifts + (list->vector toplevels) + (list->vector stxs)) out)] [(struct global-bucket (name)) (out-marshaled variable-type-num name out)] @@ -963,7 +964,8 @@ (define (convert-module mod-form) (match mod-form - [(struct mod (name srcname self-modidx prefix provides requires body syntax-bodies unexported + [(struct mod (name srcname self-modidx + prefix provides requires body syntax-bodies unexported max-let-depth dummy lang-info internal-context binding-names flags pre-submodules post-submodules)) diff --git a/zo-lib/compiler/zo-parse.rkt b/zo-lib/compiler/zo-parse.rkt index 80b82e3256..1788f7153b 100644 --- a/zo-lib/compiler/zo-parse.rkt +++ b/zo-lib/compiler/zo-parse.rkt @@ -68,9 +68,9 @@ (define (read-resolve-prefix v) (match v - [`(,i ,tv . ,sv) + [`(,src-insp-desc ,i ,tv . ,sv) ;; XXX Why not leave them as vectors and change the contract? - (make-prefix i (vector->list tv) (vector->list sv))])) + (make-prefix i (vector->list tv) (vector->list sv) src-insp-desc)])) (define (read-unclosed-procedure v) (define CLOS_HAS_REST 1) diff --git a/zo-lib/compiler/zo-structs.rkt b/zo-lib/compiler/zo-structs.rkt index 230e047c97..7ae356ec28 100644 --- a/zo-lib/compiler/zo-structs.rkt +++ b/zo-lib/compiler/zo-structs.rkt @@ -81,7 +81,8 @@ (define-form-struct prefix ([num-lifts exact-nonnegative-integer?] [toplevels (listof (or/c #f symbol? global-bucket? module-variable?))] - [stxs list?])) ; should be (listof stx?) sets up top-level and syntax-object array + [stxs list?] ; should be (listof stx?) sets up top-level and syntax-object array + [src-inspector-desc symbol?])) (define-form-struct form ()) (define-form-struct (expr form) ())