suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refine lexical scope for syntax objects from different modules

Browse Source 
For example, if definitions have two unmarked `x's that originate
from different modules, make them correspond to different bindings.

This improvement will be used by `scribble/srcdoc', which will
rely on module context to connect `for-doc' requires to documentation
code that appears in the same module --- which is needed, for example,
if a macro expands to documentation code and the macro is used in
a different module.
This commit is contained in:
Matthew Flatt 2012-05-12 00:46:55 -06:00
parent 2f9a0f4b94
commit d836cba7c9
8 changed files with 450 additions and 295 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
collects/tests/racket/stx.rktl
View File

@ -1682,6 +1682,35 @@
(namespace-require ''producer) (namespace-require ''producer)
(eval 10)) (eval 10))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check handling of module context
(module mm-context-m1 racket/base
(require (for-syntax racket/base))
(provide m1)
(define-syntax (m1 stx)
#`(begin
(define #,(syntax-local-introduce #'x) 1)
#,(syntax-local-introduce #'x))))
(module mm-context-m2 racket/base
(require (for-syntax racket/base))
(provide m2)
(define-syntax (m2 stx)
#`(begin
(define #,(syntax-local-introduce #'x) 2)
#,(syntax-local-introduce #'x))))
(module mm-context-m3 racket/base
(require 'mm-context-m1 'mm-context-m2)
(m1)
(m2))
(let ([o (open-output-bytes)])
(parameterize ([current-output-port o])
(dynamic-require ''mm-context-m3 #f))
(test #"1\n2\n" get-output-bytes o))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

111
src/racket/src/compenv.c
View File

@ -1085,63 +1085,76 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
marks = SCHEME_CAR(marks); marks = SCHEME_CAR(marks);
} }
/* Treat #f and void values of bdg the same, since a void value is if (SCHEME_FALSEP(bdg))
the same #f, but ensure that we get this far: */
if (SCHEME_FALSEP(bdg) || SCHEME_VOIDP(bdg))
bdg = NULL; bdg = NULL;
/* Find a mapping that matches the longest tail of marks */ /* Find a mapping that matches the longest tail of marks
for (l = map; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { in the first matching tail of bdg */
a = SCHEME_CAR(l); while (1) {
amarks = SCHEME_CAR(a); for (l = map; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) {
a = SCHEME_CAR(l);
amarks = SCHEME_CAR(a);
if (SCHEME_VECTORP(amarks)) { if (SCHEME_VECTORP(amarks)) {
abdg = SCHEME_VEC_ELS(amarks)[1]; abdg = SCHEME_VEC_ELS(amarks)[1];
amarks = SCHEME_VEC_ELS(amarks)[0]; amarks = SCHEME_VEC_ELS(amarks)[0];
} else } else
abdg = NULL; abdg = NULL;
if (SAME_OBJ(abdg, bdg)) { if (SAME_OBJ(abdg, bdg)
if (mode > 0) { || (bdg && abdg && scheme_equal(abdg, bdg))) {
if (scheme_equal(amarks, marks)) { if (mode > 0) {
best_match = SCHEME_CDR(a); if (scheme_equal(amarks, marks)) {
break; best_match = SCHEME_CDR(a);
} break;
} else { }
if (SCHEME_NULLP(amarks)) { } else {
/* can always match empty marks */ if (SCHEME_NULLP(amarks)) {
best_match = SCHEME_CDR(a); /* can always match empty marks */
best_match_skipped = 0; best_match = SCHEME_CDR(a);
} else if (!SCHEME_PAIRP(marks)) { best_match_skipped = 0;
/* To be better than nothing, could only match exactly: */ } else if (!SCHEME_PAIRP(marks)) {
if (scheme_equal(amarks, marks)) { /* To be better than nothing, could only match exactly: */
best_match = SCHEME_CDR(a); if (scheme_equal(amarks, marks)) {
best_match_skipped = 0; best_match = SCHEME_CDR(a);
} best_match_skipped = 0;
} else { }
/* amarks can match a tail of marks: */ } else {
for (m = marks, ms = 0; /* amarks can match a tail of marks: */
SCHEME_PAIRP(m) && (ms < best_match_skipped); for (m = marks, ms = 0;
m = SCHEME_CDR(m), ms++) { SCHEME_PAIRP(m) && (ms < best_match_skipped);
m = SCHEME_CDR(m), ms++) {
cm = m; cm = m;
if (!SCHEME_PAIRP(amarks)) { if (!SCHEME_PAIRP(amarks)) {
/* If we're down to the last element /* If we're down to the last element
of marks, then extract it to try to of marks, then extract it to try to
match the symbol amarks. */ match the symbol amarks. */
if (SCHEME_NULLP(SCHEME_CDR(m))) if (SCHEME_NULLP(SCHEME_CDR(m)))
cm = SCHEME_CAR(m); cm = SCHEME_CAR(m);
} }
if (scheme_equal(amarks, cm)) { if (scheme_equal(amarks, cm)) {
best_match = SCHEME_CDR(a); best_match = SCHEME_CDR(a);
best_match_skipped = ms; best_match_skipped = ms;
break; break;
} }
} }
} }
}
} }
} }
if (!best_match && (mode <= 1) && bdg && (SCHEME_PAIRP(bdg) || SCHEME_INTP(bdg) || SCHEME_BIGNUMP(bdg))) {
/* try lookup with less bdg context */
if (SCHEME_PAIRP(bdg)) {
bdg = SCHEME_CDR(bdg);
if (SCHEME_PAIRP(bdg) && SCHEME_NULLP(SCHEME_CDR(bdg)))
bdg = SCHEME_CAR(bdg);
} else
bdg = NULL;
} else
break;
} }
if (!best_match) { if (!best_match) {

168
src/racket/src/cstartup.inc
View File

@ -1,11 +1,11 @@
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0, 0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0,
19,0,32,0,39,0,42,0,49,0,56,0,60,0,65,0,69,0,74,0,83, 19,0,32,0,39,0,42,0,49,0,56,0,60,0,65,0,69,0,74,0,83,
0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0, 0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0,
163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,95,1,128, 163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,96,1,129,
1,161,1,220,1,19,2,97,2,152,2,157,2,177,2,70,3,90,3,142,3, 1,162,1,221,1,21,2,99,2,155,2,160,2,180,2,73,3,93,3,145,3,
208,3,97,4,239,4,36,5,47,5,126,5,0,0,88,7,0,0,69,35,37, 211,3,100,4,242,4,40,5,51,5,130,5,0,0,92,7,0,0,69,35,37,
109,105,110,45,115,116,120,29,11,11,11,64,99,111,110,100,72,112,97,114,97, 109,105,110,45,115,116,120,29,11,11,11,64,99,111,110,100,72,112,97,114,97,
109,101,116,101,114,105,122,101,66,108,101,116,114,101,99,62,111,114,66,117,110, 109,101,116,101,114,105,122,101,66,108,101,116,114,101,99,62,111,114,66,117,110,
108,101,115,115,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,63, 108,101,115,115,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,63,
@ -21,85 +21,85 @@
2,8,2,2,2,9,2,2,2,5,2,2,2,11,2,2,2,12,2,2,97, 2,8,2,2,2,9,2,2,2,5,2,2,2,11,2,2,2,12,2,2,97,
37,11,8,240,248,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2, 37,11,8,240,248,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2,
37,2,13,2,2,2,13,96,38,11,8,240,248,81,0,0,16,0,96,11,11, 37,2,13,2,2,2,13,96,38,11,8,240,248,81,0,0,16,0,96,11,11,
8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14, 8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14,
2,2,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,150, 2,2,11,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,
4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248, 150,4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,
22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,2, 248,22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,
18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22, 2,18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,
157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75, 22,157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,
194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,74, 75,194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,
199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2, 74,199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,6,36,2,14,
2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101, 2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,
110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,49,53, 8,101,110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,
53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,159,37, 49,53,53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,
36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,158,39, 159,37,36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,
36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201, 158,39,36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,
251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,100,11, 74,201,251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,
13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11, 100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29,
11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,2,21,3, 16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,
1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,157,4,194, 2,21,3,1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,
249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,157, 157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,
4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,151,4,248, 248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,
22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33, 151,4,248,22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,
40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22,83,249,22, 9,222,33,40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22,
83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2,22,74,23, 83,249,22,83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2,
204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249,22,2,22, 22,74,23,204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249,
98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36,37,47,11, 22,2,22,98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36,
9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248,22,157,4, 37,47,11,9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248,
194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22, 22,157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,
157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24,249,22,2, 75,248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24,
32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248,22,74,201, 249,22,2,32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248,
248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4,248,22,74, 22,74,201,248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4,
195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248, 248,22,74,195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2,
22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84,2,10,248, 22,9,248,22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84,
22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1,27,249,22, 2,10,248,22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1,
1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248,22,177,4, 27,249,22,1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248,
249,22,150,4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,99,111,110, 22,177,4,249,22,150,4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,
116,105,110,117,97,116,105,111,110,45,109,97,114,107,2,26,250,22,84,1,23, 99,111,110,116,105,110,117,97,116,105,111,110,45,109,97,114,107,2,26,250,22,
101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,122,97,116,105, 84,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,122,
111,110,21,95,1,27,99,111,110,116,105,110,117,97,116,105,111,110,45,109,97, 97,116,105,111,110,21,95,1,27,99,111,110,116,105,110,117,97,116,105,111,110,
114,107,45,115,101,116,45,102,105,114,115,116,11,2,26,202,250,22,84,2,22, 45,109,97,114,107,45,115,101,116,45,102,105,114,115,116,11,2,26,202,250,22,
9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14, 84,2,22,9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81,
159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248,22,74,197, 193,20,14,159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248,
28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22,83,2,22, 22,74,197,28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22,
248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,3,249,22, 83,2,22,248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,
83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18, 3,249,22,83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,
28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,10,248,22, 83,2,18,28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,
74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,22,75,202, 10,248,22,74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,
99,13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4, 22,75,202,99,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,
11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,11,11,2,21, 8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,
3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,111,105,100,8, 11,11,2,21,3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,
48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,36,28,248,22, 111,105,100,8,48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,
58,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199, 36,28,248,22,58,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83,
248,22,98,198,27,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83, 248,22,74,199,248,22,98,198,27,248,22,151,4,248,22,74,197,250,22,83,2,
248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,113, 28,248,22,83,248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202,
159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2,9,9,11,11, 159,36,20,113,159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2,
11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39,36,16,0,36, 9,9,11,11,11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39,
16,0,36,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2, 36,16,0,36,16,0,36,11,11,11,16,10,2,3,2,4,2,5,2,6,2,
9,2,10,2,11,2,12,16,10,11,11,11,11,11,11,11,11,11,11,16,10, 7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11,11,11,11,11,11,
2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,36, 11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,
46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0,16,0,36,36, 11,2,12,36,46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0,
11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,20,15,16,2, 16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,
20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1,2,13,16,1, 20,15,16,2,20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1,
33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0,33,34,36,20, 2,13,16,1,33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0,
113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8,36,37,53,37, 33,34,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8,
9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,9, 36,37,53,37,9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11,
88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36,16,1,2,13, 16,5,2,9,88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36,
16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,223,0,33,38, 16,1,2,13,16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,
36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2,11,88,163,8, 223,0,33,38,36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2,
36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2,13,16,0,11, 11,88,163,8,36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2,
16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36,20,113,159,36, 13,16,0,11,16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36,
16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54,37,9,223,0, 20,113,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54,
33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,4,88,163,8, 37,9,223,0,33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,
36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2,13,16,0,11, 4,88,163,8,36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2,
16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36,20,113,159,36, 13,16,0,11,16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36,
16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36,37,54,37,9, 20,113,159,36,16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36,
223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16,0,94,2,16, 37,54,37,9,223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16,
2,17,93,2,16,9,9,36,0}; 0,94,2,16,2,17,93,2,16,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 2024); EVAL_ONE_SIZED_STR((char *)expr, 2028);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0, 0,0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0,
26,0,43,0,65,0,94,0,109,0,127,0,139,0,155,0,169,0,191,0,207, 26,0,43,0,65,0,94,0,109,0,127,0,139,0,155,0,169,0,191,0,207,
0,224,0,246,0,1,1,7,1,16,1,23,1,30,1,42,1,58,1,82,1, 0,224,0,246,0,1,1,7,1,16,1,23,1,30,1,42,1,58,1,82,1,
@ -600,7 +600,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 10438); EVAL_ONE_SIZED_STR((char *)expr, 10438);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0, 0,0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0,
57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,179, 57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,179,
1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115, 1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115,
@ -627,7 +627,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 501); EVAL_ONE_SIZED_STR((char *)expr, 501);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,81,0,0,0,1,0,0,7,0,18,0, 0,0,0,0,0,0,0,0,0,0,81,0,0,0,1,0,0,7,0,18,0,
45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185, 45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185,
0,201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1, 0,201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1,
@ -984,7 +984,7 @@
EVAL_ONE_SIZED_STR((char *)expr, 7421); EVAL_ONE_SIZED_STR((char *)expr, 7421);
} }
{ {
SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0, 0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0,
29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0, 29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0,
0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2, 0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2,

8
src/racket/src/eval.c
View File

@ -3733,7 +3733,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env
if (genv->rename_set) { if (genv->rename_set) {
form = scheme_add_rename(form, genv->rename_set); form = scheme_add_rename(form, genv->rename_set);
/* this "phase shift" just attaches the namespace's module registry: */ /* this "phase shift" just attaches the namespace's module registry: */
form = scheme_stx_phase_shift(form, NULL, NULL, NULL, genv->module_registry->exports, NULL); form = scheme_stx_phase_shift(form, NULL, NULL, NULL, genv->module_registry->exports, NULL, NULL);
} }
return form; return form;
@ -3811,7 +3811,7 @@ static void *compile_k(void)
genv->module->me->src_modidx, genv->module->me->src_modidx,
genv->module->self_modidx, genv->module->self_modidx,
genv->module_registry->exports, genv->module_registry->exports,
NULL); NULL, NULL);
} }
} }
@ -4246,7 +4246,7 @@ Scheme_Object *scheme_eval_compiled_stx_string(Scheme_Object *expr, Scheme_Env *
for (i = 0; i < len - 1; i++) { for (i = 0; i < len - 1; i++) {
s = scheme_stx_phase_shift(SCHEME_VEC_ELS(expr)[i], scheme_make_integer(shift), orig, modidx, s = scheme_stx_phase_shift(SCHEME_VEC_ELS(expr)[i], scheme_make_integer(shift), orig, modidx,
env->module_registry->exports, NULL); env->module_registry->exports, NULL, NULL);
SCHEME_VEC_ELS(result)[i] = s; SCHEME_VEC_ELS(result)[i] = s;
} }
@ -5446,7 +5446,7 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp,
v = scheme_stx_phase_shift_as_rename(scheme_make_integer(now_phase - src_phase), v = scheme_stx_phase_shift_as_rename(scheme_make_integer(now_phase - src_phase),
src_modidx, now_modidx, src_modidx, now_modidx,
genv ? genv->module_registry->exports : NULL, genv ? genv->module_registry->exports : NULL,
insp); insp, NULL);
if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) { if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) {
/* Put lazy-shift info in pf->a[i]: */ /* Put lazy-shift info in pf->a[i]: */
Scheme_Object **ls; Scheme_Object **ls;

109
src/racket/src/module.c
View File

@ -767,6 +767,7 @@ static Scheme_Object *scheme_sys_wraps_phase_worker(intptr_t p)
scheme_make_integer(p), scheme_make_integer(p),
scheme_make_integer(0), scheme_make_integer(0),
scheme_null, scheme_null,
NULL,
1); 1);
scheme_seal_module_rename(rn, STX_SEAL_ALL); scheme_seal_module_rename(rn, STX_SEAL_ALL);
@ -2530,6 +2531,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn,
marshal_phase_index, marshal_phase_index,
scheme_make_integer(0), scheme_make_integer(0),
scheme_null, scheme_null,
NULL,
1); 1);
} }
@ -6287,24 +6289,24 @@ static Scheme_Object *annotate_existing_submodules(Scheme_Object *orig_fm)
return orig_fm; return orig_fm;
} }
static Scheme_Object *phase_shift_tail(Scheme_Object *v, Scheme_Object *old_midx, Scheme_Object *new_midx) static Scheme_Object *phase_shift_tail(Scheme_Object *v, Scheme_Object *ps)
{ {
if (!SCHEME_STXP(v)) if (!SCHEME_STXP(v))
v = scheme_datum_to_syntax(v, scheme_false, scheme_false, 0, 0); v = scheme_datum_to_syntax(v, scheme_false, scheme_false, 0, 0);
return scheme_stx_phase_shift(v, NULL, old_midx, new_midx, NULL, NULL); return scheme_add_rename(v, ps);
} }
static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Object *a, Scheme_Object *d, static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Object *a, Scheme_Object *d,
Scheme_Object *old_midx, Scheme_Object *new_midx) Scheme_Object *ps)
{ {
if (!a) { if (!a) {
a = SCHEME_STX_CAR(orig); a = SCHEME_STX_CAR(orig);
a = scheme_stx_phase_shift(a, NULL, old_midx, new_midx, NULL, NULL); a = scheme_add_rename(a, ps);
} }
if (!d) { if (!d) {
d = SCHEME_STX_CDR(orig); d = SCHEME_STX_CDR(orig);
d = phase_shift_tail(d, old_midx, new_midx); d = phase_shift_tail(d, ps);
} }
a = scheme_make_pair(a, d); a = scheme_make_pair(a, d);
@ -6312,15 +6314,13 @@ static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Objec
if (SCHEME_PAIRP(orig)) if (SCHEME_PAIRP(orig))
return a; return a;
orig = scheme_stx_phase_shift(orig, NULL, old_midx, new_midx, NULL, NULL); orig = scheme_add_rename(orig, ps);
return scheme_datum_to_syntax(a, orig, orig, 0, 2); return scheme_datum_to_syntax(a, orig, orig, 0, 2);
} }
static Scheme_Object *phase_shift_skip_submodules_k(void); static Scheme_Object *phase_shift_skip_submodules_k(void);
static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, Scheme_Object *ps, int phase)
Scheme_Object *old_midx, Scheme_Object *new_midx,
int phase)
{ {
Scheme_Object *v0, *v1, *v2, *v3, *v4, *naya; Scheme_Object *v0, *v1, *v2, *v3, *v4, *naya;
@ -6329,8 +6329,7 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm,
{ {
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
p->ku.k.p1 = (void *)fm; p->ku.k.p1 = (void *)fm;
p->ku.k.p2 = (void *)old_midx; p->ku.k.p2 = (void *)ps;
p->ku.k.p3 = (void *)new_midx;
p->ku.k.i1 = phase; p->ku.k.i1 = phase;
return scheme_handle_stack_overflow(phase_shift_skip_submodules_k); return scheme_handle_stack_overflow(phase_shift_skip_submodules_k);
} }
@ -6344,15 +6343,15 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm,
v3 = SCHEME_STX_CAR(v2); v3 = SCHEME_STX_CAR(v2);
v4 = SCHEME_STX_CDR(v3); v4 = SCHEME_STX_CDR(v3);
naya = phase_shift_skip_submodules(v4, old_midx, new_midx, 0); naya = phase_shift_skip_submodules(v4, ps, 0);
if (SAME_OBJ(naya, v4)) { if (SAME_OBJ(naya, v4)) {
return scheme_stx_phase_shift(fm, NULL, old_midx, new_midx, NULL, NULL); return scheme_add_rename(fm, ps);
} else { } else {
v3 = rebuild_with_phase_shift(v3, NULL, naya, old_midx, new_midx); v3 = rebuild_with_phase_shift(v3, NULL, naya, ps);
v2 = rebuild_with_phase_shift(v2, v3, NULL, old_midx, new_midx); v2 = rebuild_with_phase_shift(v2, v3, NULL, ps);
v1 = rebuild_with_phase_shift(v1, NULL, v2, old_midx, new_midx); v1 = rebuild_with_phase_shift(v1, NULL, v2, ps);
v0 = rebuild_with_phase_shift(v0, NULL, v1, old_midx, new_midx); v0 = rebuild_with_phase_shift(v0, NULL, v1, ps);
return rebuild_with_phase_shift(fm, NULL, v0, old_midx, new_midx); return rebuild_with_phase_shift(fm, NULL, v0, ps);
} }
} else if (SCHEME_STX_NULLP(fm)) { } else if (SCHEME_STX_NULLP(fm)) {
return fm; return fm;
@ -6366,33 +6365,33 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm,
|| scheme_stx_module_eq_x(scheme_modulestar_stx, v2, phase)) { || scheme_stx_module_eq_x(scheme_modulestar_stx, v2, phase)) {
/* found a submodule */ /* found a submodule */
v2 = SCHEME_STX_CDR(fm); v2 = SCHEME_STX_CDR(fm);
naya = phase_shift_skip_submodules(v2, old_midx, new_midx, phase); naya = phase_shift_skip_submodules(v2, ps, phase);
if (SAME_OBJ(naya, v2)) if (SAME_OBJ(naya, v2))
naya = phase_shift_tail(naya, old_midx, new_midx); naya = phase_shift_tail(naya, ps);
return rebuild_with_phase_shift(fm, v1, naya, old_midx, new_midx); return rebuild_with_phase_shift(fm, v1, naya, ps);
} else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, v2, phase)) { } else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, v2, phase)) {
/* found `begin-for-syntax': */ /* found `begin-for-syntax': */
naya = phase_shift_skip_submodules(v1, old_midx, new_midx, phase+1); naya = phase_shift_skip_submodules(v1, ps, phase+1);
v2 = SCHEME_STX_CDR(fm); v2 = SCHEME_STX_CDR(fm);
v3 = phase_shift_skip_submodules(v2, old_midx, new_midx, phase+1); v3 = phase_shift_skip_submodules(v2, ps, phase+1);
if (SAME_OBJ(naya, v1) && SAME_OBJ(v2, v3)) if (SAME_OBJ(naya, v1) && SAME_OBJ(v2, v3))
return fm; return fm;
else { else {
if (SAME_OBJ(v2, v3)) if (SAME_OBJ(v2, v3))
v3 = phase_shift_tail(v3, old_midx, new_midx); v3 = phase_shift_tail(v3, ps);
return rebuild_with_phase_shift(fm, naya, v3, old_midx, new_midx); return rebuild_with_phase_shift(fm, naya, v3, ps);
} }
} }
} }
} }
v3 = SCHEME_STX_CDR(fm); v3 = SCHEME_STX_CDR(fm);
v4 = phase_shift_skip_submodules(v3, old_midx, new_midx, phase); v4 = phase_shift_skip_submodules(v3, ps, phase);
if (SAME_OBJ(v3, v4)) if (SAME_OBJ(v3, v4))
return fm; return fm;
else { else {
v1 = scheme_stx_phase_shift(v1, NULL, old_midx, new_midx, NULL, NULL); v1 = scheme_add_rename(v1, ps);
return rebuild_with_phase_shift(fm, v1, v4, old_midx, new_midx); return rebuild_with_phase_shift(fm, v1, v4, ps);
} }
} }
} }
@ -6401,14 +6400,12 @@ static Scheme_Object *phase_shift_skip_submodules_k(void)
{ {
Scheme_Thread *p = scheme_current_thread; Scheme_Thread *p = scheme_current_thread;
Scheme_Object *fm = (Scheme_Object *)p->ku.k.p1; Scheme_Object *fm = (Scheme_Object *)p->ku.k.p1;
Scheme_Object *old_midx = (Scheme_Object *)p->ku.k.p2; Scheme_Object *ps = (Scheme_Object *)p->ku.k.p2;
Scheme_Object *new_midx = (Scheme_Object *)p->ku.k.p3;
p->ku.k.p1 = NULL; p->ku.k.p1 = NULL;
p->ku.k.p2 = NULL; p->ku.k.p2 = NULL;
p->ku.k.p3 = NULL;
return phase_shift_skip_submodules(fm, old_midx, new_midx, p->ku.k.i1); return phase_shift_skip_submodules(fm, ps, p->ku.k.i1);
} }
static Scheme_Env *find_env(Scheme_Env *env, intptr_t ph) static Scheme_Env *find_env(Scheme_Env *env, intptr_t ph)
@ -6618,7 +6615,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
rn = scheme_stx_phase_shift_as_rename(super_phase_shift, rn = scheme_stx_phase_shift_as_rename(super_phase_shift,
top_env->module->self_modidx, iidx, top_env->module->self_modidx, iidx,
menv->module_registry->exports, menv->module_registry->exports,
env->insp); env->insp, NULL);
super_bxs_info = MALLOC_N(void*, 6); super_bxs_info = MALLOC_N(void*, 6);
super_bxs_info[0] = super_bxs; super_bxs_info[0] = super_bxs;
@ -6730,13 +6727,13 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
if (ii) { if (ii) {
/* phase shift to replace self_modidx of previous expansion (if any): */ /* phase shift to replace self_modidx of previous expansion (if any): */
fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp); fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp, NULL);
fm = scheme_add_rename(fm, rn_set); fm = scheme_add_rename(fm, rn_set);
} else { } else {
if (skip_strip) { if (skip_strip) {
/* phase shift to replace self_modidx of previous expansion: */ /* phase shift to replace self_modidx of previous expansion: */
fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp); fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp, NULL);
} }
} }
@ -6800,7 +6797,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
fm = (Scheme_Object *)m; fm = (Scheme_Object *)m;
} else { } else {
Scheme_Object *hints, *formname; Scheme_Object *hints, *formname, *ps;
fm = scheme_expand_expr(fm, benv, rec, drec); fm = scheme_expand_expr(fm, benv, rec, drec);
@ -6849,10 +6846,12 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
} }
/* for future expansion, shift away from self_modidx: */ /* for future expansion, shift away from self_modidx: */
ps = scheme_stx_phase_shift_as_rename(NULL, self_modidx, this_empty_self_modidx,
NULL, NULL, scheme_rename_set_identity(rn_set));
if (m->pre_submodules) /* non-NULL => some submodules, even if it's '() */ if (m->pre_submodules) /* non-NULL => some submodules, even if it's '() */
fm = phase_shift_skip_submodules(fm, self_modidx, this_empty_self_modidx, -1); fm = phase_shift_skip_submodules(fm, ps, -1);
else else
fm = scheme_stx_phase_shift(fm, NULL, self_modidx, this_empty_self_modidx, NULL, NULL); fm = scheme_add_rename(fm, ps);
/* make self_modidx like the empty modidx */ /* make self_modidx like the empty modidx */
if (SAME_OBJ(this_empty_self_modidx, empty_self_modidx)) if (SAME_OBJ(this_empty_self_modidx, empty_self_modidx))
@ -10534,7 +10533,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null; Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null;
int *exets; int *exets;
int 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_Object *nominal_modidx, *one_exn, *prnt_iname, *name, *rn, *ename = orig_ename, *bdg;
Scheme_Hash_Table *orig_onlys; Scheme_Hash_Table *orig_onlys;
int k, skip_rename, do_copy_vars; int k, skip_rename, do_copy_vars;
Scheme_Env *name_env; Scheme_Env *name_env;
@ -10543,12 +10542,8 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
/* Check whether there's context for this import (which /* Check whether there's context for this import (which
leads to generated local names). */ leads to generated local names). */
context_marks = scheme_stx_extract_marks(mark_src); context_marks = scheme_stx_extract_marks(mark_src);
has_context = !SCHEME_NULLP(context_marks); bdg = scheme_stx_moduleless_env(mark_src);
if (!has_context) { has_context = !SCHEME_NULLP(context_marks) || !SCHEME_FALSEP(bdg);
if (SCHEME_TRUEP(scheme_stx_moduleless_env(mark_src))) {
has_context = 1;
}
}
if (has_context) { if (has_context) {
if (all_simple) if (all_simple)
*all_simple = 0; *all_simple = 0;
@ -10638,7 +10633,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
/* Simple "import everything" whose mappings can be shared via the exporting module: */ /* Simple "import everything" whose mappings can be shared via the exporting module: */
if (!pt->src_modidx && me->src_modidx) if (!pt->src_modidx && me->src_modidx)
pt->src_modidx = me->src_modidx; pt->src_modidx = me->src_modidx;
scheme_extend_module_rename_with_shared(rn, idx, pt, pt->phase_index, src_phase_index, context_marks, 1); scheme_extend_module_rename_with_shared(rn, idx, pt, pt->phase_index, src_phase_index, context_marks, bdg, 1);
skip_rename = 1; skip_rename = 1;
} else } else
skip_rename = 0; skip_rename = 0;
@ -10663,7 +10658,8 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
{ {
Scheme_Object *l; Scheme_Object *l;
l = scheme_stx_extract_marks(mark_src); l = scheme_stx_extract_marks(mark_src);
has_context = !SCHEME_NULLP(l); bdg = scheme_stx_moduleless_env(mark_src);
has_context = !SCHEME_NULLP(l) || !SCHEME_FALSEP(bdg);
} }
/* Remove to indicate that it's been imported: */ /* Remove to indicate that it's been imported: */
scheme_hash_set(onlys, exs[j], NULL); scheme_hash_set(onlys, exs[j], NULL);
@ -10711,7 +10707,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
/* The `require' expression has a set of marks in its /* The `require' expression has a set of marks in its
context, which means that we need to generate a name. */ context, which means that we need to generate a name. */
iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0); iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0);
iname = scheme_tl_id_sym(name_env, iname, scheme_false, skip_rename ? 3 : 2, to_phase, NULL); iname = scheme_tl_id_sym(name_env, iname, bdg, skip_rename ? 3 : 2, to_phase, NULL);
if (all_simple) if (all_simple)
*all_simple = 0; *all_simple = 0;
} }
@ -10809,7 +10805,7 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
Scheme_Object *modidx_shift_from, Scheme_Object *modidx_shift_to, Scheme_Object *modidx_shift_from, Scheme_Object *modidx_shift_to,
Scheme_Hash_Table *export_registry) Scheme_Hash_Table *export_registry)
{ {
Scheme_Object *orig_idx, *exns, *prefix, *idx, *name, *pt_phase, *src_phase_index, *marks; Scheme_Object *orig_idx, *exns, *prefix, *idx, *name, *pt_phase, *src_phase_index, *marks, *bdg;
Scheme_Module_Exports *me; Scheme_Module_Exports *me;
Scheme_Env *env; Scheme_Env *env;
int share_all; int share_all;
@ -10820,12 +10816,19 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
pt_phase = SCHEME_CAR(info); pt_phase = SCHEME_CAR(info);
info = SCHEME_CDR(info); info = SCHEME_CDR(info);
if (SCHEME_PAIRP(info) && SCHEME_PAIRP(SCHEME_CAR(info))) { if (SCHEME_PAIRP(info) && (SCHEME_PAIRP(SCHEME_CAR(info))
|| SCHEME_VECTORP(SCHEME_CAR(info)))) {
marks = SCHEME_CAR(info); marks = SCHEME_CAR(info);
info = SCHEME_CDR(info); info = SCHEME_CDR(info);
} else } else
marks = scheme_null; marks = scheme_null;
if (SCHEME_VECTORP(marks)) {
bdg = SCHEME_VEC_ELS(marks)[1];
marks = SCHEME_VEC_ELS(marks)[0];
} else
bdg = scheme_false;
if (SCHEME_INTP(info) if (SCHEME_INTP(info)
|| SCHEME_FALSEP(info)) { || SCHEME_FALSEP(info)) {
share_all = 1; share_all = 1;
@ -10893,11 +10896,11 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
if (pt) { if (pt) {
if (!pt->src_modidx && me->src_modidx) if (!pt->src_modidx && me->src_modidx)
pt->src_modidx = me->src_modidx; pt->src_modidx = me->src_modidx;
scheme_extend_module_rename_with_shared(rn, orig_idx, pt, pt->phase_index, src_phase_index, marks, 0); scheme_extend_module_rename_with_shared(rn, orig_idx, pt, pt->phase_index, src_phase_index, marks, bdg, 0);
} }
} else { } else {
if (!SCHEME_NULLP(marks)) if (!SCHEME_NULLP(marks) || SCHEME_TRUEP(bdg))
scheme_signal_error("internal error: unexpected marks"); scheme_signal_error("internal error: unexpected marks/bdg");
add_single_require(me, pt_phase, src_phase_index, orig_idx, NULL, add_single_require(me, pt_phase, src_phase_index, orig_idx, NULL,
NULL, NULL, rn, NULL, NULL, rn,

9
src/racket/src/schpriv.h
View File

@ -1019,7 +1019,7 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m
struct Scheme_Module_Phase_Exports *pt, struct Scheme_Module_Phase_Exports *pt,
Scheme_Object *unmarshal_phase_index, Scheme_Object *unmarshal_phase_index,
Scheme_Object *src_phase_index, Scheme_Object *src_phase_index,
Scheme_Object *marks, Scheme_Object *marks, Scheme_Object *bdg,
int save_unmarshal); int save_unmarshal);
void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info); void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info);
void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
@ -1038,6 +1038,7 @@ Scheme_Object *scheme_stx_shift_rename(Scheme_Object *mrn, Scheme_Object *old_mi
Scheme_Object *scheme_stx_shift_rename_set(Scheme_Object *mrns, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *scheme_stx_shift_rename_set(Scheme_Object *mrns, Scheme_Object *old_midx, Scheme_Object *new_midx,
Scheme_Object *new_insp); Scheme_Object *new_insp);
Scheme_Hash_Table *scheme_module_rename_marked_names(Scheme_Object *rn); Scheme_Hash_Table *scheme_module_rename_marked_names(Scheme_Object *rn);
Scheme_Object *scheme_rename_set_identity(Scheme_Object *rn_set);
Scheme_Object *scheme_stx_content(Scheme_Object *o); Scheme_Object *scheme_stx_content(Scheme_Object *o);
Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist); Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist);
@ -1079,11 +1080,13 @@ Scheme_Object *scheme_stx_property(Scheme_Object *_stx,
Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift, Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift,
Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *old_midx, Scheme_Object *new_midx,
Scheme_Hash_Table *export_registry, Scheme_Hash_Table *export_registry,
Scheme_Object *insp); Scheme_Object *insp,
Scheme_Object *ignore_old_identity);
Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift,
Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *old_midx, Scheme_Object *new_midx,
Scheme_Hash_Table *export_registry, Scheme_Hash_Table *export_registry,
Scheme_Object *insp); Scheme_Object *insp,
Scheme_Object *ignore_old_identity);
int scheme_stx_list_length(Scheme_Object *list); int scheme_stx_list_length(Scheme_Object *list);
int scheme_stx_proper_list_length(Scheme_Object *list); int scheme_stx_proper_list_length(Scheme_Object *list);

4
src/racket/src/schvers.h
View File

@ -13,12 +13,12 @@
consistently.) consistently.)
*/ */
#define MZSCHEME_VERSION "5.3.0.6" #define MZSCHEME_VERSION "5.3.0.7"
#define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Y 3
#define MZSCHEME_VERSION_Z 0 #define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 6 #define MZSCHEME_VERSION_W 7
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

307
src/racket/src/syntax.c
View File

@ -145,7 +145,9 @@ typedef struct Module_Renames {
Scheme_Hash_Table *nomarshal_ht; /* like ht, but dropped on marshal */ Scheme_Hash_Table *nomarshal_ht; /* like ht, but dropped on marshal */
Scheme_Object *shared_pes; /* list of (cons modidx (cons phase_export phase_and_marks)) Scheme_Object *shared_pes; /* list of (cons modidx (cons phase_export phase_and_marks))
phase_and_marks -> phase-index-int OR phase_and_marks -> phase-index-int OR
(cons (nonempty-listof mark) phase-index-int) (cons marks phase-index-int)
marks -> (nonempty-listof mark) OR
(vector (listof mark) bdg)
like nomarshal ht, but shared from provider */ like nomarshal ht, but shared from provider */
Scheme_Hash_Table *marked_names; /* shared with module environment while compiling the module; Scheme_Hash_Table *marked_names; /* shared with module environment while compiling the module;
this table maps a top-level-bound identifier with a non-empty mark this table maps a top-level-bound identifier with a non-empty mark
@ -271,10 +273,12 @@ XFORM_NONGCING static int is_member(Scheme_Object *a, Scheme_Object *l)
simple lexical renames (not ribs) and marks, only, and it's simple lexical renames (not ribs) and marks, only, and it's
inserted into a chain heuristically inserted into a chain heuristically
- A wrap-elem (box (vector <num-or #f> <midx> <midx> <export-registry> <insp>)) - A wrap-elem (box (vector <num-or #f> <midx> <midx> <export-registry> <insp> <id-or-#f>))
is a phase shift by <num-or-#f>, remapping the first <midx> to the is a phase shift by <num-or-#f>, remapping the first <midx> to the
second <midx>; the <export-registry> part is for finding second <midx>; the <export-registry> part is for finding
modules to unmarshal import renamings modules to unmarshal import renamings; <id-or-#f> cancels
treatment of a following module rename with a matching id
as an "old" environment
[Don't add a pair case, because sometimes we test for element [Don't add a pair case, because sometimes we test for element
versus list-of-element.] versus list-of-element.]
@ -764,7 +768,7 @@ static int maybe_add_chain_cache(Scheme_Stx *stx)
if (SCHEME_VECTORP(p)) { if (SCHEME_VECTORP(p)) {
skipable++; skipable++;
} else if (SCHEME_NUMBERP(p) || SCHEME_SYMBOLP(p)) { } else if (SCHEME_NUMBERP(p) || SCHEME_SYMBOLP(p)) {
/* ok to skip, but don<'t count toward needing a cache */ /* ok to skip, but don't count toward needing a cache */
} else if (SCHEME_HASHTP(p)) { } else if (SCHEME_HASHTP(p)) {
/* Hack: we store the depth of the table in the chain /* Hack: we store the depth of the table in the chain
in the `size' fields, at least until the table is initialized: */ in the `size' fields, at least until the table is initialized: */
@ -1328,6 +1332,11 @@ void scheme_seal_module_rename_set(Scheme_Object *_rns, int level)
} }
} }
Scheme_Object *scheme_rename_set_identity(Scheme_Object *rn_set)
{
return ((Module_Renames_Set *)rn_set)->set_identity;
}
static void check_not_sealed(Module_Renames *mrn) static void check_not_sealed(Module_Renames *mrn)
{ {
if (mrn->sealed >= STX_SEAL_ALL) if (mrn->sealed >= STX_SEAL_ALL)
@ -1425,6 +1434,7 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m
Scheme_Object *unmarshal_phase_index, Scheme_Object *unmarshal_phase_index,
Scheme_Object *src_phase_index, Scheme_Object *src_phase_index,
Scheme_Object *marks, Scheme_Object *marks,
Scheme_Object *bdg,
int save_unmarshal) int save_unmarshal)
{ {
Module_Renames *mrn = (Module_Renames *)rn; Module_Renames *mrn = (Module_Renames *)rn;
@ -1432,9 +1442,15 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m
check_not_sealed(mrn); check_not_sealed(mrn);
if (SCHEME_PAIRP(marks)) if (!bdg) bdg = scheme_false;
if (SCHEME_PAIRP(marks) || SCHEME_TRUEP(bdg)) {
if (SCHEME_TRUEP(bdg)) {
marks = scheme_make_vector(2, marks);
SCHEME_VEC_ELS(marks)[1] = bdg;
}
index_plus_marks = scheme_make_pair(marks, src_phase_index); index_plus_marks = scheme_make_pair(marks, src_phase_index);
else } else
index_plus_marks = src_phase_index; index_plus_marks = src_phase_index;
pr = scheme_make_pair(scheme_make_pair(modidx, pr = scheme_make_pair(scheme_make_pair(modidx,
@ -2141,7 +2157,8 @@ void scheme_install_free_id_rename(Scheme_Object *id,
} }
Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx,
Scheme_Hash_Table *export_registry, Scheme_Object *insp) Scheme_Hash_Table *export_registry, Scheme_Object *insp,
Scheme_Object *ignore_old_identity)
{ {
if (!shift) if (!shift)
shift = scheme_make_integer(0); shift = scheme_make_integer(0);
@ -2155,15 +2172,17 @@ Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Obj
&& (SCHEME_VEC_ELS(vec)[1] == (new_midx ? old_midx : scheme_false)) && (SCHEME_VEC_ELS(vec)[1] == (new_midx ? old_midx : scheme_false))
&& (SCHEME_VEC_ELS(vec)[2] == (new_midx ? new_midx : scheme_false)) && (SCHEME_VEC_ELS(vec)[2] == (new_midx ? new_midx : scheme_false))
&& (SCHEME_VEC_ELS(vec)[3] == (export_registry ? (Scheme_Object *)export_registry : scheme_false)) && (SCHEME_VEC_ELS(vec)[3] == (export_registry ? (Scheme_Object *)export_registry : scheme_false))
&& (SCHEME_VEC_ELS(vec)[4] == (insp ? insp : scheme_false))) { && (SCHEME_VEC_ELS(vec)[4] == (insp ? insp : scheme_false))
&& (SCHEME_VEC_ELS(vec)[5] == (ignore_old_identity ? ignore_old_identity : scheme_false))) {
/* use the old one */ /* use the old one */
} else { } else {
vec = scheme_make_vector(5, NULL); vec = scheme_make_vector(6, NULL);
SCHEME_VEC_ELS(vec)[0] = shift; SCHEME_VEC_ELS(vec)[0] = shift;
SCHEME_VEC_ELS(vec)[1] = (new_midx ? old_midx : scheme_false); SCHEME_VEC_ELS(vec)[1] = (new_midx ? old_midx : scheme_false);
SCHEME_VEC_ELS(vec)[2] = (new_midx ? new_midx : scheme_false); SCHEME_VEC_ELS(vec)[2] = (new_midx ? new_midx : scheme_false);
SCHEME_VEC_ELS(vec)[3] = (export_registry ? (Scheme_Object *)export_registry : scheme_false); SCHEME_VEC_ELS(vec)[3] = (export_registry ? (Scheme_Object *)export_registry : scheme_false);
SCHEME_VEC_ELS(vec)[4] = (insp ? insp : scheme_false); SCHEME_VEC_ELS(vec)[4] = (insp ? insp : scheme_false);
SCHEME_VEC_ELS(vec)[5] = (ignore_old_identity ? ignore_old_identity : scheme_false);
last_phase_shift = scheme_box(vec); last_phase_shift = scheme_box(vec);
} }
@ -2176,14 +2195,15 @@ Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Obj
Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift, Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift,
Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *old_midx, Scheme_Object *new_midx,
Scheme_Hash_Table *export_registry, Scheme_Hash_Table *export_registry,
Scheme_Object *insp) Scheme_Object *insp,
Scheme_Object *ignore_old_identity)
/* Shifts the phase on a syntax object in a module. A 0 shift might be /* Shifts the phase on a syntax object in a module. A 0 shift might be
used just to re-direct relative module paths. new_midx might be used just to re-direct relative module paths. new_midx might be
NULL to shift without redirection. And so on. */ NULL to shift without redirection. And so on. */
{ {
Scheme_Object *ps; Scheme_Object *ps;
ps = scheme_stx_phase_shift_as_rename(shift, old_midx, new_midx, export_registry, insp); ps = scheme_stx_phase_shift_as_rename(shift, old_midx, new_midx, export_registry, insp, ignore_old_identity);
if (ps) if (ps)
return scheme_add_rename(stx, ps); return scheme_add_rename(stx, ps);
else else
@ -2200,7 +2220,7 @@ static Scheme_Object *syntax_shift_phase(int argc, Scheme_Object **argv)
if (SCHEME_INTP(argv[1]) && !SCHEME_INT_VAL(argv[1])) if (SCHEME_INTP(argv[1]) && !SCHEME_INT_VAL(argv[1]))
return argv[0]; return argv[0];
return scheme_stx_phase_shift(argv[0], argv[1], NULL, NULL, NULL, NULL); return scheme_stx_phase_shift(argv[0], argv[1], NULL, NULL, NULL, NULL, NULL);
} }
void scheme_clear_shift_cache(void) void scheme_clear_shift_cache(void)
@ -3029,22 +3049,15 @@ int scheme_stx_has_empty_wraps(Scheme_Object *o)
/* stx comparison */ /* stx comparison */
/*========================================================================*/ /*========================================================================*/
/* If no marks and no rename with this set's tag, static Scheme_Object *get_old_module_env(Scheme_Object *stx)
then it was an unmarked-but-actually-introduced id. */ /* If an identifier has two or more module contexts, return a
representation of the prior contexts. We use the rename's
static Scheme_Object *check_floating_id(Scheme_Object *stx) identity mark or a list of marks to represent the context.
Return #f if there's no old context. */
{ {
/* If `a' has a mzMOD_RENAME_MARKED rename with no following
mzMOD_RENAME_NORMAL using the same set tag, and if there are no
marks after the mzMOD_RENAME_MARKED rename, then we've hit a
corner case: an identifier that was introduced by macro expansion
but marked so that it appears to be original. To ensure that it
gets a generated symbol in the MOD_RENAME_MARKED table, give it a
"floating" binding: scheme_void. This is a rare case, and it more
likely indicates a buggy macro than anything else. */
WRAP_POS awl; WRAP_POS awl;
Scheme_Object *cur_mark = NULL, *searching_identity = NULL, *a; Scheme_Object *a, *last_id = NULL, *cancel_rename_id = scheme_false;
int no_mark_means_floating = 0; Scheme_Object *result_id = scheme_false, *last_pr = NULL, *pr;
WRAP_POS_INIT(awl, ((Scheme_Stx *)stx)->wraps); WRAP_POS_INIT(awl, ((Scheme_Stx *)stx)->wraps);
@ -3069,41 +3082,39 @@ static Scheme_Object *check_floating_id(Scheme_Object *stx)
set_identity = mrns->set_identity; set_identity = mrns->set_identity;
} }
if (SAME_OBJ(set_identity, searching_identity)) if ((kind != mzMOD_RENAME_TOPLEVEL)
searching_identity = NULL; && (!SAME_OBJ(cancel_rename_id, set_identity))) {
if (last_id) {
if (searching_identity) if (!SAME_OBJ(last_id, set_identity)) {
no_mark_means_floating = 1; if (SCHEME_FALSEP(result_id))
result_id = set_identity;
if (kind == mzMOD_RENAME_MARKED) else {
searching_identity = set_identity; if (!SCHEME_PAIRP(result_id)) {
else result_id = scheme_make_pair(result_id, scheme_null);
searching_identity = NULL; last_pr = result_id;
}
} else if (SCHEME_MARKP(a)) { pr = scheme_make_pair(set_identity, scheme_null);
if (SAME_OBJ(a, cur_mark)) SCHEME_CDR(last_pr) = pr;
cur_mark = 0; last_pr = pr;
else { }
if (cur_mark) { }
no_mark_means_floating = 0;
searching_identity = NULL;
} }
cur_mark = a; last_id = set_identity;
} }
} else if (SCHEME_BOXP(a)) {
/* Phase shift: */
Scheme_Object *vec;
vec = SCHEME_BOX_VAL(a);
a = SCHEME_VEC_ELS(vec)[5];
if (!SCHEME_FALSEP(a))
cancel_rename_id = a;
} }
WRAP_POS_INC(awl); WRAP_POS_INC(awl);
} }
if (cur_mark) { return result_id;
no_mark_means_floating = 0;
searching_identity = NULL;
}
if (searching_identity || no_mark_means_floating)
return scheme_void;
return scheme_false;
} }
#define EXPLAIN_RESOLVE 0 #define EXPLAIN_RESOLVE 0
@ -3329,24 +3340,49 @@ static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, Scheme_Object *barrier_env
} }
} }
static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id, Scheme_Object **marks_cache, int depth, static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id,
int *_skipped) Scheme_Object **marks_cache, Scheme_Object *bdg2,
int depth, int *_skipped, int *_bdg_skipped)
{ {
int l1, l2; int l1, l2;
Scheme_Object *m1, *m2; Scheme_Object *m1, *m2, *bdg1;
p = SCHEME_CDR(p); /* skip modidx */ p = SCHEME_CDR(p); /* skip modidx */
p = SCHEME_CDR(p); /* skip phase_export */ p = SCHEME_CDR(p); /* skip phase_export */
if (SCHEME_PAIRP(p)) { if (SCHEME_PAIRP(p)) {
/* has marks */ /* has marks */
int skip = 0; int skip = 0, bdg_skip = 0;
EXPLAIN(fprintf(stderr, "%d has marks\n", depth)); EXPLAIN(fprintf(stderr, "%d has marks\n", depth));
m1 = SCHEME_CAR(p); m1 = SCHEME_CAR(p);
if (*marks_cache) if (SCHEME_VECTORP(m1)) {
bdg1 = SCHEME_VEC_ELS(m1)[1];
m1 = SCHEME_VEC_ELS(m1)[0];
} else
bdg1 = scheme_false;
/* check that bdg1 is a tail of bdg2, first */
while (1) {
if (SAME_OBJ(bdg1, bdg2)
|| (SCHEME_TRUEP(bdg1) && SCHEME_TRUEP(bdg2) && scheme_equal(bdg1, bdg2)))
break;
bdg_skip++;
if (SCHEME_PAIRP(bdg2)) {
bdg2 = SCHEME_CDR(bdg2);
if (SCHEME_PAIRP(bdg2) && SCHEME_NULLP(SCHEME_CDR(bdg2)))
bdg2 = SCHEME_CAR(bdg2);
} else if (SCHEME_FALSEP(bdg2)) {
*_bdg_skipped = -1;
return -1; /* no match */
} else
bdg2 = scheme_false;
}
*_bdg_skipped = bdg_skip;
if (*marks_cache) {
m2 = *marks_cache; m2 = *marks_cache;
else { } else {
EXPLAIN(fprintf(stderr, "%d extract marks\n", depth)); EXPLAIN(fprintf(stderr, "%d extract marks\n", depth));
m2 = scheme_stx_extract_marks(orig_id); m2 = scheme_stx_extract_marks(orig_id);
*marks_cache = m2; *marks_cache = m2;
@ -3390,13 +3426,14 @@ void scheme_populate_pt_ht(Scheme_Module_Phase_Exports * pt) {
static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes,
Scheme_Object *glob_id, Scheme_Object *orig_id, Scheme_Object *glob_id, Scheme_Object *orig_id,
Scheme_Object *bdg,
Scheme_Object **get_names, int get_orig_name, Scheme_Object **get_names, int get_orig_name,
int depth, int depth,
int *_skipped) int *_skipped)
{ {
Scheme_Object *pr, *idx, *pos, *src, *best_match = NULL; Scheme_Object *pr, *idx, *pos, *src, *best_match = NULL;
Scheme_Module_Phase_Exports *pt; Scheme_Module_Phase_Exports *pt;
int i, phase, best_match_len = -1, skip = 0; int i, phase, best_match_len = -1, best_match_bdg_skip = -1, skip = 0, bdg_skip = -1;
Scheme_Object *marks_cache = NULL; Scheme_Object *marks_cache = NULL;
for (pr = shared_pes; !SCHEME_NULLP(pr); pr = SCHEME_CDR(pr)) { for (pr = shared_pes; !SCHEME_NULLP(pr); pr = SCHEME_CDR(pr)) {
@ -3415,13 +3452,16 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes,
pos = scheme_hash_get(pt->ht, glob_id); pos = scheme_hash_get(pt->ht, glob_id);
if (pos) { if (pos) {
/* Found it, maybe. Check marks. */ /* Found it, maybe. Check marks & bdg. */
int mark_len; int mark_len;
EXPLAIN(fprintf(stderr, "%d found %p\n", depth, pos)); EXPLAIN(fprintf(stderr, "%d found %p\n", depth, pos));
mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, depth, &skip); mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, bdg, depth, &skip, &bdg_skip);
if (mark_len > best_match_len) { if (best_match_bdg_skip == -1) best_match_bdg_skip = bdg_skip;
/* Marks match and improve on previously found match. Build suitable rename: */ if ((bdg_skip < best_match_bdg_skip)
|| ((bdg_skip == best_match_bdg_skip) && (mark_len > best_match_len))) {
/* Marks and bdg match and improve on previously found match. Build suitable rename: */
best_match_len = mark_len; best_match_len = mark_len;
best_match_bdg_skip = bdg_skip;
if (_skipped) *_skipped = skip; if (_skipped) *_skipped = skip;
idx = SCHEME_CAR(SCHEME_CAR(pr)); idx = SCHEME_CAR(SCHEME_CAR(pr));
@ -3684,10 +3724,10 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
Scheme_Object *modidx_shift_to = NULL, *modidx_shift_from = NULL; Scheme_Object *modidx_shift_to = NULL, *modidx_shift_from = NULL;
Scheme_Object *rename_stack[QUICK_STACK_SIZE], *rib_delim = scheme_false; Scheme_Object *rename_stack[QUICK_STACK_SIZE], *rib_delim = scheme_false;
int stack_pos = 0, no_lexical = 0; int stack_pos = 0, no_lexical = 0;
int is_in_module = 0, skip_other_mods = 0, floating_checked = 0; int is_in_module = 0, skip_other_mods = 0;
Scheme_Lexical_Rib *rib = NULL, *did_rib = NULL; Scheme_Lexical_Rib *rib = NULL, *did_rib = NULL;
Scheme_Object *phase = orig_phase; Scheme_Object *phase = orig_phase;
Scheme_Object *bdg = NULL, *floating = NULL; Scheme_Object *bdg = NULL;
Scheme_Hash_Table *export_registry = NULL; Scheme_Hash_Table *export_registry = NULL;
int mresult_skipped = -1; int mresult_skipped = -1;
int depends_on_unsealed_rib = 0, mresult_depends_unsealed = 0; int depends_on_unsealed_rib = 0, mresult_depends_unsealed = 0;
@ -3877,13 +3917,8 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
if (!bdg) { if (!bdg) {
EXPLAIN(fprintf(stderr, "%d get bdg\n", depth)); EXPLAIN(fprintf(stderr, "%d get bdg\n", depth));
bdg = resolve_env(a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, NULL); bdg = resolve_env(a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, NULL);
if (SCHEME_FALSEP(bdg)) { if (SCHEME_FALSEP(bdg))
if (!floating_checked) { bdg = get_old_module_env(a);
floating = check_floating_id(a);
floating_checked = 1;
}
bdg = floating;
}
} }
/* Remap id based on marks and rest-of-wraps resolution: */ /* Remap id based on marks and rest-of-wraps resolution: */
glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, &skipped); glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, &skipped);
@ -3927,7 +3962,13 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
get_names_done = 0; get_names_done = 0;
if (!rename) { if (!rename) {
EXPLAIN(fprintf(stderr, "%d in pes\n", depth)); EXPLAIN(fprintf(stderr, "%d in pes\n", depth));
rename = search_shared_pes(mrn->shared_pes, glob_id, a, get_names, 0, depth, &skipped); if (!bdg) {
EXPLAIN(fprintf(stderr, "%d get bdg\n", depth));
bdg = resolve_env(a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, NULL);
if (SCHEME_FALSEP(bdg))
bdg = get_old_module_env(a);
}
rename = search_shared_pes(mrn->shared_pes, glob_id, a, bdg, get_names, 0, depth, &skipped);
if (rename) if (rename)
get_names_done = 1; get_names_done = 1;
} }
@ -4320,10 +4361,10 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
{ {
WRAP_POS wraps; WRAP_POS wraps;
Scheme_Object *result; Scheme_Object *result;
int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL, floating_checked = 0; int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL;
int no_lexical = !free_id_recur; int no_lexical = !free_id_recur;
Scheme_Object *phase = orig_phase; Scheme_Object *phase = orig_phase;
Scheme_Object *bdg = NULL, *floating = NULL; Scheme_Object *bdg = NULL;
result = ((Scheme_Stx *)a)->u.modinfo_cache; result = ((Scheme_Stx *)a)->u.modinfo_cache;
if (result && SAME_OBJ(phase, scheme_make_integer(0))) if (result && SAME_OBJ(phase, scheme_make_integer(0)))
@ -4400,13 +4441,8 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
/* Resolve based on binding ignoring modules: */ /* Resolve based on binding ignoring modules: */
if (!bdg) { if (!bdg) {
bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL); bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL);
if (SCHEME_FALSEP(bdg)) { if (SCHEME_FALSEP(bdg))
if (!floating_checked) { bdg = get_old_module_env(a);
floating = check_floating_id(a);
floating_checked = 1;
}
bdg = floating;
}
} }
/* Remap id based on marks and rest-of-wraps resolution: */ /* Remap id based on marks and rest-of-wraps resolution: */
glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, NULL); glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, NULL);
@ -4438,9 +4474,15 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
if (!rename && mrn->nomarshal_ht) if (!rename && mrn->nomarshal_ht)
rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); rename = scheme_hash_get(mrn->nomarshal_ht, glob_id);
if (!rename) if (!rename) {
result = search_shared_pes(mrn->shared_pes, glob_id, a, NULL, 1, 0, NULL); if (!bdg) {
else { EXPLAIN(fprintf(stderr, "%d get bdg\n", depth));
bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL);
if (SCHEME_FALSEP(bdg))
bdg = get_old_module_env(a);
}
result = search_shared_pes(mrn->shared_pes, glob_id, a, bdg, NULL, 1, 0, NULL);
} else {
/* match; set result: */ /* match; set result: */
if (mrn->kind == mzMOD_RENAME_MARKED) if (mrn->kind == mzMOD_RENAME_MARKED)
skip_other_mods = 1; skip_other_mods = 1;
@ -4738,7 +4780,8 @@ int scheme_stx_ribs_matter(Scheme_Object *a, Scheme_Object *skip_ribs)
} }
Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a) Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a)
/* Returns either false, a lexical-rename symbol, or void for "floating" */ /* Returns either false, a lexical-rename symbol, or an mark/mark-list
for a prior module */
{ {
if (SCHEME_STXP(a)) { if (SCHEME_STXP(a)) {
Scheme_Object *r; Scheme_Object *r;
@ -4746,7 +4789,7 @@ Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a)
r = resolve_env(a, scheme_make_integer(0), 0, NULL, NULL, NULL, NULL, 0, NULL); r = resolve_env(a, scheme_make_integer(0), 0, NULL, NULL, NULL, NULL, 0, NULL);
if (SCHEME_FALSEP(r)) if (SCHEME_FALSEP(r))
r = check_floating_id(a); r = get_old_module_env(a);
if (r) if (r)
return r; return r;
@ -6234,7 +6277,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum,
else else
a = scheme_hash_get(rns, aa); a = scheme_hash_get(rns, aa);
if (!a) { if (!a) {
a = scheme_make_vector(5, NULL); a = scheme_make_vector(6, NULL);
SCHEME_VEC_ELS(a)[0] = SCHEME_VEC_ELS(aa)[0]; SCHEME_VEC_ELS(a)[0] = SCHEME_VEC_ELS(aa)[0];
SCHEME_VEC_ELS(a)[1] = SCHEME_VEC_ELS(aa)[1]; SCHEME_VEC_ELS(a)[1] = SCHEME_VEC_ELS(aa)[1];
SCHEME_VEC_ELS(a)[2] = SCHEME_VEC_ELS(aa)[2]; SCHEME_VEC_ELS(a)[2] = SCHEME_VEC_ELS(aa)[2];
@ -6243,6 +6286,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum,
SCHEME_VEC_ELS(a)[4] = SCHEME_VEC_ELS(aa)[4]; SCHEME_VEC_ELS(a)[4] = SCHEME_VEC_ELS(aa)[4];
else else
SCHEME_VEC_ELS(a)[4] = scheme_false; SCHEME_VEC_ELS(a)[4] = scheme_false;
SCHEME_VEC_ELS(a)[5] = SCHEME_VEC_ELS(aa)[5];
a = scheme_box(a); a = scheme_box(a);
scheme_hash_set(rns, aa, a); scheme_hash_set(rns, aa, a);
} }
@ -6658,7 +6702,7 @@ static Scheme_Object *unmarshal_mark(Scheme_Object *_a, Scheme_Unmarshal_Tables
return n; return n;
} }
#if 0 #if 1
# define return_NULL return (printf("%d\n", __LINE__), NULL) # define return_NULL return (printf("%d\n", __LINE__), NULL)
#else #else
# define return_NULL return NULL # define return_NULL return NULL
@ -6950,13 +6994,21 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
return_NULL; return_NULL;
p = SCHEME_CDR(mli); p = SCHEME_CDR(mli);
if (SCHEME_PAIRP(p) && SCHEME_PAIRP(SCHEME_CAR(p))) { if (SCHEME_PAIRP(p) && (SCHEME_PAIRP(SCHEME_CAR(p))
/* list of marks: */ || SCHEME_VECTORP(SCHEME_CAR(p)))) {
Scheme_Object *m_first = scheme_null, *m_last = NULL, *mp, *after_marks; /* list of marks or a vector of marks and bdg: */
Scheme_Object *m_first = scheme_null, *m_last = NULL, *mp, *after_marks, *bdg;
after_marks = SCHEME_CDR(p); after_marks = SCHEME_CDR(p);
mli = SCHEME_CAR(p); mli = SCHEME_CAR(p);
if (SCHEME_VECTORP(mli)) {
if (SCHEME_VEC_SIZE(mli) != 2) return_NULL;
bdg = SCHEME_VEC_ELS(mli)[1];
mli = SCHEME_VEC_ELS(mli)[0];
} else
bdg = NULL;
while (SCHEME_PAIRP(mli)) { while (SCHEME_PAIRP(mli)) {
p = SCHEME_CAR(mli); p = SCHEME_CAR(mli);
p = unmarshal_mark(p, ut); p = unmarshal_mark(p, ut);
@ -6971,13 +7023,45 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
mli = SCHEME_CDR(mli); mli = SCHEME_CDR(mli);
} }
if (!SCHEME_NULLP(mli)) return_NULL;
mli = m_first;
if (bdg) {
if (!SCHEME_SYMBOLP(bdg) && !SCHEME_FALSEP(bdg)) {
if (SCHEME_MARKP(bdg))
bdg = unmarshal_mark(bdg, ut);
else {
m_first = scheme_null;
m_last = NULL;
while (SCHEME_PAIRP(bdg)) {
p = SCHEME_CAR(bdg);
if (!SCHEME_MARKP(p)) return_NULL;
p = unmarshal_mark(p, ut);
mp = scheme_make_pair(p, scheme_null);
if (m_last)
SCHEME_CDR(m_last) = mp;
else
m_first = mp;
m_last = mp;
bdg = SCHEME_CDR(bdg);
}
if (!SCHEME_NULLP(bdg)
|| !SCHEME_PAIRP(m_first)
|| !SCHEME_PAIRP(SCHEME_CDR(m_first)))
return_NULL;
bdg = m_first;
}
}
mli = scheme_make_vector(2, mli);
SCHEME_VEC_ELS(mli)[1] = bdg;
}
/* Rebuild for unmarshaled marks: */ /* Rebuild for unmarshaled marks: */
ai = scheme_make_pair(SCHEME_CAR(ai), ai = scheme_make_pair(SCHEME_CAR(ai),
scheme_make_pair(SCHEME_CADR(ai), scheme_make_pair(SCHEME_CADR(ai),
scheme_make_pair(m_first, after_marks))); scheme_make_pair(mli, after_marks)));
if (!SCHEME_NULLP(mli)) return_NULL;
p = after_marks; p = after_marks;
} }
@ -7075,7 +7159,24 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
if (SCHEME_VECTORP(a)) { if (SCHEME_VECTORP(a)) {
if (SCHEME_VEC_SIZE(a) != 2) return_NULL; if (SCHEME_VEC_SIZE(a) != 2) return_NULL;
bdg = SCHEME_VEC_ELS(a)[1]; bdg = SCHEME_VEC_ELS(a)[1];
if (!SCHEME_SYMBOLP(bdg) && !SCHEME_VOIDP(bdg)) return_NULL; if (SCHEME_SYMBOLP(bdg)) {
/* ok */
} else if (SCHEME_MARKP(bdg)) {
bdg = unmarshal_mark(bdg, ut);
} else {
Scheme_Object *bl = scheme_null;
while (SCHEME_PAIRP(bdg)) {
if (SCHEME_MARKP(SCHEME_CAR(bdg)))
bl = scheme_make_pair(unmarshal_mark(SCHEME_CAR(bdg), ut),
bl);
else
break;
bdg = SCHEME_CDR(bdg);
}
if (!SCHEME_NULLP(bdg))
return_NULL;
bdg = scheme_reverse(bl);
}
a = SCHEME_VEC_ELS(a)[0]; a = SCHEME_VEC_ELS(a)[0];
} }
@ -7139,10 +7240,16 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
a = make_prune_context(SCHEME_BOX_VAL(a)); a = make_prune_context(SCHEME_BOX_VAL(a));
} else { } else {
/* must be a phase shift */ /* must be a phase shift */
Scheme_Object *vec; Scheme_Object *vec, *cancel_id;
vec = SCHEME_BOX_VAL(a); vec = SCHEME_BOX_VAL(a);
if (!SCHEME_VECTORP(vec)) return_NULL; if (!SCHEME_VECTORP(vec)) return_NULL;
if (SCHEME_VEC_SIZE(vec) != 5) return_NULL; if (SCHEME_VEC_SIZE(vec) != 6) return_NULL;
cancel_id = SCHEME_VEC_ELS(vec)[5];
if (SCHEME_TRUEP(cancel_id)) {
cancel_id = unmarshal_mark(cancel_id, ut);
SCHEME_VEC_ELS(vec)[5] = cancel_id;
}
} }
} else { } else {
return_NULL; return_NULL;
@ -8400,7 +8507,7 @@ static Scheme_Object *identifier_prune_to_module(int argc, Scheme_Object **argv)
/* Phase shift: */ /* Phase shift: */
Scheme_Object *vec, *src; Scheme_Object *vec, *src;
vec = SCHEME_PTR_VAL(WRAP_POS_FIRST(w)); vec = SCHEME_BOX_VAL(WRAP_POS_FIRST(w));
src = SCHEME_VEC_ELS(vec)[1]; src = SCHEME_VEC_ELS(vec)[1];