1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-06 15:01:28 +00:00

Compare commits

..

90 Commits

Author SHA1 Message Date
Calvin Rose
47bb7fd21b Begin implementing async subproccesses for windows. 2021-01-03 11:21:44 -06:00
Calvin Rose
1c7ed8ca48 Use PostQueuedCompletionStatus for threaded calls on windows.
Ore efficient than using a self pipe.
2021-01-03 11:08:12 -06:00
Calvin Rose
61c65f3df1 Fix valgrind warning. 2020-12-31 16:30:54 -06:00
Calvin Rose
05166b3673 Fix proc getter bug. 2020-12-31 16:23:20 -06:00
Calvin Rose
0a1c93b869 Add ev api for making threaded calls.
Easy way to make arbitrary functions in C async.
2020-12-31 16:12:42 -06:00
Calvin Rose
788f91a36f Remove unneeded book keeping for sub processes.
Since we are not using signals we no longer need some bookkeeping.
2020-12-31 11:52:12 -06:00
Calvin Rose
c831ecf5d2 Working implementation of process waiting with threads.
Does not require all sorts of signal handling code
that is not thread-safe and can "steal processes".

However, there is a much simpler way to add this functionality
by creating a new stream and thread for each subprocess when it is
waited on. This is perhaps _slightly_ less efficient but oh so much
simpler, since we can reuse all of our concepts from streams and there
is no need to implement a whole system around the selfpipe.
2020-12-31 11:22:18 -06:00
Calvin Rose
9e42ee153c Merge branch 'master' into HEAD 2020-12-30 12:19:13 -06:00
Calvin Rose
d457aa5951 Deprecate file/popen.
os/spawn is the prefered way of creating a subprocess and
communicating with it.
2020-12-30 10:22:45 -06:00
Calvin Rose
ab37ee6ebb Add :all option to ev/read.
Brings ev/read more in line with file/read.
2020-12-29 20:37:59 -06:00
Calvin Rose
8655530b19 Rename predicates in module/paths 2020-12-29 19:52:26 -06:00
Calvin Rose
27b1f59aa9 Change Ctrl-C and move old behavior to Ctrl-Q
This lets Janet be a better unix citizen and lets Ctrl-C
raise an interrupt. Trying to make Janet behave superficially
like a shell by overriding Ctrl-C is not helpful.
2020-12-29 16:20:37 -06:00
Calvin Rose
cc2cc4db43 Merge pull request #541 from sogaiu/match-doc-formatting
Tweak match docstring
2020-12-29 13:10:35 -06:00
Calvin Rose
20bcd95279 Merge commit '0ea77cabfb30afc15433581f5888171c1f65aafd' 2020-12-28 12:20:21 -06:00
Calvin Rose
d7954be5e5 Update docstring for os/open. 2020-12-28 11:00:15 -06:00
Felix Riedel
0ea77cabfb Tweak sort: use insertion sort for small arrays 2020-12-28 16:06:48 +00:00
Felix Riedel
0d46352ff4 Revert to better performing number hash. 2020-12-27 14:05:40 +00:00
sogaiu
ffa0d5fe45 Tweak match docstring 2020-12-27 13:42:22 +09:00
Calvin Rose
a2c837a99c Merge remote-tracking branch 'felixr/master' into master 2020-12-26 20:06:34 -06:00
Calvin Rose
13d8d11011 Try new number hashing with frexp.
This may be a bit slower in some cases but generally should
have much better hashing for numbers.
2020-12-26 16:54:14 -06:00
Calvin Rose
2357b6162f Update test-install target. 2020-12-26 15:42:13 -06:00
Calvin Rose
b4f242193d Improve hash function for numbers. 2020-12-26 15:38:04 -06:00
Calvin Rose
7242ee0186 Merge pull request #540 from felixr/better-quicksort
Improve quicksort to avoid worst case performance on sorted input
2020-12-26 15:23:01 -06:00
Felix Riedel
3e742ffc4c Improve quicksort to avoid worst case performance.
The current implementation will have quadratic behaviour for already
sorted arrays because it picks the last element as pivot. In an sorted
array this splits the array repeatedly into the biggest value and all
other values.

The implementation in this commit uses the *median of three* as pivot.

`janet -e "(sort (range 10000))"` to reproduce quadratic behaviour.
2020-12-26 19:18:17 +00:00
Felix Riedel
2ec12fe06f Improve hashing of numbers
Using an integer hash (https://stackoverflow.com/a/12996028/60617) on
the number casted to int32 combined with lower bits of the number.
2020-12-26 13:09:11 +00:00
Felix Riedel
c76e0ae685 Use boost's way of combining hash values for arrays and kv pairs.
`seed ^= hash_value(v) + 0x9e3779b9 + (seed << 6) + (seed >> 2);`
from https://www.boost.org/doc/libs/1_35_0/doc/html/boost/hash_combine_id241013.html

The current way of combining hashes peforms poorly on hash values of
numbers. Changing the way hashes are combined canlead to a significant speed up:

```
time janet_new -e '(def tbl @{}) (loop [x :in (range 1000) y :in (range 1000)] (put tbl {0 x 1 y} true))'
3.77s user 0.08s system 99% cpu 3.843 total

time janet_orig -e '(def tbl @{}) (loop [x :in (range 1000) y :in (range 1000)] (put tbl {0 x 1 y} true))'
48.98s user 0.15s system 99% cpu 49.136 total
```
2020-12-26 13:05:03 +00:00
Calvin Rose
cae4f19629 Merge pull request #532 from pyrmont/feature.parser-line-col-setting
Update (parser/where) to support optional line and column
2020-12-15 19:03:25 -06:00
Michael Camilleri
04f6c7b156 Clarify docstring of parser/where 2020-12-15 16:41:45 +09:00
Michael Camilleri
77b79e9899 Update (parser/where) to support optional line and column 2020-12-15 14:12:33 +09:00
Calvin Rose
a55354357c Make dofile error if source file errors.
This should make dofile a bit easier to use.
It also means that import properly raises errors when
things go bad.
2020-12-14 08:23:06 -06:00
Calvin Rose
392d5d51df Fix build info for 1.13.1 2020-12-13 11:59:52 -06:00
Calvin Rose
9bc996a630 Prepare for 1.13.0 initial release. 2020-12-13 11:17:10 -06:00
Calvin Rose
7b709d4c68 Prevent buffer/trim from shrinking buffer to 0 bytes as well. 2020-12-13 09:38:35 -06:00
Calvin Rose
eab5f67c5c Fix buffer with NULL data pointer issue.
Simply prevent buffers from ever having a NULL data pointer.
2020-12-13 09:33:57 -06:00
Calvin Rose
6020106000 Address #529 2020-12-11 19:21:54 -06:00
Calvin Rose
12f470ed10 Use :_name instead of :name for printing tagged tables. 2020-12-11 18:28:09 -06:00
Calvin Rose
945cbcfad6 Tail recursive match implementation.
This implementation uses multiple passes on patterns
to remove the need for a sentinel value to check if there was a match.
This also re-uses extracted subpatterns for complicated patterns.
2020-12-10 08:35:34 -06:00
Calvin Rose
d53007739e Invert read/write bits on pipe in os/execute.
It was backwards, breaking this functionality.
2020-12-09 19:04:05 -06:00
Calvin Rose
6eaf8272e1 Merge pull request #525 from uvtc/patch-1
light markup in some docs in corelib
2020-12-07 15:57:09 -06:00
Calvin Rose
6fb83dce06 Merge pull request #526 from sogaiu/tweak-comment
Tweak comment for janet_fiber_popframe
2020-12-07 15:56:25 -06:00
John Gabriele
52addc877d Use xs 2020-12-07 14:07:13 -05:00
sogaiu
53a5f3d2dc Tweak comment for janet_fiber_popframe 2020-12-07 12:23:27 +09:00
Calvin Rose
711ee5a36d Merge branch 'preload' 2020-12-06 21:06:59 -06:00
Calvin Rose
cd09b696b5 Add :preload loader. 2020-12-06 21:06:17 -06:00
John Gabriele
df1ca255a9 parts/xs --> pieces 2020-12-06 21:29:30 -05:00
Calvin Rose
811a5d93f4 Prevent some potential bad characters in test out. 2020-12-06 17:10:18 -06:00
John Gabriele
adbe361b9b light markup in some docs in corelib 2020-12-06 17:51:48 -05:00
Calvin Rose
0f16f21677 Make builds deterministic again.
Also prevent marshal from creating multiple copies of
a function - (marshal function pointer before function def pointer).
2020-12-06 16:32:23 -06:00
Calvin Rose
aa0de01e5f Fix some formatting and undefined behavior. 2020-12-06 14:33:08 -06:00
Calvin Rose
785757f2f6 Remove pthreads from shell.c and update bsd build. 2020-12-06 13:51:06 -06:00
Calvin Rose
01120dfc46 Try and fix openbsd st.ht build.
Oneline meson configs, remove extra `cd janet`.
2020-12-06 11:57:40 -06:00
Calvin Rose
a119eb4ef0 Merge branch 'master' of github.com:janet-lang/janet 2020-12-06 11:47:46 -06:00
Calvin Rose
0aa4c3d217 Consolidate sr.ht builds to 1-per-platform.
This generally makes more sense from an infrastructure
point of view and works around 4 builds per push limit of sr.ht.
2020-12-06 11:46:45 -06:00
Calvin Rose
3c0cc59d77 Rename some srht build files. 2020-12-06 11:22:35 -06:00
Calvin Rose
7e1d095996 Merge pull request #522 from pyrmont/docs.keep-docstring
Clarify description of keep
2020-12-05 14:31:58 -06:00
Calvin Rose
cfa9fb6ee4 Update changelog. 2020-12-05 10:36:27 -06:00
Calvin Rose
9d23192614 Add ev/deadline and ev/with-deadline.
This should be more useful than timeouts in real-world
use cases. The deadline system is based on fibers and is target
to much more coarse-grained (and therfor reliable) timeouts than things
like ev/sleep and timeout arguments.
2020-12-05 10:32:34 -06:00
Michael Camilleri
7c1a52ae65 Use 'different from' in preference to 'different to' 2020-12-05 16:43:44 +09:00
Michael Camilleri
9aa1b9c740 Clarify description of keep 2020-12-05 16:02:36 +09:00
Calvin Rose
c4a4916055 Address #500 - update docs and add buffer/push
This updates the documentation and adds a function buffer/push, which
is a more useful function than buffer/push-string or buffer/push-byte by
combining both.
2020-12-04 17:56:47 -06:00
Calvin Rose
b402e0671a Merge pull request #514 from uvtc/patch-2
boot.janet, fix possible typo
2020-12-04 17:40:46 -06:00
Calvin Rose
8144f83b66 Merge pull request #516 from uvtc/patch-4
doc for identity
2020-12-04 17:40:31 -06:00
Calvin Rose
cd2a55e268 Merge pull request #513 from uvtc/patch-1
boot.janet, cond doc
2020-12-04 17:38:02 -06:00
Calvin Rose
f92b5d69c8 Merge pull request #515 from uvtc/patch-3
C-style (hyphenate)
2020-12-04 17:37:24 -06:00
Calvin Rose
a8c21459c3 Merge pull request #517 from uvtc/patch-5
boot.janet, compare*, light formatting
2020-12-04 17:37:06 -06:00
Calvin Rose
4789b4c9f3 Merge pull request #520 from uvtc/patch-6
corelib.c, describe, add hyphen
2020-12-04 17:31:15 -06:00
Calvin Rose
ee1cd6f151 Merge pull request #521 from sogaiu/parser-with-a-colon
Minor tweak in changelog
2020-12-04 17:30:59 -06:00
sogaiu
dfcda296a3 Minor tweak in changelog 2020-12-02 17:52:29 +09:00
John Gabriele
4d38fcb289 corelib.c, describe, add hyphen 2020-12-01 11:56:53 -05:00
Calvin Rose
cbdea8f331 Make os/execute cooperate with ev module.
os/execute, os/proc-wait do not block (currently posix only).
This uses the self-pipe trick to turn signals into a pollable entity.
2020-11-29 15:36:21 -06:00
John Gabriele
51d6a13510 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:31:01 -05:00
John Gabriele
7b4eeecd9f Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:30:48 -05:00
John Gabriele
82eff7e082 Update src/boot/boot.janet
Agreed. That's more clear.

Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:30:26 -05:00
John Gabriele
b922e36071 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:18:19 -05:00
John Gabriele
7c75aeaad2 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:17:38 -05:00
John Gabriele
2db9323671 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:17:23 -05:00
John Gabriele
31ae93de19 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:17:12 -05:00
John Gabriele
a81e9f23f0 Update src/boot/boot.janet
Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:16:55 -05:00
John Gabriele
59f09a4386 Update src/boot/boot.janet
omit needless word

Co-authored-by: Michael Camilleri <mike@inqk.net>
2020-11-29 14:15:55 -05:00
John Gabriele
53400ecac1 boot.janet, compare*, light formatting
Since those represent code, they should get backticks.
2020-11-28 14:41:42 -05:00
John Gabriele
1b8928a8ec doc for identity
This function only takes one argument anyway, and errors if you try to pass more.
2020-11-28 14:35:17 -05:00
John Gabriele
e706494893 C-style 2020-11-28 14:29:13 -05:00
John Gabriele
894aea7ce7 boot.janet, fix possible typo
Possible typo?
2020-11-28 14:25:10 -05:00
John Gabriele
87167a21c9 boot.janet, cond doc
Arranged this way seems to make more sense.
2020-11-28 14:18:35 -05:00
Calvin Rose
7c8f5ef811 Merge branch 'master' of github.com:janet-lang/janet 2020-11-28 12:18:51 -06:00
Calvin Rose
7aa4241662 Add testing for the new reindent behavior.
This also provides a reference function to reimplement
the behavior in Janet.
2020-11-28 12:18:36 -06:00
Calvin Rose
56a915b5b1 Long strings now autoindent contents - doc-format is simpler.
No need to try and auto detect the base indentation - it is 0.
This will be taken care of by the parser.
2020-11-28 10:04:25 -06:00
Calvin Rose
90a0dfa35f Merge pull request #512 from timgates42/bugfix_typo_source
docs: fix simple typo, soucre -> source
2020-11-27 16:54:34 -06:00
Tim Gates
128d72785f docs: fix simple typo, soucre -> source
There is a small typo in src/core/features.h.

Should read `source` rather than `soucre`.
2020-11-28 09:45:46 +11:00
Calvin Rose
21a6017547 typo 2020-11-27 12:27:44 -06:00
37 changed files with 1199 additions and 498 deletions

View File

@@ -1,14 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@@ -1,15 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dprf=true
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@@ -1,22 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dsingle_threaded=true
meson configure -Dnanbox=false
meson configure -Ddynamic_modules=false
meson configure -Ddocstrings=false
meson configure -Dnet=false
meson configure -Dsourcemaps=false
meson configure -Dpeg=false
meson configure -Dassembler=false
meson configure -Dint_types=false
meson configure -Dtyped_array=false
meson configure -Dreduced_os=true
ninja # will not pass tests but should build

View File

@@ -3,10 +3,31 @@ sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
- meson
tasks:
- build: |
- gmake: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install
- meson_min: |
cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
cd build_meson_min
ninja
- meson_prf: |
cd janet
meson setup build_meson_prf --buildtype=release -Dprf=true
cd build_meson_prf
ninja
ninja test
- meson_default: |
cd janet
meson setup build_meson_default --buildtype=release
cd build_meson_default
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@@ -2,8 +2,24 @@
All notable changes to this project will be documented in this file.
## Unreleased - ???
- Deprecate `file/popen` in favor of `os/spawn`.
- 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
- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
in the prototype table to tag the output.
- `match` macro implementation changed to be tail recursive.
- Adds a :preload loader which allows one to manually put things into `module/cache`.
- Add `buffer/push` function.
- Backtick delimited strings and buffers are now reindented based on the column of the
opening delimiter. WHitespace in columns to the left of the starting column is ignored unless
opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
- Argument to `(error)` combinator in PEGs is now optional.
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
@@ -12,16 +28,17 @@ All notable changes to this project will be documented in this file.
- During installation and release, merge janetconf.h into janet.h for easier install.
- Add `upscope` special form.
- `os/execute` and `os/spawn` can take streams for redirecting IO.
- Add `;parser` and `:read` parameters to `run-context`.
- Add `:parser` and `:read` parameters to `run-context`.
- Add `os/open` if ev is enabled.
- Add `os/pipe` if ev is enabled.
- Add `janet_thread_current(void)` to C API
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
for single threaded cooperative scheduling and asynchornous IO.
for single threaded cooperative scheduling and asynchronous IO.
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
and are more flexible. They also allow furter improvements to these utility functions.
and are more flexible. They also allow further improvements to these utility functions.
- Various small bug fixes.
## 1.12.2 - 2020-09-20
- Add janet\_try and janet\_restore to C API.

View File

@@ -157,7 +157,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
##### Amalgamation #####
########################
SONAME=libjanet.so.1.12
SONAME=libjanet.so.1.13
build/shell.c: src/mainclient/shell.c
cp $< $@

View File

@@ -4,8 +4,6 @@
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">

View File

@@ -0,0 +1,22 @@
(defn dowork [name n]
(print name " starting work...")
(os/execute [(dyn :executable) "-e" (string "(os/sleep " n ")")])
(print name " finished work!"))
# Will be done in parallel
(print "starting group A")
(ev/call dowork "A 2" 2)
(ev/call dowork "A 1" 1)
(ev/call dowork "A 3" 3)
(ev/sleep 4)
# Will also be done in parallel
(print "starting group B")
(ev/call dowork "B 2" 2)
(ev/call dowork "B 1" 1)
(ev/call dowork "B 3" 3)
(ev/sleep 4)
(print "all work done")

View File

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

View File

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

View File

@@ -180,8 +180,8 @@
(defmacro cond
`Evaluates conditions sequentially until the first true condition
is found, and then executes the corresponding body. If there are an
odd number of forms, the last expression is executed if no forms
are matched. If there are no matches, return nil.`
odd number of forms, and no forms are matched, the last expression
is executed. If there are no matches, return nil.`
[& pairs]
(defn aux [i]
(def restlen (- (length pairs) i))
@@ -494,13 +494,13 @@
(error (string "unexpected loop verb " verb)))))
(defmacro forv
`Do a c style for loop for side effects. The iteration variable i
can be mutated in the loop, unlike normal for. Returns nil.`
``Do a C-style for-loop for side effects. The iteration variable `i`
can be mutated in the loop, unlike normal `for`. Returns nil.``
[i start stop & body]
(for-var-template i start stop 1 < + body))
(defmacro for
"Do a c style for loop for side effects. Returns nil."
"Do a C-style for-loop for side effects. Returns nil."
[i start stop & body]
(for-template i start stop 1 < + body))
@@ -562,9 +562,9 @@
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].
* :down-to -- same as :down, but the range is inclusive [start, end].
* :keys -- terate over the keys in a data structure.
* :keys -- iterate over the keys in a data structure.
* :pairs -- iterate over the key-value pairs as tuples in a data structure.
@@ -692,7 +692,7 @@
;(tuple/slice functions 4 -1)))))
(defn identity
"A function that returns its first argument."
"A function that returns its argument."
[x]
x)
@@ -731,11 +731,11 @@
## Polymorphic comparisons
(defn compare
`Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
see whether either x or y implement a 'compare' method which can
compare x and y. If so it uses that compare method. If not, it
delegates to the primitive comparators.`
see whether either x or y implement a `compare` method which can
compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.``
[x y]
(or
(when-let [f (get x :compare)] (f x y))
@@ -753,27 +753,27 @@
r)
(defn compare=
"Equivalent of '=' but using compare function instead of primitive comparator"
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce = xs))
(defn compare<
"Equivalent of '<' but using compare function instead of primitive comparator"
``Equivalent of `<` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce < xs))
(defn compare<=
"Equivalent of '<=' but using compare function instead of primitive comparator"
``Equivalent of `<=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce <= xs))
(defn compare>
"Equivalent of '>' but using compare function instead of primitive comparator"
``Equivalent of `>` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce > xs))
(defn compare>=
"Equivalent of '>=' but using compare function instead of primitive comparator"
``Equivalent of `>=` but using polymorphic `compare` instead of primitive comparator.``
[& xs]
(compare-reduce >= xs))
@@ -790,36 +790,50 @@
###
###
(defn- sort-part
[a lo hi by]
(def pivot (in a hi))
(var i lo)
(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- median-of-three [a b c]
(if (not= (> a b) (> a c))
a
(if (not= (> b a) (> b c)) b c)))
(defn- sort-help
[a lo hi by]
(when (> hi lo)
(def piv (sort-part a lo hi by))
(sort-help a lo (- piv 1) by)
(sort-help a (+ piv 1) hi by))
(defn- insertion-sort [a lo hi by]
(for i (+ lo 1) (+ hi 1)
(def temp (in a i))
(var j (- i 1))
(while (and (>= j lo) (by temp (in a j)))
(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 sort-help)
(undef median-of-three)
(undef insertion-sort)
(defn sort-by
`Returns a new sorted array that compares elements by invoking
@@ -945,8 +959,10 @@
counter)
(defn keep
`Given a predicate, take only elements from an array or tuple for
which (pred element) is truthy. Returns a new array of truthy predicate results.`
``Given a predicate `pred`, return a new array containing the truthy results
of applying `pred` to each element in the indexed collection `ind`. This is
different from `filter` which returns an array of the original elements where
the predicate is truthy.``
[pred ind]
(def res @[])
(each item ind
@@ -1557,109 +1573,173 @@
###
###
(defmacro- with-idemp
`Return janet code body that has been prepended
with a binding of form to atom. If form is a non-idempotent
form (a function call, etc.), make sure the resulting
code will only evaluate once, even if body contains multiple
copies of binding. In body, use binding instead of form.`
[binding form & body]
(def $result (gensym))
(def $form (gensym))
~(do
(def ,$form ,form)
(def ,binding (if (idempotent? ,$form) ,$form (gensym)))
(def ,$result (do ,;body))
(if (= ,$form ,binding)
,$result
(tuple 'do (tuple 'def ,binding ,$form) ,$result))))
# Sentinel value for mismatches
(def- sentinel ~',(gensym))
(defn- match-1
[pattern expr onmatch seen]
(cond
(= '_ pattern)
(onmatch)
(symbol? pattern)
(if (in seen pattern)
~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
(do
(put seen pattern true)
~(do (def ,pattern ,expr) ,(onmatch))))
(and (tuple? pattern) (= :parens (tuple/type pattern)))
(if (= (get pattern 0) '@)
# Unification with external values
~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
(match-1
(in pattern 0) expr
(fn []
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
(indexed? pattern)
(do
(def len (length pattern))
(var i -1)
(with-idemp
$arr expr
~(if (,indexed? ,$arr)
(if (< (,length ,$arr) ,len)
,sentinel
,((fn aux []
(++ i)
(if (= i len)
(onmatch)
(match-1 (in pattern i) (tuple in $arr i) aux seen)))))
,sentinel)))
(dictionary? pattern)
(do
(var key nil)
(with-idemp
$dict expr
~(if (,dictionary? ,$dict)
,((fn aux []
(set key (next pattern key))
(def $val (gensym))
(if (= key nil)
(onmatch)
~(do (def ,$val (,get ,$dict ,key))
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
,sentinel)))
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
(defmacro match
`Pattern matching. Match an expression x against
any number of cases. Each case is a pattern to match against, followed
by an expression to evaluate to if that case is matched. A pattern that is
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
x. A table or struct will match if all values match with the corresponding
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
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]
(with-idemp $x x
(def len (length cases))
(def len-1 (dec len))
((fn aux [i]
(cond
(= i len-1) (in cases i)
(< i len-1) (with-syms [$res]
~(if (= ,sentinel (def ,$res ,(match-1 (in cases i) $x (fn [] (in cases (inc i))) @{})))
,(aux (+ 2 i))
,$res)))) 0)))
```
Pattern matching. Match an expression `x` against any number of cases.
Each case is a pattern to match against, followed by an expression to
evaluate to if that case is matched. Legal patterns are:
(undef sentinel)
(undef match-1)
(undef with-idemp)
* symbol -- a pattern that is a symbol will match anything, binding `x`'s
value to that symbol.
* array -- an array will match only if all of its elements match the
corresponding elements in `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]
# Partition body into sections.
(def oddlen (odd? (length cases)))
(def else (if oddlen (last cases)))
(def patterns (partition 2 (if oddlen (slice cases 0 -2) cases)))
# Keep an array for accumulating the compilation output
(def x-sym (if (idempotent? x) x (gensym)))
(def accum @[])
(if (not= x x-sym) (array/push accum ['def x-sym x]))
# Table of gensyms
(def symbols @{[nil nil] x-sym})
(def length-symbols @{})
(defn emit [x] (array/push accum x))
(defn emit-branch [condition result] (array/push accum :branch condition result))
(defn get-sym
[parent-sym key]
(def symbol-key [parent-sym key])
(or (get symbols symbol-key)
(let [s (gensym)]
(put symbols symbol-key s)
(emit ['def s [get parent-sym key]])
s)))
(defn get-length-sym
[parent-sym]
(or (get length-symbols parent-sym)
(let [s (gensym)]
(put length-symbols parent-sym s)
(emit ['def s ['if [indexed? parent-sym] [length parent-sym]]])
s)))
(defn visit-pattern-1
[b2g parent-sym key pattern]
(if (= pattern '_) (break))
(def s (get-sym parent-sym key))
(def t (type pattern))
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(cond
# match local binding
(= t :symbol)
(if-let [x (in b2g pattern)]
(array/push x s)
(put b2g pattern @[s]))
# match data structure template
(or isarr (= t :struct) (= t :table))
(do
(when isarr (get-length-sym s))
(eachp [i sub-pattern] pattern
(visit-pattern-1 b2g s i sub-pattern)))
# match global unification
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
(break)
# match predicated binding
(and (= t :tuple) (>= (length pattern) 2))
(do
(visit-pattern-1 b2g parent-sym key (pattern 0)))))
(defn visit-pattern-2
[anda gun preds parent-sym key pattern]
(if (= pattern '_) (break))
(def s (get-sym parent-sym key))
(def t (type pattern))
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(when isarr
(array/push anda (get-length-sym s))
(array/push anda [<= (length pattern) (get-length-sym s)]))
(cond
# match data structure template
(or isarr (= t :struct) (= t :table))
(eachp [i sub-pattern] pattern
(when (not isarr)
(array/push anda [not= nil (get-sym s i)]))
(visit-pattern-2 anda gun preds s i sub-pattern))
# match local binding
(= t :symbol) (break)
# match global unification
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
(if-let [x (in gun (pattern 1))]
(array/push x s)
(put gun (pattern 1) @[s]))
# match predicated binding
(and (= t :tuple) (>= (length pattern) 2))
(do
(array/push preds ;(slice pattern 1))
(visit-pattern-2 anda gun preds parent-sym key (pattern 0)))
# match literal
(array/push anda ['= s pattern])))
# Compile the patterns
(each [pattern expression] patterns
(def b2g @{})
(def gun @{})
(def preds @[])
(visit-pattern-1 b2g nil nil pattern)
(def anda @['and])
(visit-pattern-2 anda gun preds nil nil pattern)
# Local unification
(def unify @[])
(each syms b2g
(when (< 1 (length syms))
(array/push unify [= ;syms])))
# Global unification
(eachp [binding syms] gun
(array/push unify [= binding ;syms]))
(sort unify)
(array/concat anda unify)
# Final binding
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
# Predicates
(unless (empty? preds)
(def pred-join ~(do ,;defs (and ,;preds)))
(array/push anda pred-join))
(emit-branch (tuple/slice anda) ['do ;defs expression]))
# Expand branches
(def stack @[else])
(each el (reverse accum)
(if (= :branch el)
(let [condition (array/pop stack)
truthy (array/pop stack)
if-form ~(if ,condition ,truthy
,(case (length stack)
0 nil
1 (stack 0)
~(do ,;(reverse stack))))]
(array/remove stack 0 (length stack))
(array/push stack if-form))
(array/push stack el)))
~(do ,;(reverse stack)))
###
###
@@ -1694,8 +1774,9 @@
(env-walk keyword? env local))
(defn doc-format
`Reformat a docstring to wrap a certain width.
Returns a buffer containing the formatted text.`
`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]
(default indent 4)
(def max-width (- (or width (dyn :doc-width 80)) 8))
@@ -1708,38 +1789,8 @@
(var leading 0)
(var c nil)
(def base-indent
# Is there a better way?
(do
(var min-indent 0)
(var curr-indent 0)
(var start-of-line false)
(set c (get str pos))
(while (not= nil c)
(case c
10 (do
(set start-of-line true)
(set curr-indent 0))
32 (when start-of-line
(++ curr-indent))
(when start-of-line
(set start-of-line false)
(when (or (= 0 min-indent)
(< curr-indent min-indent))
(set min-indent curr-indent))))
(set c (get str (++ pos))))
min-indent))
(set pos 0)
(defn skip-base-indent []
(var pos* pos)
(set c (get str pos*))
(while (and (< (- pos* pos) base-indent)
(= 32 c))
(set c (get str (++ pos*))))
(set pos pos*))
(defn skip-line-indent []
(var pos* pos)
(set c (get str pos*))
@@ -1895,19 +1946,15 @@
(defn push-fcb []
(update-levels)
(push-line)
(skip-base-indent)
(while (not (end-fcb?))
(push-line)
(skip-base-indent))
(push-line))
(push-line))
(defn push-icb []
(buffer/push-string res (buffer/new-filled leading 32))
(push-line)
(skip-base-indent)
(while (not (start-nl?))
(push-line)
(skip-base-indent))
(push-line))
(push-nl))
(defn push-p []
@@ -1936,7 +1983,6 @@
(push-nl))
(while (< pos len)
(skip-base-indent)
(skip-line-indent)
(cond
(start-nl?)
@@ -2095,7 +2141,8 @@
'quasiquote expandqq
'var expanddef
'while expandall
'break expandall})
'break expandall
'upscope expandall})
(defn dotup [t]
(def h (in t 0))
@@ -2393,9 +2440,6 @@
(default where "<anonymous>")
(default guard :ydt)
# Are we done yet?
(var going true)
# Evaluate 1 source form in a protected manner
(defn eval1 [source]
(def source (if expand (expand source) source))
@@ -2419,7 +2463,7 @@
(fiber/setenv f env)
(while (fiber/can-resume? f)
(def res (resume f resumeval))
(when good (when going (set resumeval (onstatus f res))))))
(when good (set resumeval (onstatus f res)))))
# Reader version
(when read
@@ -2444,11 +2488,11 @@
# Loop
(def buf @"")
(while going
(var parser-not-done true)
(while parser-not-done
(if (env :exit) (break))
(buffer/clear buf)
(if (= (chunks buf p)
:cancel)
(if (= (chunks buf p) :cancel)
(do
# A :cancel chunk represents a cancelled form in the REPL, so reset.
(:flush p)
@@ -2459,19 +2503,23 @@
(def len (length buf))
(when (= len 0)
(:eof p)
(set going false))
(set parser-not-done false))
(while (> len pindex)
(+= pindex (p-consume p buf pindex))
(while (p-has-more p)
(eval1 (p-produce p)))
(eval1 (p-produce p))
(if (env :exit) (break)))
(when (= (p-status p) :error)
(parse-err p where))))))
(parse-err p where)
(if (env :exit) (break)))))))
# Check final parser state
(while (p-has-more p)
(eval1 (p-produce p)))
(when (= (p-status p) :error)
(parse-err p where))
(unless (env :exit)
(while (p-has-more p)
(eval1 (p-produce p))
(if (env :exit) (break)))
(when (= (p-status p) :error)
(parse-err p where)))
(in env :exit-value env))
@@ -2531,16 +2579,16 @@
(error (parser/error p))
(error "no value")))))
(def make-image-dict
`A table used in combination with marshal to marshal code (images), such that
(make-image x) is the same as (marshal x make-image-dict).`
@{})
(def load-image-dict
`A table used in combination with unmarshal to unmarshal byte sequences created
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict).`
@{})
(def make-image-dict
`A table used in combination with marshal to marshal code (images), such that
(make-image x) is the same as (marshal x make-image-dict).`
@{})
(defmacro comptime
"Evals x at compile time and returns the result. Similar to a top level unquote."
[x]
@@ -2570,8 +2618,9 @@
[image]
(unmarshal image load-image-dict))
(defn- check-. [x] (if (string/has-prefix? "." x) x))
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
(defn- check-relative [x] (if (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
```
@@ -2591,6 +2640,10 @@
(setdyn :syspath (boot/opts "JANET_PATH"))
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
(def module/cache
"Table mapping loaded module identifiers to their environments."
@{})
(defn module/add-paths
```
Add paths to module/paths for a given loader such that
@@ -2603,18 +2656,19 @@
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
(def all-index (find-prefix ":all:"))
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.])
(def all-index (find-prefix ".:all:"))
(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)
(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])
# Version of fexists that works even with a reduced OS
(defn fexists
@@ -2666,12 +2720,9 @@
(undef fexists)
(undef mod-filter)
(undef check-.)
(undef not-check-.)
(def module/cache
"Table mapping loaded module identifiers to their environments."
@{})
(undef check-relative)
(undef check-project-relative)
(undef check-is-dep)
(def module/loading
`Table mapping currently loading modules to true. Used to prevent
@@ -2699,15 +2750,25 @@
(def spath (string path))
(put env :current-file (or src (if-not path-is-file spath)))
(put env :source (or src (if-not path-is-file spath path)))
(var exit-error nil)
(var exit-fiber nil)
(defn chunks [buf _] (file/read f 2048 buf))
(defn bp [&opt x y]
(def ret (bad-parse x y))
(if exit (os/exit 1))
ret)
(when exit
(bad-parse x y)
(os/exit 1))
(put env :exit true)
(def [line col] (:where x))
(def pe (string (:error x) " in " y " around line " line ", column " col))
(set exit-error pe))
(defn bc [&opt x y z]
(def ret (bad-compile x y z))
(if exit (os/exit 1))
ret)
(when exit
(bad-compile x y z)
(os/exit 1))
(put env :exit true)
(def ce (string x " while compiling " z))
(set exit-error ce)
(set exit-fiber y))
(unless f
(error (string "could not find file " path)))
(def nenv
@@ -2717,27 +2778,40 @@
:on-compile-error bc
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(debug/stacktrace f x)
(if exit (os/exit 1) (eflush))))
(when exit
(debug/stacktrace f x)
(eflush)
(os/exit 1))
(put env :exit true)
(set exit-error x)
(set exit-fiber f)))
:evaluator evaluator
:expander expander
:read read
:parser parser
:source (or src (if path-is-file "<anonymous>" spath))}))
(if-not path-is-file (file/close f))
(when exit-error
(if exit-fiber
(propagate exit-error exit-fiber)
(error exit-error)))
nenv)
(def module/loaders
`A table of loading method names to loading functions.
This table lets require and import load many different kinds
of files as modules.`
@{:native (fn [path &] (native path (make-env)))
:source (fn [path args]
@{:native (fn native-loader [path &] (native path (make-env)))
:source (fn source-loader [path args]
(put module/loading path true)
(def newenv (dofile path ;args))
(put module/loading path nil)
newenv)
:image (fn [path &] (load-image (slurp path)))})
(defer (put module/loading path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(when-let [m (in module/cache path)]
(if (function? m)
(set (module/cache path) (m path ;args))
m)))
:image (fn image-loader [path &] (load-image (slurp path)))})
(defn require-1
[path args kargs]
@@ -3053,7 +3127,16 @@
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
[& body]
~(,ev/call (fn [] ,;body))))
~(,ev/call (fn [] ,;body)))
(defmacro ev/with-deadline
`Run a body of code with a deadline, such that if the code does not complete before
the deadline is up, it will be canceled.`
[deadline & body]
(with-syms [f]
~(let [,f (coro ,;body)]
(,ev/deadline ,deadline nil ,f)
(,resume ,f)))))
(compwhen (dyn 'net/listen)
(defn net/server
@@ -3248,8 +3331,7 @@
(put load-dict 'boot/args nil)
(each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil)))
(merge-into load-image-dict load-dict)
(merge-into make-image-dict (invert load-dict)))
(merge-into load-image-dict load-dict))
###
###

View File

@@ -5,9 +5,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 13
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.13.0-dev"
#define JANET_VERSION "1.13.2-dev"
/* #define JANET_BUILD "local" */

View File

@@ -31,12 +31,11 @@
/* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL;
if (capacity > 0) {
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
if (capacity < 4) capacity = 4;
janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) {
JANET_OUT_OF_MEMORY;
}
buffer->count = 0;
buffer->capacity = capacity;
@@ -200,19 +199,14 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count) {
if (buffer->count < buffer->capacity) {
uint8_t *newData = realloc(buffer->data, buffer->count);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = buffer->count;
if (buffer->count < buffer->capacity) {
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
uint8_t *newData = realloc(buffer->data, newcap);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
} else {
buffer->capacity = 0;
free(buffer->data);
buffer->data = NULL;
buffer->data = newData;
buffer->capacity = newcap;
}
return argv[0];
}
@@ -256,6 +250,26 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
for (i = 1; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} else {
JanetByteView view = janet_getbytes(argv, i);
if (view.bytes == buffer->data) {
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
view.bytes = buffer->data;
}
janet_buffer_push_bytes(buffer, view.bytes, view.len);
}
}
return argv[0];
}
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
@@ -407,22 +421,32 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n"
"Append a byte to a buffer. Will expand the buffer as necessary. "
JDOC("(buffer/push-byte buffer & xs)\n\n"
"Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.")
},
{
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer x)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
JDOC("(buffer/push-word buffer & xs)\n\n"
"Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
"buffer/push-string", cfun_buffer_chars,
JDOC("(buffer/push-string buffer str)\n\n"
"Push a string onto the end of a buffer. Non string values will be converted "
"to strings before being pushed. Returns the modified buffer. "
JDOC("(buffer/push-string buffer & xs)\n\n"
"Push byte sequences onto the end of a buffer. "
"Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
"buffer/push", cfun_buffer_push,
JDOC("(buffer/push buffer & xs)\n\n"
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{

View File

@@ -548,35 +548,35 @@ static const JanetReg corelib_cfuns[] = {
{
"describe", janet_core_describe,
JDOC("(describe x)\n\n"
"Returns a string that is a human readable description of a value x.")
"Returns a string that is a human-readable description of a value x.")
},
{
"string", janet_core_string,
JDOC("(string & parts)\n\n"
"Creates a string by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. "
JDOC("(string & xs)\n\n"
"Creates a string by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new string.")
},
{
"symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n"
"Creates a symbol by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new symbol.")
"Creates a symbol by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new symbol.")
},
{
"keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n"
"Creates a keyword by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new keyword.")
"Creates a keyword by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new keyword.")
},
{
"buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n"
"Creates a new buffer by concatenating values together. Values are "
"converted to bytes via describe if they are not byte sequences. Returns "
"the new buffer.")
"Creates a buffer by concatenating the elements of `xs` together. If an "
"element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new buffer.")
},
{
"abstract?", janet_core_is_abstract,
@@ -1250,6 +1250,21 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = janet_unwrap_table(marsh_out);
janet_vm_core_env = env;
/* Invert image dict manually here. We can't do this in boot.janet as it
* breaks deterministic builds */
Janet lidv, midv;
lidv = midv = janet_wrap_nil();
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
JanetTable *lid = janet_unwrap_table(lidv);
JanetTable *mid = janet_unwrap_table(midv);
for (int32_t i = 0; i < lid->capacity; i++) {
const JanetKV *kv = lid->data + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(mid, kv->value, kv->key);
}
}
return env;
}

View File

@@ -31,12 +31,12 @@
#ifdef JANET_EV
/* Includes */
#include <math.h>
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#else
#include <pthread.h>
#include <limits.h>
#include <errno.h>
#include <unistd.h>
@@ -48,6 +48,7 @@
#include <netinet/tcp.h>
#include <netdb.h>
#include <sys/socket.h>
#include <sys/wait.h>
#ifdef JANET_EV_EPOLL
#include <sys/epoll.h>
#include <sys/timerfd.h>
@@ -131,6 +132,7 @@ typedef struct JanetTimeout JanetTimeout;
struct JanetTimeout {
JanetTimestamp when;
JanetFiber *fiber;
JanetFiber *curr_fiber;
uint32_t sched_id;
int is_error;
};
@@ -147,6 +149,7 @@ JANET_THREAD_LOCAL JanetRNG janet_vm_ev_rng;
JANET_THREAD_LOCAL JanetListenerState **janet_vm_listeners = NULL;
JANET_THREAD_LOCAL size_t janet_vm_listener_count = 0;
JANET_THREAD_LOCAL size_t janet_vm_listener_cap = 0;
JANET_THREAD_LOCAL size_t janet_vm_extra_listeners = 0;
/* Get current timestamp (millisecond precision) */
static JanetTimestamp ts_now(void);
@@ -376,12 +379,56 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
return 0;
}
static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
JanetStream *s = p;
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal stream with unsafe flag");
}
janet_marshal_abstract(ctx, p);
janet_marshal_int(ctx, (int32_t) s->flags);
janet_marshal_int64(ctx, (intptr_t) s->methods);
#ifdef JANET_WINDOWS
/* TODO - ref counting to avoid situation where a handle is closed or GCed
* while in transit, and it's value gets reused. DuplicateHandle does not work
* for network sockets, and in general for winsock it is better to nipt duplicate
* unless there is a need to. */
janet_marshal_int64(ctx, (int64_t)(s->handle));
#else
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
int duph = dup(s->handle);
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
janet_marshal_int(ctx, (int32_t)(duph));
#endif
}
static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal stream with unsafe flag");
}
JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
/* Can't share listening state and such across threads */
p->_mask = 0;
p->state = NULL;
p->flags = (uint32_t) janet_unmarshal_int(ctx);
p->methods = (void *) janet_unmarshal_int64(ctx);
#ifdef JANET_WINDOWS
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
#else
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
#endif
return p;
}
const JanetAbstractType janet_stream_type = {
"core/stream",
janet_stream_gc,
janet_stream_mark,
janet_stream_getter,
JANET_ATEND_GET
NULL,
janet_stream_marshal,
janet_stream_unmarshal,
JANET_ATEND_UNMARSHAL
};
/* Register a fiber to resume with value */
@@ -433,6 +480,9 @@ void janet_ev_mark(void) {
/* Pending timeouts */
for (size_t i = 0; i < janet_vm_tq_count; i++) {
janet_mark(janet_wrap_fiber(janet_vm_tq[i].fiber));
if (janet_vm_tq[i].curr_fiber != NULL) {
janet_mark(janet_wrap_fiber(janet_vm_tq[i].curr_fiber));
}
}
/* Pending listeners */
@@ -471,6 +521,7 @@ 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_vm_listeners = NULL;
}
@@ -486,11 +537,20 @@ void janet_addtimeout(double sec) {
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = fiber;
to.curr_fiber = NULL;
to.sched_id = fiber->sched_id;
to.is_error = 1;
add_timeout(to);
}
void janet_ev_inc_refcount(void) {
janet_vm_extra_listeners++;
}
void janet_ev_dec_refcount(void) {
janet_vm_extra_listeners--;
}
/* Channels */
typedef struct {
@@ -766,42 +826,111 @@ void janet_loop1(void) {
JanetTimestamp now = ts_now();
while (peek_timeout(&to) && to.when <= now) {
pop_timeout(0);
if (to.fiber->sched_id == to.sched_id) {
if (to.is_error) {
janet_cancel(to.fiber, janet_cstringv("timeout"));
} else {
janet_schedule(to.fiber, janet_wrap_nil());
if (to.curr_fiber != NULL) {
/* This is a deadline (for a fiber, not a function call) */
JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
int isFinished = s == (JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (!isFinished) {
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
}
} else {
/* This is a timeout (for a function call, not a whole fiber) */
if (to.fiber->sched_id == to.sched_id) {
if (to.is_error) {
janet_cancel(to.fiber, janet_cstringv("timeout"));
} else {
janet_schedule(to.fiber, janet_wrap_nil());
}
}
}
}
/* Run scheduled fibers */
while (janet_vm_spawn.head != janet_vm_spawn.tail) {
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK};
janet_q_pop(&janet_vm_spawn, &task, sizeof(task));
run_one(task.fiber, task.value, task.sig);
}
/* Poll for events */
if (janet_vm_listener_count || janet_vm_tq_count) {
if (janet_vm_listener_count || janet_vm_tq_count || janet_vm_extra_listeners) {
JanetTimeout to;
memset(&to, 0, sizeof(to));
int has_timeout;
/* Drop timeouts that are no longer needed */
while ((has_timeout = peek_timeout(&to)) && to.fiber->sched_id != to.sched_id) {
while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
pop_timeout(0);
}
/* Run polling implementation only if pending timeouts or pending events */
if (janet_vm_tq_count || janet_vm_listener_count) {
if (janet_vm_tq_count || janet_vm_listener_count || janet_vm_extra_listeners) {
janet_loop1_impl(has_timeout, to.when);
}
}
}
void janet_loop(void) {
while (janet_vm_listener_count || (janet_vm_spawn.head != janet_vm_spawn.tail) || janet_vm_tq_count) {
while (janet_vm_listener_count || (janet_vm_spawn.head != janet_vm_spawn.tail) || janet_vm_tq_count || janet_vm_extra_listeners) {
janet_loop1();
}
}
/*
* Self-pipe handling code.
*/
/* Wrap return value by pairing it with the callback used to handle it
* in the main thread */
typedef struct {
JanetEVGenericMessage msg;
JanetThreadedCallback cb;
} JanetSelfPipeEvent;
/* Structure used to initialize threads in the thread pool
* (same head structure as self pipe event)*/
typedef struct {
JanetEVGenericMessage msg;
JanetThreadedCallback cb;
JanetThreadedSubroutine subr;
JanetHandle write_pipe;
} JanetEVThreadInit;
#ifdef JANET_WINDOWS
/* On windows, use PostQueuedCompletionStatus instead for
* custom events */
#else
static JANET_THREAD_LOCAL JanetHandle janet_vm_selfpipe[2];
static void janet_ev_setup_selfpipe(void) {
if (janet_make_pipe(janet_vm_selfpipe)) {
JANET_EXIT("failed to initialize self pipe in event loop");
}
}
/* Handle events from the self pipe inside the event loop */
static void janet_ev_handle_selfpipe(void) {
JanetSelfPipeEvent response;
while (read(janet_vm_selfpipe[0], &response, sizeof(response)) > 0) {
response.cb(response.msg);
janet_ev_dec_refcount();
}
}
static void janet_ev_cleanup_selfpipe(void) {
close(janet_vm_selfpipe[0]);
close(janet_vm_selfpipe[1]);
}
#endif
#ifdef JANET_WINDOWS
JANET_THREAD_LOCAL HANDLE janet_vm_iocp = NULL;
@@ -861,6 +990,12 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
if (!has_timeout) {
/* queue emptied */
}
} else if (0 == completionKey) {
/* Custom event */
JanetSelfPipeEvent *response = (JanetSelfPipeEvent *)(overlapped);
response->cb(response->msg);
free(response);
janet_ev_dec_refcount();
} else {
/* Normal event */
JanetStream *stream = (JanetStream *) completionKey;
@@ -969,8 +1104,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* Step state machines */
for (int i = 0; i < ready; i++) {
JanetStream *stream = events[i].data.ptr;
if (NULL != stream) { /* If NULL, is a timeout */
void *p = events[i].data.ptr;
if (&janet_vm_timerfd == p) {
/* Timer expired, ignore */;
} else if (janet_vm_selfpipe == p) {
/* Self-pipe handling */
janet_ev_handle_selfpipe();
} else {
JanetStream *stream = p;
int mask = events[i].events;
JanetListenerState *state = stream->state;
state->event = events + i;
@@ -1001,14 +1142,18 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
void janet_ev_init(void) {
janet_ev_init_common();
janet_ev_setup_selfpipe();
janet_vm_epoll = epoll_create1(EPOLL_CLOEXEC);
janet_vm_timerfd = timerfd_create(CLOCK_MONOTONIC, TFD_CLOEXEC | TFD_NONBLOCK);
janet_vm_timer_enabled = 0;
if (janet_vm_epoll == -1 || janet_vm_timerfd == -1) goto error;
struct epoll_event ev;
ev.events = EPOLLIN | EPOLLET;
ev.data.ptr = NULL;
ev.data.ptr = &janet_vm_timerfd;
if (-1 == epoll_ctl(janet_vm_epoll, EPOLL_CTL_ADD, janet_vm_timerfd, &ev)) goto error;
ev.events = EPOLLIN | EPOLLET;
ev.data.ptr = janet_vm_selfpipe;
if (-1 == epoll_ctl(janet_vm_epoll, EPOLL_CTL_ADD, janet_vm_selfpipe[0], &ev)) goto error;
return;
error:
JANET_EXIT("failed to initialize event loop");
@@ -1018,6 +1163,7 @@ void janet_ev_deinit(void) {
janet_ev_deinit_common();
close(janet_vm_epoll);
close(janet_vm_timerfd);
janet_ev_cleanup_selfpipe();
janet_vm_epoll = 0;
}
@@ -1054,7 +1200,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 * sizeof(struct pollfd));
janet_vm_fds = realloc(janet_vm_fds, (newsize + 1) * sizeof(struct pollfd));
if (NULL == janet_vm_fds) {
JANET_OUT_OF_MEMORY;
}
@@ -1063,12 +1209,12 @@ JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, in
ev.fd = stream->handle;
ev.events = make_poll_events(state->stream->_mask);
ev.revents = 0;
janet_vm_fds[state->_index] = ev;
janet_vm_fds[state->_index + 1] = ev;
return state;
}
static void janet_unlisten(JanetListenerState *state) {
janet_vm_fds[state->_index] = janet_vm_fds[janet_vm_listener_count - 1];
janet_vm_fds[state->_index + 1] = janet_vm_fds[janet_vm_listener_count];
janet_unlisten_impl(state);
}
@@ -1081,19 +1227,25 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JanetTimestamp now = ts_now();
to = now > timeout ? 0 : (int)(timeout - now);
}
ready = poll(janet_vm_fds, janet_vm_listener_count, to);
ready = poll(janet_vm_fds, janet_vm_listener_count + 1, to);
} while (ready == -1 && errno == EINTR);
if (ready == -1) {
JANET_EXIT("failed to poll events");
}
/* Check selfpipe */
if (janet_vm_fds[0].revents & POLLIN) {
janet_vm_fds[0].revents = 0;
janet_ev_handle_selfpipe();
}
/* Step state machines */
for (size_t i = 0; i < janet_vm_listener_count; i++) {
struct pollfd *pfd = janet_vm_fds + i;
struct pollfd *pfd = janet_vm_fds + i + 1;
/* Skip fds where nothing interesting happened */
JanetListenerState *state = janet_vm_listeners[i];
/* Normal event */
int mask = janet_vm_fds[i].revents;
int mask = pfd->revents;
JanetAsyncStatus status1 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status2 = JANET_ASYNC_STATUS_NOT_DONE;
JanetAsyncStatus status3 = JANET_ASYNC_STATUS_NOT_DONE;
@@ -1118,20 +1270,157 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
void janet_ev_init(void) {
janet_ev_init_common();
janet_vm_fds = NULL;
janet_ev_setup_selfpipe();
janet_vm_fds = malloc(sizeof(struct pollfd));
if (NULL == janet_vm_fds) {
JANET_OUT_OF_MEMORY;
}
janet_vm_fds[0].fd = janet_vm_selfpipe[0];
janet_vm_fds[0].events = POLLIN;
janet_vm_fds[0].revents = 0;
return;
}
void janet_ev_deinit(void) {
janet_ev_deinit_common();
janet_ev_cleanup_selfpipe();
free(janet_vm_fds);
janet_vm_fds = NULL;
}
#endif
/* C API helpers for reading and writing from streams.
/*
* End poll implementation
*/
/*
* Threaded calls
*/
#ifdef JANET_WINDOWS
static DWORD WINAPI janet_thread_body(LPVOID ptr) {
JanetEVThreadInit *init = (JanetEVThreadInit *)ptr;
JanetEVGenericMessage msg = init->msg;
JanetThreadedSubroutine subr = init->subr;
JanetThreadedCallback cb = init->cb;
JanetHandle iocp = init->write_pipe;
/* Reuse memory from thread init for returning data */
init->msg = subr(msg);
init->cb = cb;
janet_assert(PostQueuedCompletionStatus(iocp,
sizeof(JanetSelfPipeEvent),
0,
(LPOVERLAPPED) init),
"failed to post completion event");
return 0;
}
#else
static void *janet_thread_body(void *ptr) {
JanetEVThreadInit *init = (JanetEVThreadInit *)ptr;
JanetEVGenericMessage msg = init->msg;
JanetThreadedSubroutine subr = init->subr;
JanetThreadedCallback cb = init->cb;
int fd = init->write_pipe;
free(init);
JanetSelfPipeEvent response;
response.msg = subr(msg);
response.cb = cb;
/* handle a bit of back pressure before giving up. */
int tries = 4;
while (tries > 0) {
int status;
do {
status = write(fd, &response, sizeof(response));
} while (status == -1 && errno == EINTR);
if (status > 0) break;
sleep(1);
tries--;
}
return NULL;
}
#endif
void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb) {
JanetEVThreadInit *init = malloc(sizeof(JanetEVThreadInit));
if (NULL == init) {
JANET_OUT_OF_MEMORY;
}
init->msg = arguments;
init->subr = fp;
init->cb = cb;
#ifdef JANET_WINDOWS
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_panic("failed to create thread");
}
CloseHandle(thread_handle); /* detach from thread */
#else
init->write_pipe = janet_vm_selfpipe[1];
pthread_t waiter_thread;
int err = pthread_create(&waiter_thread, NULL, janet_thread_body, init);
if (err) {
free(init);
janet_panicf("%s", strerror(err));
}
pthread_detach(waiter_thread);
#endif
/* Increment ev refcount so we don't quit while waiting for a subprocess */
janet_ev_inc_refcount();
}
/* Default callback for janet_ev_threaded_await. */
void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
switch (return_value.tag) {
default:
case JANET_EV_TCTAG_NIL:
janet_schedule(return_value.fiber, janet_wrap_nil());
break;
case JANET_EV_TCTAG_INTEGER:
janet_schedule(return_value.fiber, janet_wrap_integer(return_value.argi));
break;
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);
break;
case JANET_EV_TCTAG_KEYWORD:
janet_schedule(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
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);
break;
case JANET_EV_TCTAG_ERR_KEYWORD:
janet_cancel(return_value.fiber, janet_ckeywordv((const char *) return_value.argp));
break;
}
janet_gcunroot(janet_wrap_fiber(return_value.fiber));
}
/* Convenience method for common case */
void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp) {
JanetEVGenericMessage arguments;
arguments.tag = tag;
arguments.argi = argi;
arguments.argp = argp;
arguments.fiber = janet_root_fiber();
janet_gcroot(janet_wrap_fiber(arguments.fiber));
janet_ev_threaded_call(fp, arguments, janet_ev_default_threaded_callback);
janet_await();
}
/*
* C API helpers for reading and writing from streams.
* There is some networking code in here as well as generic
* reading and writing primitives. */
* reading and writing primitives.
*/
void janet_stream_flags(JanetStream *stream, uint32_t flags) {
if (stream->flags & JANET_STREAM_CLOSED) {
@@ -1232,7 +1521,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) {
@@ -1295,12 +1584,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
}
return JANET_ASYNC_STATUS_DONE;
}
case JANET_ASYNC_EVENT_READ:
/* Read in bytes */
{
case JANET_ASYNC_EVENT_READ: {
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];
@@ -1309,14 +1597,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);
@@ -1666,7 +1954,13 @@ int janet_make_pipe(JanetHandle handles[2]) {
return 0;
#else
if (pipe(handles)) return -1;
if (fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
return 0;
error:
close(handles[0]);
close(handles[1]);
return -1;
#endif
}
@@ -1691,18 +1985,38 @@ static Janet cfun_ev_call(int32_t argc, Janet *argv) {
return janet_wrap_fiber(fiber);
}
static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
double sec = janet_getnumber(argv, 0);
JANET_NO_RETURN void janet_sleep_await(double sec) {
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = janet_vm_root_fiber;
to.is_error = 0;
to.sched_id = to.fiber->sched_id;
to.curr_fiber = NULL;
add_timeout(to);
janet_await();
}
static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
double sec = janet_getnumber(argv, 0);
janet_sleep_await(sec);
}
static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm_root_fiber);
JanetFiber *tocheck = janet_optfiber(argv, argc, 2, janet_vm_fiber);
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = tocancel;
to.curr_fiber = tocheck;
to.is_error = 0;
to.sched_id = to.fiber->sched_id;
add_timeout(to);
return janet_wrap_fiber(tocancel);
}
static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0);
@@ -1722,11 +2036,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);
janet_ev_read(stream, buffer, n);
if (janet_keyeq(argv[1], "all")) {
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();
}
@@ -1776,6 +2095,14 @@ static const JanetReg ev_cfuns[] = {
JDOC("(ev/sleep sec)\n\n"
"Suspend the current fiber for sec seconds without blocking the event loop.")
},
{
"ev/deadline", cfun_ev_deadline,
JDOC("(ev/deadline sec &opt tocancel tocheck)\n\n"
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`.")
},
{
"ev/chan", cfun_channel_new,
JDOC("(ev/chan &opt capacity)\n\n"
@@ -1833,7 +2160,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 "

View File

@@ -27,7 +27,7 @@
#if defined(__NetBSD__) || defined(__APPLE__) || defined(__OpenBSD__) \
|| defined(__bsdi__) || defined(__DragonFly__)
/* Use BSD soucre on any BSD systems, include OSX */
/* Use BSD source on any BSD systems, include OSX */
# define _BSD_SOURCE
#else
/* Use POSIX feature flags */

View File

@@ -420,8 +420,7 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
newframe->flags = 0;
}
/* Pop a stack frame from the fiber. Returns the new stack frame, or
* NULL if there are no more frames */
/* Pop a stack frame from the fiber. */
void janet_fiber_popframe(JanetFiber *fiber) {
JanetStackFrame *frame = janet_fiber_frame(fiber);
if (fiber->frame == 0) return;

View File

@@ -226,11 +226,14 @@ static void janet_mark_function(JanetFunction *func) {
if (janet_gc_reachable(func))
return;
janet_gc_mark(func);
numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
janet_mark_funcenv(func->envs[i]);
if (NULL != func->def) {
/* this should always be true, except if function is only partially constructed */
numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
janet_mark_funcenv(func->envs[i]);
}
janet_mark_funcdef(func->def);
}
janet_mark_funcdef(func->def);
}
static void janet_mark_fiber(JanetFiber *fiber) {

View File

@@ -777,7 +777,7 @@ static const JanetReg io_cfuns[] = {
#ifndef JANET_NO_PROCESSES
{
"file/popen", cfun_io_popen,
JDOC("(file/popen command &opt mode)\n\n"
JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
"Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process "

View File

@@ -286,7 +286,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 30)
#define JANET_STACKFRAME_HASENV (1 << 31)
#define JANET_STACKFRAME_HASENV (INT32_MIN)
/* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
@@ -542,9 +542,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x);
marshal_one_def(st, func->def, flags);
/* Mark seen after reading def, but before envs */
/* Mark seen before reading def */
MARK_SEEN();
pushint(st, func->def->environments_length);
marshal_one_def(st, func->def, flags);
for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1);
return;
@@ -1228,12 +1229,20 @@ static const uint8_t *unmarshal_one(
case LB_FUNCTION: {
JanetFunction *func;
JanetFuncDef *def;
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
data++;
int32_t len = readnat(st, &data);
if (len > 255) {
janet_panicf("invalid function");
}
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
def->environments_length * sizeof(JanetFuncEnv));
func->def = def;
len * sizeof(JanetFuncEnv));
*out = janet_wrap_function(func);
janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
if (def->environments_length != len) {
janet_panicf("invalid function");
}
func->def = def;
for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
}

View File

@@ -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);
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
if (janet_keyeq(argv[1], "all")) {
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.")

View File

@@ -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
@@ -185,6 +185,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
#ifndef JANET_REDUCED_OS
#ifndef JANET_NO_PROCESSES
/* Get env for os_execute */
static char **os_execute_env(int32_t argc, const Janet *argv) {
char **envp = NULL;
@@ -319,13 +320,15 @@ static JanetBuffer *os_exec_escape(JanetView args) {
static const JanetAbstractType ProcAT;
#define JANET_PROC_CLOSED 1
#define JANET_PROC_WAITED 2
#define JANET_PROC_WAITING 4
#define JANET_PROC_ERROR_NONZERO 8
typedef struct {
int flags;
#ifdef JANET_WINDOWS
HANDLE pHandle;
HANDLE tHandle;
#else
int pid;
pid_t pid;
#endif
int return_code;
#ifdef JANET_EV
@@ -339,6 +342,62 @@ typedef struct {
#endif
} JanetProc;
#ifdef JANET_EV
#ifdef JANET_WINDOWS
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
JanetProc *proc = (JanetProc *) args.argp;
WaitForSingleObject(proc->pHandle, INFINITE);
GetExitCodeProcess(proc->pHandle, &args.argi);
return args;
}
#else /* windows check */
/* Function that is called in separate thread to wait on a pid */
static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
JanetProc *proc = (JanetProc *) args.argp;
pid_t result;
int status = 0;
do {
result = waitpid(proc->pid, &status, 0);
} while (result == -1 && errno == EINTR);
/* Use POSIX shell semantics for interpreting signals */
if (WIFEXITED(status)) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
status = WTERMSIG(status) + 128;
}
args.argi = status;
return args;
}
#endif /* End windows check */
/* Callback that is called in main thread when subroutine completes. */
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
int status = args.argi;
JanetProc *proc = (JanetProc *) args.argp;
if (NULL != proc) {
proc->return_code = (int32_t) status;
proc->flags |= JANET_PROC_WAITED;
proc->flags &= ~JANET_PROC_WAITING;
janet_gcunroot(janet_wrap_abstract(proc));
janet_gcunroot(janet_wrap_fiber(args.fiber));
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
janet_schedule(args.fiber, janet_wrap_integer(status));
}
}
}
#endif /* End ev check */
static int janet_proc_gc(void *p, size_t s) {
(void) s;
JanetProc *proc = (JanetProc *) p;
@@ -367,10 +426,26 @@ static int janet_proc_mark(void *p, size_t s) {
return 0;
}
#ifdef JANET_EV
JANET_NO_RETURN
#endif
static Janet os_proc_wait_impl(JanetProc *proc) {
if (proc->flags & JANET_PROC_WAITED) {
janet_panicf("cannot wait on process that has already finished");
if (proc->flags & (JANET_PROC_WAITED | JANET_PROC_WAITING)) {
janet_panicf("cannot wait twice on a process");
}
#ifdef JANET_EV
/* Event loop implementation - threaded call */
proc->flags |= JANET_PROC_WAITING;
JanetEVGenericMessage targs;
memset(&targs, 0, sizeof(targs));
targs.argp = proc;
targs.fiber = janet_root_fiber();
janet_gcroot(janet_wrap_abstract(proc));
janet_gcroot(janet_wrap_fiber(targs.fiber));
janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
janet_await();
#else
/* Non evented implementation */
proc->flags |= JANET_PROC_WAITED;
int status = 0;
#ifdef JANET_WINDOWS
@@ -386,6 +461,7 @@ static Janet os_proc_wait_impl(JanetProc *proc) {
#endif
proc->return_code = (int32_t) status;
return janet_wrap_integer(proc->return_code);
#endif
}
static Janet os_proc_wait(int32_t argc, Janet *argv) {
@@ -481,7 +557,7 @@ static int janet_proc_get(void *p, Janet key, Janet *out) {
return 1;
}
if (janet_keyeq(key, "err")) {
*out = (NULL == proc->out) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
*out = (NULL == proc->err) ? janet_wrap_nil() : janet_wrap_abstract(proc->err);
return 1;
}
if ((-1 != proc->return_code) && janet_keyeq(key, "return-code")) {
@@ -575,7 +651,7 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
}
#endif
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
janet_arity(argc, 1, 3);
/* Get flags */
@@ -713,7 +789,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
tHandle = processInfo.hThread;
/* Wait and cleanup immedaitely */
if (!is_async) {
if (!is_spawn) {
DWORD code;
WaitForSingleObject(pHandle, INFINITE);
GetExitCodeProcess(pHandle, &code);
@@ -781,45 +857,51 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_async) {
if (status) {
os_execute_cleanup(envp, child_argv);
janet_panicf("%p: %s", argv[0], strerror(errno));
} else if (is_async) {
} else if (is_spawn) {
/* Get process handle */
os_execute_cleanup(envp, child_argv);
} else {
/* Wait to complete */
waitpid(pid, &status, 0);
os_execute_cleanup(envp, child_argv);
/* Use POSIX shell semantics for interpreting signals */
if (WIFEXITED(status)) {
status = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
status = WSTOPSIG(status) + 128;
} else {
status = WTERMSIG(status) + 128;
}
}
#endif
if (is_async) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
proc->return_code = -1;
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
proc->return_code = -1;
#ifdef JANET_WINDOWS
proc->pHandle = pHandle;
proc->tHandle = tHandle;
proc->pHandle = pHandle;
proc->tHandle = tHandle;
#else
proc->pid = pid;
proc->pid = pid;
#endif
proc->in = NULL;
proc->out = NULL;
proc->err = NULL;
if (new_in != JANET_HANDLE_NONE) {
proc->in = get_stdio_for_handle(new_in, orig_in, 0);
if (NULL == proc->in) janet_panic("failed to construct proc");
}
if (new_out != JANET_HANDLE_NONE) {
proc->out = get_stdio_for_handle(new_out, orig_out, 1);
if (NULL == proc->out) janet_panic("failed to construct proc");
}
if (new_err != JANET_HANDLE_NONE) {
proc->err = get_stdio_for_handle(new_err, orig_err, 1);
proc->flags = 0;
if (proc->in == NULL || proc->out == NULL || proc->err == NULL) {
janet_panic("failed to construct proc");
}
if (NULL == proc->err) janet_panic("failed to construct proc");
}
proc->flags = 0;
if (janet_flag_at(flags, 2)) {
proc->flags |= JANET_PROC_ERROR_NONZERO;
}
if (is_spawn) {
return janet_wrap_abstract(proc);
} else if (janet_flag_at(flags, 2) && status) {
janet_panicf("command failed with non-zero exit code %d", status);
} else {
return janet_wrap_integer(status);
#ifdef JANET_EV
os_proc_wait_impl(proc);
#else
return os_proc_wait_impl(proc);
#endif
}
}
@@ -2037,25 +2119,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"
"\t:w - open this file for writing\n"
"\t:c - create a new file (O_CREATE)\n"
"\t:e - fail if the file exists (O_EXCL)\n"
"\t:t - shorten an existing file to length 0 (O_TRUNC)\n\n"
"Posix only flags:\n"
"\t:a - append to a file (O_APPEND)\n"
"\t:x - O_SYNC\n"
"\t:C - O_NOCTTY\n\n"
"Windows only flags:\n"
"\t:R - share reads (FILE_SHARE_READ)\n"
"\t:W - share writes (FILE_SHARE_WRITE)\n"
"\t:D - share deletes (FILE_SHARE_DELETE)\n"
"\t:H - FILE_ATTRIBUTE_HIDDEN\n"
"\t:O - FILE_ATTRIBUTE_READONLY\n"
"\t:F - FILE_ATTRIBUTE_OFFLINE\n"
"\t:T - FILE_ATTRIBUTE_TEMPORARY\n"
"\t:d - FILE_FLAG_DELETE_ON_CLOSE\n"
"\t:b - FILE_FLAG_NO_BUFFERING\n")
" * :r - open this file for reading\n"
" * :w - open this file for writing\n"
" * :c - create a new file (O_CREATE)\n"
" * :e - fail if the file exists (O_EXCL)\n"
" * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
"Posix only flags:\n\n"
" * :a - append to a file (O_APPEND)\n"
" * :x - O_SYNC\n"
" * :C - O_NOCTTY\n\n"
"Windows only flags:\n\n"
" * :R - share reads (FILE_SHARE_READ)\n"
" * :W - share writes (FILE_SHARE_WRITE)\n"
" * :D - share deletes (FILE_SHARE_DELETE)\n"
" * :H - FILE_ATTRIBUTE_HIDDEN\n"
" * :O - FILE_ATTRIBUTE_READONLY\n"
" * :F - FILE_ATTRIBUTE_OFFLINE\n"
" * :T - FILE_ATTRIBUTE_TEMPORARY\n"
" * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
" * :b - FILE_FLAG_NO_BUFFERING\n")
},
{
"os/pipe", os_pipe,
@@ -2078,6 +2160,8 @@ void janet_lib_os(JanetTable *env) {
InitializeCriticalSection(&env_lock);
env_lock_initialized = 1;
}
#endif
#ifndef JANET_NO_PROCESSES
#endif
janet_core_cfuns(env, NULL, os_cfuns);
}

View File

@@ -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"
"Returns the current line number and column of the parser's internal state.")
JDOC("(parser/where parser &opt line col)\n\n"
"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,

View File

@@ -565,7 +565,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("name"));
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
const uint8_t *n;
int32_t len;
if (janet_bytes_view(name, &n, &len)) {

View File

@@ -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;
while (array < end)
hash = (hash << 5) + hash + janet_hash(*array++);
uint32_t hash = 0;
while (array < end) {
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 = (hash << 5) + hash + janet_hash(kvs->value);
hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
kvs++;
}
return (int32_t) hash;

View File

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

View File

@@ -1478,7 +1478,6 @@ int janet_init(void) {
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;
janet_vm_stackn = 0;
/* Threads */
#ifdef JANET_THREADS
janet_threads_init();
#endif

View File

@@ -1279,14 +1279,59 @@ JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener be
/* Shorthand for yielding to event loop in C */
JANET_NO_RETURN JANET_API void janet_await(void);
JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
/* For use inside listeners - adds a timeout to the current fiber, such that
* it will be resumed after sec seconds if no other event schedules the current fiber. */
JANET_API void janet_addtimeout(double sec);
JANET_API void janet_ev_inc_refcount(void);
JANET_API void janet_ev_dec_refcount(void);
/* Get last error from a an IO operation */
JANET_API Janet janet_ev_lasterr(void);
/* Async service for calling a function or syscall in a background thread. This is not
* as efficient in the slightest as using Streams but can be used for arbitrary blocking
* functions and syscalls. */
/* Used to pass data between the main thread and worker threads for simple tasks.
* We could just use a pointer but this prevents malloc/free in the common case
* of only a handful of arguments. */
typedef struct {
int tag;
int argi;
void *argp;
JanetFiber *fiber;
} JanetEVGenericMessage;
/* How to resume or cancel after a threaded call. Not exhaustive of the possible
* ways one might want to resume after returning from a threaded call, but should
* cover most of the common cases. For something more complicated, such as resuming
* with an abstract type or a struct, one should use janet_ev_threaded_call instead
* of janet_ev_threaded_await with a custom callback. */
#define JANET_EV_TCTAG_NIL 0 /* resume with nil */
#define JANET_EV_TCTAG_INTEGER 1 /* resume with janet_wrap_integer(argi) */
#define JANET_EV_TCTAG_STRING 2 /* resume with janet_cstringv((const char *) argp) */
#define JANET_EV_TCTAG_STRINGF 3 /* resume with janet_cstringv((const char *) argp), then call free on argp. */
#define JANET_EV_TCTAG_KEYWORD 4 /* resume with janet_ckeywordv((const char *) argp) */
#define JANET_EV_TCTAG_ERR_STRING 5 /* cancel with janet_cstringv((const char *) argp) */
#define JANET_EV_TCTAG_ERR_STRINGF 6 /* cancel with janet_cstringv((const char *) argp), then call free on argp. */
#define JANET_EV_TCTAG_ERR_KEYWORD 7 /* cancel with janet_ckeywordv((const char *) argp) */
/* Function pointer that is run in the thread pool */
typedef JanetEVGenericMessage(*JanetThreadedSubroutine)(JanetEVGenericMessage arguments);
/* Handler that is run in the main thread with the result of the JanetAsyncSubroutine */
typedef void (*JanetThreadedCallback)(JanetEVGenericMessage return_value);
/* API calls for quickly offloading some work in C to a new thread or thread pool. */
JANET_API void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage arguments, JanetThreadedCallback cb);
JANET_API void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp);
/* Callback used by janet_ev_threaded_await */
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
/* Read async from a stream */
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);

View File

@@ -126,28 +126,21 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
static int gbl_israwmode = 0;
static const char *gbl_prompt = "> ";
static int gbl_plen = 2;
static char gbl_buf[JANET_LINE_MAX];
static int gbl_len = 0;
static int gbl_pos = 0;
static int gbl_cols = 80;
static char *gbl_history[JANET_HISTORY_MAX];
static int gbl_history_count = 0;
static int gbl_historyi = 0;
static int gbl_sigint_flag = 0;
static struct termios gbl_termios_start;
static JanetByteView gbl_matches[JANET_MATCH_MAX];
static int gbl_match_count = 0;
static int gbl_lines_below = 0;
/* Put a lock around this global state so we don't screw up
* the terminal in a multithreaded situation */
#ifndef JANET_SINGLE_THREADED
#include <pthread.h>
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
#endif
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
@@ -169,9 +162,6 @@ static char *sdup(const char *s) {
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_lock(&gbl_lock);
#endif
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
@@ -185,9 +175,6 @@ static int rawmode(void) {
return 0;
fatal:
errno = ENOTTY;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
return -1;
}
@@ -195,9 +182,6 @@ fatal:
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
gbl_israwmode = 0;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
}
static int curpos(void) {
@@ -774,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;

View File

@@ -13,7 +13,7 @@
(when x (++ num-tests-passed))
(def str (string e))
(def truncated
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e)))
(if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
(if x
(eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))

View File

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

View File

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

View File

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

View File

@@ -125,6 +125,7 @@
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
# Regression #301
(def b (buffer/new-filled 128 0x78))
@@ -221,20 +222,6 @@
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
# No segfault, valgrind clean.
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
(assert-error "bad fiber status" (unmarshal x load-image-dict))
(gccollect)
(marshal x make-image-dict)
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
(unmarshal b load-image-dict)
(gccollect)
(def v (unmarshal
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
(gccollect)
# in vs get regression
@@ -349,4 +336,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
# Peg bug
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
(end-suite)

View File

@@ -40,7 +40,7 @@
# or else the first read can fail. Might be a strange windows
# "bug", but needs further investigating. Otherwise, `build_win test`
# can sometimes fail on windows, leading to flaky testing.
(ev/sleep 0.2)
(ev/sleep 0.3)
(defn test-echo [msg]
(with [conn (net/connect "127.0.0.1" "8000")]
@@ -59,6 +59,7 @@
(var pipe-counter 0)
(def chan (ev/chan 10))
(let [[reader writer] (os/pipe)]
(ev/sleep 0.3)
(ev/spawn
(while (ev/read reader 3)
(++ pipe-counter))

View File

@@ -68,5 +68,68 @@
# # off by 1 error in inttypes
(assert (= (int/s64 "-0x8000_0000_0000_0000") (+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
#
# Longstring indentation
#
(defn reindent
"Reindent a the contents of a longstring as the Janet parser would.
This include removing leading and trailing newlines."
[text indent]
# Detect minimum indent
(var rewrite true)
(each index (string/find-all "\n" text)
(for i (+ index 1) (+ index indent 1)
(case (get text i)
nil (break)
(chr "\n") (break)
(chr " ") nil
(set rewrite false))))
# Only re-indent if no dedented characters.
(def str
(if rewrite
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
text))
(def first-nl (= (chr "\n") (first str)))
(def last-nl (= (chr "\n") (last str)))
(string/slice str (if first-nl 1 0) (if last-nl -2)))
(defn reindent-reference
"Same as reindent but use parser functionality. Useful for validating conformance."
[text indent]
(if (empty? text) (break text))
(def source-code
(string (string/repeat " " indent) "``````"
text
"``````"))
(parse source-code))
(var indent-counter 0)
(defn check-indent
[text indent]
(++ indent-counter)
(let [a (reindent text indent)
b (reindent-reference text indent)]
(assert (= a b) (string "indent " indent-counter " (indent=" indent ")"))))
(check-indent "" 0)
(check-indent "\n" 0)
(check-indent "\n" 1)
(check-indent "\n\n" 0)
(check-indent "\n\n" 1)
(check-indent "\nHello, world!" 0)
(check-indent "\nHello, world!" 1)
(check-indent "Hello, world!" 0)
(check-indent "Hello, world!" 1)
(check-indent "\n Hello, world!" 4)
(check-indent "\n Hello, world!\n" 4)
(check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n dedented text\n " 4)
(check-indent "\n Hello, world!\n indented text\n " 4)
(end-suite)