1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 19:19:53 +00:00

Add flush and eflush (#278)

These functions interact with Janet's dynamically scoped
IO functions in a manner that is more useful the file/flush.
We can still redirect to a buffer without changing our code.
This commit is contained in:
Calvin Rose 2020-02-03 18:14:32 -06:00
parent 64e1961193
commit 3fdc053d6c
2 changed files with 54 additions and 5 deletions

View File

@ -1252,7 +1252,8 @@
(defn pp (defn pp
"Pretty print to stdout or (dyn :out)." "Pretty print to stdout or (dyn :out)."
[x] [x]
(print (buffer/format @"" (dyn :pretty-format "%q") x))) (printf (dyn :pretty-format "%q") x)
(flush))
### ###
### ###
@ -1775,7 +1776,8 @@
(string col) (string col)
": " ": "
(parser/error p) (parser/error p)
(if ec "\e[0m" ""))) (if ec "\e[0m" ""))
(eflush))
(defn bad-compile (defn bad-compile
"Default handler for a compile error." "Default handler for a compile error."
@ -1789,7 +1791,8 @@
msg msg
" while compiling " " while compiling "
where where
(if ec "\e[0m" "")))) (if ec "\e[0m" "")))
(eflush))
(defn run-context (defn run-context
"Run a context. This evaluates expressions of janet in an environment, "Run a context. This evaluates expressions of janet in an environment,
@ -2086,7 +2089,7 @@
:on-status (fn [f x] :on-status (fn [f x]
(when (not= (fiber/status f) :dead) (when (not= (fiber/status f) :dead)
(debug/stacktrace f x) (debug/stacktrace f x)
(if exit-on-error (os/exit 1)))) (if exit-on-error (os/exit 1) (eflush))))
:evaluator evaluator :evaluator evaluator
:expander expander :expander expander
:source (if path-is-file "<anonymous>" spath)})) :source (if path-is-file "<anonymous>" spath)}))
@ -2189,14 +2192,17 @@
(put nextenv :debug-level level) (put nextenv :debug-level level)
(put nextenv :signal x) (put nextenv :signal x)
(debug/stacktrace f x) (debug/stacktrace f x)
(eflush)
(defn debugger-chunks [buf p] (defn debugger-chunks [buf p]
(def status (parser/state p :delimiters)) (def status (parser/state p :delimiters))
(def c ((parser/where p) 0)) (def c ((parser/where p) 0))
(def prompt (string "debug[" level "]:" c ":" status "> ")) (def prompt (string "debug[" level "]:" c ":" status "> "))
(getline prompt buf nextenv)) (getline prompt buf nextenv))
(print "entering debug[" level "] - (quit) to exit") (print "entering debug[" level "] - (quit) to exit")
(flush)
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv) (repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
(print "exiting debug[" level "]") (print "exiting debug[" level "]")
(flush)
(nextenv :resume-value)) (nextenv :resume-value))
(fn [f x] (fn [f x]
@ -2204,7 +2210,7 @@
(do (pp x) (put e '_ @{:value x})) (do (pp x) (put e '_ @{:value x}))
(if (e :debug) (if (e :debug)
(enter-debugger f x) (enter-debugger f x)
(do (debug/stacktrace f x) nil))))) (do (debug/stacktrace f x) (eflush))))))
(run-context {:env env (run-context {:env env
:chunks chunks :chunks chunks
@ -2320,6 +2326,7 @@
(when (and (not *compile-only*) (or *should-repl* *no-file*)) (when (and (not *compile-only*) (or *should-repl* *no-file*))
(if-not *quiet* (if-not *quiet*
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose")) (print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
(flush)
(defn noprompt [_] "") (defn noprompt [_] "")
(defn getprompt [p] (defn getprompt [p]
(def [line] (parser/where p)) (def [line] (parser/where p))

View File

@ -460,6 +460,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr); return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
} }
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
fflush(dflt_file);
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype) break;
IOFile *iofile = abstract;
fflush(iofile->file);
break;
}
}
}
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("out", stdout);
return janet_wrap_nil();
}
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("err", stderr);
return janet_wrap_nil();
}
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) { void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
va_list args; va_list args;
va_start(args, format); va_start(args, format);
@ -541,6 +573,16 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n" JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.") "Like eprintf but with no trailing newline.")
}, },
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
},
{
"eflush", cfun_io_eflush,
JDOC("(eflush)\n\n"
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
},
{ {
"file/temp", cfun_io_temp, "file/temp", cfun_io_temp,
JDOC("(file/temp)\n\n" JDOC("(file/temp)\n\n"