refine lexical scope for syntax objects from different modules
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
parent
2f9a0f4b94
commit
d836cba7c9
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -1085,12 +1085,12 @@ 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 */
|
||||
/* 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);
|
||||
|
|
@ -1101,7 +1101,8 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
|
|||
} else
|
||||
abdg = NULL;
|
||||
|
||||
if (SAME_OBJ(abdg, bdg)) {
|
||||
if (SAME_OBJ(abdg, bdg)
|
||||
|| (bdg && abdg && scheme_equal(abdg, bdg))) {
|
||||
if (mode > 0) {
|
||||
if (scheme_equal(amarks, marks)) {
|
||||
best_match = SCHEME_CDR(a);
|
||||
|
|
@ -1144,6 +1145,18 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec
|
|||
}
|
||||
}
|
||||
|
||||
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 (mode <= 0) {
|
||||
return sym;
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
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 (cur_mark) {
|
||||
no_mark_means_floating = 0;
|
||||
searching_identity = NULL;
|
||||
if (!SCHEME_PAIRP(result_id)) {
|
||||
result_id = scheme_make_pair(result_id, scheme_null);
|
||||
last_pr = result_id;
|
||||
}
|
||||
cur_mark = a;
|
||||
pr = scheme_make_pair(set_identity, scheme_null);
|
||||
SCHEME_CDR(last_pr) = pr;
|
||||
last_pr = pr;
|
||||
}
|
||||
}
|
||||
}
|
||||
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];
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user