mirror of
https://github.com/janet-lang/janet
synced 2024-12-25 07:50:27 +00:00
Address #214
This adds several common patterns, which are defined in boot.janet. This essentially gives more primitive patterns to work with out of the box. Fix build when JANET_REDUCED_OS is defined.
This commit is contained in:
parent
bc8ee207d5
commit
f1afc5b0b4
@ -1677,6 +1677,32 @@
|
||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
||||
|
||||
###
|
||||
###
|
||||
### Default PEG patterns
|
||||
###
|
||||
###
|
||||
|
||||
(def default-peg-grammar
|
||||
"The default grammar used for pegs. This grammar defines several common patterns
|
||||
that should make it easier to write more complex patterns."
|
||||
~@{:d (range "09")
|
||||
:a (range "az" "AZ")
|
||||
:s (set " \t\r\n\0\f")
|
||||
:w (range "az" "AZ" "09")
|
||||
:S (if-not :s 1)
|
||||
:W (if-not :w 1)
|
||||
:A (if-not :a 1)
|
||||
:D (if-not :d 1)
|
||||
:d+ (some :d)
|
||||
:a+ (some :a)
|
||||
:s+ (some :s)
|
||||
:w+ (some :w)
|
||||
:d* (any :d)
|
||||
:a* (any :a)
|
||||
:w* (any :w)
|
||||
:s* (any :s)})
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
|
@ -322,7 +322,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
|
||||
/* Check error */
|
||||
if (-1 == status) {
|
||||
janet_panic(strerror(errno));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
}
|
||||
|
||||
return janet_wrap_integer(status);
|
||||
@ -351,7 +351,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
/* Wait for child */
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panic(strerror(status));
|
||||
janet_panicf("%p: %s", argv[0], strerror(errno));
|
||||
} else {
|
||||
waitpid(pid, &status, 0);
|
||||
}
|
||||
@ -915,11 +915,6 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
@ -938,6 +933,11 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/environ", os_environ,
|
||||
JDOC("(os/environ)\n\n"
|
||||
"Get a copy of the os environment table.")
|
||||
},
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
|
@ -445,6 +445,7 @@ tail:
|
||||
|
||||
typedef struct {
|
||||
JanetTable *grammar;
|
||||
JanetTable *default_grammar;
|
||||
JanetTable *tags;
|
||||
Janet *constants;
|
||||
uint32_t *bytecode;
|
||||
@ -886,9 +887,14 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
int i = JANET_RECURSION_GUARD;
|
||||
JanetTable *grammar = old_grammar;
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
peg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(peg, JANET_NIL))
|
||||
peg_panic(b, "unknown rule");
|
||||
Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
|
||||
nextPeg = janet_table_get(b->default_grammar, peg);
|
||||
if (janet_checktype(nextPeg, JANET_NIL)) {
|
||||
peg_panic(b, "unknown rule");
|
||||
}
|
||||
}
|
||||
peg = nextPeg;
|
||||
b->form = peg;
|
||||
b->grammar = grammar;
|
||||
}
|
||||
@ -1187,11 +1193,13 @@ bad:
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
NULL,
|
||||
cfun_peg_getter,
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
@ -1220,6 +1228,7 @@ static Peg *make_peg(Builder *b) {
|
||||
static Peg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.default_grammar = janet_get_core_table("default-peg-grammar");
|
||||
builder.tags = janet_table(0);
|
||||
builder.constants = NULL;
|
||||
builder.bytecode = NULL;
|
||||
@ -1276,6 +1285,15 @@ static Janet cfun_peg_match(int32_t argc, Janet *argv) {
|
||||
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
|
||||
(void) a;
|
||||
if (janet_keyeq(key, "match")) {
|
||||
*out = janet_wrap_cfunction(cfun_peg_match);
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static const JanetReg peg_cfuns[] = {
|
||||
{
|
||||
"peg/compile", cfun_peg_compile,
|
||||
|
@ -27,6 +27,7 @@
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
|
@ -407,15 +407,6 @@ JanetThread *janet_getthread(const Janet *argv, int32_t n) {
|
||||
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
|
||||
}
|
||||
|
||||
static JanetTable *janet_get_core_table(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out);
|
||||
if (bt == JANET_BINDING_NONE) return NULL;
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
||||
/* Runs in new thread */
|
||||
static int thread_worker(JanetMailbox *mailbox) {
|
||||
JanetFiber *fiber = NULL;
|
||||
|
@ -448,3 +448,12 @@ int janet_checksize(Janet x) {
|
||||
return dval == (double)((size_t) dval) &&
|
||||
dval <= SIZE_MAX;
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
Janet out = janet_wrap_nil();
|
||||
JanetBindingType bt = janet_resolve(env, janet_csymbol(name), &out);
|
||||
if (bt == JANET_BINDING_NONE) return NULL;
|
||||
if (!janet_checktype(out, JANET_TABLE)) return NULL;
|
||||
return janet_unwrap_table(out);
|
||||
}
|
||||
|
@ -72,6 +72,7 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
|
@ -4,22 +4,23 @@
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
(var start-time 0)
|
||||
|
||||
(defn assert [x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
@ -32,10 +33,12 @@
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
(set suite-num x)
|
||||
(set start-time (os/clock))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(print "\n\nTest suite " suite-num " finished.")
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
(def delta (- (os/clock) start-time))
|
||||
(printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
Loading…
Reference in New Issue
Block a user