diff --git a/src/core/compile.c b/src/core/compile.c index a4c8c2bf..b80947cd 100644 --- a/src/core/compile.c +++ b/src/core/compile.c @@ -197,6 +197,39 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) { } } +static int lookup_missing( + JanetCompiler *c, + const uint8_t *sym, + JanetFunction *handler, + Janet *out) { + Janet args[2] = { janet_wrap_symbol(sym), janet_wrap_table(c->env) }; + JanetFiber *fiberp = janet_fiber(handler, 64, 2, args); + if (NULL == fiberp) { + int32_t minar = handler->def->min_arity; + int32_t maxar = handler->def->max_arity; + const uint8_t *es = NULL; + if (minar > 2) + es = janet_formatc("lookup handler arity mismatch, minimum at most 2, got %d", minar); + if (maxar < 2) + es = janet_formatc("lookup handler arity mismatch, maximum at least 2, got %d", maxar); + janetc_error(c, es); + return 0; + } + fiberp->env = c->env; + int lock = janet_gclock(); + Janet tempOut; + JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut); + janet_gcunlock(lock); + if (status != JANET_SIGNAL_OK) { + janetc_error(c, janet_formatc("(lookup) %V", tempOut)); + return 0; + } else { + *out = tempOut; + } + + return 1; +} + /* Allow searching for symbols. Return information about the symbol */ JanetSlot janetc_resolve( JanetCompiler *c, @@ -230,6 +263,23 @@ JanetSlot janetc_resolve( /* Symbol not found - check for global */ { JanetBinding binding = janet_resolve_ext(c->env, sym); + if (binding.type == JANET_BINDING_NONE) { + Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol")); + Janet entry; + switch (janet_type(handler)) { + case JANET_NIL: + break; + case JANET_FUNCTION: + if (!lookup_missing(c, sym, janet_unwrap_function(handler), &entry)) + return janetc_cslot(janet_wrap_nil()); + binding = janet_binding_from_entry(entry); + break; + default: + janetc_error(c, janet_formatc("invalid lookup handler %V", handler)); + return janetc_cslot(janet_wrap_nil()); + } + } + switch (binding.type) { default: case JANET_BINDING_NONE: diff --git a/src/core/util.c b/src/core/util.c index 8a1fcad6..44ad8b34 100644 --- a/src/core/util.c +++ b/src/core/util.c @@ -597,9 +597,8 @@ void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetReg } #endif -JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { +JanetBinding janet_binding_from_entry(Janet entry) { JanetTable *entry_table; - Janet entry = janet_table_get(env, janet_wrap_symbol(sym)); JanetBinding binding = { JANET_BINDING_NONE, janet_wrap_nil(), @@ -649,6 +648,11 @@ JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { return binding; } +JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) { + Janet entry = janet_table_get(env, janet_wrap_symbol(sym)); + return janet_binding_from_entry(entry); +} + JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) { JanetBinding binding = janet_resolve_ext(env, sym); if (binding.type == JANET_BINDING_DYNAMIC_DEF || binding.type == JANET_BINDING_DYNAMIC_MACRO) { diff --git a/src/core/util.h b/src/core/util.h index 0c2a8ae8..6f253c89 100644 --- a/src/core/util.h +++ b/src/core/util.h @@ -84,6 +84,7 @@ void janet_buffer_format( int32_t argc, Janet *argv); Janet janet_next_impl(Janet ds, Janet key, int is_interpreter); +JanetBinding janet_binding_from_entry(Janet entry); /* Registry functions */ void janet_registry_put( diff --git a/test/suite0009.janet b/test/suite0009.janet index 0422fb39..8a1ecc0d 100644 --- a/test/suite0009.janet +++ b/test/suite0009.janet @@ -123,12 +123,12 @@ (defer (:close outstream) (:write outstream "123\n") (:write outstream "456\n")) - + (def outstream (os/open "unique.txt" :r)) (defer (:close outstream) (assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2")) (os/rm "unique.txt"))) - + # ev/gather (assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1") @@ -266,4 +266,13 @@ (ev/rselect c2) (assert (= (slice arr) (slice (range 100))) "ev/chan-close 3") +# threaded channels + +(def ch (ev/thread-chan 2)) +(def att (ev/thread-chan 109)) +(assert att "`att` was nil after creation") +(ev/give ch att) +(ev/do-thread + (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels.")) + (end-suite) diff --git a/test/suite0011.janet b/test/suite0011.janet index 7df39c2d..a67ac787 100644 --- a/test/suite0011.janet +++ b/test/suite0011.janet @@ -21,18 +21,23 @@ (import ./helper :prefix "" :exit true) (start-suite 11) -(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) - "math/gamma") +# math gamma -(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) - "math/log-gamma") +(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma") +(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma") -(def ch (ev/thread-chan 2)) -(def att (ev/thread-chan 109)) -(assert att "`att` was nil after creation") -(ev/give ch att) -(ev/do-thread - (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels.")) +# missing symbols + +(def replacement 10) +(defn lookup-symbol [sym env] (dyn 'replacement)) + +(setdyn :missing-symbol lookup-symbol) + +(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol") + +(setdyn :missing-symbol nil) + +(assert-error "compile error" (eval-string "(+ a 5)")) (end-suite)