Merge pull request #914 from pyrmont/feature.missing-symbols

Support looking up missing symbols during compilation

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:

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) {

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(

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)

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)
+(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
-        "math/log-gamma")
+(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
 
-(def ch (ev/thread-chan 2))
+# missing symbols
-(def att (ev/thread-chan 109))
+
-(assert att "`att` was nil after creation")
+(def replacement 10)
-(ev/give ch att)
+(defn lookup-symbol [sym env] (dyn 'replacement))
-(ev/do-thread
+
-  (assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
+(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)