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

add `identifier-prune-to-source-module' and use it in contract implementation

Browse Source 
reduces DrRacket's initial footprint by 20-25% --- back to the v5.0 level
This commit is contained in:
Matthew Flatt 2010-06-30 09:52:30 -06:00
parent 459dff9f37
commit 47eb8ea815
7 changed files with 440 additions and 385 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/racket/contract/private/provide.rkt
View File

@ -78,13 +78,14 @@
(with-syntax ([contract-id contract-id]
[id id]
[external-id external-id]
[pos-module-source pos-module-source])
[pos-module-source pos-module-source]
[loc-id (identifier-prune-to-source-module id)])
(syntax-local-introduce
(syntax-local-lift-expression
#`(contract contract-id
id
pos-module-source
(first-requiring-module (quote-syntax id) (quote-module-path))
(first-requiring-module (quote-syntax loc-id) (quote-module-path))
'external-id
(quote-srcloc id))))))])
(when key

7
collects/scribblings/reference/stx-ops.scrbl
View File

@ -241,3 +241,10 @@ particular, transferring the lexical context via
other than one in @scheme[syms] produces a identifier with no binding.
See also @scheme[quote-syntax/prune].}
@defproc[(identifier-prune-to-source-module [id-stx identifier?])
identifier?]{
Returns an identifier with its lexical context minimized to that
needed for @scheme[syntax-source-module]. The minimized lexical
context does not include any bindings.}

4
collects/unstable/location.rkt
View File

@ -31,7 +31,9 @@
[pos (srcloc-position src)]
[span (srcloc-span src)])
#'(make-srcloc 'src 'line 'col 'pos 'span)))]
[else #'(build-source-location (quote-syntax loc))]))]))
[else (with-syntax ([loc (identifier-prune-to-source-module
(datum->syntax #'loc 'loc #'loc #'loc))])
#'(build-source-location (quote-syntax loc)))]))]))
(define-syntax-rule (define-quote-srcloc-accessors [name accessor] ...)
(define-syntaxes [ name ... ]

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

File diff suppressed because it is too large Load Diff

2
src/racket/src/schminc.h
View File

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 996
#define EXPECTED_PRIM_COUNT 997
#define EXPECTED_UNSAFE_COUNT 66
#define EXPECTED_FLFXNUM_COUNT 55

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

@ -13,12 +13,12 @@
consistently.)
*/
#define MZSCHEME_VERSION "5.0.0.2"
#define MZSCHEME_VERSION "5.0.0.3"
#define MZSCHEME_VERSION_X 5
#define MZSCHEME_VERSION_Y 0
#define MZSCHEME_VERSION_Z 0
#define MZSCHEME_VERSION_W 2
#define MZSCHEME_VERSION_W 3
#define MZSCHEME_VERSION_MAJOR ((MZSCHEME_VERSION_X * 100) + MZSCHEME_VERSION_Y)
#define MZSCHEME_VERSION_MINOR ((MZSCHEME_VERSION_Z * 1000) + MZSCHEME_VERSION_W)

45
src/racket/src/stxobj.c
View File

@ -89,6 +89,7 @@ static Scheme_Object *module_trans_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_templ_binding(int argc, Scheme_Object **argv);
static Scheme_Object *module_label_binding(int argc, Scheme_Object **argv);
static Scheme_Object *identifier_prune(int argc, Scheme_Object **argv);
static Scheme_Object *identifier_prune_to_module(int argc, Scheme_Object **argv);
static Scheme_Object *syntax_src_module(int argc, Scheme_Object **argv);
static Scheme_Object *syntax_recertify(int argc, Scheme_Object **argv);
@ -579,6 +580,11 @@ void scheme_init_stx(Scheme_Env *env)
"identifier-prune-lexical-context",
1, 2),
env);
scheme_add_global_constant("identifier-prune-to-source-module",
scheme_make_immed_prim(identifier_prune_to_module,
"identifier-prune-to-source-module",
1, 1),
env);
scheme_add_global_constant("syntax-source-module",
@ -9131,6 +9137,45 @@ static Scheme_Object *identifier_prune(int argc, Scheme_Object **argv)
return scheme_add_rename(a, p);
}
static Scheme_Object *identifier_prune_to_module(int argc, Scheme_Object **argv)
{
WRAP_POS w;
Scheme_Stx *stx = (Scheme_Stx *)argv[0];
Scheme_Object *l = scheme_null;
if (!SCHEME_STXP(argv[0]) || !SCHEME_STX_SYMBOLP(argv[0]))
scheme_wrong_type("identifier-prune-to-source-module", "identifier syntax", 0, argc, argv);
/* Keep only redirecting phase shifts */
WRAP_POS_INIT(w, ((Scheme_Stx *)stx)->wraps);
while (!WRAP_POS_END_P(w)) {
if (SCHEME_BOXP(WRAP_POS_FIRST(w))) {
/* Phase shift: */
Scheme_Object *vec, *dest, *src;
vec = SCHEME_PTR_VAL(WRAP_POS_FIRST(w));
src = SCHEME_VEC_ELS(vec)[1];
dest = SCHEME_VEC_ELS(vec)[2];
/* If src is #f, shift is just for phase; no redirection */
if (!SCHEME_FALSEP(src)) {
l = scheme_make_pair(WRAP_POS_FIRST(w), l);
}
}
WRAP_POS_INC(w);
}
l = scheme_reverse(l);
stx = (Scheme_Stx *)scheme_make_stx(stx->val, stx->srcloc, stx->props);
stx->wraps = l;
return (Scheme_Object *)stx;
}
static Scheme_Object *syntax_src_module(int argc, Scheme_Object **argv)
{
int source = 0;