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

recompile-linklet: accept option argument

Browse Source 
Add an options argument for consistency with `compile-linklet`.
This commit is contained in:
Matthew Flatt 2018-11-23 18:04:48 -07:00
parent ac70e9a058
commit 4946196c91
2 changed files with 58 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
pkgs/racket-doc/scribblings/reference/linklet.scrbl
View File

@ -199,18 +199,22 @@ The symbols in @racket[options] must be distinct, otherwise
[import-keys #f #f]
[get-import (any/c . -> . (values (or/c linklet? #f)
(or/c vector? #f)))
(lambda (import-key) (values #f #f))])
(lambda (import-key) (values #f #f))]
[options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)])
linklet?]
[(recompile-linklet [linklet linklet?]
[name any/c]
[import-keys vector?]
[get-import (any/c . -> . (values (or/c linklet? #f)
(or/c vector? #f)))
(lambda (import-key) (values #f #f))])
(lambda (import-key) (values #f #f))]
[options (listof (or/c 'serializable 'unsafe 'static)) '(serializable)])
(values linklet? vector?)])]{
Like @racket[compile-linklet], but takes an already-compiled linklet
and potentially optimizes it further.}
and potentially optimizes it further.
@history[#:changed "7.1.0.6" @elem{Added the @racket[options] argument.}]}
@defproc[(eval-linklet [linklet linklet?]) linklet?]{

65
racket/src/racket/src/linklet.c
View File

@ -147,7 +147,7 @@ void scheme_init_linklet(Scheme_Startup_Env *env)
ADD_FOLDING_PRIM("linklet?", linklet_p, 1, 1, 1, env);
ADD_PRIM_W_ARITY2("compile-linklet", compile_linklet, 1, 5, 2, 2, env);
ADD_PRIM_W_ARITY2("recompile-linklet", recompile_linklet, 1, 4, 2, 2, env);
ADD_PRIM_W_ARITY2("recompile-linklet", recompile_linklet, 1, 5, 2, 2, env);
ADD_IMMED_PRIM("eval-linklet", eval_linklet, 1, 1, env);
ADD_PRIM_W_ARITY2("instantiate-linklet", instantiate_linklet, 2, 4, 0, -1, env);
ADD_PRIM_W_ARITY("linklet-import-variables", linklet_import_variables, 1, 1, env);
@ -365,29 +365,15 @@ void extract_import_info(const char *who, int argc, Scheme_Object **argv,
*_get_import = NULL;
}
static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
static void parse_compile_options(const char *who, int arg_pos,
int argc, Scheme_Object **argv,
int *_unsafe, int *_static_mode)
{
Scheme_Object *name, *e, *import_keys, *get_import, *a[2];
int unsafe = 0, static_mode = 0;
/* Last argument, `serializable?`, is ignored */
extract_import_info("compile-linklet", argc, argv, &import_keys, &get_import);
if ((argc > 1) && SCHEME_TRUEP(argv[1]))
name = argv[1];
else
name = scheme_intern_symbol("anonymous");
e = argv[0];
if (!SCHEME_STXP(e))
e = scheme_datum_to_syntax(e, scheme_false, DTS_CAN_GRAPH);
if (argc > 4) {
Scheme_Object *flags, *redundant = NULL, *flag;
Scheme_Object *redundant = NULL, *flag, *flags = argv[arg_pos];
int serializable = 0;
int unsafe = *_unsafe;
int static_mode = *_static_mode;
flags = argv[4];
while (SCHEME_PAIRP(flags)) {
flag = SCHEME_CAR(flags);
if (SAME_OBJ(flag, serializable_symbol)) {
@ -406,15 +392,41 @@ static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
break;
flags = SCHEME_CDR(flags);
}
if (!SCHEME_NULLP(flags))
scheme_wrong_contract("compile-linklet", "(listof/c 'serializable 'unsafe)", 4, argc, argv);
scheme_wrong_contract("compile-linklet", "(listof/c 'serializable 'unsafe)", arg_pos, argc, argv);
if (redundant)
scheme_contract_error("compile-linklet", "redundant option",
"redundant option", 1, redundant,
"supplied options", 1, argv[4],
"supplied options", 1, argv[arg_pos],
NULL);
*_unsafe = unsafe;
*_static_mode = static_mode;
}
static Scheme_Object *compile_linklet(int argc, Scheme_Object **argv)
{
Scheme_Object *name, *e, *import_keys, *get_import, *a[2];
int unsafe = 0, static_mode = 0;
/* Last argument, `serializable?`, is ignored */
extract_import_info("compile-linklet", argc, argv, &import_keys, &get_import);
if ((argc > 1) && SCHEME_TRUEP(argv[1]))
name = argv[1];
else
name = scheme_intern_symbol("anonymous");
e = argv[0];
if (!SCHEME_STXP(e))
e = scheme_datum_to_syntax(e, scheme_false, DTS_CAN_GRAPH);
if (argc > 4)
parse_compile_options("compile-linklet", 4, argc, argv, &unsafe, &static_mode);
e = (Scheme_Object *)compile_and_or_optimize_linklet(e, NULL, name, &import_keys, get_import,
unsafe, static_mode);
@ -430,6 +442,7 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv)
{
Scheme_Object *name, *import_keys, *get_import, *a[2];
Scheme_Linklet *linklet;
int unsafe = 0, static_mode = 0;
if (!SAME_TYPE(SCHEME_TYPE(argv[0]), scheme_linklet_type))
scheme_wrong_contract("recompile-linklet", "linklet?", 0, argc, argv);
@ -454,7 +467,11 @@ static Scheme_Object *recompile_linklet(int argc, Scheme_Object **argv)
NULL);
}
linklet = compile_and_or_optimize_linklet(NULL, linklet, name, &import_keys, get_import, 0, 0);
if (argc > 4)
parse_compile_options("recompile-linklet", 4, argc, argv, &unsafe, &static_mode);
linklet = compile_and_or_optimize_linklet(NULL, linklet, name, &import_keys, get_import,
unsafe, static_mode);
if (import_keys) {
a[0] = (Scheme_Object *)linklet;