diff --git a/collects/tests/racket/stx.rktl b/collects/tests/racket/stx.rktl index aadcb530ac..387f15b5d1 100644 --- a/collects/tests/racket/stx.rktl +++ b/collects/tests/racket/stx.rktl @@ -1682,6 +1682,35 @@ (namespace-require ''producer) (eval 10)) +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Check handling of module context + +(module mm-context-m1 racket/base + (require (for-syntax racket/base)) + (provide m1) + (define-syntax (m1 stx) + #`(begin + (define #,(syntax-local-introduce #'x) 1) + #,(syntax-local-introduce #'x)))) + +(module mm-context-m2 racket/base + (require (for-syntax racket/base)) + (provide m2) + (define-syntax (m2 stx) + #`(begin + (define #,(syntax-local-introduce #'x) 2) + #,(syntax-local-introduce #'x)))) + +(module mm-context-m3 racket/base + (require 'mm-context-m1 'mm-context-m2) + (m1) + (m2)) + +(let ([o (open-output-bytes)]) + (parameterize ([current-output-port o]) + (dynamic-require ''mm-context-m3 #f)) + (test #"1\n2\n" get-output-bytes o)) + ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (report-errs) diff --git a/src/racket/src/compenv.c b/src/racket/src/compenv.c index 03a94ce4e0..e103c60bc8 100644 --- a/src/racket/src/compenv.c +++ b/src/racket/src/compenv.c @@ -1085,63 +1085,76 @@ Scheme_Object *scheme_tl_id_sym(Scheme_Env *env, Scheme_Object *id, Scheme_Objec marks = SCHEME_CAR(marks); } - /* Treat #f and void values of bdg the same, since a void value is - the same #f, but ensure that we get this far: */ - if (SCHEME_FALSEP(bdg) || SCHEME_VOIDP(bdg)) + if (SCHEME_FALSEP(bdg)) bdg = NULL; - /* Find a mapping that matches the longest tail of marks */ - for (l = map; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { - a = SCHEME_CAR(l); - amarks = SCHEME_CAR(a); + /* Find a mapping that matches the longest tail of marks + in the first matching tail of bdg */ + while (1) { + for (l = map; SCHEME_PAIRP(l); l = SCHEME_CDR(l)) { + a = SCHEME_CAR(l); + amarks = SCHEME_CAR(a); - if (SCHEME_VECTORP(amarks)) { - abdg = SCHEME_VEC_ELS(amarks)[1]; - amarks = SCHEME_VEC_ELS(amarks)[0]; - } else - abdg = NULL; + if (SCHEME_VECTORP(amarks)) { + abdg = SCHEME_VEC_ELS(amarks)[1]; + amarks = SCHEME_VEC_ELS(amarks)[0]; + } else + abdg = NULL; - if (SAME_OBJ(abdg, bdg)) { - if (mode > 0) { - if (scheme_equal(amarks, marks)) { - best_match = SCHEME_CDR(a); - break; - } - } else { - if (SCHEME_NULLP(amarks)) { - /* can always match empty marks */ - best_match = SCHEME_CDR(a); - best_match_skipped = 0; - } else if (!SCHEME_PAIRP(marks)) { - /* To be better than nothing, could only match exactly: */ - if (scheme_equal(amarks, marks)) { - best_match = SCHEME_CDR(a); - best_match_skipped = 0; - } - } else { - /* amarks can match a tail of marks: */ - for (m = marks, ms = 0; - SCHEME_PAIRP(m) && (ms < best_match_skipped); - m = SCHEME_CDR(m), ms++) { + if (SAME_OBJ(abdg, bdg) + || (bdg && abdg && scheme_equal(abdg, bdg))) { + if (mode > 0) { + if (scheme_equal(amarks, marks)) { + best_match = SCHEME_CDR(a); + break; + } + } else { + if (SCHEME_NULLP(amarks)) { + /* can always match empty marks */ + best_match = SCHEME_CDR(a); + best_match_skipped = 0; + } else if (!SCHEME_PAIRP(marks)) { + /* To be better than nothing, could only match exactly: */ + if (scheme_equal(amarks, marks)) { + best_match = SCHEME_CDR(a); + best_match_skipped = 0; + } + } else { + /* amarks can match a tail of marks: */ + for (m = marks, ms = 0; + SCHEME_PAIRP(m) && (ms < best_match_skipped); + m = SCHEME_CDR(m), ms++) { - cm = m; - if (!SCHEME_PAIRP(amarks)) { - /* If we're down to the last element - of marks, then extract it to try to - match the symbol amarks. */ - if (SCHEME_NULLP(SCHEME_CDR(m))) - cm = SCHEME_CAR(m); - } + cm = m; + if (!SCHEME_PAIRP(amarks)) { + /* If we're down to the last element + of marks, then extract it to try to + match the symbol amarks. */ + if (SCHEME_NULLP(SCHEME_CDR(m))) + cm = SCHEME_CAR(m); + } - if (scheme_equal(amarks, cm)) { - best_match = SCHEME_CDR(a); - best_match_skipped = ms; - break; - } - } - } + if (scheme_equal(amarks, cm)) { + best_match = SCHEME_CDR(a); + best_match_skipped = ms; + break; + } + } + } + } } } + + if (!best_match && (mode <= 1) && bdg && (SCHEME_PAIRP(bdg) || SCHEME_INTP(bdg) || SCHEME_BIGNUMP(bdg))) { + /* try lookup with less bdg context */ + if (SCHEME_PAIRP(bdg)) { + bdg = SCHEME_CDR(bdg); + if (SCHEME_PAIRP(bdg) && SCHEME_NULLP(SCHEME_CDR(bdg))) + bdg = SCHEME_CAR(bdg); + } else + bdg = NULL; + } else + break; } if (!best_match) { diff --git a/src/racket/src/cstartup.inc b/src/racket/src/cstartup.inc index e78af204ea..2884ac6924 100644 --- a/src/racket/src/cstartup.inc +++ b/src/racket/src/cstartup.inc @@ -1,11 +1,11 @@ { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,51,0,0,0,1,0,0,10,0,14,0, 19,0,32,0,39,0,42,0,49,0,56,0,60,0,65,0,69,0,74,0,83, 0,87,0,93,0,107,0,121,0,124,0,130,0,134,0,136,0,147,0,149,0, -163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,95,1,128, -1,161,1,220,1,19,2,97,2,152,2,157,2,177,2,70,3,90,3,142,3, -208,3,97,4,239,4,36,5,47,5,126,5,0,0,88,7,0,0,69,35,37, +163,0,170,0,192,0,194,0,208,0,19,1,48,1,59,1,70,1,96,1,129, +1,162,1,221,1,21,2,99,2,155,2,160,2,180,2,73,3,93,3,145,3, +211,3,100,4,242,4,40,5,51,5,130,5,0,0,92,7,0,0,69,35,37, 109,105,110,45,115,116,120,29,11,11,11,64,99,111,110,100,72,112,97,114,97, 109,101,116,101,114,105,122,101,66,108,101,116,114,101,99,62,111,114,66,117,110, 108,101,115,115,66,100,101,102,105,110,101,63,97,110,100,64,108,101,116,42,63, @@ -21,85 +21,85 @@ 2,8,2,2,2,9,2,2,2,5,2,2,2,11,2,2,2,12,2,2,97, 37,11,8,240,248,81,0,0,93,159,2,16,36,37,16,2,2,13,161,2,2, 37,2,13,2,2,2,13,96,38,11,8,240,248,81,0,0,16,0,96,11,11, -8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,5,36,2,14, -2,2,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22,150, -4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19,248, -22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83,2, -18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248,22, -157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22,75, -194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22,74, -199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,5,36,2,14,2, -2,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1,8,101, -110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118,49,53, -53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14,159,37, -36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80,158,39, -36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22,74,201, -251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18,100,11, -13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4,11, -11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11,2,21,3, -1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22,157,4,194, -249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22,157, -4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22,151,4,248, -22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11,9,222,33, -40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22,83,249,22, -83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2,22,74,23, -204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249,22,2,22, -98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36,37,47,11, -9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248,22,157,4, -194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75,248,22, -157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24,249,22,2, -32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248,22,74,201, -248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4,248,22,74, -195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2,22,9,248, -22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84,2,10,248, -22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1,27,249,22, -1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248,22,177,4, -249,22,150,4,80,158,41,36,251,22,83,1,22,119,105,116,104,45,99,111,110, -116,105,110,117,97,116,105,111,110,45,109,97,114,107,2,26,250,22,84,1,23, -101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,122,97,116,105, -111,110,21,95,1,27,99,111,110,116,105,110,117,97,116,105,111,110,45,109,97, -114,107,45,115,101,116,45,102,105,114,115,116,11,2,26,202,250,22,84,2,22, -9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14, -159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248,22,74,197, -28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22,83,2,22, -248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2,3,249,22, -83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22,83,2,18, -28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101,10,248,22, -74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248,22,75,202, -99,13,16,5,36,2,14,2,2,11,11,8,32,8,31,8,30,8,29,16,4, -11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4,11,11,2,21, -3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118,111,105,100,8, -48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39,36,28,248,22, -58,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83,248,22,74,199, -248,22,98,198,27,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83, -248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202,159,36,20,113, -159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2,9,9,11,11, -11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39,36,16,0,36, -16,0,36,11,11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2, -9,2,10,2,11,2,12,16,10,11,11,11,11,11,11,11,11,11,11,16,10, -2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2,11,2,12,36, -46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0,16,0,36,36, -11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11,20,15,16,2, -20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1,2,13,16,1, -33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0,33,34,36,20, -113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8,36,37,53,37, -9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,9, -88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36,16,1,2,13, -16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9,223,0,33,38, -36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2,11,88,163,8, -36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2,13,16,0,11, -16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36,20,113,159,36, -16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54,37,9,223,0, -33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,4,88,163,8, -36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2,13,16,0,11, -16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36,20,113,159,36, -16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36,37,54,37,9, -223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16,0,94,2,16, -2,17,93,2,16,9,9,36,0}; - EVAL_ONE_SIZED_STR((char *)expr, 2024); +8,240,248,81,0,0,16,0,18,98,64,104,101,114,101,13,16,6,36,2,14, +2,2,11,11,11,8,32,8,31,8,30,8,29,27,248,22,157,4,195,249,22, +150,4,80,158,39,36,251,22,83,2,18,248,22,98,199,12,249,22,73,2,19, +248,22,100,201,27,248,22,157,4,195,249,22,150,4,80,158,39,36,251,22,83, +2,18,248,22,98,199,249,22,73,2,19,248,22,100,201,12,27,248,22,75,248, +22,157,4,196,28,248,22,81,193,20,14,159,37,36,37,28,248,22,81,248,22, +75,194,248,22,74,193,249,22,150,4,80,158,39,36,251,22,83,2,18,248,22, +74,199,249,22,73,2,9,248,22,75,201,11,18,100,10,13,16,6,36,2,14, +2,2,11,11,11,8,32,8,31,8,30,8,29,16,4,11,11,2,20,3,1, +8,101,110,118,49,53,53,52,52,16,4,11,11,2,21,3,1,8,101,110,118, +49,53,53,52,53,27,248,22,75,248,22,157,4,196,28,248,22,81,193,20,14, +159,37,36,37,28,248,22,81,248,22,75,194,248,22,74,193,249,22,150,4,80, +158,39,36,250,22,83,2,22,248,22,83,249,22,83,248,22,83,2,23,248,22, +74,201,251,22,83,2,18,2,23,2,23,249,22,73,2,6,248,22,75,204,18, +100,11,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30,8,29, +16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,52,55,16,4,11,11, +2,21,3,1,8,101,110,118,49,53,53,52,56,248,22,157,4,193,27,248,22, +157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22,75, +248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,28,248,22,58,248,22, +151,4,248,22,74,23,198,2,27,249,22,2,32,0,88,163,8,36,37,43,11, +9,222,33,40,248,22,157,4,248,22,98,23,200,2,250,22,83,2,24,248,22, +83,249,22,83,248,22,83,248,22,74,23,204,2,250,22,84,2,25,249,22,2, +22,74,23,204,2,248,22,100,23,206,2,249,22,73,248,22,74,23,202,1,249, +22,2,22,98,23,200,1,250,22,84,2,22,249,22,2,32,0,88,163,8,36, +37,47,11,9,222,33,41,248,22,157,4,248,22,74,201,248,22,75,198,27,248, +22,157,4,194,249,22,73,248,22,83,248,22,74,196,248,22,75,195,27,248,22, +75,248,22,157,4,23,197,1,249,22,150,4,80,158,39,36,250,22,84,2,24, +249,22,2,32,0,88,163,8,36,37,47,11,9,222,33,43,248,22,157,4,248, +22,74,201,248,22,75,198,27,248,22,75,248,22,157,4,196,27,248,22,157,4, +248,22,74,195,249,22,150,4,80,158,40,36,28,248,22,81,195,250,22,84,2, +22,9,248,22,75,199,250,22,83,2,11,248,22,83,248,22,74,199,250,22,84, +2,10,248,22,75,201,248,22,75,202,27,248,22,75,248,22,157,4,23,197,1, +27,249,22,1,22,87,249,22,2,22,157,4,248,22,157,4,248,22,74,199,248, +22,177,4,249,22,150,4,80,158,41,36,251,22,83,1,22,119,105,116,104,45, +99,111,110,116,105,110,117,97,116,105,111,110,45,109,97,114,107,2,26,250,22, +84,1,23,101,120,116,101,110,100,45,112,97,114,97,109,101,116,101,114,105,122, +97,116,105,111,110,21,95,1,27,99,111,110,116,105,110,117,97,116,105,111,110, +45,109,97,114,107,45,115,101,116,45,102,105,114,115,116,11,2,26,202,250,22, +84,2,22,9,248,22,75,204,27,248,22,75,248,22,157,4,196,28,248,22,81, +193,20,14,159,37,36,37,249,22,150,4,80,158,39,36,27,248,22,157,4,248, +22,74,197,28,249,22,144,9,62,61,62,248,22,151,4,248,22,98,196,250,22, +83,2,22,248,22,83,249,22,83,21,93,2,27,248,22,74,199,250,22,84,2, +3,249,22,83,2,27,249,22,83,248,22,107,203,2,27,248,22,75,202,251,22, +83,2,18,28,249,22,144,9,248,22,151,4,248,22,74,200,64,101,108,115,101, +10,248,22,74,197,250,22,84,2,22,9,248,22,75,200,249,22,73,2,3,248, +22,75,202,99,13,16,6,36,2,14,2,2,11,11,11,8,32,8,31,8,30, +8,29,16,4,11,11,2,20,3,1,8,101,110,118,49,53,53,55,48,16,4, +11,11,2,21,3,1,8,101,110,118,49,53,53,55,49,18,158,94,10,64,118, +111,105,100,8,48,27,248,22,75,248,22,157,4,196,249,22,150,4,80,158,39, +36,28,248,22,58,248,22,151,4,248,22,74,197,250,22,83,2,28,248,22,83, +248,22,74,199,248,22,98,198,27,248,22,151,4,248,22,74,197,250,22,83,2, +28,248,22,83,248,22,74,197,250,22,84,2,25,248,22,75,199,248,22,75,202, +159,36,20,113,159,36,16,1,11,16,0,20,26,149,9,2,1,2,1,2,2, +9,9,11,11,11,10,36,80,158,36,36,20,113,159,36,16,0,16,0,38,39, +36,16,0,36,16,0,36,11,11,11,16,10,2,3,2,4,2,5,2,6,2, +7,2,8,2,9,2,10,2,11,2,12,16,10,11,11,11,11,11,11,11,11, +11,11,16,10,2,3,2,4,2,5,2,6,2,7,2,8,2,9,2,10,2, +11,2,12,36,46,37,16,0,36,16,1,2,13,37,11,11,11,16,0,16,0, +16,0,36,36,11,12,11,11,16,0,16,0,16,0,36,36,16,11,16,5,11, +20,15,16,2,20,14,159,36,36,37,80,158,36,36,36,20,113,159,36,16,1, +2,13,16,1,33,33,10,16,5,2,7,88,163,8,36,37,53,37,9,223,0, +33,34,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2,12,88,163,8, +36,37,53,37,9,223,0,33,35,36,20,113,159,36,16,1,2,13,16,0,11, +16,5,2,9,88,163,8,36,37,53,37,9,223,0,33,36,36,20,113,159,36, +16,1,2,13,16,1,33,37,11,16,5,2,6,88,163,8,36,37,56,37,9, +223,0,33,38,36,20,113,159,36,16,1,2,13,16,1,33,39,11,16,5,2, +11,88,163,8,36,37,58,37,9,223,0,33,42,36,20,113,159,36,16,1,2, +13,16,0,11,16,5,2,5,88,163,8,36,37,53,37,9,223,0,33,44,36, +20,113,159,36,16,1,2,13,16,0,11,16,5,2,10,88,163,8,36,37,54, +37,9,223,0,33,45,36,20,113,159,36,16,1,2,13,16,0,11,16,5,2, +4,88,163,8,36,37,56,37,9,223,0,33,46,36,20,113,159,36,16,1,2, +13,16,0,11,16,5,2,3,88,163,8,36,37,58,37,9,223,0,33,47,36, +20,113,159,36,16,1,2,13,16,1,33,49,11,16,5,2,8,88,163,8,36, +37,54,37,9,223,0,33,50,36,20,113,159,36,16,1,2,13,16,0,11,16, +0,94,2,16,2,17,93,2,16,9,9,36,0}; + EVAL_ONE_SIZED_STR((char *)expr, 2028); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,109,0,0,0,1,0,0,8,0,21,0, 26,0,43,0,65,0,94,0,109,0,127,0,139,0,155,0,169,0,191,0,207, 0,224,0,246,0,1,1,7,1,16,1,23,1,30,1,42,1,58,1,82,1, @@ -600,7 +600,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 10438); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,12,0,0,0,1,0,0,15,0,40,0, 57,0,75,0,97,0,120,0,140,0,162,0,169,0,176,0,183,0,0,0,179, 1,0,0,74,35,37,112,108,97,99,101,45,115,116,114,117,99,116,1,23,115, @@ -627,7 +627,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 501); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,81,0,0,0,1,0,0,7,0,18,0, 45,0,51,0,64,0,73,0,80,0,102,0,124,0,150,0,158,0,170,0,185, 0,201,0,219,0,239,0,251,0,11,1,34,1,46,1,77,1,84,1,89,1, @@ -984,7 +984,7 @@ EVAL_ONE_SIZED_STR((char *)expr, 7421); } { - SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,54,84,0,0,0,0,0,0,0,0,0,0, + SHARED_OK static MZCOMPILED_STRING_FAR unsigned char expr[] = {35,126,7,53,46,51,46,48,46,55,84,0,0,0,0,0,0,0,0,0,0, 0,0,0,0,0,0,0,0,0,0,11,0,0,0,1,0,0,10,0,16,0, 29,0,44,0,58,0,78,0,90,0,104,0,118,0,170,0,0,0,98,1,0, 0,69,35,37,98,117,105,108,116,105,110,65,113,117,111,116,101,29,94,2,2, diff --git a/src/racket/src/eval.c b/src/racket/src/eval.c index d011dadbf8..0d28bd00a4 100644 --- a/src/racket/src/eval.c +++ b/src/racket/src/eval.c @@ -3733,7 +3733,7 @@ static Scheme_Object *add_renames_unless_module(Scheme_Object *form, Scheme_Env if (genv->rename_set) { form = scheme_add_rename(form, genv->rename_set); /* this "phase shift" just attaches the namespace's module registry: */ - form = scheme_stx_phase_shift(form, NULL, NULL, NULL, genv->module_registry->exports, NULL); + form = scheme_stx_phase_shift(form, NULL, NULL, NULL, genv->module_registry->exports, NULL, NULL); } return form; @@ -3811,7 +3811,7 @@ static void *compile_k(void) genv->module->me->src_modidx, genv->module->self_modidx, genv->module_registry->exports, - NULL); + NULL, NULL); } } @@ -4246,7 +4246,7 @@ Scheme_Object *scheme_eval_compiled_stx_string(Scheme_Object *expr, Scheme_Env * for (i = 0; i < len - 1; i++) { s = scheme_stx_phase_shift(SCHEME_VEC_ELS(expr)[i], scheme_make_integer(shift), orig, modidx, - env->module_registry->exports, NULL); + env->module_registry->exports, NULL, NULL); SCHEME_VEC_ELS(result)[i] = s; } @@ -5446,7 +5446,7 @@ Scheme_Object **scheme_push_prefix(Scheme_Env *genv, Resolve_Prefix *rp, v = scheme_stx_phase_shift_as_rename(scheme_make_integer(now_phase - src_phase), src_modidx, now_modidx, genv ? genv->module_registry->exports : NULL, - insp); + insp, NULL); if (v || (rp->delay_info_rpair && SCHEME_CDR(rp->delay_info_rpair))) { /* Put lazy-shift info in pf->a[i]: */ Scheme_Object **ls; diff --git a/src/racket/src/module.c b/src/racket/src/module.c index 01e4c1efca..af87110dae 100644 --- a/src/racket/src/module.c +++ b/src/racket/src/module.c @@ -767,6 +767,7 @@ static Scheme_Object *scheme_sys_wraps_phase_worker(intptr_t p) scheme_make_integer(p), scheme_make_integer(0), scheme_null, + NULL, 1); scheme_seal_module_rename(rn, STX_SEAL_ALL); @@ -2530,6 +2531,7 @@ static int do_add_simple_require_renames(Scheme_Object *rn, marshal_phase_index, scheme_make_integer(0), scheme_null, + NULL, 1); } @@ -6287,24 +6289,24 @@ static Scheme_Object *annotate_existing_submodules(Scheme_Object *orig_fm) return orig_fm; } -static Scheme_Object *phase_shift_tail(Scheme_Object *v, Scheme_Object *old_midx, Scheme_Object *new_midx) +static Scheme_Object *phase_shift_tail(Scheme_Object *v, Scheme_Object *ps) { if (!SCHEME_STXP(v)) v = scheme_datum_to_syntax(v, scheme_false, scheme_false, 0, 0); - return scheme_stx_phase_shift(v, NULL, old_midx, new_midx, NULL, NULL); + return scheme_add_rename(v, ps); } static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Object *a, Scheme_Object *d, - Scheme_Object *old_midx, Scheme_Object *new_midx) + Scheme_Object *ps) { if (!a) { a = SCHEME_STX_CAR(orig); - a = scheme_stx_phase_shift(a, NULL, old_midx, new_midx, NULL, NULL); + a = scheme_add_rename(a, ps); } if (!d) { d = SCHEME_STX_CDR(orig); - d = phase_shift_tail(d, old_midx, new_midx); + d = phase_shift_tail(d, ps); } a = scheme_make_pair(a, d); @@ -6312,15 +6314,13 @@ static Scheme_Object *rebuild_with_phase_shift(Scheme_Object *orig, Scheme_Objec if (SCHEME_PAIRP(orig)) return a; - orig = scheme_stx_phase_shift(orig, NULL, old_midx, new_midx, NULL, NULL); + orig = scheme_add_rename(orig, ps); return scheme_datum_to_syntax(a, orig, orig, 0, 2); } static Scheme_Object *phase_shift_skip_submodules_k(void); -static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, - Scheme_Object *old_midx, Scheme_Object *new_midx, - int phase) +static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, Scheme_Object *ps, int phase) { Scheme_Object *v0, *v1, *v2, *v3, *v4, *naya; @@ -6329,8 +6329,7 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, { Scheme_Thread *p = scheme_current_thread; p->ku.k.p1 = (void *)fm; - p->ku.k.p2 = (void *)old_midx; - p->ku.k.p3 = (void *)new_midx; + p->ku.k.p2 = (void *)ps; p->ku.k.i1 = phase; return scheme_handle_stack_overflow(phase_shift_skip_submodules_k); } @@ -6344,15 +6343,15 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, v3 = SCHEME_STX_CAR(v2); v4 = SCHEME_STX_CDR(v3); - naya = phase_shift_skip_submodules(v4, old_midx, new_midx, 0); + naya = phase_shift_skip_submodules(v4, ps, 0); if (SAME_OBJ(naya, v4)) { - return scheme_stx_phase_shift(fm, NULL, old_midx, new_midx, NULL, NULL); + return scheme_add_rename(fm, ps); } else { - v3 = rebuild_with_phase_shift(v3, NULL, naya, old_midx, new_midx); - v2 = rebuild_with_phase_shift(v2, v3, NULL, old_midx, new_midx); - v1 = rebuild_with_phase_shift(v1, NULL, v2, old_midx, new_midx); - v0 = rebuild_with_phase_shift(v0, NULL, v1, old_midx, new_midx); - return rebuild_with_phase_shift(fm, NULL, v0, old_midx, new_midx); + v3 = rebuild_with_phase_shift(v3, NULL, naya, ps); + v2 = rebuild_with_phase_shift(v2, v3, NULL, ps); + v1 = rebuild_with_phase_shift(v1, NULL, v2, ps); + v0 = rebuild_with_phase_shift(v0, NULL, v1, ps); + return rebuild_with_phase_shift(fm, NULL, v0, ps); } } else if (SCHEME_STX_NULLP(fm)) { return fm; @@ -6366,33 +6365,33 @@ static Scheme_Object *phase_shift_skip_submodules(Scheme_Object *fm, || scheme_stx_module_eq_x(scheme_modulestar_stx, v2, phase)) { /* found a submodule */ v2 = SCHEME_STX_CDR(fm); - naya = phase_shift_skip_submodules(v2, old_midx, new_midx, phase); + naya = phase_shift_skip_submodules(v2, ps, phase); if (SAME_OBJ(naya, v2)) - naya = phase_shift_tail(naya, old_midx, new_midx); - return rebuild_with_phase_shift(fm, v1, naya, old_midx, new_midx); + naya = phase_shift_tail(naya, ps); + return rebuild_with_phase_shift(fm, v1, naya, ps); } else if (scheme_stx_module_eq_x(scheme_begin_for_syntax_stx, v2, phase)) { /* found `begin-for-syntax': */ - naya = phase_shift_skip_submodules(v1, old_midx, new_midx, phase+1); + naya = phase_shift_skip_submodules(v1, ps, phase+1); v2 = SCHEME_STX_CDR(fm); - v3 = phase_shift_skip_submodules(v2, old_midx, new_midx, phase+1); + v3 = phase_shift_skip_submodules(v2, ps, phase+1); if (SAME_OBJ(naya, v1) && SAME_OBJ(v2, v3)) return fm; else { if (SAME_OBJ(v2, v3)) - v3 = phase_shift_tail(v3, old_midx, new_midx); - return rebuild_with_phase_shift(fm, naya, v3, old_midx, new_midx); + v3 = phase_shift_tail(v3, ps); + return rebuild_with_phase_shift(fm, naya, v3, ps); } } } } v3 = SCHEME_STX_CDR(fm); - v4 = phase_shift_skip_submodules(v3, old_midx, new_midx, phase); + v4 = phase_shift_skip_submodules(v3, ps, phase); if (SAME_OBJ(v3, v4)) return fm; else { - v1 = scheme_stx_phase_shift(v1, NULL, old_midx, new_midx, NULL, NULL); - return rebuild_with_phase_shift(fm, v1, v4, old_midx, new_midx); + v1 = scheme_add_rename(v1, ps); + return rebuild_with_phase_shift(fm, v1, v4, ps); } } } @@ -6401,14 +6400,12 @@ static Scheme_Object *phase_shift_skip_submodules_k(void) { Scheme_Thread *p = scheme_current_thread; Scheme_Object *fm = (Scheme_Object *)p->ku.k.p1; - Scheme_Object *old_midx = (Scheme_Object *)p->ku.k.p2; - Scheme_Object *new_midx = (Scheme_Object *)p->ku.k.p3; + Scheme_Object *ps = (Scheme_Object *)p->ku.k.p2; p->ku.k.p1 = NULL; p->ku.k.p2 = NULL; - p->ku.k.p3 = NULL; - return phase_shift_skip_submodules(fm, old_midx, new_midx, p->ku.k.i1); + return phase_shift_skip_submodules(fm, ps, p->ku.k.i1); } static Scheme_Env *find_env(Scheme_Env *env, intptr_t ph) @@ -6618,7 +6615,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, rn = scheme_stx_phase_shift_as_rename(super_phase_shift, top_env->module->self_modidx, iidx, menv->module_registry->exports, - env->insp); + env->insp, NULL); super_bxs_info = MALLOC_N(void*, 6); super_bxs_info[0] = super_bxs; @@ -6730,13 +6727,13 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, if (ii) { /* phase shift to replace self_modidx of previous expansion (if any): */ - fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp); + fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp, NULL); fm = scheme_add_rename(fm, rn_set); } else { if (skip_strip) { /* phase shift to replace self_modidx of previous expansion: */ - fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp); + fm = scheme_stx_phase_shift(fm, NULL, this_empty_self_modidx, self_modidx, NULL, m->insp, NULL); } } @@ -6800,7 +6797,7 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, fm = (Scheme_Object *)m; } else { - Scheme_Object *hints, *formname; + Scheme_Object *hints, *formname, *ps; fm = scheme_expand_expr(fm, benv, rec, drec); @@ -6849,10 +6846,12 @@ static Scheme_Object *do_module(Scheme_Object *form, Scheme_Comp_Env *env, } /* for future expansion, shift away from self_modidx: */ + ps = scheme_stx_phase_shift_as_rename(NULL, self_modidx, this_empty_self_modidx, + NULL, NULL, scheme_rename_set_identity(rn_set)); if (m->pre_submodules) /* non-NULL => some submodules, even if it's '() */ - fm = phase_shift_skip_submodules(fm, self_modidx, this_empty_self_modidx, -1); + fm = phase_shift_skip_submodules(fm, ps, -1); else - fm = scheme_stx_phase_shift(fm, NULL, self_modidx, this_empty_self_modidx, NULL, NULL); + fm = scheme_add_rename(fm, ps); /* make self_modidx like the empty modidx */ if (SAME_OBJ(this_empty_self_modidx, empty_self_modidx)) @@ -10534,7 +10533,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ Scheme_Object **exs, **exsns, **exss, *context_marks = scheme_null; int *exets; int has_context, save_marshal_info = 0; - Scheme_Object *nominal_modidx, *one_exn, *prnt_iname, *name, *rn, *ename = orig_ename; + Scheme_Object *nominal_modidx, *one_exn, *prnt_iname, *name, *rn, *ename = orig_ename, *bdg; Scheme_Hash_Table *orig_onlys; int k, skip_rename, do_copy_vars; Scheme_Env *name_env; @@ -10543,12 +10542,8 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ /* Check whether there's context for this import (which leads to generated local names). */ context_marks = scheme_stx_extract_marks(mark_src); - has_context = !SCHEME_NULLP(context_marks); - if (!has_context) { - if (SCHEME_TRUEP(scheme_stx_moduleless_env(mark_src))) { - has_context = 1; - } - } + bdg = scheme_stx_moduleless_env(mark_src); + has_context = !SCHEME_NULLP(context_marks) || !SCHEME_FALSEP(bdg); if (has_context) { if (all_simple) *all_simple = 0; @@ -10638,7 +10633,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ /* Simple "import everything" whose mappings can be shared via the exporting module: */ if (!pt->src_modidx && me->src_modidx) pt->src_modidx = me->src_modidx; - scheme_extend_module_rename_with_shared(rn, idx, pt, pt->phase_index, src_phase_index, context_marks, 1); + scheme_extend_module_rename_with_shared(rn, idx, pt, pt->phase_index, src_phase_index, context_marks, bdg, 1); skip_rename = 1; } else skip_rename = 0; @@ -10663,7 +10658,8 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ { Scheme_Object *l; l = scheme_stx_extract_marks(mark_src); - has_context = !SCHEME_NULLP(l); + bdg = scheme_stx_moduleless_env(mark_src); + has_context = !SCHEME_NULLP(l) || !SCHEME_FALSEP(bdg); } /* Remove to indicate that it's been imported: */ scheme_hash_set(onlys, exs[j], NULL); @@ -10711,7 +10707,7 @@ void add_single_require(Scheme_Module_Exports *me, /* from module */ /* The `require' expression has a set of marks in its context, which means that we need to generate a name. */ iname = scheme_datum_to_syntax(iname, scheme_false, mark_src, 0, 0); - iname = scheme_tl_id_sym(name_env, iname, scheme_false, skip_rename ? 3 : 2, to_phase, NULL); + iname = scheme_tl_id_sym(name_env, iname, bdg, skip_rename ? 3 : 2, to_phase, NULL); if (all_simple) *all_simple = 0; } @@ -10809,7 +10805,7 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, Scheme_Object *modidx_shift_from, Scheme_Object *modidx_shift_to, Scheme_Hash_Table *export_registry) { - Scheme_Object *orig_idx, *exns, *prefix, *idx, *name, *pt_phase, *src_phase_index, *marks; + Scheme_Object *orig_idx, *exns, *prefix, *idx, *name, *pt_phase, *src_phase_index, *marks, *bdg; Scheme_Module_Exports *me; Scheme_Env *env; int share_all; @@ -10820,12 +10816,19 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, pt_phase = SCHEME_CAR(info); info = SCHEME_CDR(info); - if (SCHEME_PAIRP(info) && SCHEME_PAIRP(SCHEME_CAR(info))) { + if (SCHEME_PAIRP(info) && (SCHEME_PAIRP(SCHEME_CAR(info)) + || SCHEME_VECTORP(SCHEME_CAR(info)))) { marks = SCHEME_CAR(info); info = SCHEME_CDR(info); } else marks = scheme_null; + if (SCHEME_VECTORP(marks)) { + bdg = SCHEME_VEC_ELS(marks)[1]; + marks = SCHEME_VEC_ELS(marks)[0]; + } else + bdg = scheme_false; + if (SCHEME_INTP(info) || SCHEME_FALSEP(info)) { share_all = 1; @@ -10893,11 +10896,11 @@ void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, if (pt) { if (!pt->src_modidx && me->src_modidx) pt->src_modidx = me->src_modidx; - scheme_extend_module_rename_with_shared(rn, orig_idx, pt, pt->phase_index, src_phase_index, marks, 0); + scheme_extend_module_rename_with_shared(rn, orig_idx, pt, pt->phase_index, src_phase_index, marks, bdg, 0); } } else { - if (!SCHEME_NULLP(marks)) - scheme_signal_error("internal error: unexpected marks"); + if (!SCHEME_NULLP(marks) || SCHEME_TRUEP(bdg)) + scheme_signal_error("internal error: unexpected marks/bdg"); add_single_require(me, pt_phase, src_phase_index, orig_idx, NULL, NULL, NULL, rn, diff --git a/src/racket/src/schpriv.h b/src/racket/src/schpriv.h index 0d75d16c55..cdc1ed0f31 100644 --- a/src/racket/src/schpriv.h +++ b/src/racket/src/schpriv.h @@ -1019,7 +1019,7 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m struct Scheme_Module_Phase_Exports *pt, Scheme_Object *unmarshal_phase_index, Scheme_Object *src_phase_index, - Scheme_Object *marks, + Scheme_Object *marks, Scheme_Object *bdg, int save_unmarshal); void scheme_save_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info); void scheme_do_module_rename_unmarshal(Scheme_Object *rn, Scheme_Object *info, @@ -1038,6 +1038,7 @@ Scheme_Object *scheme_stx_shift_rename(Scheme_Object *mrn, Scheme_Object *old_mi Scheme_Object *scheme_stx_shift_rename_set(Scheme_Object *mrns, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Object *new_insp); Scheme_Hash_Table *scheme_module_rename_marked_names(Scheme_Object *rn); +Scheme_Object *scheme_rename_set_identity(Scheme_Object *rn_set); Scheme_Object *scheme_stx_content(Scheme_Object *o); Scheme_Object *scheme_flatten_syntax_list(Scheme_Object *lst, int *islist); @@ -1079,11 +1080,13 @@ Scheme_Object *scheme_stx_property(Scheme_Object *_stx, Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Hash_Table *export_registry, - Scheme_Object *insp); + Scheme_Object *insp, + Scheme_Object *ignore_old_identity); Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Hash_Table *export_registry, - Scheme_Object *insp); + Scheme_Object *insp, + Scheme_Object *ignore_old_identity); int scheme_stx_list_length(Scheme_Object *list); int scheme_stx_proper_list_length(Scheme_Object *list); diff --git a/src/racket/src/schvers.h b/src/racket/src/schvers.h index b2d7c5c64d..c28c2a411e 100644 --- a/src/racket/src/schvers.h +++ b/src/racket/src/schvers.h @@ -13,12 +13,12 @@ consistently.) */ -#define MZSCHEME_VERSION "5.3.0.6" +#define MZSCHEME_VERSION "5.3.0.7" #define MZSCHEME_VERSION_X 5 #define MZSCHEME_VERSION_Y 3 #define MZSCHEME_VERSION_Z 0 -#define MZSCHEME_VERSION_W 6 +#define MZSCHEME_VERSION_W 7 #define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y) #define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W) diff --git a/src/racket/src/syntax.c b/src/racket/src/syntax.c index 8a76c6e15a..339935228c 100644 --- a/src/racket/src/syntax.c +++ b/src/racket/src/syntax.c @@ -145,7 +145,9 @@ typedef struct Module_Renames { Scheme_Hash_Table *nomarshal_ht; /* like ht, but dropped on marshal */ Scheme_Object *shared_pes; /* list of (cons modidx (cons phase_export phase_and_marks)) phase_and_marks -> phase-index-int OR - (cons (nonempty-listof mark) phase-index-int) + (cons marks phase-index-int) + marks -> (nonempty-listof mark) OR + (vector (listof mark) bdg) like nomarshal ht, but shared from provider */ Scheme_Hash_Table *marked_names; /* shared with module environment while compiling the module; this table maps a top-level-bound identifier with a non-empty mark @@ -271,10 +273,12 @@ XFORM_NONGCING static int is_member(Scheme_Object *a, Scheme_Object *l) simple lexical renames (not ribs) and marks, only, and it's inserted into a chain heuristically - - A wrap-elem (box (vector )) + - A wrap-elem (box (vector )) is a phase shift by , remapping the first to the second ; the part is for finding - modules to unmarshal import renamings + modules to unmarshal import renamings; cancels + treatment of a following module rename with a matching id + as an "old" environment [Don't add a pair case, because sometimes we test for element versus list-of-element.] @@ -764,7 +768,7 @@ static int maybe_add_chain_cache(Scheme_Stx *stx) if (SCHEME_VECTORP(p)) { skipable++; } else if (SCHEME_NUMBERP(p) || SCHEME_SYMBOLP(p)) { - /* ok to skip, but don<'t count toward needing a cache */ + /* ok to skip, but don't count toward needing a cache */ } else if (SCHEME_HASHTP(p)) { /* Hack: we store the depth of the table in the chain in the `size' fields, at least until the table is initialized: */ @@ -1328,6 +1332,11 @@ void scheme_seal_module_rename_set(Scheme_Object *_rns, int level) } } +Scheme_Object *scheme_rename_set_identity(Scheme_Object *rn_set) +{ + return ((Module_Renames_Set *)rn_set)->set_identity; +} + static void check_not_sealed(Module_Renames *mrn) { if (mrn->sealed >= STX_SEAL_ALL) @@ -1425,6 +1434,7 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m Scheme_Object *unmarshal_phase_index, Scheme_Object *src_phase_index, Scheme_Object *marks, + Scheme_Object *bdg, int save_unmarshal) { Module_Renames *mrn = (Module_Renames *)rn; @@ -1432,9 +1442,15 @@ void scheme_extend_module_rename_with_shared(Scheme_Object *rn, Scheme_Object *m check_not_sealed(mrn); - if (SCHEME_PAIRP(marks)) + if (!bdg) bdg = scheme_false; + + if (SCHEME_PAIRP(marks) || SCHEME_TRUEP(bdg)) { + if (SCHEME_TRUEP(bdg)) { + marks = scheme_make_vector(2, marks); + SCHEME_VEC_ELS(marks)[1] = bdg; + } index_plus_marks = scheme_make_pair(marks, src_phase_index); - else + } else index_plus_marks = src_phase_index; pr = scheme_make_pair(scheme_make_pair(modidx, @@ -2141,7 +2157,8 @@ void scheme_install_free_id_rename(Scheme_Object *id, } Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx, - Scheme_Hash_Table *export_registry, Scheme_Object *insp) + Scheme_Hash_Table *export_registry, Scheme_Object *insp, + Scheme_Object *ignore_old_identity) { if (!shift) shift = scheme_make_integer(0); @@ -2155,15 +2172,17 @@ Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Obj && (SCHEME_VEC_ELS(vec)[1] == (new_midx ? old_midx : scheme_false)) && (SCHEME_VEC_ELS(vec)[2] == (new_midx ? new_midx : scheme_false)) && (SCHEME_VEC_ELS(vec)[3] == (export_registry ? (Scheme_Object *)export_registry : scheme_false)) - && (SCHEME_VEC_ELS(vec)[4] == (insp ? insp : scheme_false))) { + && (SCHEME_VEC_ELS(vec)[4] == (insp ? insp : scheme_false)) + && (SCHEME_VEC_ELS(vec)[5] == (ignore_old_identity ? ignore_old_identity : scheme_false))) { /* use the old one */ } else { - vec = scheme_make_vector(5, NULL); + vec = scheme_make_vector(6, NULL); SCHEME_VEC_ELS(vec)[0] = shift; SCHEME_VEC_ELS(vec)[1] = (new_midx ? old_midx : scheme_false); SCHEME_VEC_ELS(vec)[2] = (new_midx ? new_midx : scheme_false); SCHEME_VEC_ELS(vec)[3] = (export_registry ? (Scheme_Object *)export_registry : scheme_false); SCHEME_VEC_ELS(vec)[4] = (insp ? insp : scheme_false); + SCHEME_VEC_ELS(vec)[5] = (ignore_old_identity ? ignore_old_identity : scheme_false); last_phase_shift = scheme_box(vec); } @@ -2176,14 +2195,15 @@ Scheme_Object *scheme_stx_phase_shift_as_rename(Scheme_Object *shift, Scheme_Obj Scheme_Object *scheme_stx_phase_shift(Scheme_Object *stx, Scheme_Object *shift, Scheme_Object *old_midx, Scheme_Object *new_midx, Scheme_Hash_Table *export_registry, - Scheme_Object *insp) + Scheme_Object *insp, + Scheme_Object *ignore_old_identity) /* Shifts the phase on a syntax object in a module. A 0 shift might be used just to re-direct relative module paths. new_midx might be NULL to shift without redirection. And so on. */ { Scheme_Object *ps; - ps = scheme_stx_phase_shift_as_rename(shift, old_midx, new_midx, export_registry, insp); + ps = scheme_stx_phase_shift_as_rename(shift, old_midx, new_midx, export_registry, insp, ignore_old_identity); if (ps) return scheme_add_rename(stx, ps); else @@ -2200,7 +2220,7 @@ static Scheme_Object *syntax_shift_phase(int argc, Scheme_Object **argv) if (SCHEME_INTP(argv[1]) && !SCHEME_INT_VAL(argv[1])) return argv[0]; - return scheme_stx_phase_shift(argv[0], argv[1], NULL, NULL, NULL, NULL); + return scheme_stx_phase_shift(argv[0], argv[1], NULL, NULL, NULL, NULL, NULL); } void scheme_clear_shift_cache(void) @@ -3029,22 +3049,15 @@ int scheme_stx_has_empty_wraps(Scheme_Object *o) /* stx comparison */ /*========================================================================*/ -/* If no marks and no rename with this set's tag, - then it was an unmarked-but-actually-introduced id. */ - -static Scheme_Object *check_floating_id(Scheme_Object *stx) +static Scheme_Object *get_old_module_env(Scheme_Object *stx) +/* If an identifier has two or more module contexts, return a + representation of the prior contexts. We use the rename's + identity mark or a list of marks to represent the context. + Return #f if there's no old context. */ { - /* If `a' has a mzMOD_RENAME_MARKED rename with no following - mzMOD_RENAME_NORMAL using the same set tag, and if there are no - marks after the mzMOD_RENAME_MARKED rename, then we've hit a - corner case: an identifier that was introduced by macro expansion - but marked so that it appears to be original. To ensure that it - gets a generated symbol in the MOD_RENAME_MARKED table, give it a - "floating" binding: scheme_void. This is a rare case, and it more - likely indicates a buggy macro than anything else. */ WRAP_POS awl; - Scheme_Object *cur_mark = NULL, *searching_identity = NULL, *a; - int no_mark_means_floating = 0; + Scheme_Object *a, *last_id = NULL, *cancel_rename_id = scheme_false; + Scheme_Object *result_id = scheme_false, *last_pr = NULL, *pr; WRAP_POS_INIT(awl, ((Scheme_Stx *)stx)->wraps); @@ -3069,41 +3082,39 @@ static Scheme_Object *check_floating_id(Scheme_Object *stx) set_identity = mrns->set_identity; } - if (SAME_OBJ(set_identity, searching_identity)) - searching_identity = NULL; - - if (searching_identity) - no_mark_means_floating = 1; - - if (kind == mzMOD_RENAME_MARKED) - searching_identity = set_identity; - else - searching_identity = NULL; - - } else if (SCHEME_MARKP(a)) { - if (SAME_OBJ(a, cur_mark)) - cur_mark = 0; - else { - if (cur_mark) { - no_mark_means_floating = 0; - searching_identity = NULL; + if ((kind != mzMOD_RENAME_TOPLEVEL) + && (!SAME_OBJ(cancel_rename_id, set_identity))) { + if (last_id) { + if (!SAME_OBJ(last_id, set_identity)) { + if (SCHEME_FALSEP(result_id)) + result_id = set_identity; + else { + if (!SCHEME_PAIRP(result_id)) { + result_id = scheme_make_pair(result_id, scheme_null); + last_pr = result_id; + } + pr = scheme_make_pair(set_identity, scheme_null); + SCHEME_CDR(last_pr) = pr; + last_pr = pr; + } + } } - cur_mark = a; + last_id = set_identity; } + } else if (SCHEME_BOXP(a)) { + /* Phase shift: */ + Scheme_Object *vec; + + vec = SCHEME_BOX_VAL(a); + a = SCHEME_VEC_ELS(vec)[5]; + if (!SCHEME_FALSEP(a)) + cancel_rename_id = a; } WRAP_POS_INC(awl); } - if (cur_mark) { - no_mark_means_floating = 0; - searching_identity = NULL; - } - - if (searching_identity || no_mark_means_floating) - return scheme_void; - - return scheme_false; + return result_id; } #define EXPLAIN_RESOLVE 0 @@ -3329,24 +3340,49 @@ static int same_marks(WRAP_POS *_awl, WRAP_POS *_bwl, Scheme_Object *barrier_env } } -static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id, Scheme_Object **marks_cache, int depth, - int *_skipped) +static int check_matching_marks(Scheme_Object *p, Scheme_Object *orig_id, + Scheme_Object **marks_cache, Scheme_Object *bdg2, + int depth, int *_skipped, int *_bdg_skipped) { int l1, l2; - Scheme_Object *m1, *m2; + Scheme_Object *m1, *m2, *bdg1; p = SCHEME_CDR(p); /* skip modidx */ p = SCHEME_CDR(p); /* skip phase_export */ if (SCHEME_PAIRP(p)) { /* has marks */ - int skip = 0; + int skip = 0, bdg_skip = 0; EXPLAIN(fprintf(stderr, "%d has marks\n", depth)); m1 = SCHEME_CAR(p); - if (*marks_cache) + if (SCHEME_VECTORP(m1)) { + bdg1 = SCHEME_VEC_ELS(m1)[1]; + m1 = SCHEME_VEC_ELS(m1)[0]; + } else + bdg1 = scheme_false; + + /* check that bdg1 is a tail of bdg2, first */ + while (1) { + if (SAME_OBJ(bdg1, bdg2) + || (SCHEME_TRUEP(bdg1) && SCHEME_TRUEP(bdg2) && scheme_equal(bdg1, bdg2))) + break; + bdg_skip++; + if (SCHEME_PAIRP(bdg2)) { + bdg2 = SCHEME_CDR(bdg2); + if (SCHEME_PAIRP(bdg2) && SCHEME_NULLP(SCHEME_CDR(bdg2))) + bdg2 = SCHEME_CAR(bdg2); + } else if (SCHEME_FALSEP(bdg2)) { + *_bdg_skipped = -1; + return -1; /* no match */ + } else + bdg2 = scheme_false; + } + *_bdg_skipped = bdg_skip; + + if (*marks_cache) { m2 = *marks_cache; - else { + } else { EXPLAIN(fprintf(stderr, "%d extract marks\n", depth)); m2 = scheme_stx_extract_marks(orig_id); *marks_cache = m2; @@ -3390,13 +3426,14 @@ void scheme_populate_pt_ht(Scheme_Module_Phase_Exports * pt) { static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, Scheme_Object *glob_id, Scheme_Object *orig_id, + Scheme_Object *bdg, Scheme_Object **get_names, int get_orig_name, int depth, int *_skipped) { Scheme_Object *pr, *idx, *pos, *src, *best_match = NULL; Scheme_Module_Phase_Exports *pt; - int i, phase, best_match_len = -1, skip = 0; + int i, phase, best_match_len = -1, best_match_bdg_skip = -1, skip = 0, bdg_skip = -1; Scheme_Object *marks_cache = NULL; for (pr = shared_pes; !SCHEME_NULLP(pr); pr = SCHEME_CDR(pr)) { @@ -3415,13 +3452,16 @@ static Scheme_Object *search_shared_pes(Scheme_Object *shared_pes, pos = scheme_hash_get(pt->ht, glob_id); if (pos) { - /* Found it, maybe. Check marks. */ + /* Found it, maybe. Check marks & bdg. */ int mark_len; EXPLAIN(fprintf(stderr, "%d found %p\n", depth, pos)); - mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, depth, &skip); - if (mark_len > best_match_len) { - /* Marks match and improve on previously found match. Build suitable rename: */ + mark_len = check_matching_marks(SCHEME_CAR(pr), orig_id, &marks_cache, bdg, depth, &skip, &bdg_skip); + if (best_match_bdg_skip == -1) best_match_bdg_skip = bdg_skip; + if ((bdg_skip < best_match_bdg_skip) + || ((bdg_skip == best_match_bdg_skip) && (mark_len > best_match_len))) { + /* Marks and bdg match and improve on previously found match. Build suitable rename: */ best_match_len = mark_len; + best_match_bdg_skip = bdg_skip; if (_skipped) *_skipped = skip; idx = SCHEME_CAR(SCHEME_CAR(pr)); @@ -3684,10 +3724,10 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, Scheme_Object *modidx_shift_to = NULL, *modidx_shift_from = NULL; Scheme_Object *rename_stack[QUICK_STACK_SIZE], *rib_delim = scheme_false; int stack_pos = 0, no_lexical = 0; - int is_in_module = 0, skip_other_mods = 0, floating_checked = 0; + int is_in_module = 0, skip_other_mods = 0; Scheme_Lexical_Rib *rib = NULL, *did_rib = NULL; Scheme_Object *phase = orig_phase; - Scheme_Object *bdg = NULL, *floating = NULL; + Scheme_Object *bdg = NULL; Scheme_Hash_Table *export_registry = NULL; int mresult_skipped = -1; int depends_on_unsealed_rib = 0, mresult_depends_unsealed = 0; @@ -3877,13 +3917,8 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, if (!bdg) { EXPLAIN(fprintf(stderr, "%d get bdg\n", depth)); bdg = resolve_env(a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, NULL); - if (SCHEME_FALSEP(bdg)) { - if (!floating_checked) { - floating = check_floating_id(a); - floating_checked = 1; - } - bdg = floating; - } + if (SCHEME_FALSEP(bdg)) + bdg = get_old_module_env(a); } /* Remap id based on marks and rest-of-wraps resolution: */ glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, &skipped); @@ -3927,7 +3962,13 @@ static Scheme_Object *resolve_env(Scheme_Object *a, Scheme_Object *orig_phase, get_names_done = 0; if (!rename) { EXPLAIN(fprintf(stderr, "%d in pes\n", depth)); - rename = search_shared_pes(mrn->shared_pes, glob_id, a, get_names, 0, depth, &skipped); + if (!bdg) { + EXPLAIN(fprintf(stderr, "%d get bdg\n", depth)); + bdg = resolve_env(a, orig_phase, 0, NULL, recur_skip_ribs, NULL, NULL, depth+1, NULL); + if (SCHEME_FALSEP(bdg)) + bdg = get_old_module_env(a); + } + rename = search_shared_pes(mrn->shared_pes, glob_id, a, bdg, get_names, 0, depth, &skipped); if (rename) get_names_done = 1; } @@ -4320,10 +4361,10 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ { WRAP_POS wraps; Scheme_Object *result; - int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL, floating_checked = 0; + int is_in_module = 0, skip_other_mods = 0, sealed = STX_SEAL_ALL; int no_lexical = !free_id_recur; Scheme_Object *phase = orig_phase; - Scheme_Object *bdg = NULL, *floating = NULL; + Scheme_Object *bdg = NULL; result = ((Scheme_Stx *)a)->u.modinfo_cache; if (result && SAME_OBJ(phase, scheme_make_integer(0))) @@ -4400,13 +4441,8 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ /* Resolve based on binding ignoring modules: */ if (!bdg) { bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL); - if (SCHEME_FALSEP(bdg)) { - if (!floating_checked) { - floating = check_floating_id(a); - floating_checked = 1; - } - bdg = floating; - } + if (SCHEME_FALSEP(bdg)) + bdg = get_old_module_env(a); } /* Remap id based on marks and rest-of-wraps resolution: */ glob_id = scheme_tl_id_sym((Scheme_Env *)mrn->marked_names, a, bdg, 0, NULL, NULL); @@ -4438,9 +4474,15 @@ static Scheme_Object *get_module_src_name(Scheme_Object *a, Scheme_Object *orig_ if (!rename && mrn->nomarshal_ht) rename = scheme_hash_get(mrn->nomarshal_ht, glob_id); - if (!rename) - result = search_shared_pes(mrn->shared_pes, glob_id, a, NULL, 1, 0, NULL); - else { + if (!rename) { + if (!bdg) { + EXPLAIN(fprintf(stderr, "%d get bdg\n", depth)); + bdg = resolve_env(a, orig_phase, 0, NULL, NULL, NULL, NULL, 0, NULL); + if (SCHEME_FALSEP(bdg)) + bdg = get_old_module_env(a); + } + result = search_shared_pes(mrn->shared_pes, glob_id, a, bdg, NULL, 1, 0, NULL); + } else { /* match; set result: */ if (mrn->kind == mzMOD_RENAME_MARKED) skip_other_mods = 1; @@ -4738,7 +4780,8 @@ int scheme_stx_ribs_matter(Scheme_Object *a, Scheme_Object *skip_ribs) } Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a) - /* Returns either false, a lexical-rename symbol, or void for "floating" */ + /* Returns either false, a lexical-rename symbol, or an mark/mark-list + for a prior module */ { if (SCHEME_STXP(a)) { Scheme_Object *r; @@ -4746,7 +4789,7 @@ Scheme_Object *scheme_stx_moduleless_env(Scheme_Object *a) r = resolve_env(a, scheme_make_integer(0), 0, NULL, NULL, NULL, NULL, 0, NULL); if (SCHEME_FALSEP(r)) - r = check_floating_id(a); + r = get_old_module_env(a); if (r) return r; @@ -6234,7 +6277,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum, else a = scheme_hash_get(rns, aa); if (!a) { - a = scheme_make_vector(5, NULL); + a = scheme_make_vector(6, NULL); SCHEME_VEC_ELS(a)[0] = SCHEME_VEC_ELS(aa)[0]; SCHEME_VEC_ELS(a)[1] = SCHEME_VEC_ELS(aa)[1]; SCHEME_VEC_ELS(a)[2] = SCHEME_VEC_ELS(aa)[2]; @@ -6243,6 +6286,7 @@ static Scheme_Object *wraps_to_datum(Scheme_Object *stx_datum, SCHEME_VEC_ELS(a)[4] = SCHEME_VEC_ELS(aa)[4]; else SCHEME_VEC_ELS(a)[4] = scheme_false; + SCHEME_VEC_ELS(a)[5] = SCHEME_VEC_ELS(aa)[5]; a = scheme_box(a); scheme_hash_set(rns, aa, a); } @@ -6658,7 +6702,7 @@ static Scheme_Object *unmarshal_mark(Scheme_Object *_a, Scheme_Unmarshal_Tables return n; } -#if 0 +#if 1 # define return_NULL return (printf("%d\n", __LINE__), NULL) #else # define return_NULL return NULL @@ -6950,13 +6994,21 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, return_NULL; p = SCHEME_CDR(mli); - if (SCHEME_PAIRP(p) && SCHEME_PAIRP(SCHEME_CAR(p))) { - /* list of marks: */ - Scheme_Object *m_first = scheme_null, *m_last = NULL, *mp, *after_marks; + if (SCHEME_PAIRP(p) && (SCHEME_PAIRP(SCHEME_CAR(p)) + || SCHEME_VECTORP(SCHEME_CAR(p)))) { + /* list of marks or a vector of marks and bdg: */ + Scheme_Object *m_first = scheme_null, *m_last = NULL, *mp, *after_marks, *bdg; after_marks = SCHEME_CDR(p); mli = SCHEME_CAR(p); + if (SCHEME_VECTORP(mli)) { + if (SCHEME_VEC_SIZE(mli) != 2) return_NULL; + bdg = SCHEME_VEC_ELS(mli)[1]; + mli = SCHEME_VEC_ELS(mli)[0]; + } else + bdg = NULL; + while (SCHEME_PAIRP(mli)) { p = SCHEME_CAR(mli); p = unmarshal_mark(p, ut); @@ -6971,13 +7023,45 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, mli = SCHEME_CDR(mli); } + if (!SCHEME_NULLP(mli)) return_NULL; + + mli = m_first; + + if (bdg) { + if (!SCHEME_SYMBOLP(bdg) && !SCHEME_FALSEP(bdg)) { + if (SCHEME_MARKP(bdg)) + bdg = unmarshal_mark(bdg, ut); + else { + m_first = scheme_null; + m_last = NULL; + while (SCHEME_PAIRP(bdg)) { + p = SCHEME_CAR(bdg); + if (!SCHEME_MARKP(p)) return_NULL; + p = unmarshal_mark(p, ut); + mp = scheme_make_pair(p, scheme_null); + if (m_last) + SCHEME_CDR(m_last) = mp; + else + m_first = mp; + m_last = mp; + bdg = SCHEME_CDR(bdg); + } + if (!SCHEME_NULLP(bdg) + || !SCHEME_PAIRP(m_first) + || !SCHEME_PAIRP(SCHEME_CDR(m_first))) + return_NULL; + bdg = m_first; + } + } + mli = scheme_make_vector(2, mli); + SCHEME_VEC_ELS(mli)[1] = bdg; + } /* Rebuild for unmarshaled marks: */ ai = scheme_make_pair(SCHEME_CAR(ai), scheme_make_pair(SCHEME_CADR(ai), - scheme_make_pair(m_first, after_marks))); + scheme_make_pair(mli, after_marks))); - if (!SCHEME_NULLP(mli)) return_NULL; p = after_marks; } @@ -7075,7 +7159,24 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, if (SCHEME_VECTORP(a)) { if (SCHEME_VEC_SIZE(a) != 2) return_NULL; bdg = SCHEME_VEC_ELS(a)[1]; - if (!SCHEME_SYMBOLP(bdg) && !SCHEME_VOIDP(bdg)) return_NULL; + if (SCHEME_SYMBOLP(bdg)) { + /* ok */ + } else if (SCHEME_MARKP(bdg)) { + bdg = unmarshal_mark(bdg, ut); + } else { + Scheme_Object *bl = scheme_null; + while (SCHEME_PAIRP(bdg)) { + if (SCHEME_MARKP(SCHEME_CAR(bdg))) + bl = scheme_make_pair(unmarshal_mark(SCHEME_CAR(bdg), ut), + bl); + else + break; + bdg = SCHEME_CDR(bdg); + } + if (!SCHEME_NULLP(bdg)) + return_NULL; + bdg = scheme_reverse(bl); + } a = SCHEME_VEC_ELS(a)[0]; } @@ -7139,10 +7240,16 @@ static Scheme_Object *datum_to_wraps(Scheme_Object *w, a = make_prune_context(SCHEME_BOX_VAL(a)); } else { /* must be a phase shift */ - Scheme_Object *vec; + Scheme_Object *vec, *cancel_id; vec = SCHEME_BOX_VAL(a); if (!SCHEME_VECTORP(vec)) return_NULL; - if (SCHEME_VEC_SIZE(vec) != 5) return_NULL; + if (SCHEME_VEC_SIZE(vec) != 6) return_NULL; + + cancel_id = SCHEME_VEC_ELS(vec)[5]; + if (SCHEME_TRUEP(cancel_id)) { + cancel_id = unmarshal_mark(cancel_id, ut); + SCHEME_VEC_ELS(vec)[5] = cancel_id; + } } } else { return_NULL; @@ -8400,7 +8507,7 @@ static Scheme_Object *identifier_prune_to_module(int argc, Scheme_Object **argv) /* Phase shift: */ Scheme_Object *vec, *src; - vec = SCHEME_PTR_VAL(WRAP_POS_FIRST(w)); + vec = SCHEME_BOX_VAL(WRAP_POS_FIRST(w)); src = SCHEME_VEC_ELS(vec)[1];