Prepare for 1.16.1 release.

Rename level const to not to shadow line in eval1

.gitignore

@@ -32,8 +32,9 @@ lockfile.janet
 # Local directory for testing
 local
 
-# Common test file I use.
+# Common test files I use.
 temp.janet
+scratch.janet
 
 # Emscripten
 *.bc

.travis.yml

@@ -4,7 +4,7 @@ script:
 - make test
 - sudo make install
 - make test-install
-- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
+- JANET_DIST_DIR=janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME} make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
 compiler:
 - clang
 - gcc

CHANGELOG.md

@@ -1,6 +1,55 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 1.16.1 - 2021-06-09
+- Add `maclintf` - a utility for adding linting messages when inside macros.
+- Print source code of offending line on compiler warnings and errors.
+- Fix some issues with linting and re-add missing `make docs`.
+- Allow controlling linting with dynamic bindings `:lint-warn`, `:lint-error`, and `:lint-levels`.
+- Add `-w` and `-x` command line flags to the `janet` binary to set linting thresholds.
+  linting thresholds are as follows:
+    - :none - will never be trigger.
+    - :relaxed - will only trigger on `:relaxed` lints.
+    - :normal - will trigger on `:relaxed` and `:normal` lints.
+    - :strict - will trigger on `:strict`, `:normal`, and `:relaxed` lints. This will catch the most issues
+      but can be distracting.
+
+## 1.16.0 - 2021-05-30
+- Add color documentation to the `doc` macro - enable/disable with `(dyn :doc-color)`.
+- Remove simpler HTML docs from distribution - use website or built-in documentation instead.
+- Add compiler warnings and deprecation levels.
+- Add `as-macro` to make using macros within quasiquote easier to do hygienically.
+- Expose `JANET_OUT_OF_MEMORY` as part of the Janet API.
+- Add `native-deps` option to `decalre-native` in `jpm`. This lets native libraries link to other
+  native libraries when building with jpm.
+- Remove the `tarray` module. The functionality of typed arrays will be moved to an external module
+  that can be installed via `jpm`.
+- Add `from-pairs` to core.
+- Add `JPM_OS_WHICH` environment variable to jpm to allow changing auto-detection behavior.
+- The flychecker will consider any top-level calls of functions that start with `define-` to
+  be safe to execute and execute them. This allows certain patterns (like spork/path) to be
+  better processed by the flychecker.
+
+## 1.15.5 - 2021-04-25
+- Add `declare-headers` to jpm.
+- Fix error using unix pipes on BSDs.
+- Support .cc and .cxx extensions in `jpm` for C++ code.
+- Change networking code to not create as many HUP errors.
+- Add `net/shutdown` to close sockets in one direction without hang ups.
+- Update code for printing the debug repl
+
+## 1.15.4 - 2021-03-16
+- 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.

CONTRIBUTING.md

@@ -14,7 +14,6 @@ Please read this document before making contributions.
   on how to reproduce it. If it is a compiler or language bug, please try to include a minimal
   example. This means don't post all 200 lines of code from your project, but spend some time
   distilling the problem to just the relevant code.
-* Add the `bug` tag to the issue.
 
 ## Contributing Changes
 
@@ -30,8 +29,7 @@ may require changes before being merged.
   the test folder and make sure it is run when`make test` is invoked.
 * Be consistent with the style. For C this means follow the indentation and style in
   other files (files have MIT license at top, 4 spaces indentation, no trailing
-          whitespace, cuddled brackets, etc.) Use `make format` to
-  automatically format your C code with
+  whitespace, cuddled brackets, etc.) Use `make format` to automatically format your C code with
   [astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
   to install this, but it can be installed with most package managers.
 
@@ -75,4 +73,3 @@ timely manner. In short, if you want extra functionality now, then build it.
 
 * Include a good description of the problem that is being solved
 * Include descriptions of potential solutions if you have some in mind.
-* Add the appropriate tags to the issue. For new features, add the `enhancement` tag.

LICENSE

@@ -1,4 +1,4 @@
-Copyright (c) 2020 Calvin Rose and contributors
+Copyright (c) 2021 Calvin Rose and contributors
 
 Permission is hereby granted, free of charge, to any person obtaining a copy of
 this software and associated documentation files (the "Software"), to deal in

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
@@ -35,6 +35,7 @@ JANET_STATIC_LIBRARY=build/libjanet.a
 JANET_PATH?=$(LIBDIR)/janet
 JANET_MANPATH?=$(PREFIX)/share/man/man1/
 JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
+JANET_DIST_DIR?=janet-dist
 DEBUGGER=gdb
 SONAME_SETTER=-Wl,-soname,
 
@@ -119,7 +120,6 @@ JANET_CORE_SOURCES=src/core/abstract.c \
 				   src/core/table.c \
 				   src/core/thread.c \
 				   src/core/tuple.c \
-				   src/core/typedarray.c \
 				   src/core/util.c \
 				   src/core/value.c \
 				   src/core/vector.c \
@@ -157,7 +157,7 @@ build/c/janet.c: build/janet_boot src/boot/boot.janet
 ##### Amalgamation #####
 ########################
 
-SONAME=libjanet.so.1.15
+SONAME=libjanet.so.1.16
 
 build/c/shell.c: src/mainclient/shell.c
 	cp $< $@
@@ -224,11 +224,20 @@ 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/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)/
-	cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
+	README.md build/c/janet.c build/c/shell.c jpm
+	mkdir -p build/$(JANET_DIST_DIR)/bin
+	cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
+	cp jpm build/$(JANET_DIST_DIR)/bin/
+	mkdir -p build/$(JANET_DIST_DIR)/include
+	cp build/janet.h build/$(JANET_DIST_DIR)/include/
+	mkdir -p build/$(JANET_DIST_DIR)/lib/
+	cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
+	mkdir -p build/$(JANET_DIST_DIR)/man/man1/
+	cp janet.1 jpm.1 build/$(JANET_DIST_DIR)/man/man1/
+	mkdir -p build/$(JANET_DIST_DIR)/src/
+	cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
+	cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
+	cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
 
 #########################
 ##### Documentation #####

README.md

@@ -17,6 +17,9 @@ to run script files. This client program is separate from the core runtime, so
 Janet can be embedded in other programs. Try Janet in your browser at
 [https://janet-lang.org](https://janet-lang.org).
 
+If you'd like to financially support the ongoing development of Janet, consider
+[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
+
 <br>
 
 ## Use Cases
@@ -170,7 +173,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
 
 ## Installation
 
-See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
+See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
 to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
 
 ## Usage
@@ -231,7 +234,7 @@ See the examples directory for some example janet code.
 ## Discussion
 
 Feel free to ask questions and join the discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
-Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
+Gitter provides Matrix and irc bridges as well.
 
 ## FAQ
 
@@ -243,8 +246,35 @@ will not. If your terminal does not support ANSI escape codes, run the REPL with
 the `-n` flag, which disables color output. You can also try the `-s` if further issues
 ensue.
 
-## Why Janet
+### Where is (favorite feature from other language)?
+
+It may exist, it may not. If you want to propose major language features, go ahead and open an issue, but
+they will likely by closed as "will not implement". Often, such features make one usecase simpler at the expense
+of 5 others by making the language more complicated.
+
+### Where is the example code?
+
+In the examples directory.
+
+### Is this a Clojure port?
+
+No. It's similar to Clojure superficially because I like Lisps and I like the asthetics.
+Internally, Janet is not at all like Clojure.
+
+### Are the immutable data structures (tuples and structs) implemented as hash tries?
+
+No. They are immutable arrays and hash tables. Don't try and use them like Clojure's vectors
+and maps, instead they work well as table keys or other identifiers.
+
+### Why can't we add (feature from Clojure) into the core?
+
+Usually, one of a few reasons:
+- Often, it already exists in a different form and the Clojure port would be redundant.
+- Clojure programs often generate a lot of garbage and rely on the JVM to clean it up.
+  Janet does not run on the JVM. We admittedly have a much more primitive GC.
+- We want to keep the Janet core small. With Lisps, usually a feature can be added as a library
+  without feeling "bolted on", especially when compared to ALGOL like languages.
+
+## Why is it called "Janet"?
 
 Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
-
-<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">

examples/numarray/numarray.c

@@ -7,13 +7,13 @@ typedef struct {
 } num_array;
 
 static num_array *num_array_init(num_array *array, size_t size) {
-    array->data = (double *)calloc(size, sizeof(double));
+    array->data = (double *)janet_calloc(size, sizeof(double));
     array->size = size;
     return array;
 }
 
 static void num_array_deinit(num_array *array) {
-    free(array->data);
+    janet_free(array->data);
 }
 
 static int num_array_gc(void *p, size_t s) {

examples/tarray.janet

@@ -1,73 +0,0 @@
-# naive matrix implementation for testing typed array
-
-(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
-
-(defn matrix/row [mat i]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (tarray/new :float64 ncol 1 (* i ncol)  array))
-
-(defn matrix/column [mat j]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (tarray/new :float64 nrow ncol j array))
-
-(defn matrix/set [mat i j value]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (set (array (+ (* i ncol) j)) value))
-
-(defn matrix/get [mat i j value]
-  (def {:nrow nrow :ncol ncol :array array} mat)
-  (array (+ (* i ncol) j)))
-
-
-# other variants to test rows and cols views
-
-(defn matrix/set* [mat i j value]
-  (set ((matrix/row mat i) j) value))
-
-(defn matrix/set** [mat i j value]
-  (set ((matrix/column mat j) i) value))
-
-
-(defn matrix/get* [mat i j value]
-  ((matrix/row mat i) j))
-
-(defn matrix/get** [mat i j value]
-  ((matrix/column mat j) i))
-
-
-(defn tarray/print [arr]
-  (def size (tarray/length arr))
-  (prinf "[%2i]" size)
-  (for i 0 size
-    (prinf " %+6.3f " (arr i)))
-  (print))
-
-(defn matrix/print [mat]
-  (def {:nrow nrow :ncol ncol :array tarray} mat)
-  (printf "matrix %iX%i %p" nrow ncol tarray)
-  (for i 0 nrow
-    (tarray/print (matrix/row mat i))))
-
-
-(def nr 5)
-(def nc 4)
-(def A (matrix nr nc))
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set A i j i))
-(matrix/print A)
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set* A i j i))
-(matrix/print A)
-
-(loop (i :range (0 nr) j :range (0 nc)) 
-  (matrix/set** A i j i))
-(matrix/print A)
-
-
-(printf "properties:\n%p" (tarray/properties (A :array)))
-(for i 0 nr  
-  (printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
-(for i 0 nc  
-  (printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))

janet.1

@@ -8,6 +8,8 @@ janet \- run the Janet language abstract machine
 [\fB\-l\fR \fIMODULE\fR]
 [\fB\-m\fR \fIPATH\fR]
 [\fB\-c\fR \fIMODULE JIMAGE\fR]
+[\fB\-w\fR \fILEVEL\fR]
+[\fB\-x\fR \fILEVEL\fR]
 [\fB\-\-\fR]
 .BR script
 .BR args ...
@@ -210,7 +212,18 @@ resulting image. Output should usually end with the .jimage extension.
 Import a Janet module before running a script or repl. Multiple files can be loaded
 in this manner, and exports from each file will be made available to the script
 or repl.
-
+.TP
+.BR \-w\ level
+Set the warning linting level for Janet.
+This linting level should be one of :relaxed, :none, :strict, :normal, or a
+Janet number. Any linting message that is of a greater lint level than this setting will be displayed as
+a warning, but not stop compilation or execution.
+.TP
+.BR \-x\ level
+Set the error linting level for Janet.
+This linting level should be one of :relaxed, :none, :strict, :normal, or a
+Janet number. Any linting message that is of a greater lint level will cause a compilation error
+and stop compilation.
 .TP
 .BR \-\-
 Stop parsing command line arguments. All arguments after this one will be considered file names

jpm

@@ -6,14 +6,21 @@
 # Basic Path Settings
 #
 
-# Windows is the OS outlier
-(def- is-win (= (os/which) :windows))
-(def- is-mac (= (os/which) :macos))
-(def- sep (if is-win "\\" "/"))
-(def- objext (if is-win ".obj" ".o"))
-(def- modext (if is-win ".dll" ".so"))
-(def- statext (if is-win ".static.lib" ".a"))
-(def- absprefix (if is-win "C:\\" "/"))
+# Allow changing the behavior via an environment variable
+(def- host-os (keyword (string/ascii-lower (os/getenv "JPM_OS_WHICH" (os/which)))))
+(defn- define-utils
+  []
+  (def is-win (= host-os :windows))
+  (defglobal 'is-win is-win)
+  (defglobal 'is-mac (= host-os :macos))
+  (def sep (if is-win "\\" "/"))
+  (defglobal 'sep sep)
+  (defglobal 'objext (if is-win ".obj" ".o"))
+  (defglobal 'modext (if is-win ".dll" ".so"))
+  (defglobal 'statext (if is-win ".static.lib" ".a"))
+  (defglobal 'absprefix (if is-win "C:\\" "/")))
+
+(define-utils)
 
 #
 # Defaults
@@ -44,15 +51,26 @@
 
 (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"))
    :libpath (try-real (string exe-dir "/../lib"))
    :binpath exe-dir})
 
+# If janetconf.h has been modified such that core janet functions and macros require
+# linking to external libraries, modify this.
+#
+# Example - (def- extra-lflags ["-lmimalloc"])
+
 ###END###
 
+# Redefine utils in case the above section is overriden on some installs.
+(define-utils)
+
+(compwhen (not (dyn 'extra-lflags))
+  (def- extra-lflags []))
+
 # Default based on janet binary location
 (def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
                           (get (install-paths) :headerpath)))
@@ -362,11 +380,11 @@
 # flags needed for the janet binary and compiling standalone
 # executables.
 (def janet-lflags
-  (case (os/which)
-    :macos ["-ldl" "-lm" ;thread-flags]
-    :windows [;thread-flags]
-    :linux ["-lm" "-ldl" "-lrt" ;thread-flags]
-    ["-lm" ;thread-flags]))
+  (case host-os
+    :macos ["-ldl" "-lm" ;thread-flags ;extra-lflags]
+    :windows [;thread-flags ;extra-lflags]
+    :linux ["-lm" "-ldl" "-lrt" ;thread-flags ;extra-lflags]
+    ["-lm" ;thread-flags ;extra-lflags]))
 (def janet-ldflags [])
 (def janet-cflags [])
 
@@ -452,6 +470,7 @@
   [opts]
   @[;(opt opts :cflags default-cflags)
     (string "-I" (dyn :headerpath JANET_HEADERPATH))
+    (string "-I" (dyn :modpath JANET_MODPATH))
     (string "-O" (opt opts :optimize 2))])
 
 (defn- getcppflags
@@ -459,6 +478,7 @@
   [opts]
   @[;(opt opts :cppflags default-cppflags)
     (string "-I" (dyn :headerpath JANET_HEADERPATH))
+    (string "-I" (dyn :modpath JANET_MODPATH))
     (string "-O" (opt opts :optimize 2))])
 
 (defn- entry-name
@@ -521,35 +541,26 @@
   (string hpath `\\janet.lib`))
 
 (defn- link-c
-  "Link C object files together to make a native module."
-  [opts target & objects]
-  (def linker (opt opts (if is-win :linker :compiler) default-linker))
-  (def cflags (getcflags opts))
+  "Link C or C++ object files together to make a native module."
+  [has-cpp opts target & objects]
+  (def linker
+    (if has-cpp
+      (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker)
+      (opt opts (if is-win :linker :compiler) default-linker)))
+  (def cflags ((if has-cpp getcppflags getcflags) opts))
   (def lflags [;(opt opts :lflags default-lflags)
                ;(if (opts :static) [] dynamic-lflags)])
-  (def ldflags [;(opt opts :ldflags [])])
+  (def deplibs (get opts :native-deps []))
+  (def dep-ldflags (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x modext)))
+  # Use import libs on windows - we need an import lib to link natives to other natives.
+  (def dep-importlibs (seq [x :in deplibs] (string (dyn :modpath JANET_MODPATH) sep x ".lib")))
+  (def ldflags [;(opt opts :ldflags []) ;dep-ldflags])
   (rule target objects
         (check-cc)
         (print "linking " target "...")
         (create-dirs target)
         (if is-win
-          (shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
-          (shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
-
-(defn- link-cpp
-  "Link C++ object files together to make a native module."
-  [opts target & objects]
-  (def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
-  (def cflags (getcppflags opts))
-  (def lflags [;(opt opts :lflags default-lflags)
-               ;(if (opts :static) [] dynamic-lflags)])
-  (def ldflags [;(opt opts :ldflags [])])
-  (rule target objects
-        (check-cc)
-        (print "linking " target "...")
-        (create-dirs target)
-        (if is-win
-          (shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
+          (shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;dep-importlibs ;lflags)
           (shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
 
 (defn- archive-c
@@ -968,17 +979,18 @@ int main(int argc, const char **argv) {
   (var has-cpp false)
   (def objects
     (seq [src :in sources]
-      (cond
-        (string/has-suffix? ".cpp" src)
-        (let [op (out-path src ".cpp" objext)]
-          (compile-cpp opts src op)
-          (set has-cpp true)
-          op)
-        (string/has-suffix? ".c" src)
-        (let [op (out-path src ".c" objext)]
-          (compile-c opts src op)
-          op)
-        (errorf "unknown source file type: %s, expected .c or .cpp" src))))
+      (def suffix
+        (cond
+          (string/has-suffix? ".cpp" src) ".cpp"
+          (string/has-suffix? ".cc" src) ".cc"
+          (string/has-suffix? ".c" src) ".c"
+          (errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
+      (def op (out-path src suffix objext))
+      (if (= suffix ".c")
+        (compile-c opts src op)
+        (do (compile-cpp opts src op)
+          (set has-cpp true)))
+      op))
 
   (when-let [embedded (opts :embedded)]
     (loop [src :in embedded]
@@ -987,7 +999,7 @@ int main(int argc, const char **argv) {
       (array/push objects o-src)
       (create-buffer-c src c-src (embed-name src))
       (compile-c opts c-src o-src)))
-  ((if has-cpp link-cpp link-c) opts lname ;objects)
+  (link-c has-cpp opts lname ;objects)
   (add-dep "build" lname)
   (install-rule lname path)
 
@@ -1016,16 +1028,17 @@ int main(int argc, const char **argv) {
     # Get static objects
     (def sobjects
       (seq [src :in sources]
-        (cond
-          (string/has-suffix? ".cpp" src)
-          (let [op (out-path src ".cpp" sobjext)]
-            (compile-cpp opts src op true)
-            op)
-          (string/has-suffix? ".c" src)
-          (let [op (out-path src ".c" sobjext)]
-            (compile-c opts src op true)
-            op)
-          (errorf "unknown source file type: %s, expected .c or .cpp"))))
+        (def suffix
+          (cond
+            (string/has-suffix? ".cpp" src) ".cpp"
+            (string/has-suffix? ".cc" src) ".cc"
+            (string/has-suffix? ".c" src) ".c"
+            (errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
+        (def op (out-path src suffix sobjext))
+        (if (= suffix ".c")
+          (compile-c opts src op true)
+          (compile-cpp opts src op true))
+        op))
 
     (when-let [embedded (opts :embedded)]
       (loop [src :in embedded]
@@ -1051,6 +1064,16 @@ int main(int argc, const char **argv) {
     (each s sources
       (install-rule s path))))
 
+(defn declare-headers
+  "Declare headers for a library installation. Installed headers can be used by other native
+  libraries."
+  [&keys {:headers headers :prefix prefix}]
+  (def path (string (dyn :modpath JANET_MODPATH) (or prefix "")))
+  (if (bytes? headers)
+    (install-rule headers path)
+    (each h headers
+      (install-rule h path))))
+
 (defn declare-bin
   "Declare a generic file to be installed as an executable."
   [&keys {:main main}]
@@ -1080,12 +1103,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))
@@ -1097,7 +1123,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))))

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
@@ -265,5 +269,30 @@ An optional path to a git executable to use to clone git dependencies. By defaul
 if you have a normal install of git.
 .RE
 
+.B JPM_OS_WHICH
+.RS
+Use this option to override the C compiler and build system auto-detection for the host operating system. For example, set this
+environment variable to "posix" to make sure that on platforms like MinGW, you will use GCC instead of MSVC. On most platforms, users will not need to
+set this environment variable. Set this to one of the following
+strings:
+.IP
+\- windows
+.IP
+\- macos
+.IP
+\- linux
+.IP
+\- freebsd
+.IP
+\- openbsd
+.IP
+\- netbsd
+.IP
+\- bsd
+.IP
+\- posix
+.RE
+
+
 .SH AUTHOR
 Written by Calvin Rose <calsrose@gmail.com>

meson.build

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose and contributors
+# Copyright (c) 2021 Calvin Rose and contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -19,8 +19,8 @@
 # IN THE SOFTWARE.
 
 project('janet', 'c',
-  default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.15.2')
+  default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
+  version : '1.16.1')
 
 # 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
 
@@ -60,9 +60,8 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
 conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
 conf.set('JANET_NO_PEG', not get_option('peg'))
 conf.set('JANET_NO_NET', not get_option('net'))
-conf.set('JANET_NO_EV', not get_option('ev'))
+conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
 conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
-conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
 conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
 conf.set('JANET_PRF', get_option('prf'))
 conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
@@ -135,7 +134,6 @@ core_src = [
   'src/core/table.c',
   'src/core/thread.c',
   'src/core/tuple.c',
-  'src/core/typedarray.c',
   'src/core/util.c',
   'src/core/value.c',
   'src/core/vector.c',
@@ -173,9 +171,14 @@ janetc = custom_target('janetc',
     'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
   ])
 
+janet_dependencies = [m_dep, dl_dep]
+if not get_option('single_threaded')
+  janet_dependencies += thread_dep
+endif
+
 libjanet = library('janet', janetc,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : janet_dependencies,
   version: meson.project_version(),
   soversion: version_parts[0] + '.' + version_parts[1],
   install : true)
@@ -189,7 +192,7 @@ else
 endif
 janet_mainclient = executable('janet', janetc, mainclient_src,
   include_directories : incdir,
-  dependencies : [m_dep, dl_dep, thread_dep],
+  dependencies : janet_dependencies,
   c_args : extra_cflags,
   install : true)
 
@@ -202,7 +205,7 @@ if meson.is_cross_build()
   endif
   janet_nativeclient = executable('janet-native', janetc, mainclient_src,
     include_directories : incdir,
-    dependencies : [m_dep, dl_dep, thread_dep],
+    dependencies : janet_dependencies,
     c_args : extra_native_cflags,
     native : true)
 else
@@ -244,6 +247,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

meson_options.txt

@@ -8,7 +8,6 @@ option('sourcemaps', type : 'boolean', value : true)
 option('reduced_os', type : 'boolean', value : false)
 option('assembler', type : 'boolean', value : true)
 option('peg', type : 'boolean', value : true)
-option('typed_array', type : 'boolean', value : true)
 option('int_types', type : 'boolean', value : true)
 option('prf', type : 'boolean', value : false)
 option('net', type : 'boolean', value : true)

src/boot/array_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/boot/boot.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -93,7 +93,7 @@ int main(int argc, const char **argv) {
     fseek(boot_file, 0, SEEK_END);
     size_t boot_size = ftell(boot_file);
     fseek(boot_file, 0, SEEK_SET);
-    unsigned char *boot_buffer = malloc(boot_size);
+    unsigned char *boot_buffer = janet_malloc(boot_size);
     if (NULL == boot_buffer) {
         fprintf(stderr, "Failed to allocate boot buffer\n");
         exit(1);
@@ -105,7 +105,7 @@ int main(int argc, const char **argv) {
     fclose(boot_file);
 
     status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
-    free(boot_buffer);
+    janet_free(boot_buffer);
 
     /* Deinitialize vm */
     janet_deinit();

src/boot/boot.janet

@@ -1,5 +1,5 @@
 # The core janet library
-# Copyright 2020 © Calvin Rose
+# Copyright 2021 © Calvin Rose
 
 ###
 ###
@@ -47,6 +47,14 @@
   [name & more]
   (apply defn name :macro more))
 
+(defmacro as-macro
+  ``Use a function or macro literal `f` as a macro. This lets
+  any function be used as a macro. Inside a quasiquote, the
+  idiom `(as-macro ,my-custom-macro arg1 arg2...)` can be used
+  to avoid unwanted variable capture.``
+  [f & args]
+  (f ;args))
+
 (defmacro defmacro-
   "Define a private macro that will not be exported."
   [name & more]
@@ -530,19 +538,19 @@
   Where `binding` is a binding as passed to def, `:verb` is one of a set of
   keywords, and `object` is any expression. The available verbs are:
 
-  * :iterate -- repeatedly evaluate and bind to the expression while it is
+  * `:iterate` - repeatedly evaluate and bind to the expression while it is
     truthy.
-  * :range -- loop over a range. The object should be a two-element tuple with
+  * `:range` - loop over a range. The object should be a two-element tuple with
     a start and end value, and an optional positive step. The range is half
     open, [start, end).
-  * :range-to -- same as :range, but the range is inclusive [start, end].
-  * :down -- loop over a range, stepping downwards. The object should be a
+  * `:range-to` - same as :range, but the range is inclusive [start, end].
+  * `:down` - loop over a range, stepping downwards. The object should be a
     two-element tuple with a start and (exclusive) end value, and an optional
     (positive!) step size.
-  * :down-to -- same as :down, but the range is inclusive [start, end].
-  * :keys -- iterate over the keys in a data structure.
-  * :pairs -- iterate over the key-value pairs as tuples in a data structure.
-  * :in -- iterate over the values in a data structure or fiber.
+  * `:down-to` - same as :down, but the range is inclusive [start, end].
+  * `:keys` - iterate over the keys in a data structure.
+  * `:pairs` - iterate over the key-value pairs as tuples in a data structure.
+  * `:in` - iterate over the values in a data structure or fiber.
 
   `loop` also accepts conditionals to refine the looping further. Conditionals are of
   the form:
@@ -558,6 +566,7 @@
   * `:before form` - evaluates a form for a side effect before the next inner loop.
   * `:after form` - same as `:before`, but the side effect happens after the next inner loop.
   * `:repeat n` - repeats the next inner loop `n` times.
+    lets try putting a loop item on multiple lines.
   * `:when condition` - only evaluates the loop body when condition is true.
 
   The `loop` macro always evaluates to nil.
@@ -778,24 +787,28 @@
   a)
 
 (defn sort
-  "Sort an array in-place. Uses quick-sort and is not a stable sort."
-  [a &opt before?]
-  (sort-help a 0 (- (length a) 1) (or before? <)))
+  ``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 `ind` sorted by calling
-  a function `f` on each element and comparing the result with <.``
+  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."
+  ``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 `f` on each element and comparing the result with <.``
+  a function `f` on each element and comparing the result with `<`.``
   [f ind]
   (sorted ind (fn [x y] (< (f x) (f y)))))
 
@@ -1447,6 +1460,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]
@@ -1491,6 +1534,15 @@
   (loop [k :keys dict] (array/push ret k (in dict k)))
   ret)
 
+(defn from-pairs
+  ``Takes a sequence of pairs and creates a table from each pair. The inverse of
+  `pairs` on a table.``
+  [ps]
+  (def ret @{})
+  (each [k v] ps
+    (put ret k v))
+  ret)
+
 (defn interpose
   `Returns a sequence of the elements of ind separated by
   sep. Returns a new array.`
@@ -1732,9 +1784,23 @@
 ###
 ###
 
+(defn maclintf
+  ``When inside a macro, call this function to add a linter warning. Takes
+  a `fmt` argument like `string/format` which is used to format the message.``
+  [level fmt & args]
+  (def lints (dyn :macro-lints))
+  (when lints
+    (def form (dyn :macro-form))
+    (def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
+    (def l (if-not (= -1 l) l))
+    (def c (if-not (= -1 c) c))
+    (def msg (string/format fmt ;args))
+    (array/push lints [level l c msg]))
+  nil)
+
 (defn macex1
-  `Expand macros in a form, but do not recursively expand macros.
-  See macex docs for info on on-binding.`
+  ``Expand macros in a form, but do not recursively expand macros.
+  See `macex` docs for info on on-binding.``
   [x &opt on-binding]
 
   (when on-binding
@@ -2045,6 +2111,43 @@
     (if ec "\e[0m" ""))
   (eflush))
 
+(defn- print-line-col
+  "Print the source code at a line, column in a source file. If unable to open
+  the file, prints nothing."
+  [where line col]
+  (if-not line (break))
+  (when-with [f (file/open where :r)]
+    (def source-code (file/read f :all))
+    (var index 0)
+    (repeat (dec line)
+       (if-not index (break))
+       (set index (inc (string/find "\n" source-code index))))
+    (when index
+      (def line-end (string/find "\n" source-code index))
+      (eprint "  " (string/slice source-code index line-end))
+      (when col
+        (+= index col)
+        (eprint (string/repeat " " (inc col)) "^"))
+      (eflush))))
+
+(defn warn-compile
+  "Default handler for a compile warning"
+  [msg level where &opt line col]
+  (def ec (dyn :err-color))
+  (eprin
+    (if ec "\e[33m" "")
+    where
+    ":"
+    line
+    ":"
+    col
+    ": compile warning (" level "): ")
+  (eprint msg)
+  (when ec
+    (print-line-col where line col)
+    (eprin "\e[0m"))
+  (eflush))
+
 (defn bad-compile
   "Default handler for a compile error."
   [msg macrof where &opt line col]
@@ -2059,7 +2162,10 @@
     ": compile error: ")
   (if macrof
     (debug/stacktrace macrof msg)
-    (eprint msg (if ec "\e[0m" "")))
+    (eprint msg))
+  (when ec 
+    (print-line-col where line col)
+    (eprin "\e[0m"))
   (eflush))
 
 (defn curenv
@@ -2070,6 +2176,13 @@
   (if n (repeat n (if (= nil e) (break)) (set e (table/getproto e))))
   e)
 
+(def- lint-levels
+  {:none 0
+   :relaxed 1
+   :normal 2
+   :strict 3
+   :all math/inf})
+
 (defn run-context
   ```
   Run a context. This evaluates expressions in an environment,
@@ -2077,17 +2190,19 @@
   Returns (in environment :exit-value environment) when complete.
   opts is a table or struct of options. The options are as follows:
 
-    * :chunks - callback to read into a buffer - default is getline
-    * :on-parse-error - callback when parsing fails - default is bad-parse
-    * :env - the environment to compile against - default is the current env
-    * :source - string path of source for better errors - default is "<anonymous>"
-    * :on-compile-error - callback when compilation fails - default is bad-compile
-    * :evaluator - callback that executes thunks. Signature is (evaluator thunk source env where)
-    * :on-status - callback when a value is evaluated - default is debug/stacktrace.
-    * :fiber-flags - what flags to wrap the compilation fiber with. Default is :ia.
-    * :expander - an optional function that is called on each top level form before being compiled.
-    * :parser - provide a custom parser that implements the same interface as Janet's built-in parser.
-    * :read - optional function to get the next form, called like (read env source). Overrides all parsing.
+    * `:chunks` - callback to read into a buffer - default is getline
+    * `:on-parse-error` - callback when parsing fails - default is bad-parse
+    * `:env` - the environment to compile against - default is the current env
+    * `:source` - string path of source for better errors - default is "<anonymous>"
+    * `:on-compile-error` - callback when compilation fails - default is bad-compile
+    * `:on-compile-warning` - callback for any linting error - default is warn-compile
+    * `:evaluator` - callback that executes thunks. Signature is (evaluator thunk source env where)
+    * `:on-status` - callback when a value is evaluated - default is debug/stacktrace.
+    * `:fiber-flags` - what flags to wrap the compilation fiber with. Default is :ia.
+    * `:expander` - an optional function that is called on each top level form before being compiled.
+    * `:parser` - provide a custom parser that implements the same interface as Janet's built-in parser.
+    * `:read` - optional function to get the next form, called like `(read env source)`.
+      Overrides all parsing.
   ```
   [opts]
 
@@ -2095,10 +2210,11 @@
         :chunks chunks
         :on-status onstatus
         :on-compile-error on-compile-error
+        :on-compile-warning on-compile-warning
         :on-parse-error on-parse-error
         :fiber-flags guard
         :evaluator evaluator
-        :source where
+        :source default-where
         :parser parser
         :read read
         :expander expand} opts)
@@ -2106,12 +2222,16 @@
   (default chunks (fn [buf p] (getline "" buf env)))
   (default onstatus debug/stacktrace)
   (default on-compile-error bad-compile)
+  (default on-compile-warning warn-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
+  (def lints @[])
   (defn eval1 [source &opt l c]
     (def source (if expand (expand source) source))
     (var good true)
@@ -2119,13 +2239,29 @@
     (def f
       (fiber/new
         (fn []
-          (def res (compile source env where))
-          (if (= (type res) :function)
-            (evaluator res source env where)
-            (do
-              (set good false)
-              (def {:error err :line line :column column :fiber errf} res)
-              (on-compile-error err errf where (or line l) (or column c)))))
+          (array/clear lints)
+          (def res (compile source env where lints))
+          (unless (empty? lints)
+            # Convert lint levels to numbers.
+            (def levels (get env :lint-levels lint-levels))
+            (def lint-error (get env :lint-error))
+            (def lint-warning (get env :lint-warn))
+            (def lint-error (or (get levels lint-error lint-error) 0))
+            (def lint-warning (or (get levels lint-warning lint-warning) 2))
+            (each [level line col msg] lints
+              (def lvl (get lint-levels level 0))
+              (cond
+                (<= lvl lint-error) (do
+                                      (set good false)
+                                      (on-compile-error msg nil where (or line l) (or col c)))
+                (<= lvl lint-warning) (on-compile-warning msg level where (or line l) (or col c)))))
+          (when good
+            (if (= (type res) :function)
+              (evaluator res source env where)
+              (do
+                (set good false)
+                (def {:error err :line line :column column :fiber errf} res)
+                (on-compile-error err errf where (or line l) (or column c))))))
         guard))
     (fiber/setenv f env)
     (while (fiber/can-resume? f)
@@ -2163,11 +2299,18 @@
   (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)
@@ -2204,8 +2347,9 @@
   nil)
 
 (defn eval-string
-  `Evaluates a string in the current environment. If more control over the
-  environment is needed, use run-context.`
+  ``
+  Evaluates a string in the current environment. If more control over the
+  environment is needed, use `run-context`.``
   [str]
   (var state (string str))
   (defn chunks [buf _]
@@ -2229,8 +2373,8 @@
   returnval)
 
 (defn eval
-  `Evaluates a form in the current environment. If more control over the
-  environment is needed, use run-context.`
+  ``Evaluates a form in the current environment. If more control over the
+  environment is needed, use `run-context`.``
   [form]
   (def res (compile form (fiber/getenv (fiber/current)) "eval"))
   (if (= (type res) :function)
@@ -2290,6 +2434,7 @@
   (unmarshal image load-image-dict))
 
 (defn- check-relative [x] (if (string/has-prefix? "." x) x))
+(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
 (defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
 (defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
 
@@ -2336,7 +2481,7 @@
 (module/add-paths "/init.janet" :source)
 (module/add-paths ".janet" :source)
 (module/add-paths ".jimage" :image)
-(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep])
+(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-not-relative])
 
 # Version of fexists that works even with a reduced OS
 (defn- fexists
@@ -2584,229 +2729,255 @@
   `Reformat a docstring to wrap a certain width. Docstrings can either be plaintext
   or a subset of markdown. This allows a long single line of prose or formatted text to be
   a well-formed docstring. Returns a buffer containing the formatted text.`
-  [str &opt width indent]
+  [str &opt width indent colorize]
+
   (default indent 4)
   (def max-width (- (or width (dyn :doc-width 80)) 8))
-  (def len (length str))
-  (def res @"")
-  (var pos 0)
-  (def line @"")
-  (var line-width 0)
-  (def levels @[0])
-  (var leading 0)
-  (var c nil)
+  (def has-color (if (not= nil colorize)
+                   colorize
+                   (dyn :doc-color)))
 
-  (set pos 0)
+  # Terminal codes for emission/tokenization
+  (def delimiters
+    (if has-color
+      {:underline ["\e[4m" "\e[24m"]
+       :code ["\e[3;97m" "\e[39;23m"]
+       :italics ["\e[3m" "\e[23m"]
+       :bold ["\e[1m" "\e[22m"]}
+      {:underline ["_" "_"]
+       :code ["`" "`"]
+       :italics ["*" "*"]
+       :bold ["**" "**"]}))
+  (def modes @{})
+  (defn toggle [mode]
+    (def active (get modes mode))
+    (def delims (get delimiters mode))
+    (put modes mode (not active))
+    (delims (if active 1 0)))
 
-  (defn skip-line-indent []
-    (var pos* pos)
-    (set c (get str pos*))
-    (while (and c
-                (not= 10 c)
-                (= 32 c))
-      (set c (get str (++ pos*))))
-    (set leading (- pos* pos))
-    (set pos pos*))
+  # Parse state
+  (var cursor 0) # indexes into string for parsing
+  (var stack @[])  # return value for this block.
 
-  (defn update-levels []
-    (while (< leading (array/peek levels))
-      (array/pop levels)
-      (if (empty? levels) (break))))
+  # Traversal helpers
+  (defn c [] (get str cursor))
+  (defn cn [n] (get str (+ n cursor)))
+  (defn c++ [] (let [ret (get str cursor)] (++ cursor) ret))
+  (defn c+=n [n] (let [ret (get str cursor)] (+= cursor n) ret))
+  # skip* functions return number of characters matched and advance the cursor.
+  (defn skipwhite []
+    (def x cursor)
+    (while (= (c) (chr " ")) (++ cursor))
+    (- cursor x))
+  (defn skipline []
+    (def x cursor)
+    (while (let [y (c)] (and y (not= y (chr "\n")))) (++ cursor))
+    (c++)
+    (- cursor x))
 
-  (defn start-nl? []
-    (= 10 (get str pos)))
+  # Detection helpers - return number of characters natched
+  (defn ul? []
+    (let [x (c) x1 (cn 1)]
+      (and
+        (= x1 (chr " "))
+        (or (= x (chr "*")) (= x (chr "-")))
+        2)))
+  (defn ol? []
+    (def old cursor)
+    (while (and (>= (c) (chr "0")) (<= (c) (chr "9"))) (c++))
+    (let [c1 (c) c2 (cn 1) c* cursor]
+      (set cursor old)
+      (if (and (= c1 (chr ".")) (= c2 (chr " ")))
+        (- c* cursor -2))))
+  (defn fcb? [] (if (= (chr "`") (c) (cn 1) (cn 2)) 3))
+  (defn nl? [] (= (chr "\n") (c)))
 
-  (defn start-fcb? []
-    (and (= 96 (get str (+ pos)))
-         (= 96 (get str (+ pos 1)))
-         (= 96 (get str (+ pos 2)))))
+  # Parse helper
+  # parse-* functions push nodes to `stack`, and return
+  # the indentation they leave the cursor on.
 
-  (defn end-fcb? []
-    (and (= 96 (get str (+ pos)))
-         (= 96 (get str (+ pos 1)))
-         (= 96 (get str (+ pos 2)))
-         (= 10 (get str (+ pos 3)))))
+  (var parse-blocks nil) # mutual recursion
+  (defn getslice [from to]
+    (def to (min to (length str)))
+    (string/slice str from to))
+  (defn push [x] (array/push stack x))
 
-  (defn start-icb? []
-    (and (not= leading (array/peek levels))
-         (or (= 4 leading)
-             (= 4 (- leading (array/peek levels))))))
+  (defn parse-list [bullet-check initial indent]
+    (def temp-stack @[initial])
+    (def old-stack stack)
+    (set stack temp-stack)
+    (var current-indent indent)
+    (while (and (c) (>= current-indent indent))
+      (def item-indent
+        (when-let [x (bullet-check)]
+          (c+=n x)
+          (+ indent (skipwhite) x)))
+      (unless item-indent
+        (set current-indent (skipwhite))
+        (break))
+      (def item-stack @[])
+      (set stack item-stack)
+      (set current-indent (parse-blocks item-indent))
+      (set stack temp-stack)
+      (push item-stack))
+    (set stack old-stack)
+    (push temp-stack)
+    current-indent)
 
-  (defn start-ul? []
-    (var pos* pos)
-    (var c* (get str pos*))
-    (while (and c* (= 32 c*))
-      (set c* (get str (++ pos*))))
-    (and (or (= 42 c*)
-             (= 43 c*)
-             (= 45 c*))
-         (= 32 (get str (+ pos* 1)))))
+  (defn add-codeblock [indent start end]
+    (def replace-chunk (string "\n" (string/repeat " " indent)))
+    (push @[:cb (string/replace-all replace-chunk "\n" (getslice start end))])
+    (skipline)
+    (skipwhite))
 
-  (defn start-ol? []
-    (var pos* pos)
-    (var c* (get str pos*))
-    (while (and c* (= 32 c*))
-      (set c* (get str (++ pos*))))
-    (while (and c*
-                (<= 48 c*)
-                (>= 57 c*))
-      (set c* (get str (++ pos*))))
-    (set c* (get str (-- pos*)))
-    (and (<= 48 c*)
-         (>= 57 c*)
-         (= 46 (get str (+ pos* 1)))
-         (= 32 (get str (+ pos* 2)))))
+  (defn parse-fcb [indent]
+    (c+=n 3)
+    (skipline)
+    (c+=n indent)
+    (def start cursor)
+    (var end cursor)
+    (while (c)
+      (if (fcb?) (break))
+      (skipline)
+      (set end cursor)
+      (skipwhite))
+    (add-codeblock indent start end))
 
-  (defn push-line []
-    (buffer/push-string res (buffer/new-filled indent 32))
-    (set c (get str pos))
-    (while (and c (not= 10 c))
-      (buffer/push-byte res c)
-      (set c (get str (++ pos))))
-    (buffer/push-byte res 10)
-    (++ pos))
+  (defn parse-icb [indent]
+    (var current-indent indent)
+    (def start cursor)
+    (var end cursor)
+    (while (c)
+      (skipline)
+      (set end cursor)
+      (set current-indent (skipwhite))
+      (if (< current-indent indent) (break)))
+    (add-codeblock indent start end))
 
-  (defn push-bullet []
-    (var pos* pos)
-    (buffer/push-string line (buffer/new-filled leading 32))
-    (set c (get str pos*))
-    # Add bullet
-    (while (and c (not= 32 c))
-      (buffer/push-byte line c)
-      (set c (get str (++ pos*))))
-    # Add item indentation
-    (while (= 32 c)
-      (buffer/push-byte line c)
-      (set c (get str (++ pos*))))
-    # Record indentation if necessary
-    (def item-indent (+ leading (- pos* pos)))
-    (when (not= item-indent (array/peek levels))
-       (array/push levels item-indent))
-    # Update line width
-    (+= line-width item-indent)
-    # Update position
-    (set pos pos*))
+  (defn tokenize-line [line]
+    (def tokens @[])
+    (def token @"")
+    (var token-length 0)
+    (defn delim [mode]
+      (def d (toggle mode))
+      (if-not has-color (+= token-length (length d)))
+      (buffer/push token d))
+    (defn endtoken []
+      (if (first token) (array/push tokens [(string token) token-length]))
+      (buffer/clear token)
+      (set token-length 0))
+    (forv i 0 (length line)
+      (def b (get line i))
+      (cond
+        (or (= b (chr "\n")) (= b (chr " "))) (endtoken)
+        (= b (chr `\`)) (do
+                          (++ token-length)
+                          (buffer/push token (get line (++ i))))
+        (= b (chr "_")) (delim :underline)
+        (= b (chr "`")) (delim :code)
+        (= b (chr "*"))
+          (if (= (chr "*") (get line (+ i 1)))
+            (do (++ i)
+              (delim :bold))
+            (delim :italics))
+        (do (++ token-length) (buffer/push token b))))
+    (endtoken)
+    (tuple/slice tokens))
 
-  (defn push-word [hang-indent]
-    (def word @"")
-    (var word-len 0)
-    # Build a word
-    (while (and c
-                (not= 10 c)
-                (not= 32 c))
-      (buffer/push-byte word c)
-      (++ word-len)
-      (set c (get str (++ pos))))
-    # Start new line if necessary
-    (when (> (+ line-width word-len) max-width)
-      # Push existing line
-      (buffer/push-byte line 10)
-      (buffer/push-string res line)
-      (buffer/clear line)
-      # Indent new line
-      (buffer/push-string line (buffer/new-filled hang-indent 32))
-      (set line-width hang-indent))
-    # Add single space if not beginning of line
-    (when (not= line-width hang-indent)
-      (buffer/push-byte line 32)
-      (++ line-width))
-    # Push word onto line
-    (buffer/push-string line word)
-    (set line-width (+ line-width word-len)))
+  (set parse-blocks (fn parse-blocks [indent]
+    (var new-indent indent)
+    (var p-start nil)
+    (var p-end nil)
+    (defn p-line []
+      (unless p-start
+        (set p-start cursor))
+      (skipline)
+      (set p-end cursor)
+      (set new-indent (skipwhite)))
+    (defn finish-p []
+      (when (and p-start (> p-end p-start))
+        (push (tokenize-line (getslice p-start p-end)))
+        (set p-start nil)))
+    (while (and (c) (>= new-indent indent))
+      (cond
+        (nl?) (do (finish-p) (c++) (set new-indent (skipwhite)))
+        (ul?) (do (finish-p) (set new-indent (parse-list ul? :ul new-indent)))
+        (ol?) (do (finish-p) (set new-indent (parse-list ol? :ol new-indent)))
+        (fcb?) (do (finish-p) (set new-indent (parse-fcb new-indent)))
+        (>= new-indent (+ 4 indent)) (do (finish-p) (set new-indent (parse-icb new-indent)))
+        (p-line)))
+    (finish-p)
+    new-indent))
 
-  (defn push-nl []
-    (when (< pos len)
-      (buffer/push-byte res 10)
-      (++ pos)))
+  (parse-blocks 0)
 
-  (defn push-list []
-    (update-levels)
-    # Indent first line
-    (buffer/push-string line (buffer/new-filled indent 32))
-    (set line-width indent)
-    # Add bullet
-    (push-bullet)
-    # Add words
-    (set c (get str pos))
-    (while (and c
-                (not= 10 c))
-      # Skip spaces
-      (while (= 32 c)
-        (set c (get str (++ pos))))
-      # Add word
-      (push-word (+ indent (array/peek levels)))
-      (def old-c c)
-      (set c (get str (++ pos)))
-      # Check if next line is a new item
-      (when (and (= 10 old-c)
-                 (or (start-ul?)
-                     (start-ol?)))
-        (set c (get str (-- pos)))))
-    # Add final line
-    (buffer/push-string res line)
-    (buffer/clear line)
-    # Move position back for newline
-    (-- pos)
-    (push-nl))
+  # Emission state
+  (def buf @"")
+  (var current-column 0)
 
-  (defn push-fcb []
-    (update-levels)
-    (push-line)
-    (while (and (< pos len) (not (end-fcb?)))
-      (push-line))
-    (push-line))
+  # Emission
+  (defn emit-indent [indent]
+    (def delta (- indent current-column))
+    (when (< 0 delta)
+      (buffer/push buf (string/repeat " " delta))
+      (set current-column indent)))
 
-  (defn push-icb []
-    (buffer/push-string res (buffer/new-filled leading 32))
-    (push-line)
-    (while (and (< pos len) (not (start-nl?)))
-      (push-line))
-    (push-nl))
+  (defn emit-nl [&opt indent]
+    (buffer/push buf "\n")
+    (set current-column 0))
 
-  (defn push-p []
-    (update-levels)
-    # Set up the indentation
-    (def para-indent (+ indent (array/peek levels)))
-    # Indent first line
-    (buffer/push-string line (buffer/new-filled para-indent 32))
-    (set line-width para-indent)
-    # Add words
-    (set c (get str pos))
-    (while (and c (not= 10 c))
-      # Skip spaces
-      (while (= 32 c)
-        (set c (get str (++ pos))))
-      # Add word
-      (push-word para-indent)
-      (set c (get str (++ pos))))
-    # Add final line
-    (buffer/push-string res line)
-    (buffer/clear line)
-    # Move position back for newline
-    (-- pos)
-    (push-nl)
-    (push-nl))
+  (defn emit-word [word indent &opt len]
+    (def last-byte (last buf))
+    (when (and
+            last-byte
+            (not= last-byte (chr "\n"))
+            (not= last-byte (chr " ")))
+      (buffer/push buf " ")
+      (++ current-column))
+    (default len (length word))
+    (when (and indent (> (+ 1 current-column len) max-width))
+      (emit-nl)
+      (emit-indent indent))
+    (buffer/push buf word)
+    (+= current-column len))
 
-  (while (< pos len)
-    (skip-line-indent)
-    (cond
-      (start-nl?)
-      (push-nl)
+  (defn emit-code
+    [code indent]
+    (def replacement (string "\n" (string/repeat " " (+ 4 indent))))
+    (emit-indent (+ 4 indent))
+    (buffer/push buf (string/replace-all "\n" replacement code))
+    (if (= (chr "\n") (last code))
+      (set current-column 0)
+      (emit-nl)))
 
-      (start-ul?)
-      (push-list)
+  (defn emit-node
+    [el indent]
+    (emit-indent indent)
+    (if (tuple? el)
+      (let [rep (string "\n" (string/repeat " " indent))]
+        (each [word len] el
+          (emit-word
+            (string/replace-all "\n" rep word)
+            indent
+            len))
+        (emit-nl))
+      (case (first el)
+        :ul (for i 1 (length el)
+              (if (> i 1) (emit-indent indent))
+              (emit-word "* " nil)
+              (each subel (get el i) (emit-node subel (+ 2 indent))))
+        :ol (for i 1 (length el)
+              (if (> i 1) (emit-indent indent))
+              (def lab (string/format "%d. " i))
+              (emit-word lab nil)
+              (each subel (get el i) (emit-node subel (+ (length lab) indent))))
+        :cb (emit-code (get el 1) indent))))
 
-      (start-ol?)
-      (push-list)
+  (each el stack
+    (emit-nl)
+    (emit-node el indent))
 
-      (start-fcb?)
-      (push-fcb)
-
-      (start-icb?)
-      (push-icb)
-
-      (push-p)))
-  res)
+  buf)
 
 (defn- print-index
   "Print bindings in the current environment given a filter function"
@@ -2834,10 +3005,17 @@
   (print "\n\n"
          (when d bind-type)
          (when-let [[path line col] sm]
-           (string "    " path (when (and line col) (string " on line " line ", column " col)) "\n"))
-         (when (or d sm) "\n")
-         (if d (doc-format d) "    no documentation found.")
-         "\n\n"))
+           (string "    " path (when (and line col) (string " on line " line ", column " col))))
+         (when sm "\n")
+         (if d (doc-format d) "\n    no documentation found.\n")
+         "\n"))
+
+(defn- print-special-form-entry
+  [x]
+  (print "\n\n"
+         (string "    special form\n\n")
+         (string "    (" x " ...)\n\n")
+         (string "    See https://janet-lang.org/docs/specials.html\n\n")))
 
 (defn doc*
   "Get the documentation for a symbol in a given environment. Function form of doc."
@@ -2851,14 +3029,17 @@
     (do
       (def x (dyn sym))
       (if (not x)
-        (do
-          (def [fullpath mod-kind] (module/find (string sym)))
-          (if-let [mod-env (in module/cache fullpath)]
-            (print-module-entry {:module     true
-                                 :kind       mod-kind
-                                 :source-map [fullpath nil nil]
-                                 :doc        (in mod-env :doc)})
-            (print "symbol " sym " not found.")))
+        (if (index-of sym '[break def do fn if quasiquote quote
+                            set splice unquote upscope var while])
+          (print-special-form-entry sym)
+          (do
+            (def [fullpath mod-kind] (module/find (string sym)))
+            (if-let [mod-env (in module/cache fullpath)]
+              (print-module-entry {:module     true
+                                   :kind       mod-kind
+                                   :source-map [fullpath nil nil]
+                                   :doc        (in mod-env :doc)})
+              (print "symbol " sym " not found."))))
         (print-module-entry x)))
 
     # else
@@ -3057,12 +3238,13 @@
 ###
 
 (defn repl
-  `Run a repl. The first parameter is an optional function to call to
+  ``Run a repl. The first parameter is an optional function to call to
   get a chunk of source code that should return nil for end of file.
   The second parameter is a function that is called when a signal is
   caught. One can provide an optional environment table to run
   the repl in, as well as an optional parser or read function to pass
-  to run-context.`
+  to `run-context.`
+  ``
   [&opt chunks onsignal env parser read]
   (default env (make-env))
   (default chunks
@@ -3084,8 +3266,6 @@
       (put nextenv :debug-level level)
       (put nextenv :signal x)
       (merge-into nextenv debugger-env)
-      (debug/stacktrace f x)
-      (eflush)
       (defn debugger-chunks [buf p]
         (def status (:state p :delimiters))
         (def c ((:where p) 0))
@@ -3099,14 +3279,18 @@
       (nextenv :resume-value))
 
     (fn [f x]
-      (if (= :dead (fiber/status f))
+      (def fs (fiber/status f))
+      (if (= :dead fs)
         (do
           (put e '_ @{:value x})
           (printf (get e :pretty-format "%q") x)
           (flush))
-        (if (e :debug)
-          (enter-debugger f x)
-          (do (debug/stacktrace f x) (eflush))))))
+        (do
+          (def ec (dyn :err-color))
+          (eprint (if ec "\e[31m" "") fs ": " x)
+          (debug/stacktrace f)
+          (eflush)
+          (if (e :debug) (enter-debugger f x))))))
 
   (run-context {:env env
                 :chunks chunks
@@ -3223,7 +3407,11 @@
   [thunk source env where]
   (when (tuple? source)
     (def head (source 0))
-    (def safe-check (safe-forms head))
+    (def safe-check
+      (or
+        (safe-forms head)
+        (if (symbol? head)
+          (if (string/has-prefix? "define-" head) is-safe-def))))
     (cond
       # Sometimes safe form
       (function? safe-check)
@@ -3278,11 +3466,18 @@
   (var *colorize* true)
   (var *debug* false)
   (var *compile-only* false)
+  (var *warn-level* nil)
+  (var *error-level* nil)
 
   (if-let [jp (getenv-alias "JANET_PATH")] (setdyn :syspath jp))
   (if-let [jp (getenv-alias "JANET_HEADERPATH")] (setdyn :headerpath jp))
   (if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn :profilepath jprofile))
 
+  (defn- get-lint-level
+    [i]
+    (def x (in args (+ i 1)))
+    (or (scan-number x) (keyword x)))
+
   # Flag handlers
   (def handlers
     {"h" (fn [&]
@@ -3304,6 +3499,8 @@
                -c source output : Compile janet source code into an image
                -n : Disable ANSI color output in the REPL
                -l lib : Import a module before processing more arguments
+               -w level : Set the lint warning level - default is "normal"
+               -x level : Set the lint error level - default is "none"
                -- : Stop handling options
              ```)
            (os/exit 0)
@@ -3331,6 +3528,8 @@
            (eval-string (in args (+ i 1)))
            2)
      "d" (fn [&] (set *debug* true) 1)
+     "w" (fn [i &] (set *warn-level* (get-lint-level i)) 2)
+     "x" (fn [i &] (set *error-level* (get-lint-level i)) 2)
      "R" (fn [&] (setdyn :profilepath nil) 1)})
 
   (defn- dohandler [n i &]
@@ -3349,6 +3548,8 @@
         (def env (make-env))
         (def subargs (array/slice args i))
         (put env :args subargs)
+        (put env :lint-error *error-level*)
+        (put env :lint-warn *warn-level*)
         (if *compile-only*
           (flycheck arg :exit *exit-on-error* :env env)
           (do
@@ -3382,6 +3583,9 @@
           (getter (getprompt p) buf env))
         (setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
         (setdyn :err-color (if *colorize* true))
+        (setdyn :doc-color (if *colorize* true))
+        (setdyn :lint-error *error-level*)
+        (setdyn :lint-warn *error-level*)
         (repl getchunk nil env)))))
 
 ###
@@ -3483,7 +3687,6 @@
      "src/core/table.c"
      "src/core/thread.c"
      "src/core/tuple.c"
-     "src/core/typedarray.c"
      "src/core/util.c"
      "src/core/value.c"
      "src/core/vector.c"

src/boot/buffer_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/boot/number_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/boot/system_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/boot/table_test.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/conf/janetconf.h

@@ -4,10 +4,10 @@
 #define JANETCONF_H
 
 #define JANET_VERSION_MAJOR 1
-#define JANET_VERSION_MINOR 15
-#define JANET_VERSION_PATCH 2
+#define JANET_VERSION_MINOR 16
+#define JANET_VERSION_PATCH 1
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.15.2"
+#define JANET_VERSION "1.16.1"
 
 /* #define JANET_BUILD "local" */
 
@@ -27,7 +27,6 @@
 /* #define JANET_NO_ASSEMBLER */
 /* #define JANET_NO_PEG */
 /* #define JANET_NO_NET */
-/* #define JANET_NO_TYPED_ARRAY */
 /* #define JANET_NO_INT_TYPES */
 /* #define JANET_NO_EV */
 /* #define JANET_NO_REALPATH */
@@ -49,6 +48,13 @@
 /* #define JANET_ARCH_NAME pdp-8 */
 /* #define JANET_EV_EPOLL */
 
+/* Custom vm allocator support */
+/* #include <mimalloc.h> */
+/* #define janet_malloc(X) mi_malloc((X)) */
+/* #define janet_realloc(X, Y) mi_realloc((X), (Y)) */
+/* #define janet_calloc(X, Y) mi_calloc((X), (Y)) */
+/* #define janet_free(X) mi_free((X)) */
+
 /* Main client settings, does not affect library code */
 /* #define JANET_SIMPLE_GETLINE */
 

src/core/abstract.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/array.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -36,7 +36,7 @@ JanetArray *janet_array(int32_t capacity) {
     Janet *data = NULL;
     if (capacity > 0) {
         janet_vm_next_collection += capacity * sizeof(Janet);
-        data = (Janet *) malloc(sizeof(Janet) * (size_t) capacity);
+        data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
         if (NULL == data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -52,7 +52,7 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
     JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
     array->capacity = n;
     array->count = n;
-    array->data = malloc(sizeof(Janet) * (size_t) n);
+    array->data = janet_malloc(sizeof(Janet) * (size_t) n);
     if (!array->data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -68,7 +68,7 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
     int64_t new_capacity = ((int64_t) capacity) * growth;
     if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
     capacity = (int32_t) new_capacity;
-    newData = realloc(old, capacity * sizeof(Janet));
+    newData = janet_realloc(old, capacity * sizeof(Janet));
     if (NULL == newData) {
         JANET_OUT_OF_MEMORY;
     }
@@ -275,7 +275,7 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
     JanetArray *array = janet_getarray(argv, 0);
     if (array->count) {
         if (array->count < array->capacity) {
-            Janet *newData = realloc(array->data, array->count * sizeof(Janet));
+            Janet *newData = janet_realloc(array->data, array->count * sizeof(Janet));
             if (NULL == newData) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -284,7 +284,7 @@ static Janet cfun_array_trim(int32_t argc, Janet *argv) {
         }
     } else {
         array->capacity = 0;
-        free(array->data);
+        janet_free(array->data);
         array->data = NULL;
     }
     return argv[0];

src/core/asm.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -224,7 +224,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
     janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
     if (envindex >= a->environments_capacity) {
         int32_t newcap = 2 * envindex;
-        def->environments = realloc(def->environments, newcap * sizeof(int32_t));
+        def->environments = janet_realloc(def->environments, newcap * sizeof(int32_t));
         if (NULL == def->environments) {
             JANET_OUT_OF_MEMORY;
         }
@@ -582,7 +582,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_ckeywordv("constants"));
     if (janet_indexed_view(x, &arr, &count)) {
         def->constants_length = count;
-        def->constants = malloc(sizeof(Janet) * (size_t) count);
+        def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
         if (NULL == def->constants) {
             JANET_OUT_OF_MEMORY;
         }
@@ -614,7 +614,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
             newlen = def->defs_length + 1;
             if (a.defs_capacity < newlen) {
                 int32_t newcap = newlen;
-                def->defs = realloc(def->defs, newcap * sizeof(JanetFuncDef *));
+                def->defs = janet_realloc(def->defs, newcap * sizeof(JanetFuncDef *));
                 if (NULL == def->defs) {
                     JANET_OUT_OF_MEMORY;
                 }
@@ -643,7 +643,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
         }
         /* Allocate bytecode array */
         def->bytecode_length = blength;
-        def->bytecode = malloc(sizeof(uint32_t) * (size_t) blength);
+        def->bytecode = janet_malloc(sizeof(uint32_t) * (size_t) blength);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -685,7 +685,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
     x = janet_get1(s, janet_ckeywordv("sourcemap"));
     if (janet_indexed_view(x, &arr, &count)) {
         janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
-        def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) count);
+        def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
         if (NULL == def->sourcemap) {
             JANET_OUT_OF_MEMORY;
         }
@@ -711,7 +711,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
 
     /* Set environments */
     def->environments =
-        realloc(def->environments, def->environments_length * sizeof(int32_t));
+        janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
     if (NULL == def->environments) {
         JANET_OUT_OF_MEMORY;
     }

src/core/buffer.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -33,7 +33,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
     uint8_t *data = NULL;
     if (capacity < 4) capacity = 4;
     janet_gcpressure(capacity);
-    data = malloc(sizeof(uint8_t) * (size_t) capacity);
+    data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
     if (NULL == data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -45,7 +45,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
 
 /* Deinitialize a buffer (free data memory) */
 void janet_buffer_deinit(JanetBuffer *buffer) {
-    free(buffer->data);
+    janet_free(buffer->data);
 }
 
 /* Initialize a buffer */
@@ -62,7 +62,7 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
     int64_t big_capacity = ((int64_t) capacity) * growth;
     capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
     janet_gcpressure(capacity - buffer->capacity);
-    new_data = realloc(old, (size_t) capacity * sizeof(uint8_t));
+    new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
     if (NULL == new_data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -92,7 +92,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 > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
-        uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
+        uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
         janet_gcpressure(new_capacity - buffer->capacity);
         if (NULL == new_data) {
             JANET_OUT_OF_MEMORY;
@@ -201,7 +201,7 @@ static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
     JanetBuffer *buffer = janet_getbuffer(argv, 0);
     if (buffer->count < buffer->capacity) {
         int32_t newcap = buffer->count > 4 ? buffer->count : 4;
-        uint8_t *newData = realloc(buffer->data, newcap);
+        uint8_t *newData = janet_realloc(buffer->data, newcap);
         if (NULL == newData) {
             JANET_OUT_OF_MEMORY;
         }

src/core/bytecode.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/capi.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/cfuns.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/compile.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -53,6 +53,36 @@ void janetc_cerror(JanetCompiler *c, const char *m) {
     janetc_error(c, janet_cstring(m));
 }
 
+static const char *janet_lint_level_names[] = {
+    "relaxed",
+    "normal",
+    "strict"
+};
+
+/* Emit compiler linter messages */
+void janetc_lintf(JanetCompiler *c, JanetCompileLintLevel level, const char *format, ...) {
+    if (NULL != c->lints) {
+        /* format message */
+        va_list args;
+        JanetBuffer buffer;
+        int32_t len = 0;
+        while (format[len]) len++;
+        janet_buffer_init(&buffer, len);
+        va_start(args, format);
+        janet_formatbv(&buffer, format, args);
+        va_end(args);
+        const uint8_t *str = janet_string(buffer.data, buffer.count);
+        janet_buffer_deinit(&buffer);
+        /* construct linting payload */
+        Janet *payload = janet_tuple_begin(4);
+        payload[0] = janet_ckeywordv(janet_lint_level_names[level]);
+        payload[1] = c->current_mapping.line == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.line);
+        payload[2] = c->current_mapping.column == -1 ? janet_wrap_nil() : janet_wrap_integer(c->current_mapping.column);
+        payload[3] = janet_wrap_string(str);
+        janet_array_push(c->lints, janet_wrap_tuple(janet_tuple_end(payload)));
+    }
+}
+
 /* Free a slot */
 void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
     if (s.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF | JANET_SLOT_NAMED)) return;
@@ -199,24 +229,41 @@ JanetSlot janetc_resolve(
 
     /* Symbol not found - check for global */
     {
-        Janet check;
-        JanetBindingType btype = janet_resolve(c->env, sym, &check);
-        switch (btype) {
+        JanetBinding binding = janet_resolve_ext(c->env, sym);
+        switch (binding.type) {
             default:
             case JANET_BINDING_NONE:
                 janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
                 return janetc_cslot(janet_wrap_nil());
             case JANET_BINDING_DEF:
             case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
-                return janetc_cslot(check);
+                ret = janetc_cslot(binding.value);
+                break;
             case JANET_BINDING_VAR: {
-                JanetSlot ret = janetc_cslot(check);
-                /* TODO save type info */
+                ret = janetc_cslot(binding.value);
                 ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
                 ret.flags &= ~JANET_SLOT_CONSTANT;
-                return ret;
+                break;
             }
         }
+        JanetCompileLintLevel depLevel = JANET_C_LINT_RELAXED;
+        switch (binding.deprecation) {
+            case JANET_BINDING_DEP_NONE:
+                break;
+            case JANET_BINDING_DEP_RELAXED:
+                depLevel = JANET_C_LINT_RELAXED;
+                break;
+            case JANET_BINDING_DEP_NORMAL:
+                depLevel = JANET_C_LINT_NORMAL;
+                break;
+            case JANET_BINDING_DEP_STRICT:
+                depLevel = JANET_C_LINT_STRICT;
+                break;
+        }
+        if (binding.deprecation != JANET_BINDING_DEP_NONE) {
+            janetc_lintf(c, depLevel, "%q is deprecated", janet_wrap_symbol(sym));
+        }
+        return ret;
     }
 
     /* Symbol was found */
@@ -399,6 +446,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
     int32_t mapbufstart = janet_v_count(c->mapbuffer);
     janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
     janetc_value(opts, x);
+    janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
     janetc_popscope(c);
     if (c->buffer) {
         janet_v__cnt(c->buffer) = bufstart;
@@ -504,10 +552,40 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
 static JanetSlot janetc_maker(JanetFopts opts, JanetSlot *slots, int op) {
     JanetCompiler *c = opts.compiler;
     JanetSlot retslot;
-    janetc_pushslots(c, slots);
-    janetc_freeslots(c, slots);
-    retslot = janetc_gettarget(opts);
-    janetc_emit_s(c, op, retslot, 1);
+
+    /* Check if this structure is composed entirely of constants */
+    int can_inline = 1;
+    for (int32_t i = 0; i < janet_v_count(slots); i++) {
+        if (!(slots[i].flags & JANET_SLOT_CONSTANT) ||
+                (slots[i].flags & JANET_SLOT_SPLICED)) {
+            can_inline = 0;
+            break;
+        }
+    }
+
+    if (can_inline && (op == JOP_MAKE_STRUCT)) {
+        JanetKV *st = janet_struct_begin(janet_v_count(slots) / 2);
+        for (int32_t i = 0; i < janet_v_count(slots); i += 2) {
+            Janet k = slots[i].constant;
+            Janet v = slots[i + 1].constant;
+            janet_struct_put(st, k, v);
+        }
+        retslot = janetc_cslot(janet_wrap_struct(janet_struct_end(st)));
+        janetc_freeslots(c, slots);
+    } else if (can_inline && (op == JOP_MAKE_TUPLE)) {
+        Janet *tup = janet_tuple_begin(janet_v_count(slots));
+        for (int32_t i = 0; i < janet_v_count(slots); i++) {
+            tup[i] = slots[i].constant;
+        }
+        retslot = janetc_cslot(janet_wrap_tuple(janet_tuple_end(tup)));
+        janetc_freeslots(c, slots);
+    } else {
+        janetc_pushslots(c, slots);
+        janetc_freeslots(c, slots);
+        retslot = janetc_gettarget(opts);
+        janetc_emit_s(c, op, retslot, 1);
+    }
+
     return retslot;
 }
 
@@ -601,6 +679,9 @@ static int macroexpand1(
     Janet tempOut;
     JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
     janet_table_put(c->env, mf_kw, janet_wrap_nil());
+    if (c->lints) {
+        janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
+    }
     janet_gcunlock(lock);
     if (status != JANET_SIGNAL_OK) {
         const uint8_t *es = janet_formatc("(macro) %V", tempOut);
@@ -745,7 +826,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
     def->bytecode_length = janet_v_count(c->buffer) - scope->bytecode_start;
     if (def->bytecode_length) {
         size_t s = sizeof(int32_t) * (size_t) def->bytecode_length;
-        def->bytecode = malloc(s);
+        def->bytecode = janet_malloc(s);
         if (NULL == def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -753,7 +834,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         janet_v__cnt(c->buffer) = scope->bytecode_start;
         if (NULL != c->mapbuffer && c->source) {
             size_t s = sizeof(JanetSourceMapping) * (size_t) def->bytecode_length;
-            def->sourcemap = malloc(s);
+            def->sourcemap = janet_malloc(s);
             if (NULL == def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -778,7 +859,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
         int32_t slotchunks = (def->slotcount + 31) >> 5;
         /* numchunks is min of slotchunks and scope->ua.count */
         int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
-        uint32_t *chunks = calloc(sizeof(uint32_t), slotchunks);
+        uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
         if (NULL == chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -795,7 +876,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
 }
 
 /* Initialize a compiler */
-static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where) {
+static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where, JanetArray *lints) {
     c->scope = NULL;
     c->buffer = NULL;
     c->mapbuffer = NULL;
@@ -804,6 +885,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
     c->source = where;
     c->current_mapping.line = -1;
     c->current_mapping.column = -1;
+    c->lints = lints;
     /* Init result */
     c->result.error = NULL;
     c->result.status = JANET_COMPILE_OK;
@@ -821,12 +903,13 @@ static void janetc_deinit(JanetCompiler *c) {
 }
 
 /* Compile a form. */
-JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+JanetCompileResult janet_compile_lint(Janet source,
+                                      JanetTable *env, const uint8_t *where, JanetArray *lints) {
     JanetCompiler c;
     JanetScope rootscope;
     JanetFopts fopts;
 
-    janetc_init(&c, env, where);
+    janetc_init(&c, env, where, lints);
 
     /* Push a function scope */
     janetc_scope(&rootscope, &c, JANET_SCOPE_FUNCTION | JANET_SCOPE_TOP, "root");
@@ -854,19 +937,24 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
     return c.result;
 }
 
+JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where) {
+    return janet_compile_lint(source, env, where, NULL);
+}
+
 /* C Function for compiling */
 static Janet cfun(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
+    janet_arity(argc, 1, 4);
     JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
     if (NULL == env) {
         env = janet_table(0);
         janet_vm_fiber->env = env;
     }
     const uint8_t *source = NULL;
-    if (argc == 3) {
+    if (argc >= 3) {
         source = janet_getstring(argv, 2);
     }
-    JanetCompileResult res = janet_compile(argv[0], env, source);
+    JanetArray *lints = (argc >= 4) ? janet_getarray(argv, 3) : NULL;
+    JanetCompileResult res = janet_compile_lint(argv[0], env, source, lints);
     if (res.status == JANET_COMPILE_OK) {
         return janet_wrap_function(janet_thunk(res.funcdef));
     } else {
@@ -888,11 +976,13 @@ static Janet cfun(int32_t argc, Janet *argv) {
 static const JanetReg compile_cfuns[] = {
     {
         "compile", cfun,
-        JDOC("(compile ast &opt env source)\n\n"
+        JDOC("(compile ast &opt env source lints)\n\n"
              "Compiles an Abstract Syntax Tree (ast) into a function. "
              "Pair the compile function with parsing functionality to implement "
              "eval. Returns a new function and does not modify ast. Returns an error "
-             "struct with keys :line, :column, and :error if compilation fails.")
+             "struct with keys :line, :column, and :error if compilation fails. "
+             "If a `lints` array is given, linting messages will be appended to the array. "
+             "Each message will be a tuple of the form `(level line col message)`.")
     },
     {NULL, NULL, NULL}
 };

src/core/compile.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -29,6 +29,13 @@
 #include "regalloc.h"
 #endif
 
+/* Levels for compiler warnings */
+typedef enum {
+    JANET_C_LINT_RELAXED,
+    JANET_C_LINT_NORMAL,
+    JANET_C_LINT_STRICT
+} JanetCompileLintLevel;
+
 /* Tags for some functions for the prepared inliner */
 #define JANET_FUN_DEBUG 1
 #define JANET_FUN_ERROR 2
@@ -78,10 +85,10 @@ typedef struct JanetSpecial JanetSpecial;
 #define JANET_SLOT_MUTABLE 0x40000
 #define JANET_SLOT_REF 0x80000
 #define JANET_SLOT_RETURNED 0x100000
-/* Needed for handling single element arrays as global vars. */
-
-/* Used for unquote-splicing */
-#define JANET_SLOT_SPLICED 0x200000
+#define JANET_SLOT_DEP_NOTE 0x200000
+#define JANET_SLOT_DEP_WARN 0x400000
+#define JANET_SLOT_DEP_ERROR 0x800000
+#define JANET_SLOT_SPLICED 0x1000000
 
 #define JANET_SLOTTYPE_ANY 0xFFFF
 
@@ -164,6 +171,9 @@ struct JanetCompiler {
 
     /* Prevent unbounded recursion */
     int recursion_guard;
+
+    /* Collect linting results */
+    JanetArray *lints;
 };
 
 #define JANET_FOPTS_TAIL 0x10000
@@ -230,6 +240,9 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s);
 void janetc_error(JanetCompiler *c, const uint8_t *m);
 void janetc_cerror(JanetCompiler *c, const char *m);
 
+/* Linting */
+void janetc_lintf(JanetCompiler *C, JanetCompileLintLevel level, const char *format, ...);
+
 /* Dispatch to correct form compiler */
 JanetSlot janetc_value(JanetFopts opts, Janet x);
 

src/core/corelib.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -70,7 +70,7 @@ static char *get_processed_name(const char *name) {
         if (*c == '/') return (char *) name;
     }
     size_t l = (size_t)(c - name);
-    char *ret = malloc(l + 3);
+    char *ret = janet_malloc(l + 3);
     if (NULL == ret) {
         JANET_OUT_OF_MEMORY;
     }
@@ -85,7 +85,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
     Clib lib = load_clib(processed_name);
     JanetModule init;
     JanetModconf getter;
-    if (name != processed_name) free(processed_name);
+    if (name != processed_name) janet_free(processed_name);
     if (!lib) {
         *error = janet_cstring(error_clib());
         return NULL;
@@ -754,7 +754,7 @@ static void janet_quick_asm(
     def->max_arity = max_arity;
     def->flags = flags;
     def->slotcount = slots;
-    def->bytecode = malloc(bytecode_size);
+    def->bytecode = janet_malloc(bytecode_size);
     def->bytecode_length = (int32_t)(bytecode_size / sizeof(uint32_t));
     def->name = janet_cstring(name);
     if (!def->bytecode) {
@@ -1026,9 +1026,6 @@ static void janet_load_libs(JanetTable *env) {
 #ifdef JANET_ASSEMBLER
     janet_lib_asm(env);
 #endif
-#ifdef JANET_TYPED_ARRAY
-    janet_lib_typed_array(env);
-#endif
 #ifdef JANET_INT_TYPES
     janet_lib_inttypes(env);
 #endif

src/core/debug.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/emit.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/emit.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/ev.c

@@ -90,7 +90,7 @@ static void janet_q_init(JanetQueue *q) {
 }
 
 static void janet_q_deinit(JanetQueue *q) {
-    free(q->data);
+    janet_free(q->data);
 }
 
 static int32_t janet_q_count(JanetQueue *q) {
@@ -106,7 +106,7 @@ static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
         if (count + 1 >= JANET_MAX_Q_CAPACITY) return 1;
         int32_t newcap = (count + 2) * 2;
         if (newcap > JANET_MAX_Q_CAPACITY) newcap = JANET_MAX_Q_CAPACITY;
-        q->data = realloc(q->data, itemsize * newcap);
+        q->data = janet_realloc(q->data, itemsize * newcap);
         if (NULL == q->data) {
             JANET_OUT_OF_MEMORY;
         }
@@ -213,7 +213,7 @@ static void add_timeout(JanetTimeout to) {
     size_t newcount = oldcount + 1;
     if (newcount > janet_vm_tq_capacity) {
         size_t newcap = 2 * newcount;
-        JanetTimeout *tq = realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
+        JanetTimeout *tq = janet_realloc(janet_vm_tq, newcap * sizeof(JanetTimeout));
         if (NULL == tq) {
             JANET_OUT_OF_MEMORY;
         }
@@ -247,7 +247,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
     }
     if (size < sizeof(JanetListenerState))
         size = sizeof(JanetListenerState);
-    JanetListenerState *state = malloc(size);
+    JanetListenerState *state = janet_malloc(size);
     if (NULL == state) {
         JANET_OUT_OF_MEMORY;
     }
@@ -264,7 +264,7 @@ static JanetListenerState *janet_listen_impl(JanetStream *stream, JanetListener
     int resize = janet_vm_listener_cap == janet_vm_listener_count;
     if (resize) {
         size_t newcap = janet_vm_listener_count ? janet_vm_listener_cap * 2 : 16;
-        janet_vm_listeners = realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
+        janet_vm_listeners = janet_realloc(janet_vm_listeners, newcap * sizeof(JanetListenerState *));
         if (NULL == janet_vm_listeners) {
             JANET_OUT_OF_MEMORY;
         }
@@ -301,7 +301,7 @@ static void janet_unlisten_impl(JanetListenerState *state) {
     size_t index = state->_index;
     janet_vm_listeners[index] = janet_vm_listeners[--janet_vm_listener_count];
     janet_vm_listeners[index]->_index = index;
-    free(state);
+    janet_free(state);
 }
 
 static const JanetMethod ev_default_stream_methods[] = {
@@ -557,8 +557,8 @@ void janet_ev_init_common(void) {
 /* Common deinit code */
 void janet_ev_deinit_common(void) {
     janet_q_deinit(&janet_vm_spawn);
-    free(janet_vm_tq);
-    free(janet_vm_listeners);
+    janet_free(janet_vm_tq);
+    janet_free(janet_vm_listeners);
     janet_vm_listeners = NULL;
 }
 
@@ -1042,7 +1042,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
             /* Custom event */
             JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
             response->cb(response->msg);
-            free(response);
+            janet_free(response);
             janet_ev_dec_refcount();
         } else {
             /* Normal event */
@@ -1080,7 +1080,7 @@ static JanetTimestamp ts_now(void) {
 }
 
 static int make_epoll_events(int mask) {
-    int events = EPOLLET;
+    int events = 0;
     if (mask & JANET_ASYNC_LISTEN_READ)
         events |= EPOLLIN;
     if (mask & JANET_ASYNC_LISTEN_WRITE)
@@ -1176,7 +1176,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
                     status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
                 if (mask & EPOLLERR)
                     status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
-                if (mask & EPOLLHUP)
+                if ((mask & EPOLLHUP) && !(mask & (EPOLLOUT | EPOLLIN)))
                     status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
                 if (status1 == JANET_ASYNC_STATUS_DONE ||
                         status2 == JANET_ASYNC_STATUS_DONE ||
@@ -1249,7 +1249,7 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
     JanetListenerState *state = janet_listen_impl(stream, behavior, mask, size, user);
     size_t newsize = janet_vm_listener_cap;
     if (newsize > oldsize) {
-        janet_vm_fds = realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
+        janet_vm_fds = janet_realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
         if (NULL == janet_vm_fds) {
             JANET_OUT_OF_MEMORY;
         }
@@ -1306,7 +1306,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
             status2 = state->machine(state, JANET_ASYNC_EVENT_READ);
         if (mask & POLLERR)
             status3 = state->machine(state, JANET_ASYNC_EVENT_ERR);
-        if (mask & POLLHUP)
+        if ((mask & POLLHUP) && !(mask & (POLLIN | POLLOUT)))
             status4 = state->machine(state, JANET_ASYNC_EVENT_HUP);
         if (status1 == JANET_ASYNC_STATUS_DONE ||
                 status2 == JANET_ASYNC_STATUS_DONE ||
@@ -1320,7 +1320,7 @@ void janet_ev_init(void) {
     janet_ev_init_common();
     janet_vm_fds = NULL;
     janet_ev_setup_selfpipe();
-    janet_vm_fds = malloc(sizeof(struct pollfd));
+    janet_vm_fds = janet_malloc(sizeof(struct pollfd));
     if (NULL == janet_vm_fds) {
         JANET_OUT_OF_MEMORY;
     }
@@ -1333,7 +1333,7 @@ void janet_ev_init(void) {
 void janet_ev_deinit(void) {
     janet_ev_deinit_common();
     janet_ev_cleanup_selfpipe();
-    free(janet_vm_fds);
+    janet_free(janet_vm_fds);
     janet_vm_fds = NULL;
 }
 
@@ -1371,7 +1371,7 @@ static void *janet_thread_body(void *ptr) {
     JanetThreadedSubroutine subr = init->subr;
     JanetThreadedCallback cb = init->cb;
     int fd = init->write_pipe;
-    free(init);
+    janet_free(init);
     JanetSelfPipeEvent response;
     response.msg = subr(msg);
     response.cb = cb;
@@ -1391,7 +1391,7 @@ static void *janet_thread_body(void *ptr) {
 #endif
 
 void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb) {
-    JanetEVThreadInit *init = malloc(sizeof(JanetEVThreadInit));
+    JanetEVThreadInit *init = janet_malloc(sizeof(JanetEVThreadInit));
     if (NULL == init) {
         JANET_OUT_OF_MEMORY;
     }
@@ -1403,7 +1403,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
     init->write_pipe = janet_vm_iocp;
     HANDLE thread_handle = CreateThread(NULL, 0, janet_thread_body, init, 0, NULL);
     if (NULL == thread_handle) {
-        free(init);
+        janet_free(init);
         janet_panic("failed to create thread");
     }
     CloseHandle(thread_handle); /* detach from thread */
@@ -1412,7 +1412,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
     pthread_t waiter_thread;
     int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
     if (err) {
-        free(init);
+        janet_free(init);
         janet_panicf("%s", strerror(err));
     }
     pthread_detach(waiter_thread);
@@ -1435,7 +1435,7 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
         case JANET_EV_TCTAG_STRING:
         case JANET_EV_TCTAG_STRINGF:
             janet_schedule(return_value.fiber, janet_cstringv((const char *) return_value.argp));
-            if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
+            if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
             break;
         case JANET_EV_TCTAG_KEYWORD:
             janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
@@ -1443,7 +1443,7 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
         case JANET_EV_TCTAG_ERR_STRING:
         case JANET_EV_TCTAG_ERR_STRINGF:
             janet_cancel(return_value.fiber, janet_cstringv((const char *) return_value.argp));
-            if (return_value.tag == JANET_EV_TCTAG_STRINGF) free(return_value.argp);
+            if (return_value.tag == JANET_EV_TCTAG_STRINGF) janet_free(return_value.argp);
             break;
         case JANET_EV_TCTAG_ERR_KEYWORD:
             janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
@@ -2092,7 +2092,7 @@ static Janet cfun_ev_thread(int32_t argc, Janet *argv) {
     janet_getfiber(argv, 0);
     Janet value = argc == 2 ? argv[1] : janet_wrap_nil();
     /* Marshal arguments for the new thread. */
-    JanetBuffer *buffer = malloc(sizeof(JanetBuffer));
+    JanetBuffer *buffer = janet_malloc(sizeof(JanetBuffer));
     if (NULL == buffer) {
         JANET_OUT_OF_MEMORY;
     }

src/core/features.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/fiber.c

@@ -53,7 +53,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
         capacity = 32;
     }
     fiber->capacity = capacity;
-    data = malloc(sizeof(Janet) * (size_t) capacity);
+    data = janet_malloc(sizeof(Janet) * (size_t) capacity);
     if (NULL == data) {
         JANET_OUT_OF_MEMORY;
     }
@@ -100,12 +100,12 @@ JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, c
 static void janet_fiber_refresh_memory(JanetFiber *fiber) {
     int32_t n = fiber->capacity;
     if (n) {
-        Janet *newData = malloc(sizeof(Janet) * n);
+        Janet *newData = janet_malloc(sizeof(Janet) * n);
         if (NULL == newData) {
             JANET_OUT_OF_MEMORY;
         }
         memcpy(newData, fiber->data, fiber->capacity * sizeof(Janet));
-        free(fiber->data);
+        janet_free(fiber->data);
         fiber->data = newData;
     }
 }
@@ -115,7 +115,7 @@ static void janet_fiber_refresh_memory(JanetFiber *fiber) {
 void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
     int32_t old_size = fiber->capacity;
     int32_t diff = n - old_size;
-    Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
+    Janet *newData = janet_realloc(fiber->data, sizeof(Janet) * n);
     if (NULL == newData) {
         JANET_OUT_OF_MEMORY;
     }
@@ -254,7 +254,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
         janet_env_valid(env);
         int32_t len = env->length;
         size_t s = sizeof(Janet) * (size_t) len;
-        Janet *vmem = malloc(s);
+        Janet *vmem = janet_malloc(s);
         janet_vm_next_collection += (uint32_t) s;
         if (NULL == vmem) {
             JANET_OUT_OF_MEMORY;

src/core/fiber.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/gc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -290,13 +290,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
             janet_symbol_deinit(((JanetStringHead *) mem)->data);
             break;
         case JANET_MEMORY_ARRAY:
-            free(((JanetArray *) mem)->data);
+            janet_free(((JanetArray *) mem)->data);
             break;
         case JANET_MEMORY_TABLE:
-            free(((JanetTable *) mem)->data);
+            janet_free(((JanetTable *) mem)->data);
             break;
         case JANET_MEMORY_FIBER:
-            free(((JanetFiber *)mem)->data);
+            janet_free(((JanetFiber *)mem)->data);
             break;
         case JANET_MEMORY_BUFFER:
             janet_buffer_deinit((JanetBuffer *) mem);
@@ -311,18 +311,18 @@ static void janet_deinit_block(JanetGCObject *mem) {
         case JANET_MEMORY_FUNCENV: {
             JanetFuncEnv *env = (JanetFuncEnv *)mem;
             if (0 == env->offset)
-                free(env->as.values);
+                janet_free(env->as.values);
         }
         break;
         case JANET_MEMORY_FUNCDEF: {
             JanetFuncDef *def = (JanetFuncDef *)mem;
             /* TODO - get this all with one alloc and one free */
-            free(def->defs);
-            free(def->environments);
-            free(def->constants);
-            free(def->bytecode);
-            free(def->sourcemap);
-            free(def->closure_bitset);
+            janet_free(def->defs);
+            janet_free(def->environments);
+            janet_free(def->constants);
+            janet_free(def->bytecode);
+            janet_free(def->sourcemap);
+            janet_free(def->closure_bitset);
         }
         break;
     }
@@ -347,7 +347,7 @@ void janet_sweep() {
             } else {
                 janet_vm_blocks = next;
             }
-            free(current);
+            janet_free(current);
         }
         current = next;
     }
@@ -359,7 +359,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
 
     /* Make sure everything is inited */
     janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
-    mem = malloc(size);
+    mem = janet_malloc(size);
 
     /* Check for bad malloc */
     if (NULL == mem) {
@@ -382,7 +382,7 @@ static void free_one_scratch(JanetScratch *s) {
     if (NULL != s->finalize) {
         s->finalize((char *) s->mem);
     }
-    free(s);
+    janet_free(s);
 }
 
 /* Free all allocated scratch memory */
@@ -434,7 +434,7 @@ void janet_gcroot(Janet root) {
     size_t newcount = janet_vm_root_count + 1;
     if (newcount > janet_vm_root_capacity) {
         size_t newcap = 2 * newcount;
-        janet_vm_roots = realloc(janet_vm_roots, sizeof(Janet) * newcap);
+        janet_vm_roots = janet_realloc(janet_vm_roots, sizeof(Janet) * newcap);
         if (NULL == janet_vm_roots) {
             JANET_OUT_OF_MEMORY;
         }
@@ -494,12 +494,12 @@ void janet_clear_memory(void) {
     while (NULL != current) {
         janet_deinit_block(current);
         JanetGCObject *next = current->next;
-        free(current);
+        janet_free(current);
         current = next;
     }
     janet_vm_blocks = NULL;
     janet_free_all_scratch();
-    free(janet_scratch_mem);
+    janet_free(janet_scratch_mem);
 }
 
 /* Primitives for suspending GC. */
@@ -513,14 +513,14 @@ void janet_gcunlock(int handle) {
 /* Scratch memory API */
 
 void *janet_smalloc(size_t size) {
-    JanetScratch *s = malloc(sizeof(JanetScratch) + size);
+    JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
     if (NULL == s) {
         JANET_OUT_OF_MEMORY;
     }
     s->finalize = NULL;
     if (janet_scratch_len == janet_scratch_cap) {
         size_t newcap = 2 * janet_scratch_cap + 2;
-        JanetScratch **newmem = (JanetScratch **) realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
+        JanetScratch **newmem = (JanetScratch **) janet_realloc(janet_scratch_mem, newcap * sizeof(JanetScratch));
         if (NULL == newmem) {
             JANET_OUT_OF_MEMORY;
         }
@@ -547,7 +547,7 @@ void *janet_srealloc(void *mem, size_t size) {
     if (janet_scratch_len) {
         for (size_t i = janet_scratch_len - 1; ; i--) {
             if (janet_scratch_mem[i] == s) {
-                JanetScratch *news = realloc(s, size + sizeof(JanetScratch));
+                JanetScratch *news = janet_realloc(s, size + sizeof(JanetScratch));
                 if (NULL == news) {
                     JANET_OUT_OF_MEMORY;
                 }

src/core/gc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/io.c

@@ -544,7 +544,7 @@ static Janet cfun_io_printf_impl_x(int32_t argc, Janet *argv, int newline,
     /* Clear buffer to make things easier for GC */
     buf->count = 0;
     buf->capacity = 0;
-    free(buf->data);
+    janet_free(buf->data);
     buf->data = NULL;
     return janet_wrap_nil();
 }

src/core/marsh.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -738,7 +738,7 @@ static const uint8_t *unmarshal_one_env(
             if (length == 0) {
                 janet_panic("invalid funcenv length");
             }
-            env->as.values = malloc(sizeof(Janet) * (size_t) length);
+            env->as.values = janet_malloc(sizeof(Janet) * (size_t) length);
             if (!env->as.values) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -834,7 +834,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal constants */
         if (constants_length) {
-            def->constants = malloc(sizeof(Janet) * constants_length);
+            def->constants = janet_malloc(sizeof(Janet) * constants_length);
             if (!def->constants) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -846,7 +846,7 @@ static const uint8_t *unmarshal_one_def(
         def->constants_length = constants_length;
 
         /* Unmarshal bytecode */
-        def->bytecode = malloc(sizeof(uint32_t) * bytecode_length);
+        def->bytecode = janet_malloc(sizeof(uint32_t) * bytecode_length);
         if (!def->bytecode) {
             JANET_OUT_OF_MEMORY;
         }
@@ -855,7 +855,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal environments */
         if (def->flags & JANET_FUNCDEF_FLAG_HASENVS) {
-            def->environments = calloc(1, sizeof(int32_t) * (size_t) environments_length);
+            def->environments = janet_calloc(1, sizeof(int32_t) * (size_t) environments_length);
             if (!def->environments) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -869,7 +869,7 @@ static const uint8_t *unmarshal_one_def(
 
         /* Unmarshal sub funcdefs */
         if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS) {
-            def->defs = calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
+            def->defs = janet_calloc(1, sizeof(JanetFuncDef *) * (size_t) defs_length);
             if (!def->defs) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -884,7 +884,7 @@ static const uint8_t *unmarshal_one_def(
         /* Unmarshal source maps if needed */
         if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
             int32_t current = 0;
-            def->sourcemap = malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
+            def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) bytecode_length);
             if (!def->sourcemap) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -900,7 +900,7 @@ static const uint8_t *unmarshal_one_def(
         /* Unmarshal closure bitset if needed */
         if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
             int32_t n = (def->slotcount + 31) >> 5;
-            def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
+            def->closure_bitset = janet_malloc(sizeof(uint32_t) * (size_t) n);
             if (NULL == def->closure_bitset) {
                 JANET_OUT_OF_MEMORY;
             }
@@ -961,7 +961,7 @@ static const uint8_t *unmarshal_one_fiber(
 
     /* Allocate stack memory */
     fiber->capacity = fiber_stacktop + 10;
-    fiber->data = malloc(sizeof(Janet) * fiber->capacity);
+    fiber->data = janet_malloc(sizeof(Janet) * fiber->capacity);
     if (!fiber->data) {
         JANET_OUT_OF_MEMORY;
     }

src/core/net.c

@@ -265,19 +265,20 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
 #ifndef JANET_WINDOWS
     if (janet_keyeq(argv[offset], "unix")) {
         const char *path = janet_getcstring(argv, offset + 1);
-        struct sockaddr_un *saddr = calloc(1, sizeof(struct sockaddr_un));
+        struct sockaddr_un *saddr = janet_calloc(1, sizeof(struct sockaddr_un));
         if (saddr == NULL) {
             JANET_OUT_OF_MEMORY;
         }
         saddr->sun_family = AF_UNIX;
+        size_t path_size = sizeof(saddr->sun_path);
 #ifdef JANET_LINUX
         if (path[0] == '@') {
             saddr->sun_path[0] = '\0';
-            snprintf(saddr->sun_path + 1, 107, "%s", path + 1);
+            snprintf(saddr->sun_path + 1, path_size - 1, "%s", path + 1);
         } else
 #endif
         {
-            snprintf(saddr->sun_path, 108, "%s", path);
+            snprintf(saddr->sun_path, path_size, "%s", path);
         }
         *is_unix = 1;
         return (struct addrinfo *) saddr;
@@ -397,7 +398,7 @@ static Janet cfun_net_connect(int32_t argc, Janet *argv) {
 #else
     int status = connect(sock, addr, addrlen);
     if (is_unix) {
-        free(ai);
+        janet_free(ai);
     } else {
         freeaddrinfo(ai);
     }
@@ -431,6 +432,47 @@ static const char *serverify_socket(JSock sfd) {
     return NULL;
 }
 
+#ifdef JANET_WINDOWS
+#define JANET_SHUTDOWN_RW SD_BOTH
+#define JANET_SHUTDOWN_R SD_RECEIVE
+#define JANET_SHUTDOWN_W SD_SEND
+#else
+#define JANET_SHUTDOWN_RW SHUT_RDWR
+#define JANET_SHUTDOWN_R SHUT_RD
+#define JANET_SHUTDOWN_W SHUT_WR
+#endif
+
+static Janet cfun_net_shutdown(int32_t argc, Janet *argv) {
+    janet_arity(argc, 1, 2);
+    JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
+    janet_stream_flags(stream, JANET_STREAM_SOCKET);
+    int shutdown_type = JANET_SHUTDOWN_RW;
+    if (argc == 2) {
+        const uint8_t *kw = janet_getkeyword(argv, 1);
+        if (0 == janet_cstrcmp(kw, "rw")) {
+            shutdown_type = JANET_SHUTDOWN_RW;
+        } else if (0 == janet_cstrcmp(kw, "r")) {
+            shutdown_type = JANET_SHUTDOWN_R;
+        } else if (0 == janet_cstrcmp(kw, "w")) {
+            shutdown_type = JANET_SHUTDOWN_W;
+        } else {
+            janet_panicf("unexpected keyword %v", argv[1]);
+        }
+    }
+    int status;
+#ifdef JANET_WINDOWS
+    status = shutdown((SOCKET) stream->handle, shutdown_type);
+#else
+    do {
+        status = shutdown(stream->handle, shutdown_type);
+    } while (status == -1 && errno == EINTR);
+#endif
+    if (status) {
+        janet_panicf("could not shutdown socket: %V", janet_ev_lasterr());
+    }
+    return argv[0];
+}
+
 static Janet cfun_net_listen(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 3);
 
@@ -444,20 +486,20 @@ static Janet cfun_net_listen(int32_t argc, Janet *argv) {
     if (is_unix) {
         sfd = socket(AF_UNIX, socktype | JSOCKFLAGS, 0);
         if (!JSOCKVALID(sfd)) {
-            free(ai);
+            janet_free(ai);
             janet_panicf("could not create socket: %V", janet_ev_lasterr());
         }
         const char *err = serverify_socket(sfd);
         if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
             JSOCKCLOSE(sfd);
-            free(ai);
+            janet_free(ai);
             if (err) {
                 janet_panic(err);
             } else {
                 janet_panicf("could not bind socket: %V", janet_ev_lasterr());
             }
         }
-        free(ai);
+        janet_free(ai);
     } else
 #endif
     {
@@ -622,6 +664,7 @@ static const JanetMethod net_stream_methods[] = {
     {"evread", janet_cfun_stream_read},
     {"evchunk", janet_cfun_stream_chunk},
     {"evwrite", janet_cfun_stream_write},
+    {"shutdown", cfun_net_shutdown},
     {NULL, NULL}
 };
 
@@ -709,6 +752,16 @@ static const JanetReg net_cfuns[] = {
              "that can be used to communicate with the server. Type is an optional keyword "
              "to specify a connection type, either :stream or :datagram. The default is :stream. ")
     },
+    {
+        "net/shutdown", cfun_net_shutdown,
+        JDOC("(net/shutdown stream &opt mode)\n\n"
+             "Stop communication on this socket in a graceful manner, either in both directions or just "
+             "reading/writing from the stream. The `mode` parameter controls which communication to stop on the socket. "
+             "\n\n* `:wr` is the default and prevents both reading new data from the socket and writing new data to the socket.\n"
+             "* `:r` disables reading new data from the socket.\n"
+             "* `:w` disable writing data to the socket.\n\n"
+             "Returns the original socket.")
+    },
     {NULL, NULL, NULL}
 };
 

src/core/os.c

@@ -56,7 +56,12 @@
 #include <dirent.h>
 #include <sys/types.h>
 #include <sys/wait.h>
+#ifdef JANET_APPLE
+#include <crt_externs.h>
+#define environ (*_NSGetEnviron())
+#else
 extern char **environ;
+#endif
 #ifdef JANET_THREADS
 #include <pthread.h>
 #endif
@@ -998,7 +1003,7 @@ static Janet os_spawn(int32_t argc, Janet *argv) {
 /* Runs in a separate thread */
 static JanetEVGenericMessage os_shell_subr(JanetEVGenericMessage args) {
     int stat = system((const char *) args.argp);
-    free(args.argp);
+    janet_free(args.argp);
     if (args.argi) {
         args.tag = JANET_EV_TCTAG_INTEGER;
     } else {
@@ -1761,7 +1766,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
 #endif
     if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
     Janet ret = janet_cstringv(dest);
-    free(dest);
+    janet_free(dest);
     return ret;
 #endif
 }
@@ -2085,7 +2090,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 "
@@ -2105,7 +2110,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

@@ -123,7 +123,7 @@ static void NAME(JanetParser *p, T x) { \
     if (newcount > p->STACKCAP) { \
         T *next; \
         size_t newcap = 2 * newcount; \
-        next = realloc(p->STACK, sizeof(T) * newcap); \
+        next = janet_realloc(p->STACK, sizeof(T) * newcap); \
         if (NULL == next) { \
             JANET_OUT_OF_MEMORY; \
         } \
@@ -783,9 +783,9 @@ void janet_parser_init(JanetParser *parser) {
 }
 
 void janet_parser_deinit(JanetParser *parser) {
-    free(parser->args);
-    free(parser->buf);
-    free(parser->states);
+    janet_free(parser->args);
+    janet_free(parser->buf);
+    janet_free(parser->states);
 }
 
 void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
@@ -812,17 +812,17 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
     dest->states = NULL;
     dest->buf = NULL;
     if (dest->bufcap) {
-        dest->buf = malloc(dest->bufcap);
+        dest->buf = janet_malloc(dest->bufcap);
         if (!dest->buf) goto nomem;
         memcpy(dest->buf, src->buf, dest->bufcap);
     }
     if (dest->argcap) {
-        dest->args = malloc(sizeof(Janet) * dest->argcap);
+        dest->args = janet_malloc(sizeof(Janet) * dest->argcap);
         if (!dest->args) goto nomem;
         memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
     }
     if (dest->statecap) {
-        dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
+        dest->states = janet_malloc(sizeof(JanetParseState) * dest->statecap);
         if (!dest->states) goto nomem;
         memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
     }
@@ -943,7 +943,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
         size_t newcount = p->bufcount + slen;
         if (p->bufcap < newcount) {
             size_t newcap = 2 * newcount;
-            p->buf = realloc(p->buf, newcap);
+            p->buf = janet_realloc(p->buf, newcap);
             if (p->buf == NULL) {
                 JANET_OUT_OF_MEMORY;
             }

src/core/peg.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -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);
@@ -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. */
@@ -1120,7 +1148,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
     for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
         Janet nextPeg = janet_table_get_ex(grammar, peg, &grammar);
         if (!grammar || janet_checktype(nextPeg, JANET_NIL)) {
-            nextPeg = janet_table_get(b->default_grammar, peg);
+            nextPeg = (b->default_grammar == NULL)
+                      ? janet_wrap_nil()
+                      : janet_table_get(b->default_grammar, peg);
             if (janet_checktype(nextPeg, JANET_NIL)) {
                 peg_panic(b, "unknown rule");
             }
@@ -1307,7 +1337,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
      * bytecode. */
     uint32_t blen = (int32_t) peg->bytecode_len;
     uint32_t clen = peg->num_constants;
-    uint8_t *op_flags = calloc(1, blen);
+    uint8_t *op_flags = janet_calloc(1, blen);
     if (NULL == op_flags) {
         JANET_OUT_OF_MEMORY;
     }
@@ -1392,6 +1422,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;
@@ -1437,11 +1468,11 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
     peg->bytecode = bytecode;
     peg->constants = constants;
     peg->has_backref = has_backref;
-    free(op_flags);
+    janet_free(op_flags);
     return peg;
 
 bad:
-    free(op_flags);
+    janet_free(op_flags);
     janet_panic("invalid peg bytecode");
 }
 

src/core/pp.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -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 = (int32_t)(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/regalloc.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -36,7 +36,7 @@ void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
 }
 
 void janetc_regalloc_deinit(JanetcRegisterAllocator *ra) {
-    free(ra->chunks);
+    janet_free(ra->chunks);
 }
 
 /* Fallbacks for when ctz not available */
@@ -70,7 +70,7 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
     size = sizeof(uint32_t) * (size_t) dest->capacity;
     dest->regtemps = 0;
     if (size) {
-        dest->chunks = malloc(size);
+        dest->chunks = janet_malloc(size);
         if (!dest->chunks) {
             JANET_OUT_OF_MEMORY;
         }
@@ -87,7 +87,7 @@ static void pushchunk(JanetcRegisterAllocator *ra) {
     int32_t newcount = ra->count + 1;
     if (newcount > ra->capacity) {
         int32_t newcapacity = newcount * 2;
-        ra->chunks = realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
+        ra->chunks = janet_realloc(ra->chunks, (size_t) newcapacity * sizeof(uint32_t));
         if (!ra->chunks) {
             JANET_OUT_OF_MEMORY;
         }

src/core/regalloc.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/run.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/specials.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -251,6 +251,9 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
             case JANET_STRING:
                 janet_table_put(tab, janet_ckeywordv("doc"), attr);
                 break;
+            case JANET_STRUCT:
+                janet_table_merge_struct(tab, janet_unwrap_struct(attr));
+                break;
         }
     }
     return tab;
@@ -407,7 +410,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
         right = janetc_value(bodyopts, truebody);
         if (!drop && !tail) janetc_copy(c, target, right);
         janetc_popscope(c);
-        janetc_throwaway(bodyopts, falsebody);
+        if (!janet_checktype(falsebody, JANET_NIL)) {
+            janetc_throwaway(bodyopts, falsebody);
+        }
         janetc_popscope(c);
         return target;
     }

src/core/state.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/string.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -108,7 +108,7 @@ static void kmp_init(
     if (patlen == 0) {
         janet_panic("expected non-empty pattern");
     }
-    int32_t *lookup = calloc(patlen, sizeof(int32_t));
+    int32_t *lookup = janet_calloc(patlen, sizeof(int32_t));
     if (!lookup) {
         JANET_OUT_OF_MEMORY;
     }
@@ -131,7 +131,7 @@ static void kmp_init(
 }
 
 static void kmp_deinit(struct kmp_state *state) {
-    free(state->lookup);
+    janet_free(state->lookup);
 }
 
 static void kmp_seti(struct kmp_state *state, int32_t i) {
@@ -589,14 +589,14 @@ static const JanetReg string_cfuns[] = {
     },
     {
         "string/find", cfun_string_find,
-        JDOC("(string/find patt str)\n\n"
+        JDOC("(string/find patt str &opt start-index)\n\n"
              "Searches for the first instance of pattern patt in string "
              "str. Returns the index of the first character in patt if found, "
              "otherwise returns nil.")
     },
     {
         "string/find-all", cfun_string_findall,
-        JDOC("(string/find-all patt str)\n\n"
+        JDOC("(string/find-all patt str &opt start-index)\n\n"
              "Searches for all instances of pattern patt in string "
              "str. Returns an array of all indices of found patterns. Overlapping "
              "instances of the pattern are counted individually, meaning a byte in str "

src/core/strtod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -87,7 +87,7 @@ static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
     int32_t newn = oldn + n;
     if (mant->cap < newn) {
         int32_t newcap = 2 * newn;
-        uint32_t *mem = realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
+        uint32_t *mem = janet_realloc(mant->digits, (size_t) newcap * sizeof(uint32_t));
         if (NULL == mem) {
             JANET_OUT_OF_MEMORY;
         }
@@ -368,11 +368,11 @@ int janet_scan_number(
         goto error;
 
     *out = convert(neg, &mant, base, ex);
-    free(mant.digits);
+    janet_free(mant.digits);
     return 0;
 
 error:
-    free(mant.digits);
+    janet_free(mant.digits);
     return 1;
 }
 

src/core/struct.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/symcache.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -45,7 +45,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
 /* Initialize the cache (allocate cache memory) */
 void janet_symcache_init() {
     janet_vm_cache_capacity = 1024;
-    janet_vm_cache = calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
+    janet_vm_cache = janet_calloc(1, (size_t) janet_vm_cache_capacity * sizeof(const uint8_t *));
     if (NULL == janet_vm_cache) {
         JANET_OUT_OF_MEMORY;
     }
@@ -55,7 +55,7 @@ void janet_symcache_init() {
 
 /* Deinitialize the cache (free the cache memory) */
 void janet_symcache_deinit() {
-    free((void *)janet_vm_cache);
+    janet_free((void *)janet_vm_cache);
     janet_vm_cache = NULL;
     janet_vm_cache_capacity = 0;
     janet_vm_cache_count = 0;
@@ -122,7 +122,7 @@ notfound:
 static void janet_cache_resize(uint32_t newCapacity) {
     uint32_t i, oldCapacity;
     const uint8_t **oldCache = janet_vm_cache;
-    const uint8_t **newCache = calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
+    const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
     if (newCache == NULL) {
         JANET_OUT_OF_MEMORY;
     }
@@ -145,7 +145,7 @@ static void janet_cache_resize(uint32_t newCapacity) {
         }
     }
     /* Free the old cache */
-    free((void *)oldCache);
+    janet_free((void *)oldCache);
 }
 
 /* Add an item to the cache */

src/core/symcache.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/table.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -117,7 +117,7 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
     if (islocal) {
         janet_sfree(olddata);
     } else {
-        free(olddata);
+        janet_free(olddata);
     }
 }
 
@@ -237,7 +237,7 @@ JanetTable *janet_table_clone(JanetTable *table) {
     newTable->capacity = table->capacity;
     newTable->deleted = table->deleted;
     newTable->proto = table->proto;
-    newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
+    newTable->data = janet_malloc(newTable->capacity * sizeof(JanetKV));
     if (NULL == newTable->data) {
         JANET_OUT_OF_MEMORY;
     }

src/core/thread.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -93,7 +93,7 @@ static JanetTable *janet_thread_get_decode(void) {
 }
 
 static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
-    JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
+    JanetMailbox *mailbox = janet_malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
     if (NULL == mailbox) {
         JANET_OUT_OF_MEMORY;
     }
@@ -126,7 +126,7 @@ static void janet_mailbox_destroy(JanetMailbox *mailbox) {
     for (uint16_t i = 0; i < mailbox->messageCapacity; i++) {
         janet_buffer_deinit(mailbox->messages + i);
     }
-    free(mailbox);
+    janet_free(mailbox);
 }
 
 static void janet_mailbox_lock(JanetMailbox *mailbox) {
@@ -185,7 +185,7 @@ static int thread_mark(void *p, size_t size) {
 }
 
 static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
-    JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
+    JanetMailboxPair *pair = janet_malloc(sizeof(JanetMailboxPair));
     if (NULL == pair) {
         JANET_OUT_OF_MEMORY;
     }
@@ -199,7 +199,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flag
 static void destroy_mailbox_pair(JanetMailboxPair *pair) {
     janet_mailbox_ref(pair->original, -1);
     janet_mailbox_ref(pair->newbox, -1);
-    free(pair);
+    janet_free(pair);
 }
 
 /* Abstract waiting for timeout across windows/posix */

src/core/tuple.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/typedarray.c

@@ -1,614 +0,0 @@
-/*
-* Copyright (c) 2020 Calvin Rose & contributors
-*
-* Permission is hereby granted, free of charge, to any person obtaining a copy
-* of this software and associated documentation files (the "Software"), to
-* deal in the Software without restriction, including without limitation the
-* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
-* sell copies of the Software, and to permit persons to whom the Software is
-* furnished to do so, subject to the following conditions:
-*
-* The above copyright notice and this permission notice shall be included in
-* all copies or substantial portions of the Software.
-*
-* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
-* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
-* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
-* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
-* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
-* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
-* IN THE SOFTWARE.
-*/
-
-#ifndef JANET_AMALG
-#include "features.h"
-#include <janet.h>
-#include "util.h"
-#endif
-
-#ifdef JANET_TYPED_ARRAY
-
-static char *ta_type_names[] = {
-    "uint8",
-    "int8",
-    "uint16",
-    "int16",
-    "uint32",
-    "int32",
-    "uint64",
-    "int64",
-    "float32",
-    "float64",
-    "?"
-};
-
-static size_t ta_type_sizes[] = {
-    sizeof(uint8_t),
-    sizeof(int8_t),
-    sizeof(uint16_t),
-    sizeof(int16_t),
-    sizeof(uint32_t),
-    sizeof(int32_t),
-    sizeof(uint64_t),
-    sizeof(int64_t),
-    sizeof(float),
-    sizeof(double),
-    0
-};
-
-#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_F64 + 1)
-#define TA_ATOM_MAXSIZE 8
-#define TA_FLAG_BIG_ENDIAN 1
-
-static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
-    for (int i = 0; i < TA_COUNT_TYPES; i++) {
-        if (!janet_cstrcmp(name, ta_type_names[i]))
-            return i;
-    }
-    janet_panicf("invalid typed array type %S", name);
-    return 0;
-}
-
-static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
-    buf->data = NULL;
-    if (size > 0) {
-        buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
-        if (buf->data == NULL) {
-            JANET_OUT_OF_MEMORY;
-        }
-    }
-    buf->size = size;
-#ifdef JANET_BIG_ENDIAN
-    buf->flags = TA_FLAG_BIG_ENDIAN;
-#else
-    buf->flags = 0;
-#endif
-    return buf;
-}
-
-static int ta_buffer_gc(void *p, size_t s) {
-    (void) s;
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
-    free(buf->data);
-    return 0;
-}
-
-static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
-    janet_marshal_abstract(ctx, p);
-    janet_marshal_size(ctx, buf->size);
-    janet_marshal_int(ctx, buf->flags);
-    janet_marshal_bytes(ctx, buf->data, buf->size);
-}
-
-static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
-    JanetTArrayBuffer *buf = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayBuffer));
-    size_t size = janet_unmarshal_size(ctx);
-    int32_t flags = janet_unmarshal_int(ctx);
-    ta_buffer_init(buf, size);
-    buf->flags = flags;
-    janet_unmarshal_bytes(ctx, buf->data, size);
-    return buf;
-}
-
-const JanetAbstractType janet_ta_buffer_type = {
-    "ta/buffer",
-    ta_buffer_gc,
-    NULL,
-    NULL,
-    NULL,
-    ta_buffer_marshal,
-    ta_buffer_unmarshal,
-    JANET_ATEND_UNMARSHAL
-};
-
-static int ta_mark(void *p, size_t s) {
-    (void) s;
-    JanetTArrayView *view = (JanetTArrayView *)p;
-    janet_mark(janet_wrap_abstract(view->buffer));
-    return 0;
-}
-
-static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
-    JanetTArrayView *view = (JanetTArrayView *)p;
-    size_t offset = (view->buffer->data - view->as.u8);
-    janet_marshal_abstract(ctx, p);
-    janet_marshal_size(ctx, view->size);
-    janet_marshal_size(ctx, view->stride);
-    janet_marshal_int(ctx, view->type);
-    janet_marshal_size(ctx, offset);
-    janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
-}
-
-static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
-    size_t offset;
-    int32_t atype;
-    Janet buffer;
-    JanetTArrayView *view = janet_unmarshal_abstract(ctx, sizeof(JanetTArrayView));
-    view->size = janet_unmarshal_size(ctx);
-    view->stride = janet_unmarshal_size(ctx);
-    atype = janet_unmarshal_int(ctx);
-    if (atype < 0 || atype >= TA_COUNT_TYPES)
-        janet_panic("bad typed array type");
-    view->type = atype;
-    offset = janet_unmarshal_size(ctx);
-    buffer = janet_unmarshal_janet(ctx);
-    if (!janet_checktype(buffer, JANET_ABSTRACT) ||
-            (janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
-        janet_panicf("expected typed array buffer");
-    }
-    view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
-    size_t buf_need_size = offset + (ta_type_sizes[view->type]) * ((view->size - 1) * view->stride + 1);
-    if (view->buffer->size < buf_need_size)
-        janet_panic("bad typed array offset in marshalled data");
-    view->as.u8 = view->buffer->data + offset;
-    return view;
-}
-
-static JanetMethod tarray_view_methods[6];
-
-static int ta_getter(void *p, Janet key, Janet *out) {
-    size_t index, i;
-    JanetTArrayView *array = p;
-    if (janet_checktype(key, JANET_KEYWORD)) {
-        return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods, out);
-    }
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    index = (size_t) janet_unwrap_number(key);
-    i = index * array->stride;
-    if (index >= array->size) {
-        return 0;
-    } else {
-        switch (array->type) {
-            case JANET_TARRAY_TYPE_U8:
-                *out = janet_wrap_number(array->as.u8[i]);
-                break;
-            case JANET_TARRAY_TYPE_S8:
-                *out = janet_wrap_number(array->as.s8[i]);
-                break;
-            case JANET_TARRAY_TYPE_U16:
-                *out = janet_wrap_number(array->as.u16[i]);
-                break;
-            case JANET_TARRAY_TYPE_S16:
-                *out = janet_wrap_number(array->as.s16[i]);
-                break;
-            case JANET_TARRAY_TYPE_U32:
-                *out = janet_wrap_number(array->as.u32[i]);
-                break;
-            case JANET_TARRAY_TYPE_S32:
-                *out = janet_wrap_number(array->as.s32[i]);
-                break;
-#ifdef JANET_INT_TYPES
-            case JANET_TARRAY_TYPE_U64:
-                *out = janet_wrap_u64(array->as.u64[i]);
-                break;
-            case JANET_TARRAY_TYPE_S64:
-                *out = janet_wrap_s64(array->as.s64[i]);
-                break;
-#endif
-            case JANET_TARRAY_TYPE_F32:
-                *out = janet_wrap_number_safe(array->as.f32[i]);
-                break;
-            case JANET_TARRAY_TYPE_F64:
-                *out = janet_wrap_number_safe(array->as.f64[i]);
-                break;
-            default:
-                janet_panicf("cannot get from typed array of type %s",
-                             ta_type_names[array->type]);
-                break;
-        }
-    }
-    return 1;
-}
-
-static void ta_setter(void *p, Janet key, Janet value) {
-    size_t index, i;
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    index = (size_t) janet_unwrap_number(key);
-    JanetTArrayView *array = p;
-    i = index * array->stride;
-    if (index >= array->size) {
-        janet_panic("index out of bounds");
-    }
-    if (!janet_checktype(value, JANET_NUMBER) &&
-            array->type != JANET_TARRAY_TYPE_U64 &&
-            array->type != JANET_TARRAY_TYPE_S64) {
-        janet_panic("expected number value");
-    }
-    switch (array->type) {
-        case JANET_TARRAY_TYPE_U8:
-            array->as.u8[i] = (uint8_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S8:
-            array->as.s8[i] = (int8_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_U16:
-            array->as.u16[i] = (uint16_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S16:
-            array->as.s16[i] = (int16_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_U32:
-            array->as.u32[i] = (uint32_t) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_S32:
-            array->as.s32[i] = (int32_t) janet_unwrap_number(value);
-            break;
-#ifdef JANET_INT_TYPES
-        case JANET_TARRAY_TYPE_U64:
-            array->as.u64[i] = janet_unwrap_u64(value);
-            break;
-        case JANET_TARRAY_TYPE_S64:
-            array->as.s64[i] = janet_unwrap_s64(value);
-            break;
-#endif
-        case JANET_TARRAY_TYPE_F32:
-            array->as.f32[i] = (float) janet_unwrap_number(value);
-            break;
-        case JANET_TARRAY_TYPE_F64:
-            array->as.f64[i] = janet_unwrap_number(value);
-            break;
-        default:
-            janet_panicf("cannot set typed array of type %s",
-                         ta_type_names[array->type]);
-            break;
-    }
-}
-
-static Janet ta_view_next(void *p, Janet key) {
-    JanetTArrayView *view = p;
-    if (janet_checktype(key, JANET_NIL)) {
-        if (view->size > 0) {
-            return janet_wrap_number(0);
-        } else {
-            return janet_wrap_nil();
-        }
-    }
-    if (!janet_checksize(key)) janet_panic("expected size as key");
-    size_t index = (size_t) janet_unwrap_number(key);
-    index++;
-    if (index < view->size) {
-        return janet_wrap_number((double) index);
-    }
-    return janet_wrap_nil();
-}
-
-const JanetAbstractType janet_ta_view_type = {
-    "ta/view",
-    NULL,
-    ta_mark,
-    ta_getter,
-    ta_setter,
-    ta_view_marshal,
-    ta_view_unmarshal,
-    NULL,
-    NULL,
-    NULL,
-    ta_view_next,
-    JANET_ATEND_NEXT
-};
-
-JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
-    JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-    ta_buffer_init(buf, size);
-    return buf;
-}
-
-JanetTArrayView *janet_tarray_view(
-    JanetTArrayType type,
-    size_t size,
-    size_t stride,
-    size_t offset,
-    JanetTArrayBuffer *buffer) {
-
-    JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
-
-    if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
-    size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
-
-    if (NULL == buffer) {
-        buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-        ta_buffer_init(buffer, buf_size);
-    }
-
-    if (buffer->size < buf_size) {
-        janet_panicf("bad buffer size, %i bytes allocated < %i required",
-                     buffer->size,
-                     buf_size);
-    }
-
-    view->buffer = buffer;
-    view->stride = stride;
-    view->size = size;
-    view->as.u8 = buffer->data + offset;
-    view->type = type;
-
-    return view;
-}
-
-JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &janet_ta_buffer_type);
-}
-
-JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
-    return janet_getabstract(argv, n, &janet_ta_view_type);
-}
-
-JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
-    JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
-    if (view->type != type) {
-        janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
-                     n, ta_type_names[type], argv[n]);
-    }
-    return view;
-}
-
-static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
-    janet_arity(argc, 2, 5);
-    size_t offset = 0;
-    size_t stride = 1;
-    JanetTArrayBuffer *buffer = NULL;
-    const uint8_t *keyw = janet_getkeyword(argv, 0);
-    JanetTArrayType type = get_ta_type_by_name(keyw);
-    size_t size = janet_getsize(argv, 1);
-    if (argc > 2)
-        stride = janet_getsize(argv, 2);
-    if (argc > 3)
-        offset = janet_getsize(argv, 3);
-    if (argc > 4) {
-        int32_t blen;
-        const uint8_t *bytes;
-        if (janet_bytes_view(argv[4], &bytes, &blen)) {
-            buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
-            ta_buffer_init(buffer, (size_t) blen);
-            memcpy(buffer->data, bytes, blen);
-        } else {
-            if (!janet_checktype(argv[4], JANET_ABSTRACT)) {
-                janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
-                             4, argv[4]);
-            }
-            void *p = janet_unwrap_abstract(argv[4]);
-            if (janet_abstract_type(p) == &janet_ta_view_type) {
-                JanetTArrayView *view = (JanetTArrayView *)p;
-                offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
-                stride *= view->stride;
-                buffer = view->buffer;
-            } else if (janet_abstract_type(p) == &janet_ta_buffer_type) {
-                buffer = p;
-            } else {
-                janet_panicf("bad slot #%d, expected ta/view|ta/buffer, got %v",
-                             4, argv[4]);
-            }
-        }
-    }
-    JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
-    return janet_wrap_abstract(view);
-}
-
-static JanetTArrayView *ta_is_view(Janet x) {
-    if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
-    void *abst = janet_unwrap_abstract(x);
-    if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
-    return (JanetTArrayView *)abst;
-}
-
-static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        return janet_wrap_abstract(view->buffer);
-    }
-    size_t size = janet_getsize(argv, 0);
-    JanetTArrayBuffer *buf = janet_tarray_buffer(size);
-    return janet_wrap_abstract(buf);
-}
-
-static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        return janet_wrap_number((double) view->size);
-    }
-    JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
-    return janet_wrap_number((double) buf->size);
-}
-
-static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
-    JanetTArrayView *view;
-    if ((view = ta_is_view(argv[0]))) {
-        JanetTArrayView *view = janet_unwrap_abstract(argv[0]);
-        JanetKV *props = janet_struct_begin(6);
-        ptrdiff_t boffset = view->as.u8 - view->buffer->data;
-        janet_struct_put(props, janet_ckeywordv("size"),
-                         janet_wrap_number((double) view->size));
-        janet_struct_put(props, janet_ckeywordv("byte-offset"),
-                         janet_wrap_number((double) boffset));
-        janet_struct_put(props, janet_ckeywordv("stride"),
-                         janet_wrap_number((double) view->stride));
-        janet_struct_put(props, janet_ckeywordv("type"),
-                         janet_ckeywordv(ta_type_names[view->type]));
-        janet_struct_put(props, janet_ckeywordv("type-size"),
-                         janet_wrap_number((double) ta_type_sizes[view->type]));
-        janet_struct_put(props, janet_ckeywordv("buffer"),
-                         janet_wrap_abstract(view->buffer));
-        return janet_wrap_struct(janet_struct_end(props));
-    } else {
-        JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
-        JanetKV *props = janet_struct_begin(2);
-        janet_struct_put(props, janet_ckeywordv("size"),
-                         janet_wrap_number((double) buffer->size));
-        janet_struct_put(props, janet_ckeywordv("big-endian"),
-                         janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
-        return janet_wrap_struct(janet_struct_end(props));
-    }
-}
-
-static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
-    janet_arity(argc, 1, 3);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    JanetRange range;
-    int32_t length = (int32_t)src->size;
-    if (argc == 1) {
-        range.start = 0;
-        range.end = length;
-    } else if (argc == 2) {
-        range.start = janet_gethalfrange(argv, 1, length, "start");
-        range.end = length;
-    } else {
-        range.start = janet_gethalfrange(argv, 1, length, "start");
-        range.end = janet_gethalfrange(argv, 2, length, "end");
-        if (range.end < range.start)
-            range.end = range.start;
-    }
-    JanetArray *array = janet_array(range.end - range.start);
-    if (array->data) {
-        for (int32_t i = range.start; i < range.end; i++) {
-            if (!ta_getter(src, janet_wrap_number(i), &array->data[i - range.start]))
-                array->data[i - range.start] = janet_wrap_nil();
-        }
-    }
-    array->count = range.end - range.start;
-    return janet_wrap_array(array);
-}
-
-static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
-    janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
-    size_t index_dst = janet_getsize(argv, 3);
-    size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
-    size_t src_atom_size = ta_type_sizes[src->type];
-    size_t dst_atom_size = ta_type_sizes[dst->type];
-    size_t step_src = src->stride * src_atom_size;
-    size_t step_dst = dst->stride * dst_atom_size;
-    size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
-    size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
-    uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
-    if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
-            (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
-        for (size_t i = 0; i < count; i++) {
-            memmove(pd, ps, src_atom_size);
-            pd += step_dst;
-            ps += step_src;
-        }
-    } else {
-        janet_panic("typed array copy out of bounds");
-    }
-    return janet_wrap_nil();
-}
-
-static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
-    janet_arity(argc, 4, 5);
-    JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
-    size_t index_src = janet_getsize(argv, 1);
-    JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
-    size_t index_dst = janet_getsize(argv, 3);
-    size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
-    size_t src_atom_size = ta_type_sizes[src->type];
-    size_t dst_atom_size = ta_type_sizes[dst->type];
-    size_t step_src = src->stride * src_atom_size;
-    size_t step_dst = dst->stride * dst_atom_size;
-    size_t pos_src = (src->as.u8 - src->buffer->data) + (index_src * step_src);
-    size_t pos_dst = (dst->as.u8 - dst->buffer->data) + (index_dst * step_dst);
-    uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
-    uint8_t temp[TA_ATOM_MAXSIZE];
-    if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
-            (pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
-        for (size_t i = 0; i < count; i++) {
-            memcpy(temp, ps, src_atom_size);
-            memcpy(ps, pd, src_atom_size);
-            memcpy(pd, temp, src_atom_size);
-            pd += step_dst;
-            ps += step_src;
-        }
-    } else {
-        janet_panic("typed array swap out of bounds");
-    }
-    return janet_wrap_nil();
-}
-
-static const JanetReg ta_cfuns[] = {
-    {
-        "tarray/new", cfun_typed_array_new,
-        JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
-             "Create new typed array.")
-    },
-    {
-        "tarray/buffer", cfun_typed_array_buffer,
-        JDOC("(tarray/buffer array|size)\n\n"
-             "Return typed array buffer or create a new buffer.")
-    },
-    {
-        "tarray/length", cfun_typed_array_size,
-        JDOC("(tarray/length array|buffer)\n\n"
-             "Return typed array or buffer size.")
-    },
-    {
-        "tarray/properties", cfun_typed_array_properties,
-        JDOC("(tarray/properties array)\n\n"
-             "Return typed array properties as a struct.")
-    },
-    {
-        "tarray/copy-bytes", cfun_typed_array_copy_bytes,
-        JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
-             "Copy count elements (default 1) of src array from index sindex "
-             "to dst array at position dindex "
-             "memory can overlap.")
-    },
-    {
-        "tarray/swap-bytes", cfun_typed_array_swap_bytes,
-        JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
-             "Swap count elements (default 1) between src array from index sindex "
-             "and dst array at position dindex "
-             "memory can overlap.")
-    },
-    {
-        "tarray/slice", cfun_typed_array_slice,
-        JDOC("(tarray/slice tarr &opt start end)\n\n"
-             "Takes a slice of a typed array from start to end. The range is half "
-             "open, [start, end). Indexes can also be negative, indicating indexing "
-             "from the end of the end of the typed array. By default, start is 0 and end is "
-             "the size of the typed array. Returns a new janet array.")
-    },
-    {NULL, NULL, NULL}
-};
-
-static JanetMethod tarray_view_methods[] = {
-    {"length", cfun_typed_array_size},
-    {"properties", cfun_typed_array_properties},
-    {"copy-bytes", cfun_typed_array_copy_bytes},
-    {"swap-bytes", cfun_typed_array_swap_bytes},
-    {"slice", cfun_typed_array_slice},
-    {NULL, NULL}
-};
-
-/* Module entry point */
-void janet_lib_typed_array(JanetTable *env) {
-    janet_core_cfuns(env, NULL, ta_cfuns);
-    janet_register_abstract_type(&janet_ta_buffer_type);
-    janet_register_abstract_type(&janet_ta_view_type);
-}
-
-#endif

src/core/util.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -397,7 +397,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
     if (NULL != regprefix) {
         prefixlen = strlen(regprefix);
         bufsize = prefixlen + 256;
-        longname_buffer = malloc(bufsize);
+        longname_buffer = janet_malloc(bufsize);
         if (NULL == longname_buffer) {
             JANET_OUT_OF_MEMORY;
         }
@@ -413,7 +413,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
             int32_t totallen = (int32_t) prefixlen + nmlen;
             if ((size_t) totallen > bufsize) {
                 bufsize = (size_t)(totallen) + 128;
-                longname_buffer = realloc(longname_buffer, bufsize);
+                longname_buffer = janet_realloc(longname_buffer, bufsize);
                 if (NULL == longname_buffer) {
                     JANET_OUT_OF_MEMORY;
                 }
@@ -436,7 +436,7 @@ static void _janet_cfuns_prefix(JanetTable *env, const char *regprefix, const Ja
         janet_table_put(janet_vm_registry, fun, name);
         cfuns++;
     }
-    free(longname_buffer);
+    (janet_free)(longname_buffer);
 }
 
 void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
@@ -487,27 +487,60 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
 }
 #endif
 
-/* Resolve a symbol in the environment */
-JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
+JanetBinding janet_resolve_ext(JanetTable *env, const uint8_t *sym) {
     Janet ref;
     JanetTable *entry_table;
     Janet entry = janet_table_get(env, janet_wrap_symbol(sym));
+    JanetBinding binding = {
+        JANET_BINDING_NONE,
+        janet_wrap_nil(),
+        JANET_BINDING_DEP_NONE
+    };
+
+    /* Check environment for entry */
     if (!janet_checktype(entry, JANET_TABLE))
-        return JANET_BINDING_NONE;
+        return binding;
     entry_table = janet_unwrap_table(entry);
+
+    /* deprecation check */
+    Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
+    if (janet_checktype(deprecate, JANET_KEYWORD)) {
+        JanetKeyword depkw = janet_unwrap_keyword(deprecate);
+        if (!janet_cstrcmp(depkw, "relaxed")) {
+            binding.deprecation = JANET_BINDING_DEP_RELAXED;
+        } else if (!janet_cstrcmp(depkw, "normal")) {
+            binding.deprecation = JANET_BINDING_DEP_NORMAL;
+        } else if (!janet_cstrcmp(depkw, "strict")) {
+            binding.deprecation = JANET_BINDING_DEP_STRICT;
+        }
+    } else if (!janet_checktype(deprecate, JANET_NIL)) {
+        binding.deprecation = JANET_BINDING_DEP_NORMAL;
+    }
+
     if (!janet_checktype(
                 janet_table_get(entry_table, janet_ckeywordv("macro")),
                 JANET_NIL)) {
-        *out = janet_table_get(entry_table, janet_ckeywordv("value"));
-        return JANET_BINDING_MACRO;
+        binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
+        binding.type = JANET_BINDING_MACRO;
+        return binding;
     }
+
     ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
     if (janet_checktype(ref, JANET_ARRAY)) {
-        *out = ref;
-        return JANET_BINDING_VAR;
+        binding.value = ref;
+        binding.type = JANET_BINDING_VAR;
+        return binding;
     }
-    *out = janet_table_get(entry_table, janet_ckeywordv("value"));
-    return JANET_BINDING_DEF;
+
+    binding.value = janet_table_get(entry_table, janet_ckeywordv("value"));
+    binding.type = JANET_BINDING_DEF;
+    return binding;
+}
+
+JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
+    JanetBinding binding = janet_resolve_ext(env, sym);
+    *out = binding.value;
+    return binding.type;
 }
 
 /* Resolve a symbol in the core environment. */
@@ -602,6 +635,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 */
@@ -688,3 +753,21 @@ int janet_cryptorand(uint8_t *out, size_t n) {
     return -1;
 #endif
 }
+
+
+/* Alloc function macro fills */
+void *(janet_malloc)(size_t size) {
+    return janet_malloc(size);
+}
+
+void (janet_free)(void *ptr) {
+    janet_free(ptr);
+}
+
+void *(janet_calloc)(size_t nmemb, size_t size) {
+    return janet_calloc(nmemb, size);
+}
+
+void *(janet_realloc)(void *ptr, size_t size) {
+    return janet_realloc(ptr, size);
+}

src/core/util.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -52,12 +52,6 @@
     if (!(c)) JANET_EXIT((m)); \
 } while (0)
 
-/* What to do when out of memory */
-#ifndef JANET_OUT_OF_MEMORY
-#include <stdio.h>
-#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
-#endif
-
 /* Omit docstrings in some builds */
 #ifndef JANET_BOOTSTRAP
 #define JDOC(x) NULL

src/core/value.c

@@ -47,7 +47,7 @@ static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
         if (newsize < 128) {
             newsize = 128;
         }
-        JanetTraversalNode *tn = realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
+        JanetTraversalNode *tn = janet_realloc(janet_vm_traversal_base, newsize * sizeof(JanetTraversalNode));
         if (tn == NULL) {
             JANET_OUT_OF_MEMORY;
         }

src/core/vector.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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,7 +43,7 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
     int32_t *p;
     if (NULL == v) return NULL;
     size_t size = (size_t) itemsize * janet_v__cnt(v);
-    p = malloc(size);
+    p = janet_malloc(size);
     if (NULL != p) {
         safe_memcpy(p, v, size);
         return p;

src/core/vector.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

src/core/vm.c

@@ -275,11 +275,16 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
     return janet_method_invoke(callee, argc, fiber->data + fiber->stacktop);
 }
 
+/* Method lookup could potentially handle tables specially... */
+static Janet method_to_fun(Janet method, Janet obj) {
+    return janet_get(obj, method);
+}
+
 /* Get a callable from a keyword method name and ensure that it is valid. */
 static Janet resolve_method(Janet name, JanetFiber *fiber) {
     int32_t argc = fiber->stacktop - fiber->stackstart;
     if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
-    Janet callee = janet_get(fiber->data[fiber->stackstart], name);
+    Janet callee = method_to_fun(name, fiber->data[fiber->stackstart]);
     if (janet_checktype(callee, JANET_NIL))
         janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
     return callee;
@@ -287,8 +292,7 @@ static Janet resolve_method(Janet name, JanetFiber *fiber) {
 
 /* Lookup method on value x */
 static Janet janet_method_lookup(Janet x, const char *name) {
-    Janet kname = janet_ckeywordv(name);
-    return janet_get(x, kname);
+    return method_to_fun(janet_ckeywordv(name), x);
 }
 
 /* Call a method first on the righthand side, and then on the left hand side with a prefix */
@@ -1542,7 +1546,7 @@ int janet_init(void) {
 void janet_deinit(void) {
     janet_clear_memory();
     janet_symcache_deinit();
-    free(janet_vm_roots);
+    janet_free(janet_vm_roots);
     janet_vm_roots = NULL;
     janet_vm_root_count = 0;
     janet_vm_root_capacity = 0;
@@ -1550,7 +1554,7 @@ void janet_deinit(void) {
     janet_vm_abstract_registry = NULL;
     janet_vm_core_env = NULL;
     janet_vm_top_dyns = NULL;
-    free(janet_vm_traversal_base);
+    janet_free(janet_vm_traversal_base);
     janet_vm_fiber = NULL;
     janet_vm_root_fiber = NULL;
 #ifdef JANET_THREADS

src/core/wrap.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -162,7 +162,7 @@ Janet(janet_wrap_number)(double x) {
 
 void *janet_memalloc_empty(int32_t count) {
     int32_t i;
-    void *mem = malloc((size_t) count * sizeof(JanetKV));
+    void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
     janet_vm_next_collection += (size_t) count * sizeof(JanetKV);
     if (NULL == mem) {
         JANET_OUT_OF_MEMORY;

src/include/janet.h

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -172,11 +172,6 @@ extern "C" {
 #define JANET_PEG
 #endif
 
-/* Enable or disable the typedarray module */
-#ifndef JANET_NO_TYPED_ARRAY
-#define JANET_TYPED_ARRAY
-#endif
-
 /* Enable or disable event loop */
 #if !defined(JANET_NO_EV) && !defined(__EMSCRIPTEN__)
 #define JANET_EV
@@ -288,15 +283,21 @@ typedef struct {
     JANET_CURRENT_CONFIG_BITS })
 #endif
 
+/* What to do when out of memory */
+#ifndef JANET_OUT_OF_MEMORY
+#include <stdio.h>
+#define JANET_OUT_OF_MEMORY do { fprintf(stderr, "janet out of memory\n"); exit(1); } while (0)
+#endif
 
 /***** END SECTION CONFIG *****/
 
 /***** START SECTION TYPES *****/
 
 #ifdef JANET_WINDOWS
-// Must be defined before including stdlib.h
+/* Must be defined before including stdlib.h */
 #define _CRT_RAND_S
 #endif
+
 #include <stdlib.h>
 #include <stdint.h>
 #include <string.h>
@@ -1404,6 +1405,11 @@ struct JanetCompileResult {
     enum JanetCompileStatus status;
 };
 JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetString where);
+JANET_API JanetCompileResult janet_compile_lint(
+    Janet source,
+    JanetTable *env,
+    JanetString where,
+    JanetArray *lints);
 
 /* Get the default environment for janet */
 JANET_API JanetTable *janet_core_env(JanetTable *replacements);
@@ -1630,6 +1636,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);
@@ -1658,11 +1665,24 @@ typedef enum {
     JANET_BINDING_VAR,
     JANET_BINDING_MACRO
 } JanetBindingType;
+
+typedef struct {
+    JanetBindingType type;
+    Janet value;
+    enum {
+        JANET_BINDING_DEP_NONE,
+        JANET_BINDING_DEP_RELAXED,
+        JANET_BINDING_DEP_NORMAL,
+        JANET_BINDING_DEP_STRICT,
+    } deprecation;
+} JanetBinding;
+
 JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const char *documentation);
 JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
 JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
 JANET_API void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
 JANET_API JanetBindingType janet_resolve(JanetTable *env, JanetSymbol sym, Janet *out);
+JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
 JANET_API void janet_register(const char *name, JanetCFunction cfun);
 
 /* Get values from the core environment. */
@@ -1841,7 +1861,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 {
@@ -1854,59 +1875,6 @@ typedef struct {
 
 #endif
 
-#ifdef JANET_TYPED_ARRAY
-
-extern JANET_API const JanetAbstractType janet_ta_view_type;
-extern JANET_API const JanetAbstractType janet_ta_buffer_type;
-
-typedef enum {
-    JANET_TARRAY_TYPE_U8,
-    JANET_TARRAY_TYPE_S8,
-    JANET_TARRAY_TYPE_U16,
-    JANET_TARRAY_TYPE_S16,
-    JANET_TARRAY_TYPE_U32,
-    JANET_TARRAY_TYPE_S32,
-    JANET_TARRAY_TYPE_U64,
-    JANET_TARRAY_TYPE_S64,
-    JANET_TARRAY_TYPE_F32,
-    JANET_TARRAY_TYPE_F64
-} JanetTArrayType;
-
-typedef struct {
-    uint8_t *data;
-    size_t size;
-    int32_t flags;
-} JanetTArrayBuffer;
-
-typedef struct {
-    union {
-        void *pointer;
-        uint8_t *u8;
-        int8_t *s8;
-        uint16_t *u16;
-        int16_t *s16;
-        uint32_t *u32;
-        int32_t *s32;
-        uint64_t *u64;
-        int64_t *s64;
-        float *f32;
-        double *f64;
-    } as;
-    JanetTArrayBuffer *buffer;
-    size_t size;
-    size_t stride;
-    JanetTArrayType type;
-} JanetTArrayView;
-
-JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
-JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
-JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
-JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
-JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
-JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
-
-#endif
-
 #ifdef JANET_INT_TYPES
 
 extern JANET_API const JanetAbstractType janet_s64_type;
@@ -1938,6 +1906,24 @@ JANET_API JanetThread *janet_thread_current(void);
 
 #endif
 
+/* Custom allocator support */
+JANET_API void *(janet_malloc)(size_t);
+JANET_API void *(janet_realloc)(void *, size_t);
+JANET_API void *(janet_calloc)(size_t, size_t);
+JANET_API void (janet_free)(void *);
+#ifndef janet_malloc
+#define janet_malloc(X) malloc((X))
+#endif
+#ifndef janet_realloc
+#define janet_realloc(X, Y) realloc((X), (Y))
+#endif
+#ifndef janet_calloc
+#define janet_calloc(X, Y) calloc((X), (Y))
+#endif
+#ifndef janet_free
+#define janet_free(X) free((X))
+#endif
+
 /***** END SECTION MAIN *****/
 
 /* Re-enable popped variable length array warnings */

src/mainclient/shell.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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
@@ -152,7 +152,7 @@ static const char *badterms[] = {
 
 static char *sdup(const char *s) {
     size_t len = strlen(s) + 1;
-    char *mem = malloc(len);
+    char *mem = janet_malloc(len);
     if (!mem) {
         return NULL;
     }
@@ -300,7 +300,7 @@ static int insert(char c, int draw) {
 
 static void historymove(int delta) {
     if (gbl_history_count > 1) {
-        free(gbl_history[gbl_historyi]);
+        janet_free(gbl_history[gbl_historyi]);
         gbl_history[gbl_historyi] = sdup(gbl_buf);
 
         gbl_historyi += delta;
@@ -326,7 +326,7 @@ static void addhistory(void) {
         gbl_history[gbl_history_count++] = newline;
         len++;
     } else {
-        free(gbl_history[JANET_HISTORY_MAX - 1]);
+        janet_free(gbl_history[JANET_HISTORY_MAX - 1]);
     }
     for (i = len - 1; i > 0; i--) {
         gbl_history[i] = gbl_history[i - 1];
@@ -338,7 +338,7 @@ static void replacehistory(void) {
     /* History count is always > 0 here */
     if (gbl_len == 0 || (gbl_history_count > 1 && !strcmp(gbl_buf, gbl_history[1]))) {
         /* Delete history */
-        free(gbl_history[0]);
+        janet_free(gbl_history[0]);
         for (int i = 1; i < gbl_history_count; i++) {
             gbl_history[i - 1] = gbl_history[i];
         }
@@ -346,7 +346,7 @@ static void replacehistory(void) {
     } else {
         char *newline = sdup(gbl_buf);
         if (!newline) return;
-        free(gbl_history[0]);
+        janet_free(gbl_history[0]);
         gbl_history[0] = newline;
     }
 }
@@ -934,7 +934,7 @@ void janet_line_deinit() {
     int i;
     norawmode();
     for (i = 0; i < gbl_history_count; i++)
-        free(gbl_history[i]);
+        janet_free(gbl_history[i]);
     gbl_historyi = 0;
 }
 

test/amalg/main.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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

test/install/project.janet

@@ -2,20 +2,24 @@
   :name "testmod")
 
 (declare-native
-    :name "testmod"
-    :source @["testmod.c"])
+  :name "testmod"
+  :source @["testmod.c"])
 
 (declare-native
-    :name "testmod2"
-    :source @["testmod2.c"])
+  :name "testmod2"
+  :source @["testmod2.c"])
 
 (declare-native
-    :name "testmod3"
-    :source @["testmod3.cpp"])
+  :name "testmod3"
+  :source @["testmod3.cpp"])
 
 (declare-native
-    :name "test-mod-4"
-    :source @["testmod4.c"])
+  :name "test-mod-4"
+  :source @["testmod4.c"])
+
+(declare-native
+  :name "testmod5"
+  :source @["testmod5.cc"])
 
 (declare-executable
   :name "testexec"

test/install/testexec.janet

@@ -2,7 +2,8 @@
 (use /build/testmod2)
 (use /build/testmod3)
 (use /build/test-mod-4)
+(use /build/testmod5)
 
 (defn main [&]
   (print "Hello from executable!")
-  (print (+ (get5) (get6) (get7) (get8))))
+  (print (+ (get5) (get6) (get7) (get8) (get9))))

test/install/testmod.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose and contributors
+* Copyright (c) 2021 Calvin Rose and contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

test/install/testmod2.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose and contributors
+* Copyright (c) 2021 Calvin Rose and contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

test/install/testmod3.cpp

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose and contributors
+* Copyright (c) 2021 Calvin Rose and contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

test/install/testmod4.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose and contributors
+* Copyright (c) 2021 Calvin Rose and contributors
 *
 * Permission is hereby granted, free of charge, to any person obtaining a copy
 * of this software and associated documentation files (the "Software"), to

test/install/testmod5.cc

@@ -0,0 +1,42 @@
+/*
+* Copyright (c) 2021 Calvin Rose and contributors
+*
+* Permission is hereby granted, free of charge, to any person obtaining a copy
+* of this software and associated documentation files (the "Software"), to
+* deal in the Software without restriction, including without limitation the
+* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
+* sell copies of the Software, and to permit persons to whom the Software is
+* furnished to do so, subject to the following conditions:
+*
+* The above copyright notice and this permission notice shall be included in
+* all copies or substantial portions of the Software.
+*
+* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
+* IN THE SOFTWARE.
+*/
+
+/* A very simple native module */
+
+#include <janet.h>
+#include <iostream>
+
+static Janet cfun_get_nine(int32_t argc, Janet *argv) {
+    (void) argv;
+    janet_fixarity(argc, 0);
+    std::cout << "Hello!" << std::endl;
+    return janet_wrap_number(9.0);
+}
+
+static const JanetReg array_cfuns[] = {
+    {"get9", cfun_get_nine, NULL},
+    {NULL, NULL, NULL}
+};
+
+JANET_MODULE_ENTRY(JanetTable *env) {
+    janet_cfuns(env, NULL, array_cfuns);
+}

test/suite0000.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose
+# Copyright (c) 2021 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

test/suite0001.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose
+# Copyright (c) 2021 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

test/suite0002.janet

@@ -1,4 +1,4 @@
-#' Copyright (c) 2020 Calvin Rose
+# Copyright (c) 2021 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

test/suite0003.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose
+# Copyright (c) 2021 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
@@ -481,4 +481,16 @@
 (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/suite0004.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose
+# Copyright (c) 2021 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
@@ -70,5 +70,17 @@
 (assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
 (assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
 
+# Metadata
+
+(def foo-with-tags :a-tag :bar)
+(assert (get (dyn 'foo-with-tags) :a-tag) "extra keywords in def are metadata tags")
+
+(def foo-with-meta {:baz :quux} :bar)
+(assert (= :quux (get (dyn 'foo-with-meta) :baz)) "extra struct in def is metadata")
+
+(defn foo-fn-with-meta {:baz :quux} "This is a function" [x] (identity x))
+(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz)) "extra struct in defn is metadata")
+(assert (= "(foo-fn-with-meta x)\n\nThis is a function" (get (dyn 'foo-fn-with-meta) :doc)) "extra string in defn is docstring")
+
 (end-suite)
 

test/suite0005.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose & contributors
+# Copyright (c) 2021 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -21,54 +21,6 @@
 (import ./helper :prefix "" :exit true)
 (start-suite 5)
 
-# some tests typed array
-
-(defn inspect-tarray
-  [x]
-  (def a @[])
-  (for i 0 (tarray/length x) (array/push a (x i)))
-  (pp a))
-
-(assert-no-error
- "create some typed arrays"
- (do
-   (def a (tarray/new :float64 10))
-   (def b (tarray/new :float64 5 2 0 a))
-   (def c (tarray/new :uint32 20))))
-
-(assert-no-error
- "create some typed arrays from a buffer"
- (do
-   (def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8))))
-   (def b (tarray/new :float64 10 2 64 buf))))
-
-(def a (tarray/new :float64 10))
-(def b (tarray/new :float64 5 2 0 a))
-
-(assert-no-error
- "fill tarray"
- (for i 0 (tarray/length a)
-      (set (a i) i)))
-
-(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer")
-(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
-(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
-(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
-(assert (= (:length a) (length a)) "length method and function")
-
-(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
-
-# Issue 408
-(assert-error :invalid-type (tarray/new :int32 10 1 0 (int/u64 7)) "tarray/new should only allow tarray or buffer for last argument")
-(def ta (tarray/new :int32 10))
-(assert (= (next a nil) 0) "tarray next 1")
-(assert (= (next a 0) 1) "tarray next 2")
-(assert (= (next a 8) 9) "tarray next 3")
-(assert (nil? (next a 9)) "tarray next 4")
-(put ta 3 7)
-(put ta 9 7)
-(assert (= 2 (count |(= $ 7) ta)) "tarray count")
-
 # Array remove
 
 (assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")

test/suite0006.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose & contributors
+# Copyright (c) 2021 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -72,22 +72,6 @@
  "trap INT64_MIN / -1"
  (:/ (int/s64 "-0x8000_0000_0000_0000") -1))
 
-# int64 typed arrays
-(assert (let [t (tarray/new :int64 10)
-              b (i64 1000)]
-          (set (t 0) 1000)
-          (set (t 1) b)
-          (set (t 2) "1000")
-          (set (t 3) (t 0))
-          (set (t 4) (u64 1000))
-          (and
-           (= (t 0) (t 1))
-           (= (t 1) (t 2))
-           (= (t 2) (t 3))
-           (= (t 3) (t 4))
-           ))
-        "int64 typed arrays")
-
 # Dynamic bindings
 (setdyn :a 10)
 (assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")

test/suite0007.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose & contributors
+# Copyright (c) 2021 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to
@@ -112,19 +112,6 @@
 (check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
 (check-table-clone @{} "table/clone 1")
 
-# Issue #142
-
-(def buffer (tarray/buffer 8))
-(def buffer-float64-view (tarray/new :float64 1 1 0 buffer))
-(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer))
-
-(set (buffer-uint32-view 1) 0xfffe9234)
-(set (buffer-uint32-view 0) 0x56789abc)
-
-(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1")
-(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2")
-(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3")
-
 # Make sure Carriage Returns don't end up in doc strings.
 
 (assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc ""))) "no \\r in doc strings")

test/suite0008.janet

@@ -1,4 +1,4 @@
-# Copyright (c) 2020 Calvin Rose & contributors
+# Copyright (c) 2021 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

test/suite0010.janet

@@ -1,4 +1,4 @@
-#- Copyright (c) 2020 Calvin Rose & contributors
+# Copyright (c) 2021 Calvin Rose & contributors
 #
 # Permission is hereby granted, free of charge, to any person obtaining a copy
 # of this software and associated documentation files (the "Software"), to

tools/symcharsgen.c

@@ -1,5 +1,5 @@
 /*
-* Copyright (c) 2020 Calvin Rose
+* Copyright (c) 2021 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