diff --git a/src/mzscheme/include/scheme.h b/src/mzscheme/include/scheme.h index db193f31da..d924b5952f 100644 --- a/src/mzscheme/include/scheme.h +++ b/src/mzscheme/include/scheme.h @@ -790,7 +790,7 @@ typedef struct { typedef struct Scheme_Hash_Table { - Scheme_Inclhash_Object iso; + Scheme_Inclhash_Object iso; /* 0x1 flag => marshal as #t (hack for stxobj bytecode) */ int size; /* power of 2 */ int count; Scheme_Object **keys; @@ -1024,6 +1024,7 @@ typedef struct Scheme_Thread { struct Scheme_Marshal_Tables *current_mt; Scheme_Object *constant_folding; /* compiler hack */ + Scheme_Object *reading_delayed; /* reader hack */ Scheme_Object *(*overflow_k)(void); Scheme_Object *overflow_reply; diff --git a/src/mzscheme/src/cstartup.inc b/src/mzscheme/src/cstartup.inc index 57e3464d2a..1f54490d79 100644 --- a/src/mzscheme/src/cstartup.inc +++ b/src/mzscheme/src/cstartup.inc @@ -1,5 +1,5 @@ { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,52,46,50,50,0,0,0,1,0,0,3,0,12,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,50,50,0,0,0,1,0,0,3,0,12,0, 17,0,20,0,27,0,40,0,47,0,51,0,58,0,63,0,68,0,72,0,78, 0,92,0,106,0,109,0,115,0,119,0,121,0,132,0,134,0,148,0,155,0, 177,0,179,0,193,0,253,0,23,1,32,1,41,1,51,1,87,1,126,1,165, @@ -14,13 +14,13 @@ 115,61,120,73,108,101,116,114,101,99,45,118,97,108,117,101,115,66,108,97,109, 98,100,97,1,20,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110, 45,107,101,121,61,118,73,100,101,102,105,110,101,45,118,97,108,117,101,115,98, -10,35,11,8,134,228,94,159,2,15,35,35,159,2,14,35,35,16,20,2,3, +10,35,11,8,148,228,94,159,2,15,35,35,159,2,14,35,35,16,20,2,3, 2,1,2,5,2,1,2,6,2,1,2,7,2,1,2,8,2,1,2,9,2, 1,2,10,2,1,2,4,2,1,2,11,2,1,2,12,2,1,97,36,11,8, -134,228,93,159,2,14,35,36,16,2,2,2,161,2,1,36,2,2,2,1,2, -2,97,10,11,11,8,134,228,16,0,97,10,37,11,8,134,228,16,0,13,16, +148,228,93,159,2,14,35,36,16,2,2,2,161,2,1,36,2,2,2,1,2, +2,97,10,11,11,8,148,228,16,0,97,10,37,11,8,148,228,16,0,13,16, 4,35,29,11,11,2,1,11,18,16,2,99,64,104,101,114,101,8,31,8,30, -8,29,8,28,8,27,93,8,224,13,57,0,0,95,9,8,224,13,57,0,0, +8,29,8,28,8,27,93,8,224,27,57,0,0,95,9,8,224,27,57,0,0, 2,1,27,248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251,22,75, 2,16,248,22,90,23,200,2,12,249,22,65,2,17,248,22,92,23,202,1,27, 248,22,135,4,23,196,1,249,22,128,4,80,158,38,35,251,22,75,2,16,248, @@ -29,16 +29,16 @@ 248,22,73,248,22,67,23,195,2,248,22,66,193,249,22,128,4,80,158,38,35, 251,22,75,2,16,248,22,66,23,200,2,249,22,65,2,12,248,22,67,23,202, 1,11,18,16,2,101,10,8,31,8,30,8,29,8,28,8,27,16,4,11,11, -2,18,3,1,7,101,110,118,57,55,57,53,16,4,11,11,2,19,3,1,7, -101,110,118,57,55,57,54,93,8,224,14,57,0,0,95,9,8,224,14,57,0, +2,18,3,1,7,101,110,118,57,56,48,52,16,4,11,11,2,19,3,1,7, +101,110,118,57,56,48,53,93,8,224,28,57,0,0,95,9,8,224,28,57,0, 0,2,1,27,248,22,67,248,22,135,4,23,197,1,28,248,22,73,23,194,2, 20,15,159,36,35,36,28,248,22,73,248,22,67,23,195,2,248,22,66,193,249, 22,128,4,80,158,38,35,250,22,75,2,20,248,22,75,249,22,75,248,22,75, 2,21,248,22,66,23,202,2,251,22,75,2,16,2,21,2,21,249,22,65,2, 4,248,22,67,23,205,1,18,16,2,101,11,8,31,8,30,8,29,8,28,8, -27,16,4,11,11,2,18,3,1,7,101,110,118,57,55,57,56,16,4,11,11, -2,19,3,1,7,101,110,118,57,55,57,57,93,8,224,15,57,0,0,95,9, -8,224,15,57,0,0,2,1,248,22,135,4,193,27,248,22,135,4,194,249,22, +27,16,4,11,11,2,18,3,1,7,101,110,118,57,56,48,55,16,4,11,11, +2,19,3,1,7,101,110,118,57,56,48,56,93,8,224,29,57,0,0,95,9, +8,224,29,57,0,0,2,1,248,22,135,4,193,27,248,22,135,4,194,249,22, 65,248,22,75,248,22,66,196,248,22,67,195,27,248,22,67,248,22,135,4,23, 197,1,249,22,128,4,80,158,38,35,28,248,22,53,248,22,129,4,248,22,66, 23,198,2,27,249,22,2,32,0,89,162,8,44,36,42,9,222,33,39,248,22, @@ -68,9 +68,9 @@ 249,22,164,8,248,22,129,4,248,22,66,23,201,2,64,101,108,115,101,10,248, 22,66,23,198,2,250,22,76,2,20,9,248,22,67,23,201,1,249,22,65,2, 3,248,22,67,23,203,1,100,8,31,8,30,8,29,8,28,8,27,16,4,11, -11,2,18,3,1,7,101,110,118,57,56,50,49,16,4,11,11,2,19,3,1, -7,101,110,118,57,56,50,50,93,8,224,16,57,0,0,18,16,2,158,94,10, -64,118,111,105,100,8,47,95,9,8,224,16,57,0,0,2,1,27,248,22,67, +11,2,18,3,1,7,101,110,118,57,56,51,48,16,4,11,11,2,19,3,1, +7,101,110,118,57,56,51,49,93,8,224,30,57,0,0,18,16,2,158,94,10, +64,118,111,105,100,8,47,95,9,8,224,30,57,0,0,2,1,27,248,22,67, 248,22,135,4,196,249,22,128,4,80,158,38,35,28,248,22,53,248,22,129,4, 248,22,66,197,250,22,75,2,26,248,22,75,248,22,66,199,248,22,90,198,27, 248,22,129,4,248,22,66,197,250,22,75,2,26,248,22,75,248,22,66,197,250, @@ -100,7 +100,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 2045); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,52,46,50,59,0,0,0,1,0,0,13,0,18,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,50,59,0,0,0,1,0,0,13,0,18,0, 35,0,50,0,68,0,84,0,94,0,112,0,132,0,148,0,166,0,197,0,226, 0,248,0,6,1,12,1,26,1,31,1,41,1,49,1,77,1,109,1,154,1, 199,1,223,1,6,2,8,2,65,2,155,3,196,3,31,5,135,5,239,5,100, @@ -342,12 +342,12 @@ EVAL_ONE_SIZED_STR((char *)expr, 5009); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,52,46,50,8,0,0,0,1,0,0,6,0,19,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,50,8,0,0,0,1,0,0,6,0,19,0, 34,0,48,0,62,0,76,0,111,0,0,0,1,1,0,0,65,113,117,111,116, 101,29,94,2,1,67,35,37,117,116,105,108,115,11,29,94,2,1,69,35,37, 110,101,116,119,111,114,107,11,29,94,2,1,68,35,37,112,97,114,97,109,122, 11,29,94,2,1,68,35,37,101,120,112,111,98,115,11,29,94,2,1,68,35, -37,107,101,114,110,101,108,11,98,10,35,11,8,140,230,97,159,2,2,35,35, +37,107,101,114,110,101,108,11,98,10,35,11,8,154,230,97,159,2,2,35,35, 159,2,3,35,35,159,2,4,35,35,159,2,5,35,35,159,2,6,35,35,16, 0,159,35,20,103,159,35,16,1,11,16,0,83,158,41,20,100,143,69,35,37, 98,117,105,108,116,105,110,29,11,11,11,10,10,18,96,11,42,42,42,35,80, @@ -360,12 +360,12 @@ EVAL_ONE_SIZED_STR((char *)expr, 294); } { - static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,52,46,50,52,0,0,0,1,0,0,11,0,38,0, + static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,52,46,49,46,53,46,50,52,0,0,0,1,0,0,11,0,38,0, 44,0,57,0,71,0,93,0,119,0,131,0,149,0,169,0,181,0,197,0,220, 0,0,1,5,1,10,1,15,1,24,1,29,1,60,1,64,1,72,1,81,1, -89,1,196,1,241,1,5,2,34,2,65,2,121,2,131,2,178,2,188,2,195, -2,82,4,95,4,114,4,233,4,245,4,141,5,155,5,21,6,27,6,41,6, -68,6,153,6,155,6,221,6,166,12,225,12,3,13,0,0,138,15,0,0,70, +89,1,192,1,237,1,1,2,30,2,61,2,117,2,127,2,174,2,184,2,191, +2,78,4,91,4,110,4,229,4,241,4,137,5,151,5,17,6,23,6,37,6, +64,6,149,6,151,6,217,6,162,12,221,12,255,12,0,0,134,15,0,0,70, 100,108,108,45,115,117,102,102,105,120,1,25,100,101,102,97,117,108,116,45,108, 111,97,100,47,117,115,101,45,99,111,109,112,105,108,101,100,65,113,117,111,116, 101,29,94,2,3,67,35,37,117,116,105,108,115,11,29,94,2,3,68,35,37, @@ -383,178 +383,178 @@ 45,109,111,100,117,108,101,45,110,97,109,101,45,114,101,115,111,108,118,101,114, 63,108,105,98,67,105,103,110,111,114,101,100,249,22,14,195,80,159,37,45,37, 249,80,159,37,48,36,195,10,27,28,23,195,2,28,249,22,164,8,23,197,2, -80,159,38,46,37,87,94,23,195,1,80,159,36,47,37,27,248,22,173,4,23, -197,2,28,248,22,139,13,23,194,2,91,159,38,11,90,161,38,35,11,248,22, -160,13,23,197,1,87,95,83,160,37,11,80,159,40,46,37,198,83,160,37,11, -80,159,40,47,37,192,192,11,11,28,23,193,2,192,87,94,23,193,1,27,247, -22,191,4,28,192,192,247,22,179,13,20,14,159,80,158,35,39,250,80,158,38, -40,249,22,27,11,80,158,40,39,22,191,4,28,248,22,139,13,23,198,2,23, -197,1,87,94,23,197,1,247,22,179,13,247,194,250,22,157,13,23,197,1,23, -199,1,249,80,158,42,38,23,198,1,2,17,252,22,157,13,23,199,1,23,201, -1,2,18,247,22,179,7,249,80,158,44,38,23,200,1,80,159,44,35,37,87, -94,23,194,1,27,250,22,174,13,196,11,32,0,89,162,8,44,35,40,9,222, -11,28,192,249,22,65,195,194,11,27,252,22,157,13,23,200,1,23,202,1,2, -18,247,22,179,7,249,80,158,45,38,23,201,1,80,159,45,35,37,27,250,22, -174,13,196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,65,195, -194,11,249,247,22,184,13,248,22,66,195,195,27,250,22,157,13,23,198,1,23, -200,1,249,80,158,43,38,23,199,1,2,17,27,250,22,174,13,196,11,32,0, -89,162,8,44,35,40,9,222,11,28,192,249,22,65,195,194,11,249,247,22,189, -4,248,22,66,195,195,249,247,22,189,4,194,195,87,94,28,248,80,158,36,37, -23,195,2,12,250,22,132,9,77,108,111,97,100,47,117,115,101,45,99,111,109, -112,105,108,101,100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100, -45,112,97,116,104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161, -36,35,11,28,248,22,163,13,23,201,2,23,200,1,27,247,22,191,4,28,23, -193,2,249,22,164,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,160, -13,23,194,2,87,94,23,196,1,90,161,36,39,11,28,249,22,164,8,23,196, -2,68,114,101,108,97,116,105,118,101,87,94,23,194,1,2,16,23,194,1,90, -161,36,40,11,247,22,181,13,27,89,162,43,36,49,62,122,111,225,7,5,3, -33,27,27,89,162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162, -8,44,36,46,9,223,5,33,29,23,203,2,27,28,23,195,1,27,249,22,5, -89,162,8,44,36,52,9,225,13,11,9,33,30,23,205,2,27,28,23,196,2, -11,193,28,192,192,28,193,28,23,196,2,28,249,22,168,3,248,22,67,196,248, -22,67,23,199,2,193,11,11,11,11,28,23,193,2,249,80,159,47,54,36,202, -89,162,43,35,45,9,224,14,2,33,31,87,94,23,193,1,27,28,23,197,1, -27,249,22,5,83,158,39,20,97,94,89,162,8,44,36,50,9,225,14,12,10, -33,32,23,203,1,23,206,1,27,28,196,11,193,28,192,192,28,193,28,196,28, -249,22,168,3,248,22,67,196,248,22,67,199,193,11,11,11,11,28,192,249,80, -159,48,54,36,203,89,162,43,35,45,9,224,15,2,33,33,249,80,159,48,54, -36,203,89,162,43,35,44,9,224,15,7,33,34,32,36,89,162,8,44,36,54, -2,19,222,33,38,0,17,35,114,120,34,94,40,46,42,63,41,47,40,46,42, -41,36,34,27,249,22,189,13,2,37,23,196,2,28,23,193,2,87,94,23,194, -1,249,22,65,248,22,90,23,196,2,27,248,22,99,23,197,1,27,249,22,189, -13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,65,248,22,90, -23,196,2,27,248,22,99,23,197,1,27,249,22,189,13,2,37,23,196,2,28, -23,193,2,87,94,23,194,1,249,22,65,248,22,90,23,196,2,248,2,36,248, -22,99,23,197,1,248,22,75,194,248,22,75,194,248,22,75,194,32,39,89,162, -43,36,54,2,19,222,33,40,28,248,22,73,248,22,67,23,195,2,249,22,7, -9,248,22,66,195,91,159,37,11,90,161,37,35,11,27,248,22,67,23,197,2, -28,248,22,73,248,22,67,23,195,2,249,22,7,9,248,22,66,195,91,159,37, -11,90,161,37,35,11,27,248,22,67,23,197,2,28,248,22,73,248,22,67,23, -195,2,249,22,7,9,248,22,66,195,91,159,37,11,90,161,37,35,11,248,2, -39,248,22,67,23,197,2,249,22,7,249,22,65,248,22,66,23,200,1,23,197, -1,195,249,22,7,249,22,65,248,22,66,23,200,1,23,197,1,195,249,22,7, -249,22,65,248,22,66,23,200,1,23,197,1,195,27,248,2,36,23,195,1,28, -194,192,248,2,39,193,87,95,28,248,22,171,4,195,12,250,22,132,9,2,20, -6,20,20,114,101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97, -116,104,197,28,24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250, -22,139,2,80,159,41,42,37,248,22,145,14,247,22,186,11,11,28,23,193,2, -192,87,94,23,193,1,27,247,22,123,87,94,250,22,137,2,80,159,42,42,37, -248,22,145,14,247,22,186,11,195,192,250,22,137,2,195,198,66,97,116,116,97, -99,104,251,211,197,198,199,10,28,192,250,22,131,9,11,196,195,248,22,129,9, -194,28,249,22,165,6,194,6,1,1,46,2,16,28,249,22,165,6,194,6,2, -2,46,46,62,117,112,192,28,249,22,166,8,248,22,67,23,200,2,23,197,1, -28,249,22,164,8,248,22,66,23,200,2,23,196,1,251,22,129,9,2,20,6, -26,26,99,121,99,108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116, -32,126,101,58,32,126,101,23,200,1,249,22,2,22,67,248,22,80,249,22,65, -23,206,1,23,202,1,12,12,247,192,20,14,159,80,159,39,44,37,249,22,65, -248,22,145,14,247,22,186,11,23,197,1,20,14,159,80,158,39,39,250,80,158, -42,40,249,22,27,11,80,158,44,39,22,153,4,23,196,1,249,247,22,190,4, -23,198,1,248,22,54,248,22,143,13,23,198,1,87,94,28,28,248,22,139,13, -23,197,2,10,248,22,177,4,23,197,2,12,28,23,198,2,250,22,131,9,11, -6,15,15,98,97,100,32,109,111,100,117,108,101,32,112,97,116,104,23,201,2, -250,22,132,9,2,20,6,19,19,109,111,100,117,108,101,45,112,97,116,104,32, -111,114,32,112,97,116,104,23,199,2,28,28,248,22,63,23,197,2,249,22,164, -8,248,22,66,23,199,2,2,3,11,248,22,172,4,248,22,90,197,28,28,248, -22,63,23,197,2,249,22,164,8,248,22,66,23,199,2,66,112,108,97,110,101, -116,11,87,94,28,207,12,20,14,159,80,158,37,39,250,80,158,40,40,249,22, -27,11,80,158,42,39,22,186,11,23,197,1,90,161,36,35,10,249,22,154,4, -21,94,2,21,6,18,18,112,108,97,110,101,116,47,114,101,115,111,108,118,101, -114,46,115,115,1,27,112,108,97,110,101,116,45,109,111,100,117,108,101,45,110, -97,109,101,45,114,101,115,111,108,118,101,114,12,251,211,199,200,201,202,87,94, -23,193,1,27,89,162,8,44,36,45,79,115,104,111,119,45,99,111,108,108,101, -99,116,105,111,110,45,101,114,114,223,6,33,44,27,28,248,22,53,23,199,2, -27,250,22,139,2,80,159,43,43,37,249,22,65,23,204,2,247,22,180,13,11, -28,23,193,2,192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80, -159,44,48,36,248,22,56,23,204,2,11,27,251,80,158,47,50,2,20,23,202, -1,28,248,22,73,23,199,2,23,199,2,248,22,66,23,199,2,28,248,22,73, -23,199,2,9,248,22,67,23,199,2,249,22,157,13,23,195,1,28,248,22,73, -23,197,1,87,94,23,197,1,6,7,7,109,97,105,110,46,115,115,249,22,182, -6,23,199,1,6,3,3,46,115,115,28,248,22,159,6,23,199,2,87,94,23, -194,1,27,248,80,159,41,55,36,23,201,2,27,250,22,139,2,80,159,44,43, -37,249,22,65,23,205,2,23,199,2,11,28,23,193,2,192,87,94,23,193,1, -91,159,37,11,90,161,37,35,11,249,80,159,45,48,36,23,204,2,11,250,22, -1,22,157,13,23,199,1,249,22,79,249,22,2,32,0,89,162,8,44,36,43, -9,222,33,45,23,200,1,248,22,75,23,200,1,28,248,22,139,13,23,199,2, -87,94,23,194,1,28,248,22,162,13,23,199,2,23,198,2,248,22,75,6,26, -26,32,40,97,32,112,97,116,104,32,109,117,115,116,32,98,101,32,97,98,115, -111,108,117,116,101,41,28,249,22,164,8,248,22,66,23,201,2,2,21,27,250, -22,139,2,80,159,43,43,37,249,22,65,23,204,2,247,22,180,13,11,28,23, -193,2,192,87,94,23,193,1,91,159,38,11,90,161,37,35,11,249,80,159,45, -48,36,248,22,90,23,205,2,11,90,161,36,37,11,28,248,22,73,248,22,92, -23,204,2,28,248,22,73,23,194,2,249,22,191,13,0,8,35,114,120,34,91, -46,93,34,23,196,2,11,10,27,27,28,23,197,2,249,22,79,28,248,22,73, -248,22,92,23,208,2,21,93,6,5,5,109,122,108,105,98,249,22,1,22,79, -249,22,2,80,159,51,56,36,248,22,92,23,211,2,23,197,2,28,248,22,73, -23,196,2,248,22,75,23,197,2,23,195,2,251,80,158,49,50,2,20,23,204, -1,248,22,66,23,198,2,248,22,67,23,198,1,249,22,157,13,23,195,1,28, -23,198,1,87,94,23,196,1,23,197,1,28,248,22,73,23,197,1,87,94,23, -197,1,6,7,7,109,97,105,110,46,115,115,28,249,22,191,13,0,8,35,114, -120,34,91,46,93,34,23,199,2,23,197,1,249,22,182,6,23,199,1,6,3, -3,46,115,115,28,249,22,164,8,248,22,66,23,201,2,64,102,105,108,101,249, -22,164,13,248,22,168,13,248,22,90,23,202,2,248,80,159,42,55,36,23,202, -2,12,87,94,28,28,248,22,139,13,23,194,2,10,248,22,181,7,23,194,2, -87,94,23,200,1,12,28,23,200,2,250,22,131,9,67,114,101,113,117,105,114, -101,249,22,143,7,6,17,17,98,97,100,32,109,111,100,117,108,101,32,112,97, -116,104,126,97,28,23,198,2,248,22,66,23,199,2,6,0,0,23,203,1,87, -94,23,200,1,250,22,132,9,2,20,249,22,143,7,6,13,13,109,111,100,117, -108,101,32,112,97,116,104,126,97,28,23,198,2,248,22,66,23,199,2,6,0, -0,23,201,2,27,28,248,22,181,7,23,195,2,249,22,186,7,23,196,2,35, -249,22,166,13,248,22,167,13,23,197,2,11,27,28,248,22,181,7,23,196,2, -249,22,186,7,23,197,2,36,248,80,158,42,51,23,195,2,91,159,38,11,90, -161,38,35,11,28,248,22,181,7,23,199,2,250,22,7,2,22,249,22,186,7, -23,203,2,37,2,22,248,22,160,13,23,198,2,87,95,23,195,1,23,193,1, -27,28,248,22,181,7,23,200,2,249,22,186,7,23,201,2,38,249,80,158,47, -52,23,197,2,5,0,27,28,248,22,181,7,23,201,2,249,22,186,7,23,202, -2,39,248,22,172,4,23,200,2,27,27,250,22,139,2,80,159,51,42,37,248, -22,145,14,247,22,186,11,11,28,23,193,2,192,87,94,23,193,1,27,247,22, -123,87,94,250,22,137,2,80,159,52,42,37,248,22,145,14,247,22,186,11,195, -192,87,95,28,23,209,1,27,250,22,139,2,23,197,2,197,11,28,23,193,1, -12,87,95,27,27,28,248,22,17,80,159,51,45,37,80,159,50,45,37,247,22, -19,250,22,25,248,22,23,23,197,2,80,159,53,44,37,23,196,1,27,248,22, -145,14,247,22,186,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54, -9,226,12,11,2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,159, -50,45,37,32,0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162, -43,35,50,9,227,14,9,8,4,3,33,48,250,22,137,2,23,197,1,197,10, -12,28,28,248,22,181,7,23,202,1,11,27,248,22,159,6,23,208,2,28,192, -192,28,248,22,63,23,208,2,249,22,164,8,248,22,66,23,210,2,2,21,11, -250,22,137,2,80,159,50,43,37,28,248,22,159,6,23,210,2,249,22,65,23, -211,1,248,80,159,53,55,36,23,213,1,87,94,23,210,1,249,22,65,23,211, -1,247,22,180,13,252,22,183,7,23,208,1,23,207,1,23,205,1,23,203,1, -201,12,193,91,159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38, -20,96,96,2,20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38, -48,9,223,1,33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87, -95,248,22,152,4,248,80,159,37,49,37,247,22,186,11,248,22,190,4,80,159, -36,36,37,248,22,177,12,80,159,36,41,36,159,35,20,103,159,35,16,1,11, -16,0,83,158,41,20,100,143,66,35,37,98,111,111,116,29,11,11,11,11,10, -10,36,80,158,35,35,20,103,159,39,16,19,2,1,2,2,30,2,4,72,112, -97,116,104,45,115,116,114,105,110,103,63,10,30,2,4,75,112,97,116,104,45, -97,100,100,45,115,117,102,102,105,120,7,30,2,5,1,20,112,97,114,97,109, -101,116,101,114,105,122,97,116,105,111,110,45,107,101,121,4,30,2,5,1,23, -101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,122,97,116,105, -111,110,3,2,6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,2,14, -30,2,4,69,45,102,105,110,100,45,99,111,108,0,30,2,4,76,110,111,114, -109,97,108,45,99,97,115,101,45,112,97,116,104,6,30,2,4,79,112,97,116, -104,45,114,101,112,108,97,99,101,45,115,117,102,102,105,120,9,2,15,16,0, -11,11,16,0,35,16,0,35,16,11,2,9,2,10,2,7,2,8,2,11,2, -12,2,2,2,6,2,1,2,14,2,13,46,11,11,38,35,11,11,16,1,2, -15,16,1,11,16,1,2,15,36,36,36,11,11,16,0,16,0,16,0,35,35, -11,11,11,16,0,16,0,16,0,35,35,16,0,16,16,83,158,35,16,2,89, -162,43,36,44,9,223,0,33,23,80,159,35,57,36,83,158,35,16,2,89,162, -43,36,44,9,223,0,33,24,80,159,35,56,36,83,158,35,16,2,89,162,43, -36,48,67,103,101,116,45,100,105,114,223,0,33,25,80,159,35,55,36,83,158, -35,16,2,89,162,43,37,48,68,119,105,116,104,45,100,105,114,223,0,33,26, -80,159,35,54,36,83,158,35,16,2,248,22,178,7,69,115,111,45,115,117,102, -102,105,120,80,159,35,35,36,83,158,35,16,2,89,162,43,37,59,2,2,223, -0,33,35,80,159,35,36,36,83,158,35,16,2,32,0,89,162,8,44,36,41, -2,6,222,192,80,159,35,41,36,83,158,35,16,2,247,22,126,80,159,35,42, -36,83,158,35,16,2,247,22,125,80,159,35,43,36,83,158,35,16,2,247,22, -61,80,159,35,44,36,83,158,35,16,2,248,22,18,74,109,111,100,117,108,101, -45,108,111,97,100,105,110,103,80,159,35,45,36,83,158,35,16,2,11,80,158, -35,46,83,158,35,16,2,11,80,158,35,47,83,158,35,16,2,32,0,89,162, -43,37,44,2,13,222,33,41,80,159,35,48,36,83,158,35,16,2,89,162,8, -44,36,44,2,14,223,0,33,50,80,159,35,49,36,83,158,35,16,2,89,162, -43,35,43,2,15,223,0,33,51,80,159,35,53,36,95,29,94,2,3,68,35, -37,107,101,114,110,101,108,11,29,94,2,3,69,35,37,109,105,110,45,115,116, -120,11,2,4,9,9,9,35,0}; - EVAL_ONE_SIZED_STR((char *)expr, 4103); +80,158,38,46,87,94,23,195,1,80,158,36,47,27,248,22,173,4,23,197,2, +28,248,22,139,13,23,194,2,91,159,38,11,90,161,38,35,11,248,22,160,13, +23,197,1,87,95,83,160,37,11,80,158,40,46,198,83,160,37,11,80,158,40, +47,192,192,11,11,28,23,193,2,192,87,94,23,193,1,27,247,22,191,4,28, +192,192,247,22,179,13,20,14,159,80,158,35,39,250,80,158,38,40,249,22,27, +11,80,158,40,39,22,191,4,28,248,22,139,13,23,198,2,23,197,1,87,94, +23,197,1,247,22,179,13,247,194,250,22,157,13,23,197,1,23,199,1,249,80, +158,42,38,23,198,1,2,17,252,22,157,13,23,199,1,23,201,1,2,18,247, +22,179,7,249,80,158,44,38,23,200,1,80,159,44,35,37,87,94,23,194,1, +27,250,22,174,13,196,11,32,0,89,162,8,44,35,40,9,222,11,28,192,249, +22,65,195,194,11,27,252,22,157,13,23,200,1,23,202,1,2,18,247,22,179, +7,249,80,158,45,38,23,201,1,80,159,45,35,37,27,250,22,174,13,196,11, +32,0,89,162,8,44,35,40,9,222,11,28,192,249,22,65,195,194,11,249,247, +22,184,13,248,22,66,195,195,27,250,22,157,13,23,198,1,23,200,1,249,80, +158,43,38,23,199,1,2,17,27,250,22,174,13,196,11,32,0,89,162,8,44, +35,40,9,222,11,28,192,249,22,65,195,194,11,249,247,22,189,4,248,22,66, +195,195,249,247,22,189,4,194,195,87,94,28,248,80,158,36,37,23,195,2,12, +250,22,132,9,77,108,111,97,100,47,117,115,101,45,99,111,109,112,105,108,101, +100,6,25,25,112,97,116,104,32,111,114,32,118,97,108,105,100,45,112,97,116, +104,32,115,116,114,105,110,103,23,197,2,91,159,41,11,90,161,36,35,11,28, +248,22,163,13,23,201,2,23,200,1,27,247,22,191,4,28,23,193,2,249,22, +164,13,23,203,1,23,195,1,200,90,161,38,36,11,248,22,160,13,23,194,2, +87,94,23,196,1,90,161,36,39,11,28,249,22,164,8,23,196,2,68,114,101, +108,97,116,105,118,101,87,94,23,194,1,2,16,23,194,1,90,161,36,40,11, +247,22,181,13,27,89,162,43,36,49,62,122,111,225,7,5,3,33,27,27,89, +162,43,36,51,9,225,8,6,4,33,28,27,249,22,5,89,162,8,44,36,46, +9,223,5,33,29,23,203,2,27,28,23,195,1,27,249,22,5,89,162,8,44, +36,52,9,225,13,11,9,33,30,23,205,2,27,28,23,196,2,11,193,28,192, +192,28,193,28,23,196,2,28,249,22,168,3,248,22,67,196,248,22,67,23,199, +2,193,11,11,11,11,28,23,193,2,249,80,159,47,54,36,202,89,162,43,35, +45,9,224,14,2,33,31,87,94,23,193,1,27,28,23,197,1,27,249,22,5, +83,158,39,20,97,94,89,162,8,44,36,50,9,225,14,12,10,33,32,23,203, +1,23,206,1,27,28,196,11,193,28,192,192,28,193,28,196,28,249,22,168,3, +248,22,67,196,248,22,67,199,193,11,11,11,11,28,192,249,80,159,48,54,36, +203,89,162,43,35,45,9,224,15,2,33,33,249,80,159,48,54,36,203,89,162, +43,35,44,9,224,15,7,33,34,32,36,89,162,8,44,36,54,2,19,222,33, +38,0,17,35,114,120,34,94,40,46,42,63,41,47,40,46,42,41,36,34,27, +249,22,189,13,2,37,23,196,2,28,23,193,2,87,94,23,194,1,249,22,65, +248,22,90,23,196,2,27,248,22,99,23,197,1,27,249,22,189,13,2,37,23, +196,2,28,23,193,2,87,94,23,194,1,249,22,65,248,22,90,23,196,2,27, +248,22,99,23,197,1,27,249,22,189,13,2,37,23,196,2,28,23,193,2,87, +94,23,194,1,249,22,65,248,22,90,23,196,2,248,2,36,248,22,99,23,197, +1,248,22,75,194,248,22,75,194,248,22,75,194,32,39,89,162,43,36,54,2, +19,222,33,40,28,248,22,73,248,22,67,23,195,2,249,22,7,9,248,22,66, +195,91,159,37,11,90,161,37,35,11,27,248,22,67,23,197,2,28,248,22,73, +248,22,67,23,195,2,249,22,7,9,248,22,66,195,91,159,37,11,90,161,37, +35,11,27,248,22,67,23,197,2,28,248,22,73,248,22,67,23,195,2,249,22, +7,9,248,22,66,195,91,159,37,11,90,161,37,35,11,248,2,39,248,22,67, +23,197,2,249,22,7,249,22,65,248,22,66,23,200,1,23,197,1,195,249,22, +7,249,22,65,248,22,66,23,200,1,23,197,1,195,249,22,7,249,22,65,248, +22,66,23,200,1,23,197,1,195,27,248,2,36,23,195,1,28,194,192,248,2, +39,193,87,95,28,248,22,171,4,195,12,250,22,132,9,2,20,6,20,20,114, +101,115,111,108,118,101,100,45,109,111,100,117,108,101,45,112,97,116,104,197,28, +24,193,2,248,24,194,1,195,87,94,23,193,1,12,27,27,250,22,139,2,80, +159,41,42,37,248,22,145,14,247,22,186,11,11,28,23,193,2,192,87,94,23, +193,1,27,247,22,123,87,94,250,22,137,2,80,159,42,42,37,248,22,145,14, +247,22,186,11,195,192,250,22,137,2,195,198,66,97,116,116,97,99,104,251,211, +197,198,199,10,28,192,250,22,131,9,11,196,195,248,22,129,9,194,28,249,22, +165,6,194,6,1,1,46,2,16,28,249,22,165,6,194,6,2,2,46,46,62, +117,112,192,28,249,22,166,8,248,22,67,23,200,2,23,197,1,28,249,22,164, +8,248,22,66,23,200,2,23,196,1,251,22,129,9,2,20,6,26,26,99,121, +99,108,101,32,105,110,32,108,111,97,100,105,110,103,32,97,116,32,126,101,58, +32,126,101,23,200,1,249,22,2,22,67,248,22,80,249,22,65,23,206,1,23, +202,1,12,12,247,192,20,14,159,80,159,39,44,37,249,22,65,248,22,145,14, +247,22,186,11,23,197,1,20,14,159,80,158,39,39,250,80,158,42,40,249,22, +27,11,80,158,44,39,22,153,4,23,196,1,249,247,22,190,4,23,198,1,248, +22,54,248,22,143,13,23,198,1,87,94,28,28,248,22,139,13,23,197,2,10, +248,22,177,4,23,197,2,12,28,23,198,2,250,22,131,9,11,6,15,15,98, +97,100,32,109,111,100,117,108,101,32,112,97,116,104,23,201,2,250,22,132,9, +2,20,6,19,19,109,111,100,117,108,101,45,112,97,116,104,32,111,114,32,112, +97,116,104,23,199,2,28,28,248,22,63,23,197,2,249,22,164,8,248,22,66, +23,199,2,2,3,11,248,22,172,4,248,22,90,197,28,28,248,22,63,23,197, +2,249,22,164,8,248,22,66,23,199,2,66,112,108,97,110,101,116,11,87,94, +28,207,12,20,14,159,80,158,37,39,250,80,158,40,40,249,22,27,11,80,158, +42,39,22,186,11,23,197,1,90,161,36,35,10,249,22,154,4,21,94,2,21, +6,18,18,112,108,97,110,101,116,47,114,101,115,111,108,118,101,114,46,115,115, +1,27,112,108,97,110,101,116,45,109,111,100,117,108,101,45,110,97,109,101,45, +114,101,115,111,108,118,101,114,12,251,211,199,200,201,202,87,94,23,193,1,27, +89,162,8,44,36,45,79,115,104,111,119,45,99,111,108,108,101,99,116,105,111, +110,45,101,114,114,223,6,33,44,27,28,248,22,53,23,199,2,27,250,22,139, +2,80,159,43,43,37,249,22,65,23,204,2,247,22,180,13,11,28,23,193,2, +192,87,94,23,193,1,91,159,37,11,90,161,37,35,11,249,80,159,44,48,36, +248,22,56,23,204,2,11,27,251,80,158,47,50,2,20,23,202,1,28,248,22, +73,23,199,2,23,199,2,248,22,66,23,199,2,28,248,22,73,23,199,2,9, +248,22,67,23,199,2,249,22,157,13,23,195,1,28,248,22,73,23,197,1,87, +94,23,197,1,6,7,7,109,97,105,110,46,115,115,249,22,182,6,23,199,1, +6,3,3,46,115,115,28,248,22,159,6,23,199,2,87,94,23,194,1,27,248, +80,159,41,55,36,23,201,2,27,250,22,139,2,80,159,44,43,37,249,22,65, +23,205,2,23,199,2,11,28,23,193,2,192,87,94,23,193,1,91,159,37,11, +90,161,37,35,11,249,80,159,45,48,36,23,204,2,11,250,22,1,22,157,13, +23,199,1,249,22,79,249,22,2,32,0,89,162,8,44,36,43,9,222,33,45, +23,200,1,248,22,75,23,200,1,28,248,22,139,13,23,199,2,87,94,23,194, +1,28,248,22,162,13,23,199,2,23,198,2,248,22,75,6,26,26,32,40,97, +32,112,97,116,104,32,109,117,115,116,32,98,101,32,97,98,115,111,108,117,116, +101,41,28,249,22,164,8,248,22,66,23,201,2,2,21,27,250,22,139,2,80, +159,43,43,37,249,22,65,23,204,2,247,22,180,13,11,28,23,193,2,192,87, +94,23,193,1,91,159,38,11,90,161,37,35,11,249,80,159,45,48,36,248,22, +90,23,205,2,11,90,161,36,37,11,28,248,22,73,248,22,92,23,204,2,28, +248,22,73,23,194,2,249,22,191,13,0,8,35,114,120,34,91,46,93,34,23, +196,2,11,10,27,27,28,23,197,2,249,22,79,28,248,22,73,248,22,92,23, +208,2,21,93,6,5,5,109,122,108,105,98,249,22,1,22,79,249,22,2,80, +159,51,56,36,248,22,92,23,211,2,23,197,2,28,248,22,73,23,196,2,248, +22,75,23,197,2,23,195,2,251,80,158,49,50,2,20,23,204,1,248,22,66, +23,198,2,248,22,67,23,198,1,249,22,157,13,23,195,1,28,23,198,1,87, +94,23,196,1,23,197,1,28,248,22,73,23,197,1,87,94,23,197,1,6,7, +7,109,97,105,110,46,115,115,28,249,22,191,13,0,8,35,114,120,34,91,46, +93,34,23,199,2,23,197,1,249,22,182,6,23,199,1,6,3,3,46,115,115, +28,249,22,164,8,248,22,66,23,201,2,64,102,105,108,101,249,22,164,13,248, +22,168,13,248,22,90,23,202,2,248,80,159,42,55,36,23,202,2,12,87,94, +28,28,248,22,139,13,23,194,2,10,248,22,181,7,23,194,2,87,94,23,200, +1,12,28,23,200,2,250,22,131,9,67,114,101,113,117,105,114,101,249,22,143, +7,6,17,17,98,97,100,32,109,111,100,117,108,101,32,112,97,116,104,126,97, +28,23,198,2,248,22,66,23,199,2,6,0,0,23,203,1,87,94,23,200,1, +250,22,132,9,2,20,249,22,143,7,6,13,13,109,111,100,117,108,101,32,112, +97,116,104,126,97,28,23,198,2,248,22,66,23,199,2,6,0,0,23,201,2, +27,28,248,22,181,7,23,195,2,249,22,186,7,23,196,2,35,249,22,166,13, +248,22,167,13,23,197,2,11,27,28,248,22,181,7,23,196,2,249,22,186,7, +23,197,2,36,248,80,158,42,51,23,195,2,91,159,38,11,90,161,38,35,11, +28,248,22,181,7,23,199,2,250,22,7,2,22,249,22,186,7,23,203,2,37, +2,22,248,22,160,13,23,198,2,87,95,23,195,1,23,193,1,27,28,248,22, +181,7,23,200,2,249,22,186,7,23,201,2,38,249,80,158,47,52,23,197,2, +5,0,27,28,248,22,181,7,23,201,2,249,22,186,7,23,202,2,39,248,22, +172,4,23,200,2,27,27,250,22,139,2,80,159,51,42,37,248,22,145,14,247, +22,186,11,11,28,23,193,2,192,87,94,23,193,1,27,247,22,123,87,94,250, +22,137,2,80,159,52,42,37,248,22,145,14,247,22,186,11,195,192,87,95,28, +23,209,1,27,250,22,139,2,23,197,2,197,11,28,23,193,1,12,87,95,27, +27,28,248,22,17,80,159,51,45,37,80,159,50,45,37,247,22,19,250,22,25, +248,22,23,23,197,2,80,159,53,44,37,23,196,1,27,248,22,145,14,247,22, +186,11,249,22,3,83,158,39,20,97,94,89,162,8,44,36,54,9,226,12,11, +2,3,33,46,23,195,1,23,196,1,248,28,248,22,17,80,159,50,45,37,32, +0,89,162,43,36,41,9,222,33,47,80,159,49,57,36,89,162,43,35,50,9, +227,14,9,8,4,3,33,48,250,22,137,2,23,197,1,197,10,12,28,28,248, +22,181,7,23,202,1,11,27,248,22,159,6,23,208,2,28,192,192,28,248,22, +63,23,208,2,249,22,164,8,248,22,66,23,210,2,2,21,11,250,22,137,2, +80,159,50,43,37,28,248,22,159,6,23,210,2,249,22,65,23,211,1,248,80, +159,53,55,36,23,213,1,87,94,23,210,1,249,22,65,23,211,1,247,22,180, +13,252,22,183,7,23,208,1,23,207,1,23,205,1,23,203,1,201,12,193,91, +159,37,10,90,161,36,35,10,11,90,161,36,36,10,83,158,38,20,96,96,2, +20,89,162,8,44,36,50,9,224,2,0,33,42,89,162,43,38,48,9,223,1, +33,43,89,162,43,39,8,30,9,225,2,3,0,33,49,208,87,95,248,22,152, +4,248,80,159,37,49,37,247,22,186,11,248,22,190,4,80,159,36,36,37,248, +22,177,12,80,159,36,41,36,159,35,20,103,159,35,16,1,11,16,0,83,158, +41,20,100,143,66,35,37,98,111,111,116,29,11,11,11,11,10,10,36,80,158, +35,35,20,103,159,39,16,19,2,1,2,2,30,2,4,72,112,97,116,104,45, +115,116,114,105,110,103,63,10,30,2,4,75,112,97,116,104,45,97,100,100,45, +115,117,102,102,105,120,7,30,2,5,1,20,112,97,114,97,109,101,116,101,114, +105,122,97,116,105,111,110,45,107,101,121,4,30,2,5,1,23,101,120,116,101, +110,100,45,112,97,114,97,109,101,116,101,114,105,122,97,116,105,111,110,3,2, +6,2,7,2,8,2,9,2,10,2,11,2,12,2,13,2,14,30,2,4,69, +45,102,105,110,100,45,99,111,108,0,30,2,4,76,110,111,114,109,97,108,45, +99,97,115,101,45,112,97,116,104,6,30,2,4,79,112,97,116,104,45,114,101, +112,108,97,99,101,45,115,117,102,102,105,120,9,2,15,16,0,11,11,16,0, +35,16,0,35,16,11,2,9,2,10,2,7,2,8,2,11,2,12,2,2,2, +6,2,1,2,14,2,13,46,11,11,38,35,11,11,16,1,2,15,16,1,11, +16,1,2,15,36,36,36,11,11,16,0,16,0,16,0,35,35,11,11,11,16, +0,16,0,16,0,35,35,16,0,16,16,83,158,35,16,2,89,162,43,36,44, +9,223,0,33,23,80,159,35,57,36,83,158,35,16,2,89,162,43,36,44,9, +223,0,33,24,80,159,35,56,36,83,158,35,16,2,89,162,43,36,48,67,103, +101,116,45,100,105,114,223,0,33,25,80,159,35,55,36,83,158,35,16,2,89, +162,43,37,48,68,119,105,116,104,45,100,105,114,223,0,33,26,80,159,35,54, +36,83,158,35,16,2,248,22,178,7,69,115,111,45,115,117,102,102,105,120,80, +159,35,35,36,83,158,35,16,2,89,162,43,37,59,2,2,223,0,33,35,80, +159,35,36,36,83,158,35,16,2,32,0,89,162,8,44,36,41,2,6,222,192, +80,159,35,41,36,83,158,35,16,2,247,22,126,80,159,35,42,36,83,158,35, +16,2,247,22,125,80,159,35,43,36,83,158,35,16,2,247,22,61,80,159,35, +44,36,83,158,35,16,2,248,22,18,74,109,111,100,117,108,101,45,108,111,97, +100,105,110,103,80,159,35,45,36,83,158,35,16,2,11,80,158,35,46,83,158, +35,16,2,11,80,158,35,47,83,158,35,16,2,32,0,89,162,43,37,44,2, +13,222,33,41,80,159,35,48,36,83,158,35,16,2,89,162,8,44,36,44,2, +14,223,0,33,50,80,159,35,49,36,83,158,35,16,2,89,162,43,35,43,2, +15,223,0,33,51,80,159,35,53,36,95,29,94,2,3,68,35,37,107,101,114, +110,101,108,11,29,94,2,3,69,35,37,109,105,110,45,115,116,120,11,2,4, +9,9,9,35,0}; + EVAL_ONE_SIZED_STR((char *)expr, 4099); } diff --git a/src/mzscheme/src/env.c b/src/mzscheme/src/env.c index b3e1720277..645e0aabe7 100644 --- a/src/mzscheme/src/env.c +++ b/src/mzscheme/src/env.c @@ -1171,6 +1171,22 @@ void scheme_shadow(Scheme_Env *env, Scheme_Object *n, int stxtoo) } else { if (env->shadowed_syntax) scheme_hash_set(env->shadowed_syntax, n, NULL); + + if (rn) { + /* If the syntax binding is a rename transformer, need to install + a mapping. */ + Scheme_Object *v; + v = scheme_lookup_in_table(env->syntax, (const char *)n); + if (v) { + v = SCHEME_PTR_VAL(v); + if (SAME_TYPE(SCHEME_TYPE(v), scheme_id_macro_type)) { + scheme_install_free_id_rename(n, + SCHEME_PTR1_VAL(v), + rn, + scheme_make_integer(env->phase)); + } + } + } } } @@ -1959,7 +1975,8 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec existing rename. */ if (!SCHEME_HASHTP((Scheme_Object *)env) && env->module && (mode < 2)) { Scheme_Object *mod, *nm = id; - mod = scheme_stx_module_name(&nm, scheme_make_integer(env->phase), NULL, NULL, NULL, NULL, NULL); + mod = scheme_stx_module_name(0, &nm, scheme_make_integer(env->phase), NULL, NULL, NULL, + NULL, NULL, NULL, NULL); if (mod /* must refer to env->module, otherwise there would have been an error before getting here */ && NOT_SAME_OBJ(nm, sym)) @@ -2634,7 +2651,8 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, } src_find_id = find_id; - modidx = scheme_stx_module_name(&find_id, scheme_make_integer(phase), NULL, NULL, &mod_defn_phase, NULL, NULL); + modidx = scheme_stx_module_name(0, &find_id, scheme_make_integer(phase), NULL, NULL, &mod_defn_phase, + NULL, NULL, NULL, NULL); /* Used out of context? */ if (SAME_OBJ(modidx, scheme_undefined)) { @@ -2646,9 +2664,10 @@ scheme_lookup_binding(Scheme_Object *find_id, Scheme_Comp_Env *env, int flags, } if (modidx) { - if (!(flags & SCHEME_OUT_OF_CONTEXT_OK)) + if (!(flags & SCHEME_OUT_OF_CONTEXT_OK)) { scheme_wrong_syntax(scheme_compile_stx_string, NULL, find_id, "identifier used out of context"); + } if (flags & SCHEME_OUT_OF_CONTEXT_LOCAL) return scheme_make_local(scheme_local_type, 0, 0); return NULL; @@ -2910,7 +2929,8 @@ int scheme_check_context(Scheme_Env *env, Scheme_Object *name, Scheme_Object *ok if (mod && SCHEME_TRUEP(mod) && NOT_SAME_OBJ(ok_modidx, mod)) { return 1; } else { - mod = scheme_stx_module_name(&id, scheme_make_integer(env->phase), NULL, NULL, NULL, NULL, NULL); + mod = scheme_stx_module_name(0, &id, scheme_make_integer(env->phase), NULL, NULL, NULL, + NULL, NULL, NULL, NULL); if (SAME_OBJ(mod, scheme_undefined)) return 1; } diff --git a/src/mzscheme/src/error.c b/src/mzscheme/src/error.c index 0b0ed9010a..f59f5ff98c 100644 --- a/src/mzscheme/src/error.c +++ b/src/mzscheme/src/error.c @@ -661,6 +661,9 @@ call_error(char *buffer, int len, Scheme_Object *exn) scheme_optimize_context_to_string(scheme_current_thread->constant_folding), buffer); scheme_longjmp(scheme_error_buf, 1); + } else if (scheme_current_thread->reading_delayed) { + scheme_current_thread->reading_delayed = exn; + scheme_longjmp(scheme_error_buf, 1); } else { mz_jmp_buf savebuf; Scheme_Object *p[2], *display_handler, *escape_handler, *v; @@ -1592,7 +1595,8 @@ static void do_wrong_syntax(const char *where, if (scheme_current_thread->current_local_env) phase = scheme_current_thread->current_local_env->genv->phase; else phase = 0; - scheme_stx_module_name(&first, scheme_make_integer(phase), &mod, &nomwho, NULL, NULL, NULL); + scheme_stx_module_name(0, &first, scheme_make_integer(phase), &mod, &nomwho, + NULL, NULL, NULL, NULL, NULL); } } } else { diff --git a/src/mzscheme/src/eval.c b/src/mzscheme/src/eval.c index feada2d58b..78d4d555b2 100644 --- a/src/mzscheme/src/eval.c +++ b/src/mzscheme/src/eval.c @@ -6070,7 +6070,8 @@ static Scheme_Object *check_top(const char *when, Scheme_Object *form, Scheme_Co if (NOT_SAME_OBJ(tl_id, SCHEME_STX_SYM(symbol))) { /* Since the module has a rename for this id, it's certainly defined. */ } else { - modidx = scheme_stx_module_name(&symbol, scheme_make_integer(env->genv->phase), NULL, NULL, NULL, NULL, NULL); + modidx = scheme_stx_module_name(0, &symbol, scheme_make_integer(env->genv->phase), NULL, NULL, NULL, + NULL, NULL, NULL, NULL); if (modidx) { /* If it's an access path, resolve it: */ if (env->genv->module @@ -6535,7 +6536,7 @@ scheme_compile_expand_block(Scheme_Object *forms, Scheme_Comp_Env *env, names, expr, new_env->genv->exp_env, new_env->insp, rec, drec, new_env, new_env, - &pos); + &pos, rib); } /* Remember extended environment */ @@ -9800,7 +9801,7 @@ local_eval(int argc, Scheme_Object **argv) scheme_bind_syntaxes("local syntax definition", names, expr, stx_env->genv->exp_env, stx_env->insp, &rec, 0, stx_env, stx_env, - &pos); + &pos, rib); } /* Extend shared rib with renamings */ diff --git a/src/mzscheme/src/module.c b/src/mzscheme/src/module.c index 2398ea2ba4..a8cba4d810 100644 --- a/src/mzscheme/src/module.c +++ b/src/mzscheme/src/module.c @@ -116,7 +116,8 @@ static void eval_exptime(Scheme_Object *names, int count, Scheme_Env *genv, Scheme_Comp_Env *env, Resolve_Prefix *rp, int let_depth, int shift, Scheme_Bucket_Table *syntax, int for_stx, - Scheme_Object *certs); + Scheme_Object *certs, + Scheme_Object *free_id_rename_rn); static Scheme_Module_Exports *make_module_exports(); @@ -3947,7 +3948,7 @@ void scheme_run_module_exptime(Scheme_Env *menv, int set_ns) eval_exptime(names, scheme_list_length(names), e, exp_env, rhs_env, rp, let_depth, 1, (for_stx ? for_stx_globals : syntax), for_stx, - NULL); + NULL, scheme_false); } if (set_ns) { @@ -4401,13 +4402,15 @@ static void *eval_exptime_k(void) Resolve_Prefix *rp; int let_depth, shift; Scheme_Bucket_Table *syntax; + Scheme_Object *free_id_rename_rn; names = (Scheme_Object *)p->ku.k.p1; expr = (Scheme_Object *)p->ku.k.p2; genv = (Scheme_Env *)SCHEME_CAR((Scheme_Object *)p->ku.k.p3); comp_env = (Scheme_Comp_Env *)SCHEME_CDR((Scheme_Object *)p->ku.k.p3); - rp = (Resolve_Prefix *)SCHEME_CAR((Scheme_Object *)p->ku.k.p4); - syntax = (Scheme_Bucket_Table *)SCHEME_CDR((Scheme_Object *)p->ku.k.p4); + free_id_rename_rn = SCHEME_CAR((Scheme_Object *)p->ku.k.p4); + rp = (Resolve_Prefix *)SCHEME_CAR(SCHEME_CDR((Scheme_Object *)p->ku.k.p4)); + syntax = (Scheme_Bucket_Table *)SCHEME_CDR(SCHEME_CDR((Scheme_Object *)p->ku.k.p4)); count = p->ku.k.i1; let_depth = p->ku.k.i2; shift = p->ku.k.i3; @@ -4420,7 +4423,8 @@ static void *eval_exptime_k(void) p->ku.k.p4 = NULL; p->ku.k.p5 = NULL; - eval_exptime(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, for_stx, certs); + eval_exptime(names, count, expr, genv, comp_env, rp, let_depth, shift, syntax, for_stx, + certs, free_id_rename_rn); return NULL; } @@ -4441,7 +4445,8 @@ static void eval_exptime(Scheme_Object *names, int count, Scheme_Env *genv, Scheme_Comp_Env *comp_env, Resolve_Prefix *rp, int let_depth, int shift, Scheme_Bucket_Table *syntax, - int for_stx, Scheme_Object *certs) + int for_stx, Scheme_Object *certs, + Scheme_Object *free_id_rename_rn) { Scheme_Object *macro, *vals, *name, **save_runstack; int i, g, depth; @@ -4454,6 +4459,7 @@ static void eval_exptime(Scheme_Object *names, int count, vals = scheme_make_pair((Scheme_Object *)genv, (Scheme_Object *)comp_env); p->ku.k.p3 = vals; vals = scheme_make_pair((Scheme_Object *)rp, (Scheme_Object *)syntax); + vals = scheme_make_pair(free_id_rename_rn, vals); p->ku.k.p4 = vals; p->ku.k.i1 = count; p->ku.k.i2 = let_depth; @@ -4511,6 +4517,11 @@ static void eval_exptime(Scheme_Object *names, int count, macro = scheme_alloc_small_object(); macro->type = scheme_macro_type; SCHEME_PTR_VAL(macro) = values[i]; + + if (SCHEME_TRUEP(free_id_rename_rn) + && SAME_TYPE(SCHEME_TYPE(values[i]), scheme_id_macro_type)) + scheme_install_free_id_rename(name, SCHEME_PTR1_VAL(values[i]), free_id_rename_rn, + scheme_make_integer(0)); } else macro = values[i]; @@ -4526,6 +4537,11 @@ static void eval_exptime(Scheme_Object *names, int count, macro = scheme_alloc_small_object(); macro->type = scheme_macro_type; SCHEME_PTR_VAL(macro) = vals; + + if (SCHEME_TRUEP(free_id_rename_rn) + && SAME_TYPE(SCHEME_TYPE(vals), scheme_id_macro_type)) + scheme_install_free_id_rename(name, SCHEME_PTR1_VAL(vals), free_id_rename_rn, + scheme_make_integer(0)); } else macro = vals; @@ -6170,6 +6186,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, Optimize_Info *oi; int count = 0; int for_stx; + int use_post_ex = 0; for_stx = scheme_stx_module_eq(define_for_syntaxes_stx, fst, 0); @@ -6233,6 +6250,7 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, scheme_extend_module_rename(for_stx ? post_ex_et_rn : post_ex_rn, self_modidx, name, name, self_modidx, name, for_stx ? 1 : 0, NULL, NULL, 0); *all_simple_renames = 0; + use_post_ex = 1; } else scheme_extend_module_rename(for_stx ? et_rn : rn, self_modidx, name, name, self_modidx, name, for_stx ? 1 : 0, NULL, NULL, 0); @@ -6304,8 +6322,9 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, eval_exptime(names, count, m, eenv->genv, rhs_env, rp, ri->max_let_depth, 0, (for_stx ? env->genv->exp_env->toplevel : env->genv->syntax), for_stx, - rec[drec].certs); - + rec[drec].certs, + for_stx ? scheme_false : (use_post_ex ? post_ex_rn : rn)); + if (rec[drec].comp) e = NULL; else { @@ -6369,11 +6388,11 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, } /* first = a list of (cons semi-expanded-expression kind) */ - /* Bound names will be re-bound at this point: */ + /* Bound names will not be re-bound at this point: */ if (rec[drec].comp || (rec[drec].depth != -2)) { scheme_seal_module_rename_set(rn_set, STX_SEAL_BOUND); - scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_BOUND); } + scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_BOUND); /* Pass 2 */ SCHEME_EXPAND_OBSERVE_NEXT_GROUP(observer); @@ -6534,8 +6553,8 @@ static Scheme_Object *do_module_begin(Scheme_Object *form, Scheme_Comp_Env *env, if (rec[drec].comp || (rec[drec].depth != -2)) { scheme_seal_module_rename_set(rn_set, STX_SEAL_ALL); - scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_ALL); } + scheme_seal_module_rename_set(post_ex_rn_set, STX_SEAL_ALL); /* Compute provides for re-provides and all-defs-out: */ reprovide_kernel = compute_reprovides(all_provided, @@ -8441,7 +8460,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ exets ? exets[j] : 0, src_phase_index, pt->phase_index, - for_unmarshal || (!has_context && can_save_marshal)); + (for_unmarshal || (!has_context && can_save_marshal)) ? 1 : 0); } } } diff --git a/src/mzscheme/src/mzmark.c b/src/mzscheme/src/mzmark.c index 64c2337deb..53565447b8 100644 --- a/src/mzscheme/src/mzmark.c +++ b/src/mzscheme/src/mzmark.c @@ -1649,6 +1649,7 @@ static int thread_val_MARK(void *p) { gcMARK(pr->current_mt); gcMARK(pr->constant_folding); + gcMARK(pr->reading_delayed); gcMARK(pr->overflow_reply); @@ -1759,6 +1760,7 @@ static int thread_val_FIXUP(void *p) { gcFIXUP(pr->current_mt); gcFIXUP(pr->constant_folding); + gcFIXUP(pr->reading_delayed); gcFIXUP(pr->overflow_reply); @@ -5036,6 +5038,7 @@ static int mark_rename_table_MARK(void *p) { gcMARK(rn->plus_kernel_nominal_source); gcMARK(rn->set_identity); gcMARK(rn->marked_names); + gcMARK(rn->free_id_renames); return gcBYTES_TO_WORDS(sizeof(Module_Renames)); } @@ -5050,6 +5053,7 @@ static int mark_rename_table_FIXUP(void *p) { gcFIXUP(rn->plus_kernel_nominal_source); gcFIXUP(rn->set_identity); gcFIXUP(rn->marked_names); + gcFIXUP(rn->free_id_renames); return gcBYTES_TO_WORDS(sizeof(Module_Renames)); } diff --git a/src/mzscheme/src/mzmarksrc.c b/src/mzscheme/src/mzmarksrc.c index a49b33ab01..66afce57cf 100644 --- a/src/mzscheme/src/mzmarksrc.c +++ b/src/mzscheme/src/mzmarksrc.c @@ -662,6 +662,7 @@ thread_val { gcMARK(pr->current_mt); gcMARK(pr->constant_folding); + gcMARK(pr->reading_delayed); gcMARK(pr->overflow_reply); @@ -2068,6 +2069,7 @@ mark_rename_table { gcMARK(rn->plus_kernel_nominal_source); gcMARK(rn->set_identity); gcMARK(rn->marked_names); + gcMARK(rn->free_id_renames); size: gcBYTES_TO_WORDS(sizeof(Module_Renames)); } diff --git a/src/mzscheme/src/print.c b/src/mzscheme/src/print.c index 8bf974c8bd..5a67a701d4 100644 --- a/src/mzscheme/src/print.c +++ b/src/mzscheme/src/print.c @@ -120,6 +120,8 @@ static Scheme_Object *writable_struct_subs(Scheme_Object *s, int for_write, Prin #define PRINTABLE_STRUCT(obj, pp) (scheme_inspector_sees_part(obj, pp->inspector, -1)) #define SCHEME_PREFABP(obj) (((Scheme_Structure *)(obj))->stype->prefab_key) +#define SCHEME_HASHTPx(obj) ((SCHEME_HASHTP(obj) && !(MZ_OPT_HASH_KEY(&(((Scheme_Hash_Table *)obj)->iso)) & 0x1))) + #define HAS_SUBSTRUCT(obj, qk) \ (SCHEME_PAIRP(obj) \ || SCHEME_MUTABLE_PAIRP(obj) \ @@ -129,7 +131,7 @@ static Scheme_Object *writable_struct_subs(Scheme_Object *s, int for_write, Prin && SCHEME_STRUCTP(obj) \ && PRINTABLE_STRUCT(obj, pp), 0)) \ || (qk(SCHEME_STRUCTP(obj) && scheme_is_writable_struct(obj), 0)) \ - || (qk(pp->print_hash_table, 1) && (SCHEME_HASHTP(obj) || SCHEME_HASHTRP(obj)))) + || (qk(pp->print_hash_table, 1) && (SCHEME_HASHTPx(obj) || SCHEME_HASHTRP(obj)))) #define ssQUICK(x, isbox) x #define ssQUICKp(x, isbox) (pp ? x : isbox) #define ssALL(x, isbox) 1 @@ -486,7 +488,7 @@ static int check_cycles(Scheme_Object *obj, int for_write, Scheme_Hash_Table *ht } } } - } else if (SCHEME_HASHTP(obj)) { + } else if (SCHEME_HASHTPx(obj)) { /* got here => printable */ Scheme_Hash_Table *t; Scheme_Object **keys, **vals, *val; @@ -591,7 +593,7 @@ static int check_cycles_fast(Scheme_Object *obj, PrintParams *pp, int *fast_chec } else cycle = 0; } else if (pp->print_hash_table - && SCHEME_HASHTP(obj)) { + && SCHEME_HASHTPx(obj)) { if (!((Scheme_Hash_Table *)obj)->count) cycle = 0; else @@ -702,7 +704,7 @@ static void setup_graph_table(Scheme_Object *obj, int for_write, Scheme_Hash_Tab setup_graph_table(((Scheme_Structure *)obj)->slots[i], for_write, ht, counter, pp); } } - } else if (pp && SCHEME_HASHTP(obj)) { /* got here => printable */ + } else if (pp && SCHEME_HASHTPx(obj)) { /* got here => printable */ Scheme_Hash_Table *t; Scheme_Object **keys, **vals, *val; int i; @@ -1831,7 +1833,7 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, } } else if ((compact || pp->print_hash_table) - && (SCHEME_HASHTP(obj) || SCHEME_HASHTRP(obj))) + && (SCHEME_HASHTPx(obj) || SCHEME_HASHTRP(obj))) { Scheme_Hash_Table *t; Scheme_Hash_Tree *tr; @@ -1918,6 +1920,12 @@ print(Scheme_Object *obj, int notdisplay, int compact, Scheme_Hash_Table *ht, closed = 1; } + else if (compact && SCHEME_HASHTP(obj)) + { + /* since previous case didn't catch this table, it has a 0x1 flag + and should be marshalled as #t */ + print_compact(pp, CPT_TRUE); + } else if (SAME_OBJ(obj, scheme_true)) { if (compact) diff --git a/src/mzscheme/src/read.c b/src/mzscheme/src/read.c index 1c65afc98a..5823bb7042 100644 --- a/src/mzscheme/src/read.c +++ b/src/mzscheme/src/read.c @@ -5322,6 +5322,7 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in unsigned char *st; Scheme_Object * volatile port; Scheme_Object * volatile v; + Scheme_Object * volatile v_exn; Scheme_Hash_Table ** volatile ht; mz_jmp_buf newbuf, * volatile savebuf; @@ -5417,12 +5418,16 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in /* Perform the read, catching escapes so we can clean up: */ savebuf = scheme_current_thread->error_buf; scheme_current_thread->error_buf = &newbuf; + scheme_current_thread->reading_delayed = scheme_true; if (scheme_setjmp(newbuf)) { v = NULL; + v_exn = scheme_current_thread->reading_delayed; } else { v = read_compact(rp, 0); + v_exn = NULL; } scheme_current_thread->error_buf = savebuf; + scheme_current_thread->reading_delayed = NULL; /* Clean up: */ @@ -5452,6 +5457,8 @@ Scheme_Object *scheme_load_delayed_code(int _which, Scheme_Load_Delay *_delay_in return v; } else { + if (v_exn) + scheme_raise(v_exn); scheme_longjmp(*scheme_current_thread->error_buf, 1); return NULL; } diff --git a/src/mzscheme/src/schpriv.h b/src/mzscheme/src/schpriv.h index ef64736e32..3c7920e318 100644 --- a/src/mzscheme/src/schpriv.h +++ b/src/mzscheme/src/schpriv.h @@ -743,6 +743,11 @@ Scheme_Object *scheme_stx_remove_extra_marks(Scheme_Object *o, Scheme_Object *re Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv); +void scheme_install_free_id_rename(Scheme_Object *id, + Scheme_Object *orig_id, + Scheme_Object *rename_rib, + Scheme_Object *phase); + #define mzMOD_RENAME_TOPLEVEL 0 #define mzMOD_RENAME_NORMAL 1 #define mzMOD_RENAME_MARKED 2 @@ -763,11 +768,11 @@ void scheme_seal_module_rename_set(Scheme_Object *rns, int level); #define STX_SEAL_ALL 2 Scheme_Object *scheme_make_module_rename(Scheme_Object *phase, int kind, Scheme_Hash_Table *mns); -void scheme_extend_module_rename(Scheme_Object *rn, Scheme_Object *modname, - Scheme_Object *locname, Scheme_Object *exname, - Scheme_Object *nominal_src, Scheme_Object *nominal_ex, - int mod_phase, Scheme_Object *src_phase_index, - Scheme_Object *nom_export_phase, int drop_for_marshal); +Scheme_Object* scheme_extend_module_rename(Scheme_Object *rn, Scheme_Object *modname, + Scheme_Object *locname, Scheme_Object *exname, + Scheme_Object *nominal_src, Scheme_Object *nominal_ex, + int mod_phase, Scheme_Object *src_phase_index, + Scheme_Object *nom_export_phase, int drop_for_marshal); void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *modidx, struct Scheme_Module_Phase_Exports *pt, Scheme_Object *unmarshal_phase_index, @@ -797,12 +802,15 @@ Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist); int scheme_stx_module_eq(Scheme_Object *a, Scheme_Object *b, long phase); int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase, Scheme_Object *asym); Scheme_Object *scheme_stx_get_module_eq_sym(Scheme_Object *a, Scheme_Object *phase); -Scheme_Object *scheme_stx_module_name(Scheme_Object **name, Scheme_Object *phase, +Scheme_Object *scheme_stx_module_name(int recur, + Scheme_Object **name, Scheme_Object *phase, Scheme_Object **nominal_modidx, Scheme_Object **nominal_name, Scheme_Object **mod_phase, Scheme_Object **src_phase_index, - Scheme_Object **nominal_src_phase); + Scheme_Object **nominal_src_phase, + Scheme_Object **lex_env, + int *_sealed); Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a); int scheme_stx_parallel_is_used(Scheme_Object *sym, Scheme_Object *stx); @@ -2111,7 +2119,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object Scheme_Env *exp_env, Scheme_Object *insp, Scheme_Compile_Expand_Info *rec, int drec, Scheme_Comp_Env *stx_env, Scheme_Comp_Env *rhs_env, - int *_pos); + int *_pos, Scheme_Object *rename_rib); int scheme_is_sub_env(Scheme_Comp_Env *stx_env, Scheme_Comp_Env *env); typedef struct SFS_Info { diff --git a/src/mzscheme/src/schvers.h b/src/mzscheme/src/schvers.h index d12e51749b..6aabc11135 100644 --- a/src/mzscheme/src/schvers.h +++ b/src/mzscheme/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "4.1.5.1" +#define MZSCHEME_VERSION "4.1.5.2" #define MZSCHEME_VERSION_X 4 #define MZSCHEME_VERSION_Y 1 #define MZSCHEME_VERSION_Z 5 -#define MZSCHEME_VERSION_W 1 +#define MZSCHEME_VERSION_W 2 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/mzscheme/src/stxobj.c b/src/mzscheme/src/stxobj.c index 62ed20871f..7f70231c20 100644 --- a/src/mzscheme/src/stxobj.c +++ b/src/mzscheme/src/stxobj.c @@ -150,6 +150,11 @@ typedef struct Module_Renames { set to a gensym created for the binding */ Scheme_Object *unmarshal_info; /* stores some renamings as infomation needed to consult imported modules and restore renames from their exports */ + Scheme_Hash_Table *free_id_renames; /* like `ht', but only for free-id=? checking, + and targets can also include: + id => resolve id (but cache if possible; never appears after simplifying) + (box (cons sym #f)) => top-level binding + (box (cons sym sym)) => lexical binding */ } Module_Renames; typedef struct Module_Renames_Set { @@ -209,6 +214,8 @@ static Module_Renames *krn; #define SCHEME_RENAMESP(obj) (SAME_TYPE(SCHEME_TYPE(obj), scheme_rename_table_type)) #define SCHEME_RENAMES_SETP(obj) (SAME_TYPE(SCHEME_TYPE(obj), scheme_rename_table_set_type)) +#define SCHEME_MODIDXP(obj) (SAME_TYPE(SCHEME_TYPE(obj), scheme_module_index_type)) + /* Wraps: A wrap is a list of wrap-elems and wrap-chunks. A wrap-chunk is a @@ -221,16 +228,23 @@ static Module_Renames *krn; - A wrap-elem <-num> is a certificate-only mark (doesn't conttribute to id equivalence) - - A wrap-elem (vector ... ...) is a lexical rename - env (sym var var-resolved + - A wrap-elem (vector ... ...) is a lexical rename + env (sym var : ->pos) void => not yet computed - or #f sym => mark check done, - var-resolved is answer to replace #f + or #f sym => var-resolved is answer to replace #f for nozero skipped ribs (rlistof (rcons skipped sym)) => generalization of sym - (mcons var-resolved next) => depends on unsealed rib - - A wrap-elem (vector ... ...) is also a lexical rename - var resolved + (mcons var-resolved next) => depends on unsealed rib, + will be cleared when rib set + or: + (cons (cons )) => + free-id=? renaming to on match + - A wrap-elem (vector ... ...) is also a lexical rename + var resolved: sym or (cons ), + where is module/lexical binding info: + (cons #f) => top-level binding + (cons ) => lexical binding + (vector ...) => module-binding where the variables have already been resolved and filtered (no mark or lexical-env comparison needed with the remaining wraps) @@ -813,7 +827,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: */ @@ -1007,6 +1021,8 @@ Scheme_Object *scheme_add_remove_mark(Scheme_Object *o, Scheme_Object *m) /******************** lexical renames ********************/ +#define RENAME_HT_THRESHOLD 15 + Scheme_Object *scheme_make_rename(Scheme_Object *newname, int c) { Scheme_Object *v; @@ -1014,7 +1030,7 @@ Scheme_Object *scheme_make_rename(Scheme_Object *newname, int c) v = scheme_make_vector((2 * c) + 2, NULL); SCHEME_VEC_ELS(v)[0] = newname; - if (c > 15) { + if (c > RENAME_HT_THRESHOLD) { Scheme_Hash_Table *ht; ht = scheme_make_hash_table(SCHEME_hash_ptr); SCHEME_VEC_ELS(v)[1] = (Scheme_Object *)ht; @@ -1028,6 +1044,21 @@ Scheme_Object *scheme_make_rename(Scheme_Object *newname, int c) return v; } +static void maybe_install_rename_hash_table(Scheme_Object *v) +{ + if (SCHEME_VEC_SIZE(v) > ((2 * RENAME_HT_THRESHOLD) + 2)) { + Scheme_Hash_Table *ht; + int i; + + ht = scheme_make_hash_table(SCHEME_hash_ptr); + MZ_OPT_HASH_KEY(&(ht->iso)) |= 0x1; + for (i = (SCHEME_VEC_SIZE(v) - 2) >> 1; i--; ) { + scheme_hash_set(ht, SCHEME_VEC_ELS(v)[i + 2], scheme_make_integer(i)); + } + SCHEME_VEC_ELS(v)[1] = (Scheme_Object *)ht; + } +} + void scheme_set_rename(Scheme_Object *rnm, int pos, Scheme_Object *oldname) { /* Every added name must be symbolicly distinct! */ @@ -1332,21 +1363,24 @@ static Scheme_Object *phase_to_index(Scheme_Object *phase) return phase; } -void scheme_extend_module_rename(Scheme_Object *mrn, - Scheme_Object *modname, /* actual source module */ - Scheme_Object *localname, /* name in local context */ - Scheme_Object *exname, /* name in definition context */ - Scheme_Object *nominal_mod, /* nominal source module */ - Scheme_Object *nominal_ex, /* nominal import before local renaming */ - int mod_phase, /* phase of source defn */ - Scheme_Object *src_phase_index, /* nominal import phase */ - Scheme_Object *nom_phase, /* nominal export phase */ - int unmarshal_drop) /* 1 => can be reconstructed from unmarshal info */ +Scheme_Object *scheme_extend_module_rename(Scheme_Object *mrn, + Scheme_Object *modname, /* actual source module */ + Scheme_Object *localname, /* name in local context */ + Scheme_Object *exname, /* name in definition context */ + Scheme_Object *nominal_mod, /* nominal source module */ + Scheme_Object *nominal_ex, /* nominal import before local renaming */ + int mod_phase, /* phase of source defn */ + Scheme_Object *src_phase_index, /* nominal import phase */ + Scheme_Object *nom_phase, /* nominal export phase */ + int mode) /* 1 => can be reconstructed from unmarshal info + 2 => free-id=? renaming + 3 => return info */ { Scheme_Object *elem; Scheme_Object *phase_index; - check_not_sealed((Module_Renames *)mrn); + if (mode != 3) + check_not_sealed((Module_Renames *)mrn); phase_index = phase_to_index(((Module_Renames *)mrn)->phase); if (!src_phase_index) @@ -1393,15 +1427,21 @@ void scheme_extend_module_rename(Scheme_Object *mrn, elem = CONS(modname, elem); } - if (unmarshal_drop) { + if (mode == 1) { if (!((Module_Renames *)mrn)->nomarshal_ht) { Scheme_Hash_Table *ht; ht = scheme_make_hash_table(SCHEME_hash_ptr); ((Module_Renames *)mrn)->nomarshal_ht = ht; } scheme_hash_set(((Module_Renames *)mrn)->nomarshal_ht, localname, elem); + } else if (mode == 2) { + scheme_hash_set(((Module_Renames *)mrn)->free_id_renames, localname, elem); + } else if (mode == 3) { + return elem; } else scheme_hash_set(((Module_Renames *)mrn)->ht, localname, elem); + + return NULL; } void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *modidx, @@ -1613,6 +1653,8 @@ void scheme_remove_module_rename(Scheme_Object *mrn, scheme_hash_set(((Module_Renames *)mrn)->ht, localname, NULL); if (((Module_Renames *)mrn)->nomarshal_ht) scheme_hash_set(((Module_Renames *)mrn)->nomarshal_ht, localname, NULL); + if (((Module_Renames *)mrn)->free_id_renames) + scheme_hash_set(((Module_Renames *)mrn)->free_id_renames, localname, NULL); } void scheme_list_module_rename(Scheme_Object *set, Scheme_Hash_Table *ht) @@ -1885,6 +1927,146 @@ Scheme_Object *scheme_add_rename_rib(Scheme_Object *o, Scheme_Object *rib) return scheme_add_rename(o, rib); } +static Scheme_Object *extract_module_free_id_binding(Scheme_Object *mrn, + Scheme_Object *id, + Scheme_Object *orig_id, + int *_sealed) +{ + Scheme_Object *result; + Scheme_Object *modname; + Scheme_Object *nominal_modidx; + Scheme_Object *nominal_name; + Scheme_Object *mod_phase; + Scheme_Object *src_phase_index; + Scheme_Object *nominal_src_phase; + Scheme_Object *lex_env; + + modname = scheme_stx_module_name(1, + &orig_id, ((Module_Renames *)mrn)->phase, &nominal_modidx, + &nominal_name, + &mod_phase, + &src_phase_index, + &nominal_src_phase, + &lex_env, + _sealed); + + if (!modname) + result = scheme_box(CONS(SCHEME_STX_VAL(orig_id), scheme_false)); + else if (SAME_OBJ(modname, scheme_undefined)) + result = scheme_box(CONS(SCHEME_STX_VAL(orig_id), lex_env)); + else + result = scheme_extend_module_rename(mrn, + modname, + id, /* name in local context */ + orig_id, /* name in definition context */ + nominal_modidx, /* nominal source module */ + nominal_name, /* nominal import before local renaming */ + SCHEME_INT_VAL(mod_phase), /* phase of source defn */ + src_phase_index, /* nominal import phase */ + nominal_src_phase, /* nominal export phase */ + 3); + + if (*_sealed) { + /* cache the result */ + scheme_hash_set(((Module_Renames *)mrn)->free_id_renames, id, result); + } + + return result; +} + +void scheme_install_free_id_rename(Scheme_Object *id, + Scheme_Object *orig_id, + Scheme_Object *rename_rib, + Scheme_Object *phase) +{ + Scheme_Object *v = NULL, *env, *r_id; + Scheme_Lexical_Rib *rib = NULL; + + if (rename_rib && (SCHEME_RENAMESP(rename_rib) || SCHEME_RENAMES_SETP(rename_rib))) { + /* Install a Module_Rename-level free-id=? rename, instead of at + the level of a lexical-rename. In this case, id is a symbol instead + of an identifier. */ + Module_Renames *rn; + + if (SCHEME_RENAMES_SETP(rename_rib)) + rename_rib = scheme_get_module_rename_from_set(rename_rib, phase, 1); + rn = (Module_Renames *)rename_rib; + + if (!rn->free_id_renames) { + Scheme_Hash_Table *ht; + ht = scheme_make_hash_table(SCHEME_hash_ptr); + rn->free_id_renames = ht; + } + + scheme_hash_set(rn->free_id_renames, id, orig_id); + + return; + } + + env = scheme_stx_moduleless_env(id); + + if (rename_rib) { + rib = (Scheme_Lexical_Rib *)rename_rib; + } else { + WRAP_POS wl; + + WRAP_POS_INIT(wl, ((Scheme_Stx *)id)->wraps); + while (!WRAP_POS_END_P(wl)) { + v = WRAP_POS_FIRST(wl); + if (SCHEME_VECTORP(v) && SAME_OBJ(SCHEME_VEC_ELS(v)[0], env)) { + break; + } if (SCHEME_RIBP(v)) { + rib = (Scheme_Lexical_Rib *)v; + while (rib) { + if (rib->rename) { + v = rib->rename; + if (SCHEME_VECTORP(v) && SAME_OBJ(SCHEME_VEC_ELS(v)[0], env)) + break; + v = NULL; + } + rib = rib->next; + } + } else + v = NULL; + WRAP_POS_INC(wl); + } + } + + while (v || rib) { + if (!v) { + while (rib) { + if (rib->rename) { + v = rib->rename; + if (SCHEME_VECTORP(v) && SAME_OBJ(SCHEME_VEC_ELS(v)[0], env)) + break; + v = NULL; + } + rib = rib->next; + } + } + + if (v) { + int i, sz; + + sz = SCHEME_RENAME_LEN(v); + for (i = 0; i < sz; i++) { + r_id = SCHEME_VEC_ELS(v)[i+2]; + if (SAME_OBJ(SCHEME_STX_SYM(r_id), SCHEME_STX_VAL(id))) { + /* Install rename: */ + env = SCHEME_VEC_ELS(v)[i+sz+2]; + if (SCHEME_PAIRP(env)) env = SCHEME_CAR(env); + env = CONS(env, CONS(orig_id, phase)); + SCHEME_VEC_ELS(v)[i+sz+2] = env; + return; + } + } + } + + v = NULL; + if (rib) rib = rib->next; + } +} + Scheme_Object *scheme_stx_phase_shift_as_rename(long shift, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Hash_Table *export_registry) { @@ -3650,6 +3832,11 @@ XFORM_NONGCING static Scheme_Object *filter_cached_env(Scheme_Object *other_env, { Scheme_Object *p; + if (SCHEME_PAIRP(other_env)) { + /* paired with free-id=? rename */ + other_env = SCHEME_CAR(other_env); + } + if (SCHEME_MPAIRP(other_env)) { other_env = SCHEME_CAR(other_env); if (!other_env) @@ -3674,6 +3861,12 @@ static Scheme_Object *extend_cached_env(Scheme_Object *orig, Scheme_Object *othe int depends_on_unsealed_rib) { Scheme_Object *in_mpair = NULL; + Scheme_Object *free_id_rename = NULL; + + if (SCHEME_PAIRP(orig)) { + free_id_rename = SCHEME_CDR(orig); + orig = SCHEME_CAR(orig); + } if (SCHEME_MPAIRP(orig)) { in_mpair = orig; @@ -3708,12 +3901,18 @@ static Scheme_Object *extend_cached_env(Scheme_Object *orig, Scheme_Object *othe if (in_mpair) { SCHEME_CAR(in_mpair) = orig; - return in_mpair; - } else - return orig; + orig = in_mpair; + } + + if (free_id_rename) { + orig = CONS(orig, free_id_rename); + } + + return orig; } -#define QUICK_STACK_SIZE 8 +/* This needs to be a multiple of 3: */ +#define QUICK_STACK_SIZE 12 /* Although resolve_env may call itself recursively, the recursion depth is bounded (by the fact that modules can't be nested, @@ -3723,15 +3922,17 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, Scheme_Object *a, Scheme_Object *orig_phase, int w_mod, Scheme_Object **get_names, Scheme_Object *skip_ribs, int *_binding_marks_skipped, - int *_depends_on_unsealed_rib, int depth) + int *_depends_on_unsealed_rib, int depth, int get_free_id_info) /* Module binding ignored if w_mod is 0. If module bound, result is module idx, and get_names[0] is set to source name, get_names[1] is set to the nominal source module, get_names[2] is set to the nominal source module's export, get_names[3] is set to the phase of the source definition, and get_names[4] is set to the nominal import phase index, and get_names[5] is set to the nominal export phase. - If lexically bound, result is env id, and a get_names[0] is set to scheme_undefined. - If neither, result is #f and get_names[0] is either unchanged or NULL. */ + If lexically bound, result is env id, and a get_names[0] is set to scheme_undefined; + get_names[1] is set if a free-id=? rename provides a different name for the bindig. + If neither, result is #f and get_names[0] is either unchanged or NULL; get_names[1] + is set if a free-id=? rename provides a different name. */ { WRAP_POS wraps; Scheme_Object *o_rename_stack = scheme_null, *recur_skip_ribs = skip_ribs; @@ -3745,7 +3946,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, Scheme_Object *bdg = NULL, *floating = NULL; Scheme_Hash_Table *export_registry = NULL; int mresult_skipped = -1; - int depends_on_unsealed_rib = 0; + int depends_on_unsealed_rib = 0, mresult_depends_unsealed = 0; EXPLAIN(fprintf(stderr, "%d Resolving %s [skips: %s]:\n", depth, SCHEME_SYM_VAL(SCHEME_STX_VAL(a)), scheme_write_to_string(skip_ribs ? skip_ribs : scheme_false, NULL))); @@ -3759,18 +3960,21 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, while (1) { if (WRAP_POS_END_P(wraps)) { /* See rename case for info on rename_stack: */ - Scheme_Object *result, *key; + Scheme_Object *result, *result_free_rename, *key; int did_lexical = 0; EXPLAIN(fprintf(stderr, "%d Rename...\n", depth)); result = scheme_false; + result_free_rename = scheme_false; while (!SCHEME_NULLP(o_rename_stack)) { key = SCHEME_CAAR(o_rename_stack); if (SAME_OBJ(key, result)) { EXPLAIN(fprintf(stderr, "%d Match %s\n", depth, scheme_write_to_string(key, 0))); did_lexical = 1; result = SCHEME_CDR(SCHEME_CAR(o_rename_stack)); + result_free_rename = SCHEME_CDR(result); + result = SCHEME_CAR(result); } else { EXPLAIN(fprintf(stderr, "%d No match %s\n", depth, scheme_write_to_string(key, 0))); if (SAME_OBJ(key, scheme_true)) { @@ -3785,6 +3989,7 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, if (SAME_OBJ(key, result)) { EXPLAIN(fprintf(stderr, "%d Match %s\n", depth, scheme_write_to_string(key, 0))); result = rename_stack[stack_pos - 2]; + result_free_rename = rename_stack[stack_pos - 3]; did_lexical = 1; } else { EXPLAIN(fprintf(stderr, "%d No match %s\n", depth, scheme_write_to_string(key, 0))); @@ -3793,14 +3998,65 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, did_lexical = 0; } } - stack_pos -= 2; + stack_pos -= 3; } if (!did_lexical) { result = mresult; if (_binding_marks_skipped) *_binding_marks_skipped = mresult_skipped; - } else if (get_names) - get_names[0] = scheme_undefined; + if (mresult_depends_unsealed) + depends_on_unsealed_rib = 1; + } else { + if (get_free_id_info && !SCHEME_VOIDP(result_free_rename)) { + Scheme_Object *orig; + int rib_dep = 0; + orig = result_free_rename; + result_free_rename = SCHEME_VEC_ELS(orig)[0]; + if (SCHEME_PAIRP(result_free_rename) && SCHEME_STXP(SCHEME_CAR(result_free_rename))) { + phase = SCHEME_CDR(result_free_rename); + if (!SCHEME_FALSEP(SCHEME_VEC_ELS(orig)[1])) + phase = scheme_bin_plus(phase, SCHEME_VEC_ELS(orig)[1]); + if (get_names) + get_names[1] = NULL; + result = resolve_env(NULL, SCHEME_CAR(result_free_rename), phase, + w_mod, get_names, + NULL, _binding_marks_skipped, + &rib_dep, depth + 1, 1); + if (get_names && !get_names[1]) + if (SCHEME_FALSEP(result) || SAME_OBJ(scheme_undefined, get_names[0])) + get_names[1] = SCHEME_STX_VAL(SCHEME_CAR(result_free_rename)); + } else if (SCHEME_PAIRP(result_free_rename) && SCHEME_SYMBOLP(SCHEME_CDR(result_free_rename))) { + if (get_names) + get_names[1] = SCHEME_CAR(result_free_rename); + result = SCHEME_CDR(result_free_rename); + if (get_names) + get_names[0] = scheme_undefined; + } else if (SCHEME_VECTORP(result_free_rename)) { + result = SCHEME_VEC_ELS(result_free_rename)[0]; + if (get_names) { + get_names[0] = SCHEME_VEC_ELS(result_free_rename)[1]; + get_names[1] = SCHEME_VEC_ELS(result_free_rename)[2]; + get_names[2] = SCHEME_VEC_ELS(result_free_rename)[3]; + get_names[3] = SCHEME_VEC_ELS(result_free_rename)[4]; + get_names[4] = SCHEME_VEC_ELS(result_free_rename)[5]; + get_names[5] = SCHEME_VEC_ELS(result_free_rename)[6]; + } + } else { + if (get_names) + get_names[1] = SCHEME_CAR(result_free_rename); + result = scheme_false; + } + if (rib_dep) + depends_on_unsealed_rib = 1; + if (SAME_TYPE(SCHEME_TYPE(result), scheme_module_index_type)) + result = scheme_modidx_shift(result, SCHEME_VEC_ELS(orig)[2], SCHEME_VEC_ELS(orig)[3]); + } else { + if (get_names) { + get_names[0] = scheme_undefined; + get_names[1] = NULL; + } + } + } if (_depends_on_unsealed_rib) *_depends_on_unsealed_rib = depends_on_unsealed_rib; @@ -3844,13 +4100,13 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, EXPLAIN(fprintf(stderr, "%d {unmarshal}\n", depth)); unmarshal_rename(mrn, modidx_shift_from, modidx_shift_to, export_registry); } - - if (mrn->marked_names) { + + if (mrn->marked_names) { /* Resolve based on rest of wraps: */ EXPLAIN(fprintf(stderr, "%d tl_id_sym\n", depth)); if (!bdg) { EXPLAIN(fprintf(stderr, "%d get bdg\n", depth)); - bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1); + bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, 0); if (SCHEME_FALSEP(bdg)) { if (!floating_checked) { floating = check_floating_id(a); @@ -3880,7 +4136,21 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, EXPLAIN(fprintf(stderr, "%d search %s\n", depth, scheme_write_to_string(glob_id, 0))); - rename = scheme_hash_get(mrn->ht, glob_id); + if (get_free_id_info && mrn->free_id_renames) { + rename = scheme_hash_get(mrn->free_id_renames, glob_id); + if (rename && SCHEME_STXP(rename)) { + int sealed; + rename = extract_module_free_id_binding((Scheme_Object *)mrn, + glob_id, + rename, + &sealed); + if (!sealed) + mresult_depends_unsealed = 1; + } + } else + rename = NULL; + if (!rename) + rename = scheme_hash_get(mrn->ht, glob_id); if (!rename && mrn->nomarshal_ht) rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); if (!rename && mrn->plus_kernel) { @@ -3898,6 +4168,9 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, EXPLAIN(fprintf(stderr, "%d search result: %p\n", depth, rename)); if (rename) { + if (mrn->sealed < STX_SEAL_BOUND) + mresult_depends_unsealed = 1; + if (mrn->kind == mzMOD_RENAME_MARKED) { /* One job of a mzMOD_RENAME_MARKED renamer is to replace any binding that might have come from the identifier in its source @@ -3907,90 +4180,105 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } /* match; set mresult, which is used in the case of no lexical capture: */ - if (SCHEME_PAIRP(rename)) - mresult = SCHEME_CAR(rename); - else - mresult = rename; - - if (modidx_shift_from) - mresult = scheme_modidx_shift(mresult, - modidx_shift_from, - modidx_shift_to); - mresult_skipped = skipped; + + if (SCHEME_BOXP(rename)) { + /* This should only happen for mappings from free_id_renames */ + mresult = SCHEME_BOX_VAL(rename); + if (get_names) { + if (SCHEME_FALSEP(SCHEME_CDR(mresult))) + get_names[0] = NULL; + else + get_names[0] = scheme_undefined; + get_names[1] = SCHEME_CAR(mresult); + } + mresult = SCHEME_CDR(mresult); + } else { + if (SCHEME_PAIRP(rename)) + mresult = SCHEME_CAR(rename); + else + mresult = rename; + + if (modidx_shift_from) + mresult = scheme_modidx_shift(mresult, + modidx_shift_from, + modidx_shift_to); - if (get_names) { - int no_shift = 0; + if (get_names) { + int no_shift = 0; - if (!get_names_done) { - if (SCHEME_PAIRP(rename)) { - if (nom_mod_p(rename)) { - /* (cons modidx nominal_modidx) case */ - get_names[0] = glob_id; - get_names[1] = SCHEME_CDR(rename); - get_names[2] = get_names[0]; - } else { - rename = SCHEME_CDR(rename); - if (SCHEME_PAIRP(rename)) { - /* (list* modidx [mod-phase] exportname nominal_modidx nominal_exportname) case */ - if (SCHEME_INTP(SCHEME_CAR(rename)) - || SCHEME_FALSEP(SCHEME_CAR(rename))) { - get_names[3] = SCHEME_CAR(rename); - rename = SCHEME_CDR(rename); - } - get_names[0] = SCHEME_CAR(rename); - get_names[1] = SCHEME_CADR(rename); - if (SCHEME_PAIRP(get_names[1])) { - get_names[4] = SCHEME_CDR(get_names[1]); - get_names[1] = SCHEME_CAR(get_names[1]); - if (SCHEME_PAIRP(get_names[4])) { - get_names[5] = SCHEME_CDR(get_names[4]); - get_names[4] = SCHEME_CAR(get_names[4]); - } else { - get_names[5] = get_names[3]; - } - } - get_names[2] = SCHEME_CDDR(rename); + if (!get_names_done) { + if (SCHEME_PAIRP(rename)) { + if (nom_mod_p(rename)) { + /* (cons modidx nominal_modidx) case */ + get_names[0] = glob_id; + get_names[1] = SCHEME_CDR(rename); + get_names[2] = get_names[0]; } else { - /* (cons modidx exportname) case */ - get_names[0] = rename; - get_names[2] = NULL; /* finish below */ + rename = SCHEME_CDR(rename); + if (SCHEME_PAIRP(rename)) { + /* (list* modidx [mod-phase] exportname nominal_modidx nominal_exportname) case */ + if (SCHEME_INTP(SCHEME_CAR(rename)) + || SCHEME_FALSEP(SCHEME_CAR(rename))) { + get_names[3] = SCHEME_CAR(rename); + rename = SCHEME_CDR(rename); + } + get_names[0] = SCHEME_CAR(rename); + get_names[1] = SCHEME_CADR(rename); + if (SCHEME_PAIRP(get_names[1])) { + get_names[4] = SCHEME_CDR(get_names[1]); + get_names[1] = SCHEME_CAR(get_names[1]); + if (SCHEME_PAIRP(get_names[4])) { + get_names[5] = SCHEME_CDR(get_names[4]); + get_names[4] = SCHEME_CAR(get_names[4]); + } else { + get_names[5] = get_names[3]; + } + } + get_names[2] = SCHEME_CDDR(rename); + } else { + /* (cons modidx exportname) case */ + get_names[0] = rename; + get_names[2] = NULL; /* finish below */ + } + } + } else { + get_names[0] = glob_id; + get_names[2] = NULL; /* finish below */ + } + + if (!get_names[2]) { + get_names[2] = get_names[0]; + if (nominal) + get_names[1] = nominal; + else { + no_shift = 1; + get_names[1] = mresult; } } - } else { - get_names[0] = glob_id; - get_names[2] = NULL; /* finish below */ - } - - if (!get_names[2]) { - get_names[2] = get_names[0]; - if (nominal) - get_names[1] = nominal; - else { - no_shift = 1; - get_names[1] = mresult; + if (!get_names[4]) { + GC_CAN_IGNORE Scheme_Object *pi; + pi = phase_to_index(mrn->phase); + get_names[4] = pi; + } + if (!get_names[5]) { + get_names[5] = get_names[3]; } } - if (!get_names[4]) { - GC_CAN_IGNORE Scheme_Object *pi; - pi = phase_to_index(mrn->phase); - get_names[4] = pi; - } - if (!get_names[5]) { - get_names[5] = get_names[3]; - } - } - if (modidx_shift_from && !no_shift) { - Scheme_Object *nom; - nom = get_names[1]; - nom = scheme_modidx_shift(nom, - modidx_shift_from, - modidx_shift_to); - get_names[1] = nom; + if (modidx_shift_from && !no_shift) { + Scheme_Object *nom; + nom = get_names[1]; + nom = scheme_modidx_shift(nom, + modidx_shift_from, + modidx_shift_to); + get_names[1] = nom; + } } } - } else { + } else { + if (mrn->sealed < STX_SEAL_ALL) + mresult_depends_unsealed = 1; mresult = scheme_false; mresult_skipped = -1; if (get_names) @@ -4082,26 +4370,36 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, int same; { - Scheme_Object *other_env, *envname; + Scheme_Object *other_env, *envname, *free_id_rename; if (SCHEME_SYMBOLP(renamed)) { /* Simplified table */ other_env = scheme_false; envname = SCHEME_VEC_ELS(rename)[2+c+ri]; + if (SCHEME_PAIRP(envname)) { + free_id_rename = SCHEME_CDR(envname); + envname = SCHEME_CAR(envname); + } else + free_id_rename = scheme_void; same = 1; no_lexical = 1; /* simplified table always has final result */ - EXPLAIN(fprintf(stderr, "%d Targes %s <- %s\n", depth, + EXPLAIN(fprintf(stderr, "%d Targes %s <- %s %p\n", depth, scheme_write_to_string(envname, 0), - scheme_write_to_string(other_env, 0))); + scheme_write_to_string(other_env, 0), + free_id_rename)); } else { envname = SCHEME_VEC_ELS(rename)[0]; other_env = SCHEME_VEC_ELS(rename)[2+c+ri]; + if (SCHEME_PAIRP(other_env)) + free_id_rename = SCHEME_CDR(other_env); + else + free_id_rename = scheme_void; other_env = filter_cached_env(other_env, recur_skip_ribs); if (SCHEME_VOIDP(other_env)) { int rib_dep = 0; SCHEME_USE_FUEL(1); - other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs, NULL, &rib_dep, depth+1); + other_env = resolve_env(NULL, renamed, 0, 0, NULL, recur_skip_ribs, NULL, &rib_dep, depth+1, 0); { Scheme_Object *e; e = extend_cached_env(SCHEME_VEC_ELS(rename)[2+c+ri], other_env, recur_skip_ribs, @@ -4134,11 +4432,22 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, top element of the stack and combine the two mappings, but the intermediate name may be needed (for other_env values that don't come from this stack). */ + if (get_free_id_info && !SCHEME_VOIDP(free_id_rename)) { + /* Need to remember phase ad shifts for free-id=? rename: */ + Scheme_Object *vec; + vec = scheme_make_vector(4, NULL); + SCHEME_VEC_ELS(vec)[0] = free_id_rename; + SCHEME_VEC_ELS(vec)[1] = phase; + SCHEME_VEC_ELS(vec)[2] = modidx_shift_from; + SCHEME_VEC_ELS(vec)[3] = modidx_shift_to; + free_id_rename = vec; + } if (stack_pos < QUICK_STACK_SIZE) { + rename_stack[stack_pos++] = free_id_rename; rename_stack[stack_pos++] = envname; rename_stack[stack_pos++] = other_env; } else { - o_rename_stack = CONS(CONS(other_env, envname), + o_rename_stack = CONS(CONS(other_env, CONS(envname, free_id_rename)), o_rename_stack); } if (is_rib) { @@ -4209,18 +4518,22 @@ static Scheme_Object *resolve_env(WRAP_POS *_wraps, } } -static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_phase) +static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_phase, int use_free_id_renames) /* Gets a module source name under the assumption that the identifier is not lexically renamed. This is used as a quick pre-test for - free-identifier=?. */ + free-identifier=?. We do have to look at lexical renames to check for + equivalences installed on detection of make-rename-transformer, but at least + we can normally cache the result. */ { WRAP_POS wraps; Scheme_Object *result, *result_from; int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL, floating_checked = 0; + int no_lexical = !use_free_id_renames; Scheme_Object *phase = orig_phase; Scheme_Object *bdg = NULL, *floating = NULL; - if (SAME_OBJ(phase, scheme_make_integer(0)) + if (!use_free_id_renames + && SAME_OBJ(phase, scheme_make_integer(0)) && ((Scheme_Stx *)a)->u.modinfo_cache) return ((Scheme_Stx *)a)->u.modinfo_cache; @@ -4238,7 +4551,7 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if (!result) result = SCHEME_STX_VAL(a); - if (can_cache && SAME_OBJ(orig_phase, scheme_make_integer(0))) + if (can_cache && SAME_OBJ(orig_phase, scheme_make_integer(0)) && !use_free_id_renames) ((Scheme_Stx *)a)->u.modinfo_cache = result; return result; @@ -4279,13 +4592,13 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if (mrn->needs_unmarshal) { /* Use resolve_env to trigger unmarshal, so that we don't have to implement top/from shifts here: */ - resolve_env(NULL, a, orig_phase, 1, NULL, NULL, NULL, NULL, 0); + resolve_env(NULL, a, orig_phase, 1, NULL, NULL, NULL, NULL, 0, 0); } if (mrn->marked_names) { /* Resolve based on rest of wraps: */ if (!bdg) - bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL, NULL, NULL, 0); + bdg = resolve_env(&wraps, a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, 0); if (SCHEME_FALSEP(bdg)) { if (!floating_checked) { floating = check_floating_id(a); @@ -4295,10 +4608,30 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ } /* 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); + + if (SCHEME_TRUEP(bdg) + && !SAME_OBJ(glob_id, SCHEME_STX_VAL(a))) { + /* See "Even if this module doesn't match, the lex-renamed id" in resolve_env() */ + no_lexical = 1; + } } else glob_id = SCHEME_STX_VAL(a); - rename = scheme_hash_get(mrn->ht, glob_id); + if (use_free_id_renames && mrn->free_id_renames) { + rename = scheme_hash_get(mrn->free_id_renames, glob_id); + if (rename && SCHEME_STXP(rename)) { + int sealed; + rename = extract_module_free_id_binding((Scheme_Object *)mrn, + glob_id, + rename, + &sealed); + if (!sealed) + sealed = 0; + } + } else + rename = NULL; + if (!rename) + rename = scheme_hash_get(mrn->ht, glob_id); if (!rename && mrn->nomarshal_ht) rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); if (!rename && mrn->plus_kernel) @@ -4310,7 +4643,11 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ /* match; set result: */ if (mrn->kind == mzMOD_RENAME_MARKED) skip_other_mods = 1; - if (SCHEME_PAIRP(rename)) { + if (SCHEME_BOXP(rename)) { + /* only happens with free_id_renames */ + rename = SCHEME_BOX_VAL(rename); + result = SCHEME_CAR(rename); + } else if (SCHEME_PAIRP(rename)) { if (nom_mod_p(rename)) { result = glob_id; } else { @@ -4332,10 +4669,98 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ n = SCHEME_VEC_ELS(vec)[0]; if (SCHEME_TRUEP(phase)) phase = scheme_bin_minus(phase, n); + } else if (!no_lexical + && (SCHEME_VECTORP(WRAP_POS_FIRST(wraps)) + || SCHEME_RIBP(WRAP_POS_FIRST(wraps)))) { + /* Lexical rename */ + Scheme_Object *rename, *renamed, *renames; + Scheme_Lexical_Rib *rib; + int ri, istart, iend; + + rename = WRAP_POS_FIRST(wraps); + if (SCHEME_RIBP(rename)) { + rib = ((Scheme_Lexical_Rib *)rename)->next; + rename = NULL; + } else { + rib = NULL; + if (SCHEME_FALSEP(SCHEME_VEC_ELS(rename)[0])) { + /* No free-id=? renames here. */ + rename = NULL; + } + } + + do { + if (rib) { + if (!*rib->sealed) sealed = 0; + rename = rib->rename; + rib = rib->next; + } + + if (rename) { + int c = SCHEME_RENAME_LEN(rename); + + /* Get index from hash table, if there is one: */ + if (!SCHEME_FALSEP(SCHEME_VEC_ELS(rename)[1])) { + void *pos; + pos = scheme_hash_get((Scheme_Hash_Table *)(SCHEME_VEC_ELS(rename)[1]), SCHEME_STX_VAL(a)); + if (pos) { + istart = SCHEME_INT_VAL(pos); + if (istart < 0) { + /* -1 indicates multiple slots matching this name. */ + istart = 0; + iend = c; + } else + iend = istart + 1; + } else { + istart = 0; + iend = 0; + } + } else { + istart = 0; + iend = c; + } + + for (ri = istart; ri < iend; ri++) { + renamed = SCHEME_VEC_ELS(rename)[2+ri]; + if (SAME_OBJ(SCHEME_STX_VAL(a), SCHEME_STX_SYM(renamed))) { + /* Check for free-id mapping: */ + renames = SCHEME_VEC_ELS(rename)[2 + ri + c]; + if (SCHEME_PAIRP(renames)) { + /* Has a relevant-looking free-id mapping. + Give up on the "fast" traversal. */ + Scheme_Object *modname, *names[6]; + int rib_dep; + + names[0] = NULL; + names[1] = NULL; + names[3] = scheme_make_integer(0); + names[4] = NULL; + names[5] = NULL; + + modname = resolve_env(NULL, a, orig_phase, 1, names, NULL, NULL, &rib_dep, 0, 1); + if (rib_dep) + sealed = 0; + + if (!SCHEME_FALSEP(modname) + && !SAME_OBJ(names[0], scheme_undefined)) { + result = names[0]; + } else { + result = names[1]; /* can be NULL or alternate name */ + } + + WRAP_POS_INIT_END(wraps); + rib = NULL; + break; + } + } + } + } + } while (rib); } /* Keep looking: */ - WRAP_POS_INC(wraps); + if (!WRAP_POS_END_P(wraps)) + WRAP_POS_INC(wraps); } } @@ -4346,16 +4771,16 @@ int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *pha if (!a || !b) return (a == b); + if (SCHEME_STXP(b)) + bsym = get_module_src_name(b, phase, !asym); + else + bsym = b; if (!asym) { if (SCHEME_STXP(a)) - asym = get_module_src_name(a, phase); + asym = get_module_src_name(a, phase, 1); else asym = a; } - if (SCHEME_STXP(b)) - bsym = get_module_src_name(b, phase); - else - bsym = b; /* Same name? */ if (!SAME_OBJ(asym, bsym)) @@ -4364,8 +4789,8 @@ int scheme_stx_module_eq2(Scheme_Object *a, Scheme_Object *b, Scheme_Object *pha if ((a == asym) || (b == bsym)) return 1; - a = resolve_env(NULL, a, phase, 1, NULL, NULL, NULL, NULL, 0); - b = resolve_env(NULL, b, phase, 1, NULL, NULL, NULL, NULL, 0); + a = resolve_env(NULL, a, phase, 1, NULL, NULL, NULL, NULL, 0, 1); + b = resolve_env(NULL, b, phase, 1, NULL, NULL, NULL, NULL, 0, 1); if (SAME_TYPE(SCHEME_TYPE(a), scheme_module_index_type)) a = scheme_module_resolve(a, 0); @@ -4384,34 +4809,47 @@ int scheme_stx_module_eq(Scheme_Object *a, Scheme_Object *b, long phase) Scheme_Object *scheme_stx_get_module_eq_sym(Scheme_Object *a, Scheme_Object *phase) { if (SCHEME_STXP(a)) - return get_module_src_name(a, phase); + return get_module_src_name(a, phase, 0); else return a; } -Scheme_Object *scheme_stx_module_name(Scheme_Object **a, Scheme_Object *phase, +Scheme_Object *scheme_stx_module_name(int recur, + Scheme_Object **a, Scheme_Object *phase, Scheme_Object **nominal_modidx, Scheme_Object **nominal_name, Scheme_Object **mod_phase, Scheme_Object **src_phase_index, - Scheme_Object **nominal_src_phase) + Scheme_Object **nominal_src_phase, + Scheme_Object **lex_env, + int *_sealed) /* If module bound, result is module idx, and a is set to source name. - If lexically bound, result is scheme_undefined and a is unchanged. - If neither, result is NULL and a is unchanged. */ + If lexically bound, result is scheme_undefined, a is unchanged, + and nominal_name is NULL or a free_id=? renamed id. + If neither, result is NULL, a is unchanged, and + and nominal_name is NULL or a free_id=? renamed id. */ { if (SCHEME_STXP(*a)) { Scheme_Object *modname, *names[6]; + int rib_dep; names[0] = NULL; + names[1] = NULL; names[3] = scheme_make_integer(0); names[4] = NULL; names[5] = NULL; - modname = resolve_env(NULL, *a, phase, 1, names, NULL, NULL, NULL, 0); + modname = resolve_env(NULL, *a, phase, 1, names, NULL, NULL, _sealed ? &rib_dep : NULL, 0, recur); + + if (_sealed) *_sealed = !rib_dep; if (names[0]) { if (SAME_OBJ(names[0], scheme_undefined)) { - return scheme_undefined; + if (lex_env) + *lex_env = modname; + if (nominal_name) + *nominal_name = names[1]; + return scheme_undefined; } else { *a = names[0]; if (nominal_modidx) @@ -4426,10 +4864,15 @@ Scheme_Object *scheme_stx_module_name(Scheme_Object **a, Scheme_Object *phase, *nominal_src_phase = names[5]; return modname; } - } else + } else { + if (nominal_name) *nominal_name = names[1]; return NULL; - } else + } + } else { + if (nominal_name) *nominal_name = NULL; + if (_sealed) *_sealed = 1; return NULL; + } } int scheme_stx_ribs_matter(Scheme_Object *a, Scheme_Object *skip_ribs) @@ -4442,8 +4885,8 @@ int scheme_stx_ribs_matter(Scheme_Object *a, Scheme_Object *skip_ribs) skip_ribs = SCHEME_CDR(skip_ribs); } - m1 = resolve_env(NULL, a, scheme_make_integer(0), 1, NULL, NULL, NULL, NULL, 0); - m2 = resolve_env(NULL, a, scheme_make_integer(0), 1, NULL, skips, NULL, NULL, 0); + m1 = resolve_env(NULL, a, scheme_make_integer(0), 1, NULL, NULL, NULL, NULL, 0, 0); + m2 = resolve_env(NULL, a, scheme_make_integer(0), 1, NULL, skips, NULL, NULL, 0, 0); return !SAME_OBJ(m1, m2); } @@ -4454,7 +4897,7 @@ Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a) if (SCHEME_STXP(a)) { Scheme_Object *r; - r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL, NULL, NULL, 0); + r = resolve_env(NULL, a, scheme_make_integer(0), 0, NULL, NULL, NULL, NULL, 0, 0); if (SCHEME_FALSEP(r)) r = check_floating_id(a); @@ -4486,13 +4929,13 @@ int scheme_stx_env_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *u if (!SAME_OBJ(asym, bsym)) return 0; - ae = resolve_env(NULL, a, phase, 0, NULL, NULL, NULL, NULL, 0); + ae = resolve_env(NULL, a, phase, 0, NULL, NULL, NULL, NULL, 0, 0); /* No need to module_resolve ae, because we ignored module renamings. */ if (uid) be = uid; else { - be = resolve_env(NULL, b, phase, 0, NULL, NULL, NULL, NULL, 0); + be = resolve_env(NULL, b, phase, 0, NULL, NULL, NULL, NULL, 0, 0); /* No need to module_resolve be, because we ignored module renamings. */ } @@ -4522,7 +4965,7 @@ int scheme_stx_bound_eq(Scheme_Object *a, Scheme_Object *b, Scheme_Object *phase Scheme_Object *scheme_explain_resolve_env(Scheme_Object *a) { scheme_explain_resolves++; - a = resolve_env(NULL, a, 0, 0, NULL, NULL, NULL, NULL, 0); + a = resolve_env(NULL, a, 0, 0, NULL, NULL, NULL, NULL, 0, 1); --scheme_explain_resolves; return a; } @@ -4909,6 +5352,44 @@ static void print_skips(Scheme_Object *skips) #define EXPLAIN_S(x) /* empty */ #endif +static Scheme_Object *extract_free_id_info(Scheme_Object *id) +{ + Scheme_Object *bind; + Scheme_Object *nominal_modidx; + Scheme_Object *nominal_name; + Scheme_Object *mod_phase; + Scheme_Object *src_phase_index; + Scheme_Object *nominal_src_phase; + Scheme_Object *lex_env = NULL; + Scheme_Object *vec, *phase; + + phase = SCHEME_CDR(id); + id = SCHEME_CAR(id); + + bind = scheme_stx_module_name(1, + &id, phase, &nominal_modidx, &nominal_name, + &mod_phase, &src_phase_index, &nominal_src_phase, + &lex_env, NULL); + if (!nominal_name) + nominal_name = SCHEME_STX_VAL(id); + + if (!bind) + return CONS(nominal_name, scheme_false); + else if (SAME_OBJ(bind, scheme_undefined)) + return CONS(nominal_name, lex_env); + else { + vec = scheme_make_vector(7, NULL); + SCHEME_VEC_ELS(vec)[0] = bind; + SCHEME_VEC_ELS(vec)[1] = id; + SCHEME_VEC_ELS(vec)[2] = nominal_modidx; + SCHEME_VEC_ELS(vec)[3] = nominal_name; + SCHEME_VEC_ELS(vec)[4] = mod_phase; + SCHEME_VEC_ELS(vec)[5] = src_phase_index; + SCHEME_VEC_ELS(vec)[6] = nominal_src_phase; + return vec; + } +} + static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Table *lex_cache) { WRAP_POS w, prev, w2; @@ -5031,7 +5512,7 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab other_env = filter_cached_env(other_env, prec_ribs); if (SCHEME_VOIDP(other_env)) { int rib_dep; - other_env = resolve_env(NULL, stx, 0, 0, NULL, prec_ribs, NULL, &rib_dep, 0); + other_env = resolve_env(NULL, stx, 0, 0, NULL, prec_ribs, NULL, &rib_dep, 0, 0); if (rib_dep) { scheme_signal_error("compile: unsealed local-definition context found in fully expanded form"); return NULL; @@ -5187,7 +5668,7 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab answer applies. */ Scheme_Object *ok = NULL, *ok_replace = NULL; int ok_replace_index = 0; - Scheme_Object *other_env; + Scheme_Object *other_env, *free_id_rename, *prev_env, *orig_prev_env; if (rib) { EXPLAIN_S(fprintf(stderr, " resolve %s %s (%d)\n", @@ -5197,16 +5678,26 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab } other_env = SCHEME_VEC_ELS(v)[2+vvsize+ii]; + if (SCHEME_PAIRP(other_env)) + free_id_rename = extract_free_id_info(SCHEME_CDR(other_env)); + else + free_id_rename = NULL; other_env = filter_cached_env(other_env, prec_ribs); if (SCHEME_VOIDP(other_env)) { int rib_dep; - other_env = resolve_env(NULL, stx, 0, 0, NULL, prec_ribs, NULL, &rib_dep, 0); + other_env = resolve_env(NULL, stx, 0, 0, NULL, prec_ribs, NULL, &rib_dep, 0, 0); if (rib_dep) { scheme_signal_error("compile: unsealed local-definition context found in fully expanded form"); return NULL; } - if (!prec_ribs) - SCHEME_VEC_ELS(v)[2+vvsize+ii] = other_env; + if (!prec_ribs) { + if (free_id_rename) + ok = CONS(other_env, free_id_rename); + else + ok = other_env; + SCHEME_VEC_ELS(v)[2+vvsize+ii] = ok; + ok = NULL; + } } if (!WRAP_POS_END_P(prev) @@ -5221,7 +5712,7 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab } if (other_env) { - /* A simplified table need to have the final answer, so + /* A simplified table needs to have the final answer, so fold conversions from the rest of the wraps. In the case of ribs, the "rest" can include earlier rib renamings. Otherwise, check simplications accumulated in v2l (possibly from a @@ -5233,10 +5724,15 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab for (j = 0; j < done_rib_pos; j++) { if (SAME_OBJ(SCHEME_VEC_ELS(v2)[2+j], name)) { rib_found = 1; - if (SAME_OBJ(SCHEME_VEC_ELS(v2)[2+size+j], other_env)) { + prev_env = SCHEME_VEC_ELS(v2)[2+size+j]; + orig_prev_env = prev_env; + if (SCHEME_PAIRP(prev_env)) prev_env = SCHEME_CAR(prev_env); + if (SAME_OBJ(prev_env, other_env)) { ok = SCHEME_VEC_ELS(v)[0]; ok_replace = v2; ok_replace_index = 2 + size + j; + if (!free_id_rename && SCHEME_PAIRP(orig_prev_env)) + free_id_rename = SCHEME_CDR(orig_prev_env); } else { EXPLAIN_S(fprintf(stderr, " not matching prev rib\n")); ok = NULL; @@ -5259,8 +5755,13 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab psize = SCHEME_RENAME_LEN(vp); for (j = 0; j < psize; j++) { if (SAME_OBJ(SCHEME_VEC_ELS(vp)[2+j], name)) { - if (SAME_OBJ(SCHEME_VEC_ELS(vp)[2+psize+j], other_env)) { + prev_env = SCHEME_VEC_ELS(vp)[2+psize+j]; + orig_prev_env = prev_env; + if (SCHEME_PAIRP(prev_env)) prev_env = SCHEME_CAR(prev_env); + if (SAME_OBJ(prev_env, other_env)) { ok = SCHEME_VEC_ELS(v)[0]; + if (!free_id_rename && SCHEME_PAIRP(orig_prev_env)) + free_id_rename = SCHEME_CDR(orig_prev_env); } else { EXPLAIN_S(fprintf(stderr, " not matching deeper %s\n", @@ -5309,6 +5810,8 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab } if (ok) { + if (free_id_rename) + ok = CONS(ok, free_id_rename); if (ok_replace) { EXPLAIN_S(fprintf(stderr, " replace mapping %s\n", scheme_write_to_string(ok, NULL))); @@ -5346,7 +5849,13 @@ static Scheme_Object *simplify_lex_renames(Scheme_Object *wraps, Scheme_Hash_Tab } SCHEME_VEC_ELS(v2)[0] = scheme_false; + for (i = 0; i < pos; i++) { + if (!SCHEME_SYMBOLP(SCHEME_VEC_ELS(v2)[2+pos+i])) + SCHEME_VEC_ELS(v2)[0] = scheme_true; + } + SCHEME_VEC_ELS(v2)[1] = scheme_false; + maybe_install_rename_hash_table(v2); if (no_rib_mutation) { /* Sometimes we generate the same simplified lex table, so @@ -5524,6 +6033,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, /* Not useful if there's no marked names. */ redundant = ((mrn->sealed >= STX_SEAL_ALL) && (!mrn->marked_names || !mrn->marked_names->count) + && (!mrn->free_id_renames || !mrn->free_id_renames->count) && SCHEME_NULLP(mrn->shared_pes)); if (!redundant) { /* Otherwise, watch out for multiple instances of the same rename: */ @@ -5579,6 +6089,32 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, if (just_simplify) { stack = CONS((Scheme_Object *)mrn, stack); } else { + if (mrn->free_id_renames) { + /* resolve all renamings */ + int i; + Scheme_Object *b; + for (i = mrn->free_id_renames->size; i--; ) { + if (mrn->free_id_renames->vals[i]) { + if (SCHEME_STXP(mrn->free_id_renames->vals[i])) { + int sealed; + b = extract_module_free_id_binding((Scheme_Object *)mrn, + mrn->free_id_renames->keys[i], + mrn->free_id_renames->vals[i], + &sealed); + if (!sealed) { + extract_module_free_id_binding((Scheme_Object *)mrn, + mrn->free_id_renames->keys[i], + mrn->free_id_renames->vals[i], + &sealed); + scheme_signal_error("write: unsealed local-definition or module context" + " found in syntax object"); + } + scheme_hash_set(mrn->free_id_renames, mrn->free_id_renames->keys[i], b); + } + } + } + } + if (mrn->kind == mzMOD_RENAME_TOPLEVEL) { if (same_phase(mrn->phase, scheme_make_integer(0))) stack = CONS(scheme_true, stack); @@ -5589,21 +6125,34 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, local_key = scheme_marshal_lookup(mt, (Scheme_Object *)mrn); if (!local_key) { - /* Convert hash table to vector: */ + /* Convert hash table to vector, etc.: */ int i, j, count = 0; - Scheme_Object *l; + Scheme_Hash_Table *ht; + Scheme_Object *l, *fil; - count = mrn->ht->count; - - l = scheme_make_vector(count * 2, NULL); - - for (i = mrn->ht->size, j = 0; i--; ) { - if (mrn->ht->vals[i]) { - SCHEME_VEC_ELS(l)[j++] = mrn->ht->keys[i]; - SCHEME_VEC_ELS(l)[j++] = mrn->ht->vals[i]; + ht = mrn->ht; + count = ht->count; + l = scheme_make_vector(count * 2, NULL); + for (i = ht->size, j = 0; i--; ) { + if (ht->vals[i]) { + SCHEME_VEC_ELS(l)[j++] = ht->keys[i]; + SCHEME_VEC_ELS(l)[j++] = ht->vals[i]; } } + ht = mrn->free_id_renames; + if (ht && ht->count) { + count = ht->count; + fil = scheme_make_vector(count * 2, NULL); + for (i = ht->size, j = 0; i--; ) { + if (ht->vals[i]) { + SCHEME_VEC_ELS(fil)[j++] = ht->keys[i]; + SCHEME_VEC_ELS(fil)[j++] = ht->vals[i]; + } + } + } else + fil = NULL; + if (mrn->marked_names && mrn->marked_names->count) { Scheme_Object *d = scheme_null, *p; @@ -5617,10 +6166,17 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *w_in, } } - l = CONS(l, d); - } else - l = CONS(l, scheme_null); - + if (fil) + fil = CONS(fil, d); + else + fil = d; + } else if (fil) + fil = CONS(fil, scheme_null); + else + fil = scheme_null; + + l = CONS(l, fil); + if (SCHEME_PAIRP(mrn->unmarshal_info)) l = CONS(mrn->unmarshal_info, l); @@ -6150,6 +6706,100 @@ static int ok_phase_index(Scheme_Object *o) { return ok_phase(o); } +static Scheme_Object *datum_to_module_renames(Scheme_Object *a, Scheme_Hash_Table *ht, int lex_ok) +{ + int count, i; + Scheme_Object *key, *p; + + if (!SCHEME_VECTORP(a)) return_NULL; + count = SCHEME_VEC_SIZE(a); + if (count & 0x1) return_NULL; + + for (i = 0; i < count; i+= 2) { + key = SCHEME_VEC_ELS(a)[i]; + p = SCHEME_VEC_ELS(a)[i+1]; + + if (!SCHEME_SYMBOLP(key)) return_NULL; + + if (SAME_TYPE(SCHEME_TYPE(p), scheme_module_index_type)) { + /* Ok */ + } else if (SCHEME_PAIRP(p)) { + Scheme_Object *midx; + + midx = SCHEME_CAR(p); + if (!SAME_TYPE(SCHEME_TYPE(midx), scheme_module_index_type)) + return_NULL; + + if (SCHEME_SYMBOLP(SCHEME_CDR(p))) { + /* Ok */ + } else if (SAME_TYPE(SCHEME_TYPE(SCHEME_CDR(p)), scheme_module_index_type)) { + /* Ok */ + } else { + Scheme_Object *ap, *bp; + + ap = SCHEME_CDR(p); + if (!SCHEME_PAIRP(ap)) + return_NULL; + + /* mod-phase, maybe */ + if (SCHEME_INTP(SCHEME_CAR(ap))) { + bp = SCHEME_CDR(ap); + } else + bp = ap; + + /* exportname */ + if (!SCHEME_PAIRP(bp)) + return_NULL; + ap = SCHEME_CAR(bp); + if (!SCHEME_SYMBOLP(ap)) + return_NULL; + + /* nominal_modidx_plus_phase */ + bp = SCHEME_CDR(bp); + if (!SCHEME_PAIRP(bp)) + return_NULL; + ap = SCHEME_CAR(bp); + if (SAME_TYPE(SCHEME_TYPE(ap), scheme_module_index_type)) { + /* Ok */ + } else if (SCHEME_PAIRP(ap)) { + if (!SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(ap)), scheme_module_index_type)) + return_NULL; + ap = SCHEME_CDR(ap); + /* import_phase_plus_nominal_phase */ + if (SCHEME_PAIRP(ap)) { + if (!ok_phase_index(SCHEME_CAR(ap))) return_NULL; + if (!ok_phase_index(SCHEME_CDR(ap))) return_NULL; + } else if (!ok_phase_index(ap)) + return_NULL; + } else + return_NULL; + + /* nominal_exportname */ + ap = SCHEME_CDR(bp); + if (!SCHEME_SYMBOLP(ap)) + return_NULL; + } + } else if (lex_ok) { + Scheme_Object *ap; + if (!SCHEME_BOXP(p)) + return_NULL; + ap = SCHEME_BOX_VAL(p); + if (!SCHEME_PAIRP(ap)) + return_NULL; + if (!SCHEME_SYMBOLP(SCHEME_CAR(ap))) + return_NULL; + ap = SCHEME_CDR(ap); + if (!SCHEME_SYMBOLP(ap) && !SCHEME_FALSEP(ap)) + return_NULL; + } else + return_NULL; + + scheme_hash_set(ht, key, p); + } + + return scheme_true; +} + static Scheme_Object *datum_to_wraps(Scheme_Object *w, Scheme_Unmarshal_Tables *ut) { @@ -6213,15 +6863,53 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, if (!a) return_NULL; } else if (SCHEME_VECTORP(a)) { /* A (simplified) rename table. */ - int i = SCHEME_VEC_SIZE(a); + int sz = SCHEME_VEC_SIZE(a), cnt, i, any_free_id_renames = 0; + Scheme_Object *v; /* Make sure that it's a well-formed rename table. */ - if ((i < 2) || !SCHEME_FALSEP(SCHEME_VEC_ELS(a)[1])) + if (sz < 2) return_NULL; - while (i > 2) { - i--; - if (!SCHEME_SYMBOLP(SCHEME_VEC_ELS(a)[i])) + cnt = (sz - 2) >> 1; + for (i = 0; i < cnt; i++) { + if (!SCHEME_SYMBOLP(SCHEME_VEC_ELS(a)[i + 2])) return_NULL; + v = SCHEME_VEC_ELS(a)[i + cnt + 2]; + if (SCHEME_SYMBOLP(v)) { + /* simple target-environment symbol */ + } else if (SCHEME_PAIRP(v)) { + /* target-environment symbol paired with free-id=? rename info */ + any_free_id_renames = 1; + if (!SCHEME_SYMBOLP(SCHEME_CAR(v))) + return_NULL; + v = SCHEME_CDR(v); + if (SCHEME_PAIRP(v)) { + if (!SCHEME_SYMBOLP(SCHEME_CAR(v))) + return_NULL; + v = SCHEME_CDR(v); + if (!SCHEME_SYMBOLP(v) && !SCHEME_FALSEP(v)) + return_NULL; + } else if (SCHEME_VECTORP(v)) { + if (SCHEME_VEC_SIZE(v) != 7) + return_NULL; + if (!SCHEME_MODIDXP(SCHEME_VEC_ELS(v)[0]) + || !SCHEME_SYMBOLP(SCHEME_VEC_ELS(v)[1]) + || !SCHEME_MODIDXP(SCHEME_VEC_ELS(v)[2]) + || !SCHEME_SYMBOLP(SCHEME_VEC_ELS(v)[3]) + || !ok_phase(SCHEME_VEC_ELS(v)[4]) + || !ok_phase(SCHEME_VEC_ELS(v)[5]) + || !ok_phase(SCHEME_VEC_ELS(v)[6])) + return_NULL; + } else + return_NULL; + } else + return_NULL; + } + + SCHEME_VEC_ELS(a)[0] = (any_free_id_renames ? scheme_true : scheme_false); + + if (!SCHEME_FALSEP(SCHEME_VEC_ELS(a)[1])) { + SCHEME_VEC_ELS(a)[1] = scheme_false; + maybe_install_rename_hash_table(a); } /* It's ok: */ @@ -6237,7 +6925,7 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, Scheme_Object *mns; Module_Renames *mrn; Scheme_Object *p, *key; - int plus_kernel, i, count, kind; + int plus_kernel, kind; Scheme_Object *phase, *set_identity; if (!SCHEME_PAIRP(a)) return_NULL; @@ -6377,78 +7065,17 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, mns = SCHEME_CDR(mns); } - if (!SCHEME_VECTORP(a)) return_NULL; - count = SCHEME_VEC_SIZE(a); - if (count & 0x1) return_NULL; + if (!datum_to_module_renames(a, mrn->ht, 0)) + return_NULL; - for (i = 0; i < count; i+= 2) { - key = SCHEME_VEC_ELS(a)[i]; - p = SCHEME_VEC_ELS(a)[i+1]; - - if (!SCHEME_SYMBOLP(key)) return_NULL; - - if (SAME_TYPE(SCHEME_TYPE(p), scheme_module_index_type)) { - /* Ok */ - } else if (SCHEME_PAIRP(p)) { - Scheme_Object *midx; - - midx = SCHEME_CAR(p); - if (!SAME_TYPE(SCHEME_TYPE(midx), scheme_module_index_type)) - return_NULL; - - if (SCHEME_SYMBOLP(SCHEME_CDR(p))) { - /* Ok */ - } else if (SAME_TYPE(SCHEME_TYPE(SCHEME_CDR(p)), scheme_module_index_type)) { - /* Ok */ - } else { - Scheme_Object *ap, *bp; - - ap = SCHEME_CDR(p); - if (!SCHEME_PAIRP(ap)) - return_NULL; - - /* mod-phase, maybe */ - if (SCHEME_INTP(SCHEME_CAR(ap))) { - bp = SCHEME_CDR(ap); - } else - bp = ap; - - /* exportname */ - if (!SCHEME_PAIRP(bp)) - return_NULL; - ap = SCHEME_CAR(bp); - if (!SCHEME_SYMBOLP(ap)) - return_NULL; - - /* nominal_modidx_plus_phase */ - bp = SCHEME_CDR(bp); - if (!SCHEME_PAIRP(bp)) - return_NULL; - ap = SCHEME_CAR(bp); - if (SAME_TYPE(SCHEME_TYPE(ap), scheme_module_index_type)) { - /* Ok */ - } else if (SCHEME_PAIRP(ap)) { - if (!SAME_TYPE(SCHEME_TYPE(SCHEME_CAR(ap)), scheme_module_index_type)) - return_NULL; - ap = SCHEME_CDR(ap); - /* import_phase_plus_nominal_phase */ - if (SCHEME_PAIRP(ap)) { - if (!ok_phase_index(SCHEME_CAR(ap))) return_NULL; - if (!ok_phase_index(SCHEME_CDR(ap))) return_NULL; - } else if (!ok_phase_index(ap)) - return_NULL; - } else - return_NULL; - - /* nominal_exportname */ - ap = SCHEME_CDR(bp); - if (!SCHEME_SYMBOLP(ap)) - return_NULL; - } - } else - return_NULL; - - scheme_hash_set(mrn->ht, key, p); + /* Extract free-id=? renames, if any */ + if (SCHEME_PAIRP(mns) && SCHEME_VECTORP(SCHEME_CAR(mns))) { + Scheme_Hash_Table *ht; + ht = scheme_make_hash_table(SCHEME_hash_ptr); + mrn->free_id_renames = ht; + if (!datum_to_module_renames(SCHEME_CAR(mns), mrn->free_id_renames, 1)) + return_NULL; + mns = SCHEME_CDR(mns); } /* Extract the mark-rename table, if any: */ @@ -7151,7 +7778,7 @@ void scheme_simplify_stx(Scheme_Object *stx, Scheme_Object *cache) if (SAME_OBJ(scheme_intern_symbol("y"), SCHEME_STX_VAL(stx))) { fprintf(stderr, "simplifying... %s\n", - scheme_write_to_string(resolve_env(NULL, stx, 0, 0, NULL, NULL, NULL, NULL, 0), + scheme_write_to_string(resolve_env(NULL, stx, 0, 0, NULL, NULL, NULL, NULL, 0, 0), NULL)); explain_simp = 1; } @@ -7169,7 +7796,7 @@ void scheme_simplify_stx(Scheme_Object *stx, Scheme_Object *cache) if (explain_simp) { explain_simp = 0; fprintf(stderr, "simplified: %s\n", - scheme_write_to_string(resolve_env(NULL, stx, 0, 0, NULL, NULL, NULL, NULL, 0), + scheme_write_to_string(resolve_env(NULL, stx, 0, 0, NULL, NULL, NULL, NULL, 0, 0), NULL)); } #endif @@ -7661,7 +8288,7 @@ Scheme_Object *scheme_syntax_make_transfer_intro(int argc, Scheme_Object **argv) int skipped = -1; Scheme_Object *mod; - mod = resolve_env(NULL, argv[0], phase, 1, NULL, NULL, &skipped, NULL, 0); + mod = resolve_env(NULL, argv[0], phase, 1, NULL, NULL, &skipped, NULL, 0, 1); if ((skipped == -1) && SCHEME_FALSEP(mod)) { /* For top-level bindings, need to check the current environment's table, @@ -7787,12 +8414,15 @@ static Scheme_Object *do_module_binding(char *name, int argc, Scheme_Object **ar phase = scheme_bin_plus(dphase, phase); } - m = scheme_stx_module_name(&a, + m = scheme_stx_module_name(1, + &a, phase, &nom_mod, &nom_a, &mod_phase, &src_phase_index, - &nominal_src_phase); + &nominal_src_phase, + NULL, + NULL); if (!m) return scheme_false; diff --git a/src/mzscheme/src/syntax.c b/src/mzscheme/src/syntax.c index b68e2f1b80..77444877c6 100644 --- a/src/mzscheme/src/syntax.c +++ b/src/mzscheme/src/syntax.c @@ -5737,7 +5737,7 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object Scheme_Env *exp_env, Scheme_Object *insp, Scheme_Compile_Expand_Info *rec, int drec, Scheme_Comp_Env *stx_env, Scheme_Comp_Env *rhs_env, - int *_pos) + int *_pos, Scheme_Object *rename_rib) { Scheme_Object **results, *l; Scheme_Comp_Env *eenv; @@ -5841,10 +5841,16 @@ void scheme_bind_syntaxes(const char *where, Scheme_Object *names, Scheme_Object macro->type = scheme_macro_type; if (vc == 1) SCHEME_PTR_VAL(macro) = a; - else + else SCHEME_PTR_VAL(macro) = results[j]; scheme_set_local_syntax(i++, name, macro, stx_env); + + if (SAME_TYPE(SCHEME_TYPE(SCHEME_PTR_VAL(macro)), scheme_id_macro_type)) { + /* Install a free-id=? rename */ + scheme_install_free_id_rename(name, SCHEME_PTR1_VAL(SCHEME_PTR_VAL(macro)), rename_rib, + scheme_make_integer(rhs_env->genv->phase)); + } } *_pos = i; @@ -6033,7 +6039,7 @@ do_letrec_syntaxes(const char *where, stx_env->insp, rec, drec, stx_env, rhs_env, - &i); + &i, NULL); } }