Update CHANGELOG.md

meson.build: fix static build

.builds/linux.yml

@@ -4,12 +4,20 @@ sources:
 packages:
 - meson
 tasks:
-- build: |
+- with-epoll: |
     cd janet
-    meson setup build --buildtype=release
-    cd build
+    meson setup with-epoll --buildtype=release
+    cd with-epoll
+    meson configure -Depoll=true
+    ninja
+    ninja test
+- no-epoll: |
+    cd janet
+    meson setup no-epoll --buildtype=release
+    cd no-epoll
     meson configure -Depoll=false
     ninja
     ninja test
     sudo ninja install
     sudo jpm --verbose install circlet
+    sudo jpm --verbose install spork

.gitignore

@@ -140,3 +140,6 @@ compile_commands.json
 CTestTestfile.cmake
 
 # End of https://www.gitignore.io/api/cmake
+
+# Astyle
+*.orig

CHANGELOG.md

@@ -1,6 +1,33 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## Unreleased - ???
+- Increase default nesting depth of pretty printing to `JANET_RECURSION_GUARD`
+- Update meson.build
+- Add option to automatically add shebang line in installed scripts with `jpm`.
+- Add `partition-by` and `group-by` to the core.
+- Sort keys in pretty printing output.
+
+## 1.15.3 - 2021-02-28
+- Fix a fiber bug that occured in deeply nested fibers
+- Add `unref` combinator to pegs.
+- Small docstring changes.
+
+## 1.15.2 - 2021-02-15
+- Fix bug in windows version of `os/spawn` and `os/execute` with setting environment variables.
+- Fix documentation typos.
+- Fix peg integer reading combinators when used with capture tags.
+
+## 1.15.0 - 2021-02-08
+- Fix `gtim` and `ltim` bytecode instructions on non-integer values.
+- Clean up output of flychecking to be the same as the repl.
+- Change behavior of `debug/stacktrace` with a nil error value.
+- Add optional argument to `parser/produce`.
+- Add `no-core` option to creating standalone binaries to make execution faster.
+- Fix bug where a buffer overflow could be confused with an out of memory error.
+- Change error output to `file:line:column: message`. Column is in bytes - tabs
+  are considered to have width 1 (instead of 8).
+
 ## 1.14.2 - 2021-01-23
 - Allow `JANET_PROFILE` env variable to load a profile before loading the repl.
 - Update `tracev` macro to allow `def` and `var` inside to work as expected.

Makefile

@@ -27,7 +27,7 @@ PREFIX?=/usr/local
 INCLUDEDIR?=$(PREFIX)/include
 BINDIR?=$(PREFIX)/bin
 LIBDIR?=$(PREFIX)/lib
-JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 2> /dev/null || echo local)\""
+JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 2> /dev/null || echo local)\""
 CLIBS=-lm -lpthread
 JANET_TARGET=build/janet
 JANET_LIBRARY=build/libjanet.so
@@ -66,7 +66,7 @@ ifeq ($(UNAME), Haiku)
 	LDFLAGS=-Wl,--export-dynamic
 endif
 
-$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
+$(shell mkdir -p build/core build/c build/boot)
 all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
 
 ######################
@@ -149,7 +149,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
 	$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
 
 # Now the reason we bootstrap in the first place
-build/janet.c: build/janet_boot src/boot/boot.janet
+build/c/janet.c: build/janet_boot src/boot/boot.janet
 	build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
 	cksum $@
 
@@ -157,9 +157,9 @@ build/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.14
+SONAME=libjanet.so.1.15
 
-build/shell.c: src/mainclient/shell.c
+build/c/shell.c: src/mainclient/shell.c
 	cp $< $@
 
 build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
@@ -168,11 +168,11 @@ build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
 build/janetconf.h: src/conf/janetconf.h
 	cp $< $@
 
-build/janet.o: build/janet.c src/include/janet.h src/conf/janetconf.h
-	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
+build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
+	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
 
-build/shell.o: build/shell.c src/include/janet.h src/conf/janetconf.h
-	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
+build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
+	$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
 
 $(JANET_TARGET): build/janet.o build/shell.o
 	$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
@@ -224,7 +224,7 @@ dist: build/janet-dist.tar.gz
 build/janet-%.tar.gz: $(JANET_TARGET) \
 	build/janet.h \
 	jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
-	build/doc.html README.md build/janet.c build/shell.c jpm
+	build/doc.html README.md build/c/janet.c build/c/shell.c jpm
 	$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
 	mkdir -p build/$(JANET_DIST_DIR)
 	cp -r $^ build/$(JANET_DIST_DIR)/

README.md

@@ -58,9 +58,9 @@ Documentation is also available locally in the REPL.
 Use the `(doc symbol-name)` macro to get API
 documentation for symbols in the core library. For example,
 ```
-(doc doc)
+(doc apply)
 ```
-Shows documentation for the doc macro.
+Shows documentation for the `apply` function.
 
 To get a list of all bindings in the default
 environment, use the `(all-bindings)` function. You

build_win.bat

@@ -30,7 +30,7 @@ if not "%JANET_BUILD%" == "" (
 
 if not exist build mkdir build
 if not exist build\core mkdir build\core
-if not exist build\mainclient mkdir build\mainclient
+if not exist build\c mkdir build\c
 if not exist build\boot mkdir build\boot
 
 @rem Build the bootstrap interpreter
@@ -44,10 +44,10 @@ for %%f in (src\boot\*.c) do (
 )
 %JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
 @if errorlevel 1 goto :BUILDFAIL
-build\janet_boot . > build\janet.c
+build\janet_boot . > build\c\janet.c
 
 @rem Build the sources
-%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
+%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
 @if errorlevel 1 goto :BUILDFAIL
 %JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
 @if errorlevel 1 goto :BUILDFAIL
@@ -102,9 +102,9 @@ exit /b 0
 mkdir dist
 janet.exe tools\gendoc.janet > dist\doc.html
 janet.exe tools\removecr.janet dist\doc.html
-janet.exe tools\removecr.janet build\janet.c
+janet.exe tools\removecr.janet build\c\janet.c
 
-copy build\janet.c dist\janet.c
+copy build\c\janet.c dist\janet.c
 copy src\mainclient\shell.c dist\shell.c
 copy janet.exe dist\janet.exe
 copy LICENSE dist\LICENSE

jpm

@@ -23,12 +23,12 @@
 
 # Overriden on some installs.
 # To configure this script, replace the code between
-# the START and END comments and define a function 
+# the START and END comments and define a function
 # (install-paths) that gives the the default paths
 # to use. Trailing directory separator not expected.
 #
 # Example.
-# 
+#
 #   (defn- install-paths []
 #     {:headerpath "/usr/local/include/janet"
 #      :libpath "/usr/local/lib/janet"
@@ -44,7 +44,7 @@
 
 (defn- try-real [path]
   "If os/realpath fails just use normal path."
-  (try (os/realpath) ([_] path)))
+  (try (os/realpath path) ([_] path)))
 
 (defn- install-paths []
   {:headerpath (try-real (string exe-dir "/../include/janet"))
@@ -169,9 +169,7 @@
   [& args]
   (if (dyn :verbose)
     (print ;(interpose " " args)))
-  (def res (os/execute args :p))
-  (unless (zero? res)
-    (error (string "command exited with status " res))))
+  (os/execute args :px))
 
 (defn copy
   "Copy a file or directory recursively from one location to another."
@@ -602,7 +600,7 @@
   (string (string/slice path 0 (- -1 (length modext))) statext))
 
 (defn- make-bin-source
-  [declarations lookup-into-invocations]
+  [declarations lookup-into-invocations no-core]
   (string
     declarations
     ```
@@ -627,15 +625,22 @@ int main(int argc, const char **argv) {
 
     janet_init();
 
+    ```
+    (if no-core
+    ```
+    /* Get core env */
+    JanetTable *env = janet_table(8);
+    JanetTable *lookup = janet_core_lookup_table(NULL);
+    JanetTable *temptab;
+    int handle = janet_gclock();
+    ```
+    ```
     /* Get core env */
     JanetTable *env = janet_core_env(NULL);
     JanetTable *lookup = janet_env_lookup(env);
     JanetTable *temptab;
     int handle = janet_gclock();
-
-    /* Load natives into unmarshalling dictionary */
-
-    ```
+    ```)
     lookup-into-invocations
     ```
     /* Unmarshal bytecode */
@@ -663,7 +668,6 @@ int main(int argc, const char **argv) {
     }
 
     /* Create enviornment */
-    temptab = janet_table(0);
     temptab = env;
     janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args));
     janet_gcroot(janet_wrap_table(temptab));
@@ -674,6 +678,14 @@ int main(int argc, const char **argv) {
     /* Run everything */
     JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL);
     fiber->env = temptab;
+#ifdef JANET_EV
+    janet_gcroot(janet_wrap_fiber(fiber));
+    janet_schedule(fiber, janet_wrap_nil());
+    janet_loop();
+    int status = janet_fiber_status(fiber);
+    janet_deinit();
+    return status;
+#else
     Janet out;
     JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
     if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) {
@@ -681,11 +693,9 @@ int main(int argc, const char **argv) {
       janet_deinit();
       return result;
     }
-#ifdef JANET_NET
-    janet_loop();
-#endif
     janet_deinit();
     return 0;
+#endif
 }
 
 ```))
@@ -694,7 +704,7 @@ int main(int argc, const char **argv) {
   "Links an image with libjanet.a (or .lib) to produce an
   executable. Also will try to link native modules into the
   final executable as well."
-  [opts source dest]
+  [opts source dest no-core]
 
   # Create executable's janet image
   (def cimage_dest (string dest ".c"))
@@ -710,7 +720,16 @@ int main(int argc, const char **argv) {
         (def dep-ldflags @[])
 
         # Create marshalling dictionary
-        (def mdict (invert (env-lookup root-env)))
+        (def mdict1 (invert (env-lookup root-env)))
+        (def mdict
+          (if no-core
+            (let [temp @{}]
+              (eachp [k v] mdict1
+                (if (or (cfunction? k) (abstract? k))
+                  (put temp k v)))
+              temp)
+            mdict1))
+
         # Load all native modules
         (def prefixes @{})
         (def static-libs @[])
@@ -755,7 +774,7 @@ int main(int argc, const char **argv) {
         # Make image byte buffer
         (create-buffer-c-impl image cimage_dest "janet_payload_image")
         # Append main function
-        (spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
+        (spit cimage_dest (make-bin-source declarations lookup-into-invocations no-core) :ab)
         (def oimage_dest (out-path cimage_dest ".c" ".o"))
         # Compile and link final exectable
         (unless no-compile
@@ -959,7 +978,7 @@ int main(int argc, const char **argv) {
         (let [op (out-path src ".c" objext)]
           (compile-c opts src op)
           op)
-        (errorf "unknown source file type: %s, expected .c or .cpp"))))
+        (errorf "unknown source file type: %s, expected .c or .cpp" src))))
 
   (when-let [embedded (opts :embedded)]
     (loop [src :in embedded]
@@ -1044,10 +1063,10 @@ int main(int argc, const char **argv) {
   This executable can be installed as well to the --binpath given."
   [&keys {:install install :name name :entry entry :headers headers
           :cflags cflags :lflags lflags :deps deps :ldflags ldflags
-          :no-compile no-compile}]
+          :no-compile no-compile :no-core no-core}]
   (def name (if is-win (string name ".exe") name))
   (def dest (string "build" sep name))
-  (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
+  (create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest no-core)
   (if no-compile
     (let [cdest (string dest ".c")]
       (add-dep "build" cdest))
@@ -1061,12 +1080,15 @@ int main(int argc, const char **argv) {
         (install-rule dest (dyn :binpath JANET_BINPATH))))))
 
 (defn declare-binscript
-  "Declare a janet file to be installed as an executable script. Creates
+  ``Declare a janet file to be installed as an executable script. Creates
   a shim on windows. If hardcode is true, will insert code into the script
-  such that it will run correctly even when JANET_PATH is changed."
-  [&keys {:main main :hardcode-syspath hardcode}]
+  such that it will run correctly even when JANET_PATH is changed. if auto-shebang
+  is truthy, will also automatically insert a correct shebang line.
+  ``
+  [&keys {:main main :hardcode-syspath hardcode :is-janet is-janet}]
   (def binpath (dyn :binpath JANET_BINPATH))
-  (if hardcode
+  (def auto-shebang (and is-janet (dyn :auto-shebang)))
+  (if (or auto-shebang hardcode)
     (let [syspath (dyn :modpath JANET_MODPATH)]
       (def parts (peg/match path-splitter main))
       (def name (last parts))
@@ -1078,7 +1100,9 @@ int main(int argc, const char **argv) {
                     (def first-line (:read f :line))
                     (def second-line (string/format "(put root-env :syspath %v)\n" syspath))
                     (def rest (:read f :all))
-                    (string first-line second-line rest)))
+                    (string (if auto-shebang
+                              (string "#!" (dyn :binpath JANET_BINPATH) "/janet\n"))
+                            first-line (if hardcode second-line) rest)))
                 (create-dirs path)
                 (spit path contents)
                 (unless is-win (shell "chmod" "+x" path))))
@@ -1354,7 +1378,9 @@ Flags are:
 
 (defn quickbin
   [input output]
-  (create-executable @{} input output)
+  (if (= (os/stat output :mode) :file)
+    (print "output " output " exists."))
+  (create-executable @{:no-compile (dyn :no-compile)} input output (dyn :no-core))
   (do-rule output))
 
 (defn jpm-debug-repl
@@ -1401,26 +1427,30 @@ Flags are:
    "load-lockfile" load-lockfile
    "quickbin" quickbin})
 
-(def- args (tuple/slice (dyn :args) 1))
-(def- len (length args))
-(var i :private 0)
+(defn- main
+  "Script entry."
+  [& argv]
 
-# Get flags
-(while (< i len)
-  (if-let [m (peg/match argpeg (args i))]
-    (if (= 2 (length m))
-      (let [[key value] m]
-        (setdyn (keyword key) value))
-      (setdyn (keyword (m 0)) true))
-    (break))
-  (++ i))
+  (def- args (tuple/slice argv 1))
+  (def- len (length args))
+  (var i :private 0)
 
-# Run subcommand
-(if (= i len)
-  (help)
-  (do
-    (if-let [com (subcommands (args i))]
-      (com ;(tuple/slice args (+ i 1)))
-      (do
-        (print "invalid command " (args i))
-        (help)))))
+  # Get flags
+  (while (< i len)
+    (if-let [m (peg/match argpeg (args i))]
+      (if (= 2 (length m))
+        (let [[key value] m]
+          (setdyn (keyword key) value))
+        (setdyn (keyword (m 0)) true))
+      (break))
+    (++ i))
+
+  # Run subcommand
+  (if (= i len)
+    (help)
+    (do
+      (if-let [com (subcommands (args i))]
+        (com ;(tuple/slice args (+ i 1)))
+        (do
+          (print "invalid command " (args i))
+          (help))))))

jpm.1

@@ -42,6 +42,10 @@ Prevents jpm from going to network to get dependencies - all dependencies should
 Use this flag with the deps and update-pkgs subcommands. This is not a surefire way to prevent a build script from accessing
 the network, for example, a build script that invokes curl will still have network access.
 
+.TP
+.BR \-\-auto\-shebang
+Prepends installed scripts with a generated shebang line, such that they will use a janet binary located in JANET_BINPATH.
+
 .SH OPTIONS
 
 .TP

meson.build

@@ -19,8 +19,8 @@
 # IN THE SOFTWARE.
 
 project('janet', 'c',
-  default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.14.2')
+  default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
+  version : '1.15.3')
 
 # Global settings
 janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -33,7 +33,7 @@ dl_dep = cc.find_library('dl', required : false)
 thread_dep = dependency('threads')
 
 # Link options
-if build_machine.system() != 'windows'
+if get_option('default_library') != 'static' and build_machine.system() != 'windows'
     add_project_link_arguments('-rdynamic', language : 'c')
 endif
 
@@ -244,6 +244,7 @@ janet_dep = declare_dependency(include_directories : incdir,
 # pkgconfig
 pkg = import('pkgconfig')
 pkg.generate(libjanet,
+  subdirs: 'janet',
   description: 'Library for the Janet programming language.')
 
 # Installation

src/boot/boot.janet

@@ -7,8 +7,6 @@
 ###
 ###
 
-(def root-env "The root environment used to create environments with (make-env)" _env)
-
 (def defn :macro
   ```
   (defn name & more)
@@ -279,7 +277,7 @@
   [& forms]
   (def len (length forms))
   (var i (- len 1))
-  (var ret (in forms i))
+  (var ret (get forms i))
   (while (> i 0)
     (-- i)
     (def fi (in forms i))
@@ -585,16 +583,6 @@
   [& body]
   (tuple fiber/new (tuple 'fn '[] ;body) :yi))
 
-(defmacro- undef
-  "Remove binding from root-env"
-  [& syms]
-  ~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
-
-(undef _env)
-
-(undef loop1 check-indexed for-template for-var-template iterate-template
-       each-template range-template)
-
 (defn sum
   "Returns the sum of xs. If xs is empty, returns 0."
   [xs]
@@ -757,8 +745,6 @@
 (defn even? "Check if x is even." [x] (= 0 (compare 0 (mod x 2))))
 (defn odd? "Check if x is odd." [x] (= 0 (compare 1 (mod x 2))))
 
-(undef compare-reduce)
-
 ###
 ###
 ### Indexed Combinators
@@ -770,7 +756,7 @@
     a
     (if (not= (> b a) (> b c)) b c)))
 
-(defn sort-help [a lo hi by]
+(defn- sort-help [a lo hi before?]
   (when (< lo hi)
     (def pivot
       (median-of-three (in a hi) (in a lo)
@@ -778,8 +764,8 @@
     (var left lo)
     (var right hi)
     (while true
-      (while (by (in a left) pivot) (++ left))
-      (while (by pivot (in a right)) (-- right))
+      (while (before? (in a left) pivot) (++ left))
+      (while (before? pivot (in a right)) (-- right))
       (when (<= left right)
         (def tmp (in a left))
         (set (a left) (in a right))
@@ -787,32 +773,33 @@
         (++ left)
         (-- right))
       (if (>= left right) (break)))
-    (sort-help a lo right by)
-    (sort-help a left hi by))
+    (sort-help a lo right before?)
+    (sort-help a left hi before?))
   a)
 
 (defn sort
-  "Sort an array in-place. Uses quick-sort and is not a stable sort."
-  [a &opt by]
-  (sort-help a 0 (- (length a) 1) (or by <)))
-
-(undef median-of-three)
-(undef sort-help)
+  ``Sort `ind` in-place, and return it. Uses quick-sort and is not a stable sort.
+  If a `before?` comparator function is provided, sorts elements using that,
+  otherwise uses `<`.``
+  [ind &opt before?]
+  (sort-help ind 0 (- (length ind) 1) (or before? <)))
 
 (defn sort-by
-  `Returns a new sorted array that compares elements by invoking
-  a function on each element and comparing the result with <.`
+  ``Returns `ind` sorted by calling
+  a function `f` on each element and comparing the result with `<`.``
   [f ind]
   (sort ind (fn [x y] (< (f x) (f y)))))
 
 (defn sorted
-  "Returns a new sorted array without modifying the old one."
-  [ind &opt by]
-  (sort (array/slice ind) by))
+  ``Returns a new sorted array without modifying the old one.
+  If a `before?` comparator function is provided, sorts elements using that,
+  otherwise uses `<`.``
+  [ind &opt before?]
+  (sort (array/slice ind) before?))
 
 (defn sorted-by
-  `Returns a new sorted array that compares elements by invoking
-  a function on each element and comparing the result with <.`
+  ``Returns a new sorted array that compares elements by invoking
+  a function `f` on each element and comparing the result with `<`.``
   [f ind]
   (sorted ind (fn [x y] (< (f x) (f y)))))
 
@@ -1204,9 +1191,6 @@
                (tuple/brackets ;x)))
     form))
 
-(undef walk-ind)
-(undef walk-dict)
-
 (defn postwalk
   `Do a post-order traversal of a data structure and call (f x)
   on every visitation.`
@@ -1467,6 +1451,36 @@
     (set (freqs x) (if n (+ 1 n) 1)))
   freqs)
 
+(defn group-by
+  ``Group elements of `ind` by a function `f` and put the results into a table. The keys of
+  the table are the distinct return values of `f`, and the values are arrays of all elements of `ind`
+  that are equal to that value.``
+  [f ind]
+  (def ret @{})
+  (each x ind
+    (def y (f x))
+    (if-let [arr (get ret y)]
+      (array/push arr x)
+      (put ret y @[x])))
+  ret)
+
+(defn partition-by
+  ``Partition elements of a sequential data structure by a representative function `f`. Partitions 
+  split when `(f x)` changes values when iterating to the next element `x` of `ind`. Returns a new array
+  of arrays.``
+  [f ind]
+  (def ret @[])
+  (var span nil)
+  (var category nil)
+  (var is-new true)
+  (each x ind
+    (def y (f x))
+    (cond
+      is-new          (do (set is-new false) (set category y) (set span @[x]) (array/push ret span))
+      (= y category)  (array/push span x)
+      (do (set category y) (set span @[x]) (array/push ret span))))
+  ret)
+
 (defn interleave
   "Returns an array of the first elements of each col, then the second, etc."
   [& cols]
@@ -2033,10 +2047,11 @@
 ###
 ###
 
-# Get boot options
-(def- boot/opts @{})
+# Initialize syspath and header path
 (each [k v] (partition 2 (tuple/slice boot/args 2))
-  (put boot/opts k v))
+  (case k
+    "JANET_PATH" (setdyn :syspath v)
+    "JANET_HEADERPATH" (setdyn :headerpath v)))
 
 (defn make-env
   `Create a new environment table. The new environment
@@ -2054,30 +2069,31 @@
   (def [line col] (:where p))
   (eprint
     (if ec "\e[31m" "")
-    "parse error in "
     where
-    " around line "
-    (string line)
-    ", column "
-    (string col)
-    ": "
+    ":"
+    line
+    ":"
+    col
+    ": parse error: "
     (:error p)
     (if ec "\e[0m" ""))
   (eflush))
 
 (defn bad-compile
   "Default handler for a compile error."
-  [msg macrof where]
+  [msg macrof where &opt line col]
   (def ec (dyn :err-color))
+  (eprin
+    (if ec "\e[31m" "")
+    where
+    ":"
+    line
+    ":"
+    col
+    ": compile error: ")
   (if macrof
-    (debug/stacktrace macrof (string msg " while compiling " where))
-    (eprint
-      (if ec "\e[31m" "")
-      "compile error: "
-      msg
-      " while compiling "
-      where
-      (if ec "\e[0m" "")))
+    (debug/stacktrace macrof msg)
+    (eprint msg (if ec "\e[0m" "")))
   (eflush))
 
 (defn curenv
@@ -2116,7 +2132,7 @@
         :on-parse-error on-parse-error
         :fiber-flags guard
         :evaluator evaluator
-        :source where
+        :source default-where
         :parser parser
         :read read
         :expander expand} opts)
@@ -2126,11 +2142,13 @@
   (default on-compile-error bad-compile)
   (default on-parse-error bad-parse)
   (default evaluator (fn evaluate [x &] (x)))
-  (default where "<anonymous>")
+  (default default-where "<anonymous>")
   (default guard :ydt)
 
+  (var where default-where)
+
   # Evaluate 1 source form in a protected manner
-  (defn eval1 [source]
+  (defn eval1 [source &opt l c]
     (def source (if expand (expand source) source))
     (var good true)
     (var resumeval nil)
@@ -2143,11 +2161,7 @@
             (do
               (set good false)
               (def {:error err :line line :column column :fiber errf} res)
-              (def msg
-                (if (<= 0 line)
-                  (string err " on line " line ", column " column)
-                  err))
-              (on-compile-error msg errf where))))
+              (on-compile-error err errf where (or line l) (or column c)))))
         guard))
     (fiber/setenv f env)
     (while (fiber/can-resume? f)
@@ -2175,17 +2189,28 @@
     (fiber/setenv f env)
     (resume f))
 
+  (defn produce []
+    (def tup (p-produce p true))
+    [(in tup 0) ;(tuple/sourcemap tup)])
+
   # Loop
   (def buf @"")
   (var parser-not-done true)
   (while parser-not-done
     (if (env :exit) (break))
     (buffer/clear buf)
-    (if (= (chunks buf p) :cancel)
+    (match (chunks buf p)
+      :cancel
       (do
         # A :cancel chunk represents a cancelled form in the REPL, so reset.
         (:flush p)
         (buffer/clear buf))
+
+      [:source new-where]
+      (if (string? new-where)
+        (set where new-where)
+        (set where default-where))
+
       (do
         (var pindex 0)
         (var pstatus nil)
@@ -2196,7 +2221,7 @@
         (while (> len pindex)
           (+= pindex (p-consume p buf pindex))
           (while (p-has-more p)
-            (eval1 (p-produce p))
+            (eval1 ;(produce))
             (if (env :exit) (break)))
           (when (= (p-status p) :error)
             (parse-err p where)
@@ -2205,7 +2230,7 @@
   # Check final parser state
   (unless (env :exit)
     (while (p-has-more p)
-      (eval1 (p-produce p))
+      (eval1 ;(produce))
       (if (env :exit) (break)))
     (when (= (p-status p) :error)
       (parse-err p where)))
@@ -2330,16 +2355,13 @@
   ```
   @[])
 
-(setdyn :syspath (boot/opts "JANET_PATH"))
-(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
-
 (defn module/add-paths
   ```
-  Add paths to module/paths for a given loader such that
+  Add paths to `module/paths` for a given loader such that
   the generated paths behave like other module types, including
-  relative imports and syspath imports. ext is the file extension
-  to associate with this module type, including the dot. loader is the
-  keyword name of a loader that is module/loaders. Returns the modified module/paths.
+  relative imports and syspath imports. `ext` is the file extension
+  to associate with this module type, including the dot. `loader` is the
+  keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
   ```
   [ext loader]
   (defn- find-prefix
@@ -2360,7 +2382,7 @@
 (array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep])
 
 # Version of fexists that works even with a reduced OS
-(defn fexists
+(defn- fexists
   [path]
   (compif (dyn 'os/stat)
     (= :file (os/stat path :mode))
@@ -2407,12 +2429,6 @@
           str-parts (interpose "\n    " paths)]
       [nil (string "could not find module " path ":\n    " ;str-parts)])))
 
-(undef fexists)
-(undef mod-filter)
-(undef check-relative)
-(undef check-project-relative)
-(undef check-is-dep)
-
 (def module/loading
   `Table mapping currently loading modules to true. Used to prevent
   circular dependencies.`
@@ -2441,22 +2457,25 @@
   (put env :source (or src (if-not path-is-file spath path)))
   (var exit-error nil)
   (var exit-fiber nil)
-  (defn chunks [buf _] (file/read f 2048 buf))
+  (defn chunks [buf _] (file/read f 4096 buf))
   (defn bp [&opt x y]
     (when exit
       (bad-parse x y)
       (os/exit 1))
     (put env :exit true)
-    (def [line col] (:where x))
-    (def pe (string (:error x) " in " y " around line " line ", column " col))
-    (set exit-error pe))
-  (defn bc [&opt x y z]
+    (def buf @"")
+    (with-dyns [:err buf :err-color false]
+      (bad-parse x y))
+    (set exit-error (string/slice buf 0 -2)))
+  (defn bc [&opt x y z a b]
     (when exit
-      (bad-compile x y z)
+      (bad-compile x y z a b)
       (os/exit 1))
     (put env :exit true)
-    (def ce (string x " while compiling " z))
-    (set exit-error ce)
+    (def buf @"")
+    (with-dyns [:err buf :err-color false]
+      (bad-compile x nil z a b))
+    (set exit-error (string/slice buf 0 -2))
     (set exit-fiber y))
   (unless f
     (error (string "could not find file " path)))
@@ -2468,7 +2487,8 @@
                   :on-status (fn [f x]
                                (when (not= (fiber/status f) :dead)
                                  (when exit
-                                   (debug/stacktrace f x)
+                                   (eprint x)
+                                   (debug/stacktrace f)
                                    (eflush)
                                    (os/exit 1))
                                  (put env :exit true)
@@ -2502,7 +2522,7 @@
                    m)))
     :image (fn image-loader [path &] (load-image (slurp path)))})
 
-(defn require-1
+(defn- require-1
   [path args kargs]
   (def [fullpath mod-kind] (module/find path))
   (unless fullpath (error mod-kind))
@@ -2551,8 +2571,6 @@
                 (string (last (string/split "/" path)) "/")))
   (merge-module env newenv prefix ep))
 
-(undef require-1)
-
 (defmacro import
   `Import a module. First requires the module, and then merges its
   symbols into the current environment, prepending a given prefix as needed.
@@ -2913,10 +2931,6 @@
   (if-not found
     (print "documentation for value " x " not found.")))
 
-(undef env-walk)
-(undef print-index)
-(undef print-module-entry)
-
 ###
 ###
 ### Debugger
@@ -2962,71 +2976,67 @@
   (in (.slots frame-idx) (or nth 0)))
 
 # Conditional compilation for disasm
-(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
+(compwhen (dyn 'disasm)
 
-(defn .disasm
-  "Gets the assembly for the current function."
-  [&opt n]
-  (def frame (.frame n))
-  (def func (frame :function))
-  (disasm-alias func))
+  (defn .disasm
+    "Gets the assembly for the current function."
+    [&opt n]
+    (def frame (.frame n))
+    (def func (frame :function))
+    (disasm func))
 
-(defn .bytecode
-  "Get the bytecode for the current function."
-  [&opt n]
-  ((.disasm n) :bytecode))
+  (defn .bytecode
+    "Get the bytecode for the current function."
+    [&opt n]
+    ((.disasm n) :bytecode))
 
-(defn .ppasm
-  "Pretty prints the assembly for the current function"
-  [&opt n]
-  (def frame (.frame n))
-  (def func (frame :function))
-  (def dasm (disasm-alias func))
-  (def bytecode (in dasm :bytecode))
-  (def pc (frame :pc))
-  (def sourcemap (in dasm :sourcemap))
-  (var last-loc [-2 -2])
-  (print "\n  signal: " (.signal))
-  (print "  function:   " (dasm :name) " [" (in dasm :source "") "]")
-  (when-let [constants (dasm :constants)]
-    (printf "  constants:  %.4q" constants))
-  (printf "  slots:      %.4q\n" (frame :slots))
-  (def padding (string/repeat " " 20))
-  (loop [i :range [0 (length bytecode)]
-         :let [instr (bytecode i)]]
-    (prin (if (= (tuple/type instr) :brackets) "*" " "))
-    (prin (if (= i pc) "> " "  "))
-    (prinf "%.20s" (string (string/join (map string instr) " ") padding))
-    (when sourcemap
-      (let [[sl sc] (sourcemap i)
-            loc [sl sc]]
-        (when (not= loc last-loc)
-          (set last-loc loc)
-          (prin " # line " sl ", column " sc))))
+  (defn .ppasm
+    "Pretty prints the assembly for the current function"
+    [&opt n]
+    (def frame (.frame n))
+    (def func (frame :function))
+    (def dasm (disasm func))
+    (def bytecode (in dasm :bytecode))
+    (def pc (frame :pc))
+    (def sourcemap (in dasm :sourcemap))
+    (var last-loc [-2 -2])
+    (print "\n  signal: " (.signal))
+    (print "  function:   " (dasm :name) " [" (in dasm :source "") "]")
+    (when-let [constants (dasm :constants)]
+      (printf "  constants:  %.4q" constants))
+    (printf "  slots:      %.4q\n" (frame :slots))
+    (def padding (string/repeat " " 20))
+    (loop [i :range [0 (length bytecode)]
+           :let [instr (bytecode i)]]
+      (prin (if (= (tuple/type instr) :brackets) "*" " "))
+      (prin (if (= i pc) "> " "  "))
+      (prinf "%.20s" (string (string/join (map string instr) " ") padding))
+      (when sourcemap
+        (let [[sl sc] (sourcemap i)
+              loc [sl sc]]
+          (when (not= loc last-loc)
+            (set last-loc loc)
+            (prin " # line " sl ", column " sc))))
+      (print))
     (print))
-  (print))
 
-(defn .breakall
-  "Set breakpoints on all instructions in the current function."
-  [&opt n]
-  (def fun (.fn n))
-  (def bytecode (.bytecode n))
-  (forv i 0 (length bytecode)
-    (debug/fbreak fun i))
-  (print "Set " (length bytecode) " breakpoints in " fun))
+  (defn .breakall
+    "Set breakpoints on all instructions in the current function."
+    [&opt n]
+    (def fun (.fn n))
+    (def bytecode (.bytecode n))
+    (forv i 0 (length bytecode)
+      (debug/fbreak fun i))
+    (print "Set " (length bytecode) " breakpoints in " fun))
 
-(defn .clearall
-  "Clear all breakpoints on the current function."
-  [&opt n]
-  (def fun (.fn n))
-  (def bytecode (.bytecode n))
-  (forv i 0 (length bytecode)
-    (debug/unfbreak fun i))
-  (print "Cleared " (length bytecode) " breakpoints in " fun))
-
-(unless (get root-env 'disasm)
-  (undef .disasm .bytecode .breakall .clearall .ppasm))
-(undef disasm-alias)
+  (defn .clearall
+    "Clear all breakpoints on the current function."
+    [&opt n]
+    (def fun (.fn n))
+    (def bytecode (.bytecode n))
+    (forv i 0 (length bytecode)
+      (debug/unfbreak fun i))
+    (print "Cleared " (length bytecode) " breakpoints in " fun)))
 
 (defn .source
   "Show the source code for the function being debugged."
@@ -3082,7 +3092,6 @@
 
 (def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
 (each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
-(undef debugger-keys)
 
 ###
 ###
@@ -3156,6 +3165,7 @@
 ###
 
 (compwhen (dyn 'ev/go)
+
   (defn net/close "Alias for ev/close." [stream] (ev/close stream))
 
   (defn ev/call
@@ -3207,9 +3217,7 @@
          (,wait-for-fibers ,chan
            ,(seq [[i body] :pairs bodies]
               ~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan)))
-         ,res)))
-
-  (undef wait-for-fibers))
+         ,res))))
 
 (compwhen (dyn 'net/listen)
   (defn net/server
@@ -3251,7 +3259,10 @@
 (defn- use-2 [evaluator args]
   (each a args (import* (string a) :prefix "" :evaluator evaluator)))
 
-(defn- evaluator
+(defn- flycheck-evaluator
+  ``An evaluator function that is passed to `run-context` that lints (flychecks) code.
+  This means code will parsed and compiled, macros executed, but the code will not be run.
+  Used by `flycheck`.``
   [thunk source env where]
   (when (tuple? source)
     (def head (source 0))
@@ -3265,20 +3276,25 @@
       (thunk)
       # Use
       (= 'use head)
-      (use-2 evaluator (tuple/slice source 1))
+      (use-2 flycheck-evaluator (tuple/slice source 1))
       # Import-like form
       (importers head)
       (let [[l c] (tuple/sourcemap source)
-            newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)]
+            newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
         ((compile newtup env where))))))
 
 (defn flycheck
   ``Check a file for errors without running the file. Found errors will be printed to stderr
   in the usual format. Macros will still be executed, however, so
   arbitrary execution is possible. Other arguments are the same as dofile. `path` can also be
-  a file value such as stdin.``
+  a file value such as stdin. Returns nil.``
   [path &keys kwargs]
-  (dofile path :evaluator evaluator ;(kvs kwargs)))
+  (try
+    (dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
+    ([e f]
+     (eprint e)
+     (debug/stacktrace f)))
+  nil)
 
 ###
 ###
@@ -3286,7 +3302,6 @@
 ###
 ###
 
-
 # conditional compilation for reduced os
 (def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
 
@@ -3412,23 +3427,6 @@
         (setdyn :err-color (if *colorize* true))
         (repl getchunk nil env)))))
 
-(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
-
-###
-###
-### Clean up
-###
-###
-
-(do
-  (undef boot/opts undef)
-  (def load-dict (env-lookup root-env))
-  (put load-dict 'boot/config nil)
-  (put load-dict 'boot/args nil)
-  (each [k v] (pairs load-dict)
-    (if (number? v) (put load-dict k nil)))
-  (merge-into load-image-dict load-dict))
-
 ###
 ###
 ### Bootstrap
@@ -3446,29 +3444,38 @@
         (put into k (x k))))
     into)
 
-  # Modify env based on some options.
-  (loop [[k v] :pairs root-env
+  # Modify root-env to remove private symbols and
+  # flatten nested tables.
+  (loop [[k v] :in (pairs root-env)
          :when (symbol? k)]
     (def flat (proto-flatten @{} v))
     (when (boot/config :no-docstrings)
       (put flat :doc nil))
     (when (boot/config :no-sourcemaps)
       (put flat :source-map nil))
-    (put root-env k flat))
-
+    (if (v :private)
+      (put root-env k nil)
+      (put root-env k flat)))
   (put root-env 'boot/config nil)
   (put root-env 'boot/args nil)
 
-  (def image (let [env-pairs (pairs (env-lookup root-env))
-                   essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
-                   lookup (table ;(mapcat identity essential-pairs))
-                   reverse-lookup (invert lookup)]
-               # Check no duplicate values
-               (def temp @{})
-               (eachp [k v] lookup
-                 (if (in temp v) (errorf "duplicate value: %v" v))
-                 (put temp v k))
-               (marshal root-env reverse-lookup)))
+  # Build dictionary for loading images
+  (def load-dict (env-lookup root-env))
+  (each [k v] (pairs load-dict)
+    (if (number? v) (put load-dict k nil)))
+  (merge-into load-image-dict load-dict)
+
+  (def image
+    (let [env-pairs (pairs (env-lookup root-env))
+          essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
+          lookup (table ;(mapcat identity essential-pairs))
+          reverse-lookup (invert lookup)]
+      # Check no duplicate values
+      (def temp @{})
+      (eachp [k v] lookup
+        (if (in temp v) (errorf "duplicate value: %v" v))
+        (put temp v k))
+      (marshal root-env reverse-lookup)))
 
   # Create amalgamation
 

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 14
-#define JANET_VERSION_PATCH 2
+#define JANET_VERSION_MINOR 15
+#define JANET_VERSION_PATCH 3
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.14.2"
+#define JANET_VERSION "1.15.3"
 
 /* #define JANET_BUILD "local" */
 

src/core/buffer.c

@@ -91,7 +91,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
     }
     int32_t new_size = buffer->count + n;
     if (new_size > buffer->capacity) {
-        int32_t new_capacity = new_size * 2;
+        int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
         uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
         janet_gcpressure(new_capacity - buffer->capacity);
         if (NULL == new_data) {

src/core/compile.c

@@ -872,8 +872,12 @@ static Janet cfun(int32_t argc, Janet *argv) {
     } else {
         JanetTable *t = janet_table(4);
         janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
-        janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
-        janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
+        if (res.error_mapping.line > 0) {
+            janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
+        }
+        if (res.error_mapping.column > 0) {
+            janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
+        }
         if (res.macrofiber) {
             janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
         }

src/core/corelib.c

@@ -1206,7 +1206,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
                    "if native modules are compatible with the host program."));
 
     /* Allow references to the environment */
-    janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
+    janet_def(env, "root-env", janet_wrap_table(env),
+              JDOC("The root environment used to create environments with (make-env)."));
 
     janet_load_libs(env);
     janet_gcroot(janet_wrap_table(env));
@@ -1221,22 +1222,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
         return janet_vm_core_env;
     }
 
-    /* Load core cfunctions (and some built in janet assembly functions) */
-    JanetTable *dict = janet_table(512);
-    janet_load_libs(dict);
-
-    /* Add replacements */
-    if (replacements != NULL) {
-        for (int32_t i = 0; i < replacements->capacity; i++) {
-            JanetKV kv = replacements->data[i];
-            if (!janet_checktype(kv.key, JANET_NIL)) {
-                janet_table_put(dict, kv.key, kv.value);
-                if (janet_checktype(kv.value, JANET_CFUNCTION)) {
-                    janet_table_put(janet_vm_registry, kv.value, kv.key);
-                }
-            }
-        }
-    }
+    JanetTable *dict = janet_core_lookup_table(replacements);
 
     /* Unmarshal bytecode */
     Janet marsh_out = janet_unmarshal(
@@ -1270,3 +1256,23 @@ JanetTable *janet_core_env(JanetTable *replacements) {
 }
 
 #endif
+
+JanetTable *janet_core_lookup_table(JanetTable *replacements) {
+    JanetTable *dict = janet_table(512);
+    janet_load_libs(dict);
+
+    /* Add replacements */
+    if (replacements != NULL) {
+        for (int32_t i = 0; i < replacements->capacity; i++) {
+            JanetKV kv = replacements->data[i];
+            if (!janet_checktype(kv.key, JANET_NIL)) {
+                janet_table_put(dict, kv.key, kv.value);
+                if (janet_checktype(kv.value, JANET_CFUNCTION)) {
+                    janet_table_put(janet_vm_registry, kv.value, kv.key);
+                }
+            }
+        }
+    }
+
+    return dict;
+}

src/core/debug.c

@@ -102,7 +102,9 @@ 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;
+
+    /* Don't print error line if it is nil. */
+    int wrote_error = janet_checktype(err, JANET_NIL);
 
     int print_color = janet_truthy(janet_dyn("err-color"));
     if (print_color) janet_eprintf("\x1b[31m");
@@ -302,7 +304,6 @@ static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
     janet_arity(argc, 1, 2);
     JanetFiber *fiber = janet_getfiber(argv, 0);
     Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
-    x = janet_checktype(x, JANET_NIL) ? fiber->last_value : x;
     janet_stacktrace(fiber, x);
     return argv[0];
 }
@@ -382,7 +383,7 @@ static const JanetReg debug_cfuns[] = {
         JDOC("(debug/stacktrace fiber &opt err)\n\n"
              "Prints a nice looking stacktrace for a fiber. Can optionally provide "
              "an error value to print the stack trace with. If `err` is nil or not "
-             "provided, will default to `(fiber/last-value fiber)`. Returns the fiber.")
+             "provided, will skipp the error line. Returns the fiber.")
     },
     {
         "debug/lineage", cfun_debug_lineage,

src/core/ev.c

@@ -393,7 +393,20 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
      * while in transit, and it's value gets reused. DuplicateHandle does not work
      * for network sockets, and in general for winsock it is better to nipt duplicate
      * unless there is a need to. */
-    janet_marshal_int64(ctx, (int64_t)(s->handle));
+    HANDLE duph = INVALID_HANDLE_VALUE;
+    if (s->flags & JANET_STREAM_SOCKET) {
+        duph = s->handle;
+    } else {
+        DuplicateHandle(
+            GetCurrentProcess(),
+            s->handle,
+            GetCurrentProcess(),
+            &duph,
+            0,
+            FALSE,
+            DUPLICATE_SAME_ACCESS);
+    }
+    janet_marshal_int64(ctx, (int64_t)(duph));
 #else
     /* Marshal after dup becuse it is easier than maintaining our own ref counting. */
     int duph = dup(s->handle);
@@ -2314,6 +2327,7 @@ static const JanetReg ev_cfuns[] = {
 
 void janet_lib_ev(JanetTable *env) {
     janet_core_cfuns(env, NULL, ev_cfuns);
+    janet_register_abstract_type(&janet_stream_type);
 }
 
 #endif

src/core/io.c

@@ -746,6 +746,7 @@ static const JanetReg io_cfuns[] = {
              "* r - allow reading from the file\n\n"
              "* w - allow writing to the file\n\n"
              "* a - append to the file\n\n"
+             "Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
              "* b - open the file in binary mode (rather than text mode)\n\n"
              "* + - append to the file instead of overwriting it\n\n"
              "* n - error if the file cannot be opened instead of returning nil")

src/core/marsh.c

@@ -1428,9 +1428,9 @@ static const JanetReg marsh_cfuns[] = {
         "marshal", cfun_marshal,
         JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
              "Marshal a value into a buffer and return the buffer. The buffer "
-             "can the later be unmarshalled to reconstruct the initial value. "
+             "can then later be unmarshalled to reconstruct the initial value. "
              "Optionally, one can pass in a reverse lookup table to not marshal "
-             "aliased values that are found in the table. Then a forward"
+             "aliased values that are found in the table. Then a forward "
              "lookup table can be used to recover the original value when "
              "unmarshalling.")
     },

src/core/os.c

@@ -187,49 +187,71 @@ static Janet os_exit(int32_t argc, Janet *argv) {
 #ifndef JANET_NO_PROCESSES
 
 /* Get env for os_execute */
-static char **os_execute_env(int32_t argc, const Janet *argv) {
-    char **envp = NULL;
-    if (argc > 2) {
-        JanetDictView dict = janet_getdictionary(argv, 2);
-        envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
-        int32_t j = 0;
-        for (int32_t i = 0; i < dict.cap; i++) {
-            const JanetKV *kv = dict.kvs + i;
-            if (!janet_checktype(kv->key, JANET_STRING)) continue;
-            if (!janet_checktype(kv->value, JANET_STRING)) continue;
-            const uint8_t *keys = janet_unwrap_string(kv->key);
-            const uint8_t *vals = janet_unwrap_string(kv->value);
-            int32_t klen = janet_string_length(keys);
-            int32_t vlen = janet_string_length(vals);
-            /* Check keys has no embedded 0s or =s. */
-            int skip = 0;
-            for (int32_t k = 0; k < klen; k++) {
-                if (keys[k] == '\0' || keys[k] == '=') {
-                    skip = 1;
-                    break;
-                }
-            }
-            if (skip) continue;
-            char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
-            memcpy(envitem, keys, klen);
-            envitem[klen] = '=';
-            memcpy(envitem + klen + 1, vals, vlen);
-            envitem[klen + vlen + 1] = 0;
-            envp[j++] = envitem;
-        }
-        envp[j] = NULL;
+#ifdef JANET_WINDOWS
+typedef char *EnvBlock;
+#else
+typedef char **EnvBlock;
+#endif
+
+/* Get env for os_execute */
+static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
+    if (argc <= 2) return NULL;
+    JanetDictView dict = janet_getdictionary(argv, 2);
+#ifdef JANET_WINDOWS
+    JanetBuffer *temp = janet_buffer(10);
+    for (int32_t i = 0; i < dict.cap; i++) {
+        const JanetKV *kv = dict.kvs + i;
+        if (!janet_checktype(kv->key, JANET_STRING)) continue;
+        if (!janet_checktype(kv->value, JANET_STRING)) continue;
+        const uint8_t *keys = janet_unwrap_string(kv->key);
+        const uint8_t *vals = janet_unwrap_string(kv->value);
+        janet_buffer_push_bytes(temp, keys, janet_string_length(keys));
+        janet_buffer_push_u8(temp, '=');
+        janet_buffer_push_bytes(temp, vals, janet_string_length(vals));
+        janet_buffer_push_u8(temp, '\0');
     }
+    janet_buffer_push_u8(temp, '\0');
+    char *ret = janet_smalloc(temp->count);
+    memcpy(ret, temp->data, temp->count);
+    return ret;
+#else
+    char **envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
+    int32_t j = 0;
+    for (int32_t i = 0; i < dict.cap; i++) {
+        const JanetKV *kv = dict.kvs + i;
+        if (!janet_checktype(kv->key, JANET_STRING)) continue;
+        if (!janet_checktype(kv->value, JANET_STRING)) continue;
+        const uint8_t *keys = janet_unwrap_string(kv->key);
+        const uint8_t *vals = janet_unwrap_string(kv->value);
+        int32_t klen = janet_string_length(keys);
+        int32_t vlen = janet_string_length(vals);
+        /* Check keys has no embedded 0s or =s. */
+        int skip = 0;
+        for (int32_t k = 0; k < klen; k++) {
+            if (keys[k] == '\0' || keys[k] == '=') {
+                skip = 1;
+                break;
+            }
+        }
+        if (skip) continue;
+        char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
+        memcpy(envitem, keys, klen);
+        envitem[klen] = '=';
+        memcpy(envitem + klen + 1, vals, vlen);
+        envitem[klen + vlen + 1] = 0;
+        envp[j++] = envitem;
+    }
+    envp[j] = NULL;
     return envp;
+#endif
 }
 
-/* Free memory from os_execute. Not actually needed, but doesn't pressure the GC
-   in the happy path. */
-static void os_execute_cleanup(char **envp, const char **child_argv) {
+static void os_execute_cleanup(EnvBlock envp, const char **child_argv) {
 #ifdef JANET_WINDOWS
     (void) child_argv;
+    if (NULL != envp) janet_sfree(envp);
 #else
     janet_sfree((void *)child_argv);
-#endif
     if (NULL != envp) {
         char **envitem = envp;
         while (*envitem != NULL) {
@@ -238,6 +260,7 @@ static void os_execute_cleanup(char **envp, const char **child_argv) {
         }
     }
     janet_sfree(envp);
+#endif
 }
 
 #ifdef JANET_WINDOWS
@@ -730,12 +753,11 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
     uint64_t flags = 0;
     if (argc > 1) {
         flags = janet_getflags(argv, 1, "epx");
-
     }
 
     /* Get environment */
     int use_environ = !janet_flag_at(flags, 0);
-    char **envp = os_execute_env(argc, argv);
+    EnvBlock envp = os_execute_env(argc, argv);
 
     /* Get arguments */
     JanetView exargs = janet_getindexed(argv, 0);
@@ -919,7 +941,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
         janet_unlock_environ();
     }
 
-    /* Wait for child */
     os_execute_cleanup(envp, child_argv);
     if (status) {
         janet_panicf("%p: %s", argv[0], strerror(errno));
@@ -2064,7 +2085,7 @@ static const JanetReg os_cfuns[] = {
 #ifndef JANET_NO_PROCESSES
     {
         "os/execute", os_execute,
-        JDOC("(os/execute args &opts flags env)\n\n"
+        JDOC("(os/execute args &opt flags env)\n\n"
              "Execute a program on the system and pass it string arguments. `flags` "
              "is a keyword that modifies how the program will execute.\n\n"
              "* :e - enables passing an environment to the program. Without :e, the "
@@ -2084,7 +2105,7 @@ static const JanetReg os_cfuns[] = {
     },
     {
         "os/spawn", os_spawn,
-        JDOC("(os/spawn args &opts flags env)\n\n"
+        JDOC("(os/spawn args &opt flags env)\n\n"
              "Execute a program on the system and return a handle to the process. Otherwise, the "
              "same arguments as os/execute. Does not wait for the process.")
     },

src/core/parse.c

@@ -175,7 +175,14 @@ static void popstate(JanetParser *p, Janet val) {
         if (newtop->flags & PFLAG_CONTAINER) {
             newtop->argn++;
             /* Keep track of number of values in the root state */
-            if (p->statecount == 1) p->pending++;
+            if (p->statecount == 1) {
+                p->pending++;
+                /* Root items are always wrapped in a tuple for source map info. */
+                const Janet *tup = janet_tuple_n(&val, 1);
+                janet_tuple_sm_line(tup) = (int32_t) top.line;
+                janet_tuple_sm_column(tup) = (int32_t) top.column;
+                val = janet_wrap_tuple(tup);
+            }
             push_arg(p, val);
             return;
         } else if (newtop->flags & PFLAG_READERMAC) {
@@ -730,6 +737,19 @@ const char *janet_parser_error(JanetParser *parser) {
 }
 
 Janet janet_parser_produce(JanetParser *parser) {
+    Janet ret;
+    size_t i;
+    if (parser->pending == 0) return janet_wrap_nil();
+    ret = janet_unwrap_tuple(parser->args[0])[0];
+    for (i = 1; i < parser->argcount; i++) {
+        parser->args[i - 1] = parser->args[i];
+    }
+    parser->pending--;
+    parser->argcount--;
+    return ret;
+}
+
+Janet janet_parser_produce_wrapped(JanetParser *parser) {
     Janet ret;
     size_t i;
     if (parser->pending == 0) return janet_wrap_nil();
@@ -910,8 +930,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
     if (s->flags & PFLAG_COMMENT) s--;
     if (s->flags & PFLAG_CONTAINER) {
         s->argn++;
-        if (p->statecount == 1) p->pending++;
-        push_arg(p, argv[1]);
+        if (p->statecount == 1) {
+            p->pending++;
+            Janet tup = janet_wrap_tuple(janet_tuple_n(argv + 1, 1));
+            push_arg(p, tup);
+        } else {
+            push_arg(p, argv[1]);
+        }
     } else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
         const uint8_t *str = janet_to_string(argv[1]);
         int32_t slen = janet_string_length(str);
@@ -980,9 +1005,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
 }
 
 static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 2);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
-    return janet_parser_produce(p);
+    if (argc == 2 && janet_truthy(argv[1])) {
+        return janet_parser_produce_wrapped(p);
+    } else {
+        return janet_parser_produce(p);
+    }
 }
 
 static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
@@ -1217,10 +1246,12 @@ static const JanetReg parse_cfuns[] = {
     },
     {
         "parser/produce", cfun_parse_produce,
-        JDOC("(parser/produce parser)\n\n"
+        JDOC("(parser/produce parser &opt wrap)\n\n"
              "Dequeue the next value in the parse queue. Will return nil if "
              "no parsed values are in the queue, otherwise will dequeue the "
-             "next value.")
+             "next value. If `wrap` is truthy, will return a 1-element tuple that "
+             "wraps the result. This tuple can be used for source-mapping "
+             "purposes.")
     },
     {
         "parser/consume", cfun_parse_consume,

src/core/peg.c

@@ -286,7 +286,7 @@ tail:
             const uint8_t *next_text;
             CapState cs = cap_save(s);
             down1(s);
-            while (text < s->text_end) {
+            while (text <= s->text_end) {
                 CapState cs2 = cap_save(s);
                 next_text = peg_rule(s, rule_a, text);
                 if (next_text) {
@@ -296,7 +296,7 @@ tail:
                 text++;
             }
             up1(s);
-            if (text >= s->text_end) {
+            if (text > s->text_end) {
                 cap_load(s, cs);
                 return NULL;
             }
@@ -596,6 +596,30 @@ tail:
             return text + width;
         }
 
+        case RULE_UNREF: {
+            int32_t tcap = s->tags->count;
+            down1(s);
+            const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
+            up1(s);
+            if (!result) return NULL;
+            int32_t final_tcap = s->tags->count;
+            /* Truncate tagged captures to not include items of the given tag */
+            int32_t w = tcap;
+            /* If no tag is given, drop ALL tagged captures */
+            if (rule[2]) {
+                for (int32_t i = tcap; i < final_tcap; i++) {
+                    if (s->tags->data[i] != (0xFF & rule[2])) {
+                        s->tags->data[w] = s->tags->data[i];
+                        s->tagged_captures->data[w] = s->tagged_captures->data[i];
+                        w++;
+                    }
+                }
+            }
+            s->tags->count = w;
+            s->tagged_captures->count = w;
+            return result;
+        }
+
     }
 }
 
@@ -919,15 +943,15 @@ static void spec_error(Builder *b, int32_t argc, const Janet *argv) {
         spec_onerule(b, argc, argv, RULE_ERROR);
     }
 }
-static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
-    spec_onerule(b, argc, argv, RULE_DROP);
-}
 static void spec_to(Builder *b, int32_t argc, const Janet *argv) {
     spec_onerule(b, argc, argv, RULE_TO);
 }
 static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
     spec_onerule(b, argc, argv, RULE_THRU);
 }
+static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
+    spec_onerule(b, argc, argv, RULE_DROP);
+}
 
 /* Rule of the form [rule, tag] */
 static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -947,6 +971,9 @@ static void spec_accumulate(Builder *b, int32_t argc, const Janet *argv) {
 static void spec_group(Builder *b, int32_t argc, const Janet *argv) {
     spec_cap1(b, argc, argv, RULE_GROUP);
 }
+static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
+    spec_cap1(b, argc, argv, RULE_UNREF);
+}
 
 static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
     peg_arity(b, argc, 1, 2);
@@ -1027,7 +1054,7 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
 static void spec_readint(Builder *b, int32_t argc, const Janet *argv, uint32_t mask) {
     peg_arity(b, argc, 1, 2);
     Reserve r = reserve(b, 3);
-    uint32_t tag = (argc == 2) ? emit_tag(b, argv[3]) : 0;
+    uint32_t tag = (argc == 2) ? emit_tag(b, argv[1]) : 0;
     int32_t width = peg_getnat(b, argv[0]);
     if ((width < 0) || (width > JANET_MAX_READINT_WIDTH)) {
         peg_panicf(b, "width must be between 0 and %d, got %d", JANET_MAX_READINT_WIDTH, width);
@@ -1104,6 +1131,7 @@ static const SpecialPair peg_specials[] = {
     {"to", spec_to},
     {"uint", spec_uint_le},
     {"uint-be", spec_uint_be},
+    {"unref", spec_unref},
 };
 
 /* Compile a janet value into a rule and return the rule index. */
@@ -1392,6 +1420,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
             case RULE_ACCUMULATE:
             case RULE_GROUP:
             case RULE_CAPTURE:
+            case RULE_UNREF:
                 /* [rule, tag] */
                 if (rule[1] >= blen) goto bad;
                 op_flags[rule[1]] |= 0x01;

src/core/pp.c

@@ -351,6 +351,9 @@ struct pretty {
     int indent;
     int flags;
     int32_t bufstartlen;
+    int32_t *keysort_buffer;
+    int32_t keysort_capacity;
+    int32_t keysort_start;
     JanetTable seen;
 };
 
@@ -594,31 +597,55 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                 janet_buffer_push_cstring(S->buffer, "...");
             } else {
                 int32_t i = 0, len = 0, cap = 0;
-                int first_kv_pair = 1;
                 const JanetKV *kvs = NULL;
-                int counter = 0;
                 janet_dictionary_view(x, &kvs, &len, &cap);
                 if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
                     janet_buffer_push_u8(S->buffer, ' ');
                 if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
-                for (i = 0; i < cap; i++) {
-                    if (!janet_checktype(kvs[i].key, JANET_NIL)) {
-                        if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
-                            print_newline(S, 0);
-                            janet_buffer_push_cstring(S->buffer, "...");
-                            break;
-                        }
-                        if (first_kv_pair) {
-                            first_kv_pair = 0;
-                        } else {
-                            print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
-                        }
-                        janet_pretty_one(S, kvs[i].key, 0);
-                        janet_buffer_push_u8(S->buffer, ' ');
-                        janet_pretty_one(S, kvs[i].value, 1);
-                        counter++;
+                int32_t ks_start = S->keysort_start;
+
+                /* Ensure buffer is large enough to sort keys. */
+                int truncated = 0;
+                int64_t mincap = (int64_t) len + (int64_t) ks_start;
+                if (mincap > INT32_MAX) {
+                    truncated = 1;
+                    len = 0;
+                    mincap = ks_start;
+                }
+
+                if (S->keysort_capacity < mincap) {
+                    if (mincap >= INT32_MAX / 2) {
+                        S->keysort_capacity = INT32_MAX;
+                    } else {
+                        S->keysort_capacity = mincap * 2;
+                    }
+                    S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
+                    if (NULL == S->keysort_buffer) {
+                        JANET_OUT_OF_MEMORY;
                     }
                 }
+
+                janet_sorted_keys(kvs, cap, S->keysort_buffer + ks_start);
+                S->keysort_start += len;
+                if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
+                    len = JANET_PRETTY_DICT_LIMIT;
+                    truncated = 1;
+                }
+
+                for (i = 0; i < len; i++) {
+                    if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
+                    int32_t j = S->keysort_buffer[i + ks_start];
+                    janet_pretty_one(S, kvs[j].key, 0);
+                    janet_buffer_push_u8(S->buffer, ' ');
+                    janet_pretty_one(S, kvs[j].value, 1);
+                }
+
+                if (truncated) {
+                    print_newline(S, 0);
+                    janet_buffer_push_cstring(S->buffer, "...");
+                }
+
+                S->keysort_start = ks_start;
             }
             S->indent -= 2;
             S->depth++;
@@ -641,6 +668,9 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
     S.indent = 0;
     S.flags = flags;
     S.bufstartlen = startlen;
+    S.keysort_capacity = 0;
+    S.keysort_buffer = NULL;
+    S.keysort_start = 0;
     janet_table_init(&S.seen, 10);
     janet_pretty_one(&S, x, 0);
     janet_table_deinit(&S.seen);
@@ -663,6 +693,9 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
     S.indent = 0;
     S.flags = 0;
     S.bufstartlen = startlen;
+    S.keysort_capacity = 0;
+    S.keysort_buffer = NULL;
+    S.keysort_start = 0;
     janet_table_init(&S.seen, 10);
     int res = print_jdn_one(&S, x, depth);
     janet_table_deinit(&S.seen);
@@ -822,7 +855,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
                 case 'P':
                 case 'p': { /* janet pretty , precision = depth */
                     int depth = atoi(precision);
-                    if (depth < 1) depth = 4;
+                    if (depth < 1) depth = JANET_RECURSION_GUARD;
                     char d = c[-1];
                     int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
                     int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
@@ -974,7 +1007,7 @@ void janet_buffer_format(
                 case 'P':
                 case 'p': { /* janet pretty , precision = depth */
                     int depth = atoi(precision);
-                    if (depth < 1) depth = 4;
+                    if (depth < 1) depth = JANET_RECURSION_GUARD;
                     char d = strfrmt[-1];
                     int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
                     int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');

src/core/thread.c

@@ -84,6 +84,9 @@ static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
 static JanetTable *janet_thread_get_decode(void) {
     if (janet_vm_thread_decode == NULL) {
         janet_vm_thread_decode = janet_get_core_table("load-image-dict");
+        if (NULL == janet_vm_thread_decode) {
+            janet_vm_thread_decode = janet_table(0);
+        }
         janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
     }
     return janet_vm_thread_decode;

src/core/util.c

@@ -602,6 +602,38 @@ JanetTable *janet_get_core_table(const char *name) {
     return janet_unwrap_table(out);
 }
 
+/* Sort keys of a dictionary type */
+int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer) {
+
+    /* First, put populated indices into index_buffer */
+    int32_t next_index = 0;
+    for (int32_t i = 0; i < cap; i++) {
+        if (!janet_checktype(dict[i].key, JANET_NIL)) {
+            index_buffer[next_index++] = i;
+        }
+    }
+
+    /* Next, sort those (simple insertion sort here for now) */
+    for (int32_t i = 1; i < next_index; i++) {
+        int32_t index_to_insert = index_buffer[i];
+        Janet lhs = dict[index_to_insert].key;
+        for (int32_t j = i - 1; j >= 0; j--) {
+            index_buffer[j + 1] = index_buffer[j];
+            Janet rhs = dict[index_buffer[j]].key;
+            if (janet_compare(lhs, rhs) >= 0) {
+                index_buffer[j + 1] = index_to_insert;
+                break;
+            } else if (j == 0) {
+                index_buffer[0] = index_to_insert;
+            }
+        }
+    }
+
+    /* Return number of indices found */
+    return next_index;
+
+}
+
 /* Clock shims for various platforms */
 #ifdef JANET_GETTIME
 /* For macos */

src/core/util.h

@@ -108,6 +108,11 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
 int janet_gettime(struct timespec *spec);
 #endif
 
+/* strdup */
+#ifdef JANET_WINDOWS
+#define strdup(x) _strdup(x)
+#endif
+
 #define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
 
 /* Initialize builtin libraries */

src/core/value.c

@@ -307,18 +307,14 @@ int32_t janet_hash(Janet x) {
             hash = janet_struct_hash(janet_unwrap_struct(x));
             break;
         case JANET_NUMBER: {
-            double num = janet_unwrap_number(x);
-            if (isnan(num) || isinf(num) || num == 0) {
-                hash = 0;
-            } else {
-                hash = (int32_t)num;
-                hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
-                hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
-                hash = (hash >> 16) ^ hash;
-
-                uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
-                hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
-            }
+            union {
+                double d;
+                uint64_t u;
+            } as;
+            as.d = janet_unwrap_number(x);
+            uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
+            uint32_t hi = (uint32_t)(as.u >> 32);
+            hash = (int32_t)(hi ^ (lo >> 3));
             break;
         }
         case JANET_ABSTRACT: {

src/core/vm.c

@@ -202,6 +202,20 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
             vm_checkgc_pcnext();\
         }\
     }
+#define vm_compop_imm(op) \
+    {\
+        Janet op1 = stack[B];\
+        if (janet_checktype(op1, JANET_NUMBER)) {\
+            double x1 = janet_unwrap_number(op1);\
+            double x2 = (double) CS; \
+            stack[A] = janet_wrap_boolean(x1 op x2);\
+            vm_pcnext();\
+        } else {\
+            vm_commit();\
+            stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
+            vm_checkgc_pcnext();\
+        }\
+    }
 
 /* Trace a function call */
 static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
@@ -780,8 +794,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_compop( <=);
 
     VM_OP(JOP_LESS_THAN_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
-    vm_pcnext();
+    vm_compop_imm( <);
 
     VM_OP(JOP_GREATER_THAN)
     vm_compop( >);
@@ -790,15 +803,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_compop( >=);
 
     VM_OP(JOP_GREATER_THAN_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
-    vm_pcnext();
+    vm_compop_imm( >);
 
     VM_OP(JOP_EQUALS)
     stack[A] = janet_wrap_boolean(janet_equals(stack[B], stack[C]));
     vm_pcnext();
 
     VM_OP(JOP_EQUALS_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
+    stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
     vm_pcnext();
 
     VM_OP(JOP_NOT_EQUALS)
@@ -806,7 +818,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
     vm_pcnext();
 
     VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
-    stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
+    stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
     vm_pcnext();
 
     VM_OP(JOP_COMPARE)
@@ -1276,7 +1288,14 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
     /* Push frame */
     janet_fiber_pushn(janet_vm_fiber, argv, argc);
     if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
-        janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
+        int32_t min = fun->def->min_arity;
+        int32_t max = fun->def->max_arity;
+        Janet funv = janet_wrap_function(fun);
+        if (min == max && min != argc)
+            janet_panicf("arity mismatch in %v, expected %d, got %d", funv, min, argc);
+        if (min >= 0 && argc < min)
+            janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
+        janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
     }
     janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
 
@@ -1359,6 +1378,7 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
         if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
         if (sig != JANET_SIGNAL_OK && !(child->flags & (1 << sig))) {
             *out = in;
+            janet_fiber_set_status(fiber, sig);
             return sig;
         }
         /* Check if we need any special handling for certain opcodes */
@@ -1398,23 +1418,23 @@ static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *o
 
     /* Save global state */
     JanetTryState tstate;
-    JanetSignal signal = janet_try(&tstate);
-    if (!signal) {
+    JanetSignal sig = janet_try(&tstate);
+    if (!sig) {
         /* Normal setup */
         if (janet_vm_root_fiber == NULL) janet_vm_root_fiber = fiber;
         janet_vm_fiber = fiber;
         janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
-        signal = run_vm(fiber, in);
+        sig = run_vm(fiber, in);
     }
 
     /* Restore */
     if (janet_vm_root_fiber == fiber) janet_vm_root_fiber = NULL;
-    janet_fiber_set_status(fiber, signal);
+    janet_fiber_set_status(fiber, sig);
     janet_restore(&tstate);
     fiber->last_value = tstate.payload;
     *out = tstate.payload;
 
-    return signal;
+    return sig;
 }
 
 /* Enter the main vm loop */

src/include/janet.h

@@ -1367,6 +1367,7 @@ JANET_API void janet_parser_deinit(JanetParser *parser);
 JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
 JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
 JANET_API Janet janet_parser_produce(JanetParser *parser);
+JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
 JANET_API const char *janet_parser_error(JanetParser *parser);
 JANET_API void janet_parser_flush(JanetParser *parser);
 JANET_API void janet_parser_eof(JanetParser *parser);
@@ -1406,6 +1407,7 @@ JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetS
 
 /* Get the default environment for janet */
 JANET_API JanetTable *janet_core_env(JanetTable *replacements);
+JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
 
 JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
 JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
@@ -1628,6 +1630,7 @@ JANET_API Janet janet_wrap_number_safe(double x);
 JANET_API int janet_keyeq(Janet x, const char *cstring);
 JANET_API int janet_streq(Janet x, const char *cstring);
 JANET_API int janet_symeq(Janet x, const char *cstring);
+JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
 
 /* VM functions */
 JANET_API int janet_init(void);
@@ -1839,7 +1842,8 @@ typedef enum {
     RULE_LENPREFIX,    /* [rule_a, rule_b (repeat rule_b rule_a times)] */
     RULE_READINT,      /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
     RULE_LINE,         /* [tag] */
-    RULE_COLUMN        /* [tag] */
+    RULE_COLUMN,       /* [tag] */
+    RULE_UNREF         /* [rule, tag] */
 } JanetPegOpcod;
 
 typedef struct {

src/mainclient/shell.c

@@ -1042,19 +1042,23 @@ int main(int argc, char **argv) {
     janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
 
     /* Run startup script */
-    Janet mainfun, out;
+    Janet mainfun;
     janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
     Janet mainargs[1] = { janet_wrap_array(args) };
     JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
     fiber->env = env;
+
+#ifdef JANET_EV
+    janet_gcroot(janet_wrap_fiber(fiber));
+    janet_schedule(fiber, janet_wrap_nil());
+    janet_loop();
+    status = janet_fiber_status(fiber);
+#else
+    Janet out;
     status = janet_continue(fiber, janet_wrap_nil(), &out);
     if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
         janet_stacktrace(fiber, out);
     }
-
-#ifdef JANET_EV
-    status = JANET_SIGNAL_OK;
-    janet_loop();
 #endif
 
     /* Deinitialize vm */

test/suite0001.janet

@@ -294,4 +294,25 @@
           (sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99))))) "sort 5")
 (assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
 
+# And and or
+
+(assert (= (and true true) true) "and true true")
+(assert (= (and true false) false) "and true false")
+(assert (= (and false true) false) "and false true")
+(assert (= (and true true true) true) "and true true true")
+(assert (= (and 0 1 2) 2) "and 0 1 2")
+(assert (= (and 0 1 nil) nil) "and 0 1 nil")
+(assert (= (and 1) 1) "and 1")
+(assert (= (and) true) "and with no arguments")
+
+(assert (= (or true true) true) "or true true")
+(assert (= (or true false) true) "or true false")
+(assert (= (or false true) true) "or false true")
+(assert (= (or false false) false) "or false true")
+(assert (= (or true true false) true) "or true true false")
+(assert (= (or 0 1 2) 0) "or 0 1 2")
+(assert (= (or nil 1 2) 1) "or nil 1 2")
+(assert (= (or 1) 1) "or 1")
+(assert (= (or) nil) "or with no arguments")
+
 (end-suite)

test/suite0003.janet

@@ -473,4 +473,24 @@
 
 (check-deep '(* (int 2) -1) "123" nil)
 
+# to/thru bug
+(check-deep '(to -1) "aaaa" @[])
+(check-deep '(thru -1) "aaaa" @[])
+(check-deep ''(to -1) "aaaa" @["aaaa"])
+(check-deep ''(thru -1) "aaaa" @["aaaa"])
+(check-deep '(to "b") "aaaa" nil)
+(check-deep '(thru "b") "aaaa" nil)
+
+# unref
+(def grammar
+  (peg/compile
+    ~{:main (* :tagged -1)
+      :tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
+      :open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
+      :value (* (constant :value) (group (any (+ :tagged :untagged))))
+      :close-tag (* "</" (backmatch :tag-name) ">")
+      :untagged (capture (any (if-not "<" 1)))}))
+(check-deep grammar "<p><em>foobar</em></p>" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
+(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
+
 (end-suite)

test/suite0010.janet

@@ -137,4 +137,28 @@
 (assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
 (assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
 
+# Comparisons
+(assert (> 1e23 100) "less than immediate 1")
+(assert (> 1e23 1000) "less than immediate 2")
+(assert (< 100 1e23) "greater than immediate 1")
+(assert (< 1000 1e23) "greater than immediate 2")
+
+# os/execute with environment variables
+(assert (= 0 (os/execute [(dyn :executable) "-e" "(+ 1 2 3)"] :pe {"HELLO" "WORLD"})) "os/execute with env")
+
+# Regression #638
+(compwhen
+  (dyn 'ev/go)
+  (assert
+    (= [true :caught]
+       (protect
+         (try
+           (do
+             (ev/sleep 0)
+             (with-dyns []
+               (ev/sleep 0)
+               (error "oops")))
+           ([err] :caught))))
+    "regression #638"))
+
 (end-suite)