Remove redundancies in stacktraces.

There was an implementation for stacktraces in both
run.c and in core.janet, status-pp. The commit removes
the one in core.janet in favor of the C based stacktrace, which
is exposed via debug/stacktrace. Lots of reshuffling of run-context
ensued as well, which resulted in an api that is a bit cleaner.
This commit is contained in:
Calvin Rose 2019-01-30 23:07:30 -05:00
parent 85a211b26b
commit c76f4e89d8
4 changed files with 166 additions and 151 deletions

View File

@ -1385,17 +1385,51 @@ value, one key will be ignored."
(def newenv (table/setproto @{} parent))
newenv)
(defn bad-parse
"Default handler for a parse error."
[p where]
(file/write stderr
"parse error in "
where
" around byte "
(string (parser/where p))
(or (parser/error p) "unmatched delimiter")))
(defn bad-compile
"Default handler for a compile error."
[msg macrof where]
(file/write stderr msg " while compiling " where "\n")
(when macrof (debug/stacktrace macrof)))
(defn getline
"Read a line from stdin into a buffer."
[buf p]
(file/read stdin :line buf))
(defn run-context
"Run a context. This evaluates expressions of janet in an environment,
and is encapsulates the parsing, compilation, and evaluation of janet.
env is the environment to evaluate the code in, chunks is a function
that returns strings or buffers of source code (from a repl, file,
network connection, etc. onstatus is a callback that is
invoked when a result is returned or any other signal is raised.
and is encapsulates the parsing, compilation, and evaluation.
opts is a table or struct of options. The options are as follows:\n\n\t
:chunks - callback to read into a buffer - default is getline\n\t
:on-parse-error - callback when parsing fails - default is bad-parse\n\t
:env - the environment to compile against - default is *env*\n\t
:source - string path of source for better errors - default is \"<anonymous>\"\n\t
:on-compile-error - callback when compilation fails - default is bad-compile\n\t
:on-status - callback when a value is evaluated - default is debug/stacktrace"
[opts]
This function can be used to implement a repl very easily, simply
pass a function that reads line from stdin to chunks, status-pp to onstatus"
[env chunks onstatus where &]
(def {:env env
:chunks chunks
:on-status onstatus
:on-compile-error on-compile-error
:on-parse-error on-parse-error
:source where} opts)
(default env *env*)
(default chunks getline)
(default onstatus debug/stacktrace)
(default on-compile-error bad-compile)
(default on-parse-error bad-parse)
(default where "<anonymous>")
# Are we done yet?
(var going true)
@ -1415,17 +1449,14 @@ value, one key will be ignored."
(do
(set good false)
(def {:error err :start start :end end :fiber errf} res)
(onstatus
:compile
(def msg
(if (<= 0 start)
(string err "\n at (" start ":" end ")")
err)
errf
where))))
(string "compile error: " err " at (" start ":" end ")")
err))
(on-compile-error msg errf where))))
:a))
(def res (resume f nil))
(when good
(if going (onstatus (fiber/status f) res f where))))
(when good (if going (onstatus f res))))
(def oldenv *env*)
(set *env* env)
@ -1444,73 +1475,19 @@ value, one key will be ignored."
(while (parser/has-more p)
(eval1 (parser/produce p)))
(when (= (parser/status p) :error)
(onstatus :parse
(string (parser/error p)
" around byte " (parser/where p))
nil
where))))
(on-parse-error p where))))
(if (= (parser/status p) :pending)
(onstatus :parse
(string "unmatched delimiters " (parser/state p))
nil
where))
(on-parse-error p where))
(set *env* oldenv)
env)
(defn status-pp
"Pretty print a signal and associated state. Can be used as the
onsignal argument to run-context."
[sig x f source]
(def title
(case sig
:parse "parse error"
:compile "compile error"
:error "error"
(string "status " sig)))
(file/write stderr
(string title " in " source ": ")
(if (bytes? x) x (string/pretty x))
"\n")
(when f
(loop
[nf :in (reverse (debug/lineage f))
{:function func
:tail tail
:pc pc
:c c
:name name
:source source
:source-start start
:source-end end} :in (debug/stack nf)]
(file/write stderr " in")
(when c (file/write stderr " cfunction"))
(if name
(file/write stderr " " name)
(when func (file/write stderr " <anonymous>")))
(if source
(do
(file/write stderr " [" source "]")
(if start
(file/write
stderr
" at ("
(string start)
":"
(string end)
")"))))
(if (and (not start) pc)
(file/write stderr " (pc=" (string pc) ")"))
(when tail (file/write stderr " (tailcall)"))
(file/write stderr "\n"))))
(defn eval-string
"Evaluates a string in the current environment. If more control over the
environment is needed, use run-context."
[str env &]
(default env *env*)
(var state (string str))
(defn chunks [buf _]
(def ret state)
@ -1519,12 +1496,15 @@ value, one key will be ignored."
(buffer/push-string buf str)
(buffer/push-string buf "\n")))
(var returnval nil)
(run-context env chunks
(fn [sig x f source]
(if (= sig :dead)
(set returnval x)
(status-pp sig x f source)))
"eval")
(run-context {:env env
:chunks chunks
:on-compile-error error
:on-parse-error error
:on-status (fn [f val]
(set returnval val)
(if-not (= (fiber/status f) :dead)
(debug/stacktrace f val)))
:source "eval"})
returnval)
(defn eval
@ -1612,15 +1592,17 @@ value, one key will be ignored."
(def newenv (make-env))
(put module/loading modpath true)
(defn chunks [buf _] (file/read f 2048 buf))
(run-context newenv chunks
(fn [sig x f source]
(when (not= sig :dead)
(status-pp sig x f source)
(if exit-on-error (os/exit 1))))
modpath)
(run-context {:env newenv
:chunks chunks
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(debug/stacktrace f x)
(if exit-on-error (os/exit 1))))
:source modpath})
(file/close f)
(put module/loading modpath false)
(put module/cache modpath newenv)
(put module/cache path newenv)
newenv)
(do
# Try native module
@ -1629,6 +1611,7 @@ value, one key will be ignored."
(error (string "could not open file for module " path)))
(def e (make-env))
(native n e)
(put module/cache n e)
(put module/cache path e)
e))))
@ -1667,14 +1650,16 @@ value, one key will be ignored."
caught."
[chunks onsignal &]
(def newenv (make-env))
(default chunks (fn [buf _] (file/read stdin :line buf)))
(default onsignal (fn [sig x f source]
(case sig
(default onsignal (fn [f x]
(case (fiber/status f)
:dead (do
(put newenv '_ @{:value x})
(print (string/pretty x 20)))
(status-pp sig x f source))))
(run-context newenv chunks onsignal "repl"))
(debug/stacktrace f x))))
(run-context {:env newenv
:chunks chunks
:on-status onsignal
:source "repl"}))
(defmacro meta
"Add metadata to the current environment."

View File

@ -25,6 +25,7 @@
#include "gc.h"
#include "state.h"
#include "util.h"
#include "vector.h"
#endif
/* Implements functionality to build a debugger from within janet.
@ -90,6 +91,74 @@ void janet_debug_find(
}
}
/* Error reporting. This can be emulated from within Janet, but for
* consitency with the top level code it is defined once. */
void janet_stacktrace(JanetFiber *fiber, Janet err) {
int32_t fi;
const char *errstr = (const char *)janet_to_string(err);
JanetFiber **fibers = NULL;
int wrote_error = 0;
while (fiber) {
janet_v_push(fibers, fiber);
fiber = fiber->child;
}
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
fiber = fibers[fi];
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL;
i = frame->prevframe;
/* Print prelude to stack frame */
if (!wrote_error) {
JanetFiberStatus status = janet_fiber_status(fiber);
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
fprintf(stderr, "%s%s: %s\n",
prefix,
janet_status_names[status],
errstr);
wrote_error = 1;
}
fprintf(stderr, " in");
if (frame->func) {
def = frame->func->def;
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
if (def->source) {
fprintf(stderr, " [%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));
else
fprintf(stderr, " <cfunction>");
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
fprintf(stderr, " (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);
} else {
fprintf(stderr, " pc=%d", off);
}
}
fprintf(stderr, "\n");
}
}
janet_v_free(fibers);
}
/*
* CFuns
*/
@ -218,6 +287,13 @@ static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
return janet_wrap_array(array);
}
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
janet_stacktrace(fiber, argv[1]);
return argv[0];
}
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
@ -280,6 +356,13 @@ static const JanetReg debug_cfuns[] = {
"\t:slots - array of all values in each slot\n"
"\t:tail - boolean indicating a tail call")
},
{
"debug/stacktrace", cfun_debug_stacktrace,
JDOC("(debug/stacktrace fiber err)\n\n"
"Prints a nice looking stacktrace for a fiber. The error message "
"err must be passed to the function as fiber's do not keep track of "
"the last error they have thrown. Returns the fiber.")
},
{
"debug/lineage", cfun_debug_lineage,
JDOC("(debug/lineage fib)\n\n"

View File

@ -23,63 +23,8 @@
#ifndef JANET_AMALG
#include <janet/janet.h>
#include "state.h"
#include "vector.h"
#endif
/* Error reporting */
void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err) {
int32_t fi;
const char *errstr = (const char *)janet_to_string(err);
JanetFiber **fibers = NULL;
fprintf(stderr, "%s error: %s\n", errtype, errstr);
while (fiber) {
janet_v_push(fibers, fiber);
fiber = fiber->child;
}
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
fiber = fibers[fi];
int32_t i = fiber->frame;
while (i > 0) {
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
JanetFuncDef *def = NULL;
i = frame->prevframe;
fprintf(stderr, " in");
if (frame->func) {
def = frame->func->def;
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
if (def->source) {
fprintf(stderr, " [%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));
else
fprintf(stderr, " <cfunction>");
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
fprintf(stderr, " (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);
} else {
fprintf(stderr, " pc=%d", off);
}
}
fprintf(stderr, "\n");
}
}
janet_v_free(fibers);
}
/* Run a string */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser parser;
@ -90,6 +35,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
Janet ret = janet_wrap_nil();
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
if (where) janet_gcroot(janet_wrap_string(where));
if (NULL == sourcePath) sourcePath = "<unknown>";
janet_parser_init(&parser);
while (!errflags && !done) {
@ -103,13 +49,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
if (status != JANET_SIGNAL_OK) {
janet_stacktrace(fiber, "runtime", ret);
janet_stacktrace(fiber, ret);
errflags |= 0x01;
}
} else {
fprintf(stderr, "source path: %s\n", sourcePath);
janet_stacktrace(cres.macrofiber, "compile",
janet_wrap_string(cres.error));
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
errflags |= 0x02;
}
}
@ -118,13 +63,15 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
switch (janet_parser_status(&parser)) {
case JANET_PARSE_ERROR:
errflags |= 0x04;
fprintf(stderr, "parse error: %s\n", janet_parser_error(&parser));
fprintf(stderr, "parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
break;
case JANET_PARSE_PENDING:
if (index >= len) {
if (dudeol) {
errflags |= 0x04;
fprintf(stderr, "internal parse error: unexpected end of source\n");
fprintf(stderr, "internal parse error in %s: unexpected end of source\n",
sourcePath);
} else {
dudeol = 1;
janet_parser_consume(&parser, '\n');

View File

@ -1114,7 +1114,7 @@ JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
JANET_API void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err);
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
/* C Library helpers */
typedef enum {