Merge branch 'master' of github.com:janet-lang/janet

CHANGELOG.md

@@ -2,6 +2,13 @@
 All notable changes to this project will be documented in this file.
 
 ## Unreleased - ???
+- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
+  do not provide any `:line` option as that requires buffering.
+- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
+  to clear the current line buffer, has been moved to Ctrl-Q.
+- Importing modules that start with `/` is now the only way to import from project root.
+  Before, this would import from / on disk.
+- Change hash function for numbers.
 - Improve error handling of `dofile`.
 
 ## 1.13.1 - 2020-12-13

janet.1

@@ -64,6 +64,10 @@ Move cursor to the beginning of input line.
 .BR Ctrl\-B
 Move cursor one character to the left.
 
+.TP 16
+.BR Ctrl\-D
+If on a newline, indicate end of stream and exit the repl.
+
 .TP 16
 .BR Ctrl\-E
 Move cursor to the end of input line.
@@ -100,6 +104,10 @@ Delete one word before the cursor.
 .BR Ctrl\-G
 Show documentation for the current symbol under the cursor.
 
+.TP 16
+.BR Ctrl\-Q
+Clear the current command, including already typed lines.
+
 .TP 16
 .BR Alt\-B/Alt\-F
 Move cursor backwards and forwards one word.

src/boot/boot.janet

@@ -790,36 +790,50 @@
 ###
 ###
 
-(defn- sort-part
+(defn- median-of-three [a b c]
-  [a lo hi by]
+  (if (not= (> a b) (> a c))
-  (def pivot (in a hi))
+    a
-  (var i lo)
+    (if (not= (> b a) (> b c)) b c)))
-  (forv j lo hi
-    (def aj (in a j))
-    (when (by aj pivot)
-      (def ai (in a i))
-      (set (a i) aj)
-      (set (a j) ai)
-      (++ i)))
-  (set (a hi) (in a i))
-  (set (a i) pivot)
-  i)
 
-(defn- sort-help
+(defn- insertion-sort [a lo hi by]
-  [a lo hi by]
+  (for i (+ lo 1) (+ hi 1)
-  (when (> hi lo)
+    (def temp (in a i))
-    (def piv (sort-part a lo hi by))
+    (var j (- i 1))
-    (sort-help a lo (- piv 1) by)
+    (while (and (>= j lo) (by temp (in a j)))
-    (sort-help a (+ piv 1) hi by))
+      (set (a (+ j 1)) (in a j))
+      (-- j))
+
+    (set (a (+ j 1)) temp))
   a)
 
 (defn sort
   "Sort an array in-place. Uses quick-sort and is not a stable sort."
   [a &opt by]
-  (sort-help a 0 (- (length a) 1) (or by <)))
+  (default by <)
+  (def stack @[[0 (- (length a) 1)]])
+  (while (not (empty? stack))
+    (def [lo hi] (array/pop stack))
+    (when (< lo hi)
+      (when (< (- hi lo) 32) (insertion-sort a lo hi by) (break))
+      (def pivot (median-of-three (in a hi) (in a lo) (in a (math/floor (/ (+ lo hi) 2)))))
+      (var left lo)
+      (var right hi)
+      (while true
+        (while (by (in a left) pivot) (++ left))
+        (while (by pivot (in a right)) (-- right))
+        (when (<= left right)
+          (def tmp (in a left))
+          (set (a left) (in a right))
+          (set (a right) tmp)
+          (++ left)
+          (-- right))
+        (if (>= left right) (break)))
+      (array/push stack [lo right])
+      (array/push stack [left hi])))
+  a)
 
-(undef sort-part)
+(undef median-of-three)
-(undef sort-help)
+(undef insertion-sort)
 
 (defn sort-by
   `Returns a new sorted array that compares elements by invoking
@@ -1602,16 +1616,26 @@
 
 (defmacro match
   ```
-  Pattern matching. Match an expression x against
+  Pattern matching. Match an expression `x` against any number of cases.
-  any number of cases. Each case is a pattern to match against, followed
+  Each case is a pattern to match against, followed by an expression to
-  by an expression to evaluate to if that case is matched. A pattern that is
+  evaluate to if that case is matched.  Legal patterns are:
-  a symbol will match anything, binding x's value to that symbol. An array
+
-  will match only if all of it's elements match the corresponding elements in
+  * symbol -- a pattern that is a symbol will match anything, binding `x`'s
-  x. A table or struct will match if all values match with the corresponding
+    value to that symbol.
-  values in x. A tuple pattern will match if it's first element matches, and the following
+
-  elements are treated as predicates and are true. The last special case is
+  * array -- an array will match only if all of its elements match the
-  the '_ symbol, which is a wildcard that will match any value without creating a binding.
+    corresponding elements in `x`.
-  Any other value pattern will only match if it is equal to x.
+
+  * table or struct -- a table or struct will match if all values match with
+    the corresponding values in `x`.
+
+  * tuple -- a tuple pattern will match if its first element matches, and the
+    following elements are treated as predicates and are true.
+
+  * `_` symbol -- the last special case is the `_` symbol, which is a wildcard
+    that will match any value without creating a binding.
+
+  Any other value pattern will only match if it is equal to `x`.
   ```
   [x & cases]
 
@@ -2635,8 +2659,9 @@
   [image]
   (unmarshal image load-image-dict))
 
-(defn- check-. [x] (if (string/has-prefix? "." x) x))
+(defn- check-relative [x] (if (string/has-prefix? "." x) x))
-(defn- not-check-. [x] (unless (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))
 
 (def module/paths
   ```
@@ -2672,12 +2697,12 @@
   (defn- find-prefix
     [pre]
     (or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
-  (def all-index (find-prefix ":all:"))
+  (def all-index (find-prefix ".:all:"))
-  (array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
+  (array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
   (def sys-index (find-prefix ":sys:"))
-  (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.])
+  (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
   (def curall-index (find-prefix ":cur:/:all:"))
-  (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-.])
+  (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
   module/paths)
 
 (module/add-paths ":native:" :native)
@@ -2736,8 +2761,9 @@
 
 (undef fexists)
 (undef mod-filter)
-(undef check-.)
+(undef check-relative)
-(undef not-check-.)
+(undef check-project-relative)
+(undef check-is-dep)
 
 (def module/loading
   `Table mapping currently loading modules to true. Used to prevent

src/core/ev.c

@@ -1297,7 +1297,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
             janet_buffer_push_bytes(state->buf, state->chunk_buf, s->bytes);
             state->bytes_left -= s->bytes;
 
-            if (state->bytes_left <= 0 || !state->is_chunk || s->bytes == 0) {
+            if (state->bytes_left == 0 || !state->is_chunk || s->bytes == 0) {
                 Janet resume_val;
 #ifdef JANET_NET
                 if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
@@ -1360,12 +1360,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
             }
             return JANET_ASYNC_STATUS_DONE;
         }
-        case JANET_ASYNC_EVENT_READ:
+        case JANET_ASYNC_EVENT_READ: {
-            /* Read in bytes */
-        {
             JanetBuffer *buffer = state->buf;
             int32_t bytes_left = state->bytes_left;
-            janet_buffer_extra(buffer, bytes_left);
+            int32_t read_limit = bytes_left < 0 ? 4096 : bytes_left;
+            janet_buffer_extra(buffer, read_limit);
             ssize_t nread;
 #ifdef JANET_NET
             char saddr[256];
@@ -1374,14 +1373,14 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
             do {
 #ifdef JANET_NET
                 if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
-                    nread = recvfrom(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags,
+                    nread = recvfrom(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags,
                                      (struct sockaddr *)&saddr, &socklen);
                 } else if (state->mode == JANET_ASYNC_READMODE_RECV) {
-                    nread = recv(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags);
+                    nread = recv(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags);
                 } else
 #endif
                 {
-                    nread = read(s->stream->handle, buffer->data + buffer->count, bytes_left);
+                    nread = read(s->stream->handle, buffer->data + buffer->count, read_limit);
                 }
             } while (nread == -1 && errno == EINTR);
 
@@ -1803,11 +1802,16 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 4);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_READABLE);
-    int32_t n = janet_getnat(argv, 1);
     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
     double to = janet_optnumber(argv, argc, 3, INFINITY);
-    if (to != INFINITY) janet_addtimeout(to);
+    if (janet_keyeq(argv[1], "all")) {
-    janet_ev_read(stream, buffer, n);
+        if (to != INFINITY) janet_addtimeout(to);
+        janet_ev_readchunk(stream, buffer, -1);
+    } else {
+        int32_t n = janet_getnat(argv, 1);
+        if (to != INFINITY) janet_addtimeout(to);
+        janet_ev_read(stream, buffer, n);
+    }
     janet_await();
 }
 
@@ -1922,7 +1926,8 @@ static const JanetReg ev_cfuns[] = {
     {
         "ev/read", janet_cfun_stream_read,
         JDOC("(ev/read stream n &opt buffer timeout)\n\n"
-             "Read up to n bytes into a buffer asynchronously from a stream. "
+             "Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
+             "`:all` to read into the buffer until end of stream. "
              "Optionally provide a buffer to write into "
              "as well as a timeout in seconds after which to cancel the operation and raise an error. "
              "Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "

src/core/net.c

@@ -509,11 +509,16 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
     janet_arity(argc, 2, 4);
     JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
     janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
-    int32_t n = janet_getnat(argv, 1);
     JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
     double to = janet_optnumber(argv, argc, 3, INFINITY);
-    if (to != INFINITY) janet_addtimeout(to);
+    if (janet_keyeq(argv[1], "all")) {
-    janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
+        if (to != INFINITY) janet_addtimeout(to);
+        janet_ev_recvchunk(stream, buffer, -1, MSG_NOSIGNAL);
+    } else {
+        int32_t n = janet_getnat(argv, 1);
+        if (to != INFINITY) janet_addtimeout(to);
+        janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
+    }
     janet_await();
 }
 
@@ -643,6 +648,7 @@ static const JanetReg net_cfuns[] = {
         "net/read", cfun_stream_read,
         JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
              "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
+             "`n` can also be the keyword `:all` to read into the buffer until end of stream. "
              "If less than n bytes are available (and more than 0), will push those bytes and return early. "
              "Takes an optional timeout in seconds, after which will return nil. "
              "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")

src/core/os.c

@@ -2037,25 +2037,25 @@ static const JanetReg os_cfuns[] = {
              "mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
              "The default mode is 8r666. "
              "Allowed flags are as follows:\n\n"
-             "\t:r - open this file for reading\n"
+             "  * :r - open this file for reading\n"
-             "\t:w - open this file for writing\n"
+             "  * :w - open this file for writing\n"
-             "\t:c - create a new file (O_CREATE)\n"
+             "  * :c - create a new file (O_CREATE)\n"
-             "\t:e - fail if the file exists (O_EXCL)\n"
+             "  * :e - fail if the file exists (O_EXCL)\n"
-             "\t:t - shorten an existing file to length 0 (O_TRUNC)\n\n"
+             "  * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
-             "Posix only flags:\n"
+             "Posix only flags:\n\n"
-             "\t:a - append to a file (O_APPEND)\n"
+             "  * :a - append to a file (O_APPEND)\n"
-             "\t:x - O_SYNC\n"
+             "  * :x - O_SYNC\n"
-             "\t:C - O_NOCTTY\n\n"
+             "  * :C - O_NOCTTY\n\n"
-             "Windows only flags:\n"
+             "Windows only flags:\n\n"
-             "\t:R - share reads (FILE_SHARE_READ)\n"
+             "  * :R - share reads (FILE_SHARE_READ)\n"
-             "\t:W - share writes (FILE_SHARE_WRITE)\n"
+             "  * :W - share writes (FILE_SHARE_WRITE)\n"
-             "\t:D - share deletes (FILE_SHARE_DELETE)\n"
+             "  * :D - share deletes (FILE_SHARE_DELETE)\n"
-             "\t:H - FILE_ATTRIBUTE_HIDDEN\n"
+             "  * :H - FILE_ATTRIBUTE_HIDDEN\n"
-             "\t:O - FILE_ATTRIBUTE_READONLY\n"
+             "  * :O - FILE_ATTRIBUTE_READONLY\n"
-             "\t:F - FILE_ATTRIBUTE_OFFLINE\n"
+             "  * :F - FILE_ATTRIBUTE_OFFLINE\n"
-             "\t:T - FILE_ATTRIBUTE_TEMPORARY\n"
+             "  * :T - FILE_ATTRIBUTE_TEMPORARY\n"
-             "\t:d - FILE_FLAG_DELETE_ON_CLOSE\n"
+             "  * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
-             "\t:b - FILE_FLAG_NO_BUFFERING\n")
+             "  * :b - FILE_FLAG_NO_BUFFERING\n")
     },
     {
         "os/pipe", os_pipe,

src/core/parse.c

@@ -985,8 +985,20 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
 }
 
 static Janet cfun_parse_where(int32_t argc, Janet *argv) {
-    janet_fixarity(argc, 1);
+    janet_arity(argc, 1, 3);
     JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
+    if (argc > 1) {
+        int32_t line = janet_getinteger(argv, 1);
+        if (line < 1)
+            janet_panicf("invalid line number %d", line);
+        p->line = (size_t) line;
+    }
+    if (argc > 2) {
+        int32_t column = janet_getinteger(argv, 2);
+        if (column < 0)
+            janet_panicf("invalid column number %d", column);
+        p->column = (size_t) column;
+    }
     Janet *tup = janet_tuple_begin(2);
     tup[0] = janet_wrap_integer(p->line);
     tup[1] = janet_wrap_integer(p->column);
@@ -1247,8 +1259,10 @@ static const JanetReg parse_cfuns[] = {
     },
     {
         "parser/where", cfun_parse_where,
-        JDOC("(parser/where parser)\n\n"
+        JDOC("(parser/where parser &opt line col)\n\n"
-             "Returns the current line number and column of the parser's internal state.")
+             "Returns the current line number and column of the parser's internal state. If line is "
+             "provided, the current line number of the parser is first set to that value. If column is "
+             "also provided, the current column number of the parser is also first set to that value.")
     },
     {
         "parser/eof", cfun_parse_eof,

src/core/util.c

@@ -227,19 +227,21 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
 /* Computes hash of an array of values */
 int32_t janet_array_calchash(const Janet *array, int32_t len) {
     const Janet *end = array + len;
-    uint32_t hash = 5381;
+    uint32_t hash = 0;
-    while (array < end)
+    while (array < end) {
-        hash = (hash << 5) + hash + janet_hash(*array++);
+        uint32_t elem = janet_hash(*array++);
+        hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+    }
     return (int32_t) hash;
 }
 
 /* Computes hash of an array of values */
 int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
     const JanetKV *end = kvs + len;
-    uint32_t hash = 5381;
+    uint32_t hash = 0;
     while (kvs < end) {
-        hash = (hash << 5) + hash + janet_hash(kvs->key);
+        hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
-        hash = (hash << 5) + hash + janet_hash(kvs->value);
+        hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
         kvs++;
     }
     return (int32_t) hash;

src/core/value.c

@@ -28,6 +28,8 @@
 #include <janet.h>
 #endif
 
+#include <math.h>
+
 JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
 JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
 JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
@@ -261,6 +263,21 @@ int32_t janet_hash(Janet x) {
         case JANET_STRUCT:
             hash = janet_struct_hash(janet_unwrap_struct(x));
             break;
+        case JANET_NUMBER: {
+            double num = janet_unwrap_number(x);
+            if (isnan(num) || isinf(num) || num == 0) {
+                hash = 0;
+            } else {
+                hash = (int32_t)num;
+                hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
+                hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
+                hash = (hash >> 16) ^ hash;
+
+                uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
+                hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
+            }
+            break;
+        }
         case JANET_ABSTRACT: {
             JanetAbstract xx = janet_unwrap_abstract(x);
             const JanetAbstractType *at = janet_abstract_type(xx);

src/mainclient/shell.c

@@ -758,6 +758,10 @@ static int line() {
                 kleft();
                 break;
             case 3:     /* ctrl-c */
+                clearlines();
+                gbl_sigint_flag = 1;
+                return -1;
+            case 17:    /* ctrl-q */
                 gbl_cancel_current_repl_form = 1;
                 clearlines();
                 return -1;

test/install/test/test1.janet

@@ -1,3 +1,3 @@
-(import build/testmod :as testmod)
+(import /build/testmod :as testmod)
 
 (if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))

test/install/testexec.janet

@@ -1,7 +1,7 @@
-(use build/testmod)
+(use /build/testmod)
-(use build/testmod2)
+(use /build/testmod2)
-(use build/testmod3)
+(use /build/testmod3)
-(use build/test-mod-4)
+(use /build/test-mod-4)
 
 (defn main [&]
   (print "Hello from executable!")

test/suite0006.janet

@@ -128,6 +128,18 @@
 (assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
 (assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
 
+# Parser line and column numbers
+(defn parser-location [input &opt location]
+  (def p (parser/new))
+  (parser/consume p input)
+  (if location
+    (parser/where p ;location)
+    (parser/where p)))
+
+(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
+(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
+(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
+
 # String check-set
 (assert (string/check-set "abc" "a") "string/check-set 1")
 (assert (not (string/check-set "abc" "z")) "string/check-set 2")