mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-24 23:40:27 +00:00
Code Issues 1 Releases Wiki Activity

Update peg to allow functions over captures. Update C API

Browse Source 
to make janet function calls easier and faster from C (still
needs an object pool for fibers, though). Fix bug in scan-number
and add many more peg tests.
This commit is contained in:
Calvin Rose 2019-01-12 17:31:15 -05:00
parent 83f4a11bf3
commit 798c88b4c8
10 changed files with 201 additions and 75 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/core/capi.c
View File

@ -118,6 +118,14 @@ int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const c
return raw;
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
if (raw < 0) raw += length;
if (raw < 0 || raw > length)
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
return raw;
}
JanetView janet_getindexed(const Janet *argv, int32_t n) {
Janet x = argv[n];
JanetView view;

2
src/core/compile.c
View File

@ -485,7 +485,7 @@ static int macroexpand1(
JanetFiber *fiberp;
JanetFunction *macro = janet_unwrap_function(macroval);
int lock = janet_gclock();
JanetSignal status = janet_call(
JanetSignal status = janet_pcall(
macro,
janet_tuple_length(form) - 1,
form + 1,

5
src/core/core.janet
View File

@ -1367,6 +1367,11 @@ value, one key will be ignored."
(set current (macex1 current)))
current)
(defn pp
"Pretty print to stdout."
[x]
(print (string/pretty x)))
###
###
### Evaluation and Compilation

2
src/core/corelib.c
View File

@ -152,7 +152,7 @@ static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
double number;
janet_fixarity(argc, 1);
JanetByteView view = janet_getbytes(argv, 1);
JanetByteView view = janet_getbytes(argv, 0);
if (janet_scan_number(view.bytes, view.len, &number))
return janet_wrap_nil();
return janet_wrap_number(number);

51
src/core/fiber.c
View File

@ -26,7 +26,17 @@
#include "gc.h"
#include "util.h"
static JanetFiber *make_fiber(int32_t capacity) {
static void fiber_reset(JanetFiber *fiber) {
fiber->maxstack = JANET_STACK_MAX;
fiber->frame = 0;
fiber->stackstart = JANET_FRAME_SIZE;
fiber->stacktop = JANET_FRAME_SIZE;
fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
}
static JanetFiber *fiber_alloc(int32_t capacity) {
Janet *data;
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
if (capacity < 32) {
@ -38,37 +48,30 @@ static JanetFiber *make_fiber(int32_t capacity) {
JANET_OUT_OF_MEMORY;
}
fiber->data = data;
fiber->maxstack = JANET_STACK_MAX;
fiber->frame = 0;
fiber->stackstart = JANET_FRAME_SIZE;
fiber->stacktop = JANET_FRAME_SIZE;
fiber->child = NULL;
fiber->flags = JANET_FIBER_MASK_YIELD;
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
return fiber;
}
/* Initialize a new fiber */
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
JanetFiber *fiber = make_fiber(capacity);
if (janet_fiber_funcframe(fiber, callee)) return NULL;
return fiber;
}
/* Clear a fiber (reset it) with argn values on the stack. */
JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn) {
/* Create a new fiber with argn values on the stack by reusing a fiber. */
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv) {
int32_t newstacktop;
JanetFiber *fiber = make_fiber(capacity);
newstacktop = fiber->stacktop + argn;
if (newstacktop >= fiber->capacity) {
janet_fiber_setcapacity(fiber, 2 * newstacktop);
fiber_reset(fiber);
if (argc) {
newstacktop = fiber->stacktop + argc;
if (newstacktop >= fiber->capacity) {
janet_fiber_setcapacity(fiber, 2 * newstacktop);
}
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
fiber->stacktop = newstacktop;
}
memcpy(fiber->data + fiber->stacktop, argv, argn * sizeof(Janet));
fiber->stacktop = newstacktop;
if (janet_fiber_funcframe(fiber, callee)) return NULL;
return fiber;
}
/* Create a new fiber with argn values on the stack. */
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv) {
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
}
/* Ensure that the fiber has enough extra capacity */
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
@ -302,7 +305,7 @@ static Janet cfun_new(int32_t argc, Janet *argv) {
janet_panic("expected nullary function in fiber constructor");
}
}
fiber = janet_fiber(func, 64);
fiber = janet_fiber(func, 64, 0, NULL);
if (argc == 2) {
int32_t i;
JanetByteView view = janet_getbytes(argv, 1);

112
src/core/peg.c
View File

@ -35,7 +35,6 @@
/* Hold captured patterns and match state */
typedef struct {
int32_t depth;
const uint8_t *text_start;
const uint8_t *text_end;
const uint8_t *subst_end;
@ -44,12 +43,14 @@ typedef struct {
JanetBuffer *scratch;
const Janet *extrav;
int32_t extrac;
int flags;
int32_t depth;
enum {
PEG_NORMAL,
PEG_SUBSTITUTE,
PEG_NOCAPTURE
} mode;
} State;
/* Check if we are inside a substitution capture */
#define PEG_SUBSTITUTE 1
/* Forward declaration */
static int32_t match(State *s, Janet peg, const uint8_t *text);
@ -202,13 +203,13 @@ static int32_t match_between(State *s, int32_t argc, const Janet *argv, const ui
*/
static void push_capture(State *s, Janet capture, const uint8_t *text, int32_t nbytes) {
if (s->flags & PEG_SUBSTITUTE) {
if (s->mode == PEG_SUBSTITUTE) {
/* Substitution mode, append as string to scratch buffer */
/* But first append in-between text */
janet_buffer_push_bytes(s->scratch, s->subst_end, text - s->subst_end);
janet_to_string_b(s->scratch, capture);
s->subst_end = text + nbytes;
} else {
} else if (s->mode == PEG_NORMAL) {
/* Normal mode, append to captures */
janet_array_push(s->captures, capture);
}
@ -217,7 +218,12 @@ static void push_capture(State *s, Janet capture, const uint8_t *text, int32_t n
/* Capture a value */
static int32_t match_capture(State *s, int32_t argc, const Janet *argv, const uint8_t *text) {
janet_fixarity(argc, 1);
int oldmode = s->mode;
/* We can't have overlapping captures during substitution, so we can
* turn off the child captures if subsituting */
if (s->mode == PEG_SUBSTITUTE) s->mode = PEG_NOCAPTURE;
int32_t result = match(s, argv[0], text);
s->mode = oldmode;
if (result < 0) return -1;
push_capture(s, janet_stringv(text, result), text, result);
return result;
@ -235,21 +241,24 @@ static int32_t match_position(State *s, int32_t argc, const Janet *argv, const u
static int32_t match_group(State *s, int32_t argc, const Janet *argv, const uint8_t *text) {
janet_fixarity(argc, 1);
int32_t old_count = s->captures->count;
int32_t old_flags = s->flags;
s->flags &= ~PEG_SUBSTITUTE; /* Turn off substitution mode */
int oldmode = s->mode;
if (oldmode != PEG_NOCAPTURE) s->mode = PEG_NORMAL;
int32_t result = match(s, argv[0], text);
s->flags = old_flags;
s->mode = oldmode;
if (result < 0) return -1;
/* Collect sub-captures into an array by popping new values off of the capture stack,
* and then putting them in a new array. Then, push the new array back onto the capture stack. */
int32_t num_sub_captures = s->captures->count - old_count;
JanetArray *sub_captures = janet_array(num_sub_captures);
memcpy(sub_captures->data, s->captures->data + old_count, sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
s->captures->count = old_count;
if (oldmode != PEG_NOCAPTURE) {
/* Collect sub-captures into an array by popping new values off of the capture stack,
* and then putting them in a new array. Then, push the new array back onto the capture stack. */
int32_t num_sub_captures = s->captures->count - old_count;
JanetArray *sub_captures = janet_array(num_sub_captures);
memcpy(sub_captures->data, s->captures->data + old_count, sizeof(Janet) * num_sub_captures);
sub_captures->count = num_sub_captures;
s->captures->count = old_count;
push_capture(s, janet_wrap_array(sub_captures), text, result);
}
push_capture(s, janet_wrap_array(sub_captures), text, result);
return result;
}
@ -263,7 +272,7 @@ static int32_t match_capture_constant(State *s, int32_t argc, const Janet *argv,
/* Capture nth extra argument to peg/match */
static int32_t match_capture_arg(State *s, int32_t argc, const Janet *argv, const uint8_t *text) {
janet_fixarity(argc, 1);
int32_t n = janet_gethalfrange(argv, 0, s->extrac, "n");
int32_t n = janet_getargindex(argv, 0, s->extrac, "n");
push_capture(s, s->extrav[n], text, 0);
return 0;
}
@ -271,8 +280,16 @@ static int32_t match_capture_arg(State *s, int32_t argc, const Janet *argv, cons
/* Capture replace */
static int32_t match_replace(State *s, int32_t argc, const Janet *argv, const uint8_t *text) {
janet_fixarity(argc, 2);
int oldmode = s->mode;
int32_t old_count = s->captures->count;
if (oldmode == PEG_SUBSTITUTE) s->mode = PEG_NORMAL;
int32_t result = match(s, argv[0], text);
s->mode = oldmode;
if (result < 0) return -1;
if (oldmode == PEG_NOCAPTURE) return result;
Janet capture;
switch (janet_type(argv[1])) {
default:
@ -284,8 +301,28 @@ static int32_t match_replace(State *s, int32_t argc, const Janet *argv, const ui
case JANET_TABLE:
capture = janet_table_get(janet_unwrap_table(argv[1]), janet_stringv(text, result));
break;
/* TODO - add functions, c functions, numbers */
case JANET_CFUNCTION:
{
janet_array_push(s->captures, janet_stringv(text, result));
JanetCFunction cfunc = janet_unwrap_cfunction(argv[1]);
capture = cfunc(s->captures->count - old_count, s->captures->data + old_count);
break;
}
case JANET_FUNCTION:
{
janet_array_push(s->captures, janet_stringv(text, result));
capture = janet_call(janet_unwrap_function(argv[1]),
s->captures->count - old_count, s->captures->data + old_count);
break;
}
case JANET_NUMBER:
{
int32_t index = janet_getargindex(argv, 1, s->captures->count, "capture");
capture = s->captures->data[index];
break;
}
}
s->captures->count = old_count;
push_capture(s, capture, text, result);
return result;
}
@ -294,26 +331,32 @@ static int32_t match_replace(State *s, int32_t argc, const Janet *argv, const ui
static int32_t match_substitute(State *s, int32_t argc, const Janet *argv, const uint8_t *text) {
janet_fixarity(argc, 1);
/* If we were originally in substitution mode, simply pass
* argv[0] right through */
if (s->flags & PEG_SUBSTITUTE)
return match(s, argv[0], text);
/* Save old scratch state */
int32_t old_count = s->scratch->count;
const uint8_t *old_subst_end = s->subst_end;
/* Set up scratch */
s->scratch->count = 0;
/* Prepare for collecting in scratch */
s->subst_end = text;
s->flags |= PEG_SUBSTITUTE;
int oldmode = s->mode;
if (oldmode != PEG_NOCAPTURE) s->mode = PEG_SUBSTITUTE;
int32_t result = match(s, argv[0], text);
s->flags &= ~PEG_SUBSTITUTE;
s->mode = oldmode;
if (result < 0) return -1;
/* Pop scratch to captures */
janet_buffer_push_bytes(s->scratch, s->subst_end, text - s->subst_end + result);
janet_array_push(s->captures, janet_stringv(s->scratch->data, s->scratch->count));
s->scratch->count = 0;
if (oldmode != PEG_NOCAPTURE) {
/* Push remaining text to scratch buffer */
janet_buffer_push_bytes(s->scratch, s->subst_end, text - s->subst_end + result);
/* Pop last section of scratch buffer and push a string capture */
janet_array_push(s->captures,
janet_stringv(s->scratch->data + old_count, s->scratch->count - old_count));
}
/* Reset scratch buffer and subst_end */
s->scratch->count = old_count;
s->subst_end = old_subst_end;
return result;
}
@ -391,7 +434,6 @@ static int32_t match(State *s, Janet peg, const uint8_t *text) {
int32_t old_capture_count = s->captures->count;
int32_t old_scratch_count = s->scratch->count;
const uint8_t *old_subst_end = s->subst_end;
int32_t result = mp->matcher(s, len - 1, items + 1, text);
/* Reset old state on failure */
@ -438,7 +480,7 @@ static Janet cfun_match(int32_t argc, Janet *argv) {
s.extrac = 0;
s.extrav = NULL;
}
s.flags = 0;
s.mode = PEG_NORMAL;
s.text_start = bytes.bytes;
s.text_end = bytes.bytes + bytes.len;
s.depth = JANET_RECURSION_GUARD;

2
src/core/run.c
View File

@ -99,7 +99,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
JanetFiber *fiber = janet_fiber(f, 64);
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);

42
src/core/vm.c
View File

@ -752,6 +752,24 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
VM_END()
}
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
janet_panic("C stack recursed too deeply");
JanetFiber *fiber = janet_fiber(fun, 64, argc, argv);
if (!fiber)
janet_panic("arity mismatch");
int handle = janet_gclock();
JanetFiber *old_fiber = janet_vm_fiber;
janet_vm_fiber = fiber;
memcpy(fiber->buf, janet_vm_fiber->buf, sizeof(jmp_buf));
run_vm(fiber, janet_wrap_nil(), JANET_STATUS_NEW);
janet_vm_fiber = old_fiber;
janet_gcunlock(handle);
return fiber->data[fiber->stacktop - 1];
}
/* Enter the main vm loop */
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
@ -782,11 +800,14 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
fiber->child = NULL;
}
/* Prepare state */
janet_vm_stackn++;
janet_gcroot(janet_wrap_fiber(fiber));
/* Save global state */
int32_t oldn = janet_vm_stackn++;
int handle = janet_vm_gc_suspend;
JanetFiber *old_vm_fiber = janet_vm_fiber;
/* Setup fiber */
janet_vm_fiber = fiber;
janet_gcroot(janet_wrap_fiber(fiber));
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
/* Run loop */
@ -797,25 +818,28 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
signal = run_vm(fiber, in, old_status);
}
/* Tear down */
/* Tear down fiber */
janet_fiber_set_status(fiber, signal);
janet_vm_fiber = old_vm_fiber;
janet_vm_stackn--;
janet_gcunroot(janet_wrap_fiber(fiber));
/* Restore global state */
janet_vm_gc_suspend = handle;
janet_vm_fiber = old_vm_fiber;
janet_vm_stackn = oldn;
/* Pop error or return value from fiber stack */
*out = fiber->data[--fiber->stacktop];
return signal;
}
JanetSignal janet_call(
JanetSignal janet_pcall(
JanetFunction *fun,
int32_t argn,
int32_t argc,
const Janet *argv,
Janet *out,
JanetFiber **f) {
JanetFiber *fiber = janet_fiber_n(fun, 64, argv, argn);
JanetFiber *fiber = janet_fiber(fun, 64, argc, argv);
if (f) *f = fiber;
if (!fiber) {
*out = janet_cstringv("arity mismatch");

8
src/include/janet/janet.h
View File

@ -1042,8 +1042,8 @@ JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other)
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity);
JANET_API JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn);
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
/* Treat similar types through uniform interfaces for iteration */
@ -1112,7 +1112,8 @@ JANET_API void janet_inspect(Janet x);
JANET_API int janet_init(void);
JANET_API void janet_deinit(void);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_call(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
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);
/* C Library helpers */
@ -1163,6 +1164,7 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
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);
/***** END SECTION MAIN *****/

44
test/suite3.janet
View File

@ -53,6 +53,12 @@
(assert (= var-b "hello") "regression 1")
# Scan number
(assert (= 1 (scan-number "1")) "scan-number 1")
(assert (= -1 (scan-number "-1")) "scan-number -1")
(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
# Some macros
(assert (= 2 (if-not 1 3 2)) "if-not 1")
@ -160,6 +166,11 @@
(def result (peg/match pat text))
(assert (= (not should-match) (not result)) text))
(defn check-deep
[pat text what]
(def result (peg/match pat text))
(assert (deep= result what) text))
# Just numbers
(check-match '(* 4 -1) "abcd" true)
@ -193,11 +204,42 @@
(assert (= (string/replace-all "dog" "purple panda" text) (0 (peg/match grammar text))) text))
(try-grammar "i have a dog called doug the dog. he is good.")
(try-grammar "i have a dog called doug the dog. he is good boy.")
(try-grammar "i have a dog called doug the dog. he is a good boy.")
(try-grammar "i have a dog called doug the do")
(try-grammar "i have a dog called doug the dog")
(try-grammar "i have a dog called doug the dogg")
(try-grammar "i have a dog called doug the doggg")
(try-grammar "i have a dog called doug the dogggg")
# Peg CSV test
(def csv
'{:field (+
(* `"` (<-s (at-least 0 (+ (- 1 `"`) (/ `""` `"`)))) `"`)
(<- (at-least 0 (- 1 (set ",\n")))))
:main (* :field (at-least 0 (* "," :field)) (+ "\n" -1))})
(defn check-csv
[str res]
(check-deep csv str res))
(check-csv "1,2,3" @["1" "2" "3"])
(check-csv "1,\"2\",3" @["1" "2" "3"])
(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
# Nested Captures
(def grmr '(<- (* (<- "a") (<- 1) (<- "c"))))
(check-deep grmr "abc" @["a" "b" "c" "abc"])
(check-deep grmr "acc" @["a" "c" "c" "acc"])
# Functions in grammar
(def grmr-triple ~(<-s (at-least 0 (/ 1 ,(fn [x] (string x x x))))))
(check-deep grmr-triple "abc" @["aaabbbccc"])
(check-deep grmr-triple "" @[""])
(check-deep grmr-triple " " @[" "])
(def counter ~(/ (<-g (at-least 0 (<- 1))) ,length))
(check-deep counter "abcdefg" @[7])
(end-suite)