Fix named arguments with optional args.

This commit is contained in:
Calvin Rose 2022-06-18 09:46:28 -05:00
parent 1d905bf07f
commit a1172529bf
4 changed files with 22 additions and 21 deletions

View File

@ -3643,7 +3643,7 @@
(defn ffi/context
"Set the path of the dynamic library to implictly bind, as well
as other global state for ease of creating native bindings."
[native-path &named map-symbols lazy]
[&opt native-path &named map-symbols lazy]
(default map-symbols default-mangle)
(def lib (if lazy nil (ffi/native native-path)))
(def lazy-lib (if lazy (delay (ffi/native native-path))))
@ -3663,26 +3663,19 @@
(def type-args (map 1 arg-pairs))
(def computed-type-args (eval ~[,;type-args]))
(def {:native lib
:native-path np
:lazy lazy
:native-lazy llib
:map-symbols ms} (assert (dyn *ffi-context*) "no ffi context found"))
(def raw-symbol (ms name))
(defn make-sig []
(ffi/signature :default ret-type ;computed-type-args))
(defn make-ptr []
(assert (ffi/lookup (llib) raw-symbol) "failed to find symbol"))
(if lazy
(let [ptr
(delay
(assert (ffi/lookup (llib) raw-symbol) "failed to find symbol"))
sig
(delay
(ffi/signature :default ret-type ;computed-type-args))]
~(defn ,name ,;meta [,;formal-args]
(,ffi/call (,ptr) (,sig) ,;formal-args)))
(let [ptr
(assert (ffi/lookup lib raw-symbol) "failed to find symbol")
sig
(ffi/signature :default ret-type ;computed-type-args)]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,name ,;meta [,;formal-args]
(,ffi/call ,ptr ,sig ,;formal-args))))))
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
###
###

View File

@ -1101,15 +1101,16 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline,
}
JANET_CORE_FN(janet_core_raw_native,
"(ffi/native path)",
"(ffi/native &opt path)",
"Load a shared object or dll from the given path, and do not extract"
" or run any code from it. This is different than `native`, which will "
"run initialization code to get a module table. Returns a `core/native`.") {
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
char *processed_name = get_processed_name(path);
"run initialization code to get a module table. If `path` is nil, opens the current running binary. "
"Returns a `core/native`.") {
janet_arity(argc, 0, 1);
const char *path = janet_optcstring(argv, argc, 0, NULL);
char *processed_name = (NULL == path) ? NULL : get_processed_name(path);
Clib lib = load_clib(processed_name);
if (path != processed_name) janet_free(processed_name);
if (NULL != path && path != processed_name) janet_free(processed_name);
if (!lib) janet_panic(error_clib());
JanetAbstractNative *anative = janet_abstract(&janet_native_type, sizeof(JanetAbstractNative));
anative->clib = lib;

View File

@ -858,6 +858,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
for (i = 0; i < paramcount; i++) {
Janet param = params[i];
if (namedargs) {
arity--;
if (!janet_checktype(param, JANET_SYMBOL)) {
errmsg = "only named arguments can follow &named";
goto error;
@ -915,7 +916,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
}
vararg = 1;
structarg = 1;
arity = i;
arity--;
seenamp = 1;
namedargs = 1;
named_table = janet_table(10);

View File

@ -87,5 +87,11 @@
(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
(defn named-opt-arguments
[&opt x &named a b c]
(+ x a b c))
(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
(end-suite)