mirror of
https://github.com/janet-lang/janet
synced 2024-11-24 17:27:18 +00:00
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
parent
85a211b26b
commit
c76f4e89d8
@ -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."
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -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');
|
||||
|
||||
@ -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 {
|
||||
|
||||
Loading…
Reference in New Issue
Block a user