mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-11-25 09:47:17 +00:00
Code Issues 1 Releases Wiki Activity

Add proper optional arguments.

Browse Source 
Use &opt in the parameter list to get optional arguments.
This commit is contained in:
Calvin Rose 2019-03-12 00:23:14 -04:00
parent a246877c1e
commit d42bdf2443
9 changed files with 92 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
src/core/asm.c
View File

@ -525,15 +525,20 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
/* Set function arity */
x = janet_get1(s, janet_csymbolv("arity"));
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
x = janet_get1(s, janet_csymbolv("max-arity"));
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
x = janet_get1(s, janet_csymbolv("min-arity"));
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
/* Check vararg */
x = janet_get1(s, janet_csymbolv("vararg"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
/* Check strict arity */
x = janet_get1(s, janet_csymbolv("fix-arity"));
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
/* Check source */
x = janet_get1(s, janet_csymbolv("source"));
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
@ -822,6 +827,8 @@ Janet janet_disasm(JanetFuncDef *def) {
JanetArray *constants;
JanetTable *ret = janet_table(10);
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
if (NULL != def->source) {
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
@ -829,9 +836,6 @@ Janet janet_disasm(JanetFuncDef *def) {
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
}
if (def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
janet_table_put(ret, janet_csymbolv("fix-arity"), janet_wrap_true());
}
if (NULL != def->name) {
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
}

2
src/core/bytecode.c
View File

@ -208,6 +208,8 @@ JanetFuncDef *janet_funcdef_alloc() {
def->flags = 0;
def->slotcount = 0;
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
def->source = NULL;
def->sourcemap = NULL;
def->name = NULL;

1
src/core/compile.c
View File

@ -643,6 +643,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
def->source = c->source;
def->arity = 0;
def->min_arity = 0;
def->flags = 0;
if (scope->flags & JANET_SCOPE_ENV) {
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;

25
src/core/core.janet
View File

@ -142,7 +142,7 @@
(defmacro if-not
"Shorthand for (if (not ... "
[condition exp-1 exp-2 &]
[condition exp-1 &opt exp-2]
~(if ,condition ,exp-2 ,exp-1))
(defmacro when
@ -414,12 +414,12 @@
"Create a generator expression using the loop syntax. Returns a fiber
that yields all values inside the loop in order. See loop for details."
[head & body]
~(fiber/new (fn [&] (loop ,head (yield (do ,;body))))))
~(fiber/new (fn [] (loop ,head (yield (do ,;body))))))
(defmacro coro
"A wrapper for making fibers. Same as (fiber/new (fn [&] ...body))."
"A wrapper for making fibers. Same as (fiber/new (fn [] ...body))."
[& body]
(tuple fiber/new (tuple 'fn '[&] ;body)))
(tuple fiber/new (tuple 'fn '[] ;body)))
(defn sum
"Returns the sum of xs. If xs is empty, returns 0."
@ -439,7 +439,7 @@
"Make multiple bindings, and if all are truthy,
evaluate the tru form. If any are false or nil, evaluate
the fal form. Bindings have the same syntax as the let macro."
[bindings tru fal &]
[bindings tru &opt fal]
(def len (length bindings))
(if (zero? len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
@ -565,7 +565,7 @@
(sort-help a (+ piv 1) hi by))
a)
(fn sort [a by &]
(fn sort [a &opt by]
(sort-help a 0 (- (length a) 1) (or by order<)))))
(defn sorted
@ -1060,7 +1060,7 @@ value, one key will be ignored."
(defn spit
"Write contents to a file at path.
Can optionally append to the file."
[path contents mode &]
[path contents &opt mode]
(default mode :w)
(def f (file/open path mode))
(if-not f (error (string "could not open file " path " with mode " mode)))
@ -1402,7 +1402,7 @@ value, one key will be ignored."
"Create a new environment table. The new environment
will inherit bindings from the parent environment, but new
bindings will not pollute the parent environment."
[parent &]
[&opt parent]
(def parent (if parent parent _env))
(def newenv (table/setproto @{} parent))
newenv)
@ -1513,7 +1513,7 @@ value, one key will be ignored."
(defn eval-string
"Evaluates a string in the current environment. If more control over the
environment is needed, use run-context."
[str env &]
[str &opt env]
(var state (string str))
(defn chunks [buf _]
(def ret state)
@ -1522,7 +1522,6 @@ value, one key will be ignored."
(buffer/push-string buf str)
(buffer/push-string buf "\n")))
(var returnval nil)
(defn error1 [x &] (error x))
(run-context {:env env
:chunks chunks
:on-compile-error (fn [msg errf &]
@ -1540,7 +1539,7 @@ value, one key will be ignored."
(defn eval
"Evaluates a form in the current environment. If more control over the
environment is needed, use run-context."
[form env &]
[form &opt env]
(default env *env*)
(def res (compile form env "eval"))
(if (= (type res) :function)
@ -1694,7 +1693,7 @@ value, one key will be ignored."
get a chunk of source code that should return nil for end of file.
The second parameter is a function that is called when a signal is
caught."
[chunks onsignal &]
[&opt chunks onsignal]
(def newenv (make-env))
(default onsignal (fn [f x]
(case (fiber/status f)
@ -1716,7 +1715,7 @@ value, one key will be ignored."
(defn all-bindings
"Get all symbols available in the current environment."
[env &]
[&opt env]
(default env *env*)
(def envs @[])
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))

40
src/core/corelib.c
View File

@ -433,12 +433,16 @@ static void janet_quick_asm(
int32_t flags,
const char *name,
int32_t arity,
int32_t min_arity,
int32_t max_arity,
int32_t slots,
const uint32_t *bytecode,
size_t bytecode_size,
const char *doc) {
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = arity;
def->min_arity = min_arity;
def->max_arity = max_arity;
def->flags = flags;
def->slotcount = slots;
def->bytecode = malloc(bytecode_size);
@ -514,6 +518,8 @@ static void templatize_varop(
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
0,
INT32_MAX,
6,
varop_asm,
sizeof(varop_asm),
@ -567,6 +573,8 @@ static void templatize_comparator(
flags | JANET_FUNCDEF_FLAG_VARARG,
name,
0,
0,
INT32_MAX,
6,
comparator_asm,
sizeof(comparator_asm),
@ -604,7 +612,7 @@ static void make_apply(JanetTable *env) {
S(JOP_TAILCALL, 0)
};
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 6, apply_asm, sizeof(apply_asm),
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to "
@ -652,38 +660,38 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_core_cfuns(env, NULL, corelib_cfuns);
#ifdef JANET_BOOTSTRAP
janet_quick_asm(env, JANET_FUN_YIELD | JANET_FUNCDEF_FLAG_FIXARITY,
"debug", 0, 1, debug_asm, sizeof(debug_asm),
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns nil."));
janet_quick_asm(env, JANET_FUN_ERROR | JANET_FUNCDEF_FLAG_FIXARITY,
"error", 1, 1, error_asm, sizeof(error_asm),
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 2, yield_asm, sizeof(yield_asm),
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber [,x])\n\n"
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_GET | JANET_FUNCDEF_FLAG_FIXARITY,
"get", 2, 2, get_asm, sizeof(get_asm),
janet_quick_asm(env, JANET_FUN_GET,
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
JDOC("(get ds key)\n\n"
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
"symbols, and buffers are all associative and can be used with get. Order structures, name "
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
"take any value as a key except nil and return a value except nil. Byte sequences will return "
"integer representations of bytes as result of a get call."));
janet_quick_asm(env, JANET_FUN_PUT | JANET_FUNCDEF_FLAG_FIXARITY,
"put", 3, 3, put_asm, sizeof(put_asm),
janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
@ -691,13 +699,13 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH | JANET_FUNCDEF_FLAG_FIXARITY,
"length", 1, 1, length_asm, sizeof(length_asm),
janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT | JANET_FUNCDEF_FLAG_FIXARITY,
"bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
make_apply(env);

18
src/core/fiber.c
View File

@ -138,11 +138,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
int32_t next_arity = fiber->stacktop - fiber->stackstart;
/* Check strict arity before messing with state */
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != next_arity) {
return 1;
}
}
if (next_arity < func->def->min_arity) return 1;
if (next_arity > func->def->max_arity) return 1;
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
@ -204,11 +201,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
int32_t stacksize;
/* Check strict arity before messing with state */
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != next_arity) {
return 1;
}
}
if (next_arity < func->def->min_arity) return 1;
if (next_arity > func->def->max_arity) return 1;
if (fiber->capacity < nextstacktop) {
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
@ -303,11 +297,9 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetFunction *func = janet_getfunction(argv, 0);
JanetFiber *fiber;
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
if (func->def->arity != 0) {
if (func->def->min_arity != 0) {
janet_panic("expected nullary function in fiber constructor");
}
}
fiber = janet_fiber(func, 64, 0, NULL);
if (argc == 2) {
int32_t i;

4
src/core/marsh.c
View File

@ -203,6 +203,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
pushint(st, def->flags);
pushint(st, def->slotcount);
pushint(st, def->arity);
pushint(st, def->min_arity);
pushint(st, def->max_arity);
pushint(st, def->constants_length);
pushint(st, def->bytecode_length);
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
@ -708,6 +710,8 @@ static const uint8_t *unmarshal_one_def(
def->flags = readint(st, &data);
def->slotcount = readint(st, &data);
def->arity = readint(st, &data);
def->min_arity = readint(st, &data);
def->max_arity = readint(st, &data);
/* Read some lengths */
constants_length = readint(st, &data);

40
src/core/specials.c
View File

@ -643,16 +643,17 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetSlot ret;
Janet head;
JanetScope fnscope;
int32_t paramcount, argi, parami, arity, defindex, i;
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
JanetFopts subopts = janetc_fopts_default(c);
const Janet *params;
const char *errmsg = NULL;
/* Function flags */
int vararg = 0;
int fixarity = 1;
int allow_extra = 0;
int selfref = 0;
int seenamp = 0;
int seenopt = 0;
/* Begin function */
c->scope->flags |= JANET_SCOPE_CLOSURE;
@ -683,19 +684,32 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
Janet param = params[i];
if (janet_checktype(param, JANET_SYMBOL)) {
/* Check for varargs and unfixed arity */
if ((!seenamp) &&
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
seenamp = 1;
fixarity = 0;
if (i == paramcount - 1) {
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
if (seenamp) {
errmsg = "& in unexpected location";
goto error;
} else if (i == paramcount - 1) {
allow_extra = 1;
arity--;
} else if (i == paramcount - 2) {
vararg = 1;
arity -= 2;
} else {
errmsg = "variable argument symbol in unexpected location";
errmsg = "& in unexpected location";
goto error;
}
seenamp = 1;
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
if (seenopt) {
errmsg = "only one &opt allowed";
goto error;
} else if (i == paramcount - 1) {
errmsg = "&opt cannot be last item in parameter list";
goto error;
}
min_arity = i;
arity--;
seenopt = 1;
} else {
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
}
@ -704,6 +718,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
}
}
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
if (!seenopt) min_arity = arity;
/* Check for self ref */
if (selfref) {
JanetSlot slot = janetc_farslot(c);
@ -715,17 +732,20 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile function body */
if (parami + 1 == argn) {
janetc_emit(c, JOP_RETURN_NIL);
} else for (argi = parami + 1; argi < argn; argi++) {
} else {
for (argi = parami + 1; argi < argn; argi++) {
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
janetc_value(subopts, argv[argi]);
if (c->result.status == JANET_COMPILE_ERROR)
goto error2;
}
}
/* Build function */
def = janetc_pop_funcdef(c);
def->arity = arity;
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
def->min_arity = min_arity;
def->max_arity = max_arity;
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
if (selfref) def->name = janet_unwrap_symbol(head);

3
src/include/janet.h
View File

@ -725,7 +725,6 @@ struct JanetAbstractHead {
/* Some function definition flags */
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
@ -755,6 +754,8 @@ struct JanetFuncDef {
int32_t flags;
int32_t slotcount; /* The amount of stack space required for the function */
int32_t arity; /* Not including varargs */
int32_t min_arity; /* Including varargs */
int32_t max_arity; /* Including varargs */
int32_t constants_length;
int32_t bytecode_length;
int32_t environments_length;