Prepare for 1.15.5 release.

Fix link to Introduction

CHANGELOG.md

@@ -1,6 +1,26 @@
 # Changelog
 All notable changes to this project will be documented in this file.
 
+## 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.

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
@@ -226,8 +226,18 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
 	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)/
+	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 build/doc.html LICENSE README.md build/$(JANET_DIST_DIR)/
 	cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
 
 #########################

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

jpm

@@ -44,7 +44,7 @@
 
 (defn- try-real [path]
   "If os/realpath fails just use normal path."
-  (try (os/realpath) ([_] path)))
+  (try (os/realpath path) ([_] path)))
 
 (defn- install-paths []
   {:headerpath (try-real (string exe-dir "/../include/janet"))
@@ -452,6 +452,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 +460,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
@@ -968,17 +970,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]
@@ -1016,16 +1019,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 +1055,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 +1094,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 +1114,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

meson.build

@@ -19,8 +19,8 @@
 # IN THE SOFTWARE.
 
 project('janet', 'c',
-  default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
-  version : '1.15.2')
+  default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
+  version : '1.15.5')
 
 # 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,7 +60,7 @@ 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'))
@@ -173,9 +173,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 +194,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 +207,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 +249,7 @@ janet_dep = declare_dependency(include_directories : incdir,
 # pkgconfig
 pkg = import('pkgconfig')
 pkg.generate(libjanet,
+  subdirs: 'janet',
   description: 'Library for the Janet programming language.')
 
 # Installation

src/boot/boot.janet

@@ -778,24 +778,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 +1451,36 @@
     (set (freqs x) (if n (+ 1 n) 1)))
   freqs)
 
+(defn group-by
+  ``Group elements of `ind` by a function `f` and put the results into a table. The keys of
+  the table are the distinct return values of `f`, and the values are arrays of all elements of `ind`
+  that are equal to that value.``
+  [f ind]
+  (def ret @{})
+  (each x ind
+    (def y (f x))
+    (if-let [arr (get ret y)]
+      (array/push arr x)
+      (put ret y @[x])))
+  ret)
+
+(defn partition-by
+  ``Partition elements of a sequential data structure by a representative function `f`. Partitions 
+  split when `(f x)` changes values when iterating to the next element `x` of `ind`. Returns a new array
+  of arrays.``
+  [f ind]
+  (def ret @[])
+  (var span nil)
+  (var category nil)
+  (var is-new true)
+  (each x ind
+    (def y (f x))
+    (cond
+      is-new          (do (set is-new false) (set category y) (set span @[x]) (array/push ret span))
+      (= y category)  (array/push span x)
+      (do (set category y) (set span @[x]) (array/push ret span))))
+  ret)
+
 (defn interleave
   "Returns an array of the first elements of each col, then the second, etc."
   [& cols]
@@ -2098,7 +2132,7 @@
         :on-parse-error on-parse-error
         :fiber-flags guard
         :evaluator evaluator
-        :source where
+        :source default-where
         :parser parser
         :read read
         :expander expand} opts)
@@ -2108,9 +2142,11 @@
   (default on-compile-error bad-compile)
   (default on-parse-error bad-parse)
   (default evaluator (fn evaluate [x &] (x)))
-  (default where "<anonymous>")
+  (default default-where "<anonymous>")
   (default guard :ydt)
 
+  (var where default-where)
+
   # Evaluate 1 source form in a protected manner
   (defn eval1 [source &opt l c]
     (def source (if expand (expand source) source))
@@ -2163,11 +2199,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)
@@ -3084,8 +3127,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 +3140,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

src/conf/janetconf.h

@@ -5,9 +5,9 @@
 
 #define JANET_VERSION_MAJOR 1
 #define JANET_VERSION_MINOR 15
-#define JANET_VERSION_PATCH 2
+#define JANET_VERSION_PATCH 5
 #define JANET_VERSION_EXTRA ""
-#define JANET_VERSION "1.15.2"
+#define JANET_VERSION "1.15.5"
 
 /* #define JANET_BUILD "local" */
 

src/core/compile.c

@@ -504,10 +504,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;
 }
 

src/core/ev.c

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

src/core/net.c

@@ -270,14 +270,15 @@ static struct addrinfo *janet_get_addrinfo(Janet *argv, int32_t offset, int sock
             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;
@@ -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);
 
@@ -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

@@ -2085,7 +2085,7 @@ static const JanetReg os_cfuns[] = {
 #ifndef JANET_NO_PROCESSES
     {
         "os/execute", os_execute,
-        JDOC("(os/execute args &opts flags env)\n\n"
+        JDOC("(os/execute args &opt flags env)\n\n"
              "Execute a program on the system and pass it string arguments. `flags` "
              "is a keyword that modifies how the program will execute.\n\n"
              "* :e - enables passing an environment to the program. Without :e, the "
@@ -2105,7 +2105,7 @@ static const JanetReg os_cfuns[] = {
     },
     {
         "os/spawn", os_spawn,
-        JDOC("(os/spawn args &opts flags env)\n\n"
+        JDOC("(os/spawn args &opt flags env)\n\n"
              "Execute a program on the system and return a handle to the process. Otherwise, the "
              "same arguments as os/execute. Does not wait for the process.")
     },

src/core/peg.c

@@ -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. */
@@ -1392,6 +1420,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
             case RULE_ACCUMULATE:
             case RULE_GROUP:
             case RULE_CAPTURE:
+            case RULE_UNREF:
                 /* [rule, tag] */
                 if (rule[1] >= blen) goto bad;
                 op_flags[rule[1]] |= 0x01;

src/core/pp.c

@@ -351,6 +351,9 @@ struct pretty {
     int indent;
     int flags;
     int32_t bufstartlen;
+    int32_t *keysort_buffer;
+    int32_t keysort_capacity;
+    int32_t keysort_start;
     JanetTable seen;
 };
 
@@ -594,31 +597,55 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
                 janet_buffer_push_cstring(S->buffer, "...");
             } else {
                 int32_t i = 0, len = 0, cap = 0;
-                int first_kv_pair = 1;
                 const JanetKV *kvs = NULL;
-                int counter = 0;
                 janet_dictionary_view(x, &kvs, &len, &cap);
                 if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
                     janet_buffer_push_u8(S->buffer, ' ');
                 if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
-                for (i = 0; i < cap; i++) {
-                    if (!janet_checktype(kvs[i].key, JANET_NIL)) {
-                        if (counter == JANET_PRETTY_DICT_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
-                            print_newline(S, 0);
-                            janet_buffer_push_cstring(S->buffer, "...");
-                            break;
-                        }
-                        if (first_kv_pair) {
-                            first_kv_pair = 0;
-                        } else {
-                            print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
-                        }
-                        janet_pretty_one(S, kvs[i].key, 0);
-                        janet_buffer_push_u8(S->buffer, ' ');
-                        janet_pretty_one(S, kvs[i].value, 1);
-                        counter++;
+                int32_t ks_start = S->keysort_start;
+
+                /* Ensure buffer is large enough to sort keys. */
+                int truncated = 0;
+                int64_t mincap = (int64_t) len + (int64_t) ks_start;
+                if (mincap > INT32_MAX) {
+                    truncated = 1;
+                    len = 0;
+                    mincap = ks_start;
+                }
+
+                if (S->keysort_capacity < mincap) {
+                    if (mincap >= INT32_MAX / 2) {
+                        S->keysort_capacity = INT32_MAX;
+                    } else {
+                        S->keysort_capacity = (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/specials.c

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

src/core/typedarray.c

@@ -498,16 +498,23 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
     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);
+    if (index_src > src->size || index_dst > dst->size) {
+        janet_panic("invalid buffer index");
+    }
     size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
+    if (count > dst->size || count > src->size) {
+        janet_panic("typed array copy out of bounds");
+    }
     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)) {
+    uint8_t *ps = src->buffer->data + pos_src;
+    uint8_t *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;

src/core/util.c

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

src/core/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 */

src/include/janet.h

@@ -1630,6 +1630,7 @@ JANET_API Janet janet_wrap_number_safe(double x);
 JANET_API int janet_keyeq(Janet x, const char *cstring);
 JANET_API int janet_streq(Janet x, const char *cstring);
 JANET_API int janet_symeq(Janet x, const char *cstring);
+JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
 
 /* VM functions */
 JANET_API int janet_init(void);
@@ -1841,7 +1842,8 @@ typedef enum {
     RULE_LENPREFIX,    /* [rule_a, rule_b (repeat rule_b rule_a times)] */
     RULE_READINT,      /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
     RULE_LINE,         /* [tag] */
-    RULE_COLUMN        /* [tag] */
+    RULE_COLUMN,       /* [tag] */
+    RULE_UNREF         /* [rule, tag] */
 } JanetPegOpcod;
 
 typedef struct {

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/testmod5.cc

@@ -0,0 +1,42 @@
+/*
+* Copyright (c) 2020 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/suite0003.janet

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

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