(v4.1.5.5) repair interaction of provides redirected by a rename-transformer, certification of access to unexported variables, and protected exports; also get rid of kernel-reprovide special case in export handling, because a more general export-sharing technique subsumed the special case long ago

svn: r14593
This commit is contained in:
Matthew Flatt 2009-04-24 14:59:09 +00:00
parent be1478345e
commit cd09b30497
15 changed files with 1135 additions and 770 deletions

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

File diff suppressed because it is too large Load Diff

View File

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

View File

@ -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;
/**********************************************************************/

View File

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

View File

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

View File

@ -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 <var-resolved> (cons <id> <phase>)) =>
free-id=? renaming to <id> on match
- A wrap-elem (vector <free-id-renames?> <ht> <sym> ... <sym> ...) is also a lexical rename
var resolved: sym or (cons <sym> <bind-info>),
where <bind-info> is module/lexical binding info:
(cons <sym> #f) => top-level binding
(cons <sym> <sym>) => lexical binding
(vector ...) => module-binding
bool var resolved: sym or (cons <sym> <bind-info>),
where <bind-info> is module/lexical binding info:
(cons <sym> #f) => top-level binding
(cons <sym> <sym>) => 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;

View File

@ -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_
};