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.

src/boot/boot.janet

@@ -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

src/core/os.c

@@ -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"

src/core/peg.c

@@ -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);
+        Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
-        if (!grammar || janet_checktype(peg, JANET_NIL))
+        if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
-            peg_panic(b, "unknown rule");
+            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,

src/core/pp.c

@@ -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

src/core/thread.c

@@ -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;

src/core/util.c

@@ -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);
+}

src/core/util.h

@@ -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,

test/helper.janet

@@ -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)
+  (++ num-tests-run)
- (when x (++ num-tests-passed))
+  (when x (++ num-tests-passed))
- (if x
+  (if x
-   (do
+    (do
-     (when (= numchecks 25)
+      (when (= numchecks 25)
-       (set numchecks 0)
+        (set numchecks 0)
-       (print))
+        (print))
-     (++ numchecks)
+      (++ numchecks)
-     (file/write stdout "\e[32m✔\e[0m"))
+      (file/write stdout "\e[32m✔\e[0m"))
-   (do
+    (do
-     (file/write stdout "\n\e[31m✘\e[0m  ")
+      (file/write stdout "\n\e[31m✘\e[0m  ")
-     (set numchecks 0)
+      (set numchecks 0)
-     (print e)))
+      (print e)))
- x)
+  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)
+  (set suite-num x)
- (print "\nRunning test suite " x " tests...\n  "))
+  (set start-time (os/clock))
+  (print "\nRunning test suite " x " tests...\n  "))
 
 (defn end-suite []
- (print "\n\nTest suite " suite-num " finished.")
+  (def delta (- (os/clock) start-time))
- (print num-tests-passed " of " num-tests-run " tests passed.\n")
+  (printf "\n\nTest suite %d finished in %.3f seconds" suite-num delta)
- (if (not= num-tests-passed num-tests-run) (os/exit 1)))
+  (print num-tests-passed " of " num-tests-run " tests passed.\n")
+  (if (not= num-tests-passed num-tests-run) (os/exit 1)))