From d47804d222b2b579c5c8409f3f32680f1f9bb51f Mon Sep 17 00:00:00 2001 From: Calvin Rose Date: Sat, 19 Oct 2019 09:44:27 -0500 Subject: [PATCH] Add prin, eprint, and eprin functions. The print family of functions now writes output to an optional buffer instead of a file bound to :out. This means output can be more easily captured an redirected. --- src/boot/boot.janet | 44 +++++++++---------- src/core/capi.c | 13 ------ src/core/debug.c | 34 +++++++-------- src/core/io.c | 104 ++++++++++++++++++++++++++++++++++++++++++-- src/core/run.c | 9 ++-- src/include/janet.h | 4 +- test/suite7.janet | 12 +++++ 7 files changed, 155 insertions(+), 65 deletions(-) diff --git a/src/boot/boot.janet b/src/boot/boot.janet index 97d4df2d..d1f318bd 100644 --- a/src/boot/boot.janet +++ b/src/boot/boot.janet @@ -1183,13 +1183,13 @@ nil) (defn printf - "Print formatted strings to stdout, followed by + "Print formatted strings to stdout or (dyn :out), followed by a new line." [f & args] - (file/write stdout (buffer/format @"" f ;args))) + (prin (buffer/format @"" f ;args))) (defn pp - "Pretty print to stdout." + "Pretty print to stdout or (dyn :out)." [x] (print (buffer/format @"" (dyn :pretty-format "%q") x))) @@ -1630,31 +1630,29 @@ [p where] (def ec (dyn :err-color)) (def [line col] (parser/where p)) - (file/write stderr - (if ec "\e[31m" "") - "parse error in " - where - " around line " - (string line) - ", column " - (string col) - ": " - (parser/error p) - (if ec "\e[0m" "") - "\n")) + (eprint + (if ec "\e[31m" "") + "parse error in " + where + " around line " + (string line) + ", column " + (string col) + ": " + (parser/error p) + (if ec "\e[0m" ""))) (defn bad-compile "Default handler for a compile error." [msg macrof where] (def ec (dyn :err-color)) - (file/write stderr - (if ec "\e[31m" "") - "compile error: " - msg - " while compiling " - where - (if ec "\e[0m" "") - "\n") + (eprint + (if ec "\e[31m" "") + "compile error: " + msg + " while compiling " + where + (if ec "\e[0m" "")) (when macrof (debug/stacktrace macrof))) (defn run-context diff --git a/src/core/capi.c b/src/core/capi.c index f7fae4b1..d4548e22 100644 --- a/src/core/capi.c +++ b/src/core/capi.c @@ -51,19 +51,6 @@ void janet_panicf(const char *format, ...) { janet_panics(ret); } -void janet_printf(const char *format, ...) { - va_list args; - JanetBuffer buffer; - int32_t len = 0; - while (format[len]) len++; - janet_buffer_init(&buffer, len); - va_start(args, format); - janet_formatb(&buffer, format, args); - va_end(args); - fwrite(buffer.data, buffer.count, 1, janet_dynfile("out", stdout)); - janet_buffer_deinit(&buffer); -} - void janet_panic(const char *message) { janet_panicv(janet_cstringv(message)); } diff --git a/src/core/debug.c b/src/core/debug.c index a14db7b7..cc5eafff 100644 --- a/src/core/debug.c +++ b/src/core/debug.c @@ -90,9 +90,6 @@ void janet_debug_find( if (best_def) { *def_out = best_def; *pc_out = besti; - if (best_def->name) { - janet_printf("name: %S\n", best_def->name); - } } else { janet_panic("could not find breakpoint"); } @@ -102,13 +99,12 @@ 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; int print_color = janet_truthy(janet_dyn("err-color")); - if (print_color) fprintf(out, "\x1b[31m"); + if (print_color) janet_eprintf("\x1b[31m"); while (fiber) { janet_v_push(fibers, fiber); @@ -127,47 +123,47 @@ 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(out, "%s%s: %s\n", - prefix, - janet_status_names[status], - errstr); + janet_eprintf("%s%s: %s\n", + prefix, + janet_status_names[status], + errstr); wrote_error = 1; } - fprintf(out, " in"); + janet_eprintf(" in"); if (frame->func) { def = frame->func->def; - fprintf(out, " %s", def->name ? (const char *)def->name : ""); + janet_eprintf(" %s", def->name ? (const char *)def->name : ""); if (def->source) { - fprintf(out, " [%s]", (const char *)def->source); + janet_eprintf(" [%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(out, " %s", (const char *)janet_to_string(name)); + janet_eprintf(" %s", (const char *)janet_to_string(name)); else - fprintf(out, " "); + janet_eprintf(" "); } } if (frame->flags & JANET_STACKFRAME_TAILCALL) - fprintf(out, " (tailcall)"); + janet_eprintf(" (tailcall)"); if (frame->func && frame->pc) { int32_t off = (int32_t)(frame->pc - def->bytecode); if (def->sourcemap) { JanetSourceMapping mapping = def->sourcemap[off]; - fprintf(out, " on line %d, column %d", mapping.line, mapping.column); + janet_eprintf(" on line %d, column %d", mapping.line, mapping.column); } else { - fprintf(out, " pc=%d", off); + janet_eprintf(" pc=%d", off); } } - fprintf(out, "\n"); + janet_eprintf("\n"); } } - if (print_color) fprintf(out, "\x1b[0m"); + if (print_color) janet_eprintf("\x1b[0m"); janet_v_free(fibers); } diff --git a/src/core/io.c b/src/core/io.c index 4e3cfb3e..c35bde39 100644 --- a/src/core/io.c +++ b/src/core/io.c @@ -384,8 +384,35 @@ FILE *janet_dynfile(const char *name, FILE *def) { return iofile->file; } -static Janet cfun_io_print(int32_t argc, Janet *argv) { - FILE *f = janet_dynfile("out", stdout); +static Janet cfun_io_print_impl(int32_t argc, Janet *argv, + int newline, const char *name, FILE *dflt_file) { + FILE *f; + Janet x = janet_dyn(name); + switch (janet_type(x)) { + default: + goto err; + case JANET_BUFFER: { + /* Special case buffer */ + JanetBuffer *buf = janet_unwrap_buffer(x); + for (int32_t i = 0; i < argc; ++i) { + const uint8_t *vstr = janet_to_string(argv[i]); + janet_buffer_push_string(buf, vstr); + } + if (newline) + janet_buffer_push_u8(buf, '\n'); + return janet_wrap_nil(); + } + case JANET_NIL: + f = dflt_file; + break; + case JANET_ABSTRACT: { + void *abstract = janet_unwrap_abstract(x); + if (janet_abstract_type(abstract) != &cfun_io_filetype) goto err; + IOFile *iofile = abstract; + f = iofile->file; + break; + } + } for (int32_t i = 0; i < argc; ++i) { int32_t j, len; const uint8_t *vstr = janet_to_string(argv[i]); @@ -394,8 +421,60 @@ static Janet cfun_io_print(int32_t argc, Janet *argv) { putc(vstr[j], f); } } - putc('\n', f); + if (newline) + putc('\n', f); return janet_wrap_nil(); +err: + janet_panicf("expected (dyn :%s) to be a file, buffer, or nil; got %v", name, x); +} + +static Janet cfun_io_print(int32_t argc, Janet *argv) { + return cfun_io_print_impl(argc, argv, 1, "out", stdout); +} + +static Janet cfun_io_prin(int32_t argc, Janet *argv) { + return cfun_io_print_impl(argc, argv, 0, "out", stdout); +} + +static Janet cfun_io_eprint(int32_t argc, Janet *argv) { + return cfun_io_print_impl(argc, argv, 1, "err", stderr); +} + +static Janet cfun_io_eprin(int32_t argc, Janet *argv) { + return cfun_io_print_impl(argc, argv, 0, "err", stderr); +} + +void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) { + va_list args; + va_start(args, format); + Janet x = janet_dyn(name); + JanetType xtype = janet_type(x); + switch (xtype) { + default: + case JANET_ABSTRACT: { + FILE *f = dflt_file; + JanetBuffer buffer; + int32_t len = 0; + while (format[len]) len++; + janet_buffer_init(&buffer, len); + janet_formatb(&buffer, format, args); + if (xtype == JANET_ABSTRACT) { + void *abstract = janet_unwrap_abstract(x); + if (janet_abstract_type(abstract) == &cfun_io_filetype) { + IOFile *iofile = abstract; + f = iofile->file; + } + } + fwrite(buffer.data, buffer.count, 1, f); + janet_buffer_deinit(&buffer); + break; + } + case JANET_BUFFER: + janet_formatb(janet_unwrap_buffer(x), format, args); + break; + } + va_end(args); + return; } static const JanetReg io_cfuns[] = { @@ -404,7 +483,24 @@ static const JanetReg io_cfuns[] = { JDOC("(print & xs)\n\n" "Print values to the console (standard out). Value are converted " "to strings if they are not already. After printing all values, a " - "newline character is printed. Returns nil.") + "newline character is printed. Use the value of (dyn :out stdout) to determine " + "what to push characters to. Expects (dyn :out stdout) to be either a core/file or " + "a buffer. Returns nil.") + }, + { + "prin", cfun_io_prin, + JDOC("(prin & xs)\n\n" + "Same as print, but does not add trailing newline.") + }, + { + "eprin", cfun_io_eprin, + JDOC("(eprin & xs)\n\n" + "Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).") + }, + { + "eprint", cfun_io_eprint, + JDOC("(eprint & xs)\n\n" + "Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).") }, { "file/open", cfun_io_fopen, diff --git a/src/core/run.c b/src/core/run.c index 94a199e8..6e09ede0 100644 --- a/src/core/run.c +++ b/src/core/run.c @@ -28,7 +28,6 @@ /* Run a string */ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) { JanetParser parser; - FILE *errf = janet_dynfile("err", stderr); int errflags = 0, done = 0; int32_t index = 0; Janet ret = janet_wrap_nil(); @@ -56,8 +55,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char done = 1; } } else { - fprintf(errf, "compile error in %s: %s\n", sourcePath, - (const char *)cres.error); + janet_eprintf("compile error in %s: %s\n", sourcePath, + (const char *)cres.error); errflags |= 0x02; done = 1; } @@ -70,8 +69,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char break; case JANET_PARSE_ERROR: errflags |= 0x04; - fprintf(errf, "parse error in %s: %s\n", - sourcePath, janet_parser_error(&parser)); + janet_eprintf("parse error in %s: %s\n", + sourcePath, janet_parser_error(&parser)); done = 1; break; case JANET_PARSE_PENDING: diff --git a/src/include/janet.h b/src/include/janet.h index ca84fb9b..08264941 100644 --- a/src/include/janet.h +++ b/src/include/janet.h @@ -1326,7 +1326,9 @@ JANET_NO_RETURN JANET_API void janet_panicv(Janet message); JANET_NO_RETURN JANET_API void janet_panic(const char *message); JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message); JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...); -JANET_API void janet_printf(const char *format, ...); +JANET_API void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...); +#define janet_printf(...) janet_dynprintf("out", stdout, __VA_ARGS__) +#define janet_eprintf(...) janet_dynprintf("err", stderr, __VA_ARGS__) JANET_NO_RETURN JANET_API void janet_panic_type(Janet x, int32_t n, int expected); JANET_NO_RETURN JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at); JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max); diff --git a/test/suite7.janet b/test/suite7.janet index 07b0d805..3f11cf07 100644 --- a/test/suite7.janet +++ b/test/suite7.janet @@ -170,4 +170,16 @@ (assert (idx= (take 10 (range 100)) (range 10)) "take 10") (assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10") +# Printing to buffers +(def out-buf @"") +(def err-buf @"") +(with-dyns [:out out-buf :err err-buf] + (print "Hello") + (prin "hi") + (eprint "Sup") + (eprin "not much.")) + +(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1") +(assert (= (string err-buf) "Sup\nnot much.") "eprint and eprin to buffer 1") + (end-suite)