Allow dynamically setting output for printers

Some functions like print and debug/stacktrace print
to a file, usually stdout. This file can now be optionally set
via a dynamic variable.

src/boot/boot.janet

@@ -1699,7 +1699,7 @@
         :export ep} (table ;args))
   (def newenv (require path ;args))
   (def prefix (or (and as (string as "/")) prefix (string path "/")))
-  (loop [[k v] :pairs newenv :when (not (v :private))]
+  (loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
     (def newv (table/setproto @{:private (not ep)} v))
     (put env (symbol prefix k) newv)))
 

src/core/capi.c

@@ -206,6 +206,7 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
 }
 
 Janet janet_dyn(const char *name) {
+    if (!janet_vm_fiber) return janet_wrap_nil();
     if (janet_vm_fiber->env) {
         return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
     } else {
@@ -214,6 +215,7 @@ Janet janet_dyn(const char *name) {
 }
 
 void janet_setdyn(const char *name, Janet value) {
+    if (!janet_vm_fiber) return;
     if (!janet_vm_fiber->env) {
         janet_vm_fiber->env = janet_table(1);
     }

src/core/debug.c

@@ -95,6 +95,7 @@ void janet_debug_find(
  * consitency with the top level code it is defined once. */
 void janet_stacktrace(JanetFiber *fiber, Janet err) {
     int32_t fi;
+    FILE *out = janet_dynfile("err", stderr);
     const char *errstr = (const char *)janet_to_string(err);
     JanetFiber **fibers = NULL;
     int wrote_error = 0;
@@ -116,43 +117,43 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
             if (!wrote_error) {
                 JanetFiberStatus status = janet_fiber_status(fiber);
                 const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
-                fprintf(stderr, "%s%s: %s\n",
+                fprintf(out, "%s%s: %s\n",
                         prefix,
                         janet_status_names[status],
                         errstr);
                 wrote_error = 1;
             }
 
-            fprintf(stderr, "  in");
+            fprintf(out, "  in");
 
             if (frame->func) {
                 def = frame->func->def;
-                fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
+                fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
                 if (def->source) {
-                    fprintf(stderr, " [%s]", (const char *)def->source);
+                    fprintf(out, " [%s]", (const char *)def->source);
                 }
             } else {
                 JanetCFunction cfun = (JanetCFunction)(frame->pc);
                 if (cfun) {
                     Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
                     if (!janet_checktype(name, JANET_NIL))
-                        fprintf(stderr, " %s", (const char *)janet_to_string(name));
+                        fprintf(out, " %s", (const char *)janet_to_string(name));
                     else
-                        fprintf(stderr, " <cfunction>");
+                        fprintf(out, " <cfunction>");
                 }
             }
             if (frame->flags & JANET_STACKFRAME_TAILCALL)
-                fprintf(stderr, " (tailcall)");
+                fprintf(out, " (tailcall)");
             if (frame->func && frame->pc) {
                 int32_t off = (int32_t)(frame->pc - def->bytecode);
                 if (def->sourcemap) {
                     JanetSourceMapping mapping = def->sourcemap[off];
-                    fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
+                    fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
                 } else {
-                    fprintf(stderr, " pc=%d", off);
+                    fprintf(out, " pc=%d", off);
                 }
             }
-            fprintf(stderr, "\n");
+            fprintf(out, "\n");
         }
     }
 

src/core/io.c

@@ -333,17 +333,17 @@ static Janet io_file_get(void *p, Janet key) {
     return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
 }
 
-static IOFile *io_isfile(Janet x) {
+FILE *janet_dynfile(const char *name, FILE *def) {
-    if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
+    Janet x = janet_dyn(name);
+    if (!janet_checktype(x, JANET_ABSTRACT)) return def;
     void *abstract = janet_unwrap_abstract(x);
-    if (janet_abstract_type(abstract) != &cfun_io_filetype) return NULL;
+    if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
-    return (IOFile *)abstract;
+    IOFile *iofile = abstract;
+    return iofile->file;
 }
 
 static Janet cfun_io_print(int32_t argc, Janet *argv) {
-    /* Get output stream */
+    FILE *f = janet_dynfile("out", stdout);
-    IOFile *outf = io_isfile(janet_dyn("out"));
-    FILE *f = outf ? outf->file : stdout;
     for (int32_t i = 0; i < argc; ++i) {
         int32_t j, len;
         const uint8_t *vstr = janet_to_string(argv[i]);

src/include/janet.h

@@ -1279,11 +1279,12 @@ JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
 JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
 JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
 
-JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
-
 JANET_API Janet janet_dyn(const char *name);
 JANET_API void janet_setdyn(const char *name, Janet value);
 
+JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
+JANET_API FILE *janet_dynfile(const char *name, FILE *def);
+
 /* Marshal API */
 #define janet_marshal_size(ctx, x) janet_marshal_int64((ctx), (int64_t) (x))
 JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);

test/suite6.janet

@@ -88,4 +88,12 @@
            ))
         "int64 typed arrays")
 
+# Dynamic bindings
+(setdyn :a 10)
+(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
+(assert (= 10 (dyn :a)) "dyn usage 2")
+(assert (= nil (dyn :b)) "dyn usage 3")
+(setdyn :a 100)
+(assert (= 100 (dyn :a)) "dyn usage 4")
+
 (end-suite)