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

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

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,
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,
163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,95,1,128,
1,161,1,220,1,19,2,97,2,152,2,157,2,177,2,70,3,90,3,142,3,
208,3,97,4,239,4,36,5,47,5,126,5,0,0,88,7,0,0,69,35,37,
163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,96,1,129,
1,162,1,221,1,21,2,99,2,155,2,160,2,180,2,73,3,93,3,145,3,
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,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,
@ -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,
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,
8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14,
2,2,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,150,
4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248,
22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,2,
18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22,
157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75,
194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,74,
199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2,
2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101,
110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,49,53,
53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,159,37,
36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,158,39,
36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201,
251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,100,11,
13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11,
11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,2,21,3,
1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,157,4,194,
249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,157,
4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,151,4,248,
22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33,
40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22,83,249,22,
83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2,22,74,23,
204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249,22,2,22,
98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36,37,47,11,
9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248,22,157,4,
194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,
157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24,249,22,2,
32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248,22,74,201,
248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4,248,22,74,
195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248,
22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84,2,10,248,
22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1,27,249,22,
1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248,22,177,4,
249,22,150,4,80,158,41,36,251,22,83,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,26,250,22,84,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,26,202,250,22,84,2,22,
9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,
159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248,22,74,197,
28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22,83,2,22,
248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,3,249,22,
83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18,
28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,10,248,22,
74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,22,75,202,
99,13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,
11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,11,11,2,21,
3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,111,105,100,8,
48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,36,28,248,22,
58,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,28,248,22,83,
248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,113,
159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2,9,9,11,11,
11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39,36,16,0,36,
16,0,36,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,36,
46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0,16,0,36,36,
11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,20,15,16,2,
20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1,2,13,16,1,
33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0,33,34,36,20,
113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8,36,37,53,37,
9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,9,
88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36,16,1,2,13,
16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,223,0,33,38,
36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2,11,88,163,8,
36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2,13,16,0,11,
16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36,20,113,159,36,
16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54,37,9,223,0,
33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,4,88,163,8,
36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2,13,16,0,11,
16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36,20,113,159,36,
16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36,37,54,37,9,
223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16,0,94,2,16,
2,17,93,2,16,9,9,36,0};
EVAL_ONE_SIZED_STR((char *)expr, 2024);
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,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,
150,4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,
248,22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,
2,18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,
22,157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,
75,194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,
74,199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,6,36,2,14,
2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,
8,101,110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,
49,53,53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,
159,37,36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,
158,39,36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,
74,201,251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,
100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29,
16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,
2,21,3,1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,
157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,
248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,
151,4,248,22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,
9,222,33,40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22,
83,249,22,83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2,
22,74,23,204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249,
22,2,22,98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36,
37,47,11,9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248,
22,157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,
75,248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24,
249,22,2,32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248,
22,74,201,248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4,
248,22,74,195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2,
22,9,248,22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84,
2,10,248,22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1,
27,249,22,1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248,
22,177,4,249,22,150,4,80,158,41,36,251,22,83,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,26,250,22,
84,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,26,202,250,22,
84,2,22,9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81,
193,20,14,159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248,
22,74,197,28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22,
83,2,22,248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,
3,249,22,83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,
83,2,18,28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,
10,248,22,74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,
22,75,202,99,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,
8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,
11,11,2,21,3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,
111,105,100,8,48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,
36,28,248,22,58,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,
28,248,22,83,248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202,
159,36,20,113,159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2,
9,9,11,11,11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39,
36,16,0,36,16,0,36,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,36,46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0,
16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,
20,15,16,2,20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1,
2,13,16,1,33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0,
33,34,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8,
36,37,53,37,9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11,
16,5,2,9,88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36,
16,1,2,13,16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,
223,0,33,38,36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2,
11,88,163,8,36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2,
13,16,0,11,16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36,
20,113,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54,
37,9,223,0,33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,
4,88,163,8,36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2,
13,16,0,11,16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36,
20,113,159,36,16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36,
37,54,37,9,223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16,
0,94,2,16,2,17,93,2,16,9,9,36,0};
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,
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,
@ -600,7 +600,7 @@
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,
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,
@ -627,7 +627,7 @@
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,
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,
@ -984,7 +984,7 @@
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,
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,

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) {
form = scheme_add_rename(form, genv->rename_set);
/* 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;
@ -3811,7 +3811,7 @@ static void *compile_k(void)
genv->module->me->src_modidx,
genv->module->self_modidx,
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++) {
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;
}
@ -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),
src_modidx, now_modidx,
genv ? genv->module_registry->exports : NULL,
insp);
insp, NULL);
if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) {
/* Put lazy-shift info in pf->a[i]: */
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(0),
scheme_null,
NULL,
1);
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,
scheme_make_integer(0),
scheme_null,
NULL,
1);
}
@ -6287,24 +6289,24 @@ static Scheme_Object *annotate_existing_submodules(Scheme_Object *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))
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,
Scheme_Object *old_midx, Scheme_Object *new_midx)
Scheme_Object *ps)
{
if (!a) {
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) {
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);
@ -6312,15 +6314,13 @@ static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Objec
if (SCHEME_PAIRP(orig))
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);
}
static Scheme_Object *phase_shift_skip_submodules_k(void);
static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm,
Scheme_Object *old_midx, Scheme_Object *new_midx,
int phase)
static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, Scheme_Object *ps, int phase)
{
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;
p->ku.k.p1 = (void *)fm;
p->ku.k.p2 = (void *)old_midx;
p->ku.k.p3 = (void *)new_midx;
p->ku.k.p2 = (void *)ps;
p->ku.k.i1 = phase;
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);
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)) {
return scheme_stx_phase_shift(fm, NULL, old_midx, new_midx, NULL, NULL);
return scheme_add_rename(fm, ps);
} else {
v3 = rebuild_with_phase_shift(v3, NULL, naya, old_midx, new_midx);
v2 = rebuild_with_phase_shift(v2, v3, NULL, old_midx, new_midx);
v1 = rebuild_with_phase_shift(v1, NULL, v2, old_midx, new_midx);
v0 = rebuild_with_phase_shift(v0, NULL, v1, old_midx, new_midx);
return rebuild_with_phase_shift(fm, NULL, v0, old_midx, new_midx);
v3 = rebuild_with_phase_shift(v3, NULL, naya, ps);
v2 = rebuild_with_phase_shift(v2, v3, NULL, ps);
v1 = rebuild_with_phase_shift(v1, NULL, v2, ps);
v0 = rebuild_with_phase_shift(v0, NULL, v1, ps);
return rebuild_with_phase_shift(fm, NULL, v0, ps);
}
} else if (SCHEME_STX_NULLP(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)) {
/* found a submodule */
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))
naya = phase_shift_tail(naya, old_midx, new_midx);
return rebuild_with_phase_shift(fm, v1, naya, old_midx, new_midx);
naya = phase_shift_tail(naya, ps);
return rebuild_with_phase_shift(fm, v1, naya, ps);
} else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, v2, phase)) {
/* 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);
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))
return fm;
else {
if (SAME_OBJ(v2, v3))
v3 = phase_shift_tail(v3, old_midx, new_midx);
return rebuild_with_phase_shift(fm, naya, v3, old_midx, new_midx);
v3 = phase_shift_tail(v3, ps);
return rebuild_with_phase_shift(fm, naya, v3, ps);
}
}
}
}
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))
return fm;
else {
v1 = scheme_stx_phase_shift(v1, NULL, old_midx, new_midx, NULL, NULL);
return rebuild_with_phase_shift(fm, v1, v4, old_midx, new_midx);
v1 = scheme_add_rename(v1, ps);
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_Object *fm = (Scheme_Object *)p->ku.k.p1;
Scheme_Object *old_midx = (Scheme_Object *)p->ku.k.p2;
Scheme_Object *new_midx = (Scheme_Object *)p->ku.k.p3;
Scheme_Object *ps = (Scheme_Object *)p->ku.k.p2;
p->ku.k.p1 = 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)
@ -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,
top_env->module->self_modidx, iidx,
menv->module_registry->exports,
env->insp);
env->insp, NULL);
super_bxs_info = MALLOC_N(void*, 6);
super_bxs_info[0] = super_bxs;
@ -6730,13 +6727,13 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env,
if (ii) {
/* 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);
} else {
if (skip_strip) {
/* 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;
} else {
Scheme_Object *hints, *formname;
Scheme_Object *hints, *formname, *ps;
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: */
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 '() */
fm = phase_shift_skip_submodules(fm, self_modidx, this_empty_self_modidx, -1);
fm = phase_shift_skip_submodules(fm, ps, -1);
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 */
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;
int *exets;
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;
int k, skip_rename, do_copy_vars;
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
leads to generated local names). */
context_marks = scheme_stx_extract_marks(mark_src);
has_context = !SCHEME_NULLP(context_marks);
if (!has_context) {
if (SCHEME_TRUEP(scheme_stx_moduleless_env(mark_src))) {
has_context = 1;
}
}
bdg = scheme_stx_moduleless_env(mark_src);
has_context = !SCHEME_NULLP(context_marks) || !SCHEME_FALSEP(bdg);
if (has_context) {
if (all_simple)
*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: */
if (!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;
} else
skip_rename = 0;
@ -10663,7 +10658,8 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */
{
Scheme_Object *l;
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: */
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
context, which means that we need to generate a name. */
iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0);
iname = scheme_tl_id_sym(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)
*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_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_Env *env;
int share_all;
@ -10820,12 +10816,19 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
pt_phase = SCHEME_CAR(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);
info = SCHEME_CDR(info);
} else
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)
|| SCHEME_FALSEP(info)) {
share_all = 1;
@ -10893,11 +10896,11 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info,
if (pt) {
if (!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 {
if (!SCHEME_NULLP(marks))
scheme_signal_error("internal error: unexpected marks");
if (!SCHEME_NULLP(marks) || SCHEME_TRUEP(bdg))
scheme_signal_error("internal error: unexpected marks/bdg");
add_single_require(me, pt_phase, src_phase_index, orig_idx, NULL,
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,
Scheme_Object *unmarshal_phase_index,
Scheme_Object *src_phase_index,
Scheme_Object *marks,
Scheme_Object *marks, Scheme_Object *bdg,
int save_unmarshal);
void scheme_save_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 *new_insp);
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_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 *old_midx, Scheme_Object *new_midx,
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 *old_midx, Scheme_Object *new_midx,
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_proper_list_length(Scheme_Object *list);

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.3.0.6"
#define MZSCHEME_VERSION "5.3.0.7"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 3
#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_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_Object *shared_pes; /* list of (cons modidx (cons phase_export phase_and_marks))
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 */
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
@ -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
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
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
versus list-of-element.]
@ -764,7 +768,7 @@ static int maybe_add_chain_cache(Scheme_Stx *stx)
if (SCHEME_VECTORP(p)) {
skipable++;
} 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)) {
/* Hack: we store the depth of the table in the chain
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)
{
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 *src_phase_index,
Scheme_Object *marks,
Scheme_Object *bdg,
int save_unmarshal)
{
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);
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);
else
} else
index_plus_marks = src_phase_index;
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_Hash_Table *export_registry, Scheme_Object *insp)
Scheme_Hash_Table *export_registry, Scheme_Object *insp,
Scheme_Object *ignore_old_identity)
{
if (!shift)
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)[2] == (new_midx ? new_midx : 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 */
} else {
vec = scheme_make_vector(5, NULL);
vec = scheme_make_vector(6, NULL);
SCHEME_VEC_ELS(vec)[0] = shift;
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)[3] = (export_registry ? (Scheme_Object *)export_registry : 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);
}
@ -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 *old_midx, Scheme_Object *new_midx,
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
used just to re-direct relative module paths. new_midx might be
NULL to shift without redirection. And so on. */
{
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)
return scheme_add_rename(stx, ps);
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]))
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)
@ -3029,22 +3049,15 @@ int scheme_stx_has_empty_wraps(Scheme_Object *o)
/* stx comparison */
/*========================================================================*/
/* If no marks and no rename with this set's tag,
then it was an unmarked-but-actually-introduced id. */
static Scheme_Object *check_floating_id(Scheme_Object *stx)
static Scheme_Object *get_old_module_env(Scheme_Object *stx)
/* If an identifier has two or more module contexts, return a
representation of the prior contexts. We use the rename's
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;
Scheme_Object *cur_mark = NULL, *searching_identity = NULL, *a;
int no_mark_means_floating = 0;
Scheme_Object *a, *last_id = NULL, *cancel_rename_id = scheme_false;
Scheme_Object *result_id = scheme_false, *last_pr = NULL, *pr;
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;
}
if (SAME_OBJ(set_identity, searching_identity))
searching_identity = NULL;
if (searching_identity)
no_mark_means_floating = 1;
if (kind == mzMOD_RENAME_MARKED)
searching_identity = set_identity;
else
searching_identity = NULL;
} else if (SCHEME_MARKP(a)) {
if (SAME_OBJ(a, cur_mark))
cur_mark = 0;
else {
if (cur_mark) {
no_mark_means_floating = 0;
searching_identity = NULL;
if ((kind != mzMOD_RENAME_TOPLEVEL)
&& (!SAME_OBJ(cancel_rename_id, set_identity))) {
if (last_id) {
if (!SAME_OBJ(last_id, set_identity)) {
if (SCHEME_FALSEP(result_id))
result_id = set_identity;
else {
if (!SCHEME_PAIRP(result_id)) {
result_id = scheme_make_pair(result_id, scheme_null);
last_pr = result_id;
}
pr = scheme_make_pair(set_identity, scheme_null);
SCHEME_CDR(last_pr) = pr;
last_pr = pr;
}
}
}
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);
}
if (cur_mark) {
no_mark_means_floating = 0;
searching_identity = NULL;
}
if (searching_identity || no_mark_means_floating)
return scheme_void;
return scheme_false;
return result_id;
}
#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,
int *_skipped)
static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id,
Scheme_Object **marks_cache, Scheme_Object *bdg2,
int depth, int *_skipped, int *_bdg_skipped)
{
int l1, l2;
Scheme_Object *m1, *m2;
Scheme_Object *m1, *m2, *bdg1;
p = SCHEME_CDR(p); /* skip modidx */
p = SCHEME_CDR(p); /* skip phase_export */
if (SCHEME_PAIRP(p)) {
/* has marks */
int skip = 0;
int skip = 0, bdg_skip = 0;
EXPLAIN(fprintf(stderr, "%d has marks\n", depth));
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;
else {
} else {
EXPLAIN(fprintf(stderr, "%d extract marks\n", depth));
m2 = scheme_stx_extract_marks(orig_id);
*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,
Scheme_Object *glob_id, Scheme_Object *orig_id,
Scheme_Object *bdg,
Scheme_Object **get_names, int get_orig_name,
int depth,
int *_skipped)
{
Scheme_Object *pr, *idx, *pos, *src, *best_match = NULL;
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;
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);
if (pos) {
/* Found it, maybe. Check marks. */
/* Found it, maybe. Check marks & bdg. */
int mark_len;
EXPLAIN(fprintf(stderr, "%d found %p\n", depth, pos));
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: */
mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, bdg, depth, &skip, &bdg_skip);
if (best_match_bdg_skip == -1) best_match_bdg_skip = bdg_skip;
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_bdg_skip = bdg_skip;
if (_skipped) *_skipped = skip;
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 *rename_stack[QUICK_STACK_SIZE], *rib_delim = scheme_false;
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_Object *phase = orig_phase;
Scheme_Object *bdg = NULL, *floating = NULL;
Scheme_Object *bdg = NULL;
Scheme_Hash_Table *export_registry = NULL;
int mresult_skipped = -1;
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) {
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)) {
if (!floating_checked) {
floating = check_floating_id(a);
floating_checked = 1;
}
bdg = floating;
}
if (SCHEME_FALSEP(bdg))
bdg = get_old_module_env(a);
}
/* 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);
@ -3927,7 +3962,13 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase,
get_names_done = 0;
if (!rename) {
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)
get_names_done = 1;
}
@ -4320,10 +4361,10 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
{
WRAP_POS wraps;
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;
Scheme_Object *phase = orig_phase;
Scheme_Object *bdg = NULL, *floating = NULL;
Scheme_Object *bdg = NULL;
result = ((Scheme_Stx *)a)->u.modinfo_cache;
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: */
if (!bdg) {
bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL);
if (SCHEME_FALSEP(bdg)) {
if (!floating_checked) {
floating = check_floating_id(a);
floating_checked = 1;
}
bdg = floating;
}
if (SCHEME_FALSEP(bdg))
bdg = get_old_module_env(a);
}
/* 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);
@ -4438,9 +4474,15 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_
if (!rename && mrn->nomarshal_ht)
rename = scheme_hash_get(mrn->nomarshal_ht, glob_id);
if (!rename)
result = search_shared_pes(mrn->shared_pes, glob_id, a, NULL, 1, 0, NULL);
else {
if (!rename) {
if (!bdg) {
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: */
if (mrn->kind == mzMOD_RENAME_MARKED)
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)
/* 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)) {
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);
if (SCHEME_FALSEP(r))
r = check_floating_id(a);
r = get_old_module_env(a);
if (r)
return r;
@ -6234,7 +6277,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum,
else
a = scheme_hash_get(rns, aa);
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)[1] = SCHEME_VEC_ELS(aa)[1];
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];
else
SCHEME_VEC_ELS(a)[4] = scheme_false;
SCHEME_VEC_ELS(a)[5] = SCHEME_VEC_ELS(aa)[5];
a = scheme_box(a);
scheme_hash_set(rns, aa, a);
}
@ -6658,7 +6702,7 @@ static Scheme_Object *unmarshal_mark(Scheme_Object *_a, Scheme_Unmarshal_Tables
return n;
}
#if 0
#if 1
# define return_NULL return (printf("%d\n", __LINE__), NULL)
#else
# define return_NULL return NULL
@ -6950,13 +6994,21 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
return_NULL;
p = SCHEME_CDR(mli);
if (SCHEME_PAIRP(p) && SCHEME_PAIRP(SCHEME_CAR(p))) {
/* list of marks: */
Scheme_Object *m_first = scheme_null, *m_last = NULL, *mp, *after_marks;
if (SCHEME_PAIRP(p) && (SCHEME_PAIRP(SCHEME_CAR(p))
|| SCHEME_VECTORP(SCHEME_CAR(p)))) {
/* 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);
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)) {
p = SCHEME_CAR(mli);
p = unmarshal_mark(p, ut);
@ -6971,13 +7023,45 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
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: */
ai = scheme_make_pair(SCHEME_CAR(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;
}
@ -7075,7 +7159,24 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
if (SCHEME_VECTORP(a)) {
if (SCHEME_VEC_SIZE(a) != 2) return_NULL;
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];
}
@ -7139,10 +7240,16 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w,
a = make_prune_context(SCHEME_BOX_VAL(a));
} else {
/* must be a phase shift */
Scheme_Object *vec;
Scheme_Object *vec, *cancel_id;
vec = SCHEME_BOX_VAL(a);
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 {
return_NULL;
@ -8400,7 +8507,7 @@ static Scheme_Object *identifier_prune_to_module(int argc, Scheme_Object **argv)
/* Phase shift: */
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];