Merge branch 'master' into compile-opt

.github/workflows/release.yml

@@ -17,7 +17,7 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        os: [ ubuntu-latest, macos-latest ]
+        os: [ ubuntu-latest, macos-13 ]
     steps:
       - name: Checkout the repository
         uses: actions/checkout@master
@@ -39,6 +39,35 @@ jobs:
             build/c/janet.c
             build/c/shell.c
 
+  release-arm:
+    permissions:
+      contents: write  # for softprops/action-gh-release to create GitHub release
+    name: Build release binaries
+    runs-on: ${{ matrix.os }}
+    strategy:
+      matrix:
+        os: [ macos-latest ]
+    steps:
+      - name: Checkout the repository
+        uses: actions/checkout@master
+      - name: Set the version
+        run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
+      - name: Set the platform
+        run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
+      - name: Compile the project
+        run: make clean && make
+      - name: Build the artifact
+        run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz
+      - name: Draft the release
+        uses: softprops/action-gh-release@v1
+        with:
+          draft: true
+          files: |
+            build/*.gz
+            build/janet.h
+            build/c/janet.c
+            build/c/shell.c
+
   release-windows:
     permissions:
       contents: write  # for softprops/action-gh-release to create GitHub release

.github/workflows/test.yml

@@ -12,7 +12,7 @@ jobs:
     runs-on: ${{ matrix.os }}
     strategy:
       matrix:
-        os: [ ubuntu-latest, macos-latest ]
+        os: [ ubuntu-latest, macos-latest, macos-13 ]
     steps:
       - name: Checkout the repository
         uses: actions/checkout@master
@@ -23,7 +23,10 @@ jobs:
 
   test-windows:
     name: Build and test on Windows
-    runs-on: windows-latest
+    strategy:
+      matrix:
+        os: [ windows-latest, windows-2019 ]
+    runs-on: ${{ matrix.os }}
     steps:
       - name: Checkout the repository
         uses: actions/checkout@master

CHANGELOG.md

@@ -1,6 +1,12 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## ??? - Unreleased
+- Change how JANET_PROFILE is loaded to allow more easily customizing the environment.
+- Add `*repl-prompt*` dynamic binding to allow customizing the built in repl.
+- Add multiple path support in the `JANET_PATH` environment variables. This lets
+  user more easily import modules from many directories.
+
 ## 1.36.0 - 2024-09-07
 - Improve error messages in `bundle/add*` functions.
 - Add CI testing and verify tests pass on the s390x architecture.

Makefile

@@ -1,4 +1,4 @@
-# Copyright (c) 2023 Calvin Rose
+# Copyright (c) 2024 Calvin Rose
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -43,6 +43,7 @@ JANET_DIST_DIR?=janet-dist
 JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
 JANET_TARGET_OBJECTS=build/janet.o build/shell.o
 JPM_TAG?=master
+SPORK_TAG?=master
 HAS_SHARED?=1
 DEBUGGER=gdb
 SONAME_SETTER=-Wl,-soname,
@@ -208,9 +209,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
 ########################
 
 ifeq ($(UNAME), Darwin)
-SONAME=libjanet.1.36.dylib
+SONAME=libjanet.1.37.dylib
 else
-SONAME=libjanet.so.1.36
+SONAME=libjanet.so.1.37
 endif
 
 build/c/shell.c: src/mainclient/shell.c
@@ -362,6 +363,12 @@ install-jpm-git: $(JANET_TARGET)
 		JANET_LIBPATH='$(LIBDIR)' \
 		$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
 
+install-spork-git: $(JANET_TARGET)
+	mkdir -p build
+	rm -rf build/spork
+	git clone --depth=1 --branch='$(SPORK_TAG)' https://github.com/janet-lang/spork.git build/spork
+	$(JANET_TARGET) -e '(bundle/install "build/spork")'
+
 uninstall:
 	-rm '$(DESTDIR)$(BINDIR)/janet'
 	-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'

janet.1

@@ -255,7 +255,8 @@ and then arguments to the script.
 .RS
 The location to look for Janet libraries. This is the only environment variable Janet needs to
 find native and source code modules. If no JANET_PATH is set, Janet will look in
-the default location set at compile time.
+the default location set at compile time. This should be a list of as well as a colon
+separate list of such directories.
 .RE
 
 .B JANET_PROFILE

meson.build

@@ -20,7 +20,7 @@
 
 project('janet', 'c',
   default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.36.0')
+  version : '1.37.0')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

src/boot/boot.janet

@@ -1863,6 +1863,9 @@
 (defdyn *pretty-format*
   "Format specifier for the `pp` function")
 
+(defdyn *repl-prompt*
+  "Allow setting a custom prompt at the default REPL. Not all REPLs will respect this binding.")
+
 (defn pp
   ``Pretty-print to stdout or `(dyn *out*)`. The format string used is `(dyn *pretty-format* "%q")`.``
   [x]
@@ -2837,6 +2840,24 @@
   (array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
   mp)
 
+# Don't expose this externally yet - could break if custom module/paths is setup.
+(defn- module/add-syspath
+  ```
+  Add a custom syspath to `module/paths` by duplicating all entries that being with `:sys:` and
+  adding duplicates with a specific path prefix instead.
+  ```
+  [path]
+  (def copies @[])
+  (var last-index 0)
+  (def mp (dyn *module-paths* module/paths))
+  (eachp [index entry] mp
+    (def pattern (first entry))
+    (when (and (string? pattern) (string/has-prefix? ":sys:/" pattern))
+      (set last-index index)
+      (array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)])))
+   (array/insert mp (+ 1 last-index) ;copies)
+   mp)
+
 (module/add-paths ":native:" :native)
 (module/add-paths "/init.janet" :source)
 (module/add-paths ".janet" :source)
@@ -4498,7 +4519,12 @@
   (var error-level nil)
   (var expect-image false)
 
-  (if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp))
+  (when-let [jp (getenv-alias "JANET_PATH")]
+    (def path-sep (if (index-of (os/which) [:windows :mingw]) ";" ":"))
+    (def paths (reverse! (string/split path-sep jp)))
+    (for i 1 (length paths)
+      (module/add-syspath (get paths i)))
+    (setdyn *syspath* (first paths)))
   (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
   (set colorize (and
                   (not (getenv-alias "NO_COLOR"))
@@ -4630,17 +4656,15 @@
         (if-not quiet
           (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
         (flush)
+        (def env (make-env))
         (defn getprompt [p]
+          (when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
           (def [line] (parser/where p))
           (string "repl:" line ":" (parser/state p :delimiters) "> "))
         (defn getstdin [prompt buf _]
           (file/write stdout prompt)
           (file/flush stdout)
           (file/read stdin :line buf))
-        (def env (make-env))
-        (when-let [profile.janet (dyn *profilepath*)]
-          (def new-env (dofile profile.janet :exit true))
-          (merge-module env new-env "" false))
         (when debug-flag
           (put env *debug* true)
           (put env *redef* true))
@@ -4652,6 +4676,8 @@
         (setdyn *doc-color* (if colorize true))
         (setdyn *lint-error* error-level)
         (setdyn *lint-warn* error-level)
+        (when-let [profile.janet (dyn *profilepath*)]
+          (dofile profile.janet :exit true :env env))
         (repl getchunk nil env)))))
 
 ###

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 36
+#define JANET_VERSION_MINOR 37
 #define JANET_VERSION_PATCH 0
-#define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.36.0"
+#define JANET_VERSION_EXTRA "-dev"
+#define JANET_VERSION "1.37.0-dev"
 
 /* #define JANET_BUILD "local" */
 

src/core/corelib.c

@@ -700,7 +700,15 @@ JANET_CORE_FN(janet_core_is_lengthable,
 
 JANET_CORE_FN(janet_core_signal,
               "(signal what x)",
-              "Raise a signal with payload x. ") {
+              "Raise a signal with payload x. `what` can be an integer\n"
+              "from 0 through 7 indicating user(0-7), or one of:\n\n"
+              "* :ok\n"
+              "* :error\n"
+              "* :debug\n"
+              "* :yield\n"
+              "* :user(0-7)\n"
+              "* :interrupt\n"
+              "* :await") {
     janet_arity(argc, 1, 2);
     Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
     if (janet_checkint(argv[0])) {

src/core/filewatch.c

@@ -588,6 +588,7 @@ JANET_CORE_FN(cfun_filewatch_make,
         "* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
         "* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
         "") {
+    janet_sandbox_assert(JANET_SANDBOX_FS_READ);
     janet_arity(argc, 1, -1);
     JanetChannel *channel = janet_getchannel(argv, 0);
     JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));

src/core/peg.c

@@ -465,6 +465,16 @@ tail:
             return result;
         }
 
+        case RULE_ONLY_TAGS: {
+            CapState cs = cap_save(s);
+            down1(s);
+            const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
+            up1(s);
+            if (!result) return NULL;
+            cap_load_keept(s, cs);
+            return result;
+        }
+
         case RULE_GROUP: {
             uint32_t tag = rule[2];
             int oldmode = s->mode;
@@ -486,6 +496,30 @@ tail:
             return result;
         }
 
+        case RULE_NTH: {
+            uint32_t nth = rule[1];
+            if (nth > INT32_MAX) nth = INT32_MAX;
+            uint32_t tag = rule[3];
+            int oldmode = s->mode;
+            CapState cs = cap_save(s);
+            s->mode = PEG_MODE_NORMAL;
+            down1(s);
+            const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
+            up1(s);
+            s->mode = oldmode;
+            if (!result) return NULL;
+            int32_t num_sub_captures = s->captures->count - cs.cap;
+            Janet cap;
+            if (num_sub_captures > (int32_t) nth) {
+                cap = s->captures->data[cs.cap + nth];
+            } else {
+                return NULL;
+            }
+            cap_load_keept(s, cs);
+            pushcap(s, cap, tag);
+            return result;
+        }
+
         case RULE_SUB: {
             const uint8_t *text_start = text;
             const uint32_t *rule_window = s->bytecode + rule[1];
@@ -1061,6 +1095,9 @@ static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
 static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
     spec_onerule(b, argc, argv, RULE_DROP);
 }
+static void spec_only_tags(Builder *b, int32_t argc, const Janet *argv) {
+    spec_onerule(b, argc, argv, RULE_ONLY_TAGS);
+}
 
 /* Rule of the form [rule, tag] */
 static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -1084,6 +1121,15 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
     spec_cap1(b, argc, argv, RULE_UNREF);
 }
 
+static void spec_nth(Builder *b, int32_t argc, const Janet *argv) {
+    peg_arity(b, argc, 2, 3);
+    Reserve r = reserve(b, 4);
+    uint32_t nth = peg_getnat(b, argv[0]);
+    uint32_t rule = peg_compile1(b, argv[1]);
+    uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
+    emit_3(r, RULE_NTH, nth, rule, tag);
+}
+
 static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
     peg_arity(b, argc, 1, 3);
     Reserve r = reserve(b, 4);
@@ -1262,7 +1308,9 @@ static const SpecialPair peg_specials[] = {
     {"line", spec_line},
     {"look", spec_look},
     {"not", spec_not},
+    {"nth", spec_nth},
     {"number", spec_capture_number},
+    {"only-tags", spec_only_tags},
     {"opt", spec_opt},
     {"position", spec_position},
     {"quote", spec_capture},
@@ -1619,6 +1667,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
                 break;
             case RULE_ERROR:
             case RULE_DROP:
+            case RULE_ONLY_TAGS:
             case RULE_NOT:
             case RULE_TO:
             case RULE_THRU:
@@ -1632,6 +1681,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
                 if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
                 i += 3;
                 break;
+            case RULE_NTH:
+                /* [nth, rule, tag] */
+                if (rule[2] >= blen) goto bad;
+                op_flags[rule[2]] |= 0x01;
+                i += 4;
+                break;
             default:
                 goto bad;
         }

src/core/util.c

@@ -79,6 +79,7 @@ const char *const janet_type_names[16] = {
     "pointer"
 };
 
+/* Docstring for signal lists these */
 const char *const janet_signal_names[14] = {
     "ok",
     "error",
@@ -96,6 +97,7 @@ const char *const janet_signal_names[14] = {
     "await"
 };
 
+/* Docstring for fiber/status lists these */
 const char *const janet_status_names[16] = {
     "dead",
     "error",

src/include/janet.h

@@ -2181,7 +2181,9 @@ typedef enum {
     RULE_UNREF,        /* [rule, tag] */
     RULE_CAPTURE_NUM,  /* [rule, tag] */
     RULE_SUB,          /* [rule, rule] */
-    RULE_SPLIT         /* [rule, rule] */
+    RULE_SPLIT,        /* [rule, rule] */
+    RULE_NTH,          /* [nth, rule, tag] */
+    RULE_ONLY_TAGS,    /* [rule] */
 } JanetPegOpcod;
 
 typedef struct {

test/suite-peg.janet

@@ -664,6 +664,8 @@
   @[]) "peg if not")
 
 (defn test [name peg input expected]
+  (assert-no-error "compile peg" (peg/compile peg))
+  (assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal))
   (assert (deep= (peg/match peg input) expected) name))
 
 (test "sub: matches the same input twice"
@@ -756,5 +758,19 @@
   "a,b,c"
   @["a" "b" "c"])
 
+(test "nth 1"
+  ~{:prefix (number :d+ nil :n)
+    :word '(lenprefix (-> :n) :w)
+    :main (some (nth 1 (* :prefix ":" :word)))}
+  "5:apple6:banana6:cherry"
+  @["apple" "banana" "cherry"])
+
+(test "only-tags 1"
+  ~{:prefix (number :d+ nil :n)
+    :word (capture (lenprefix (-> :n) :w) :W)
+    :main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
+  "5:apple6:banana6:cherry"
+  @["apple" "banana" "cherry"])
+
 (end-suite)