diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss index b4d4375997..538e065a4c 100644 --- a/collects/compiler/zo-parse.ss +++ b/collects/compiler/zo-parse.ss @@ -220,14 +220,14 @@ (match v [`(,name ,self-modidx ,lang-info ,functional? ,et-functional? ,rename ,max-let-depth ,dummy - ,prefix ,kernel-exclusion ,reprovide-kernel? + ,prefix ,indirect-provides ,num-indirect-provides ,indirect-syntax-provides ,num-indirect-syntax-provides ,indirect-et-provides ,num-indirect-et-provides ,protects ,et-protects ,provide-phase-count . ,rest) - (let ([phase-data (take rest (* 8 provide-phase-count))]) - (match (list-tail rest (* 8 provide-phase-count)) + (let ([phase-data (take rest (* 9 provide-phase-count))]) + (match (list-tail rest (* 9 provide-phase-count)) [`(,syntax-body ,body ,requires ,syntax-requires ,template-requires ,label-requires ,more-requires-count . ,more-requires) @@ -729,6 +729,7 @@ [read-accept-dot #t] [read-accept-infix-dot #t] [read-accept-quasiquote #t]) + (printf "~s\n" s) (read (open-input-bytes s))))] [(reference) (make-primval (read-compact-number cp))] diff --git a/collects/syntax/modresolve.ss b/collects/syntax/modresolve.ss index de53caf42b..fe5972a000 100644 --- a/collects/syntax/modresolve.ss +++ b/collects/syntax/modresolve.ss @@ -7,6 +7,9 @@ (cond [(path-string? relto) (if dir? (let-values ([(base n d?) (split-path relto)]) + (when d? + (error 'resolve-module-path-index + "given a directory path instead of a file path: ~e" relto)) (if (eq? base 'relative) (or (current-load-relative-directory) (current-directory)) base)) diff --git a/collects/tests/mzscheme/modprot.ss b/collects/tests/mzscheme/modprot.ss new file mode 100644 index 0000000000..64d03c0386 --- /dev/null +++ b/collects/tests/mzscheme/modprot.ss @@ -0,0 +1,212 @@ +(load-relative "loadtest.ss") + +(Section 'modprot) + +;; ============================================================ + +;; Use '#%kernel everywhere so we're only checking the directly +;; intended certifications and protections. + +(define zero + '(module zero '#%kernel + + (define-values (prot) 8) + + (#%provide (protect prot)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define one + '(module one '#%kernel + (#%require 'zero + (for-syntax '#%kernel)) + + (define-values (unexp) 5) + (define-syntaxes (stx) + (lambda (stx) (quote-syntax 13))) + + (define-syntaxes (nab) + (lambda (stx) + (datum->syntax + stx + (list (quote-syntax define-syntaxes) + (cdr (syntax-e stx)) + (quote-syntax (make-rename-transformer (quote-syntax unexp))))))) + (define-syntaxes (pnab) + (lambda (stx) + (datum->syntax + stx + (list (quote-syntax define-syntaxes) + (cdr (syntax-e stx)) + (quote-syntax (make-rename-transformer (quote-syntax prot))))))) + (define-syntaxes (snab) + (lambda (xstx) + (datum->syntax + xstx + (list (quote-syntax define-syntaxes) + (cdr (syntax-e xstx)) + (quote-syntax (make-rename-transformer (quote-syntax stx))))))) + + (#%provide nab + pnab + snab))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define two/no-protect + '(module two '#%kernel + (#%require 'one) + + (define-values (normal) 10) + + (nab nabbed) + (pnab pnabbed) + (snab snabbed) + + (#%provide normal + nabbed + pnabbed + snabbed))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define two/protect + '(module two '#%kernel + (#%require 'one) + + (define-values (normal) 10) + + (nab nabbed) + (pnab pnabbed) + (snab snabbed) + + (#%provide (protect normal + nabbed + pnabbed + snabbed)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define three/nabbed + '(module three '#%kernel + (#%module-begin + (#%require 'two) + (#%app printf "~s ~s\n" + (resolved-module-path-name + (module-path-index-resolve (car (identifier-binding (quote-syntax nabbed))))) + nabbed)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define three/pnabbed + '(module three '#%kernel + (#%module-begin + (#%require 'two) + (#%app printf "~s ~s\n" + (resolved-module-path-name + (module-path-index-resolve (car (identifier-binding (quote-syntax pnabbed))))) + pnabbed)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define three/snabbed + '(module three '#%kernel + (#%module-begin + (#%require 'two) + (#%app printf "~s ~s\n" + (resolved-module-path-name + (module-path-index-resolve (car (identifier-binding (quote-syntax snabbed))))) + snabbed)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define three/normal + '(module three '#%kernel + (#%module-begin + (#%require 'two) + (#%app printf "~s ~s\n" + (resolved-module-path-name + (module-path-index-resolve (car (identifier-binding (quote-syntax normal))))) + normal)))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define (xeval e) + (eval + (if (bytes? e) + (parameterize ([read-accept-compiled #t]) + (read (open-input-bytes e))) + e))) + +(define (mp-try-all zero one two/no-protect two/protect three/nabbed three/pnabbed three/snabbed three/normal + get-one-inspector get-three-inspector fail-pnab? fail-prot? fail-three? np-ok?) + (let ([try + (lambda (two three v) + (let ([ns (make-base-namespace)] + [p (open-output-bytes)]) + (parameterize ([current-namespace ns] + [current-output-port p]) + (xeval zero) + (parameterize ([current-code-inspector (get-one-inspector)]) + (xeval one) + (xeval two) + (parameterize ([current-code-inspector (get-three-inspector)]) + (with-handlers ([(lambda (x) fail-three?) + (lambda (exn) + (printf "~a\n" (exn-message exn)))]) + (xeval three)) + (with-handlers ([values (lambda (exn) + (printf "~a\n" (exn-message exn)))]) + (eval '(#%require 'three)))))) + (test #t regexp-match? + (if (byte-regexp? v) v (byte-regexp (string->bytes/utf-8 (format "~a\n" v)))) + (get-output-bytes p))))]) + (try two/no-protect three/nabbed (if (and fail-prot? (not np-ok?)) #rx#"unexported .* unexp" #rx#"one 5")) + (try two/no-protect three/pnabbed (if (and fail-pnab? (not np-ok?)) #rx#"protected .* prot" #rx#"zero 8")) + (try two/no-protect three/snabbed #rx#"one 13") + (try two/no-protect three/normal #rx#"two 10") + (try two/protect three/nabbed (if fail-prot? #rx#"unexported .* unexp" #rx#"one 5")) + (try two/protect three/pnabbed (if fail-pnab? #rx#"protected .* prot" #rx#"zero 8")) + (try two/protect three/snabbed (if (and fail-prot? np-ok?) #rx#"unexported .* stx" #rx#"one 13")) + (try two/protect three/normal (if fail-prot? #rx#"protected .* normal" #rx#"two 10")))) + +;; - - - - - - - - - - - - - - - - - - - - + +(define-values (zero-zo one-zo two/no-protect-zo two/protect-zo + three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/normal-zo) + (apply + values + (let ([ns (make-base-namespace)]) + (parameterize ([current-namespace ns]) + (map (lambda (c) + (let ([c (compile c)] + [p (open-output-bytes)]) + (write c p) + (eval c) + (get-output-bytes p))) + (list zero one two/no-protect two/protect three/nabbed three/pnabbed three/snabbed three/normal)))))) + +;; - - - - - - - - - - - - - - - - - - - - + + +(mp-try-all zero one two/no-protect two/protect three/nabbed three/pnabbed three/snabbed three/normal + current-code-inspector current-code-inspector #f #f #f #f) + +(mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/normal-zo + current-code-inspector current-code-inspector #f #f #f #f) + +(mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/normal-zo + make-inspector current-code-inspector #t #f #f #f) + +(mp-try-all zero one two/no-protect two/protect three/nabbed three/pnabbed three/snabbed-zo three/normal + make-inspector current-code-inspector #t #f #t #f) + +(mp-try-all zero-zo one-zo two/no-protect-zo two/protect-zo three/nabbed-zo three/pnabbed-zo three/snabbed-zo three/normal-zo + current-code-inspector make-inspector #t #t #f #f) + +(mp-try-all zero one two/no-protect two/protect three/nabbed three/pnabbed three/snabbed three/normal + current-code-inspector make-inspector #t #t #t #t) + +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(report-errs) diff --git a/collects/tests/mzscheme/mz-tests.ss b/collects/tests/mzscheme/mz-tests.ss index dfc0d5921f..07e8f7adc7 100644 --- a/collects/tests/mzscheme/mz-tests.ss +++ b/collects/tests/mzscheme/mz-tests.ss @@ -23,6 +23,7 @@ (load-relative "prompt.ss") (load-relative "will.ss") (load-relative "namespac.ss") +(load-relative "modprot.ss") (unless (or building-flat-tests? in-drscheme?) (load-relative "param.ss")) (load-relative "port.ss") diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 106a7fda17..695378257d 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,10 +1,10 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,51,50,0,0,0,1,0,0,3,0,12,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,53,50,0,0,0,1,0,0,3,0,12,0, 17,0,20,0,27,0,40,0,47,0,51,0,58,0,63,0,68,0,72,0,78, 0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0, -177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,87,1,126,1,165, -1,234,1,42,2,130,2,194,2,199,2,219,2,110,3,130,3,181,3,247,3, -132,4,34,5,84,5,107,5,186,5,0,0,132,7,0,0,29,11,11,68,104, +177,0,179,0,193,0,1,1,27,1,35,1,43,1,53,1,89,1,128,1,167, +1,236,1,44,2,132,2,196,2,201,2,221,2,112,3,132,3,183,3,249,3, +134,4,36,5,86,5,109,5,188,5,0,0,135,7,0,0,29,11,11,68,104, 101,114,101,45,115,116,120,64,99,111,110,100,62,111,114,66,108,101,116,114,101, 99,72,112,97,114,97,109,101,116,101,114,105,122,101,66,117,110,108,101,115,115, 63,108,101,116,66,100,101,102,105,110,101,64,119,104,101,110,64,108,101,116,42, @@ -13,100 +13,100 @@ 98,101,103,105,110,63,115,116,120,61,115,70,108,101,116,45,118,97,108,117,101, 115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109, 98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110, -45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98, -10,35,11,8,165,228,94,159,2,15,35,35,159,2,14,35,35,16,20,2,3, -2,1,2,5,2,1,2,6,2,1,2,7,2,1,2,8,2,1,2,9,2, -1,2,10,2,1,2,4,2,1,2,11,2,1,2,12,2,1,97,36,11,8, -165,228,93,159,2,14,35,36,16,2,2,2,161,2,1,36,2,2,2,1,2, -2,97,10,11,11,8,165,228,16,0,97,10,37,11,8,165,228,16,0,13,16, -4,35,29,11,11,2,1,11,18,16,2,99,64,104,101,114,101,8,31,8,30, -8,29,8,28,8,27,93,8,224,44,57,0,0,95,9,8,224,44,57,0,0, -2,1,27,248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251,22,75, -2,16,248,22,90,23,200,2,12,249,22,65,2,17,248,22,92,23,202,1,27, -248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251,22,75,2,16,248, -22,90,23,200,2,249,22,65,2,17,248,22,92,23,202,1,12,27,248,22,67, -248,22,135,4,23,197,1,28,248,22,73,23,194,2,20,15,159,36,35,36,28, -248,22,73,248,22,67,23,195,2,248,22,66,193,249,22,128,4,80,158,38,35, -251,22,75,2,16,248,22,66,23,200,2,249,22,65,2,12,248,22,67,23,202, -1,11,18,16,2,101,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11, -2,18,3,1,7,101,110,118,57,56,50,51,16,4,11,11,2,19,3,1,7, -101,110,118,57,56,50,52,93,8,224,45,57,0,0,95,9,8,224,45,57,0, -0,2,1,27,248,22,67,248,22,135,4,23,197,1,28,248,22,73,23,194,2, -20,15,159,36,35,36,28,248,22,73,248,22,67,23,195,2,248,22,66,193,249, -22,128,4,80,158,38,35,250,22,75,2,20,248,22,75,249,22,75,248,22,75, -2,21,248,22,66,23,202,2,251,22,75,2,16,2,21,2,21,249,22,65,2, -4,248,22,67,23,205,1,18,16,2,101,11,8,31,8,30,8,29,8,28,8, -27,16,4,11,11,2,18,3,1,7,101,110,118,57,56,50,54,16,4,11,11, -2,19,3,1,7,101,110,118,57,56,50,55,93,8,224,46,57,0,0,95,9, -8,224,46,57,0,0,2,1,248,22,135,4,193,27,248,22,135,4,194,249,22, -65,248,22,75,248,22,66,196,248,22,67,195,27,248,22,67,248,22,135,4,23, -197,1,249,22,128,4,80,158,38,35,28,248,22,53,248,22,129,4,248,22,66, -23,198,2,27,249,22,2,32,0,89,162,8,44,36,42,9,222,33,39,248,22, -135,4,248,22,90,23,200,2,250,22,75,2,22,248,22,75,249,22,75,248,22, -75,248,22,66,23,204,2,250,22,76,2,23,249,22,2,22,66,23,204,2,248, -22,92,23,206,2,249,22,65,248,22,66,23,202,1,249,22,2,22,90,23,200, -1,250,22,76,2,20,249,22,2,32,0,89,162,8,44,36,46,9,222,33,40, -248,22,135,4,248,22,66,201,248,22,67,198,27,248,22,135,4,194,249,22,65, -248,22,75,248,22,66,196,248,22,67,195,27,248,22,67,248,22,135,4,23,197, -1,249,22,128,4,80,158,38,35,250,22,76,2,22,249,22,2,32,0,89,162, -8,44,36,46,9,222,33,42,248,22,135,4,248,22,66,201,248,22,67,198,27, -248,22,67,248,22,135,4,196,27,248,22,135,4,248,22,66,195,249,22,128,4, -80,158,39,35,28,248,22,73,195,250,22,76,2,20,9,248,22,67,199,250,22, -75,2,8,248,22,75,248,22,66,199,250,22,76,2,11,248,22,67,201,248,22, -67,202,27,248,22,67,248,22,135,4,23,197,1,27,249,22,1,22,79,249,22, -2,22,135,4,248,22,135,4,248,22,66,199,249,22,128,4,80,158,39,35,251, -22,75,1,22,119,105,116,104,45,99,111,110,116,105,110,117,97,116,105,111,110, -45,109,97,114,107,2,24,250,22,76,1,23,101,120,116,101,110,100,45,112,97, -114,97,109,101,116,101,114,105,122,97,116,105,111,110,21,95,1,27,99,111,110, -116,105,110,117,97,116,105,111,110,45,109,97,114,107,45,115,101,116,45,102,105, -114,115,116,11,2,24,201,250,22,76,2,20,9,248,22,67,203,27,248,22,67, -248,22,135,4,23,197,1,28,248,22,73,23,194,2,20,15,159,36,35,36,249, -22,128,4,80,158,38,35,27,248,22,135,4,248,22,66,23,198,2,28,249,22, -164,8,62,61,62,248,22,129,4,248,22,90,23,197,2,250,22,75,2,20,248, -22,75,249,22,75,21,93,2,25,248,22,66,199,250,22,76,2,3,249,22,75, -2,25,249,22,75,248,22,99,203,2,25,248,22,67,202,251,22,75,2,16,28, -249,22,164,8,248,22,129,4,248,22,66,23,201,2,64,101,108,115,101,10,248, -22,66,23,198,2,250,22,76,2,20,9,248,22,67,23,201,1,249,22,65,2, -3,248,22,67,23,203,1,100,8,31,8,30,8,29,8,28,8,27,16,4,11, -11,2,18,3,1,7,101,110,118,57,56,52,57,16,4,11,11,2,19,3,1, -7,101,110,118,57,56,53,48,93,8,224,47,57,0,0,18,16,2,158,94,10, -64,118,111,105,100,8,47,95,9,8,224,47,57,0,0,2,1,27,248,22,67, -248,22,135,4,196,249,22,128,4,80,158,38,35,28,248,22,53,248,22,129,4, -248,22,66,197,250,22,75,2,26,248,22,75,248,22,66,199,248,22,90,198,27, -248,22,129,4,248,22,66,197,250,22,75,2,26,248,22,75,248,22,66,197,250, -22,76,2,23,248,22,67,199,248,22,67,202,159,35,20,103,159,35,16,1,11, -16,0,83,158,41,20,100,143,69,35,37,109,105,110,45,115,116,120,2,1,11, -10,11,10,35,80,158,35,35,20,103,159,35,16,0,16,0,11,11,16,1,2, -2,36,16,0,35,16,0,35,11,11,38,35,11,11,16,10,2,3,2,4,2, -5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11,11, -11,11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2, -9,2,10,2,11,2,12,35,45,36,11,11,16,0,16,0,16,0,35,35,11, -11,11,16,0,16,0,16,0,35,35,16,11,16,5,2,2,20,15,159,35,35, -35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,2,7,89,162,8,44, -36,52,9,223,0,33,33,35,20,103,159,35,16,1,2,2,16,0,11,16,5, -2,10,89,162,8,44,36,52,9,223,0,33,34,35,20,103,159,35,16,1,2, -2,16,0,11,16,5,2,12,89,162,8,44,36,52,9,223,0,33,35,35,20, -103,159,35,16,1,2,2,16,1,33,36,11,16,5,2,4,89,162,8,44,36, -55,9,223,0,33,37,35,20,103,159,35,16,1,2,2,16,1,33,38,11,16, -5,2,8,89,162,8,44,36,57,9,223,0,33,41,35,20,103,159,35,16,1, -2,2,16,0,11,16,5,2,5,89,162,8,44,36,52,9,223,0,33,43,35, -20,103,159,35,16,1,2,2,16,0,11,16,5,2,11,89,162,8,44,36,53, -9,223,0,33,44,35,20,103,159,35,16,1,2,2,16,0,11,16,5,2,6, -89,162,8,44,36,54,9,223,0,33,45,35,20,103,159,35,16,1,2,2,16, -0,11,16,5,2,3,89,162,8,44,36,57,9,223,0,33,46,35,20,103,159, -35,16,1,2,2,16,1,33,48,11,16,5,2,9,89,162,8,44,36,53,9, -223,0,33,49,35,20,103,159,35,16,1,2,2,16,0,11,16,0,94,2,14, -2,15,93,2,14,9,9,35,0}; - EVAL_ONE_SIZED_STR((char *)expr, 2045); +45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,97, +35,11,8,168,228,95,159,2,15,35,35,159,2,14,35,35,159,2,14,35,35, +16,20,2,3,2,1,2,5,2,1,2,6,2,1,2,7,2,1,2,8,2, +1,2,9,2,1,2,10,2,1,2,4,2,1,2,11,2,1,2,12,2,1, +97,36,11,8,168,228,93,159,2,14,35,36,16,2,2,2,161,2,1,36,2, +2,2,1,2,2,96,11,11,8,168,228,16,0,96,37,11,8,168,228,16,0, +13,16,4,35,29,11,11,2,1,11,18,16,2,99,64,104,101,114,101,8,31, +8,30,8,29,8,28,8,27,93,8,224,47,57,0,0,95,9,8,224,47,57, +0,0,2,1,27,248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251, +22,75,2,16,248,22,90,23,200,2,12,249,22,65,2,17,248,22,92,23,202, +1,27,248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251,22,75,2, +16,248,22,90,23,200,2,249,22,65,2,17,248,22,92,23,202,1,12,27,248, +22,67,248,22,135,4,23,197,1,28,248,22,73,23,194,2,20,15,159,36,35, +36,28,248,22,73,248,22,67,23,195,2,248,22,66,193,249,22,128,4,80,158, +38,35,251,22,75,2,16,248,22,66,23,200,2,249,22,65,2,12,248,22,67, +23,202,1,11,18,16,2,101,10,8,31,8,30,8,29,8,28,8,27,16,4, +11,11,2,18,3,1,7,101,110,118,57,56,49,54,16,4,11,11,2,19,3, +1,7,101,110,118,57,56,49,55,93,8,224,48,57,0,0,95,9,8,224,48, +57,0,0,2,1,27,248,22,67,248,22,135,4,23,197,1,28,248,22,73,23, +194,2,20,15,159,36,35,36,28,248,22,73,248,22,67,23,195,2,248,22,66, +193,249,22,128,4,80,158,38,35,250,22,75,2,20,248,22,75,249,22,75,248, +22,75,2,21,248,22,66,23,202,2,251,22,75,2,16,2,21,2,21,249,22, +65,2,4,248,22,67,23,205,1,18,16,2,101,11,8,31,8,30,8,29,8, +28,8,27,16,4,11,11,2,18,3,1,7,101,110,118,57,56,49,57,16,4, +11,11,2,19,3,1,7,101,110,118,57,56,50,48,93,8,224,49,57,0,0, +95,9,8,224,49,57,0,0,2,1,248,22,135,4,193,27,248,22,135,4,194, +249,22,65,248,22,75,248,22,66,196,248,22,67,195,27,248,22,67,248,22,135, +4,23,197,1,249,22,128,4,80,158,38,35,28,248,22,53,248,22,129,4,248, +22,66,23,198,2,27,249,22,2,32,0,89,162,8,44,36,42,9,222,33,39, +248,22,135,4,248,22,90,23,200,2,250,22,75,2,22,248,22,75,249,22,75, +248,22,75,248,22,66,23,204,2,250,22,76,2,23,249,22,2,22,66,23,204, +2,248,22,92,23,206,2,249,22,65,248,22,66,23,202,1,249,22,2,22,90, +23,200,1,250,22,76,2,20,249,22,2,32,0,89,162,8,44,36,46,9,222, +33,40,248,22,135,4,248,22,66,201,248,22,67,198,27,248,22,135,4,194,249, +22,65,248,22,75,248,22,66,196,248,22,67,195,27,248,22,67,248,22,135,4, +23,197,1,249,22,128,4,80,158,38,35,250,22,76,2,22,249,22,2,32,0, +89,162,8,44,36,46,9,222,33,42,248,22,135,4,248,22,66,201,248,22,67, +198,27,248,22,67,248,22,135,4,196,27,248,22,135,4,248,22,66,195,249,22, +128,4,80,158,39,35,28,248,22,73,195,250,22,76,2,20,9,248,22,67,199, +250,22,75,2,8,248,22,75,248,22,66,199,250,22,76,2,11,248,22,67,201, +248,22,67,202,27,248,22,67,248,22,135,4,23,197,1,27,249,22,1,22,79, +249,22,2,22,135,4,248,22,135,4,248,22,66,199,249,22,128,4,80,158,39, +35,251,22,75,1,22,119,105,116,104,45,99,111,110,116,105,110,117,97,116,105, +111,110,45,109,97,114,107,2,24,250,22,76,1,23,101,120,116,101,110,100,45, +112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,21,95,1,27,99, +111,110,116,105,110,117,97,116,105,111,110,45,109,97,114,107,45,115,101,116,45, +102,105,114,115,116,11,2,24,201,250,22,76,2,20,9,248,22,67,203,27,248, +22,67,248,22,135,4,23,197,1,28,248,22,73,23,194,2,20,15,159,36,35, +36,249,22,128,4,80,158,38,35,27,248,22,135,4,248,22,66,23,198,2,28, +249,22,164,8,62,61,62,248,22,129,4,248,22,90,23,197,2,250,22,75,2, +20,248,22,75,249,22,75,21,93,2,25,248,22,66,199,250,22,76,2,3,249, +22,75,2,25,249,22,75,248,22,99,203,2,25,248,22,67,202,251,22,75,2, +16,28,249,22,164,8,248,22,129,4,248,22,66,23,201,2,64,101,108,115,101, +10,248,22,66,23,198,2,250,22,76,2,20,9,248,22,67,23,201,1,249,22, +65,2,3,248,22,67,23,203,1,100,8,31,8,30,8,29,8,28,8,27,16, +4,11,11,2,18,3,1,7,101,110,118,57,56,52,50,16,4,11,11,2,19, +3,1,7,101,110,118,57,56,52,51,93,8,224,50,57,0,0,18,16,2,158, +94,10,64,118,111,105,100,8,47,95,9,8,224,50,57,0,0,2,1,27,248, +22,67,248,22,135,4,196,249,22,128,4,80,158,38,35,28,248,22,53,248,22, +129,4,248,22,66,197,250,22,75,2,26,248,22,75,248,22,66,199,248,22,90, +198,27,248,22,129,4,248,22,66,197,250,22,75,2,26,248,22,75,248,22,66, +197,250,22,76,2,23,248,22,67,199,248,22,67,202,159,35,20,103,159,35,16, +1,11,16,0,83,158,41,20,100,144,69,35,37,109,105,110,45,115,116,120,2, +1,11,11,11,10,35,80,158,35,35,20,103,159,35,16,0,16,0,16,1,2, +2,36,16,0,35,16,0,35,11,11,38,35,11,11,11,16,10,2,3,2,4, +2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11, +11,11,11,11,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8, +2,9,2,10,2,11,2,12,35,45,36,11,11,11,16,0,16,0,16,0,35, +35,11,11,11,11,16,0,16,0,16,0,35,35,16,11,16,5,2,2,20,15, +159,35,35,35,35,20,103,159,35,16,0,16,1,33,32,10,16,5,2,7,89, +162,8,44,36,52,9,223,0,33,33,35,20,103,159,35,16,1,2,2,16,0, +11,16,5,2,10,89,162,8,44,36,52,9,223,0,33,34,35,20,103,159,35, +16,1,2,2,16,0,11,16,5,2,12,89,162,8,44,36,52,9,223,0,33, +35,35,20,103,159,35,16,1,2,2,16,1,33,36,11,16,5,2,4,89,162, +8,44,36,55,9,223,0,33,37,35,20,103,159,35,16,1,2,2,16,1,33, +38,11,16,5,2,8,89,162,8,44,36,57,9,223,0,33,41,35,20,103,159, +35,16,1,2,2,16,0,11,16,5,2,5,89,162,8,44,36,52,9,223,0, +33,43,35,20,103,159,35,16,1,2,2,16,0,11,16,5,2,11,89,162,8, +44,36,53,9,223,0,33,44,35,20,103,159,35,16,1,2,2,16,0,11,16, +5,2,6,89,162,8,44,36,54,9,223,0,33,45,35,20,103,159,35,16,1, +2,2,16,0,11,16,5,2,3,89,162,8,44,36,57,9,223,0,33,46,35, +20,103,159,35,16,1,2,2,16,1,33,48,11,16,5,2,9,89,162,8,44, +36,53,9,223,0,33,49,35,20,103,159,35,16,1,2,2,16,0,11,16,0, +94,2,14,2,15,93,2,14,9,9,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 2048); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,51,59,0,0,0,1,0,0,13,0,18,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,53,59,0,0,0,1,0,0,13,0,18,0, 35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226, 0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1, 199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100, 6,114,6,148,6,164,6,14,8,28,8,191,8,194,9,194,10,201,10,208,10, 215,10,90,11,103,11,58,12,160,12,173,12,195,12,147,13,51,14,123,15,131, -15,139,15,165,15,20,16,0,0,8,19,0,0,72,112,97,116,104,45,115,116, +15,139,15,165,15,20,16,0,0,9,19,0,0,72,112,97,116,104,45,115,116, 114,105,110,103,63,64,98,115,98,115,76,110,111,114,109,97,108,45,99,97,115, 101,45,112,97,116,104,74,45,99,104,101,99,107,45,114,101,108,112,97,116,104, 77,45,99,104,101,99,107,45,99,111,108,108,101,99,116,105,111,110,75,99,111, @@ -303,69 +303,69 @@ 175,3,23,202,1,28,192,192,35,249,22,153,5,23,197,1,83,158,39,20,97, 95,89,162,8,44,35,47,9,224,3,2,33,57,23,195,1,23,196,1,27,248, 22,138,5,23,195,1,248,80,159,38,53,36,193,159,35,20,103,159,35,16,1, -11,16,0,83,158,41,20,100,143,67,35,37,117,116,105,108,115,29,11,11,11, -11,10,10,42,80,158,35,35,20,103,159,37,16,17,2,1,2,2,2,3,2, +11,16,0,83,158,41,20,100,144,67,35,37,117,116,105,108,115,29,11,11,11, +11,11,10,42,80,158,35,35,20,103,159,37,16,17,2,1,2,2,2,3,2, 4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,2,14, 2,15,30,2,17,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105, 111,110,45,107,101,121,4,30,2,17,1,23,101,120,116,101,110,100,45,112,97, -114,97,109,101,116,101,114,105,122,97,116,105,111,110,3,16,0,11,11,16,0, -35,16,0,35,16,4,2,5,2,4,2,2,2,8,39,11,11,38,35,11,11, -16,11,2,7,2,6,2,15,2,14,2,12,2,11,2,3,2,10,2,13,2, -9,2,1,16,11,11,11,11,11,11,11,11,11,11,11,11,16,11,2,7,2, -6,2,15,2,14,2,12,2,11,2,3,2,10,2,13,2,9,2,1,46,46, -36,11,11,16,0,16,0,16,0,35,35,11,11,11,16,0,16,0,16,0,35, -35,16,0,16,17,83,158,35,16,2,89,162,43,36,48,2,18,223,0,33,28, -80,159,35,53,36,83,158,35,16,2,89,162,8,44,36,55,2,18,223,0,33, -29,80,159,35,52,36,83,158,35,16,2,32,0,89,162,43,36,44,2,1,222, -33,30,80,159,35,35,36,83,158,35,16,2,249,22,161,6,7,92,7,92,80, -159,35,36,36,83,158,35,16,2,89,162,43,36,53,2,3,223,0,33,31,80, -159,35,37,36,83,158,35,16,2,32,0,89,162,8,44,37,49,2,4,222,33, -32,80,159,35,38,36,83,158,35,16,2,32,0,89,162,8,44,38,50,2,5, -222,33,34,80,159,35,39,36,83,158,35,16,2,89,162,8,45,37,47,2,6, -223,0,33,36,80,159,35,40,36,83,158,35,16,2,32,0,89,162,43,39,51, -2,7,222,33,39,80,159,35,41,36,83,158,35,16,2,32,0,89,162,43,38, -49,2,8,222,33,40,80,159,35,42,36,83,158,35,16,2,32,0,89,162,43, -37,52,2,9,222,33,41,80,159,35,43,36,83,158,35,16,2,32,0,89,162, -43,37,53,2,10,222,33,42,80,159,35,44,36,83,158,35,16,2,32,0,89, -162,43,36,43,2,11,222,33,43,80,159,35,45,36,83,158,35,16,2,83,158, -38,20,96,96,2,12,89,162,43,35,43,9,223,0,33,44,89,162,43,36,44, -9,223,0,33,45,89,162,43,37,54,9,223,0,33,46,80,159,35,46,36,83, -158,35,16,2,27,248,22,187,13,248,22,170,7,27,28,249,22,164,8,247,22, -178,7,2,20,6,1,1,59,6,1,1,58,250,22,143,7,6,14,14,40,91, -94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,89,162,8, -44,37,47,2,13,223,0,33,49,80,159,35,47,36,83,158,35,16,2,83,158, -38,20,96,96,2,14,89,162,8,44,38,53,9,223,0,33,54,89,162,43,37, -46,9,223,0,33,55,89,162,43,36,45,9,223,0,33,56,80,159,35,48,36, -83,158,35,16,2,89,162,43,38,51,2,15,223,0,33,58,80,159,35,49,36, -94,29,94,2,16,68,35,37,107,101,114,110,101,108,11,29,94,2,16,69,35, -37,109,105,110,45,115,116,120,11,9,9,9,35,0}; - EVAL_ONE_SIZED_STR((char *)expr, 5011); +114,97,109,101,116,101,114,105,122,97,116,105,111,110,3,16,0,16,0,35,16, +0,35,16,4,2,5,2,4,2,2,2,8,39,11,11,38,35,11,11,11,16, +11,2,7,2,6,2,15,2,14,2,12,2,11,2,3,2,10,2,13,2,9, +2,1,16,11,11,11,11,11,11,11,11,11,11,11,11,16,11,2,7,2,6, +2,15,2,14,2,12,2,11,2,3,2,10,2,13,2,9,2,1,46,46,36, +11,11,11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,16,0, +35,35,16,0,16,17,83,158,35,16,2,89,162,43,36,48,2,18,223,0,33, +28,80,159,35,53,36,83,158,35,16,2,89,162,8,44,36,55,2,18,223,0, +33,29,80,159,35,52,36,83,158,35,16,2,32,0,89,162,43,36,44,2,1, +222,33,30,80,159,35,35,36,83,158,35,16,2,249,22,161,6,7,92,7,92, +80,159,35,36,36,83,158,35,16,2,89,162,43,36,53,2,3,223,0,33,31, +80,159,35,37,36,83,158,35,16,2,32,0,89,162,8,44,37,49,2,4,222, +33,32,80,159,35,38,36,83,158,35,16,2,32,0,89,162,8,44,38,50,2, +5,222,33,34,80,159,35,39,36,83,158,35,16,2,89,162,8,45,37,47,2, +6,223,0,33,36,80,159,35,40,36,83,158,35,16,2,32,0,89,162,43,39, +51,2,7,222,33,39,80,159,35,41,36,83,158,35,16,2,32,0,89,162,43, +38,49,2,8,222,33,40,80,159,35,42,36,83,158,35,16,2,32,0,89,162, +43,37,52,2,9,222,33,41,80,159,35,43,36,83,158,35,16,2,32,0,89, +162,43,37,53,2,10,222,33,42,80,159,35,44,36,83,158,35,16,2,32,0, +89,162,43,36,43,2,11,222,33,43,80,159,35,45,36,83,158,35,16,2,83, +158,38,20,96,96,2,12,89,162,43,35,43,9,223,0,33,44,89,162,43,36, +44,9,223,0,33,45,89,162,43,37,54,9,223,0,33,46,80,159,35,46,36, +83,158,35,16,2,27,248,22,187,13,248,22,170,7,27,28,249,22,164,8,247, +22,178,7,2,20,6,1,1,59,6,1,1,58,250,22,143,7,6,14,14,40, +91,94,126,97,93,42,41,126,97,40,46,42,41,23,196,2,23,196,1,89,162, +8,44,37,47,2,13,223,0,33,49,80,159,35,47,36,83,158,35,16,2,83, +158,38,20,96,96,2,14,89,162,8,44,38,53,9,223,0,33,54,89,162,43, +37,46,9,223,0,33,55,89,162,43,36,45,9,223,0,33,56,80,159,35,48, +36,83,158,35,16,2,89,162,43,38,51,2,15,223,0,33,58,80,159,35,49, +36,94,29,94,2,16,68,35,37,107,101,114,110,101,108,11,29,94,2,16,69, +35,37,109,105,110,45,115,116,120,11,9,9,9,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 5012); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,51,8,0,0,0,1,0,0,6,0,19,0, -34,0,48,0,62,0,76,0,111,0,0,0,1,1,0,0,65,113,117,111,116, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,53,8,0,0,0,1,0,0,6,0,19,0, +34,0,48,0,62,0,76,0,115,0,0,0,6,1,0,0,65,113,117,111,116, 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37, 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122, 11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35, -37,107,101,114,110,101,108,11,98,10,35,11,8,171,230,97,159,2,2,35,35, -159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,16, -0,159,35,20,103,159,35,16,1,11,16,0,83,158,41,20,100,143,69,35,37, -98,117,105,108,116,105,110,29,11,11,11,10,10,18,96,11,42,42,42,35,80, -158,35,35,20,103,159,35,16,0,16,0,11,11,16,0,35,16,0,35,16,0, -35,11,11,38,35,11,11,16,0,16,0,16,0,35,35,36,11,11,16,0,16, -0,16,0,35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,0,99, -2,6,2,5,29,94,2,1,69,35,37,102,111,114,101,105,103,110,11,2,4, -2,3,2,2,29,94,2,1,67,35,37,112,108,97,99,101,11,9,9,9,35, -0}; - EVAL_ONE_SIZED_STR((char *)expr, 294); +37,107,101,114,110,101,108,11,97,35,11,8,174,230,98,159,2,2,35,35,159, +2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,159,2, +6,35,35,16,0,159,35,20,103,159,35,16,1,11,16,0,83,158,41,20,100, +144,69,35,37,98,117,105,108,116,105,110,29,11,11,11,11,11,18,96,11,42, +42,42,35,80,158,35,35,20,103,159,35,16,0,16,0,16,0,35,16,0,35, +16,0,35,11,11,38,35,11,11,11,16,0,16,0,16,0,35,35,36,11,11, +11,16,0,16,0,16,0,35,35,11,11,11,11,16,0,16,0,16,0,35,35, +16,0,16,0,99,2,6,2,5,29,94,2,1,69,35,37,102,111,114,101,105, +103,110,11,2,4,2,3,2,2,29,94,2,1,67,35,37,112,108,97,99,101, +11,9,9,9,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 299); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,51,52,0,0,0,1,0,0,11,0,38,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,53,52,0,0,0,1,0,0,11,0,38,0, 44,0,57,0,71,0,93,0,119,0,131,0,149,0,169,0,181,0,197,0,220, 0,0,1,5,1,10,1,15,1,24,1,29,1,60,1,64,1,72,1,81,1, 89,1,192,1,237,1,1,2,30,2,61,2,117,2,127,2,174,2,184,2,191, 2,78,4,91,4,110,4,229,4,241,4,137,5,151,5,17,6,23,6,37,6, -64,6,149,6,151,6,217,6,172,12,231,12,9,13,0,0,144,15,0,0,70, +64,6,149,6,151,6,217,6,172,12,231,12,9,13,0,0,145,15,0,0,70, 100,108,108,45,115,117,102,102,105,120,1,25,100,101,102,97,117,108,116,45,108, 111,97,100,47,117,115,101,45,99,111,109,112,105,108,101,100,65,113,117,111,116, 101,29,94,2,3,67,35,37,117,116,105,108,115,11,29,94,2,3,68,35,37, @@ -525,8 +525,8 @@ 33,42,89,162,43,38,48,9,223,1,33,43,89,162,43,39,8,30,9,225,2, 3,0,33,49,208,87,95,248,22,152,4,248,80,159,37,49,37,247,22,188,11, 248,22,190,4,80,159,36,36,37,248,22,179,12,80,159,36,41,36,159,35,20, -103,159,35,16,1,11,16,0,83,158,41,20,100,143,66,35,37,98,111,111,116, -29,11,11,11,11,10,10,36,80,158,35,35,20,103,159,39,16,19,2,1,2, +103,159,35,16,1,11,16,0,83,158,41,20,100,144,66,35,37,98,111,111,116, +29,11,11,11,11,11,10,36,80,158,35,35,20,103,159,39,16,19,2,1,2, 2,30,2,4,72,112,97,116,104,45,115,116,114,105,110,103,63,10,30,2,4, 75,112,97,116,104,45,97,100,100,45,115,117,102,102,105,120,7,30,2,5,1, 20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,45,107,101,121, @@ -535,26 +535,26 @@ 2,12,2,13,2,14,30,2,4,69,45,102,105,110,100,45,99,111,108,0,30, 2,4,76,110,111,114,109,97,108,45,99,97,115,101,45,112,97,116,104,6,30, 2,4,79,112,97,116,104,45,114,101,112,108,97,99,101,45,115,117,102,102,105, -120,9,2,15,16,0,11,11,16,0,35,16,0,35,16,11,2,9,2,10,2, -7,2,8,2,11,2,12,2,2,2,6,2,1,2,14,2,13,46,11,11,38, -35,11,11,16,1,2,15,16,1,11,16,1,2,15,36,36,36,11,11,16,0, -16,0,16,0,35,35,11,11,11,16,0,16,0,16,0,35,35,16,0,16,16, -83,158,35,16,2,89,162,43,36,44,9,223,0,33,23,80,159,35,57,36,83, -158,35,16,2,89,162,43,36,44,9,223,0,33,24,80,159,35,56,36,83,158, -35,16,2,89,162,43,36,48,67,103,101,116,45,100,105,114,223,0,33,25,80, -159,35,55,36,83,158,35,16,2,89,162,43,37,48,68,119,105,116,104,45,100, -105,114,223,0,33,26,80,159,35,54,36,83,158,35,16,2,248,22,178,7,69, -115,111,45,115,117,102,102,105,120,80,159,35,35,36,83,158,35,16,2,89,162, -43,37,59,2,2,223,0,33,35,80,159,35,36,36,83,158,35,16,2,32,0, -89,162,8,44,36,41,2,6,222,192,80,159,35,41,36,83,158,35,16,2,247, -22,126,80,159,35,42,36,83,158,35,16,2,247,22,125,80,159,35,43,36,83, -158,35,16,2,247,22,61,80,159,35,44,36,83,158,35,16,2,248,22,18,74, -109,111,100,117,108,101,45,108,111,97,100,105,110,103,80,159,35,45,36,83,158, -35,16,2,11,80,158,35,46,83,158,35,16,2,11,80,158,35,47,83,158,35, -16,2,32,0,89,162,43,37,44,2,13,222,33,41,80,159,35,48,36,83,158, -35,16,2,89,162,8,44,36,44,2,14,223,0,33,50,80,159,35,49,36,83, -158,35,16,2,89,162,43,35,43,2,15,223,0,33,51,80,159,35,53,36,95, -29,94,2,3,68,35,37,107,101,114,110,101,108,11,29,94,2,3,69,35,37, -109,105,110,45,115,116,120,11,2,4,9,9,9,35,0}; - EVAL_ONE_SIZED_STR((char *)expr, 4109); +120,9,2,15,16,0,16,0,35,16,0,35,16,11,2,9,2,10,2,7,2, +8,2,11,2,12,2,2,2,6,2,1,2,14,2,13,46,11,11,38,35,11, +11,11,16,1,2,15,16,1,11,16,1,2,15,36,36,36,11,11,11,16,0, +16,0,16,0,35,35,11,11,11,11,16,0,16,0,16,0,35,35,16,0,16, +16,83,158,35,16,2,89,162,43,36,44,9,223,0,33,23,80,159,35,57,36, +83,158,35,16,2,89,162,43,36,44,9,223,0,33,24,80,159,35,56,36,83, +158,35,16,2,89,162,43,36,48,67,103,101,116,45,100,105,114,223,0,33,25, +80,159,35,55,36,83,158,35,16,2,89,162,43,37,48,68,119,105,116,104,45, +100,105,114,223,0,33,26,80,159,35,54,36,83,158,35,16,2,248,22,178,7, +69,115,111,45,115,117,102,102,105,120,80,159,35,35,36,83,158,35,16,2,89, +162,43,37,59,2,2,223,0,33,35,80,159,35,36,36,83,158,35,16,2,32, +0,89,162,8,44,36,41,2,6,222,192,80,159,35,41,36,83,158,35,16,2, +247,22,126,80,159,35,42,36,83,158,35,16,2,247,22,125,80,159,35,43,36, +83,158,35,16,2,247,22,61,80,159,35,44,36,83,158,35,16,2,248,22,18, +74,109,111,100,117,108,101,45,108,111,97,100,105,110,103,80,159,35,45,36,83, +158,35,16,2,11,80,158,35,46,83,158,35,16,2,11,80,158,35,47,83,158, +35,16,2,32,0,89,162,43,37,44,2,13,222,33,41,80,159,35,48,36,83, +158,35,16,2,89,162,8,44,36,44,2,14,223,0,33,50,80,159,35,49,36, +83,158,35,16,2,89,162,43,35,43,2,15,223,0,33,51,80,159,35,53,36, +95,29,94,2,3,68,35,37,107,101,114,110,101,108,11,29,94,2,3,69,35, +37,109,105,110,45,115,116,120,11,2,4,9,9,9,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 4110); } diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index fae5f8556b..d9dd2994b8 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -1180,6 +1180,7 @@ void scheme_shadow(Scheme_Env *env, Scheme_Object *n, int stxtoo) env->mod_phase, NULL, NULL, + NULL, 0); } } @@ -2004,7 +2005,7 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec if (!SCHEME_HASHTP((Scheme_Object *)env) && env->module && (mode < 2)) { Scheme_Object *mod, *nm = id; mod = scheme_stx_module_name(NULL, &nm, scheme_make_integer(env->phase), NULL, NULL, NULL, - NULL, NULL, NULL, NULL); + NULL, NULL, NULL, NULL, NULL); if (mod /* must refer to env->module, otherwise there would have been an error before getting here */ && NOT_SAME_OBJ(nm, sym)) @@ -2527,7 +2528,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, int j = 0, p = 0, modpos, skip_stops = 0, module_self_reference = 0; Scheme_Bucket *b; Scheme_Object *val, *modidx, *modname, *src_find_id, *find_global_id, *mod_defn_phase; - Scheme_Object *find_id_sym = NULL; + Scheme_Object *find_id_sym = NULL, *rename_insp = NULL; Scheme_Env *genv; long phase; @@ -2680,7 +2681,7 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, src_find_id = find_id; modidx = scheme_stx_module_name(NULL, &find_id, scheme_make_integer(phase), NULL, NULL, &mod_defn_phase, - NULL, NULL, NULL, NULL); + NULL, NULL, NULL, NULL, &rename_insp); /* Used out of context? */ if (SAME_OBJ(modidx, scheme_undefined)) { @@ -2765,9 +2766,10 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, val = scheme_module_syntax(modname, env->genv, find_id); if (val && !(flags & SCHEME_NO_CERT_CHECKS)) scheme_check_accessible_in_module(genv, env->insp, in_modidx, - find_id, src_find_id, certs, NULL, -2, 0, - NULL, - env->genv); + find_id, src_find_id, certs, NULL, rename_insp, + -2, 0, + NULL, NULL, + env->genv, NULL); } else { /* Only try syntax table if there's not an explicit (later) variable mapping: */ @@ -2790,8 +2792,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, pos = 0; else pos = scheme_check_accessible_in_module(genv, env->insp, in_modidx, - find_id, src_find_id, certs, NULL, -1, 1, - _protected, env->genv); + find_id, src_find_id, certs, NULL, rename_insp, -1, 1, + _protected, NULL, env->genv, NULL); modpos = SCHEME_INT_VAL(pos); } else modpos = -1; @@ -2958,7 +2960,7 @@ int scheme_check_context(Scheme_Env *env, Scheme_Object *name, Scheme_Object *ok return 1; } else { mod = scheme_stx_module_name(NULL, &id, scheme_make_integer(env->phase), NULL, NULL, NULL, - NULL, NULL, NULL, NULL); + NULL, NULL, NULL, NULL, NULL); if (SAME_OBJ(mod, scheme_undefined)) return 1; } diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 5d8df60285..ce5b889df5 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -1610,7 +1610,7 @@ static void do_wrong_syntax(const char *where, phase = scheme_current_thread->current_local_env->genv->phase; else phase = 0; scheme_stx_module_name(0, &first, scheme_make_integer(phase), &mod, &nomwho, - NULL, NULL, NULL, NULL, NULL); + NULL, NULL, NULL, NULL, NULL, NULL); } } } else { diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index 5febd2e7ac..3552cff5e0 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -1788,7 +1788,7 @@ static Scheme_Object *link_module_variable(Scheme_Object *modidx, if (check_access && !SAME_OBJ(menv, env)) { varname = scheme_check_accessible_in_module(menv, insp, NULL, varname, NULL, NULL, - insp, pos, 0, NULL, env); + insp, NULL, pos, 0, NULL, NULL, env, NULL); } } @@ -6091,7 +6091,7 @@ static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Co /* Since the module has a rename for this id, it's certainly defined. */ } else { modidx = scheme_stx_module_name(NULL, &symbol, scheme_make_integer(env->genv->phase), NULL, NULL, NULL, - NULL, NULL, NULL, NULL); + NULL, NULL, NULL, NULL, NULL); if (modidx) { /* If it's an access path, resolve it: */ if (env->genv->module diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 6ffc0eda7b..b0c90a7843 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -217,7 +217,7 @@ typedef void (*Check_Func)(Scheme_Object *prnt_name, Scheme_Object *name, int isval, void *data, Scheme_Object *e, Scheme_Object *form, Scheme_Object *err_src, Scheme_Object *mark_src, Scheme_Object *to_phase, Scheme_Object *src_phase_index, - Scheme_Object *nominal_export_phase); + Scheme_Object *nominal_export_phase, Scheme_Object *in_insp); static void parse_requires(Scheme_Object *form, Scheme_Object *base_modidx, Scheme_Env *env, @@ -245,13 +245,11 @@ static int compute_reprovides(Scheme_Hash_Table *all_provided, Scheme_Env *genv, Scheme_Object *all_rt_defs, Scheme_Object *all_rt_defs_out, Scheme_Object *all_et_defs, Scheme_Object *all_et_defs_out, - Scheme_Object **_exclude_hint, const char *matching_form, Scheme_Object *all_mods, Scheme_Object *all_phases); static char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables, Scheme_Module_Exports *me, Scheme_Env *genv, - int reprovide_kernel, Scheme_Object *form, char **_phase1_protects); static Scheme_Object **compute_indirects(Scheme_Env *genv, @@ -268,7 +266,7 @@ static Scheme_Object *do_namespace_require(Scheme_Env *env, int argc, Scheme_Obj static Scheme_Object *default_module_resolver(int argc, Scheme_Object **argv); static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, char *exps, char *exets, - Scheme_Object **exsnoms, + Scheme_Object **exsnoms, Scheme_Object **exinsps, int start, int count, int do_uninterned); #define MODCHAIN_TABLE(p) ((Scheme_Hash_Table *)(SCHEME_VEC_ELS(p)[0])) @@ -479,7 +477,7 @@ void scheme_finish_kernel(Scheme_Env *env) rn = scheme_make_module_rename(scheme_make_integer(0), mzMOD_RENAME_NORMAL, NULL); for (i = kernel->me->rt->num_provides; i--; ) { scheme_extend_module_rename(rn, kernel_modidx, exs[i], exs[i], kernel_modidx, exs[i], - 0, scheme_make_integer(0), NULL, 0); + 0, scheme_make_integer(0), NULL, NULL, 0); } scheme_seal_module_rename(rn, STX_SEAL_ALL); @@ -613,8 +611,13 @@ Scheme_Object *scheme_sys_wraps_phase(Scheme_Object *phase) rn = scheme_make_module_rename(phase, mzMOD_RENAME_NORMAL, NULL); /* Add a module mapping for all kernel provides: */ - scheme_extend_module_rename_with_kernel(rn, kernel_modidx); - + scheme_extend_module_rename_with_shared(rn, kernel_modidx, + kernel->me->rt, + scheme_make_integer(p), + scheme_make_integer(0), + scheme_null, + 1); + scheme_seal_module_rename(rn, STX_SEAL_ALL); w = scheme_datum_to_syntax(kernel_symbol, scheme_false, scheme_false, 0, 0); @@ -863,8 +866,6 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], srcname = name; srcmname = modname; } else { - try_again: - /* Before starting, check whether the name is provided */ count = srcm->me->rt->num_provides; if (position >= 0) { @@ -930,12 +931,6 @@ static Scheme_Object *_dynamic_require(int argc, Scheme_Object *argv[], srcname = srcm->me->rt->provide_src_names[i]; } - if ((position < 0) && (i == count) && srcm->me->rt->reprovide_kernel) { - /* Check kernel. */ - srcm = kernel; - goto try_again; - } - if (i == count) { if (indirect_ok) { /* Try indirect provides: */ @@ -2180,13 +2175,13 @@ static int do_add_simple_require_renames(Scheme_Object *rn, int can_override) { int i, saw_mb, numvals; - Scheme_Object **exs, **exss, **exsns, *midx, *info, *vec, *nml, *mark_src; + Scheme_Object **exs, **exss, **exsns, *midx, *info, *vec, *nml, *mark_src, **exinsps; char *exets; int with_shared = 1; saw_mb = 0; - if (!pt->num_provides && !pt->reprovide_kernel) + if (!pt->num_provides) return 0; if (with_shared) { @@ -2205,6 +2200,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, exsns = pt->provide_src_names; exss = pt->provide_srcs; exets = pt->provide_src_phases; + exinsps = pt->provide_insps; numvals = pt->num_var_provides; for (i = pt->num_provides; i--; ) { if (exss && !SCHEME_FALSEP(exss[i])) @@ -2213,13 +2209,14 @@ static int do_add_simple_require_renames(Scheme_Object *rn, midx = idx; if (!with_shared) { scheme_extend_module_rename(rn, midx, exs[i], exsns[i], idx, exs[i], - exets ? exets[i] : 0, src_phase_index, pt->phase_index, 1); + exets ? exets[i] : 0, src_phase_index, pt->phase_index, + exinsps ? exinsps[i] : NULL, 1); } if (SAME_OBJ(exs[i], module_begin_symbol)) saw_mb = 1; if (required) { - vec = scheme_make_vector(9, NULL); + vec = scheme_make_vector(10, NULL); nml = scheme_make_pair(idx, scheme_null); SCHEME_VEC_ELS(vec)[0] = nml; SCHEME_VEC_ELS(vec)[1] = midx; @@ -2229,38 +2226,11 @@ static int do_add_simple_require_renames(Scheme_Object *rn, SCHEME_VEC_ELS(vec)[5] = orig_src; SCHEME_VEC_ELS(vec)[6] = mark_src; SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false); - SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : 0; + SCHEME_VEC_ELS(vec)[8] = exets ? scheme_make_integer(exets[i]) : scheme_false; + SCHEME_VEC_ELS(vec)[9] = exets ? exinsps[i] : scheme_false; scheme_hash_set(required, exs[i], vec); } } - - if (pt->reprovide_kernel) { - if (!with_shared) { - scheme_extend_module_rename_with_kernel(rn, idx); - } - saw_mb = 1; - - if (required) { - exs = kernel->me->rt->provides; - numvals = kernel->me->rt->num_var_provides; - for (i = kernel->me->rt->num_provides; i--; ) { - if (!SAME_OBJ(pt->kernel_exclusion, exs[i])) { - vec = scheme_make_vector(9, NULL); - nml = scheme_make_pair(idx, scheme_null); - SCHEME_VEC_ELS(vec)[0] = nml; - SCHEME_VEC_ELS(vec)[1] = kernel_modidx; - SCHEME_VEC_ELS(vec)[2] = exs[i]; - SCHEME_VEC_ELS(vec)[3] = ((i < numvals) ? scheme_true : scheme_false); - SCHEME_VEC_ELS(vec)[4] = exs[i]; - SCHEME_VEC_ELS(vec)[5] = orig_src; - SCHEME_VEC_ELS(vec)[6] = mark_src; - SCHEME_VEC_ELS(vec)[7] = (can_override ? scheme_true : scheme_false); - SCHEME_VEC_ELS(vec)[8] = scheme_make_integer(0); - scheme_hash_set(required, exs[i], vec); - } - } - } - } if (!with_shared) { info = cons(idx, cons(marshal_phase_index, @@ -2391,19 +2361,19 @@ void scheme_prep_namespace_rename(Scheme_Env *menv) if (SCHEME_FALSEP(m->me->rt->provide_srcs[i])) { name = m->me->rt->provides[i]; scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, 0, - scheme_make_integer(0), NULL, 0); + scheme_make_integer(0), NULL, NULL, 0); } } /* Local, not provided: */ for (i = 0; i < m->num_indirect_provides; i++) { name = m->indirect_provides[i]; scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, 0, - scheme_make_integer(0), NULL, 0); + scheme_make_integer(0), NULL, NULL, 0); } for (i = 0; i < m->num_indirect_syntax_provides; i++) { name = m->indirect_syntax_provides[i]; scheme_extend_module_rename(one_rn, m->self_modidx, name, name, m->self_modidx, name, 0, - scheme_make_integer(0), NULL, 0); + scheme_make_integer(0), NULL, NULL, 0); } one_rn = scheme_get_module_rename_from_set(rns, scheme_make_integer(1), 1); @@ -3236,9 +3206,10 @@ Scheme_Env *scheme_module_access(Scheme_Object *name, Scheme_Env *env, int rev_m } static void check_certified(Scheme_Object *stx, Scheme_Object *certs, - Scheme_Object *insp, Scheme_Object *in_modidx, + Scheme_Object *prot_insp, Scheme_Object *insp, + Scheme_Object *rename_insp, Scheme_Object *in_modidx, Scheme_Env *env, Scheme_Object *symbol, - int var, int prot) + int var, int prot, int *_would_complain) { int need_cert = 1; Scheme_Object *midx; @@ -3250,8 +3221,20 @@ static void check_certified(Scheme_Object *stx, Scheme_Object *certs, if (need_cert && insp) need_cert = scheme_module_protected_wrt(env->insp, insp); + if (need_cert && rename_insp) { + if (SCHEME_PAIRP(rename_insp)) { + /* First inspector of pair protects second */ + if (!prot_insp + || scheme_module_protected_wrt(SCHEME_CAR(rename_insp), prot_insp)) { + rename_insp = NULL; + } else + rename_insp = SCHEME_CDR(rename_insp); + } + if (rename_insp) + need_cert = scheme_module_protected_wrt(env->insp, rename_insp); + } - if (need_cert && in_modidx) { + if (need_cert && in_modidx && midx) { /* If we're currently executing a macro expander in this module, then allow the access under any cirsumstances. This is mostly useful for syntax-local-value and local-expand. */ @@ -3262,24 +3245,30 @@ static void check_certified(Scheme_Object *stx, Scheme_Object *certs, } if (need_cert) { - /* For error, if stx is no more specific than symbol, drop symbol. */ - if (stx && SAME_OBJ(SCHEME_STX_SYM(stx), symbol)) { - symbol = stx; - stx = NULL; + if (_would_complain) { + *_would_complain = 1; + } else { + /* For error, if stx is no more specific than symbol, drop symbol. */ + if (stx && SAME_OBJ(SCHEME_STX_SYM(stx), symbol)) { + symbol = stx; + stx = NULL; + } + scheme_wrong_syntax("compile", stx, symbol, + "access from an uncertified context to %s %s from module: %D", + prot ? "protected" : "unexported", + var ? "variable" : "syntax", + env->module->modname); } - scheme_wrong_syntax("compile", stx, symbol, - "access from an uncertified context to %s %s from module: %D", - prot ? "protected" : "unexported", - var ? "variable" : "syntax", - env->module->modname); } } Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *prot_insp, Scheme_Object *in_modidx, Scheme_Object *symbol, Scheme_Object *stx, - Scheme_Object *certs, Scheme_Object *unexp_insp, - int position, int want_pos, int *_protected, - Scheme_Env *from_env) + Scheme_Object *certs, Scheme_Object *unexp_insp, + Scheme_Object *rename_insp, + int position, int want_pos, + int *_protected, int *_unexported, + Scheme_Env *from_env, int *_would_complain) /* Returns the actual name when !want_pos, needed in case of uninterned names. Otherwise, returns a position value on success. If position < -1, then merely checks for protected syntax. @@ -3288,8 +3277,11 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object certifictions in stx+certs, access implied by {prot_,unexp_}insp, or access implied by in_modidx. For unexported access, either stx+certs or unexp_insp must be - supplied (not both). For unprotected access, both prot_insp - and stx+certs should be supplied. */ + supplied (not both), and prot_insp should be supplied + (for protected re-exports of unexported). + For unprotected access, both prot_insp and stx+certs + should be supplied. In either case, rename_insp + is optionally allowed. */ { Scheme_Module_Phase_Exports *pt; @@ -3375,12 +3367,12 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object && provide_protects[position]) { if (_protected) *_protected = 1; - check_certified(stx, certs, prot_insp, in_modidx, env, symbol, 1, 1); + check_certified(stx, certs, prot_insp, prot_insp, rename_insp, in_modidx, env, symbol, 1, 1, _would_complain); } } if (need_cert) - check_certified(stx, certs, unexp_insp, in_modidx, env, symbol, 1, 0); + check_certified(stx, certs, prot_insp, unexp_insp, rename_insp, in_modidx, env, symbol, 1, 0, _would_complain); if (want_pos) return scheme_make_integer(position); @@ -3426,7 +3418,7 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object && provide_protects[SCHEME_INT_VAL(pos)]) { if (_protected) *_protected = 1; - check_certified(stx, certs, prot_insp, in_modidx, env, symbol, 1, 1); + check_certified(stx, certs, prot_insp, prot_insp, rename_insp, in_modidx, env, symbol, 1, 1, _would_complain); } if ((position >= -1) @@ -3434,7 +3426,9 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object /* unexported var -- need cert */ if (_protected) *_protected = 1; - check_certified(stx, certs, unexp_insp, in_modidx, env, symbol, 1, 0); + if (_unexported) + *_unexported = 1; + check_certified(stx, certs, prot_insp, unexp_insp, rename_insp, in_modidx, env, symbol, 1, 0, _would_complain); } if (want_pos) @@ -3445,12 +3439,19 @@ Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object if (position < -1) { /* unexported syntax -- need cert */ - check_certified(stx, certs, unexp_insp, in_modidx, env, symbol, 0, 0); + if (_unexported) + *_unexported = 1; + check_certified(stx, certs, prot_insp, unexp_insp, rename_insp, in_modidx, env, symbol, 0, 0, _would_complain); return NULL; } } } + if (_would_complain) { + *_would_complain = 1; + return NULL; + } + /* For error, if stx is no more specific than symbol, drop symbol. */ if (stx && SAME_OBJ(SCHEME_STX_SYM(stx), symbol)) { symbol = stx; @@ -4329,7 +4330,7 @@ void scheme_finish_primitive_module(Scheme_Env *env) m->me->rt->num_provides = count; m->me->rt->num_var_provides = count; - qsort_provides(exs, NULL, NULL, NULL, NULL, NULL, 0, count, 1); + qsort_provides(exs, NULL, NULL, NULL, NULL, NULL, NULL, 0, count, 1); env->running = 1; } @@ -4631,13 +4632,39 @@ static void eval_exptime(Scheme_Object *names, int count, /* module */ /**********************************************************************/ +static Scheme_Object **declare_insps(int n, Scheme_Object **insps, Scheme_Object *insp) +{ + int i; + Scheme_Object **naya, *v; + + for (i = 0; i < n; i++) { + if (insps[i] && SCHEME_PAIRP(insps[i])) + break; + } + if (i >= n) + return insps; + + insp = scheme_make_inspector(insp); + + naya = MALLOC_N(Scheme_Object*, n); + for (i = 0; i < n; i++) { + v = insps[i]; + if (v && SCHEME_PAIRP(v)) { + v = cons(insp, SCHEME_CDR(v)); + } + naya[i] = v; + } + + return naya; +} + static Scheme_Object * module_execute(Scheme_Object *data) { Scheme_Module *m; Scheme_Env *env; Scheme_Env *old_menv; - Scheme_Object *prefix, *insp; + Scheme_Object *prefix, *insp, **rt_insps, **et_insps; m = MALLOC_ONE_TAGGED(Scheme_Module); memcpy(m, data, sizeof(Scheme_Module)); @@ -4682,6 +4709,40 @@ module_execute(Scheme_Object *data) } } + if (m->me->rt->provide_insps) + rt_insps = declare_insps(m->me->rt->num_provides, m->me->rt->provide_insps, insp); + else + rt_insps = NULL; + if (m->me->et->provide_insps) + et_insps = declare_insps(m->me->et->num_provides, m->me->et->provide_insps, insp); + else + et_insps = NULL; + + if (!SAME_OBJ(rt_insps, m->me->rt->provide_insps) + || !SAME_OBJ(et_insps, m->me->et->provide_insps)) { + /* have to clone m->me, etc. */ + Scheme_Module_Exports *naya_me; + Scheme_Module_Phase_Exports *pt; + + naya_me = MALLOC_ONE_TAGGED(Scheme_Module_Exports); + memcpy(naya_me, m->me, sizeof(Scheme_Module_Exports)); + m->me = naya_me; + + if (!SAME_OBJ(rt_insps, m->me->rt->provide_insps)) { + pt = MALLOC_ONE_TAGGED(Scheme_Module_Phase_Exports); + memcpy(pt, m->me->rt, sizeof(Scheme_Module_Phase_Exports)); + m->me->rt = pt; + pt->provide_insps = rt_insps; + } + + if (!SAME_OBJ(rt_insps, m->me->et->provide_insps)) { + pt = MALLOC_ONE_TAGGED(Scheme_Module_Phase_Exports); + memcpy(pt, m->me->et, sizeof(Scheme_Module_Phase_Exports)); + m->me->et = pt; + pt->provide_insps = et_insps; + } + } + m->insp = insp; scheme_hash_set(env->module_registry, m->modname, (Scheme_Object *)m); scheme_hash_set(env->export_registry, m->modname, (Scheme_Object *)m->me); @@ -5313,12 +5374,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, scheme_prepare_exp_env(menv); /* For each provide in iim, add a module rename to fm */ - if (SAME_OBJ(iim, kernel)) { - scheme_extend_module_rename_with_kernel(rn, kernel_modidx); - saw_mb = 1; - } else { - saw_mb = add_simple_require_renames(NULL, rn_set, NULL, iim, iidx, scheme_make_integer(0), NULL, 1); - } + saw_mb = add_simple_require_renames(NULL, rn_set, NULL, iim, iidx, scheme_make_integer(0), NULL, 1); if (rec[drec].comp) benv = scheme_new_comp_env(menv, env->insp, SCHEME_MODULE_FRAME); @@ -5523,7 +5579,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, int isval, void *tables, Scheme_Object *e, Scheme_Object *form, Scheme_Object *err_src, Scheme_Object *mark_src, Scheme_Object *phase, Scheme_Object *src_phase_index, - Scheme_Object *nominal_export_phase) + Scheme_Object *nominal_export_phase, Scheme_Object *in_insp) { Scheme_Bucket_Table *toplevel, *syntax; Scheme_Hash_Table *required; @@ -5611,7 +5667,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, } /* Remember require: */ - vec = scheme_make_vector(9, NULL); + vec = scheme_make_vector(10, NULL); nml = scheme_make_pair(nominal_modidx, scheme_null); SCHEME_VEC_ELS(vec)[0] = nml; SCHEME_VEC_ELS(vec)[1] = modidx; @@ -5622,6 +5678,7 @@ static void check_require_name(Scheme_Object *prnt_name, Scheme_Object *name, SCHEME_VEC_ELS(vec)[6] = (mark_src ? mark_src : scheme_false); SCHEME_VEC_ELS(vec)[7] = scheme_false; SCHEME_VEC_ELS(vec)[8] = scheme_make_integer(exet); + SCHEME_VEC_ELS(vec)[9] = in_insp; scheme_hash_set(required, name, vec); } @@ -5690,7 +5747,7 @@ static Scheme_Object *add_lifted_defn(Scheme_Object *data, Scheme_Object **_id, scheme_add_global_symbol(name, scheme_undefined, env->genv); /* Add a renaming: */ - scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0); + scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, NULL, 0); id = scheme_add_rename(*_id, rn); *_id = id; @@ -5803,7 +5860,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, Scheme_Object *post_ex_rn, *post_ex_et_rn; /* renames for ids introduced by expansion */ Scheme_Object *post_ex_rn_set; /* phase -> post_ex_rn-like rename */ Scheme_Hash_Table *tables; /* phase -> (vector toplevels requires syntaxes) */ - Scheme_Object *exclude_hint = scheme_false, *lift_data; + Scheme_Object *lift_data; Scheme_Object **exis, **et_exis, **exsis; Scheme_Object *lift_ctx; Scheme_Object *lifted_reqs = scheme_null, *req_data; @@ -5811,7 +5868,6 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, char *exps, *et_exps; int *all_simple_renames; int maybe_has_lifts = 0; - int reprovide_kernel; Scheme_Object *redef_modname; Scheme_Object *observer; @@ -6098,10 +6154,10 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, /* Add a renaming: */ if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) { - scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0); + scheme_extend_module_rename(post_ex_rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, NULL, 0); *all_simple_renames = 0; } else - scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, 0); + scheme_extend_module_rename(rn, self_modidx, name, name, self_modidx, name, 0, NULL, NULL, NULL, 0); vars = SCHEME_STX_CDR(vars); } @@ -6183,12 +6239,12 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, if (!SAME_OBJ(SCHEME_STX_VAL(orig_name), name)) { scheme_extend_module_rename(for_stx ? post_ex_et_rn : post_ex_rn, self_modidx, name, name, self_modidx, name, - for_stx ? 1 : 0, NULL, NULL, 0); + for_stx ? 1 : 0, NULL, NULL, NULL, 0); *all_simple_renames = 0; use_post_ex = 1; } else scheme_extend_module_rename(for_stx ? et_rn : rn, self_modidx, name, name, self_modidx, name, - for_stx ? 1 : 0, NULL, NULL, 0); + for_stx ? 1 : 0, NULL, NULL, NULL, 0); count++; } @@ -6493,60 +6549,19 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_ALL); /* Compute provides for re-provides and all-defs-out: */ - reprovide_kernel = compute_reprovides(all_provided, - all_reprovided, - env->genv->module, - tables, - env->genv, - all_defs, all_defs_out, - all_et_defs, all_et_defs_out, - &exclude_hint, - "require", NULL, NULL); - - /* Ad hoc optimization: some early modules are everything from kernel except - #%module_begin */ - if ((reprovide_kernel == (kernel->me->rt->num_provides - 1)) - && SCHEME_FALSEP(exclude_hint)) { - exclude_hint = scheme_make_pair(module_begin_symbol, scheme_null); - exclude_hint = scheme_datum_to_syntax(exclude_hint, scheme_false, scheme_top_stx, 0, 0); - } - - /* Re-providing all of the kernel without prefixing? */ - if (reprovide_kernel) { - if ((reprovide_kernel == (kernel->me->rt->num_provides - 1)) - && SCHEME_TRUEP(exclude_hint)) { - if (SCHEME_STX_PAIRP(exclude_hint) && SCHEME_NULLP(SCHEME_STX_CDR(exclude_hint))) { - Scheme_Object *n; - - exclude_hint = SCHEME_STX_CAR(exclude_hint); - exclude_hint = SCHEME_STX_VAL(exclude_hint); - n = scheme_hash_get(provided, exclude_hint); - if (n) { - /* may be a single shadowed exclusion, now bound to exclude_hint... */ - n = SCHEME_CAR(n); - if (SCHEME_STXP(n)) - n = scheme_tl_id_sym(env->genv, n, NULL, -1, NULL, NULL); - n = scheme_hash_get(required, n); - if (n && !SAME_OBJ(SCHEME_VEC_ELS(n)[1], kernel_modidx)) { - /* there is a single shadowed exclusion. */ - } else - reprovide_kernel = 0; - } else - reprovide_kernel = 0; - } else - reprovide_kernel = 0; - } else if (reprovide_kernel != kernel->me->rt->num_provides) - reprovide_kernel = 0; - else - exclude_hint = scheme_false; - } - /* If reprovide_kernel is non-zero, we re-provide all of it */ + (void)compute_reprovides(all_provided, + all_reprovided, + env->genv->module, + tables, + env->genv, + all_defs, all_defs_out, + all_et_defs, all_et_defs_out, + "require", NULL, NULL); /* Compute provide arrays */ exps = compute_provide_arrays(all_provided, tables, env->genv->module->me, env->genv, - reprovide_kernel, form, &et_exps); /* Compute indirect provides (which is everything at the top-level): */ @@ -6585,14 +6600,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, result = scheme_null; - /* kernel re-export info: */ - if (reprovide_kernel) { - if (exclude_hint) - result = scheme_make_pair(exclude_hint, result); - else - result = scheme_make_pair(scheme_true, result); - } else - result = scheme_make_pair(scheme_false, result); + /* kernel re-export info (always #f): */ + result = scheme_make_pair(scheme_false, result); /* Indirect provides */ a = scheme_null; @@ -6607,24 +6616,6 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, e = scheme_null; - if (reprovide_kernel) { - if (!j) { - i = kernel->me->rt->num_var_provides; - top = kernel->me->rt->num_provides; - } else { - i = 0; - top = kernel->me->rt->num_var_provides; - } - - for (; i < top; i++) { - if (!SAME_OBJ(kernel->me->rt->provides[i], exclude_hint)) { - a = scheme_make_pair(kernel->me->rt->provides[i], kernel->me->rt->provides[i]); - a = scheme_make_pair(kernel_modidx, a); - e = scheme_make_pair(a, e); - } - } - } - if (!j) { i = exvcount; top = excount; @@ -6669,9 +6660,6 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, env->genv->module->provide_protects = exps; env->genv->module->et_provide_protects = et_exps; - env->genv->module->me->rt->reprovide_kernel = reprovide_kernel; - env->genv->module->me->rt->kernel_exclusion = exclude_hint; - env->genv->module->indirect_provides = exis; env->genv->module->num_indirect_provides = exicount; @@ -6750,7 +6738,6 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, Scheme_Env *_genv, Scheme_Object *all_rt_defs, Scheme_Object *all_rt_defs_out, Scheme_Object *all_et_defs, Scheme_Object *all_et_defs_out, - Scheme_Object **_exclude_hint, const char *matching_form, Scheme_Object *all_mods, /* a phase list to use for all mods */ Scheme_Object *all_phases) /* a module-path list for all phases */ @@ -6759,7 +6746,6 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, Scheme_Object *reprovided, *tvec; int i, k, z; Scheme_Object *rx, *provided_list, *phase, *req_phase; - int reprovide_kernel = 0; Scheme_Object *all_defs, *all_defs_out; Scheme_Env *genv; @@ -6846,7 +6832,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, "cannot provide from a module without a matching `%s'", matching_form); } else { - return -1; + return 0; } } @@ -6942,11 +6928,6 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, ree = SCHEME_CDR(SCHEME_CAR(rx)); exns = SCHEME_CDR(ree); - if (SAME_OBJ(modidx, kernel_modidx)) - if (!SCHEME_STX_NULLP(exns)) { - if (SAME_OBJ(phase, scheme_make_integer(0)) && _exclude_hint) - *_exclude_hint = exns; - } } else { ree = NULL; exns = scheme_null; @@ -6997,10 +6978,6 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, provided_list = scheme_make_pair(name, provided_list); scheme_hash_set(all_provided, req_phase, provided_list); } - - if (SAME_OBJ(phase, scheme_make_integer(0))) - if (SAME_OBJ(modidx, kernel_modidx) && SAME_OBJ(outname, srcname)) - reprovide_kernel++; } } } @@ -7096,7 +7073,7 @@ int compute_reprovides(Scheme_Hash_Table *all_provided, } } - return reprovide_kernel; + return 1; } static Scheme_Object **compute_indirects(Scheme_Env *genv, @@ -7167,7 +7144,7 @@ static Scheme_Object **compute_indirects(Scheme_Env *genv, exicount = count; - qsort_provides(exis, NULL, NULL, NULL, NULL, NULL, 0, exicount, 1); + qsort_provides(exis, NULL, NULL, NULL, NULL, NULL, NULL, 0, exicount, 1); *_count = exicount; return exis; @@ -7216,10 +7193,10 @@ Scheme_Object *scheme_module_imported_list(Scheme_Env *genv, Scheme_Object *bind tables, genv, NULL, NULL, NULL, NULL, - NULL, NULL, + NULL, all_mods, all_phases); - if (v < 0) { + if (!v) { return scheme_false; } else { l = scheme_null; @@ -7279,7 +7256,8 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name, Scheme_Object **_implicit_src_name, Scheme_Object **_implicit_mod_phase, Scheme_Object **_implicit_nominal_name, - Scheme_Object **_implicit_nominal_mod) + Scheme_Object **_implicit_nominal_mod, + Scheme_Object **_implicit_insp) { *_implicit = 0; @@ -7300,29 +7278,72 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name, v2 = scheme_lookup_in_table(genv->syntax, (const char *)name); if (v2 && scheme_is_binding_rename_transformer(SCHEME_PTR_VAL(v2))) { Scheme_Object *name2; - Scheme_Object *mod, *id; + Scheme_Object *mod, *id, *rename_insp = NULL; + Scheme_Object *mod_phase = NULL; name2 = scheme_rename_transformer_id(SCHEME_PTR_VAL(v2)); id = name2; + + if (_implicit_mod_phase) mod_phase = *_implicit_mod_phase; mod = scheme_stx_module_name(NULL, &id, phase, _implicit_nominal_mod, _implicit_nominal_name, - _implicit_mod_phase, - NULL, NULL, NULL, NULL); + &mod_phase, + NULL, NULL, NULL, NULL, &rename_insp); + if (_implicit_mod_phase) *_implicit_mod_phase = mod_phase; + if (mod && SAME_TYPE(SCHEME_TYPE(mod), scheme_module_index_type)) { if (SCHEME_FALSEP(((Scheme_Modidx *)mod)->path)) { /* keep looking locally */ name = name2; SCHEME_USE_FUEL(1); } else { - /* free-id=? equivalence to a name that is not necessarily imported explicitly */ - if (_implicit_src) { - *_implicit_src = mod; - *_implicit_src_name = id; - name2 = scheme_stx_property(name2, nominal_id_symbol, NULL); - if (SCHEME_SYMBOLP(name2)) - *_implicit_nominal_name = name2; + /* free-id=? equivalence to a name that is not necessarily imported explicitly. */ + int would_complain = 0, is_prot = 0, is_unexp = 0; + + if (!SCHEME_FALSEP(phase)) { + /* Check whether reference is certified, and ignore it if not: */ + Scheme_Env *menv; + Scheme_Object *modname; + + modname = scheme_module_resolve(mod, 1); + menv = scheme_module_access(modname, genv, SCHEME_INT_VAL(mod_phase)); + if (!menv) + would_complain = 1; + else { + scheme_check_accessible_in_module(menv, menv->module->insp, mod, + SCHEME_STX_VAL(name2), name2, + NULL, NULL, rename_insp, + -1, 0, + &is_prot, &is_unexp, genv, &would_complain); + if (would_complain && (!is_prot && !is_unexp)) { + /* Must be unexported syntax */ + is_prot = is_unexp = would_complain = 0; + scheme_check_accessible_in_module(menv, menv->module->insp, mod, + SCHEME_STX_VAL(name2), name2, + NULL, NULL, rename_insp, + -2, 0, + &is_prot, &is_unexp, genv, &would_complain); + } + } + } + + + if (!would_complain) { + if (_implicit_src) { + *_implicit_src = mod; + *_implicit_src_name = id; + if (is_prot || is_unexp) { + if (rename_insp) + *_implicit_insp = rename_insp; + else + *_implicit_insp = genv->module->insp; + } + name2 = scheme_stx_property(name2, nominal_id_symbol, NULL); + if (SCHEME_SYMBOLP(name2)) + *_implicit_nominal_name = name2; + } + *_implicit = 1; } - *_implicit = 1; break; } } else @@ -7339,18 +7360,18 @@ static Scheme_Object *extract_free_id_name(Scheme_Object *name, char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table *tables, Scheme_Module_Exports *me, Scheme_Env *genv, - int reprovide_kernel, Scheme_Object *form, char **_phase1_protects) { int i, count, z, implicit; - Scheme_Object **exs, **exsns, **exss, **exsnoms, *phase; + Scheme_Object **exs, **exsns, **exss, **exsnoms, **exinsps, *phase; Scheme_Hash_Table *provided, *required; char *exps, *exets, *phase0_exps = NULL, *phase1_exps = NULL; int excount, exvcount; Scheme_Module_Phase_Exports *pt; Scheme_Object *implicit_src, *implicit_src_name, *implicit_mod_phase; Scheme_Object *implicit_nominal_name, *implicit_nominal_mod; + Scheme_Object *implicit_insp; for (z = 0; z < all_provided->size; z++) { provided = (Scheme_Hash_Table *)all_provided->vals[z]; @@ -7384,13 +7405,11 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table count++; } - if (SAME_OBJ(phase, scheme_make_integer(0))) - count -= reprovide_kernel; - exs = MALLOC_N(Scheme_Object *, count); exsns = MALLOC_N(Scheme_Object *, count); exss = MALLOC_N(Scheme_Object *, count); exsnoms = MALLOC_N(Scheme_Object *, count); + exinsps = MALLOC_N(Scheme_Object *, count); exps = MALLOC_N_ATOMIC(char, count); exets = MALLOC_N_ATOMIC(char, count); memset(exets, 0, count); @@ -7408,7 +7427,7 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table name = extract_free_id_name(name, phase, genv, 1, &implicit, NULL, NULL, NULL, - NULL, NULL); + NULL, NULL, NULL); if (!implicit && genv @@ -7441,24 +7460,19 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table scheme_wrong_syntax("module", NULL, name, "cannot protect imported identifier with re-provide"); } if (SCHEME_TRUEP(SCHEME_VEC_ELS(v)[3])) { - /* If this is a kernel re-provide, don't provide after all. */ - if ((reprovide_kernel && SAME_OBJ(phase, scheme_make_integer(0))) - && SAME_OBJ(SCHEME_VEC_ELS(v)[1], kernel_modidx) - && SAME_OBJ(provided->keys[i], SCHEME_VEC_ELS(v)[2])) { - /* skip */ - } else { - Scheme_Object *noms; - exs[count] = provided->keys[i]; - exsns[count] = SCHEME_VEC_ELS(v)[2]; - exss[count] = SCHEME_VEC_ELS(v)[1]; - noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]); - exsnoms[count] = noms; - exps[count] = protected; - if (SAME_OBJ(SCHEME_VEC_ELS(v)[8], scheme_make_integer(1))) - exets[count] = 1; - - count++; - } + Scheme_Object *noms; + exs[count] = provided->keys[i]; + exsns[count] = SCHEME_VEC_ELS(v)[2]; + exss[count] = SCHEME_VEC_ELS(v)[1]; + noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]); + exsnoms[count] = noms; + exps[count] = protected; + if (SAME_OBJ(SCHEME_VEC_ELS(v)[8], scheme_make_integer(1))) + exets[count] = 1; + if (SCHEME_TRUEP(SCHEME_VEC_ELS(v)[9])) + exinsps[count] = SCHEME_VEC_ELS(v)[9]; + + count++; } } else { /* Not defined! */ @@ -7481,7 +7495,8 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table name = extract_free_id_name(name, phase, genv, 0, &implicit, &implicit_src, &implicit_src_name, &implicit_mod_phase, - &implicit_nominal_name, &implicit_nominal_mod); + &implicit_nominal_name, &implicit_nominal_mod, + &implicit_insp); if (!implicit && genv @@ -7495,33 +7510,34 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table exps[count] = protected; count++; } else if (implicit) { - /* We record all free-id=?-based exprts as synatx, even though they may be values. */ + /* We record all free-id=?-based exprts as syntax, even though they may be values. */ Scheme_Object *noms; exs[count] = provided->keys[i]; exsns[count] = implicit_src_name; exss[count] = implicit_src; noms = adjust_for_rename(exs[count], implicit_nominal_name, cons(implicit_nominal_mod, scheme_null)); exsnoms[count] = noms; - exps[count] = protected; + exps[count] = protected; + if (implicit_insp) { + if (protected) { + implicit_insp = cons(genv->insp, implicit_insp); + } + exinsps[count] = implicit_insp; + } count++; } else if ((v = scheme_hash_get(required, name))) { /* Required */ if (SCHEME_FALSEP(SCHEME_VEC_ELS(v)[3])) { - /* If this is a kernel re-provide, don't provide after all. */ - if ((reprovide_kernel && SAME_OBJ(phase, scheme_make_integer(0))) - && SAME_OBJ(SCHEME_VEC_ELS(v)[1], kernel_modidx) - && SAME_OBJ(provided->keys[i], SCHEME_VEC_ELS(v)[2])) { - /* skip */ - } else { - Scheme_Object *noms; - exs[count] = provided->keys[i]; - exsns[count] = SCHEME_VEC_ELS(v)[2]; - exss[count] = SCHEME_VEC_ELS(v)[1]; - noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]); - exsnoms[count] = noms; - exps[count] = protected; - count++; - } + Scheme_Object *noms; + exs[count] = provided->keys[i]; + exsns[count] = SCHEME_VEC_ELS(v)[2]; + exss[count] = SCHEME_VEC_ELS(v)[1]; + noms = adjust_for_rename(exs[count], SCHEME_VEC_ELS(v)[4], SCHEME_VEC_ELS(v)[0]); + exsnoms[count] = noms; + exps[count] = protected; + if (SCHEME_TRUEP(SCHEME_VEC_ELS(v)[9])) + exinsps[count] = SCHEME_VEC_ELS(v)[9]; + count++; } } } @@ -7538,17 +7554,16 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table exsnoms = NULL; } - /* Sort provide array for variables: interned followed by - uninterned, alphabetical within each. This is important for - having a consistent provide arrays. */ - qsort_provides(exs, exsns, exss, exps, exets, exsnoms, 0, exvcount, 1); + /* Discard exinsps if there are no inspectors */ + for (i = 0; i < excount; i++) { + if (exinsps[i]) + break; + } + if (i >= excount) { + exinsps = NULL; + } - pt->num_provides = excount; - pt->num_var_provides = exvcount; - pt->provides = exs; - pt->provide_src_names = exsns; - pt->provide_srcs = exss; - pt->provide_nominal_srcs = exsnoms; + /* Discard exets if all 0 */ if (exets) { for (i = 0; i < excount; i++) { if (exets[i]) @@ -7557,6 +7572,19 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table if (i >= excount) exets = NULL; } + + /* Sort provide array for variables: interned followed by + uninterned, alphabetical within each. This is important for + having a consistent provide arrays. */ + qsort_provides(exs, exsns, exss, exps, exets, exsnoms, exinsps, 0, exvcount, 1); + + pt->num_provides = excount; + pt->num_var_provides = exvcount; + pt->provides = exs; + pt->provide_src_names = exsns; + pt->provide_srcs = exss; + pt->provide_nominal_srcs = exsnoms; + pt->provide_insps = exinsps; pt->provide_src_phases = exets; if (SAME_OBJ(phase, scheme_make_integer(0))) @@ -7574,11 +7602,11 @@ char *compute_provide_arrays(Scheme_Hash_Table *all_provided, Scheme_Hash_Table /* Helper: */ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Object **exss, char *exps, char *exets, - Scheme_Object **exsnoms, + Scheme_Object **exsnoms, Scheme_Object **exinsps, int start, int count, int do_uninterned) { int i, j; - Scheme_Object *tmp_ex, *tmp_exsn, *tmp_exs, *tmp_exsnom, *pivot; + Scheme_Object *tmp_ex, *tmp_exsn, *tmp_exs, *tmp_exsnom, *tmp_exinsp, *pivot; char tmp_exp, tmp_exet; if (do_uninterned) { @@ -7620,6 +7648,13 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob exsnoms[j] = tmp_exsnom; } + if (exinsps) { + tmp_exinsp = exinsps[i]; + + exinsps[i] = exinsps[j]; + + exinsps[j] = tmp_exinsp; + } j--; /* Skip over uninterns already at the end: */ @@ -7633,8 +7668,8 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob } /* Sort interned and uninterned separately: */ - qsort_provides(exs, exsns, exss, exps, exets, exsnoms, 0, j + 1, 0); - qsort_provides(exs, exsns, exss, exps, exets, exsnoms, j + 1, count - j - 1, 0); + qsort_provides(exs, exsns, exss, exps, exets, exsnoms, exinsps, 0, j + 1, 0); + qsort_provides(exs, exsns, exss, exps, exets, exsnoms, exinsps, j + 1, count - j - 1, 0); } else { j = start; while (count > 1) { @@ -7666,7 +7701,6 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob exets[k] = exets[j]; exets[j] = tmp_exet; } - if (exsnoms) { tmp_exsnom = exsnoms[k]; @@ -7674,6 +7708,13 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob exsnoms[j] = tmp_exsnom; } + if (exinsps) { + tmp_exinsp = exinsps[k]; + + exinsps[k] = exinsps[j]; + + exinsps[j] = tmp_exinsp; + } j++; } @@ -7687,8 +7728,8 @@ static void qsort_provides(Scheme_Object **exs, Scheme_Object **exsns, Scheme_Ob } if (count > 1) { - qsort_provides(exs, exsns, exss, exps, exets, exsnoms, start, j - start, 0); - qsort_provides(exs, exsns, exss, exps, exets, exsnoms, j, count - (j - start), 0); + qsort_provides(exs, exsns, exss, exps, exets, exsnoms, exinsps, start, j - start, 0); + qsort_provides(exs, exsns, exss, exps, exets, exsnoms, exinsps, j, count - (j - start), 0); } } } @@ -8255,9 +8296,9 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ { int j, var_count; Scheme_Object *orig_idx = idx, *to_phase; - Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null; + Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null, **exinsps; char *exets; - int is_kern, has_context, save_marshal_info = 0; + int has_context, save_marshal_info = 0; Scheme_Object *nominal_modidx, *one_exn, *prnt_iname, *name, *rn, *ename = orig_ename; Scheme_Hash_Table *orig_onlys; int k, skip_rename, do_copy_vars; @@ -8316,14 +8357,6 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ to_phase = NULL; if (pt) { - is_kern = (SAME_OBJ(idx, kernel_modidx) - && !exns - && !onlys - && !prefix - && !iname - && !unpack_kern - && !has_context); - one_exn = NULL; nominal_modidx = idx; @@ -8344,7 +8377,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ && !exns && !prefix && !orig_ename - && (pt->num_provides || pt->reprovide_kernel) + && pt->num_provides && !do_copy_vars) { /* Simple "import everything" whose mappings can be shared via the exporting module: */ if (!pt->src_modidx) @@ -8354,150 +8387,134 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ } else skip_rename = 0; - while (1) { /* loop to handle kernel re-provides... */ - int break_if_iname_null = !!iname; - - exs = pt->provides; - exsns = pt->provide_src_names; - exss = pt->provide_srcs; - exets = pt->provide_src_phases; - var_count = pt->num_var_provides; - - for (j = pt->num_provides; j--; ) { - Scheme_Object *modidx; - - if (orig_ename) { - if (!SAME_OBJ(SCHEME_STX_VAL(orig_ename), exs[j])) - continue; /* we don't want this one. */ - } else if (onlys) { - name = scheme_hash_get(orig_onlys, exs[j]); - if (!name) - continue; /* we don't want this one. */ - mark_src = name; - { - Scheme_Object *l; - l = scheme_stx_extract_marks(mark_src); - has_context = !SCHEME_NULLP(l); - } - /* Remove to indicate that it's been imported: */ - scheme_hash_set(onlys, exs[j], NULL); - } else { - if (exns) { - Scheme_Object *l, *a; - for (l = exns; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { - a = SCHEME_STX_CAR(l); - if (SCHEME_STXP(a)) - a = SCHEME_STX_VAL(a); - if (SAME_OBJ(a, exs[j])) - break; - } - if (!SCHEME_STX_NULLP(l)) - continue; /* we don't want this one. */ - } - - if (one_exn) { - if (SAME_OBJ(one_exn, exs[j])) - continue; /* we don't want this one. */ - } - } - - modidx = ((exss && !SCHEME_FALSEP(exss[j])) - ? scheme_modidx_shift(exss[j], me->src_modidx, idx) - : idx); + exs = pt->provides; + exsns = pt->provide_src_names; + exss = pt->provide_srcs; + exets = pt->provide_src_phases; + exinsps = pt->provide_insps; + var_count = pt->num_var_provides; - if (!iname) - iname = exs[j]; - - if (SCHEME_SYM_WEIRDP(iname)) { - /* This shouldn't happen. In case it does, don't import a - gensym or parallel symbol. The former is useless. The - latter is supposed to be module-specific, and it could - collide with local module-specific ids. */ - iname = NULL; - continue; - } - - if (prefix) - iname = scheme_symbol_append(prefix, iname); - - prnt_iname = iname; - if (has_context) { - /* The `require' expression has a set of marks in its - context, which means that we need to generate a name. */ - iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0); - iname = scheme_tl_id_sym(orig_env, iname, scheme_false, skip_rename ? 3 : 2, to_phase, NULL); - if (all_simple) - *all_simple = 0; - } - - if (ck) - ck(prnt_iname, iname, nominal_modidx, exs[j], modidx, exsns[j], exets ? exets[j] : 0, - (j < var_count), - data, cki, form, err_src, mark_src, to_phase, src_phase_index, pt->phase_index); - - if (!is_kern) { - int done; - - if (do_copy_vars && (j < var_count)) { - Scheme_Env *menv; - Scheme_Object *val, *modname; - Scheme_Bucket *b; - modname = scheme_module_resolve(modidx, 1); - menv = scheme_module_access(modname, orig_env, 0); - val = scheme_lookup_in_table(menv->toplevel, (char *)exsns[j]); - b = scheme_global_bucket(iname, orig_env); - scheme_set_global_bucket(((copy_vars == 2) - ? "namespace-require/constant" - : "namespace-require/copy"), - b, val, 1); - if (copy_vars == 2) { - ((Scheme_Bucket_With_Flags *)b)->flags |= GLOB_IS_IMMUTATED; - done = 0; - } else { - scheme_shadow(orig_env, iname, 1); - done = 1; - } - } else - done = 0; - - if (done) { - } else if (!for_unmarshal || !has_context) { - if (!skip_rename) { - if (!save_marshal_info && !has_context && can_save_marshal) - save_marshal_info = 1; - - scheme_extend_module_rename(rn, - modidx, iname, exsns[j], nominal_modidx, exs[j], - exets ? exets[j] : 0, - src_phase_index, - pt->phase_index, - (for_unmarshal || (!has_context && can_save_marshal)) ? 1 : 0); - } - } - } - - iname = NULL; + for (j = pt->num_provides; j--; ) { + Scheme_Object *modidx; - if (ename) { - ename = NULL; - break; + if (orig_ename) { + if (!SAME_OBJ(SCHEME_STX_VAL(orig_ename), exs[j])) + continue; /* we don't want this one. */ + } else if (onlys) { + name = scheme_hash_get(orig_onlys, exs[j]); + if (!name) + continue; /* we don't want this one. */ + mark_src = name; + { + Scheme_Object *l; + l = scheme_stx_extract_marks(mark_src); + has_context = !SCHEME_NULLP(l); + } + /* Remove to indicate that it's been imported: */ + scheme_hash_set(onlys, exs[j], NULL); + } else { + if (exns) { + Scheme_Object *l, *a; + for (l = exns; SCHEME_STX_PAIRP(l); l = SCHEME_STX_CDR(l)) { + a = SCHEME_STX_CAR(l); + if (SCHEME_STXP(a)) + a = SCHEME_STX_VAL(a); + if (SAME_OBJ(a, exs[j])) + break; + } + if (!SCHEME_STX_NULLP(l)) + continue; /* we don't want this one. */ + } + + if (one_exn) { + if (SAME_OBJ(one_exn, exs[j])) + continue; /* we don't want this one. */ + } + } + + modidx = ((exss && !SCHEME_FALSEP(exss[j])) + ? scheme_modidx_shift(exss[j], me->src_modidx, idx) + : idx); + + if (!iname) + iname = exs[j]; + + if (SCHEME_SYM_WEIRDP(iname)) { + /* This shouldn't happen. In case it does, don't import a + gensym or parallel symbol. The former is useless. The + latter is supposed to be module-specific, and it could + collide with local module-specific ids. */ + iname = NULL; + continue; + } + + if (prefix) + iname = scheme_symbol_append(prefix, iname); + + prnt_iname = iname; + if (has_context) { + /* The `require' expression has a set of marks in its + context, which means that we need to generate a name. */ + iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0); + iname = scheme_tl_id_sym(orig_env, iname, scheme_false, skip_rename ? 3 : 2, to_phase, NULL); + if (all_simple) + *all_simple = 0; + } + + if (ck) + ck(prnt_iname, iname, nominal_modidx, exs[j], modidx, exsns[j], exets ? exets[j] : 0, + (j < var_count), + data, cki, form, err_src, mark_src, to_phase, src_phase_index, pt->phase_index, + exinsps ? exinsps[j] : scheme_false); + + { + int done; + + if (do_copy_vars && (j < var_count)) { + Scheme_Env *menv; + Scheme_Object *val, *modname; + Scheme_Bucket *b; + modname = scheme_module_resolve(modidx, 1); + menv = scheme_module_access(modname, orig_env, 0); + val = scheme_lookup_in_table(menv->toplevel, (char *)exsns[j]); + b = scheme_global_bucket(iname, orig_env); + scheme_set_global_bucket(((copy_vars == 2) + ? "namespace-require/constant" + : "namespace-require/copy"), + b, val, 1); + if (copy_vars == 2) { + ((Scheme_Bucket_With_Flags *)b)->flags |= GLOB_IS_IMMUTATED; + done = 0; + } else { + scheme_shadow(orig_env, iname, 1); + done = 1; + } + } else + done = 0; + + if (done) { + } else if (!for_unmarshal || !has_context) { + if (!skip_rename) { + if (!save_marshal_info && !has_context && can_save_marshal) + save_marshal_info = 1; + + scheme_extend_module_rename(rn, + modidx, iname, exsns[j], nominal_modidx, exs[j], + exets ? exets[j] : 0, + src_phase_index, + pt->phase_index, + exinsps ? exinsps[j] : NULL, + (for_unmarshal || (!has_context && can_save_marshal)) ? 1 : 0); + } } } - if (is_kern && !skip_rename) - scheme_extend_module_rename_with_kernel(rn, nominal_modidx); - - if (break_if_iname_null && !iname) - break; - - if (pt->reprovide_kernel) { - idx = kernel_modidx; - one_exn = pt->kernel_exclusion; - me = kernel->me; - pt = kernel->me->rt; - is_kern = !prefix && !unpack_kern && !ename && !has_context && !onlys; - } else + iname = NULL; + + if (ename) { + ename = NULL; break; + } } if (save_marshal_info) { @@ -9028,7 +9045,7 @@ static void check_dup_require(Scheme_Object *prnt_name, Scheme_Object *name, int isval, void *ht, Scheme_Object *e, Scheme_Object *form, Scheme_Object *err_src, Scheme_Object *mark_src, Scheme_Object *to_phase, Scheme_Object *src_phase_index, - Scheme_Object *nominal_export_phase) + Scheme_Object *nominal_export_phase, Scheme_Object *in_insp) { Scheme_Object *i; @@ -9328,6 +9345,20 @@ static Scheme_Object *write_module(Scheme_Object *obj) v = scheme_false; l = cons(v, l); + if (pt->provide_insps) { + v = scheme_make_vector(count, scheme_false); + for (i = 0; i < count; i++) { + if (pt->provide_insps[i]) { + if (SCHEME_PAIRP(pt->provide_insps[i])) + SCHEME_VEC_ELS(v)[i] = scheme_void; + else + SCHEME_VEC_ELS(v)[i] = scheme_true; + } + } + } else + v = scheme_false; + l = cons(v, l); + l = cons(pt->phase_index, l); cnt++; } @@ -9393,9 +9424,6 @@ static Scheme_Object *write_module(Scheme_Object *obj) } l = cons(v, l); - l = cons(m->me->rt->reprovide_kernel ? scheme_true : scheme_false, l); - l = cons(m->me->rt->kernel_exclusion, l); - l = cons((Scheme_Object *)m->prefix, l); l = cons(m->dummy, l); @@ -9439,8 +9467,8 @@ static int check_requires_ok(Scheme_Object *l) static Scheme_Object *read_module(Scheme_Object *obj) { Scheme_Module *m; - Scheme_Object *ie, *nie; - Scheme_Object *eesp, *esp, *esn, *esph, *es, *esnom, *e, *nve, *ne, **v; + Scheme_Object *ie, *nie, *insp; + Scheme_Object *eesp, *esp, *esn, *esph, *es, *esnom, *einsp, *e, *nve, *ne, **v; Scheme_Module_Exports *me; Scheme_Module_Phase_Exports *pt; char *ps, *sps; @@ -9501,13 +9529,6 @@ static Scheme_Object *read_module(Scheme_Object *obj) m->prefix = (Resolve_Prefix *)SCHEME_CAR(obj); obj = SCHEME_CDR(obj); - if (!SCHEME_PAIRP(obj)) return_NULL(); - me->rt->kernel_exclusion = SCHEME_CAR(obj); - obj = SCHEME_CDR(obj); - if (!SCHEME_PAIRP(obj)) return_NULL(); - me->rt->reprovide_kernel = SCHEME_TRUEP(SCHEME_CAR(obj)); - obj = SCHEME_CDR(obj); - if (!SCHEME_PAIRP(obj)) return_NULL(); ie = SCHEME_CAR(obj); obj = SCHEME_CDR(obj); @@ -9604,6 +9625,10 @@ static Scheme_Object *read_module(Scheme_Object *obj) scheme_hash_set(me->other_phases, phase, (Scheme_Object *)pt); } + if (!SCHEME_PAIRP(obj)) return_NULL(); + einsp = SCHEME_CAR(obj); + obj = SCHEME_CDR(obj); + if (!SCHEME_PAIRP(obj)) return_NULL(); esph = SCHEME_CAR(obj); obj = SCHEME_CDR(obj); @@ -9678,6 +9703,24 @@ static Scheme_Object *read_module(Scheme_Object *obj) } } pt->provide_src_phases = sps; + + if (SCHEME_FALSEP(einsp)) { + pt->provide_insps = NULL; + } else { + if (!SCHEME_VECTORP(einsp) || (SCHEME_VEC_SIZE(einsp) != count)) return_NULL(); + insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); + v = MALLOC_N(Scheme_Object *, count); + for (i = 0; i < count; i++) { + if (SCHEME_TRUEP(SCHEME_VEC_ELS(einsp)[i])) { + if (SCHEME_VOIDP(SCHEME_VEC_ELS(einsp)[i])) { + e = cons(scheme_false, insp); + v[i] = e; + } else + v[i] = insp; + } + } + pt->provide_insps = v; + } } count = me->rt->num_provides; diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 277bcb6bda..80985c8c22 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -2465,6 +2465,7 @@ static int module_phase_exports_val_MARK(void *p) { gcMARK(m->provide_src_names); gcMARK(m->provide_nominal_srcs); gcMARK(m->provide_src_phases); + gcMARK(m->provide_insps); gcMARK(m->kernel_exclusion); gcMARK(m->kernel_exclusion2); @@ -2487,6 +2488,7 @@ static int module_phase_exports_val_FIXUP(void *p) { gcFIXUP(m->provide_src_names); gcFIXUP(m->provide_nominal_srcs); gcFIXUP(m->provide_src_phases); + gcFIXUP(m->provide_insps); gcFIXUP(m->kernel_exclusion); gcFIXUP(m->kernel_exclusion2); @@ -5043,7 +5045,6 @@ static int mark_rename_table_MARK(void *p) { gcMARK(rn->nomarshal_ht); gcMARK(rn->unmarshal_info); gcMARK(rn->shared_pes); - gcMARK(rn->plus_kernel_nominal_source); gcMARK(rn->set_identity); gcMARK(rn->marked_names); gcMARK(rn->free_id_renames); @@ -5058,7 +5059,6 @@ static int mark_rename_table_FIXUP(void *p) { gcFIXUP(rn->nomarshal_ht); gcFIXUP(rn->unmarshal_info); gcFIXUP(rn->shared_pes); - gcFIXUP(rn->plus_kernel_nominal_source); gcFIXUP(rn->set_identity); gcFIXUP(rn->marked_names); gcFIXUP(rn->free_id_renames); @@ -5216,6 +5216,40 @@ static int lex_rib_FIXUP(void *p) { #define lex_rib_IS_CONST_SIZE 1 +static int mark_free_id_info_SIZE(void *p) { + return + gcBYTES_TO_WORDS((sizeof(Scheme_Vector) + + ((8 - 1) * sizeof(Scheme_Object *)))); +} + +static int mark_free_id_info_MARK(void *p) { + Scheme_Vector *vec = (Scheme_Vector *)p; + int i; + for (i = 8; i--; ) + gcMARK(vec->els[i]); + + return + gcBYTES_TO_WORDS((sizeof(Scheme_Vector) + + ((8 - 1) * sizeof(Scheme_Object *)))); +} + +static int mark_free_id_info_FIXUP(void *p) { + Scheme_Vector *vec = (Scheme_Vector *)p; + int i; + for (i = 8; i--; ) + gcFIXUP(vec->els[i]); + + return + gcBYTES_TO_WORDS((sizeof(Scheme_Vector) + + ((8 - 1) * sizeof(Scheme_Object *)))); +} + +#define mark_free_id_info_IS_ATOMIC 0 +#define mark_free_id_info_IS_CONST_SIZE 0 + + + + #endif /* STXOBJ */ /**********************************************************************/ diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index d19fb7c89c..a93a9e4384 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -990,6 +990,7 @@ module_phase_exports_val { gcMARK(m->provide_src_names); gcMARK(m->provide_nominal_srcs); gcMARK(m->provide_src_phases); + gcMARK(m->provide_insps); gcMARK(m->kernel_exclusion); gcMARK(m->kernel_exclusion2); @@ -2070,7 +2071,6 @@ mark_rename_table { gcMARK(rn->nomarshal_ht); gcMARK(rn->unmarshal_info); gcMARK(rn->shared_pes); - gcMARK(rn->plus_kernel_nominal_source); gcMARK(rn->set_identity); gcMARK(rn->marked_names); gcMARK(rn->free_id_renames); @@ -2133,6 +2133,20 @@ lex_rib { gcBYTES_TO_WORDS(sizeof(Scheme_Lexical_Rib)); } +mark_free_id_info { + mark: + Scheme_Vector *vec = (Scheme_Vector *)p; + int i; + for (i = 8; i--; ) + gcMARK(vec->els[i]); + + size: + gcBYTES_TO_WORDS((sizeof(Scheme_Vector) + + ((8 - 1) * sizeof(Scheme_Object *)))); +} + + + END stxobj; /**********************************************************************/ diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index fd3e59f66a..385e3f4e9d 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -779,14 +779,14 @@ Scheme_Object* scheme_extend_module_rename(Scheme_Object *rn, Scheme_Object *mod Scheme_Object *locname, Scheme_Object *exname, Scheme_Object *nominal_src, Scheme_Object *nominal_ex, int mod_phase, Scheme_Object *src_phase_index, - Scheme_Object *nom_export_phase, int drop_for_marshal); + Scheme_Object *nom_export_phase, Scheme_Object *insp, + int mode); void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *modidx, struct Scheme_Module_Phase_Exports *pt, Scheme_Object *unmarshal_phase_index, Scheme_Object *src_phase_index, Scheme_Object *marks, int save_unmarshal); -void scheme_extend_module_rename_with_kernel(Scheme_Object *rn, Scheme_Object *nominal_src); void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info); void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, Scheme_Object *modidx_shift_from, Scheme_Object *modidx_shift_to, @@ -817,7 +817,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *recur, Scheme_Object **src_phase_index, Scheme_Object **nominal_src_phase, Scheme_Object **lex_env, - int *_sealed); + int *_sealed, + Scheme_Object **rename_insp); Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a); int scheme_stx_parallel_is_used(Scheme_Object *sym, Scheme_Object *stx); @@ -2653,10 +2654,10 @@ typedef struct Scheme_Module_Phase_Exports Scheme_Object **provide_src_names; /* symbols (original internal names) */ Scheme_Object **provide_nominal_srcs; /* import source if re-exported; NULL or array of lists */ char *provide_src_phases; /* NULL, or src phase for for-syntax import */ + Scheme_Object **provide_insps; /* inspectors for re-provided protected/unexported */ int num_provides; int num_var_provides; /* non-syntax listed first in provides */ - int reprovide_kernel; /* if true, extend provides with kernel's */ Scheme_Object *kernel_exclusion; /* we allow up to two exns, but they must be shadowed */ Scheme_Object *kernel_exclusion2; @@ -2729,9 +2730,11 @@ int scheme_module_export_position(Scheme_Object *modname, Scheme_Env *env, Schem Scheme_Object *scheme_check_accessible_in_module(Scheme_Env *env, Scheme_Object *prot_insp, Scheme_Object *in_modidx, Scheme_Object *symbol, Scheme_Object *stx, - Scheme_Object *certs, Scheme_Object *unexp_insp, + Scheme_Object *certs, Scheme_Object *unexp_insp, + Scheme_Object *rename_insp, int position, int want_pos, - int *_protected, Scheme_Env *from_env); + int *_protected, int *_unexported, + Scheme_Env *from_env, int *_would_complain); Scheme_Object *scheme_module_syntax(Scheme_Object *modname, Scheme_Env *env, Scheme_Object *name); Scheme_Object *scheme_modidx_shift(Scheme_Object *modidx, diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index a58c15b25f..3f88efcb15 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.1.5.4" +#define MZSCHEME_VERSION "4.1.5.5" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Z 5 -#define MZSCHEME_VERSION_W 4 +#define MZSCHEME_VERSION_W 5 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 942b31cfb9..0046a1e5f0 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -71,6 +71,9 @@ static Scheme_Object *syntax_recertify(int argc, Scheme_Object **argv); static Scheme_Object *lift_inactive_certs(Scheme_Object *o, int as_active); +static Scheme_Object *write_free_id_info_prefix(Scheme_Object *obj); +static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj); + static Scheme_Object *source_symbol; /* uninterned! */ static Scheme_Object *share_symbol; /* uninterned! */ static Scheme_Object *origin_symbol; @@ -130,16 +133,16 @@ XFORM_NONGCING static int prefab_p(Scheme_Object *o) typedef struct Module_Renames { Scheme_Object so; /* scheme_rename_table_type */ - char plus_kernel, kind, needs_unmarshal; + char kind, needs_unmarshal; char sealed; /* 1 means bound won't change; 2 means unbound won't change, either */ Scheme_Object *phase; - Scheme_Object *plus_kernel_nominal_source; Scheme_Object *set_identity; Scheme_Hash_Table *ht; /* localname -> modidx OR (cons modidx exportname) OR (cons modidx nominal_modidx) OR (list* modidx exportname nominal_modidx_plus_phase nominal_exportname) OR - (list* modidx mod-phase exportname nominal_modidx_plus_phase nominal_exportname) + (list* modidx mod-phase exportname nominal_modidx_plus_phase nominal_exportname) OR + (cons insp localname) nominal_modix_plus_phase -> nominal_modix | (cons nominal_modix import_phase_plus_nominal_phase) import_phase_plus_nominal_phase -> import-phase-index | (cons import-phase-index nom-phase) */ Scheme_Hash_Table *nomarshal_ht; /* like ht, but dropped on marshal */ @@ -218,6 +221,14 @@ static Module_Renames *krn; #define SCHEME_MODIDXP(obj) (SAME_TYPE(SCHEME_TYPE(obj), scheme_module_index_type)) +static int is_rename_inspector_info(Scheme_Object *v) +{ + return (SAME_TYPE(SCHEME_TYPE(v), scheme_inspector_type) + || (SCHEME_PAIRP(v) + && SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(v)), scheme_inspector_type) + && SAME_TYPE(SCHEME_TYPE(SCHEME_CDR(v)), scheme_inspector_type))); +} + /* Wraps: A wrap is a list of wrap-elems and wrap-chunks. A wrap-chunk is a @@ -242,11 +253,11 @@ static Module_Renames *krn; (cons (cons )) => free-id=? renaming to on match - A wrap-elem (vector ... ...) is also a lexical rename - var resolved: sym or (cons ), - where is module/lexical binding info: - (cons #f) => top-level binding - (cons ) => lexical binding - (vector ...) => module-binding + bool var resolved: sym or (cons ), + where is module/lexical binding info: + (cons #f) => top-level binding + (cons ) => lexical binding + (free-eq-info ...) => module-binding where the variables have already been resolved and filtered (no mark or lexical-env comparison needed with the remaining wraps) @@ -586,6 +597,9 @@ void scheme_init_stx(Scheme_Env *env) SCHEME_SET_IMMUTABLE(no_nested_inactive_certs); REGISTER_SO(unsealed_dependencies); + + scheme_install_type_writer(scheme_free_id_info_type, write_free_id_info_prefix); + scheme_install_type_reader(scheme_free_id_info_type, read_free_id_info_prefix); } /*========================================================================*/ @@ -1355,15 +1369,6 @@ static void check_not_sealed(Module_Renames *mrn) scheme_signal_error("internal error: attempt to change sealed module rename"); } -void scheme_extend_module_rename_with_kernel(Scheme_Object *mrn, Scheme_Object *nominal_mod) -{ - /* Don't use on a non-module namespace, where renames may need - to be removed... */ - check_not_sealed((Module_Renames *)mrn); - ((Module_Renames *)mrn)->plus_kernel = 1; - ((Module_Renames *)mrn)->plus_kernel_nominal_source = nominal_mod; -} - static Scheme_Object *phase_to_index(Scheme_Object *phase) { return phase; @@ -1378,6 +1383,7 @@ Scheme_Object *scheme_extend_module_rename(Scheme_Object *mrn, int mod_phase, /* phase of source defn */ Scheme_Object *src_phase_index, /* nominal import phase */ Scheme_Object *nom_phase, /* nominal export phase */ + Scheme_Object *insp, /* inspector for re-export */ int mode) /* 1 => can be reconstructed from unmarshal info 2 => free-id=? renaming 3 => return info */ @@ -1432,6 +1438,9 @@ Scheme_Object *scheme_extend_module_rename(Scheme_Object *mrn, elem = CONS(scheme_make_integer(mod_phase), elem); elem = CONS(modname, elem); } + + if (insp) + elem = CONS(insp, elem); if (mode == 1) { if (!((Module_Renames *)mrn)->nomarshal_ht) { @@ -1500,11 +1509,6 @@ static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest, check_not_sealed((Module_Renames *)dest); - if (((Module_Renames *)src)->plus_kernel) { - ((Module_Renames *)dest)->plus_kernel = 1; - ((Module_Renames *)dest)->plus_kernel_nominal_source = ((Module_Renames *)src)->plus_kernel_nominal_source; - } - if (do_pes) { if (!SCHEME_NULLP(((Module_Renames *)src)->shared_pes)) { Scheme_Object *first = NULL, *last = NULL, *pr, *l; @@ -1562,6 +1566,14 @@ static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest, if (hts->vals[i]) { v = hts->vals[i]; if (old_midx) { + Scheme_Object *insp = NULL; + + if (SCHEME_PAIRP(v) && is_rename_inspector_info(SCHEME_CAR(v))) { + insp = SCHEME_CAR(v); + v = SCHEME_CDR(v); + } else + insp = NULL; + /* Shift the modidx part */ if (SCHEME_PAIRP(v)) { if (SCHEME_PAIRP(SCHEME_CDR(v))) { @@ -1600,6 +1612,9 @@ static void do_append_module_rename(Scheme_Object *src, Scheme_Object *dest, /* modidx */ v = scheme_modidx_shift(v, old_midx, new_midx); } + + if (insp) + v = CONS(insp, v); } scheme_hash_set(ht, hts->keys[i], v); if (drop_ht) @@ -1701,12 +1716,6 @@ void scheme_list_module_rename(Scheme_Object *set, Scheme_Hash_Table *ht) for (i = pt->num_provides; i--; ) { scheme_hash_set(ht, pt->provides[i], scheme_false); } - if (pt->reprovide_kernel) - scheme_list_module_rename((Scheme_Object *)krn, ht); - } - - if (src->plus_kernel) { - scheme_list_module_rename((Scheme_Object *)krn, ht); } } @@ -1965,6 +1974,7 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn, Scheme_Object *src_phase_index; Scheme_Object *nominal_src_phase; Scheme_Object *lex_env; + Scheme_Object *rename_insp; if (scheme_hash_get(free_id_recur, id)) { return id; @@ -1980,7 +1990,8 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn, &src_phase_index, &nominal_src_phase, &lex_env, - _sealed); + _sealed, + &rename_insp); if (SCHEME_SYMBOLP(nom2)) nominal_name = nom2; @@ -1999,6 +2010,7 @@ static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn, SCHEME_INT_VAL(mod_phase), /* phase of source defn */ src_phase_index, /* nominal import phase */ nominal_src_phase, /* nominal export phase */ + rename_insp, 3); if (*_sealed) { @@ -3710,7 +3722,7 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, Scheme_Object *pr, *idx, *pos, *src, *best_match = NULL; Scheme_Module_Phase_Exports *pt; Scheme_Hash_Table *ht; - int i, phase, best_match_len = -1, skip; + int i, phase, best_match_len = -1, skip = 0; Scheme_Object *marks_cache = NULL; for (pr = shared_pes; !SCHEME_NULLP(pr); pr = SCHEME_CDR(pr)) { @@ -3771,6 +3783,7 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, if (SCHEME_PAIRP(get_names[4])) /* skip over marks, if any */ get_names[4] = SCHEME_CDR(get_names[4]); get_names[5] = pt->phase_index; + get_names[6] = (pt->provide_insps ? pt->provide_insps[i] : NULL); } if (SCHEME_FALSEP(src)) { @@ -3782,34 +3795,6 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, best_match = src; } } - } else if (pt->reprovide_kernel) { - Scheme_Object *kpr; - kpr = scheme_hash_get(krn->ht, glob_id); - if (kpr) { - /* Found it, maybe. Check marks. */ - int mark_len, skip; - mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, depth, &skip); - if (mark_len > best_match_len) { - /* Marks match and improve on previously found match. Build suitable rename: */ - best_match_len = mark_len; - if (_skipped) *_skipped = skip; - - if (get_orig_name) - best_match = glob_id; - else { - if (get_names) { - idx = SCHEME_CAR(SCHEME_CAR(kpr)); - get_names[0] = glob_id; - get_names[1] = idx; - get_names[2] = glob_id; - get_names[3] = scheme_make_integer(0); - get_names[4] = pt->phase_index; - get_names[5] = scheme_make_integer(0); - } - best_match = scheme_get_kernel_modidx(); - } - } - } } } @@ -3973,7 +3958,9 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, get_names[1] is set to the nominal source module, get_names[2] is set to the nominal source module's export, get_names[3] is set to the phase of the source definition, and get_names[4] is set to the nominal import phase index, - and get_names[5] is set to the nominal export phase. + and get_names[5] is set to the nominal export phase; get_names[6] is set to + an inspector/pair if one applies for a re-export of a protected or unexported, NULL or + #f otherwise. If lexically bound, result is env id, and a get_names[0] is set to scheme_undefined; get_names[1] is set if a free-id=? rename provides a different name for the bindig. If neither, result is #f and get_names[0] is either unchanged or NULL; get_names[1] @@ -3981,7 +3968,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, { WRAP_POS wraps; Scheme_Object *o_rename_stack = scheme_null, *recur_skip_ribs = skip_ribs; - Scheme_Object *mresult = scheme_false; + Scheme_Object *mresult = scheme_false, *mresult_insp; Scheme_Object *modidx_shift_to = NULL, *modidx_shift_from = NULL; Scheme_Object *rename_stack[QUICK_STACK_SIZE]; int stack_pos = 0, no_lexical = 0; @@ -4080,7 +4067,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, result = SCHEME_CDR(result_free_rename); if (get_names) get_names[0] = scheme_undefined; - } else if (SCHEME_VECTORP(result_free_rename)) { + } else if (SAME_OBJ(SCHEME_TYPE(result_free_rename), scheme_free_id_info_type)) { result = SCHEME_VEC_ELS(result_free_rename)[0]; if (get_names) { get_names[0] = SCHEME_VEC_ELS(result_free_rename)[1]; @@ -4089,6 +4076,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, get_names[3] = SCHEME_VEC_ELS(result_free_rename)[4]; get_names[4] = SCHEME_VEC_ELS(result_free_rename)[5]; get_names[5] = SCHEME_VEC_ELS(result_free_rename)[6]; + get_names[6] = SCHEME_VEC_ELS(result_free_rename)[7]; } } else { if (get_names) @@ -4203,10 +4191,6 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, rename = scheme_hash_get(mrn->ht, glob_id); if (!rename && mrn->nomarshal_ht) rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); - if (!rename && mrn->plus_kernel) { - rename = scheme_hash_get(krn->ht, glob_id); - nominal = mrn->plus_kernel_nominal_source; - } get_names_done = 0; if (!rename) { EXPLAIN(fprintf(stderr, "%d in pes\n", depth)); @@ -4231,6 +4215,8 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, /* match; set mresult, which is used in the case of no lexical capture: */ mresult_skipped = skipped; + + mresult_insp = NULL; if (SCHEME_BOXP(rename)) { /* This should only happen for mappings from free_id_renames */ @@ -4244,9 +4230,14 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } mresult = SCHEME_CDR(mresult); } else { - if (SCHEME_PAIRP(rename)) + if (SCHEME_PAIRP(rename)) { mresult = SCHEME_CAR(rename); - else + if (is_rename_inspector_info(mresult)) { + mresult_insp = mresult; + rename = SCHEME_CDR(rename); + mresult = SCHEME_CAR(rename); + } + } else mresult = rename; if (modidx_shift_from) @@ -4314,6 +4305,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, if (!get_names[5]) { get_names[5] = get_names[3]; } + get_names[6] = mresult_insp; } if (modidx_shift_from && !no_shift) { @@ -4686,8 +4678,6 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ rename = scheme_hash_get(mrn->ht, glob_id); if (!rename && mrn->nomarshal_ht) rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); - if (!rename && mrn->plus_kernel) - rename = scheme_hash_get(krn->ht, glob_id); if (!rename) result = search_shared_pes(mrn->shared_pes, glob_id, a, NULL, 1, 0, NULL); @@ -4780,7 +4770,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if (SCHEME_PAIRP(renames)) { /* Has a relevant-looking free-id mapping. Give up on the "fast" traversal. */ - Scheme_Object *modname, *names[6]; + Scheme_Object *modname, *names[7]; int rib_dep; names[0] = NULL; @@ -4788,6 +4778,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ names[3] = scheme_make_integer(0); names[4] = NULL; names[5] = NULL; + names[6] = NULL; modname = resolve_env(NULL, a, orig_phase, 1, names, NULL, NULL, &rib_dep, 0, free_id_recur); if (rib_dep) @@ -4888,7 +4879,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur, Scheme_Object **src_phase_index, /* phase level of import from nominal modidx */ Scheme_Object **nominal_src_phase, /* phase level of export from nominal modidx */ Scheme_Object **lex_env, - int *_sealed) + int *_sealed, + Scheme_Object **insp) /* If module bound, result is module idx, and a is set to source name. If lexically bound, result is scheme_undefined, a is unchanged, and nominal_name is NULL or a free_id=? renamed id. @@ -4904,6 +4896,7 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur, names[3] = scheme_make_integer(0); names[4] = NULL; names[5] = NULL; + names[6] = NULL; modname = resolve_env(NULL, *a, phase, 1, names, NULL, NULL, _sealed ? &rib_dep : NULL, 0, free_id_recur); @@ -4928,6 +4921,8 @@ Scheme_Object *scheme_stx_module_name(Scheme_Hash_Table *free_id_recur, *src_phase_index = names[4]; if (nominal_src_phase) *nominal_src_phase = names[5]; + if (insp) + *insp = names[6]; return modname; } } else { @@ -5427,7 +5422,7 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id) Scheme_Object *src_phase_index; Scheme_Object *nominal_src_phase; Scheme_Object *lex_env = NULL; - Scheme_Object *vec, *phase; + Scheme_Object *vec, *phase, *insp; Scheme_Hash_Table *free_id_recur; phase = SCHEME_CDR(id); @@ -5439,7 +5434,7 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id) bind = scheme_stx_module_name(free_id_recur, &id, phase, &nominal_modidx, &nominal_name, &mod_phase, &src_phase_index, &nominal_src_phase, - &lex_env, NULL); + &lex_env, NULL, &insp); release_recur_table(free_id_recur); if (SCHEME_SYMBOLP(nom2)) @@ -5452,7 +5447,8 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id) else if (SAME_OBJ(bind, scheme_undefined)) return CONS(nominal_name, lex_env); else { - vec = scheme_make_vector(7, NULL); + vec = scheme_make_vector(8, NULL); + vec->type = scheme_free_id_info_type; SCHEME_VEC_ELS(vec)[0] = bind; SCHEME_VEC_ELS(vec)[1] = id; SCHEME_VEC_ELS(vec)[2] = nominal_modidx; @@ -5460,6 +5456,7 @@ static Scheme_Object *extract_free_id_info(Scheme_Object *id) SCHEME_VEC_ELS(vec)[4] = mod_phase; SCHEME_VEC_ELS(vec)[5] = src_phase_index; SCHEME_VEC_ELS(vec)[6] = nominal_src_phase; + SCHEME_VEC_ELS(vec)[7] = (insp ? insp : scheme_false); return vec; } } @@ -6211,7 +6208,15 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, for (i = ht->size, j = 0; i--; ) { if (ht->vals[i]) { SCHEME_VEC_ELS(l)[j++] = ht->keys[i]; - SCHEME_VEC_ELS(l)[j++] = ht->vals[i]; + fil = ht->vals[i]; + if (SCHEME_PAIRP(fil) && is_rename_inspector_info(SCHEME_CAR(fil))) { + /* use 1 or 2 to indicate inspector info */ + if (SCHEME_PAIRP(SCHEME_CAR(fil))) + fil = CONS(scheme_make_integer(2), SCHEME_CDR(fil)); + else + fil = CONS(scheme_make_integer(1), SCHEME_CDR(fil)); + } + SCHEME_VEC_ELS(l)[j++] = fil; } } @@ -6258,10 +6263,6 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, l = CONS(mrn->set_identity, l); l = CONS((mrn->kind == mzMOD_RENAME_MARKED) ? scheme_true : scheme_false, l); l = CONS(mrn->phase, l); - if (mrn->plus_kernel) { - l = CONS(scheme_true,l); - /* FIXME: plus-kernel nominal omitted */ - } local_key = scheme_marshal_lookup(mt, a); if (local_key) @@ -6784,7 +6785,7 @@ static int ok_phase_index(Scheme_Object *o) { static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Table *ht, int lex_ok) { int count, i; - Scheme_Object *key, *p; + Scheme_Object *key, *p0, *p; if (!SCHEME_VECTORP(a)) return_NULL; count = SCHEME_VEC_SIZE(a); @@ -6792,10 +6793,22 @@ static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Tabl for (i = 0; i < count; i+= 2) { key = SCHEME_VEC_ELS(a)[i]; - p = SCHEME_VEC_ELS(a)[i+1]; + p0 = SCHEME_VEC_ELS(a)[i+1]; if (!SCHEME_SYMBOLP(key)) return_NULL; + p = p0; + if (SCHEME_PAIRP(p) && SCHEME_INTP(SCHEME_CAR(p))) { + /* reconstruct inspector info */ + Scheme_Object *insp; + insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); + if (!SAME_OBJ(scheme_make_integer(1), SCHEME_CAR(p))) { + insp = CONS(scheme_make_inspector(insp), insp); + } + p = SCHEME_CDR(p0); + p0 = CONS(insp, p); + } + if (SAME_TYPE(SCHEME_TYPE(p), scheme_module_index_type)) { /* Ok */ } else if (SCHEME_PAIRP(p)) { @@ -6869,7 +6882,7 @@ static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Tabl } else return_NULL; - scheme_hash_set(ht, key, p); + scheme_hash_set(ht, key, p0); } return scheme_true; @@ -6963,9 +6976,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, v = SCHEME_CDR(v); if (!SCHEME_SYMBOLP(v) && !SCHEME_FALSEP(v)) return_NULL; - } else if (SCHEME_VECTORP(v)) { - if (SCHEME_VEC_SIZE(v) != 7) - return_NULL; + } else if (SAME_TYPE(SCHEME_TYPE(v), scheme_free_id_info_type)) { if (!SCHEME_MODIDXP(SCHEME_VEC_ELS(v)[0]) || !SCHEME_SYMBOLP(SCHEME_VEC_ELS(v)[1]) || !SCHEME_MODIDXP(SCHEME_VEC_ELS(v)[2]) @@ -7000,7 +7011,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, Scheme_Object *mns; Module_Renames *mrn; Scheme_Object *p, *key; - int plus_kernel, kind; + int kind; Scheme_Object *phase, *set_identity; if (!SCHEME_PAIRP(a)) return_NULL; @@ -7008,10 +7019,8 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, /* Convert list to rename table: */ if (SAME_OBJ(SCHEME_CAR(a), scheme_true)) { - plus_kernel = 1; - a = SCHEME_CDR(a); - } else - plus_kernel = 0; + scheme_signal_error("leftover plus-kernel"); + } if (!SCHEME_PAIRP(a)) return_NULL; phase = SCHEME_CAR(a); @@ -7031,7 +7040,6 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, a = SCHEME_CDR(a); mrn = (Module_Renames *)scheme_make_module_rename(phase, kind, NULL); - mrn->plus_kernel = plus_kernel; mrn->set_identity = set_identity; if (!SCHEME_PAIRP(a)) return_NULL; @@ -8498,6 +8506,7 @@ static Scheme_Object *do_module_binding(char *name, int argc, Scheme_Object **ar &src_phase_index, &nominal_src_phase, NULL, + NULL, NULL); if (!m) @@ -8771,6 +8780,47 @@ Scheme_Object *scheme_explode_syntax(Scheme_Object *stx, Scheme_Hash_Table *ht) /**********************************************************************/ +static Scheme_Object *write_free_id_info_prefix(Scheme_Object *obj) +{ + Scheme_Object *vec; + int i; + + vec = scheme_make_vector(8, NULL); + for (i = 0; i < 8; i++) { + SCHEME_VEC_ELS(vec)[i] = SCHEME_VEC_ELS(obj)[i]; + } + if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7])) + SCHEME_VEC_ELS(vec)[7] = scheme_true; + + return vec; +} + +static Scheme_Object *read_free_id_info_prefix(Scheme_Object *obj) +{ + Scheme_Object *vec, *insp; + int i; + + if (!SCHEME_VECTORP(obj) + || (SCHEME_VEC_SIZE(obj) != 8)) + return NULL; + + vec = scheme_make_vector(8, NULL); + for (i = 0; i < 8; i++) { + SCHEME_VEC_ELS(vec)[i] = SCHEME_VEC_ELS(obj)[i]; + } + + if (SCHEME_TRUEP(SCHEME_VEC_ELS(vec)[7])) { + insp = scheme_get_param(scheme_current_config(), MZCONFIG_CODE_INSPECTOR); + SCHEME_VEC_ELS(vec)[7] = insp; + } + + vec->type = scheme_free_id_info_type; + + return vec; +} + +/**********************************************************************/ + #ifdef MZ_PRECISE_GC START_XFORM_SKIP; @@ -8786,6 +8836,7 @@ static void register_traversers(void) GC_REG_TRAV(scheme_wrap_chunk_type, mark_wrapchunk); GC_REG_TRAV(scheme_certifications_type, mark_cert); GC_REG_TRAV(scheme_lexical_rib_type, lex_rib); + GC_REG_TRAV(scheme_free_id_info_type, mark_free_id_info); } END_XFORM_SKIP; diff --git a/src/mzscheme/src/stypes.h b/src/mzscheme/src/stypes.h index 047b103b70..1cb9de0bcc 100644 --- a/src/mzscheme/src/stypes.h +++ b/src/mzscheme/src/stypes.h @@ -167,84 +167,85 @@ enum { scheme_module_phase_exports_type, /* 149 */ scheme_logger_type, /* 150 */ scheme_log_reader_type, /* 151 */ + scheme_free_id_info_type, /* 152 */ #ifdef MZTAG_REQUIRED - _scheme_last_normal_type_, /* 152 */ + _scheme_last_normal_type_, /* 153 */ - scheme_rt_weak_array, /* 153 */ + scheme_rt_weak_array, /* 154 */ - scheme_rt_comp_env, /* 154 */ - scheme_rt_constant_binding, /* 155 */ - scheme_rt_resolve_info, /* 156 */ - scheme_rt_optimize_info, /* 157 */ - scheme_rt_compile_info, /* 158 */ - scheme_rt_cont_mark, /* 159 */ - scheme_rt_saved_stack, /* 160 */ - scheme_rt_reply_item, /* 161 */ - scheme_rt_closure_info, /* 162 */ - scheme_rt_overflow, /* 163 */ - scheme_rt_overflow_jmp, /* 164 */ - scheme_rt_meta_cont, /* 165 */ - scheme_rt_dyn_wind_cell, /* 166 */ - scheme_rt_dyn_wind_info, /* 167 */ - scheme_rt_dyn_wind, /* 168 */ - scheme_rt_dup_check, /* 169 */ - scheme_rt_thread_memory, /* 170 */ - scheme_rt_input_file, /* 171 */ - scheme_rt_input_fd, /* 172 */ - scheme_rt_oskit_console_input, /* 173 */ - scheme_rt_tested_input_file, /* 174 */ - scheme_rt_tested_output_file, /* 175 */ - scheme_rt_indexed_string, /* 176 */ - scheme_rt_output_file, /* 177 */ - scheme_rt_load_handler_data, /* 178 */ - scheme_rt_pipe, /* 179 */ - scheme_rt_beos_process, /* 180 */ - scheme_rt_system_child, /* 181 */ - scheme_rt_tcp, /* 182 */ - scheme_rt_write_data, /* 183 */ - scheme_rt_tcp_select_info, /* 184 */ - scheme_rt_namespace_option, /* 185 */ - scheme_rt_param_data, /* 186 */ - scheme_rt_will, /* 187 */ - scheme_rt_struct_proc_info, /* 188 */ - scheme_rt_linker_name, /* 189 */ - scheme_rt_param_map, /* 190 */ - scheme_rt_finalization, /* 191 */ - scheme_rt_finalizations, /* 192 */ - scheme_rt_cpp_object, /* 193 */ - scheme_rt_cpp_array_object, /* 194 */ - scheme_rt_stack_object, /* 195 */ - scheme_rt_preallocated_object, /* 196 */ - scheme_thread_hop_type, /* 197 */ - scheme_rt_srcloc, /* 198 */ - scheme_rt_evt, /* 199 */ - scheme_rt_syncing, /* 200 */ - scheme_rt_comp_prefix, /* 201 */ - scheme_rt_user_input, /* 202 */ - scheme_rt_user_output, /* 203 */ - scheme_rt_compact_port, /* 204 */ - scheme_rt_read_special_dw, /* 205 */ - scheme_rt_regwork, /* 206 */ - scheme_rt_buf_holder, /* 207 */ - scheme_rt_parameterization, /* 208 */ - scheme_rt_print_params, /* 209 */ - scheme_rt_read_params, /* 210 */ - scheme_rt_native_code, /* 211 */ - scheme_rt_native_code_plus_case, /* 212 */ - scheme_rt_jitter_data, /* 213 */ - scheme_rt_module_exports, /* 214 */ - scheme_rt_delay_load_info, /* 215 */ - scheme_rt_marshal_info, /* 216 */ - scheme_rt_unmarshal_info, /* 217 */ - scheme_rt_runstack, /* 218 */ - scheme_rt_sfs_info, /* 219 */ - scheme_rt_validate_clearing, /* 220 */ - scheme_rt_rb_node, /* 221 */ + scheme_rt_comp_env, /* 155 */ + scheme_rt_constant_binding, /* 156 */ + scheme_rt_resolve_info, /* 157 */ + scheme_rt_optimize_info, /* 158 */ + scheme_rt_compile_info, /* 159 */ + scheme_rt_cont_mark, /* 160 */ + scheme_rt_saved_stack, /* 161 */ + scheme_rt_reply_item, /* 162 */ + scheme_rt_closure_info, /* 163 */ + scheme_rt_overflow, /* 164 */ + scheme_rt_overflow_jmp, /* 165 */ + scheme_rt_meta_cont, /* 166 */ + scheme_rt_dyn_wind_cell, /* 167 */ + scheme_rt_dyn_wind_info, /* 168 */ + scheme_rt_dyn_wind, /* 169 */ + scheme_rt_dup_check, /* 170 */ + scheme_rt_thread_memory, /* 171 */ + scheme_rt_input_file, /* 172 */ + scheme_rt_input_fd, /* 173 */ + scheme_rt_oskit_console_input, /* 174 */ + scheme_rt_tested_input_file, /* 175 */ + scheme_rt_tested_output_file, /* 176 */ + scheme_rt_indexed_string, /* 177 */ + scheme_rt_output_file, /* 178 */ + scheme_rt_load_handler_data, /* 179 */ + scheme_rt_pipe, /* 180 */ + scheme_rt_beos_process, /* 181 */ + scheme_rt_system_child, /* 182 */ + scheme_rt_tcp, /* 183 */ + scheme_rt_write_data, /* 184 */ + scheme_rt_tcp_select_info, /* 185 */ + scheme_rt_namespace_option, /* 186 */ + scheme_rt_param_data, /* 187 */ + scheme_rt_will, /* 188 */ + scheme_rt_struct_proc_info, /* 189 */ + scheme_rt_linker_name, /* 190 */ + scheme_rt_param_map, /* 191 */ + scheme_rt_finalization, /* 192 */ + scheme_rt_finalizations, /* 193 */ + scheme_rt_cpp_object, /* 194 */ + scheme_rt_cpp_array_object, /* 195 */ + scheme_rt_stack_object, /* 196 */ + scheme_rt_preallocated_object, /* 197 */ + scheme_thread_hop_type, /* 198 */ + scheme_rt_srcloc, /* 199 */ + scheme_rt_evt, /* 200 */ + scheme_rt_syncing, /* 201 */ + scheme_rt_comp_prefix, /* 202 */ + scheme_rt_user_input, /* 203 */ + scheme_rt_user_output, /* 204 */ + scheme_rt_compact_port, /* 205 */ + scheme_rt_read_special_dw, /* 206 */ + scheme_rt_regwork, /* 207 */ + scheme_rt_buf_holder, /* 208 */ + scheme_rt_parameterization, /* 209 */ + scheme_rt_print_params, /* 210 */ + scheme_rt_read_params, /* 211 */ + scheme_rt_native_code, /* 212 */ + scheme_rt_native_code_plus_case, /* 213 */ + scheme_rt_jitter_data, /* 214 */ + scheme_rt_module_exports, /* 215 */ + scheme_rt_delay_load_info, /* 216 */ + scheme_rt_marshal_info, /* 217 */ + scheme_rt_unmarshal_info, /* 218 */ + scheme_rt_runstack, /* 219 */ + scheme_rt_sfs_info, /* 220 */ + scheme_rt_validate_clearing, /* 221 */ + scheme_rt_rb_node, /* 222 */ #endif - scheme_place_type, /* 222 */ - scheme_engine_type, /* 223 */ + scheme_place_type, /* 223 */ + scheme_engine_type, /* 224 */ _scheme_last_type_ };