mirror of
https://github.com/janet-lang/janet
synced 2026-05-03 04:01:26 +00:00
Compare commits
86 Commits
issue-1692
...
v1.41.0
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
10bb17199c | ||
|
|
0aa7dfeb9a | ||
|
|
8f7c32e5cb | ||
|
|
abd7bb1110 | ||
|
|
d81512723b | ||
|
|
2a54154976 | ||
|
|
306ce892ea | ||
|
|
c7c3821aa6 | ||
|
|
d2685594f9 | ||
|
|
ca5c617fba | ||
|
|
16b449a137 | ||
|
|
2e8dd90a51 | ||
|
|
196f27af3d | ||
|
|
42c0096ce7 | ||
|
|
0194115412 | ||
|
|
f33697d6a0 | ||
|
|
b2bf70eace | ||
|
|
855d1f2940 | ||
|
|
416bba9bd9 | ||
|
|
517e40a17b | ||
|
|
4f9a2af357 | ||
|
|
a37752708e | ||
|
|
5042ad6d4b | ||
|
|
643c0b4976 | ||
|
|
ecb72c9c9a | ||
|
|
a95546ff16 | ||
|
|
d47f82713b | ||
|
|
497e363401 | ||
|
|
8481da18d0 | ||
|
|
8f8382eead | ||
|
|
8e2ec997f0 | ||
|
|
ea271b6d6c | ||
|
|
e1897e1865 | ||
|
|
0c1585fdfe | ||
|
|
a5c4e929e8 | ||
|
|
4c21dc3c06 | ||
|
|
d67b462023 | ||
|
|
24ca108288 | ||
|
|
7366fbed1f | ||
|
|
797643716b | ||
|
|
eda2e11d31 | ||
|
|
ae0afe6198 | ||
|
|
33f5a0b319 | ||
|
|
3ecc9bc543 | ||
|
|
339b0751c8 | ||
|
|
87b1bf1a66 | ||
|
|
41354ada96 | ||
|
|
ee8d816738 | ||
|
|
0f285855f0 | ||
|
|
c43e06672c | ||
|
|
2fabc80151 | ||
|
|
4dd08a4cde | ||
|
|
883dde4fa5 | ||
|
|
6111291ede | ||
|
|
53b8bf2684 | ||
|
|
0c402cf3d6 | ||
|
|
606a1fc11a | ||
|
|
a2db57b9dc | ||
|
|
f021bb2839 | ||
|
|
979233dee5 | ||
|
|
78a785175a | ||
|
|
268864b072 | ||
|
|
06f099d7f9 | ||
|
|
6549903c51 | ||
|
|
c1dff351d9 | ||
|
|
4aa5615a37 | ||
|
|
67932bbaed | ||
|
|
4575cefb7e | ||
|
|
d5a014baff | ||
|
|
eb825772bb | ||
|
|
ee2985f5e3 | ||
|
|
5819408715 | ||
|
|
8fe284b5eb | ||
|
|
19b5502f50 | ||
|
|
0a5ff208a8 | ||
|
|
d35f189446 | ||
|
|
216c9799f5 | ||
|
|
5966017232 | ||
|
|
f80690e4c9 | ||
|
|
9bc308532f | ||
|
|
7a8d8444fe | ||
|
|
15cea60589 | ||
|
|
10954fe0d7 | ||
|
|
70fb13eb48 | ||
|
|
cb355815ee | ||
|
|
ddc7cc5ae4 |
1
.gitignore
vendored
1
.gitignore
vendored
@@ -12,6 +12,7 @@ janet
|
|||||||
/src/include/generated/*.h
|
/src/include/generated/*.h
|
||||||
janet-*.tar.gz
|
janet-*.tar.gz
|
||||||
dist
|
dist
|
||||||
|
/tmp
|
||||||
|
|
||||||
# jpm lockfile
|
# jpm lockfile
|
||||||
lockfile.janet
|
lockfile.janet
|
||||||
|
|||||||
17
CHANGELOG.md
17
CHANGELOG.md
@@ -1,7 +1,22 @@
|
|||||||
# Changelog
|
# Changelog
|
||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## Unreleased - ???
|
## 1.41.0 - 2026-02-15
|
||||||
|
- Revert to blocking behaior of `net/connect` on windows to fix spurious errors.
|
||||||
|
- Allow overriding the loader when doing imports with the `:loader` argument.
|
||||||
|
- Allow importing modules with a path extension to do what one would expect.
|
||||||
|
- Add `find-all` argument to `module/find`
|
||||||
|
- Add :threads, :unmarshal, :compiler, and :asm sandbox flags.
|
||||||
|
- Add support for persistent REPL history with the environment variable `JANET_HISTFILE`
|
||||||
|
- Fix a number of fuzzer-found compiler bugs
|
||||||
|
- Fix windows processes launching bug with empty environment table that caused process-launch failures.
|
||||||
|
- Add `:I`, `:V`, and `:N` flags to `os/open` for more control when creating streams.
|
||||||
|
- Add `ev/go-gather` for a dynamic `ev/gather`.
|
||||||
|
- Use color in script output if color is being used in REPL output.
|
||||||
|
- Fix `varfn` macros handling of extra metadata.
|
||||||
|
- Disallow certain degenerate uses of fibers with the ev/ module.
|
||||||
|
- Add linting for unused bindings.
|
||||||
|
- Add linting for extra or wrong parameters to &named functions.
|
||||||
- Add `janet_optuinteger` and `janet_optuinteger64` to the C API.
|
- Add `janet_optuinteger` and `janet_optuinteger64` to the C API.
|
||||||
- Add `cms` combinator to PEGs.
|
- Add `cms` combinator to PEGs.
|
||||||
- Add `thaw-keep-keys` as a variant of thaw
|
- Add `thaw-keep-keys` as a variant of thaw
|
||||||
|
|||||||
5
Makefile
5
Makefile
@@ -58,7 +58,6 @@ LDFLAGS?=-rdynamic
|
|||||||
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
||||||
RUN:=$(RUN)
|
RUN:=$(RUN)
|
||||||
|
|
||||||
|
|
||||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
||||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||||
@@ -220,9 +219,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
|||||||
########################
|
########################
|
||||||
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
SONAME=libjanet.1.40.dylib
|
SONAME=libjanet.1.41.dylib
|
||||||
else
|
else
|
||||||
SONAME=libjanet.so.1.40
|
SONAME=libjanet.so.1.41
|
||||||
endif
|
endif
|
||||||
|
|
||||||
ifeq ($(MINGW_COMPILER), clang)
|
ifeq ($(MINGW_COMPILER), clang)
|
||||||
|
|||||||
56
README.md
56
README.md
@@ -148,8 +148,40 @@ You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
|||||||
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||||
the SourceHut mirror is actively maintained.
|
the SourceHut mirror is actively maintained.
|
||||||
|
|
||||||
|
## Spork and JPM
|
||||||
|
|
||||||
|
Spork and JPM are two companion projects to Janet. They are optional, especially in an embedding use case.
|
||||||
|
|
||||||
|
Spork is a collection of common utility modules, and several packaged scripts
|
||||||
|
like `janet-format` for code formatting, `janet-netrepl` for a socket-based
|
||||||
|
REPL, and `janet-pm` for a comprehensive Janet project manager tool. The
|
||||||
|
modules in `spork` are less stable than the interfaces in core Janet, although
|
||||||
|
we try to prevent breaking changes to existing modules, with a preference to
|
||||||
|
add new modules and functions. Spork requires a C compiler to build and install
|
||||||
|
various extenstion components such as miniz and JSON utilities. Many spork
|
||||||
|
sub-modules, for example spork/path, are independent and can be manually
|
||||||
|
vendored in programmer projects without fully installing spork.
|
||||||
|
|
||||||
|
When install Spork, scripts will be installed to $JANET_PATH/bin/ on POSIX systems by default.
|
||||||
|
This likely needs to be added to the path to use these scripts.
|
||||||
|
|
||||||
|
JPM is the older, more opinionated, project manager tool, which has it's pros
|
||||||
|
and cons. It does not require a C compiler to build and install, but is less
|
||||||
|
flexible and is not receiving many changes and improvements going forward. It
|
||||||
|
may also be harder to configure correctly on new systems. In that sense, it may
|
||||||
|
be more stable.
|
||||||
|
|
||||||
|
JPM will install to /usr/local/bin/ on posix systems by default, which may or
|
||||||
|
may not be on your PATH.
|
||||||
|
|
||||||
## Building
|
## Building
|
||||||
|
|
||||||
|
When building from source, for stability, please use the latest tagged release. For
|
||||||
|
example, run `git checkout $(git describe --tags --abbrev=0)` after cloning but
|
||||||
|
before building. For the latest development, build directly on the master
|
||||||
|
branch. The master branch is not-necessarily stable as most Janet development
|
||||||
|
happens directly on the master branch.
|
||||||
|
|
||||||
### macOS and Unix-like
|
### macOS and Unix-like
|
||||||
|
|
||||||
The Makefile is non-portable and requires GNU-flavored make.
|
The Makefile is non-portable and requires GNU-flavored make.
|
||||||
@@ -160,15 +192,18 @@ make
|
|||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
make install
|
make install
|
||||||
make install-jpm-git
|
make install-spork-git # optional
|
||||||
|
make install-jpm-git # optional
|
||||||
```
|
```
|
||||||
|
|
||||||
Find out more about the available make targets by running `make help`.
|
Find out more about the available make targets by running `make help`.
|
||||||
|
|
||||||
### Alpine Linux
|
### Alpine Linux
|
||||||
|
|
||||||
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good combination. Janet can also
|
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good
|
||||||
be built inside a docker container or similar in this manner.
|
combination. Janet can also be built inside a docker container or similar in
|
||||||
|
this manner. This is a great way to try Janet without committing to a full
|
||||||
|
install or needing to customize the default install.
|
||||||
|
|
||||||
```sh
|
```sh
|
||||||
docker run -it --rm alpine /bin/ash
|
docker run -it --rm alpine /bin/ash
|
||||||
@@ -178,8 +213,13 @@ $ cd janet
|
|||||||
$ make -j10
|
$ make -j10
|
||||||
$ make test
|
$ make test
|
||||||
$ make install
|
$ make install
|
||||||
|
$ make install-spork-git # optional
|
||||||
|
$ make install-jpm-git # optional
|
||||||
```
|
```
|
||||||
|
|
||||||
|
Note that for a true statically-linked binary with MUSL, one needs to add `-static` to the Makefile flags. This
|
||||||
|
will also disable runtime loading of native modules (plugins) as well as the FFI.
|
||||||
|
|
||||||
### 32-bit Haiku
|
### 32-bit Haiku
|
||||||
|
|
||||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||||
@@ -191,7 +231,8 @@ make CC=gcc-x86
|
|||||||
make test
|
make test
|
||||||
make repl
|
make repl
|
||||||
make install
|
make install
|
||||||
make install-jpm-git
|
make install-spork-git # optional
|
||||||
|
make install-jpm-git # optional
|
||||||
```
|
```
|
||||||
|
|
||||||
### FreeBSD
|
### FreeBSD
|
||||||
@@ -205,7 +246,8 @@ gmake
|
|||||||
gmake test
|
gmake test
|
||||||
gmake repl
|
gmake repl
|
||||||
gmake install
|
gmake install
|
||||||
gmake install-jpm-git
|
gmake install-spork-git # optional
|
||||||
|
gmake install-jpm-git # optional
|
||||||
```
|
```
|
||||||
|
|
||||||
### NetBSD
|
### NetBSD
|
||||||
@@ -320,8 +362,8 @@ If installed, you can also run `man janet` to get usage information.
|
|||||||
## Embedding
|
## Embedding
|
||||||
|
|
||||||
Janet can be embedded in a host program very easily. The normal build
|
Janet can be embedded in a host program very easily. The normal build
|
||||||
will create a file `build/janet.c`, which is a single C file
|
will create a file `build/c/janet.c`, a C source code file that
|
||||||
that contains all the source to Janet. This file, along with
|
that contains the amalgamated source to Janet. This file, along with
|
||||||
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
|
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
|
||||||
project and compiled into it. Janet should be compiled with `-std=c99`
|
project and compiled into it. Janet should be compiled with `-std=c99`
|
||||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||||
|
|||||||
@@ -26,7 +26,7 @@
|
|||||||
(broadcast name (string msg)))
|
(broadcast name (string msg)))
|
||||||
(print name " disconnected")))))
|
(print name " disconnected")))))
|
||||||
|
|
||||||
(defn main [& args]
|
(defn main [&]
|
||||||
(printf "STARTING SERVER...")
|
(printf "STARTING SERVER...")
|
||||||
(flush)
|
(flush)
|
||||||
(def my-server (net/listen "127.0.0.1" "8000"))
|
(def my-server (net/listen "127.0.0.1" "8000"))
|
||||||
|
|||||||
@@ -132,7 +132,7 @@
|
|||||||
"Go to the next breakpoint."
|
"Go to the next breakpoint."
|
||||||
[&opt n]
|
[&opt n]
|
||||||
(var res nil)
|
(var res nil)
|
||||||
(for i 0 (or n 1)
|
(repeat (or n 1)
|
||||||
(set res (resume (.fiber))))
|
(set res (resume (.fiber))))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
@@ -146,6 +146,6 @@
|
|||||||
"Execute the next n instructions."
|
"Execute the next n instructions."
|
||||||
[&opt n]
|
[&opt n]
|
||||||
(var res nil)
|
(var res nil)
|
||||||
(for i 0 (or n 1)
|
(repeat (or n 1)
|
||||||
(set res (debug/step (.fiber))))
|
(set res (debug/step (.fiber))))
|
||||||
res)
|
res)
|
||||||
|
|||||||
@@ -2,7 +2,7 @@
|
|||||||
|
|
||||||
(def counts (seq [_ :range [0 100]] 0))
|
(def counts (seq [_ :range [0 100]] 0))
|
||||||
|
|
||||||
(for i 0 1000000
|
(repeat 1000000
|
||||||
(let [x (math/random)
|
(let [x (math/random)
|
||||||
intrange (math/floor (* 100 x))
|
intrange (math/floor (* 100 x))
|
||||||
oldcount (counts intrange)]
|
oldcount (counts intrange)]
|
||||||
|
|||||||
@@ -7,7 +7,7 @@
|
|||||||
(ev/give chan (math/random))
|
(ev/give chan (math/random))
|
||||||
(ev/give chan (math/random))
|
(ev/give chan (math/random))
|
||||||
(ev/sleep 0.5)
|
(ev/sleep 0.5)
|
||||||
(for i 0 10
|
(repeat 10
|
||||||
(print "giving to channel...")
|
(print "giving to channel...")
|
||||||
(ev/give chan (math/random))
|
(ev/give chan (math/random))
|
||||||
(ev/sleep 1))
|
(ev/sleep 1))
|
||||||
|
|||||||
8
janet.1
8
janet.1
@@ -156,7 +156,7 @@ Shows the version text and exits immediately.
|
|||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-s
|
.BR \-s
|
||||||
Read raw input from stdin and forgo prompt history and other readline-like features.
|
Read raw input from stdin and forgo fancy input, which includes prompt history and other readline-like features.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-e\ code
|
.BR \-e\ code
|
||||||
@@ -272,6 +272,12 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
|
|||||||
cannot be defined for this variable to have an effect.
|
cannot be defined for this variable to have an effect.
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
|
.B JANET_HISTFILE
|
||||||
|
.RS
|
||||||
|
A file location to use for the default shell's REPL history when using fancy input. This relative path is where commands are persisted between sessions.
|
||||||
|
If unset, no repl history well be used. Does not work with the -s flag where fancy input is disabled.
|
||||||
|
.RE
|
||||||
|
|
||||||
.B NO_COLOR
|
.B NO_COLOR
|
||||||
.RS
|
.RS
|
||||||
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
|
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
|
|
||||||
project('janet', 'c',
|
project('janet', 'c',
|
||||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||||
version : '1.40.1')
|
version : '1.41.0')
|
||||||
|
|
||||||
# Global settings
|
# Global settings
|
||||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||||
@@ -288,6 +288,7 @@ test_files = [
|
|||||||
'test/suite-io.janet',
|
'test/suite-io.janet',
|
||||||
'test/suite-marsh.janet',
|
'test/suite-marsh.janet',
|
||||||
'test/suite-math.janet',
|
'test/suite-math.janet',
|
||||||
|
'test/suite-net.janet',
|
||||||
'test/suite-os.janet',
|
'test/suite-os.janet',
|
||||||
'test/suite-parse.janet',
|
'test/suite-parse.janet',
|
||||||
'test/suite-peg.janet',
|
'test/suite-peg.janet',
|
||||||
|
|||||||
@@ -1,5 +1,5 @@
|
|||||||
# The core janet library
|
# The core janet library
|
||||||
# Copyright 2025 © Calvin Rose
|
# Copyright 2026 © Calvin Rose
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@@ -105,9 +105,9 @@
|
|||||||
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
|
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
|
||||||
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
||||||
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
|
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
|
||||||
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
|
(defn cfunction? "Check if x is a cfunction." [x] (= (type x) :cfunction))
|
||||||
(defn table? "Check if x a table." [x] (= (type x) :table))
|
(defn table? "Check if x is a table." [x] (= (type x) :table))
|
||||||
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
|
(defn struct? "Check if x is a struct." [x] (= (type x) :struct))
|
||||||
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
||||||
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
||||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||||
@@ -115,7 +115,7 @@
|
|||||||
(defn true? "Check if x is true." [x] (= x true))
|
(defn true? "Check if x is true." [x] (= x true))
|
||||||
(defn false? "Check if x is false." [x] (= x false))
|
(defn false? "Check if x is false." [x] (= x false))
|
||||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||||
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
|
(defn empty? "Check if an iterable, `iter`, is empty." [iter] (= nil (next iter nil)))
|
||||||
|
|
||||||
# For macros, we define an incomplete odd? function that will be overridden.
|
# For macros, we define an incomplete odd? function that will be overridden.
|
||||||
(defn odd? [x] (= 1 (mod x 2)))
|
(defn odd? [x] (= 1 (mod x 2)))
|
||||||
@@ -370,19 +370,24 @@
|
|||||||
(++ i))
|
(++ i))
|
||||||
~(let (,;accum) ,;body))
|
~(let (,;accum) ,;body))
|
||||||
|
|
||||||
(defmacro defer
|
(defn- defer-impl
|
||||||
``Run `form` unconditionally after `body`, even if the body throws an error.
|
"Defer but allow custom name for stack traces"
|
||||||
Will also run `form` if a user signal 0-4 is received.``
|
[name form body]
|
||||||
[form & body]
|
|
||||||
(with-syms [f r]
|
(with-syms [f r]
|
||||||
~(do
|
~(do
|
||||||
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
|
(def ,f (,fiber/new (fn ,name [] ,;body) :ti))
|
||||||
(def ,r (,resume ,f))
|
(def ,r (,resume ,f))
|
||||||
,form
|
,form
|
||||||
(if (= (,fiber/status ,f) :dead)
|
(if (= (,fiber/status ,f) :dead)
|
||||||
,r
|
,r
|
||||||
(,propagate ,r ,f)))))
|
(,propagate ,r ,f)))))
|
||||||
|
|
||||||
|
(defmacro defer
|
||||||
|
``Run `form` unconditionally after `body`, even if the body throws an error.
|
||||||
|
Will also run `form` if a user signal 0-4 is received.``
|
||||||
|
[form & body]
|
||||||
|
(defer-impl :defer form body))
|
||||||
|
|
||||||
(defmacro edefer
|
(defmacro edefer
|
||||||
``Run `form` after `body` in the case that body terminates abnormally (an error or user signal 0-4).
|
``Run `form` after `body` in the case that body terminates abnormally (an error or user signal 0-4).
|
||||||
Otherwise, return last form in `body`.``
|
Otherwise, return last form in `body`.``
|
||||||
@@ -436,14 +441,14 @@
|
|||||||
[[binding ctor dtor] & body]
|
[[binding ctor dtor] & body]
|
||||||
~(do
|
~(do
|
||||||
(def ,binding ,ctor)
|
(def ,binding ,ctor)
|
||||||
,(apply defer [(or dtor :close) binding] body)))
|
,(defer-impl :with [(or dtor :close) binding] body)))
|
||||||
|
|
||||||
(defmacro when-with
|
(defmacro when-with
|
||||||
``Similar to with, but if binding is false or nil, returns
|
``Similar to with, but if binding is false or nil, returns
|
||||||
nil without evaluating the body. Otherwise, the same as `with`.``
|
nil without evaluating the body. Otherwise, the same as `with`.``
|
||||||
[[binding ctor dtor] & body]
|
[[binding ctor dtor] & body]
|
||||||
~(if-let [,binding ,ctor]
|
~(if-let [,binding ,ctor]
|
||||||
,(apply defer [(or dtor :close) binding] body)))
|
,(defer-impl :when-with [(or dtor :close) binding] body)))
|
||||||
|
|
||||||
(defmacro if-with
|
(defmacro if-with
|
||||||
``Similar to `with`, but if binding is false or nil, evaluates
|
``Similar to `with`, but if binding is false or nil, evaluates
|
||||||
@@ -451,7 +456,7 @@
|
|||||||
`ctor` is bound to binding.``
|
`ctor` is bound to binding.``
|
||||||
[[binding ctor dtor] truthy &opt falsey]
|
[[binding ctor dtor] truthy &opt falsey]
|
||||||
~(if-let [,binding ,ctor]
|
~(if-let [,binding ,ctor]
|
||||||
,(apply defer [(or dtor :close) binding] [truthy])
|
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
|
||||||
,falsey))
|
,falsey))
|
||||||
|
|
||||||
(defn- for-var-template
|
(defn- for-var-template
|
||||||
@@ -2113,11 +2118,15 @@
|
|||||||
(array/concat anda unify)
|
(array/concat anda unify)
|
||||||
# Final binding
|
# Final binding
|
||||||
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
|
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
|
||||||
|
(def unused-defs (seq [[k v] :in (sort (pairs b2g))] ['def k :unused (first v)]))
|
||||||
# Predicates
|
# Predicates
|
||||||
(unless (empty? preds)
|
(unless (empty? preds)
|
||||||
(def pred-join ~(do ,;defs (and ,;preds)))
|
(def pred-join ~(do ,;unused-defs (and ,;preds)))
|
||||||
(array/push anda pred-join))
|
(array/push anda pred-join))
|
||||||
(emit-branch (tuple/slice anda) ['do ;defs expression]))
|
# Use `unused-defs` instead of `defs` when we have predicates to avoid unused binding lint
|
||||||
|
# e.g. (match x (n (even? n)) :yes :no) should not warn on unused binding `n`.
|
||||||
|
# This is unfortunately not perfect since one programmer written binding is expanded for use in multiple places.
|
||||||
|
(emit-branch (tuple/slice anda) ['do ;(if (next preds) unused-defs defs) expression]))
|
||||||
|
|
||||||
# Expand branches
|
# Expand branches
|
||||||
(def stack @[else])
|
(def stack @[else])
|
||||||
@@ -2164,7 +2173,7 @@
|
|||||||
(defn expand-bindings [x]
|
(defn expand-bindings [x]
|
||||||
(case (type x)
|
(case (type x)
|
||||||
:array (map expand-bindings x)
|
:array (map expand-bindings x)
|
||||||
:tuple (tuple/slice (map expand-bindings x))
|
:tuple (keep-syntax! x (map expand-bindings x))
|
||||||
:table (dotable x expand-bindings)
|
:table (dotable x expand-bindings)
|
||||||
:struct (table/to-struct (dotable x expand-bindings))
|
:struct (table/to-struct (dotable x expand-bindings))
|
||||||
(recur x)))
|
(recur x)))
|
||||||
@@ -2172,11 +2181,11 @@
|
|||||||
(defn expanddef [t]
|
(defn expanddef [t]
|
||||||
(def last (in t (- (length t) 1)))
|
(def last (in t (- (length t) 1)))
|
||||||
(def bound (in t 1))
|
(def bound (in t 1))
|
||||||
(tuple/slice
|
(keep-syntax! t
|
||||||
(array/concat
|
(array/concat
|
||||||
@[(in t 0) (expand-bindings bound)]
|
@[(in t 0) (expand-bindings bound)]
|
||||||
(tuple/slice t 2 -2)
|
(tuple/slice t 2 -2)
|
||||||
@[(recur last)])))
|
@[(recur last)])))
|
||||||
|
|
||||||
(defn expandall [t]
|
(defn expandall [t]
|
||||||
(def args (map recur (tuple/slice t 1)))
|
(def args (map recur (tuple/slice t 1)))
|
||||||
@@ -2187,10 +2196,10 @@
|
|||||||
(if (symbol? t1)
|
(if (symbol? t1)
|
||||||
(do
|
(do
|
||||||
(def args (map recur (tuple/slice t 3)))
|
(def args (map recur (tuple/slice t 3)))
|
||||||
(tuple 'fn t1 (in t 2) ;args))
|
(keep-syntax t (tuple 'fn t1 (in t 2) ;args)))
|
||||||
(do
|
(do
|
||||||
(def args (map recur (tuple/slice t 2)))
|
(def args (map recur (tuple/slice t 2)))
|
||||||
(tuple 'fn t1 ;args))))
|
(keep-syntax t (tuple 'fn t1 ;args)))))
|
||||||
|
|
||||||
(defn expandqq [t]
|
(defn expandqq [t]
|
||||||
(defn qq [x]
|
(defn qq [x]
|
||||||
@@ -2399,6 +2408,7 @@
|
|||||||
(cond
|
(cond
|
||||||
(keyword? m) (put metadata m true)
|
(keyword? m) (put metadata m true)
|
||||||
(string? m) (put metadata :doc m)
|
(string? m) (put metadata :doc m)
|
||||||
|
(dictionary? m) (merge-into metadata m)
|
||||||
(error (string "invalid metadata " m))))
|
(error (string "invalid metadata " m))))
|
||||||
(with-syms [entry old-entry f]
|
(with-syms [entry old-entry f]
|
||||||
~(let [,old-entry (,dyn ',name)]
|
~(let [,old-entry (,dyn ',name)]
|
||||||
@@ -2835,7 +2845,8 @@
|
|||||||
(defmacro comptime
|
(defmacro comptime
|
||||||
"Evals x at compile time and returns the result. Similar to a top level unquote."
|
"Evals x at compile time and returns the result. Similar to a top level unquote."
|
||||||
[x]
|
[x]
|
||||||
(eval x))
|
(def y (eval x))
|
||||||
|
y)
|
||||||
|
|
||||||
(defmacro compif
|
(defmacro compif
|
||||||
"Check the condition `cnd` at compile time -- if truthy, compile `tru`, else compile `fals`."
|
"Check the condition `cnd` at compile time -- if truthy, compile `tru`, else compile `fals`."
|
||||||
@@ -2863,7 +2874,8 @@
|
|||||||
|
|
||||||
(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
|
(defn- check-dyn-relative [x] (if (string/has-prefix? "@" x) x))
|
||||||
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
|
(defn- check-relative [x] (if (string/has-prefix? "." x) x))
|
||||||
(defn- check-not-relative [x] (if-not (string/has-prefix? "." x) x))
|
# Don't try to preload absolute or relative paths
|
||||||
|
(defn- check-preloadable [x] (if-not (or (string/has-prefix? "/" x) (string/find "." x) (string/find "@" x)) x))
|
||||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
||||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||||
|
|
||||||
@@ -2913,6 +2925,7 @@
|
|||||||
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
||||||
(def curall-index (find-prefix ":cur:/:all:"))
|
(def curall-index (find-prefix ":cur:/:all:"))
|
||||||
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||||
|
(array/insert mp 0 [":all:" loader (fn :check-ext [x] (string/has-suffix? ext x))])
|
||||||
mp)
|
mp)
|
||||||
|
|
||||||
# Don't expose this externally yet - could break if custom module/paths is setup.
|
# Don't expose this externally yet - could break if custom module/paths is setup.
|
||||||
@@ -2937,7 +2950,10 @@
|
|||||||
(module/add-paths "/init.janet" :source)
|
(module/add-paths "/init.janet" :source)
|
||||||
(module/add-paths ".janet" :source)
|
(module/add-paths ".janet" :source)
|
||||||
(module/add-paths ".jimage" :image)
|
(module/add-paths ".jimage" :image)
|
||||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
|
(array/insert module/paths 0
|
||||||
|
[(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path))
|
||||||
|
:preload
|
||||||
|
check-preloadable])
|
||||||
|
|
||||||
# Version of fexists that works even with a reduced OS
|
# Version of fexists that works even with a reduced OS
|
||||||
(defn- fexists
|
(defn- fexists
|
||||||
@@ -2965,20 +2981,22 @@
|
|||||||
or :image if the module is found, otherwise a tuple with nil followed by
|
or :image if the module is found, otherwise a tuple with nil followed by
|
||||||
an error message.
|
an error message.
|
||||||
```
|
```
|
||||||
[path]
|
[path &opt find-all]
|
||||||
(var ret nil)
|
(var ret nil)
|
||||||
(def mp (dyn *module-paths* module/paths))
|
(def mp (dyn *module-paths* module/paths))
|
||||||
|
(def all-matches (if find-all @[]))
|
||||||
(each [p mod-kind checker] mp
|
(each [p mod-kind checker] mp
|
||||||
(when (mod-filter checker path)
|
(when (mod-filter checker path)
|
||||||
(if (function? p)
|
(if (function? p)
|
||||||
(when-let [res (p path)]
|
(when-let [res (p path)]
|
||||||
(set ret [res mod-kind])
|
(set ret [res mod-kind])
|
||||||
(break))
|
(if find-all (array/push all-matches ret) (break)))
|
||||||
(do
|
(do
|
||||||
(def fullpath (string (module/expand-path path p)))
|
(def fullpath (string (module/expand-path path p)))
|
||||||
(when (fexists fullpath)
|
(when (fexists fullpath)
|
||||||
(set ret [fullpath mod-kind])
|
(set ret [fullpath mod-kind])
|
||||||
(break))))))
|
(if find-all (array/push all-matches ret) (break)))))))
|
||||||
|
(if find-all (break all-matches))
|
||||||
(if ret ret
|
(if ret ret
|
||||||
(let [expander (fn :expander [[t _ chk]]
|
(let [expander (fn :expander [[t _ chk]]
|
||||||
(when (string? t)
|
(when (string? t)
|
||||||
@@ -3089,7 +3107,7 @@
|
|||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
(put env :exit true)
|
(put env :exit true)
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
(with-dyns [*err* buf *err-color* false]
|
(with-dyns [*err* buf]
|
||||||
(bad-parse x y))
|
(bad-parse x y))
|
||||||
(set exit-error (string/slice buf 0 -2)))
|
(set exit-error (string/slice buf 0 -2)))
|
||||||
(defn bc [&opt x y z a b]
|
(defn bc [&opt x y z a b]
|
||||||
@@ -3098,7 +3116,7 @@
|
|||||||
(os/exit 1))
|
(os/exit 1))
|
||||||
(put env :exit true)
|
(put env :exit true)
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
(with-dyns [*err* buf *err-color* false]
|
(with-dyns [*err* buf]
|
||||||
(bad-compile x nil z a b))
|
(bad-compile x nil z a b))
|
||||||
(set exit-error (string/slice buf 0 -2))
|
(set exit-error (string/slice buf 0 -2))
|
||||||
(set exit-fiber y))
|
(set exit-fiber y))
|
||||||
@@ -3153,17 +3171,20 @@
|
|||||||
|
|
||||||
(defn- require-1
|
(defn- require-1
|
||||||
[path args kargs]
|
[path args kargs]
|
||||||
(def [fullpath mod-kind] (module/find path))
|
(def [fullpath mod-kind]
|
||||||
|
(if-let [loader (get kargs :loader)]
|
||||||
|
[path loader]
|
||||||
|
(module/find path)))
|
||||||
(unless fullpath (error mod-kind))
|
(unless fullpath (error mod-kind))
|
||||||
(def mc (dyn *module-cache* module/cache))
|
(def mc (dyn *module-cache* module/cache))
|
||||||
(def ml (dyn *module-loading* module/loading))
|
(def ml (dyn *module-loading* module/loading))
|
||||||
(def mls (dyn *module-loaders* module/loaders))
|
(def mls (dyn *module-loaders* module/loaders))
|
||||||
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
|
(if-let [check (if-not (get kargs :fresh) (in mc fullpath))]
|
||||||
check
|
check
|
||||||
(if (ml fullpath)
|
(if (get ml fullpath)
|
||||||
(error (string "circular dependency " fullpath " detected"))
|
(error (string "circular dependency " fullpath " detected"))
|
||||||
(do
|
(do
|
||||||
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
|
(def loader (if (keyword? mod-kind) (get mls mod-kind) mod-kind))
|
||||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||||
(def env (loader fullpath args))
|
(def env (loader fullpath args))
|
||||||
(put mc fullpath env)
|
(put mc fullpath env)
|
||||||
@@ -3202,7 +3223,7 @@
|
|||||||
(def prefix (or
|
(def prefix (or
|
||||||
(and as (string as "/"))
|
(and as (string as "/"))
|
||||||
prefix
|
prefix
|
||||||
(string (last (string/split "/" path)) "/")))
|
(string (first (string/split "." (last (string/split "/" path)))) "/")))
|
||||||
(merge-module env newenv prefix ep only))
|
(merge-module env newenv prefix ep only))
|
||||||
|
|
||||||
(defmacro import
|
(defmacro import
|
||||||
@@ -3717,7 +3738,7 @@
|
|||||||
(def digits (inc (math/floor (math/log10 end))))
|
(def digits (inc (math/floor (math/log10 end))))
|
||||||
(def fmt-str (string "%" digits "d: %s"))
|
(def fmt-str (string "%" digits "d: %s"))
|
||||||
(for i beg end
|
(for i beg end
|
||||||
(eprin " ") # breakpoint someday?
|
(eprin " ")
|
||||||
(eprin (if (= i cur) "> " " "))
|
(eprin (if (= i cur) "> " " "))
|
||||||
(eprintf fmt-str i (get lines i))))
|
(eprintf fmt-str i (get lines i))))
|
||||||
(let [[sl _] (sourcemap pc)]
|
(let [[sl _] (sourcemap pc)]
|
||||||
@@ -3854,13 +3875,16 @@
|
|||||||
(defn ev/call
|
(defn ev/call
|
||||||
```
|
```
|
||||||
Call a function asynchronously.
|
Call a function asynchronously.
|
||||||
Returns a fiber that is scheduled to run the function.
|
Returns a task fiber that is scheduled to run the function.
|
||||||
```
|
```
|
||||||
[f & args]
|
[f & args]
|
||||||
(ev/go (fn :call [&] (f ;args))))
|
(ev/go (fn :call [&] (f ;args))))
|
||||||
|
|
||||||
(defmacro ev/spawn
|
(defmacro ev/spawn
|
||||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
``
|
||||||
|
Run some code in a new task fiber. This is shorthand for
|
||||||
|
`(ev/go (fn [] ;body))`."
|
||||||
|
``
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/go (fn :spawn [&] ,;body)))
|
~(,ev/go (fn :spawn [&] ,;body)))
|
||||||
|
|
||||||
@@ -3933,23 +3957,33 @@
|
|||||||
(cancel-all chan fibers "sibling canceled")
|
(cancel-all chan fibers "sibling canceled")
|
||||||
(propagate (fiber/last-value fiber) fiber))))))
|
(propagate (fiber/last-value fiber) fiber))))))
|
||||||
|
|
||||||
|
(defn ev/go-gather
|
||||||
|
```
|
||||||
|
Run a dyanmic number of fibers in parallel and resume the current fiber after they complete. Takes
|
||||||
|
an array of functions or fibers, `thunks`, that will be run via `ev/go` in another task.
|
||||||
|
Returns the gathered results in an array.
|
||||||
|
```
|
||||||
|
[thunks]
|
||||||
|
(def fset @{})
|
||||||
|
(def chan (ev/chan))
|
||||||
|
(def results @[])
|
||||||
|
(each thunk thunks
|
||||||
|
(def ftemp (ev/go thunk nil chan))
|
||||||
|
(array/push results ftemp)
|
||||||
|
(put fset ftemp ftemp))
|
||||||
|
(wait-for-fibers chan fset)
|
||||||
|
(for i 0 (length results) # avoid extra copy from map
|
||||||
|
(set (results i) (fiber/last-value (in results i))))
|
||||||
|
results)
|
||||||
|
|
||||||
(defmacro ev/gather
|
(defmacro ev/gather
|
||||||
``
|
``
|
||||||
Run a number of fibers in parallel on the event loop, and join when they complete.
|
Create and run a number of fibers in parallel (created from `bodies`) and resume the
|
||||||
Returns the gathered results in an array.
|
current fiber after they complete. Shorthand for `ev/go-gather`. Returns the gathered results in an
|
||||||
|
array.
|
||||||
``
|
``
|
||||||
[& bodies]
|
[& bodies]
|
||||||
(with-syms [chan res fset ftemp]
|
~(,ev/go-gather ,(seq [body :in bodies] ~(fn :ev/gather [] ,body)))))
|
||||||
~(do
|
|
||||||
(def ,fset @{})
|
|
||||||
(def ,chan (,ev/chan))
|
|
||||||
(def ,res @[])
|
|
||||||
,;(seq [[i body] :pairs bodies]
|
|
||||||
~(do
|
|
||||||
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
|
|
||||||
(,put ,fset ,ftemp ,ftemp)))
|
|
||||||
(,wait-for-fibers ,chan ,fset)
|
|
||||||
,res))))
|
|
||||||
|
|
||||||
(compwhen (dyn 'net/listen)
|
(compwhen (dyn 'net/listen)
|
||||||
(defn net/server
|
(defn net/server
|
||||||
@@ -4261,12 +4295,12 @@
|
|||||||
(try
|
(try
|
||||||
(require (string "@syspath/bundle/" bundle-name))
|
(require (string "@syspath/bundle/" bundle-name))
|
||||||
([e f]
|
([e f]
|
||||||
(def pfx "could not find module @syspath/bundle/")
|
(def pfx "could not find module @syspath/bundle/")
|
||||||
(def msg (if (and (string? e)
|
(def msg (if (and (string? e)
|
||||||
(string/has-prefix? pfx e))
|
(string/has-prefix? pfx e))
|
||||||
"bundle must contain bundle.janet or bundle/init.janet"
|
"bundle must contain bundle.janet or bundle/init.janet"
|
||||||
e))
|
e))
|
||||||
(propagate msg f))))))
|
(propagate msg f))))))
|
||||||
|
|
||||||
(defn- do-hook
|
(defn- do-hook
|
||||||
[module bundle-name hook & args]
|
[module bundle-name hook & args]
|
||||||
@@ -4398,8 +4432,8 @@
|
|||||||
(def bscript-src1 (string path s "bundle" s "init.janet"))
|
(def bscript-src1 (string path s "bundle" s "init.janet"))
|
||||||
(def bscript-src2 (string path s "bundle.janet"))
|
(def bscript-src2 (string path s "bundle.janet"))
|
||||||
(def bscript-src (cond
|
(def bscript-src (cond
|
||||||
(fexists bscript-src1) bscript-src1
|
(fexists bscript-src1) bscript-src1
|
||||||
(fexists bscript-src2) bscript-src2))
|
(fexists bscript-src2) bscript-src2))
|
||||||
# Setup installed paths
|
# Setup installed paths
|
||||||
(prime-bundle-paths)
|
(prime-bundle-paths)
|
||||||
(os/mkdir (bundle-dir bundle-name))
|
(os/mkdir (bundle-dir bundle-name))
|
||||||
@@ -4672,6 +4706,17 @@
|
|||||||
"-lint-warn" "w"
|
"-lint-warn" "w"
|
||||||
"-lint-error" "x"})
|
"-lint-error" "x"})
|
||||||
|
|
||||||
|
(defn- apply-color
|
||||||
|
[colorize]
|
||||||
|
(setdyn *pretty-format* (if colorize "%.20Q" "%.20q"))
|
||||||
|
(setdyn *err-color* (if colorize true))
|
||||||
|
(setdyn *doc-color* (if colorize true)))
|
||||||
|
|
||||||
|
(defn- getstdin [prompt buf _]
|
||||||
|
(file/write stdout prompt)
|
||||||
|
(file/flush stdout)
|
||||||
|
(file/read stdin :line buf))
|
||||||
|
|
||||||
(defn cli-main
|
(defn cli-main
|
||||||
`Entrance for the Janet CLI tool. Call this function with the command line
|
`Entrance for the Janet CLI tool. Call this function with the command line
|
||||||
arguments as an array or tuple of strings to invoke the CLI interface.`
|
arguments as an array or tuple of strings to invoke the CLI interface.`
|
||||||
@@ -4685,11 +4730,7 @@
|
|||||||
(var raw-stdin false)
|
(var raw-stdin false)
|
||||||
(var handleopts true)
|
(var handleopts true)
|
||||||
(var exit-on-error true)
|
(var exit-on-error true)
|
||||||
(var colorize true)
|
|
||||||
(var debug-flag false)
|
|
||||||
(var compile-only false)
|
(var compile-only false)
|
||||||
(var warn-level nil)
|
|
||||||
(var error-level nil)
|
|
||||||
(var expect-image false)
|
(var expect-image false)
|
||||||
|
|
||||||
(when-let [jp (getenv-alias "JANET_PATH")]
|
(when-let [jp (getenv-alias "JANET_PATH")]
|
||||||
@@ -4699,9 +4740,10 @@
|
|||||||
(module/add-syspath (get paths i)))
|
(module/add-syspath (get paths i)))
|
||||||
(setdyn *syspath* (first paths)))
|
(setdyn *syspath* (first paths)))
|
||||||
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
|
(if-let [jprofile (getenv-alias "JANET_PROFILE")] (setdyn *profilepath* jprofile))
|
||||||
(set colorize (and
|
(apply-color
|
||||||
(not (getenv-alias "NO_COLOR"))
|
(and
|
||||||
(os/isatty stdout)))
|
(not (getenv-alias "NO_COLOR"))
|
||||||
|
(os/isatty stdout)))
|
||||||
|
|
||||||
(defn- get-lint-level
|
(defn- get-lint-level
|
||||||
[i]
|
[i]
|
||||||
@@ -4751,8 +4793,8 @@
|
|||||||
"q" (fn [&] (set quiet true) 1)
|
"q" (fn [&] (set quiet true) 1)
|
||||||
"i" (fn [&] (set expect-image true) 1)
|
"i" (fn [&] (set expect-image true) 1)
|
||||||
"k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
|
"k" (fn [&] (set compile-only true) (set exit-on-error false) 1)
|
||||||
"n" (fn [&] (set colorize false) 1)
|
"n" (fn [&] (apply-color false) 1)
|
||||||
"N" (fn [&] (set colorize true) 1)
|
"N" (fn [&] (apply-color true) 1)
|
||||||
"m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2)
|
"m" (fn [i &] (setdyn *syspath* (in args (+ i 1))) 2)
|
||||||
"c" (fn c-switch [i &]
|
"c" (fn c-switch [i &]
|
||||||
(def path (in args (+ i 1)))
|
(def path (in args (+ i 1)))
|
||||||
@@ -4808,9 +4850,9 @@
|
|||||||
(compif (dyn 'bundle/list)
|
(compif (dyn 'bundle/list)
|
||||||
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
|
||||||
(fn [i &] (eprint "--list not supported with reduced os") 1))
|
(fn [i &] (eprint "--list not supported with reduced os") 1))
|
||||||
"d" (fn [&] (set debug-flag true) 1)
|
"d" (fn [&] (setdyn *debug* true) (setdyn *redef* true) 1)
|
||||||
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
|
"w" (fn [i &] (setdyn *lint-warn* (get-lint-level i)) 2)
|
||||||
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
|
"x" (fn [i &] (setdyn *lint-error* (get-lint-level i)) 2)
|
||||||
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
"R" (fn [&] (setdyn *profilepath* nil) 1)})
|
||||||
|
|
||||||
(defn- dohandler [n i &]
|
(defn- dohandler [n i &]
|
||||||
@@ -4831,20 +4873,10 @@
|
|||||||
(do
|
(do
|
||||||
(def env (load-image (slurp arg)))
|
(def env (load-image (slurp arg)))
|
||||||
(put env *args* subargs)
|
(put env *args* subargs)
|
||||||
(put env *lint-error* error-level)
|
|
||||||
(put env *lint-warn* warn-level)
|
|
||||||
(when debug-flag
|
|
||||||
(put env *debug* true)
|
|
||||||
(put env *redef* true))
|
|
||||||
(run-main env subargs arg))
|
(run-main env subargs arg))
|
||||||
(do
|
(do
|
||||||
(def env (make-env))
|
(def env (make-env))
|
||||||
(put env *args* subargs)
|
(put env *args* subargs)
|
||||||
(put env *lint-error* error-level)
|
|
||||||
(put env *lint-warn* warn-level)
|
|
||||||
(when debug-flag
|
|
||||||
(put env *debug* true)
|
|
||||||
(put env *redef* true))
|
|
||||||
(if compile-only
|
(if compile-only
|
||||||
(flycheck arg :exit exit-on-error :env env)
|
(flycheck arg :exit exit-on-error :env env)
|
||||||
(do
|
(do
|
||||||
@@ -4864,21 +4896,9 @@
|
|||||||
(when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
|
(when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
|
||||||
(def [line] (parser/where p))
|
(def [line] (parser/where p))
|
||||||
(string "repl:" line ":" (parser/state p :delimiters) "> "))
|
(string "repl:" line ":" (parser/state p :delimiters) "> "))
|
||||||
(defn getstdin [prompt buf _]
|
|
||||||
(file/write stdout prompt)
|
|
||||||
(file/flush stdout)
|
|
||||||
(file/read stdin :line buf))
|
|
||||||
(when debug-flag
|
|
||||||
(put env *debug* true)
|
|
||||||
(put env *redef* true))
|
|
||||||
(def getter (if raw-stdin getstdin getline))
|
(def getter (if raw-stdin getstdin getline))
|
||||||
(defn getchunk [buf p]
|
(defn getchunk [buf p]
|
||||||
(getter (getprompt p) buf env))
|
(getter (getprompt p) buf env))
|
||||||
(setdyn *pretty-format* (if colorize "%.20Q" "%.20q"))
|
|
||||||
(setdyn *err-color* (if colorize true))
|
|
||||||
(setdyn *doc-color* (if colorize true))
|
|
||||||
(setdyn *lint-error* error-level)
|
|
||||||
(setdyn *lint-warn* error-level)
|
|
||||||
(when-let [profile.janet (dyn *profilepath*)]
|
(when-let [profile.janet (dyn *profilepath*)]
|
||||||
(dofile profile.janet :exit true :env env)
|
(dofile profile.janet :exit true :env env)
|
||||||
(put env *current-file* nil))
|
(put env *current-file* nil))
|
||||||
|
|||||||
@@ -37,7 +37,7 @@ int system_test() {
|
|||||||
|
|
||||||
/* Check the version defines are self consistent */
|
/* Check the version defines are self consistent */
|
||||||
char version_combined[256];
|
char version_combined[256];
|
||||||
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
|
snprintf(version_combined, sizeof(version_combined), "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
|
||||||
assert(!strcmp(JANET_VERSION, version_combined));
|
assert(!strcmp(JANET_VERSION, version_combined));
|
||||||
|
|
||||||
/* Reflexive testing and nanbox testing */
|
/* Reflexive testing and nanbox testing */
|
||||||
|
|||||||
@@ -4,10 +4,10 @@
|
|||||||
#define JANETCONF_H
|
#define JANETCONF_H
|
||||||
|
|
||||||
#define JANET_VERSION_MAJOR 1
|
#define JANET_VERSION_MAJOR 1
|
||||||
#define JANET_VERSION_MINOR 40
|
#define JANET_VERSION_MINOR 41
|
||||||
#define JANET_VERSION_PATCH 1
|
#define JANET_VERSION_PATCH 0
|
||||||
#define JANET_VERSION_EXTRA ""
|
#define JANET_VERSION_EXTRA "-dev"
|
||||||
#define JANET_VERSION "1.40.1"
|
#define JANET_VERSION "1.41.0-dev"
|
||||||
|
|
||||||
/* #define JANET_BUILD "local" */
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
|
|||||||
@@ -201,4 +201,17 @@ int32_t janet_abstract_decref(void *abst) {
|
|||||||
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
int32_t janet_abstract_decref_maybe_free(void *abst) {
|
||||||
|
int32_t result = janet_abstract_decref(abst);
|
||||||
|
if (0 == result) {
|
||||||
|
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||||
|
if (head->type->gc) {
|
||||||
|
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||||
|
}
|
||||||
|
/* Free memory */
|
||||||
|
janet_free(head);
|
||||||
|
}
|
||||||
|
return result;
|
||||||
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -567,6 +567,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
|
/* Check namedarg */
|
||||||
|
x = janet_get1(s, janet_ckeywordv("namedargs"));
|
||||||
|
if (janet_checkint(x)) {
|
||||||
|
def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||||
|
def->named_args_count = janet_unwrap_integer(x);
|
||||||
|
}
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get1(s, janet_ckeywordv("source"));
|
x = janet_get1(s, janet_ckeywordv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
@@ -982,6 +989,14 @@ static Janet janet_disasm_structarg(JanetFuncDef *def) {
|
|||||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet janet_disasm_namedargs(JanetFuncDef *def) {
|
||||||
|
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS) {
|
||||||
|
return janet_wrap_integer(def->named_args_count);
|
||||||
|
} else {
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||||
JanetArray *constants = janet_array(def->constants_length);
|
JanetArray *constants = janet_array(def->constants_length);
|
||||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||||
@@ -1032,6 +1047,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
||||||
|
janet_table_put(ret, janet_ckeywordv("namedargs"), janet_disasm_namedargs(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||||
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
||||||
@@ -1048,6 +1064,7 @@ JANET_CORE_FN(cfun_asm,
|
|||||||
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
||||||
"to the return value of disasm. Will throw an\n"
|
"to the return value of disasm. Will throw an\n"
|
||||||
"error on invalid assembly.") {
|
"error on invalid assembly.") {
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_ASM);
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetAssembleResult res;
|
JanetAssembleResult res;
|
||||||
res = janet_asm(argv[0], 0);
|
res = janet_asm(argv[0], 0);
|
||||||
@@ -1067,6 +1084,8 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
"* :min-arity - minimum number of arguments function can be called with.\n"
|
"* :min-arity - minimum number of arguments function can be called with.\n"
|
||||||
"* :max-arity - maximum number of arguments function can be called with.\n"
|
"* :max-arity - maximum number of arguments function can be called with.\n"
|
||||||
"* :vararg - true if function can take a variable number of arguments.\n"
|
"* :vararg - true if function can take a variable number of arguments.\n"
|
||||||
|
"* :structarg - true if function can take a variable number of arguments using the &keys option.\n"
|
||||||
|
"* :namedargs - if function can take a variable number of arguments using the &named option, this will be the number of named arguments.\n"
|
||||||
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||||
"* :source - name of source file that this function was compiled from.\n"
|
"* :source - name of source file that this function was compiled from.\n"
|
||||||
"* :name - name of function.\n"
|
"* :name - name of function.\n"
|
||||||
@@ -1076,6 +1095,7 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||||
"* :defs - other function definitions that this function may instantiate.\n") {
|
"* :defs - other function definitions that this function may instantiate.\n") {
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_ASM);
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetFunction *f = janet_getfunction(argv, 0);
|
JanetFunction *f = janet_getfunction(argv, 0);
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
@@ -1088,6 +1108,7 @@ JANET_CORE_FN(cfun_disasm,
|
|||||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||||
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
||||||
|
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
|
||||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||||
|
|||||||
@@ -74,6 +74,7 @@ JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t
|
|||||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||||
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||||
janet_free(buffer->data);
|
janet_free(buffer->data);
|
||||||
|
buffer->data = NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -522,6 +522,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
|||||||
def->bytecode_length = 0;
|
def->bytecode_length = 0;
|
||||||
def->environments_length = 0;
|
def->environments_length = 0;
|
||||||
def->symbolmap_length = 0;
|
def->symbolmap_length = 0;
|
||||||
|
def->named_args_count = 0;
|
||||||
return def;
|
return def;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -460,7 +460,7 @@ Janet janet_dyn(const char *name) {
|
|||||||
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
||||||
}
|
}
|
||||||
if (janet_vm.fiber->env) {
|
if (janet_vm.fiber->env) {
|
||||||
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
|
return janet_table_get_keyword(janet_vm.fiber->env, name);
|
||||||
} else {
|
} else {
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -98,6 +98,22 @@ void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
|||||||
sp.sym2 = sym;
|
sp.sym2 = sym;
|
||||||
sp.slot = s;
|
sp.slot = s;
|
||||||
sp.keep = 0;
|
sp.keep = 0;
|
||||||
|
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
|
||||||
|
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||||
|
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||||
|
sp.death_pc = UINT32_MAX;
|
||||||
|
janet_v_push(c->scope->syms, sp);
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
|
||||||
|
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||||
|
SymPair sp;
|
||||||
|
int32_t cnt = janet_v_count(c->buffer);
|
||||||
|
sp.sym = sym;
|
||||||
|
sp.sym2 = sym;
|
||||||
|
sp.slot = s;
|
||||||
|
sp.keep = 0;
|
||||||
|
sp.referenced = 1;
|
||||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||||
sp.death_pc = UINT32_MAX;
|
sp.death_pc = UINT32_MAX;
|
||||||
@@ -170,6 +186,10 @@ void janetc_popscope(JanetCompiler *c) {
|
|||||||
/* Keep upvalue slots and symbols for debugging. */
|
/* Keep upvalue slots and symbols for debugging. */
|
||||||
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
for (int32_t i = 0; i < janet_v_count(oldscope->syms); i++) {
|
||||||
SymPair pair = oldscope->syms[i];
|
SymPair pair = oldscope->syms[i];
|
||||||
|
/* Check for unused symbols */
|
||||||
|
if (pair.referenced == 0 && pair.sym) {
|
||||||
|
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is unused", janet_wrap_symbol(pair.sym));
|
||||||
|
}
|
||||||
/* The variable should not be lexically accessible */
|
/* The variable should not be lexically accessible */
|
||||||
pair.sym = NULL;
|
pair.sym = NULL;
|
||||||
if (pair.death_pc == UINT32_MAX) {
|
if (pair.death_pc == UINT32_MAX) {
|
||||||
@@ -262,6 +282,7 @@ JanetSlot janetc_resolve(
|
|||||||
pair = scope->syms + i;
|
pair = scope->syms + i;
|
||||||
if (pair->sym == sym) {
|
if (pair->sym == sym) {
|
||||||
ret = pair->slot;
|
ret = pair->slot;
|
||||||
|
pair->referenced = 1;
|
||||||
goto found;
|
goto found;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -274,7 +295,7 @@ JanetSlot janetc_resolve(
|
|||||||
{
|
{
|
||||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||||
if (binding.type == JANET_BINDING_NONE) {
|
if (binding.type == JANET_BINDING_NONE) {
|
||||||
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
|
Janet handler = janet_table_get_keyword(c->env, "missing-symbol");
|
||||||
switch (janet_type(handler)) {
|
switch (janet_type(handler)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
break;
|
break;
|
||||||
@@ -346,6 +367,7 @@ found:
|
|||||||
/* non-local scope needs to expose its environment */
|
/* non-local scope needs to expose its environment */
|
||||||
JanetScope *original_scope = scope;
|
JanetScope *original_scope = scope;
|
||||||
pair->keep = 1;
|
pair->keep = 1;
|
||||||
|
pair->referenced = 1;
|
||||||
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
while (scope && !(scope->flags & JANET_SCOPE_FUNCTION))
|
||||||
scope = scope->parent;
|
scope = scope->parent;
|
||||||
janet_assert(scope, "invalid scopes");
|
janet_assert(scope, "invalid scopes");
|
||||||
@@ -514,9 +536,9 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
|||||||
JanetScope unusedScope;
|
JanetScope unusedScope;
|
||||||
int32_t bufstart = janet_v_count(c->buffer);
|
int32_t bufstart = janet_v_count(c->buffer);
|
||||||
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
||||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
|
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unused");
|
||||||
janetc_value(opts, x);
|
janetc_value(opts, x);
|
||||||
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.2q", x);
|
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.4q", x);
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
if (c->buffer) {
|
if (c->buffer) {
|
||||||
janet_v__cnt(c->buffer) = bufstart;
|
janet_v__cnt(c->buffer) = bufstart;
|
||||||
@@ -526,7 +548,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Compile a call or tailcall instruction */
|
/* Compile a call or tailcall instruction */
|
||||||
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, const Janet *form) {
|
||||||
JanetSlot retslot;
|
JanetSlot retslot;
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int specialized = 0;
|
int specialized = 0;
|
||||||
@@ -552,6 +574,8 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
|||||||
JanetFunction *f = janet_unwrap_function(fun.constant);
|
JanetFunction *f = janet_unwrap_function(fun.constant);
|
||||||
int32_t min = f->def->min_arity;
|
int32_t min = f->def->min_arity;
|
||||||
int32_t max = f->def->max_arity;
|
int32_t max = f->def->max_arity;
|
||||||
|
int structarg = f->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
int namedarg = f->def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||||
if (min_arity < 0) {
|
if (min_arity < 0) {
|
||||||
/* Call has splices */
|
/* Call has splices */
|
||||||
min_arity = -1 - min_arity;
|
min_arity = -1 - min_arity;
|
||||||
@@ -575,6 +599,47 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
|||||||
fun.constant, min, min == 1 ? "" : "s", min_arity);
|
fun.constant, min, min == 1 ? "" : "s", min_arity);
|
||||||
janetc_error(c, es);
|
janetc_error(c, es);
|
||||||
}
|
}
|
||||||
|
if (structarg && (min_arity > f->def->arity) && ((min_arity - f->def->arity) & 1)) {
|
||||||
|
/* If we have an odd number of variadic arguments to a `&keys` function, that is almost certainly wrong. */
|
||||||
|
if (namedarg) {
|
||||||
|
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||||
|
"odd number of named arguments to `&named` function %v", fun.constant);
|
||||||
|
} else {
|
||||||
|
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||||
|
"odd number of named arguments to `&keys` function %v", fun.constant);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (namedarg && f->def->named_args_count > 0) {
|
||||||
|
/* For each argument passed in, check if it is one of the used named arguments
|
||||||
|
* by checking the list defined in the function def. If not, raise a normal compiler
|
||||||
|
* lint. We can also do a strict lint for _missing_ named arguments, although in many
|
||||||
|
* cases those are assumed to have some kind of default, or we have dynamic keys. */
|
||||||
|
int32_t first_arg_key_index = f->def->arity + 1;
|
||||||
|
for (int32_t i = first_arg_key_index; i < janet_tuple_length(form); i += 2) {
|
||||||
|
Janet argkey = form[i];
|
||||||
|
/* Assumption: The first N constants of a function are its named argument keys. This
|
||||||
|
* may change if the compiler changes, but is true for all Janet generated functions. */
|
||||||
|
int found = 0;
|
||||||
|
if (janet_checktype(argkey, JANET_KEYWORD)) {
|
||||||
|
for (int32_t j = 0; j < f->def->named_args_count && j < f->def->constants_length; j++) {
|
||||||
|
if (janet_equals(argkey, f->def->constants[j])) {
|
||||||
|
found = 1;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else if (janet_checktype(argkey, JANET_TUPLE)) {
|
||||||
|
/* Possible lint : too dynamic, be dumber
|
||||||
|
* (defn f [&named x] [x])
|
||||||
|
* (f (if (coin-flip) :x :w) 10)
|
||||||
|
* A tuple could be a function call the evaluates to a valid key */
|
||||||
|
found = 1;
|
||||||
|
}
|
||||||
|
if (!found) {
|
||||||
|
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||||
|
"unused named argument %v to function %v", argkey, fun.constant);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
@@ -809,14 +874,16 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||||
ret = janetc_tuple(opts, x);
|
ret = janetc_tuple(opts, x);
|
||||||
} else {
|
} else {
|
||||||
|
/* Function calls */
|
||||||
JanetSlot head = janetc_value(subopts, tup[0]);
|
JanetSlot head = janetc_value(subopts, tup[0]);
|
||||||
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
||||||
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
|
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head, tup);
|
||||||
janetc_freeslot(c, head);
|
janetc_freeslot(c, head);
|
||||||
}
|
}
|
||||||
ret.flags &= ~JANET_SLOT_SPLICED;
|
ret.flags &= ~JANET_SLOT_SPLICED;
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
|
/* Data Constructors */
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
||||||
break;
|
break;
|
||||||
@@ -856,19 +923,21 @@ void janet_def_addflags(JanetFuncDef *def) {
|
|||||||
int32_t set_flags = 0;
|
int32_t set_flags = 0;
|
||||||
int32_t unset_flags = 0;
|
int32_t unset_flags = 0;
|
||||||
/* pos checks */
|
/* pos checks */
|
||||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||||
|
if (def->named_args_count) set_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||||
/* negative checks */
|
/* negative checks */
|
||||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||||
|
if (!def->named_args_count) unset_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||||
/* Update flags */
|
/* Update flags */
|
||||||
def->flags |= set_flags;
|
def->flags |= set_flags;
|
||||||
def->flags &= ~unset_flags;
|
def->flags &= ~unset_flags;
|
||||||
@@ -939,8 +1008,9 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
|
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
|
||||||
|
/* fprintf(stderr, "slot chunks: %d, scope->ua.count: %d, numchunks: %d\n", slotchunks, scope->ua.count, numchunks); */
|
||||||
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
||||||
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
|
if (scope->ua.count > 7 && slotchunks > 7) chunks[7] &= 0xFFFFU;
|
||||||
def->closure_bitset = chunks;
|
def->closure_bitset = chunks;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -974,6 +1044,10 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
SymPair pair = scope->syms[i];
|
SymPair pair = scope->syms[i];
|
||||||
if (pair.sym2) {
|
if (pair.sym2) {
|
||||||
JanetSymbolMap jsm;
|
JanetSymbolMap jsm;
|
||||||
|
/* Check for unused symbols */
|
||||||
|
if (pair.referenced == 0 && pair.sym) {
|
||||||
|
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is unused", janet_wrap_symbol(pair.sym));
|
||||||
|
}
|
||||||
if (pair.death_pc == UINT32_MAX) {
|
if (pair.death_pc == UINT32_MAX) {
|
||||||
jsm.death_pc = def->bytecode_length;
|
jsm.death_pc = def->bytecode_length;
|
||||||
} else {
|
} else {
|
||||||
@@ -1082,6 +1156,7 @@ JANET_CORE_FN(cfun_compile,
|
|||||||
"struct with keys :line, :column, and :error if compilation fails. "
|
"struct with keys :line, :column, and :error if compilation fails. "
|
||||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
"Each message will be a tuple of the form `(level line col message)`.") {
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_COMPILE);
|
||||||
janet_arity(argc, 1, 4);
|
janet_arity(argc, 1, 4);
|
||||||
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
||||||
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||||
|
|||||||
@@ -114,6 +114,7 @@ typedef struct SymPair {
|
|||||||
const uint8_t *sym;
|
const uint8_t *sym;
|
||||||
const uint8_t *sym2;
|
const uint8_t *sym2;
|
||||||
int keep;
|
int keep;
|
||||||
|
int referenced; /* Has this value been used */
|
||||||
uint32_t birth_pc;
|
uint32_t birth_pc;
|
||||||
uint32_t death_pc;
|
uint32_t death_pc;
|
||||||
} SymPair;
|
} SymPair;
|
||||||
@@ -222,6 +223,7 @@ const JanetSpecial *janetc_special(const uint8_t *name);
|
|||||||
|
|
||||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
|
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
|
||||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||||
|
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||||
JanetSlot janetc_farslot(JanetCompiler *c);
|
JanetSlot janetc_farslot(JanetCompiler *c);
|
||||||
|
|
||||||
/* Throw away some code after checking that it is well formed. */
|
/* Throw away some code after checking that it is well formed. */
|
||||||
|
|||||||
@@ -746,7 +746,9 @@ typedef struct SandboxOption {
|
|||||||
|
|
||||||
static const SandboxOption sandbox_options[] = {
|
static const SandboxOption sandbox_options[] = {
|
||||||
{"all", JANET_SANDBOX_ALL},
|
{"all", JANET_SANDBOX_ALL},
|
||||||
|
{"asm", JANET_SANDBOX_ASM},
|
||||||
{"chroot", JANET_SANDBOX_CHROOT},
|
{"chroot", JANET_SANDBOX_CHROOT},
|
||||||
|
{"compile", JANET_SANDBOX_COMPILE},
|
||||||
{"env", JANET_SANDBOX_ENV},
|
{"env", JANET_SANDBOX_ENV},
|
||||||
{"ffi", JANET_SANDBOX_FFI},
|
{"ffi", JANET_SANDBOX_FFI},
|
||||||
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
||||||
@@ -764,6 +766,8 @@ static const SandboxOption sandbox_options[] = {
|
|||||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||||
{"signal", JANET_SANDBOX_SIGNAL},
|
{"signal", JANET_SANDBOX_SIGNAL},
|
||||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||||
|
{"threads", JANET_SANDBOX_THREADS},
|
||||||
|
{"unmarshal", JANET_SANDBOX_UNMARSHAL},
|
||||||
{NULL, 0}
|
{NULL, 0}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -772,7 +776,9 @@ JANET_CORE_FN(janet_core_sandbox,
|
|||||||
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
||||||
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
||||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||||
|
"* :asm - disallow calling `asm` and `disasm` functions.\n"
|
||||||
"* :chroot - disallow calling `os/posix-chroot`\n"
|
"* :chroot - disallow calling `os/posix-chroot`\n"
|
||||||
|
"* :compile - disallow calling `compile`. This will disable a lot of functionality, such as `eval`.\n"
|
||||||
"* :env - disallow reading and write env variables\n"
|
"* :env - disallow reading and write env variables\n"
|
||||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||||
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
||||||
@@ -789,7 +795,9 @@ JANET_CORE_FN(janet_core_sandbox,
|
|||||||
"* :net-listen - disallow accepting inbound network connections\n"
|
"* :net-listen - disallow accepting inbound network connections\n"
|
||||||
"* :sandbox - disallow calling this function\n"
|
"* :sandbox - disallow calling this function\n"
|
||||||
"* :signal - disallow adding or removing signal handlers\n"
|
"* :signal - disallow adding or removing signal handlers\n"
|
||||||
"* :subprocess - disallow running subprocesses") {
|
"* :subprocess - disallow running subprocesses\n"
|
||||||
|
"* :threads - disallow spawning threads with `ev/thread`. Certain helper threads may still be spawned.\n"
|
||||||
|
"* :unmarshal - disallow calling the unmarshal function.\n") {
|
||||||
uint32_t flags = 0;
|
uint32_t flags = 0;
|
||||||
for (int32_t i = 0; i < argc; i++) {
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
JanetKeyword kw = janet_getkeyword(argv, i);
|
JanetKeyword kw = janet_getkeyword(argv, i);
|
||||||
@@ -1354,12 +1362,16 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||||||
lidv = midv = janet_wrap_nil();
|
lidv = midv = janet_wrap_nil();
|
||||||
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
|
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
|
||||||
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
||||||
JanetTable *lid = janet_unwrap_table(lidv);
|
|
||||||
JanetTable *mid = janet_unwrap_table(midv);
|
/* Check that we actually got tables - if we are using a smaller corelib, may not exist */
|
||||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
if (janet_checktype(lidv, JANET_TABLE) && janet_checktype(midv, JANET_TABLE)) {
|
||||||
const JanetKV *kv = lid->data + i;
|
JanetTable *lid = janet_unwrap_table(lidv);
|
||||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
JanetTable *mid = janet_unwrap_table(midv);
|
||||||
janet_table_put(mid, kv->value, kv->key);
|
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);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -539,6 +539,9 @@ void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_cancel(JanetFiber *fiber, Janet value) {
|
void janet_cancel(JanetFiber *fiber, Janet value) {
|
||||||
|
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
|
||||||
|
janet_panic("cannot cancel non-task fiber");
|
||||||
|
}
|
||||||
janet_schedule_signal(fiber, value, JANET_SIGNAL_ERROR);
|
janet_schedule_signal(fiber, value, JANET_SIGNAL_ERROR);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1269,11 +1272,13 @@ JANET_CORE_FN(cfun_channel_choice,
|
|||||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||||
/* Write */
|
/* Write */
|
||||||
JanetChannel *chan = janet_getchannel(data, 0);
|
JanetChannel *chan = janet_getchannel(data, 0);
|
||||||
|
janet_chan_lock(chan);
|
||||||
janet_channel_push_with_lock(chan, data[1], 1);
|
janet_channel_push_with_lock(chan, data[1], 1);
|
||||||
} else {
|
} else {
|
||||||
/* Read */
|
/* Read */
|
||||||
Janet item;
|
Janet item;
|
||||||
JanetChannel *chan = janet_getchannel(argv, i);
|
JanetChannel *chan = janet_getchannel(argv, i);
|
||||||
|
janet_chan_lock(chan);
|
||||||
janet_channel_pop_with_lock(chan, &item, 1);
|
janet_channel_pop_with_lock(chan, &item, 1);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -1376,7 +1381,7 @@ JANET_CORE_FN(cfun_channel_close,
|
|||||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (janet_fiber_can_resume(writer.fiber)) {
|
if (janet_fiber_can_resume(writer.fiber) && writer.sched_id == writer.fiber->sched_id) {
|
||||||
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
||||||
janet_schedule(writer.fiber, make_close_result(channel));
|
janet_schedule(writer.fiber, make_close_result(channel));
|
||||||
} else {
|
} else {
|
||||||
@@ -1399,7 +1404,7 @@ JANET_CORE_FN(cfun_channel_close,
|
|||||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
if (janet_fiber_can_resume(reader.fiber)) {
|
if (janet_fiber_can_resume(reader.fiber) && reader.sched_id == reader.fiber->sched_id) {
|
||||||
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
||||||
janet_schedule(reader.fiber, make_close_result(channel));
|
janet_schedule(reader.fiber, make_close_result(channel));
|
||||||
} else {
|
} else {
|
||||||
@@ -2411,7 +2416,7 @@ Janet janet_ev_lasterr(void) {
|
|||||||
msgbuf,
|
msgbuf,
|
||||||
sizeof(msgbuf),
|
sizeof(msgbuf),
|
||||||
NULL);
|
NULL);
|
||||||
if (!*msgbuf) sprintf(msgbuf, "%d", code);
|
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%d", code);
|
||||||
char *c = msgbuf;
|
char *c = msgbuf;
|
||||||
while (*c) {
|
while (*c) {
|
||||||
if (*c == '\n' || *c == '\r') {
|
if (*c == '\n' || *c == '\r') {
|
||||||
@@ -3002,12 +3007,14 @@ error:
|
|||||||
|
|
||||||
JANET_CORE_FN(cfun_ev_go,
|
JANET_CORE_FN(cfun_ev_go,
|
||||||
"(ev/go fiber-or-fun &opt value supervisor)",
|
"(ev/go fiber-or-fun &opt value supervisor)",
|
||||||
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
|
"Put a fiber on the event loop to be resumed later. If a "
|
||||||
"with `fiber/new` first. "
|
"function is used, it is wrapped with `fiber/new` first. "
|
||||||
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
"Returns a task fiber. Optionally pass a value to resume "
|
||||||
"An optional `core/channel` can be provided as a supervisor. When various "
|
"with, otherwise resumes with nil. An optional `core/channel` "
|
||||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
"can be provided as a supervisor. When various events occur "
|
||||||
"If not provided, the new fiber will inherit the current supervisor.") {
|
"in the newly scheduled fiber, an event will be pushed to the "
|
||||||
|
"supervisor. If not provided, the new fiber will inherit the "
|
||||||
|
"current supervisor.") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
||||||
void *supervisor = janet_optabstract(argv, argc, 2, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
void *supervisor = janet_optabstract(argv, argc, 2, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
||||||
@@ -3033,6 +3040,9 @@ JANET_CORE_FN(cfun_ev_go,
|
|||||||
fiber->env->proto = janet_vm.fiber->env;
|
fiber->env->proto = janet_vm.fiber->env;
|
||||||
} else {
|
} else {
|
||||||
fiber = janet_getfiber(argv, 0);
|
fiber = janet_getfiber(argv, 0);
|
||||||
|
if (janet_fiber_status(fiber) != JANET_STATUS_NEW) {
|
||||||
|
janet_panic("can only schedule new fibers where (= (fiber/status f) :new)");
|
||||||
|
}
|
||||||
}
|
}
|
||||||
fiber->supervisor_channel = supervisor;
|
fiber->supervisor_channel = supervisor;
|
||||||
janet_schedule(fiber, value);
|
janet_schedule(fiber, value);
|
||||||
@@ -3168,6 +3178,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
|||||||
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
||||||
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
||||||
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_THREADS);
|
||||||
janet_arity(argc, 1, 4);
|
janet_arity(argc, 1, 4);
|
||||||
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
||||||
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
||||||
@@ -3316,7 +3327,8 @@ JANET_CORE_FN(cfun_ev_deadline,
|
|||||||
|
|
||||||
JANET_CORE_FN(cfun_ev_cancel,
|
JANET_CORE_FN(cfun_ev_cancel,
|
||||||
"(ev/cancel fiber err)",
|
"(ev/cancel fiber err)",
|
||||||
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately.") {
|
"Cancel a suspended task fiber in the event loop. Differs from "
|
||||||
|
"`cancel` in that it returns the canceled fiber immediately.") {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
Janet err = argv[1];
|
Janet err = argv[1];
|
||||||
@@ -3549,7 +3561,7 @@ JANET_CORE_FN(janet_cfun_to_file,
|
|||||||
|
|
||||||
JANET_CORE_FN(janet_cfun_ev_all_tasks,
|
JANET_CORE_FN(janet_cfun_ev_all_tasks,
|
||||||
"(ev/all-tasks)",
|
"(ev/all-tasks)",
|
||||||
"Get an array of all active fibers that are being used by the scheduler.") {
|
"Get an array of all active task fibers that are being used by the scheduler.") {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
JanetArray *array = janet_array(janet_vm.active_tasks.count);
|
JanetArray *array = janet_array(janet_vm.active_tasks.count);
|
||||||
|
|||||||
@@ -610,8 +610,9 @@ JANET_CORE_FN(cfun_fiber_current,
|
|||||||
|
|
||||||
JANET_CORE_FN(cfun_fiber_root,
|
JANET_CORE_FN(cfun_fiber_root,
|
||||||
"(fiber/root)",
|
"(fiber/root)",
|
||||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
"Returns the current root fiber. The root fiber is the oldest "
|
||||||
"that does not have a parent.") {
|
"ancestor that does not have a parent. Note that a root fiber "
|
||||||
|
"is also a task fiber.") {
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
return janet_wrap_fiber(janet_vm.root_fiber);
|
return janet_wrap_fiber(janet_vm.root_fiber);
|
||||||
|
|||||||
@@ -521,23 +521,23 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
|
|||||||
(void) watcher;
|
(void) watcher;
|
||||||
(void) flags;
|
(void) flags;
|
||||||
(void) path;
|
(void) path;
|
||||||
janet_panic("nyi");
|
janet_panic("filewatch not supported on this platform");
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||||
(void) watcher;
|
(void) watcher;
|
||||||
(void) path;
|
(void) path;
|
||||||
janet_panic("nyi");
|
janet_panic("filewatch not supported on this platform");
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
static void janet_watcher_listen(JanetWatcher *watcher) {
|
||||||
(void) watcher;
|
(void) watcher;
|
||||||
janet_panic("nyi");
|
janet_panic("filewatch not supported on this platform");
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||||
(void) watcher;
|
(void) watcher;
|
||||||
janet_panic("nyi");
|
janet_panic("filewatch not supported on this platform");
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -504,14 +504,7 @@ void janet_sweep() {
|
|||||||
if (head->type->gcperthread) {
|
if (head->type->gcperthread) {
|
||||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||||
}
|
}
|
||||||
if (0 == janet_abstract_decref(abst)) {
|
janet_abstract_decref_maybe_free(abst);
|
||||||
/* Run finalizer */
|
|
||||||
if (head->type->gc) {
|
|
||||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
|
||||||
}
|
|
||||||
/* Free memory */
|
|
||||||
janet_free(janet_abstract_head(abst));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Mark as tombstone in place */
|
/* Mark as tombstone in place */
|
||||||
items[i].key = janet_wrap_nil();
|
items[i].key = janet_wrap_nil();
|
||||||
@@ -682,12 +675,7 @@ void janet_clear_memory(void) {
|
|||||||
if (head->type->gcperthread) {
|
if (head->type->gcperthread) {
|
||||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||||
}
|
}
|
||||||
if (0 == janet_abstract_decref(abst)) {
|
janet_abstract_decref_maybe_free(abst);
|
||||||
if (head->type->gc) {
|
|
||||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
|
||||||
}
|
|
||||||
janet_free(janet_abstract_head(abst));
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -721,8 +721,15 @@ JANET_CORE_FN(cfun_io_eflush,
|
|||||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||||
va_list args;
|
va_list args;
|
||||||
va_start(args, format);
|
va_start(args, format);
|
||||||
Janet x = janet_dyn(name);
|
JanetType xtype;
|
||||||
JanetType xtype = janet_type(x);
|
Janet x;
|
||||||
|
if (!name || name[0] == '\0') { /* Allow NULL or empty string to just use dflt_file directly */
|
||||||
|
x = janet_wrap_nil();
|
||||||
|
xtype = JANET_NIL;
|
||||||
|
} else {
|
||||||
|
x = janet_dyn(name);
|
||||||
|
xtype = janet_type(x);
|
||||||
|
}
|
||||||
switch (xtype) {
|
switch (xtype) {
|
||||||
default:
|
default:
|
||||||
/* Other values simply do nothing */
|
/* Other values simply do nothing */
|
||||||
|
|||||||
@@ -276,6 +276,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
pushint(st, def->max_arity);
|
pushint(st, def->max_arity);
|
||||||
pushint(st, def->constants_length);
|
pushint(st, def->constants_length);
|
||||||
pushint(st, def->bytecode_length);
|
pushint(st, def->bytecode_length);
|
||||||
|
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
|
||||||
|
pushint(st, def->named_args_count);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||||
pushint(st, def->environments_length);
|
pushint(st, def->environments_length);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||||
@@ -914,6 +916,7 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
def->symbolmap = NULL;
|
def->symbolmap = NULL;
|
||||||
def->symbolmap_length = 0;
|
def->symbolmap_length = 0;
|
||||||
|
def->named_args_count = 0;
|
||||||
janet_v_push(st->lookup_defs, def);
|
janet_v_push(st->lookup_defs, def);
|
||||||
|
|
||||||
/* Set default lengths to zero */
|
/* Set default lengths to zero */
|
||||||
@@ -933,6 +936,8 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
/* Read some lengths */
|
/* Read some lengths */
|
||||||
constants_length = readnat(st, &data);
|
constants_length = readnat(st, &data);
|
||||||
bytecode_length = readnat(st, &data);
|
bytecode_length = readnat(st, &data);
|
||||||
|
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
|
||||||
|
def->named_args_count = readnat(st, &data);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||||
environments_length = readnat(st, &data);
|
environments_length = readnat(st, &data);
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||||
@@ -1693,6 +1698,7 @@ JANET_CORE_FN(cfun_unmarshal,
|
|||||||
"Unmarshal a value from a buffer. An optional lookup table "
|
"Unmarshal a value from a buffer. An optional lookup table "
|
||||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||||
"unmarshalled from the buffer.") {
|
"unmarshalled from the buffer.") {
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_UNMARSHAL);
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetTable *reg = NULL;
|
JanetTable *reg = NULL;
|
||||||
|
|||||||
@@ -120,6 +120,25 @@ static void janet_net_socknoblock(JSock s) {
|
|||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Allow specifying IPV6 vs. IPV4 (or unix domain socket) */
|
||||||
|
static int net_get_address_family(Janet x) {
|
||||||
|
if (janet_checktype(x, JANET_NIL)) {
|
||||||
|
return AF_UNSPEC;
|
||||||
|
}
|
||||||
|
if (janet_keyeq(x, "ipv4")) {
|
||||||
|
return AF_INET;
|
||||||
|
}
|
||||||
|
if (janet_keyeq(x, "ipv6")) {
|
||||||
|
return AF_INET6;
|
||||||
|
}
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
if (janet_keyeq(x, "unix")) {
|
||||||
|
return AF_UNIX;
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
return AF_UNSPEC;
|
||||||
|
}
|
||||||
|
|
||||||
/* State machine for async connect */
|
/* State machine for async connect */
|
||||||
|
|
||||||
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||||
@@ -551,15 +570,16 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
|
if (socktype == SOCK_DGRAM) udp_flag = JANET_STREAM_UDPSERVER;
|
||||||
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
|
JanetStream *stream = make_stream(sock, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | udp_flag);
|
||||||
|
|
||||||
/* Set up the socket for non-blocking IO before connecting */
|
|
||||||
janet_net_socknoblock(sock);
|
|
||||||
|
|
||||||
/* Connect to socket */
|
/* Connect to socket */
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
int status = WSAConnect(sock, addr, addrlen, NULL, NULL, NULL, NULL);
|
||||||
int err = WSAGetLastError();
|
int err = WSAGetLastError();
|
||||||
freeaddrinfo(ai);
|
freeaddrinfo(ai);
|
||||||
|
/* Set up the socket for non-blocking IO after connecting on windows by default */
|
||||||
|
janet_net_socknoblock(sock);
|
||||||
#else
|
#else
|
||||||
|
/* Set up the socket for non-blocking IO before connecting */
|
||||||
|
janet_net_socknoblock(sock);
|
||||||
int status;
|
int status;
|
||||||
do {
|
do {
|
||||||
status = connect(sock, addr, addrlen);
|
status = connect(sock, addr, addrlen);
|
||||||
@@ -580,10 +600,11 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
return janet_wrap_abstract(stream);
|
return janet_wrap_abstract(stream);
|
||||||
}
|
}
|
||||||
|
|
||||||
if (status == -1) {
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
|
if (status == SOCKET_ERROR) {
|
||||||
if (err != WSAEWOULDBLOCK) {
|
if (err != WSAEWOULDBLOCK) {
|
||||||
#else
|
#else
|
||||||
|
if (status == -1) {
|
||||||
if (err != EINPROGRESS) {
|
if (err != EINPROGRESS) {
|
||||||
#endif
|
#endif
|
||||||
JSOCKCLOSE(sock);
|
JSOCKCLOSE(sock);
|
||||||
@@ -596,10 +617,11 @@ JANET_CORE_FN(cfun_net_connect,
|
|||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(cfun_net_socket,
|
JANET_CORE_FN(cfun_net_socket,
|
||||||
"(net/socket &opt type)",
|
"(net/socket &opt type address-family)",
|
||||||
"Creates a new unbound socket. Type is an optional keyword, "
|
"Creates a new unbound socket. Type is an optional keyword, "
|
||||||
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream.") {
|
"either a :stream (usually tcp), or :datagram (usually udp). The default is :stream. "
|
||||||
janet_arity(argc, 0, 1);
|
"`address-family` should be one of :ipv4 or :ipv6.") {
|
||||||
|
janet_arity(argc, 0, 2);
|
||||||
|
|
||||||
int socktype = janet_get_sockettype(argv, argc, 0);
|
int socktype = janet_get_sockettype(argv, argc, 0);
|
||||||
|
|
||||||
@@ -610,7 +632,14 @@ JANET_CORE_FN(cfun_net_socket,
|
|||||||
memset(&hints, 0, sizeof(hints));
|
memset(&hints, 0, sizeof(hints));
|
||||||
hints.ai_family = AF_UNSPEC;
|
hints.ai_family = AF_UNSPEC;
|
||||||
hints.ai_socktype = socktype;
|
hints.ai_socktype = socktype;
|
||||||
|
#ifdef AI_NUMERICSERV
|
||||||
|
hints.ai_flags = AI_NUMERICSERV; /* Explicitly prevent name resolution */
|
||||||
|
#else
|
||||||
hints.ai_flags = 0;
|
hints.ai_flags = 0;
|
||||||
|
#endif
|
||||||
|
if (argc >= 2) {
|
||||||
|
hints.ai_family = net_get_address_family(argv[1]);
|
||||||
|
}
|
||||||
int status = getaddrinfo(NULL, "0", &hints, &ai);
|
int status = getaddrinfo(NULL, "0", &hints, &ai);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panicf("could not get address info: %s", gai_strerror(status));
|
janet_panicf("could not get address info: %s", gai_strerror(status));
|
||||||
@@ -1038,6 +1067,8 @@ static const struct sockopt_type sockopt_type_list[] = {
|
|||||||
#ifndef JANET_NO_IPV6
|
#ifndef JANET_NO_IPV6
|
||||||
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
||||||
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
||||||
|
{ "ipv6-multicast-hops", IPPROTO_IPV6, IPV6_MULTICAST_HOPS, JANET_NUMBER },
|
||||||
|
{ "ipv6-unicast-hops", IPPROTO_IPV6, IPV6_UNICAST_HOPS, JANET_NUMBER },
|
||||||
#endif
|
#endif
|
||||||
{ NULL, 0, 0, JANET_POINTER }
|
{ NULL, 0, 0, JANET_POINTER }
|
||||||
};
|
};
|
||||||
@@ -1054,7 +1085,10 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||||||
"- :ip-add-membership string\n"
|
"- :ip-add-membership string\n"
|
||||||
"- :ip-drop-membership string\n"
|
"- :ip-drop-membership string\n"
|
||||||
"- :ipv6-join-group string\n"
|
"- :ipv6-join-group string\n"
|
||||||
"- :ipv6-leave-group string\n") {
|
"- :ipv6-leave-group string\n"
|
||||||
|
"- :ipv6-multicast-hops number\n"
|
||||||
|
"- :ipv6-unicast-hops number\n"
|
||||||
|
) {
|
||||||
janet_arity(argc, 3, 3);
|
janet_arity(argc, 3, 3);
|
||||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||||
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
janet_stream_flags(stream, JANET_STREAM_SOCKET);
|
||||||
@@ -1073,6 +1107,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||||||
}
|
}
|
||||||
|
|
||||||
union {
|
union {
|
||||||
|
unsigned char v_uchar;
|
||||||
int v_int;
|
int v_int;
|
||||||
struct ip_mreq v_mreq;
|
struct ip_mreq v_mreq;
|
||||||
#ifndef JANET_NO_IPV6
|
#ifndef JANET_NO_IPV6
|
||||||
@@ -1087,8 +1122,19 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||||||
val.v_int = janet_getboolean(argv, 2);
|
val.v_int = janet_getboolean(argv, 2);
|
||||||
optlen = sizeof(val.v_int);
|
optlen = sizeof(val.v_int);
|
||||||
} else if (st->type == JANET_NUMBER) {
|
} else if (st->type == JANET_NUMBER) {
|
||||||
|
#ifdef JANET_BSD
|
||||||
|
int v_int = janet_getinteger(argv, 2);
|
||||||
|
if (st->optname == IP_MULTICAST_TTL) {
|
||||||
|
val.v_uchar = v_int;
|
||||||
|
optlen = sizeof(val.v_uchar);
|
||||||
|
} else {
|
||||||
|
val.v_int = v_int;
|
||||||
|
optlen = sizeof(val.v_int);
|
||||||
|
}
|
||||||
|
#else
|
||||||
val.v_int = janet_getinteger(argv, 2);
|
val.v_int = janet_getinteger(argv, 2);
|
||||||
optlen = sizeof(val.v_int);
|
optlen = sizeof(val.v_int);
|
||||||
|
#endif
|
||||||
} else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
|
} else if (st->optname == IP_ADD_MEMBERSHIP || st->optname == IP_DROP_MEMBERSHIP) {
|
||||||
const char *addr = janet_getcstring(argv, 2);
|
const char *addr = janet_getcstring(argv, 2);
|
||||||
memset(&val.v_mreq, 0, sizeof val.v_mreq);
|
memset(&val.v_mreq, 0, sizeof val.v_mreq);
|
||||||
|
|||||||
109
src/core/os.c
109
src/core/os.c
@@ -142,8 +142,8 @@ static void janet_unlock_environ(void) {
|
|||||||
#define janet_stringify(x) janet_stringify1(x)
|
#define janet_stringify(x) janet_stringify1(x)
|
||||||
|
|
||||||
JANET_CORE_FN(os_which,
|
JANET_CORE_FN(os_which,
|
||||||
"(os/which)",
|
"(os/which &opt test)",
|
||||||
"Check the current operating system. Returns one of:\n\n"
|
"Check the current operating system. If `test` is nil or unset, Returns one of:\n\n"
|
||||||
"* :windows\n\n"
|
"* :windows\n\n"
|
||||||
"* :mingw\n\n"
|
"* :mingw\n\n"
|
||||||
"* :cygwin\n\n"
|
"* :cygwin\n\n"
|
||||||
@@ -156,9 +156,12 @@ JANET_CORE_FN(os_which,
|
|||||||
"* :dragonfly\n\n"
|
"* :dragonfly\n\n"
|
||||||
"* :bsd\n\n"
|
"* :bsd\n\n"
|
||||||
"* :posix - A POSIX compatible system (default)\n\n"
|
"* :posix - A POSIX compatible system (default)\n\n"
|
||||||
"May also return a custom keyword specified at build time.") {
|
"May also return a custom keyword specified at build time. Is `test` is truthy, will check if the current operating system equals `test` and return true if they are the same, false otherwise.") {
|
||||||
janet_fixarity(argc, 0);
|
janet_arity(argc, 0, 1);
|
||||||
(void) argv;
|
if (argc == 1 && janet_truthy(argv[0])) {
|
||||||
|
janet_getkeyword(argv, 0); /* Constrain to keywords */
|
||||||
|
return janet_wrap_boolean(janet_equals(argv[0], os_which(0, NULL)));
|
||||||
|
}
|
||||||
#if defined(JANET_OS_NAME)
|
#if defined(JANET_OS_NAME)
|
||||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||||
#elif defined(JANET_MINGW)
|
#elif defined(JANET_MINGW)
|
||||||
@@ -1211,7 +1214,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
|
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
|
||||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||||
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
||||||
} else if (is_spawn && janet_keyeq(maybe_stderr, "out")) {
|
} else if (janet_keyeq(maybe_stderr, "out")) {
|
||||||
stderr_is_stdout = 1;
|
stderr_is_stdout = 1;
|
||||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||||
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
|
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
|
||||||
@@ -1297,6 +1300,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
int cp_failed = 0;
|
int cp_failed = 0;
|
||||||
|
DWORD cp_error_code = 0;
|
||||||
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
|
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
|
||||||
(char *) buf->data, /* Single CLI argument */
|
(char *) buf->data, /* Single CLI argument */
|
||||||
&saAttr, /* no proc inheritance */
|
&saAttr, /* no proc inheritance */
|
||||||
@@ -1308,6 +1312,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
&startupInfo,
|
&startupInfo,
|
||||||
&processInfo)) {
|
&processInfo)) {
|
||||||
cp_failed = 1;
|
cp_failed = 1;
|
||||||
|
cp_error_code = GetLastError();
|
||||||
}
|
}
|
||||||
|
|
||||||
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
|
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
|
||||||
@@ -1317,7 +1322,25 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
os_execute_cleanup(envp, NULL);
|
os_execute_cleanup(envp, NULL);
|
||||||
|
|
||||||
if (cp_failed) {
|
if (cp_failed) {
|
||||||
janet_panic("failed to create process");
|
char msgbuf[256];
|
||||||
|
msgbuf[0] = '\0';
|
||||||
|
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||||
|
NULL,
|
||||||
|
cp_error_code,
|
||||||
|
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||||
|
msgbuf,
|
||||||
|
sizeof(msgbuf),
|
||||||
|
NULL);
|
||||||
|
if (!*msgbuf) snprintf(msgbuf, sizeof(msgbuf), "%d", cp_error_code);
|
||||||
|
char *c = msgbuf;
|
||||||
|
while (*c) {
|
||||||
|
if (*c == '\n' || *c == '\r') {
|
||||||
|
*c = '\0';
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
c++;
|
||||||
|
}
|
||||||
|
janet_panicf("failed to create process: %s", janet_cstringv(msgbuf));
|
||||||
}
|
}
|
||||||
|
|
||||||
pHandle = processInfo.hProcess;
|
pHandle = processInfo.hProcess;
|
||||||
@@ -1870,9 +1893,8 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct
|
|||||||
JANET_CORE_FN(os_date,
|
JANET_CORE_FN(os_date,
|
||||||
"(os/date &opt time local)",
|
"(os/date &opt time local)",
|
||||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
|
||||||
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||||
"the local timezone.\n\n"
|
"the local timezone. Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||||
"* :seconds - number of seconds [0-61]\n\n"
|
"* :seconds - number of seconds [0-61]\n\n"
|
||||||
"* :minutes - number of minutes [0-59]\n\n"
|
"* :minutes - number of minutes [0-59]\n\n"
|
||||||
"* :hours - number of hours [0-23]\n\n"
|
"* :hours - number of hours [0-23]\n\n"
|
||||||
@@ -1881,7 +1903,9 @@ JANET_CORE_FN(os_date,
|
|||||||
"* :year - years since year 0 (e.g. 2019)\n\n"
|
"* :year - years since year 0 (e.g. 2019)\n\n"
|
||||||
"* :week-day - day of the week [0-6]\n\n"
|
"* :week-day - day of the week [0-6]\n\n"
|
||||||
"* :year-day - day of the year [0-365]\n\n"
|
"* :year-day - day of the year [0-365]\n\n"
|
||||||
"* :dst - if Day Light Savings is in effect") {
|
"* :dst - if Day Light Savings is in effect\n\n"
|
||||||
|
"You can set local timezone by setting TZ environment variable. "
|
||||||
|
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
|
||||||
janet_arity(argc, 0, 2);
|
janet_arity(argc, 0, 2);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
struct tm t_infos;
|
struct tm t_infos;
|
||||||
@@ -1899,14 +1923,15 @@ JANET_CORE_FN(os_date,
|
|||||||
return janet_wrap_struct(janet_struct_end(st));
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
}
|
}
|
||||||
|
|
||||||
#define SIZETIMEFMT 250
|
#define SIZETIMEFMT 250
|
||||||
|
|
||||||
JANET_CORE_FN(os_strftime,
|
JANET_CORE_FN(os_strftime,
|
||||||
"(os/strftime fmt &opt time local)",
|
"(os/strftime fmt &opt time local)",
|
||||||
"Format the given time as a string, or the current time if `time` is not given. "
|
"Format the given time as a string, or the current time if `time` is not given. "
|
||||||
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
|
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
|
||||||
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
|
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||||
"the local timezone.") {
|
"the local timezone. You can set local timezone by setting TZ environment variable. "
|
||||||
|
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
const char *fmt = janet_getcstring(argv, 0);
|
const char *fmt = janet_getcstring(argv, 0);
|
||||||
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
|
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
|
||||||
@@ -1914,6 +1939,9 @@ JANET_CORE_FN(os_strftime,
|
|||||||
const char *p = fmt;
|
const char *p = fmt;
|
||||||
while (*p) {
|
while (*p) {
|
||||||
if (*p++ == '%') {
|
if (*p++ == '%') {
|
||||||
|
if (!*p) {
|
||||||
|
janet_panic("invalid conversion specifier");
|
||||||
|
}
|
||||||
if (!strchr(valid, *p)) {
|
if (!strchr(valid, *p)) {
|
||||||
janet_panicf("invalid conversion specifier '%%%c'", *p);
|
janet_panicf("invalid conversion specifier '%%%c'", *p);
|
||||||
}
|
}
|
||||||
@@ -1923,7 +1951,7 @@ JANET_CORE_FN(os_strftime,
|
|||||||
struct tm t_infos;
|
struct tm t_infos;
|
||||||
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
|
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
|
||||||
char buf[SIZETIMEFMT];
|
char buf[SIZETIMEFMT];
|
||||||
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
|
(void)strftime(buf, sizeof(buf), fmt, t_info);
|
||||||
return janet_cstringv(buf);
|
return janet_cstringv(buf);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1931,7 +1959,7 @@ static int entry_getdst(Janet env_entry) {
|
|||||||
Janet v;
|
Janet v;
|
||||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||||
v = janet_table_get(entry, janet_ckeywordv("dst"));
|
v = janet_table_get_keyword(entry, "dst");
|
||||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||||
v = janet_struct_get(entry, janet_ckeywordv("dst"));
|
v = janet_struct_get(entry, janet_ckeywordv("dst"));
|
||||||
@@ -1955,7 +1983,7 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
|
|||||||
Janet i;
|
Janet i;
|
||||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||||
i = janet_table_get(entry, janet_ckeywordv(field));
|
i = janet_table_get_keyword(entry, field);
|
||||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||||
i = janet_struct_get(entry, janet_ckeywordv(field));
|
i = janet_struct_get(entry, janet_ckeywordv(field));
|
||||||
@@ -2668,10 +2696,11 @@ JANET_CORE_FN(os_open,
|
|||||||
" * :c - create a new file (O\\_CREATE)\n"
|
" * :c - create a new file (O\\_CREATE)\n"
|
||||||
" * :e - fail if the file exists (O\\_EXCL)\n"
|
" * :e - fail if the file exists (O\\_EXCL)\n"
|
||||||
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
||||||
|
" * :a - append to a file (O\\_APPEND on posix, FILE_APPEND_DATA on windows)\n"
|
||||||
"Posix-only flags:\n\n"
|
"Posix-only flags:\n\n"
|
||||||
" * :a - append to a file (O\\_APPEND)\n"
|
|
||||||
" * :x - O\\_SYNC\n"
|
" * :x - O\\_SYNC\n"
|
||||||
" * :C - O\\_NOCTTY\n\n"
|
" * :C - O\\_NOCTTY\n\n"
|
||||||
|
" * :N - Turn off O\\_NONBLOCK and disable ev reading/writing\n\n"
|
||||||
"Windows-only flags:\n\n"
|
"Windows-only flags:\n\n"
|
||||||
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
||||||
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
||||||
@@ -2681,19 +2710,24 @@ JANET_CORE_FN(os_open,
|
|||||||
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
||||||
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
||||||
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
||||||
|
" * :V - Turn off FILE\\_FLAG\\_OVERLAPPED and disable ev reading/writing\n"
|
||||||
|
" * :I - set bInheritHandle on the created file so it can be passed to other processes.\n"
|
||||||
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
||||||
janet_arity(argc, 1, 3);
|
janet_arity(argc, 1, 3);
|
||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||||
jmode_t mode = os_optmode(argc, argv, 2, 0666);
|
jmode_t mode = os_optmode(argc, argv, 2, 0666);
|
||||||
uint32_t stream_flags = 0;
|
uint32_t stream_flags = 0;
|
||||||
|
int disable_stream_mode = 0;
|
||||||
JanetHandle fd;
|
JanetHandle fd;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
(void) mode;
|
(void) mode;
|
||||||
|
int inherited_handle = 0;
|
||||||
DWORD desiredAccess = 0;
|
DWORD desiredAccess = 0;
|
||||||
DWORD shareMode = 0;
|
DWORD shareMode = 0;
|
||||||
DWORD creationDisp = 0;
|
DWORD creationDisp = 0;
|
||||||
DWORD flagsAndAttributes = FILE_FLAG_OVERLAPPED;
|
DWORD fileFlags = FILE_FLAG_OVERLAPPED;
|
||||||
|
DWORD fileAttributes = 0;
|
||||||
/* We map unix-like open flags to the creationDisp parameter */
|
/* We map unix-like open flags to the creationDisp parameter */
|
||||||
int creatUnix = 0;
|
int creatUnix = 0;
|
||||||
#define OCREAT 1
|
#define OCREAT 1
|
||||||
@@ -2713,6 +2747,11 @@ JANET_CORE_FN(os_open,
|
|||||||
stream_flags |= JANET_STREAM_WRITABLE;
|
stream_flags |= JANET_STREAM_WRITABLE;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||||
break;
|
break;
|
||||||
|
case 'a':
|
||||||
|
desiredAccess |= FILE_APPEND_DATA;
|
||||||
|
stream_flags |= JANET_STREAM_WRITABLE;
|
||||||
|
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||||
|
break;
|
||||||
case 'c':
|
case 'c':
|
||||||
creatUnix |= OCREAT;
|
creatUnix |= OCREAT;
|
||||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||||
@@ -2735,22 +2774,29 @@ JANET_CORE_FN(os_open,
|
|||||||
shareMode |= FILE_SHARE_WRITE;
|
shareMode |= FILE_SHARE_WRITE;
|
||||||
break;
|
break;
|
||||||
case 'H':
|
case 'H':
|
||||||
flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN;
|
fileAttributes |= FILE_ATTRIBUTE_HIDDEN;
|
||||||
break;
|
break;
|
||||||
case 'O':
|
case 'O':
|
||||||
flagsAndAttributes |= FILE_ATTRIBUTE_READONLY;
|
fileAttributes |= FILE_ATTRIBUTE_READONLY;
|
||||||
break;
|
break;
|
||||||
case 'F':
|
case 'F':
|
||||||
flagsAndAttributes |= FILE_ATTRIBUTE_OFFLINE;
|
fileAttributes |= FILE_ATTRIBUTE_OFFLINE;
|
||||||
break;
|
break;
|
||||||
case 'T':
|
case 'T':
|
||||||
flagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY;
|
fileAttributes |= FILE_ATTRIBUTE_TEMPORARY;
|
||||||
break;
|
break;
|
||||||
case 'd':
|
case 'd':
|
||||||
flagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
|
fileFlags |= FILE_FLAG_DELETE_ON_CLOSE;
|
||||||
break;
|
break;
|
||||||
case 'b':
|
case 'b':
|
||||||
flagsAndAttributes |= FILE_FLAG_NO_BUFFERING;
|
fileFlags |= FILE_FLAG_NO_BUFFERING;
|
||||||
|
break;
|
||||||
|
case 'I':
|
||||||
|
inherited_handle = 1;
|
||||||
|
break;
|
||||||
|
case 'V':
|
||||||
|
fileFlags &= ~FILE_FLAG_OVERLAPPED;
|
||||||
|
disable_stream_mode = 1;
|
||||||
break;
|
break;
|
||||||
/* we could potentially add more here -
|
/* we could potentially add more here -
|
||||||
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
|
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
|
||||||
@@ -2776,7 +2822,16 @@ JANET_CORE_FN(os_open,
|
|||||||
creationDisp = TRUNCATE_EXISTING;
|
creationDisp = TRUNCATE_EXISTING;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
fd = CreateFileA(path, desiredAccess, shareMode, NULL, creationDisp, flagsAndAttributes, NULL);
|
if (fileAttributes == 0) {
|
||||||
|
fileAttributes = FILE_ATTRIBUTE_NORMAL;
|
||||||
|
}
|
||||||
|
SECURITY_ATTRIBUTES saAttr;
|
||||||
|
memset(&saAttr, 0, sizeof(saAttr));
|
||||||
|
saAttr.nLength = sizeof(saAttr);
|
||||||
|
if (inherited_handle) {
|
||||||
|
saAttr.bInheritHandle = TRUE; /* Needed to do interesting things with file */
|
||||||
|
}
|
||||||
|
fd = CreateFileA(path, desiredAccess, shareMode, &saAttr, creationDisp, fileFlags | fileAttributes, NULL);
|
||||||
if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
|
if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
|
||||||
#else
|
#else
|
||||||
int open_flags = O_NONBLOCK;
|
int open_flags = O_NONBLOCK;
|
||||||
@@ -2820,6 +2875,10 @@ JANET_CORE_FN(os_open,
|
|||||||
case 'a':
|
case 'a':
|
||||||
open_flags |= O_APPEND;
|
open_flags |= O_APPEND;
|
||||||
break;
|
break;
|
||||||
|
case 'N':
|
||||||
|
open_flags &= ~O_NONBLOCK;
|
||||||
|
disable_stream_mode = 1;
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
/* If both read and write, fix up to O_RDWR */
|
/* If both read and write, fix up to O_RDWR */
|
||||||
@@ -2836,7 +2895,7 @@ JANET_CORE_FN(os_open,
|
|||||||
} while (fd == -1 && errno == EINTR);
|
} while (fd == -1 && errno == EINTR);
|
||||||
if (fd == -1) janet_panicv(janet_ev_lasterr());
|
if (fd == -1) janet_panicv(janet_ev_lasterr());
|
||||||
#endif
|
#endif
|
||||||
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
|
return janet_wrap_abstract(janet_stream(fd, disable_stream_mode ? 0 : stream_flags, NULL));
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_pipe,
|
JANET_CORE_FN(os_pipe,
|
||||||
|
|||||||
@@ -194,6 +194,41 @@ tail:
|
|||||||
return memcmp(text, rule + 2, len) ? NULL : text + len;
|
return memcmp(text, rule + 2, len) ? NULL : text + len;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
case RULE_DEBUG: {
|
||||||
|
char buffer[32] = {0};
|
||||||
|
size_t len = (size_t)(s->outer_text_end - text);
|
||||||
|
memcpy(buffer, text, (len > 31 ? 31 : len));
|
||||||
|
janet_eprintf("?? at [%s] (index %d)\n", buffer, (int32_t)(text - s->text_start));
|
||||||
|
int has_color = janet_truthy(janet_dyn("err-color"));
|
||||||
|
/* Accumulate buffer */
|
||||||
|
if (s->scratch->count) {
|
||||||
|
janet_eprintf("accumulate buffer: %v\n", janet_wrap_buffer(s->scratch));
|
||||||
|
}
|
||||||
|
/* Normal captures */
|
||||||
|
if (s->captures->count) {
|
||||||
|
janet_eprintf("stack [%d]:\n", s->captures->count);
|
||||||
|
for (int32_t i = 0; i < s->captures->count; i++) {
|
||||||
|
if (has_color) {
|
||||||
|
janet_eprintf(" [%d]: %M\n", i, s->captures->data[i]);
|
||||||
|
} else {
|
||||||
|
janet_eprintf(" [%d]: %m\n", i, s->captures->data[i]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Tagged captures */
|
||||||
|
if (s->tagged_captures->count) {
|
||||||
|
janet_eprintf("tag stack [%d]:\n", s->tagged_captures->count);
|
||||||
|
for (int32_t i = 0; i < s->tagged_captures->count; i++) {
|
||||||
|
if (has_color) {
|
||||||
|
janet_eprintf(" [%d] tag=%d: %M\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
|
||||||
|
} else {
|
||||||
|
janet_eprintf(" [%d] tag=%d: %m\n", i, (int32_t) s->tags->data[i], s->tagged_captures->data[i]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return text;
|
||||||
|
}
|
||||||
|
|
||||||
case RULE_NCHAR: {
|
case RULE_NCHAR: {
|
||||||
uint32_t n = rule[1];
|
uint32_t n = rule[1];
|
||||||
return (text + n > s->text_end) ? NULL : text + n;
|
return (text + n > s->text_end) ? NULL : text + n;
|
||||||
@@ -1245,6 +1280,14 @@ static void spec_constant(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
emit_2(r, RULE_CONSTANT, emit_constant(b, argv[0]), tag);
|
emit_2(r, RULE_CONSTANT, emit_constant(b, argv[0]), tag);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void spec_debug(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
|
peg_arity(b, argc, 0, 0);
|
||||||
|
Reserve r = reserve(b, 1);
|
||||||
|
uint32_t empty = 0;
|
||||||
|
(void) argv;
|
||||||
|
emit_rule(r, RULE_DEBUG, 0, &empty);
|
||||||
|
}
|
||||||
|
|
||||||
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_arity(b, argc, 2, 3);
|
peg_arity(b, argc, 2, 3);
|
||||||
Reserve r = reserve(b, 4);
|
Reserve r = reserve(b, 4);
|
||||||
@@ -1349,6 +1392,7 @@ static const SpecialPair peg_specials[] = {
|
|||||||
{"<-", spec_capture},
|
{"<-", spec_capture},
|
||||||
{">", spec_look},
|
{">", spec_look},
|
||||||
{"?", spec_opt},
|
{"?", spec_opt},
|
||||||
|
{"??", spec_debug},
|
||||||
{"accumulate", spec_accumulate},
|
{"accumulate", spec_accumulate},
|
||||||
{"any", spec_any},
|
{"any", spec_any},
|
||||||
{"argument", spec_argument},
|
{"argument", spec_argument},
|
||||||
@@ -1363,6 +1407,7 @@ static const SpecialPair peg_specials[] = {
|
|||||||
{"cmt", spec_matchtime},
|
{"cmt", spec_matchtime},
|
||||||
{"column", spec_column},
|
{"column", spec_column},
|
||||||
{"constant", spec_constant},
|
{"constant", spec_constant},
|
||||||
|
{"debug", spec_debug},
|
||||||
{"drop", spec_drop},
|
{"drop", spec_drop},
|
||||||
{"error", spec_error},
|
{"error", spec_error},
|
||||||
{"group", spec_group},
|
{"group", spec_group},
|
||||||
@@ -1639,6 +1684,10 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
|||||||
case RULE_LITERAL:
|
case RULE_LITERAL:
|
||||||
i += 2 + ((rule[1] + 3) >> 2);
|
i += 2 + ((rule[1] + 3) >> 2);
|
||||||
break;
|
break;
|
||||||
|
case RULE_DEBUG:
|
||||||
|
/* [0 words] */
|
||||||
|
i += 1;
|
||||||
|
break;
|
||||||
case RULE_NCHAR:
|
case RULE_NCHAR:
|
||||||
case RULE_NOTNCHAR:
|
case RULE_NOTNCHAR:
|
||||||
case RULE_RANGE:
|
case RULE_RANGE:
|
||||||
@@ -1854,8 +1903,8 @@ static JanetPeg *compile_peg(Janet x) {
|
|||||||
JANET_CORE_FN(cfun_peg_compile,
|
JANET_CORE_FN(cfun_peg_compile,
|
||||||
"(peg/compile peg)",
|
"(peg/compile peg)",
|
||||||
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
||||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
|
"if the same peg will be used multiple times. `(dyn :peg-grammar)` replaces "
|
||||||
"the grammar of the peg for otherwise undefined peg keywords.") {
|
"`default-peg-grammar` for the grammar of the peg.") {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetPeg *peg = compile_peg(argv[0]);
|
JanetPeg *peg = compile_peg(argv[0]);
|
||||||
return janet_wrap_abstract(peg);
|
return janet_wrap_abstract(peg);
|
||||||
|
|||||||
@@ -487,6 +487,7 @@ static const char *janet_pretty_colors[] = {
|
|||||||
#define JANET_PRETTY_DICT_ONELINE 4
|
#define JANET_PRETTY_DICT_ONELINE 4
|
||||||
#define JANET_PRETTY_IND_ONELINE 10
|
#define JANET_PRETTY_IND_ONELINE 10
|
||||||
#define JANET_PRETTY_DICT_LIMIT 30
|
#define JANET_PRETTY_DICT_LIMIT 30
|
||||||
|
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
|
||||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||||
|
|
||||||
/* Helper for pretty printing */
|
/* Helper for pretty printing */
|
||||||
@@ -625,55 +626,78 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
if (S->depth == 0) {
|
if (S->depth == 0) {
|
||||||
janet_buffer_push_cstring(S->buffer, "...");
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
} else {
|
} else {
|
||||||
int32_t i = 0, len = 0, cap = 0;
|
int32_t len = 0, cap = 0;
|
||||||
const JanetKV *kvs = NULL;
|
const JanetKV *kvs = NULL;
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||||
int32_t ks_start = S->keysort_start;
|
int32_t ks_start = S->keysort_start;
|
||||||
|
|
||||||
/* Ensure buffer is large enough to sort keys. */
|
|
||||||
int truncated = 0;
|
int truncated = 0;
|
||||||
int64_t mincap = (int64_t) len + (int64_t) ks_start;
|
|
||||||
if (mincap > INT32_MAX) {
|
|
||||||
truncated = 1;
|
|
||||||
len = 0;
|
|
||||||
mincap = ks_start;
|
|
||||||
}
|
|
||||||
|
|
||||||
if (S->keysort_capacity < mincap) {
|
/* Shortcut for huge dictionaries, don't bother sorting keys */
|
||||||
if (mincap >= INT32_MAX / 2) {
|
if (len > JANET_PRETTY_DICT_KEYSORT_LIMIT) {
|
||||||
S->keysort_capacity = INT32_MAX;
|
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
||||||
} else {
|
len = JANET_PRETTY_DICT_LIMIT;
|
||||||
S->keysort_capacity = (int32_t)(mincap * 2);
|
truncated = 1;
|
||||||
}
|
}
|
||||||
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
|
int32_t j = 0;
|
||||||
if (NULL == S->keysort_buffer) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
JANET_OUT_OF_MEMORY;
|
while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
|
||||||
|
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||||
|
janet_pretty_one(S, kvs[j].key, 0);
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
janet_pretty_one(S, kvs[j].value, 1);
|
||||||
|
j++;
|
||||||
}
|
}
|
||||||
}
|
if (truncated) {
|
||||||
|
print_newline(S, 0);
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
/* Sorted keys dictionaries */
|
||||||
|
|
||||||
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
|
/* Ensure buffer is large enough to sort keys. */
|
||||||
S->keysort_start += len;
|
int64_t mincap = (int64_t) len + (int64_t) ks_start;
|
||||||
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
if (mincap > INT32_MAX) {
|
||||||
len = JANET_PRETTY_DICT_LIMIT;
|
truncated = 1;
|
||||||
truncated = 1;
|
len = 0;
|
||||||
}
|
mincap = ks_start;
|
||||||
|
}
|
||||||
|
|
||||||
for (i = 0; i < len; i++) {
|
if (S->keysort_capacity < mincap) {
|
||||||
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
if (mincap >= INT32_MAX / 2) {
|
||||||
int32_t j = S->keysort_buffer[i + ks_start];
|
S->keysort_capacity = INT32_MAX;
|
||||||
janet_pretty_one(S, kvs[j].key, 0);
|
} else {
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
S->keysort_capacity = (int32_t)(mincap * 2);
|
||||||
janet_pretty_one(S, kvs[j].value, 1);
|
}
|
||||||
}
|
S->keysort_buffer = janet_srealloc(S->keysort_buffer, sizeof(int32_t) * S->keysort_capacity);
|
||||||
|
if (NULL == S->keysort_buffer) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
if (truncated) {
|
janet_sorted_keys(kvs, cap, S->keysort_buffer == NULL ? NULL : S->keysort_buffer + ks_start);
|
||||||
print_newline(S, 0);
|
S->keysort_start += len;
|
||||||
janet_buffer_push_cstring(S->buffer, "...");
|
if (!(S->flags & JANET_PRETTY_NOTRUNC) && (len > JANET_PRETTY_DICT_LIMIT)) {
|
||||||
}
|
len = JANET_PRETTY_DICT_LIMIT;
|
||||||
|
truncated = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
for (int32_t i = 0; i < len; i++) {
|
||||||
|
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||||
|
int32_t j = S->keysort_buffer[i + ks_start];
|
||||||
|
janet_pretty_one(S, kvs[j].key, 0);
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
janet_pretty_one(S, kvs[j].value, 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
if (truncated) {
|
||||||
|
print_newline(S, 0);
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
}
|
||||||
|
|
||||||
|
}
|
||||||
S->keysort_start = ks_start;
|
S->keysort_start = ks_start;
|
||||||
}
|
}
|
||||||
S->indent -= 2;
|
S->indent -= 2;
|
||||||
@@ -897,7 +921,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
|||||||
case 's':
|
case 's':
|
||||||
case 'S': {
|
case 'S': {
|
||||||
const char *str = va_arg(args, const char *);
|
const char *str = va_arg(args, const char *);
|
||||||
int32_t len = c[-1] == 's'
|
int32_t len = (c[-1] == 's')
|
||||||
? (int32_t) strlen(str)
|
? (int32_t) strlen(str)
|
||||||
: janet_string_length((JanetString) str);
|
: janet_string_length((JanetString) str);
|
||||||
if (form[2] == '\0')
|
if (form[2] == '\0')
|
||||||
|
|||||||
@@ -307,14 +307,14 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
/* Add attributes to a global def or var table */
|
/* Add attributes to a global def or var table */
|
||||||
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
|
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetTable *tab = janet_table(2);
|
|
||||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
|
||||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
|
||||||
: "<multiple bindings>";
|
|
||||||
if (argn < 2) {
|
if (argn < 2) {
|
||||||
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
JanetTable *tab = janet_table(2);
|
||||||
|
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||||
|
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||||
|
: "<multiple bindings>";
|
||||||
for (i = 1; i < argn - 1; i++) {
|
for (i = 1; i < argn - 1; i++) {
|
||||||
Janet attr = argv[i];
|
Janet attr = argv[i];
|
||||||
switch (janet_type(attr)) {
|
switch (janet_type(attr)) {
|
||||||
@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Def or var a symbol in a local scope */
|
/* Def or var a symbol in a local scope */
|
||||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
|
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
|
||||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||||
ret.index > 0 &&
|
ret.index > 0 &&
|
||||||
ret.envindex >= 0;
|
ret.envindex >= 0;
|
||||||
@@ -425,7 +425,11 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
|||||||
ret = localslot;
|
ret = localslot;
|
||||||
}
|
}
|
||||||
ret.flags |= flags;
|
ret.flags |= flags;
|
||||||
janetc_nameslot(c, head, ret);
|
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
|
||||||
|
janetc_nameslot_no_unused(c, head, ret);
|
||||||
|
} else {
|
||||||
|
janetc_nameslot(c, head, ret);
|
||||||
|
}
|
||||||
return !isUnnamedRegister;
|
return !isUnnamedRegister;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -439,8 +443,7 @@ static int varleaf(
|
|||||||
JanetSlot refslot;
|
JanetSlot refslot;
|
||||||
JanetTable *entry = janet_table_clone(reftab);
|
JanetTable *entry = janet_table_clone(reftab);
|
||||||
|
|
||||||
Janet redef_kw = janet_ckeywordv("redef");
|
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
|
||||||
|
|
||||||
JanetArray *ref;
|
JanetArray *ref;
|
||||||
JanetBinding old_binding;
|
JanetBinding old_binding;
|
||||||
@@ -460,17 +463,16 @@ static int varleaf(
|
|||||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
||||||
return 1;
|
return 1;
|
||||||
} else {
|
} else {
|
||||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s);
|
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
|
||||||
|
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void check_metadata_lint(JanetCompiler *c, JanetTable *attr_table) {
|
static void check_metadata_lint(JanetCompiler *c, JanetTable *attr_table) {
|
||||||
if (!(c->scope->flags & JANET_SCOPE_TOP) && attr_table && attr_table->count) {
|
if (!(c->scope->flags & JANET_SCOPE_TOP) && attr_table && attr_table->count) {
|
||||||
/* A macro is a normal lint, other metadata is a strict lint */
|
/* A macro is a normal lint, other metadata is a strict lint */
|
||||||
if (janet_truthy(janet_table_get(attr_table, janet_ckeywordv("macro")))) {
|
if (janet_truthy(janet_table_get_keyword(attr_table, "macro"))) {
|
||||||
janetc_lintf(c, JANET_C_LINT_NORMAL, "macro tag is ignored in inner scopes");
|
janetc_lintf(c, JANET_C_LINT_NORMAL, "macro tag is ignored in inner scopes");
|
||||||
} else {
|
|
||||||
janetc_lintf(c, JANET_C_LINT_STRICT, "unused metadata %j in inner scope", janet_wrap_table(attr_table));
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -508,9 +510,8 @@ static int defleaf(
|
|||||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
|
|
||||||
Janet redef_kw = janet_ckeywordv("redef");
|
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
|
||||||
if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
|
|
||||||
|
|
||||||
if (is_redef) {
|
if (is_redef) {
|
||||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||||
@@ -533,7 +534,8 @@ static int defleaf(
|
|||||||
/* Add env entry to env */
|
/* Add env entry to env */
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||||
}
|
}
|
||||||
return namelocal(c, sym, 0, s);
|
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
|
||||||
|
return namelocal(c, sym, 0, s, no_unused);
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
@@ -682,8 +684,10 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Write jumps - only add jump lengths if jump actually emitted */
|
/* Write jumps - only add jump lengths if jump actually emitted */
|
||||||
labeld = janet_v_count(c->buffer);
|
labeld = janet_v_count(c->buffer);
|
||||||
c->buffer[labeljr] |= (labelr - labeljr) << 16;
|
if (labeljr < labeld) {
|
||||||
if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8;
|
c->buffer[labeljr] |= (labelr - labeljr) << 16;
|
||||||
|
if (!tail && labeljd < labeld) c->buffer[labeljd] |= (labeld - labeljd) << 8;
|
||||||
|
}
|
||||||
|
|
||||||
if (tail) target.flags |= JANET_SLOT_RETURNED;
|
if (tail) target.flags |= JANET_SLOT_RETURNED;
|
||||||
return target;
|
return target;
|
||||||
@@ -1072,6 +1076,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Compile named arguments */
|
||||||
|
if (namedargs) {
|
||||||
|
Janet param = janet_wrap_table(named_table);
|
||||||
|
destructure(c, param, named_slot, defleaf, NULL);
|
||||||
|
janetc_freeslot(c, named_slot);
|
||||||
|
janet_v_free(named_params);
|
||||||
|
}
|
||||||
|
|
||||||
/* Compile destructed params */
|
/* Compile destructed params */
|
||||||
int32_t j = 0;
|
int32_t j = 0;
|
||||||
for (i = 0; i < paramcount; i++) {
|
for (i = 0; i < paramcount; i++) {
|
||||||
@@ -1085,14 +1097,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
janet_v_free(destructed_params);
|
janet_v_free(destructed_params);
|
||||||
|
|
||||||
/* Compile named arguments */
|
|
||||||
if (namedargs) {
|
|
||||||
Janet param = janet_wrap_table(named_table);
|
|
||||||
destructure(c, param, named_slot, defleaf, NULL);
|
|
||||||
janetc_freeslot(c, named_slot);
|
|
||||||
janet_v_free(named_params);
|
|
||||||
}
|
|
||||||
|
|
||||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
if (!seenopt) min_arity = arity;
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
@@ -1114,7 +1118,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetSlot slot = janetc_farslot(c);
|
JanetSlot slot = janetc_farslot(c);
|
||||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||||
janetc_nameslot(c, sym, slot);
|
janetc_nameslot_no_unused(c, sym, slot);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1135,8 +1139,12 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
def->min_arity = min_arity;
|
def->min_arity = min_arity;
|
||||||
def->max_arity = max_arity;
|
def->max_arity = max_arity;
|
||||||
|
if (named_table != NULL) {
|
||||||
|
def->named_args_count = named_table->count;
|
||||||
|
}
|
||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
if (namedargs) def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||||
|
|
||||||
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
|
|||||||
@@ -155,6 +155,17 @@ Janet janet_table_get(JanetTable *t, Janet key) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Used internally for compiler stuff */
|
||||||
|
Janet janet_table_get_keyword(JanetTable *t, const char *keyword) {
|
||||||
|
int32_t keyword_len = (int32_t) strlen(keyword);
|
||||||
|
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||||
|
JanetKV *bucket = (JanetKV *) janet_dict_find_keyword(t->data, t->capacity, (const uint8_t *) keyword, keyword_len);
|
||||||
|
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||||
|
return bucket->value;
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
/* Get a value out of the table, and record which prototype it was from. */
|
/* Get a value out of the table, and record which prototype it was from. */
|
||||||
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
|
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
|
||||||
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||||
|
|||||||
@@ -321,6 +321,54 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
|||||||
return first_bucket;
|
return first_bucket;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Helper to find a keyword, symbol, or string in a Janet struct or table without allocating
|
||||||
|
* memory or needing to find interned symbols */
|
||||||
|
const JanetKV *janet_dict_find_keyword(
|
||||||
|
const JanetKV *buckets, int32_t cap,
|
||||||
|
const uint8_t *cstr, int32_t cstr_len) {
|
||||||
|
int32_t hash = janet_string_calchash(cstr, cstr_len);
|
||||||
|
int32_t index = janet_maphash(cap, hash);
|
||||||
|
int32_t i;
|
||||||
|
const JanetKV *first_bucket = NULL;
|
||||||
|
/* Higher half */
|
||||||
|
for (i = index; i < cap; i++) {
|
||||||
|
const JanetKV *kv = buckets + i;
|
||||||
|
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||||
|
if (janet_checktype(kv->value, JANET_NIL)) {
|
||||||
|
return kv;
|
||||||
|
} else if (NULL == first_bucket) {
|
||||||
|
first_bucket = kv;
|
||||||
|
}
|
||||||
|
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
|
||||||
|
/* Works for symbol and keyword, too */
|
||||||
|
JanetString str = janet_unwrap_string(kv->key);
|
||||||
|
int32_t len = janet_string_length(str);
|
||||||
|
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
|
||||||
|
return buckets + i;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Lower half */
|
||||||
|
for (i = 0; i < index; i++) {
|
||||||
|
const JanetKV *kv = buckets + i;
|
||||||
|
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||||
|
if (janet_checktype(kv->value, JANET_NIL)) {
|
||||||
|
return kv;
|
||||||
|
} else if (NULL == first_bucket) {
|
||||||
|
first_bucket = kv;
|
||||||
|
}
|
||||||
|
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
|
||||||
|
/* Works for symbol and keyword, too */
|
||||||
|
JanetString str = janet_unwrap_string(kv->key);
|
||||||
|
int32_t len = janet_string_length(str);
|
||||||
|
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
|
||||||
|
return buckets + i;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return first_bucket;
|
||||||
|
}
|
||||||
|
|
||||||
/* Get a value from a janet struct or table. */
|
/* Get a value from a janet struct or table. */
|
||||||
Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
|
Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
|
||||||
const JanetKV *kv = janet_dict_find(data, cap, key);
|
const JanetKV *kv = janet_dict_find(data, cap, key);
|
||||||
@@ -628,8 +676,11 @@ JanetBinding janet_binding_from_entry(Janet entry) {
|
|||||||
return binding;
|
return binding;
|
||||||
entry_table = janet_unwrap_table(entry);
|
entry_table = janet_unwrap_table(entry);
|
||||||
|
|
||||||
/* deprecation check */
|
Janet deprecate = janet_table_get_keyword(entry_table, "deprecated");
|
||||||
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
|
int macro = janet_truthy(janet_table_get_keyword(entry_table, "macro"));
|
||||||
|
Janet value = janet_table_get_keyword(entry_table, "value");
|
||||||
|
Janet ref = janet_table_get_keyword(entry_table, "ref");
|
||||||
|
|
||||||
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
||||||
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
||||||
if (!janet_cstrcmp(depkw, "relaxed")) {
|
if (!janet_cstrcmp(depkw, "relaxed")) {
|
||||||
@@ -643,11 +694,8 @@ JanetBinding janet_binding_from_entry(Janet entry) {
|
|||||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||||
}
|
}
|
||||||
|
|
||||||
int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
|
|
||||||
Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
|
||||||
Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
|
||||||
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
|
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
|
||||||
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
|
int redef = ref_is_valid && janet_truthy(janet_table_get_keyword(entry_table, "redef"));
|
||||||
|
|
||||||
if (macro) {
|
if (macro) {
|
||||||
binding.value = redef ? ref : value;
|
binding.value = redef ? ref : value;
|
||||||
|
|||||||
@@ -66,42 +66,72 @@
|
|||||||
|
|
||||||
/* Utils */
|
/* Utils */
|
||||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
|
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
|
||||||
|
|
||||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||||
|
|
||||||
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
||||||
|
|
||||||
int janet_is_symbol_char(uint8_t c);
|
int janet_is_symbol_char(uint8_t c);
|
||||||
|
|
||||||
extern const char janet_base64[65];
|
extern const char janet_base64[65];
|
||||||
|
|
||||||
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||||
|
|
||||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||||
|
|
||||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||||
|
|
||||||
int32_t janet_tablen(int32_t n);
|
int32_t janet_tablen(int32_t n);
|
||||||
|
|
||||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||||
|
|
||||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||||
|
|
||||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||||
|
|
||||||
void janet_memempty(JanetKV *mem, int32_t count);
|
void janet_memempty(JanetKV *mem, int32_t count);
|
||||||
|
|
||||||
void *janet_memalloc_empty(int32_t count);
|
void *janet_memalloc_empty(int32_t count);
|
||||||
|
|
||||||
JanetTable *janet_get_core_table(const char *name);
|
JanetTable *janet_get_core_table(const char *name);
|
||||||
|
|
||||||
void janet_def_addflags(JanetFuncDef *def);
|
void janet_def_addflags(JanetFuncDef *def);
|
||||||
|
|
||||||
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
|
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
|
||||||
|
|
||||||
const char *janet_strerror(int e);
|
const char *janet_strerror(int e);
|
||||||
|
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
size_t itemsize,
|
size_t itemsize,
|
||||||
const uint8_t *key);
|
const uint8_t *key);
|
||||||
|
|
||||||
void janet_buffer_format(
|
void janet_buffer_format(
|
||||||
JanetBuffer *b,
|
JanetBuffer *b,
|
||||||
const char *strfrmt,
|
const char *strfrmt,
|
||||||
int32_t argstart,
|
int32_t argstart,
|
||||||
int32_t argc,
|
int32_t argc,
|
||||||
Janet *argv);
|
Janet *argv);
|
||||||
|
|
||||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||||
|
|
||||||
JanetBinding janet_binding_from_entry(Janet entry);
|
JanetBinding janet_binding_from_entry(Janet entry);
|
||||||
|
|
||||||
JanetByteView janet_text_substitution(
|
JanetByteView janet_text_substitution(
|
||||||
Janet *subst,
|
Janet *subst,
|
||||||
const uint8_t *bytes,
|
const uint8_t *bytes,
|
||||||
uint32_t len,
|
uint32_t len,
|
||||||
JanetArray *extra_args);
|
JanetArray *extra_args);
|
||||||
|
|
||||||
|
const JanetKV *janet_dict_find_keyword(
|
||||||
|
const JanetKV *buckets,
|
||||||
|
int32_t cap,
|
||||||
|
const uint8_t *cstr,
|
||||||
|
int32_t cstr_len);
|
||||||
|
|
||||||
|
Janet janet_table_get_keyword(JanetTable *t, const char *keyword);
|
||||||
|
|
||||||
/* Registry functions */
|
/* Registry functions */
|
||||||
void janet_registry_put(
|
void janet_registry_put(
|
||||||
JanetCFunction key,
|
JanetCFunction key,
|
||||||
|
|||||||
@@ -335,10 +335,9 @@ int32_t janet_hash(Janet x) {
|
|||||||
} as;
|
} as;
|
||||||
as.d = janet_unwrap_number(x);
|
as.d = janet_unwrap_number(x);
|
||||||
as.d += 0.0; /* normalize negative 0 */
|
as.d += 0.0; /* normalize negative 0 */
|
||||||
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
|
as.u = murmur64(as.u);
|
||||||
uint32_t hi = (uint32_t)(as.u >> 32);
|
uint32_t hi = (uint32_t)(as.u >> 32);
|
||||||
uint32_t hilo = (hi ^ lo) * 2654435769u;
|
hash = (int32_t)hi;
|
||||||
hash = (int32_t)((hilo << 16) | (hilo >> 16));
|
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_ABSTRACT: {
|
case JANET_ABSTRACT: {
|
||||||
@@ -768,7 +767,8 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||||
if (index >= array->count) {
|
if (index >= array->count) {
|
||||||
janet_array_setcount(array, index + 1);
|
janet_array_ensure(array, index + 1, 2);
|
||||||
|
array->count = index + 1;
|
||||||
}
|
}
|
||||||
array->data[index] = value;
|
array->data[index] = value;
|
||||||
break;
|
break;
|
||||||
@@ -779,7 +779,8 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
if (!janet_checkint(value))
|
if (!janet_checkint(value))
|
||||||
janet_panicf("can only put integers in buffers, got %v", value);
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
if (index >= buffer->count) {
|
if (index >= buffer->count) {
|
||||||
janet_buffer_setcount(buffer, index + 1);
|
janet_buffer_ensure(buffer, index + 1, 2);
|
||||||
|
buffer->count = index + 1;
|
||||||
}
|
}
|
||||||
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
||||||
break;
|
break;
|
||||||
|
|||||||
@@ -1074,6 +1074,7 @@ struct JanetAbstractHead {
|
|||||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||||
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
|
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
|
||||||
|
#define JANET_FUNCDEF_FLAG_NAMEDARGS 0x4000000
|
||||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||||
|
|
||||||
/* Source mapping structure for a bytecode instruction */
|
/* Source mapping structure for a bytecode instruction */
|
||||||
@@ -1115,6 +1116,7 @@ struct JanetFuncDef {
|
|||||||
int32_t environments_length;
|
int32_t environments_length;
|
||||||
int32_t defs_length;
|
int32_t defs_length;
|
||||||
int32_t symbolmap_length;
|
int32_t symbolmap_length;
|
||||||
|
int32_t named_args_count;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A function environment */
|
/* A function environment */
|
||||||
@@ -1138,6 +1140,7 @@ struct JanetFunction {
|
|||||||
JanetFuncEnv *envs[];
|
JanetFuncEnv *envs[];
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Use to read Janet data structures into memory from source code */
|
||||||
typedef struct JanetParseState JanetParseState;
|
typedef struct JanetParseState JanetParseState;
|
||||||
typedef struct JanetParser JanetParser;
|
typedef struct JanetParser JanetParser;
|
||||||
|
|
||||||
@@ -1187,7 +1190,10 @@ typedef struct {
|
|||||||
const JanetAbstractType *at;
|
const JanetAbstractType *at;
|
||||||
} JanetMarshalContext;
|
} JanetMarshalContext;
|
||||||
|
|
||||||
/* Defines an abstract type */
|
/* Defines an abstract type. Use a const pointer to one of these structures
|
||||||
|
* when creating abstract types. The memory for this pointer should not be free
|
||||||
|
* until after janet_deinit is called. Usually, this means declaring JanetAbstractType's
|
||||||
|
* as const data at file scope, and creating instances with janet_abstract(&MyType, sizeof(MyTypeStruct)); */
|
||||||
struct JanetAbstractType {
|
struct JanetAbstractType {
|
||||||
const char *name;
|
const char *name;
|
||||||
int (*gc)(void *data, size_t len);
|
int (*gc)(void *data, size_t len);
|
||||||
@@ -1439,6 +1445,7 @@ JANET_API void janet_loop(void);
|
|||||||
* } else {
|
* } else {
|
||||||
* janet_schedule(interrupted_fiber, janet_wrap_nil());
|
* janet_schedule(interrupted_fiber, janet_wrap_nil());
|
||||||
* }
|
* }
|
||||||
|
* janet_interpreter_interrupt_handled(NULL);
|
||||||
* }
|
* }
|
||||||
* }
|
* }
|
||||||
*
|
*
|
||||||
@@ -1478,9 +1485,18 @@ JANET_API void janet_ev_dec_refcount(void);
|
|||||||
JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
|
JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
|
||||||
JANET_API void *janet_abstract_end_threaded(void *x);
|
JANET_API void *janet_abstract_end_threaded(void *x);
|
||||||
JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
|
JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
|
||||||
|
|
||||||
|
/* Allow reference counting on threaded abstract types. This is useful when external code , either
|
||||||
|
* in the current OS thread or in a different OS thread, takes a pointer to this abstract type. The programmer
|
||||||
|
* should tncrement the reference count when taking the pointer, and then decrement and possibly cleanup and free
|
||||||
|
* if the reference count is 0. */
|
||||||
JANET_API int32_t janet_abstract_incref(void *abst);
|
JANET_API int32_t janet_abstract_incref(void *abst);
|
||||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||||
|
|
||||||
|
/* If this returns 0, *abst will be deinitialized and freed. Useful shorthand if there is no other cleanup for
|
||||||
|
* this abstract type before calling `janet_free` on it's backing memory. */
|
||||||
|
JANET_API int32_t janet_abstract_decref_maybe_free(void *abst);
|
||||||
|
|
||||||
/* Expose channel utilities */
|
/* Expose channel utilities */
|
||||||
JANET_API JanetChannel *janet_channel_make(uint32_t limit);
|
JANET_API JanetChannel *janet_channel_make(uint32_t limit);
|
||||||
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
|
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
|
||||||
@@ -1489,7 +1505,7 @@ JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_
|
|||||||
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
|
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
|
||||||
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
|
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
|
||||||
|
|
||||||
/* Expose some OS sync primitives */
|
/* Expose some OS sync primitives - mutexes and reader-writer locks */
|
||||||
JANET_API size_t janet_os_mutex_size(void);
|
JANET_API size_t janet_os_mutex_size(void);
|
||||||
JANET_API size_t janet_os_rwlock_size(void);
|
JANET_API size_t janet_os_rwlock_size(void);
|
||||||
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
||||||
@@ -1557,7 +1573,8 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
|
|||||||
/* Callback used by janet_ev_threaded_await */
|
/* Callback used by janet_ev_threaded_await */
|
||||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||||
|
|
||||||
/* Read async from a stream */
|
/* Read async from a stream. These function yield to the event-loop with janet_await(), and so do not return.
|
||||||
|
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
|
||||||
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||||
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||||
#ifdef JANET_NET
|
#ifdef JANET_NET
|
||||||
@@ -1566,7 +1583,8 @@ JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuff
|
|||||||
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Write async to a stream */
|
/* Write async to a stream. These function yield to the event-loop with janet_await(), and so do not return.
|
||||||
|
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
|
||||||
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||||
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||||
#ifdef JANET_NET
|
#ifdef JANET_NET
|
||||||
@@ -1578,17 +1596,63 @@ JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, Janet
|
|||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Parsing */
|
/* Parsing.
|
||||||
|
*
|
||||||
|
* E.g.
|
||||||
|
*
|
||||||
|
* JanetParser parser;
|
||||||
|
* janet_parser_init(&parser);
|
||||||
|
* for (int i = 0; i < source_code_length + 1; i++) {
|
||||||
|
* if (i >= source_code_length) {
|
||||||
|
* janet_parser_eof(&parser);
|
||||||
|
* } else {
|
||||||
|
* janet_parser_consume(&parser, source_code[i]);
|
||||||
|
* }
|
||||||
|
* while (janet_parser_has_more(&parser)) {
|
||||||
|
* Janet x = janet_parser_produce(&parser);
|
||||||
|
* janet_printf("got value: %v\n", x);
|
||||||
|
* }
|
||||||
|
* switch (janet_parser_status(&parser)) {
|
||||||
|
* case JANET_PARSE_PENDING: break;
|
||||||
|
* case JANET_PARSE_ERROR: janet_eprintf("error: %s\n", janet_parser_error(&parser)); break;
|
||||||
|
* case JANET_PARSE_ROOT: break;
|
||||||
|
* case JANET_PARSE_DEAD: break;
|
||||||
|
* }
|
||||||
|
* }
|
||||||
|
* janet_parser_deinit(&parser);
|
||||||
|
*
|
||||||
|
* */
|
||||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||||
|
|
||||||
|
/* Construct/destruct a parser. Parsers can be allocated on the stack or the heap. */
|
||||||
JANET_API void janet_parser_init(JanetParser *parser);
|
JANET_API void janet_parser_init(JanetParser *parser);
|
||||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||||
|
|
||||||
|
/* Feed bytes into the parser. Check the parser state after every byte to handle errors. */
|
||||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||||
|
|
||||||
|
/* Check the current status of the parser */
|
||||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||||
|
|
||||||
|
/* Produce a value from the parser. Call this when janet_parser_has_more(&parser) is non-zero. */
|
||||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||||
|
|
||||||
|
/* Produce a value from the parser, wrapped in a tuple. The tuple is used to carry the source mapping information of the
|
||||||
|
* top level form, such as a line number or symbol. */
|
||||||
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
|
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
|
||||||
|
|
||||||
|
/* When there is an error while parsing (janet_parser_status(&parser) == JANET_PARSE_ERROR), get a nice error string.
|
||||||
|
* Calling this will also flush the parser. */
|
||||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||||
|
|
||||||
|
/* If there is a parsing error, flush the parser to set the state back to empty.
|
||||||
|
* This allows for better error recover and less confusing error messages on bad syntax deep inside nested data structures. */
|
||||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||||
|
|
||||||
|
/* Indicate that there is no more source code */
|
||||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||||
|
|
||||||
|
/* If non-zero, the parser has values ready to be produced. */
|
||||||
JANET_API int janet_parser_has_more(JanetParser *parser);
|
JANET_API int janet_parser_has_more(JanetParser *parser);
|
||||||
|
|
||||||
/* Assembly */
|
/* Assembly */
|
||||||
@@ -1632,7 +1696,10 @@ JANET_API JanetCompileResult janet_compile_lint(
|
|||||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||||
|
|
||||||
/* Execute strings */
|
/* Execute strings.
|
||||||
|
*
|
||||||
|
* These functions wrap parsing, compilation, and evalutation into convenient functions.
|
||||||
|
* */
|
||||||
#define JANET_DO_ERROR_RUNTIME 0x01
|
#define JANET_DO_ERROR_RUNTIME 0x01
|
||||||
#define JANET_DO_ERROR_COMPILE 0x02
|
#define JANET_DO_ERROR_COMPILE 0x02
|
||||||
#define JANET_DO_ERROR_PARSE 0x04
|
#define JANET_DO_ERROR_PARSE 0x04
|
||||||
@@ -1826,21 +1893,41 @@ JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
|||||||
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
|
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
|
||||||
|
|
||||||
/* GC */
|
/* GC */
|
||||||
JANET_API void janet_mark(Janet x);
|
|
||||||
JANET_API void janet_sweep(void);
|
/* The main interface to garbage collection. Call this to do a full mark and sweep cleanup. */
|
||||||
JANET_API void janet_collect(void);
|
JANET_API void janet_collect(void);
|
||||||
JANET_API void janet_clear_memory(void);
|
|
||||||
|
/* Add "roots" to the garbage collector to prevent the runtime from freeing objects.
|
||||||
|
* This is only needed if code outside of Janet keeps references to Janet values */
|
||||||
JANET_API void janet_gcroot(Janet root);
|
JANET_API void janet_gcroot(Janet root);
|
||||||
JANET_API int janet_gcunroot(Janet root);
|
JANET_API int janet_gcunroot(Janet root);
|
||||||
JANET_API int janet_gcunrootall(Janet root);
|
|
||||||
|
/* Allow disabling garbage collection temporarily or for certain sections of code.
|
||||||
|
* this is a very cheap operation. */
|
||||||
JANET_API int janet_gclock(void);
|
JANET_API int janet_gclock(void);
|
||||||
JANET_API void janet_gcunlock(int handle);
|
JANET_API void janet_gcunlock(int handle);
|
||||||
|
|
||||||
|
/* The mark and sweep components of the mark and sweep collector. Prefer using janet_collect directly. */
|
||||||
|
JANET_API void janet_mark(Janet x);
|
||||||
|
JANET_API void janet_sweep(void);
|
||||||
|
|
||||||
|
/* Clear all gced memory and call all destructors. Used as part of the standard cleanup routune, most programmers will not need this. */
|
||||||
|
JANET_API void janet_clear_memory(void);
|
||||||
|
|
||||||
|
/* Remove all GC roots. Used as part of the standard cleanup routine, most programmers will not need this. */
|
||||||
|
JANET_API int janet_gcunrootall(Janet root);
|
||||||
|
|
||||||
|
/* Hint to the collector that memory of size s was just allocated to help it better understand when to free memory. */
|
||||||
JANET_API void janet_gcpressure(size_t s);
|
JANET_API void janet_gcpressure(size_t s);
|
||||||
|
|
||||||
/* Functions */
|
/* Functions */
|
||||||
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||||
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
||||||
|
|
||||||
|
/* Get a function that when called with no args, will return x. */
|
||||||
JANET_API JanetFunction *janet_thunk_delay(Janet x);
|
JANET_API JanetFunction *janet_thunk_delay(Janet x);
|
||||||
|
|
||||||
|
/* Do some simple verfification on constructed bytecode to disallow any trivial incorrect bytecode. */
|
||||||
JANET_API int janet_verify(JanetFuncDef *def);
|
JANET_API int janet_verify(JanetFuncDef *def);
|
||||||
|
|
||||||
/* Pretty printing */
|
/* Pretty printing */
|
||||||
@@ -1889,7 +1976,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
|
|||||||
JANET_API void janet_vm_save(JanetVM *into);
|
JANET_API void janet_vm_save(JanetVM *into);
|
||||||
JANET_API void janet_vm_load(JanetVM *from);
|
JANET_API void janet_vm_load(JanetVM *from);
|
||||||
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
||||||
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
|
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm); /* Call this after running interrupt handler */
|
||||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||||
@@ -1918,6 +2005,10 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
|||||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||||
|
#define JANET_SANDBOX_COMPILE 32768
|
||||||
|
#define JANET_SANDBOX_ASM 65536
|
||||||
|
#define JANET_SANDBOX_THREADS 131072
|
||||||
|
#define JANET_SANDBOX_UNMARSHAL 262144
|
||||||
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
||||||
JANET_API void janet_sandbox(uint32_t flags);
|
JANET_API void janet_sandbox(uint32_t flags);
|
||||||
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
|
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
|
||||||
@@ -1962,7 +2053,14 @@ JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
|
|||||||
/* Get values from the core environment. */
|
/* Get values from the core environment. */
|
||||||
JANET_API Janet janet_resolve_core(const char *name);
|
JANET_API Janet janet_resolve_core(const char *name);
|
||||||
|
|
||||||
/* New C API */
|
/* New C API
|
||||||
|
*
|
||||||
|
* The "New" C API is intended to make constructing good documentation and source maps
|
||||||
|
* much more straightforward. This not only ensures doc strings for functions in native
|
||||||
|
* modules, it also add source code mapping for C functions so that programmers can see which
|
||||||
|
* file and line a native function that calls janet_panic came from.
|
||||||
|
*
|
||||||
|
* */
|
||||||
|
|
||||||
/* Shorthand for janet C function declarations */
|
/* Shorthand for janet C function declarations */
|
||||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||||
@@ -2220,6 +2318,7 @@ typedef enum {
|
|||||||
RULE_NTH, /* [nth, rule, tag] */
|
RULE_NTH, /* [nth, rule, tag] */
|
||||||
RULE_ONLY_TAGS, /* [rule] */
|
RULE_ONLY_TAGS, /* [rule] */
|
||||||
RULE_MATCHSPLICE, /* [rule, constant, tag] */
|
RULE_MATCHSPLICE, /* [rule, constant, tag] */
|
||||||
|
RULE_DEBUG, /* [] */
|
||||||
} JanetPegOpcode;
|
} JanetPegOpcode;
|
||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
|
|||||||
@@ -112,6 +112,8 @@ static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
|||||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
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_match_count = 0;
|
||||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||||
|
static JANET_THREAD_LOCAL int gbl_history_loaded = 0;
|
||||||
|
static JANET_THREAD_LOCAL char *gbl_history_file = NULL;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Fallback */
|
/* Fallback */
|
||||||
@@ -430,6 +432,63 @@ static int insert(char c, int draw) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static void calc_history_file(void) {
|
||||||
|
char *hist = getenv("JANET_HISTFILE");
|
||||||
|
if (hist != NULL) {
|
||||||
|
gbl_history_file = sdup(hist);
|
||||||
|
} else {
|
||||||
|
gbl_history_file = NULL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static void loadhistory(void) {
|
||||||
|
if (gbl_history_loaded) return;
|
||||||
|
calc_history_file();
|
||||||
|
gbl_history_loaded = 1;
|
||||||
|
if (NULL == gbl_history_file) return;
|
||||||
|
FILE *history_file = fopen(gbl_history_file, "rb");
|
||||||
|
if (NULL == history_file) return;
|
||||||
|
JanetParser p;
|
||||||
|
janet_parser_init(&p);
|
||||||
|
int c = 0;
|
||||||
|
while ((c = fgetc(history_file))) {
|
||||||
|
if (c == EOF) {
|
||||||
|
janet_parser_eof(&p);
|
||||||
|
} else {
|
||||||
|
janet_parser_consume(&p, c);
|
||||||
|
}
|
||||||
|
|
||||||
|
while (janet_parser_has_more(&p) && gbl_history_count < JANET_HISTORY_MAX) {
|
||||||
|
if (janet_parser_status(&p) == JANET_PARSE_ERROR) {
|
||||||
|
janet_eprintf("bad history file: %s\n", janet_parser_error(&p));
|
||||||
|
goto parsing_done;
|
||||||
|
}
|
||||||
|
Janet x = janet_parser_produce(&p);
|
||||||
|
const char *cstr = (const char *) janet_to_string(x);
|
||||||
|
if (cstr[0]) { /* Drop empty strings */
|
||||||
|
gbl_history[gbl_history_count++] = sdup(cstr);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
if (c == EOF) break;
|
||||||
|
}
|
||||||
|
parsing_done:
|
||||||
|
janet_parser_deinit(&p);
|
||||||
|
gbl_historyi = 0;
|
||||||
|
fclose(history_file);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void savehistory(void) {
|
||||||
|
if (gbl_history_count < 1 || (gbl_history_file == NULL)) return;
|
||||||
|
FILE *history_file = fopen(gbl_history_file, "wb");
|
||||||
|
for (int i = 0; i < gbl_history_count; i++) {
|
||||||
|
if (gbl_history[i][0]) { /* Drop empty strings */
|
||||||
|
janet_dynprintf(NULL, history_file, "%j\n", janet_cstringv(gbl_history[i]));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
fclose(history_file);
|
||||||
|
}
|
||||||
|
|
||||||
static void historymove(int delta) {
|
static void historymove(int delta) {
|
||||||
if (gbl_history_count > 1) {
|
if (gbl_history_count > 1) {
|
||||||
janet_free(gbl_history[gbl_historyi]);
|
janet_free(gbl_history[gbl_historyi]);
|
||||||
@@ -896,6 +955,7 @@ static int line() {
|
|||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
clearlines();
|
clearlines();
|
||||||
norawmode();
|
norawmode();
|
||||||
|
savehistory();
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
ExitProcess(1);
|
ExitProcess(1);
|
||||||
#else
|
#else
|
||||||
@@ -1089,17 +1149,21 @@ void janet_line_init() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_deinit() {
|
void janet_line_deinit() {
|
||||||
int i;
|
|
||||||
norawmode();
|
norawmode();
|
||||||
for (i = 0; i < gbl_history_count; i++)
|
for (int i = 0; i < gbl_history_count; i++)
|
||||||
janet_free(gbl_history[i]);
|
janet_free(gbl_history[i]);
|
||||||
gbl_historyi = 0;
|
gbl_historyi = 0;
|
||||||
|
if (gbl_history_file) {
|
||||||
|
janet_free(gbl_history_file);
|
||||||
|
gbl_history_file = NULL;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
gbl_prompt = p;
|
gbl_prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
gbl_historyi = 0;
|
gbl_historyi = 0;
|
||||||
|
loadhistory();
|
||||||
if (check_simpleline(buffer)) return;
|
if (check_simpleline(buffer)) return;
|
||||||
FILE *out = janet_dynfile("err", stderr);
|
FILE *out = janet_dynfile("err", stderr);
|
||||||
if (line()) {
|
if (line()) {
|
||||||
@@ -1194,6 +1258,7 @@ int main(int argc, char **argv) {
|
|||||||
status = janet_loop_fiber(fiber);
|
status = janet_loop_fiber(fiber);
|
||||||
|
|
||||||
/* Deinitialize vm */
|
/* Deinitialize vm */
|
||||||
|
savehistory();
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
janet_line_deinit();
|
janet_line_deinit();
|
||||||
|
|
||||||
|
|||||||
@@ -1,5 +1,8 @@
|
|||||||
# Helper code for running tests
|
# Helper code for running tests
|
||||||
|
|
||||||
|
# Turn on strict linting by default in test suite.
|
||||||
|
(put root-env *lint-warn* :strict)
|
||||||
|
|
||||||
(var num-tests-passed 0)
|
(var num-tests-passed 0)
|
||||||
(var num-tests-run 0)
|
(var num-tests-run 0)
|
||||||
(var suite-name 0)
|
(var suite-name 0)
|
||||||
@@ -7,7 +10,7 @@
|
|||||||
(var skip-count 0)
|
(var skip-count 0)
|
||||||
(var skip-n 0)
|
(var skip-n 0)
|
||||||
|
|
||||||
(def is-verbose (os/getenv "VERBOSE"))
|
(var is-verbose (os/getenv "VERBOSE"))
|
||||||
|
|
||||||
(defn- assert-no-tail
|
(defn- assert-no-tail
|
||||||
"Override's the default assert with some nice error handling."
|
"Override's the default assert with some nice error handling."
|
||||||
@@ -19,7 +22,6 @@
|
|||||||
(break x))
|
(break x))
|
||||||
(default e "assert error")
|
(default e "assert error")
|
||||||
(when x (++ num-tests-passed))
|
(when x (++ num-tests-passed))
|
||||||
(def str (string e))
|
|
||||||
(def stack (debug/stack (fiber/current)))
|
(def stack (debug/stack (fiber/current)))
|
||||||
(def frame (last stack))
|
(def frame (last stack))
|
||||||
(def line-info (string/format "%s:%d"
|
(def line-info (string/format "%s:%d"
|
||||||
@@ -65,8 +67,8 @@
|
|||||||
(def e (gensym))
|
(def e (gensym))
|
||||||
(def f (gensym))
|
(def f (gensym))
|
||||||
(if is-verbose
|
(if is-verbose
|
||||||
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
|
~(try (do ,;forms (as-macro ,assert true ,msg)) ([,e ,f] (as-macro ,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
|
||||||
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
|
~(try (do ,;forms (as-macro ,assert true ,msg)) ([_] (as-macro ,assert false ,msg)))))
|
||||||
|
|
||||||
(defn start-suite [&opt x]
|
(defn start-suite [&opt x]
|
||||||
(default x (dyn :current-file))
|
(default x (dyn :current-file))
|
||||||
|
|||||||
@@ -21,6 +21,8 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
# Assembly test
|
# Assembly test
|
||||||
# Fibonacci sequence, implemented with naive recursion.
|
# Fibonacci sequence, implemented with naive recursion.
|
||||||
# a679f60
|
# a679f60
|
||||||
|
|||||||
@@ -21,6 +21,8 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
# Let
|
# Let
|
||||||
# 807f981
|
# 807f981
|
||||||
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
|
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
|
||||||
|
|||||||
@@ -30,7 +30,7 @@
|
|||||||
(defn myfun [x]
|
(defn myfun [x]
|
||||||
(var a 10)
|
(var a 10)
|
||||||
(set a (do
|
(set a (do
|
||||||
(def y x)
|
(def _y x)
|
||||||
(if x 8 9))))
|
(if x 8 9))))
|
||||||
|
|
||||||
(assert (= (myfun true) 8) "check do form regression")
|
(assert (= (myfun true) 8) "check do form regression")
|
||||||
@@ -46,8 +46,10 @@
|
|||||||
# Edge case should cause old compilers to fail due to
|
# Edge case should cause old compilers to fail due to
|
||||||
# if statement optimization
|
# if statement optimization
|
||||||
# 17283241
|
# 17283241
|
||||||
|
(setdyn *lint-warn* :relaxed)
|
||||||
(var var-a 1)
|
(var var-a 1)
|
||||||
(var var-b (if false 2 (string "hello")))
|
(var var-b (if false 2 (string "hello")))
|
||||||
|
(setdyn *lint-warn* nil)
|
||||||
|
|
||||||
(assert (= var-b "hello") "regression 1")
|
(assert (= var-b "hello") "regression 1")
|
||||||
|
|
||||||
@@ -73,5 +75,80 @@
|
|||||||
(foo 0)
|
(foo 0)
|
||||||
10)
|
10)
|
||||||
|
|
||||||
|
# Issue #1699 - fuzz case with bad def
|
||||||
|
(def result
|
||||||
|
(compile '(defn sum3
|
||||||
|
"Solve the 3SUM problem in O(n^2) time."
|
||||||
|
[s]
|
||||||
|
(def)tab @{})))
|
||||||
|
(assert (get result :error) "bad sum3 fuzz issue valgrind")
|
||||||
|
|
||||||
|
# Issue #1700
|
||||||
|
(def result
|
||||||
|
(compile
|
||||||
|
'(defn fuzz-case-1
|
||||||
|
[start end &]
|
||||||
|
(if end
|
||||||
|
(if e start (lazy-range (+ 1 start) end)))
|
||||||
|
1)))
|
||||||
|
(assert (get result :error) "fuzz case issue #1700")
|
||||||
|
|
||||||
|
# Issue #1702 - fuzz case with upvalues
|
||||||
|
(def result
|
||||||
|
(compile
|
||||||
|
'(each item [1 2 3]
|
||||||
|
# Generate a lot of upvalues (more than 224)
|
||||||
|
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
|
||||||
|
(with-dyns [:out out-buf] 1))))
|
||||||
|
(assert result "bad upvalues fuzz case")
|
||||||
|
|
||||||
|
# Named argument linting
|
||||||
|
# Enhancement for #1654
|
||||||
|
|
||||||
|
(defn fnamed [&named x y z] [x y z])
|
||||||
|
(defn fkeys [&keys ks] ks)
|
||||||
|
(defn fnamed2 [_a _b _c &named x y z] [x y z])
|
||||||
|
(defn fkeys2 [_a _b _c &keys ks] ks)
|
||||||
|
(defn fnamed3 [{:x x} &named a b c] [x a b c])
|
||||||
|
(defn fnamed4 [_y &opt _z &named a b c] [a b c])
|
||||||
|
(defn fnamed5 [&opt _z &named a b c] [a b c])
|
||||||
|
(defn g [x &opt y &named z] [x y z])
|
||||||
|
|
||||||
|
(defn check-good-compile
|
||||||
|
[code msg]
|
||||||
|
(def lints @[])
|
||||||
|
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||||
|
(assert (and (function? result) (empty? lints)) msg))
|
||||||
|
|
||||||
|
(defn check-lint-compile
|
||||||
|
[code msg]
|
||||||
|
(def lints @[])
|
||||||
|
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||||
|
(assert (and (function? result) (next lints)) msg))
|
||||||
|
|
||||||
|
(check-good-compile '(fnamed) "named no args")
|
||||||
|
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
|
||||||
|
(check-lint-compile '(fnamed :x) "named odd args")
|
||||||
|
(check-lint-compile '(fnamed :w 0) "named wrong key args")
|
||||||
|
(check-good-compile '(fkeys :a 1) "keys even args")
|
||||||
|
(check-lint-compile '(fkeys :a 1 :b) "keys odd args")
|
||||||
|
(check-good-compile '(fnamed2 nil nil nil) "named 2 no args")
|
||||||
|
(check-good-compile '(fnamed2 nil nil nil :x 1 :y 2 :z 3) "named 2 full args")
|
||||||
|
(check-lint-compile '(fnamed2 nil nil nil :x) "named 2 odd args")
|
||||||
|
(check-lint-compile '(fnamed2 nil nil nil :w 0) "named 2 wrong key args")
|
||||||
|
(check-good-compile '(fkeys2 nil nil nil :a 1) "keys 2 even args")
|
||||||
|
(check-lint-compile '(fkeys2 nil nil nil :a 1 :b) "keys 2 odd args")
|
||||||
|
(check-good-compile '(fnamed3 {:x 1} :a 1 :b 2 :c 3) "named 3 good")
|
||||||
|
(check-lint-compile '(fnamed3 {:x 1} :a 1 :b 2 :d 3) "named 3 lint")
|
||||||
|
(check-good-compile '(fnamed4 10 20 :a 1 :b 2 :c 3) "named 4 good")
|
||||||
|
(check-lint-compile '(fnamed4 10 20 :a 1 :b 2 :d 3) "named 4 lint")
|
||||||
|
(check-good-compile '(fnamed5 10 :a 1 :b 2 :c 3) "named 5 good")
|
||||||
|
(check-lint-compile '(fnamed5 10 :a 1 :b 2 :d 3) "named 5 lint")
|
||||||
|
(check-good-compile '(g 1) "g good 1")
|
||||||
|
(check-good-compile '(g 1 2) "g good 2")
|
||||||
|
(check-good-compile '(g 1 2 :z 10) "g good 3")
|
||||||
|
(check-lint-compile '(g 1 2 :z) "g lint 1")
|
||||||
|
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
@@ -192,13 +192,19 @@
|
|||||||
(assert (deep-not= (thaw ds2) (thaw-keep-keys ds2)) "thaw vs. thaw-keep-keys 2")
|
(assert (deep-not= (thaw ds2) (thaw-keep-keys ds2)) "thaw vs. thaw-keep-keys 2")
|
||||||
|
|
||||||
# match
|
# match
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
(assert (= :yes (match [1 2 3] [x y z w] :no1 [x y $] :no2 [x y z] :yes)) "match dollar suffix 1")
|
(assert (= :yes (match [1 2 3] [x y z w] :no1 [x y $] :no2 [x y z] :yes)) "match dollar suffix 1")
|
||||||
(assert (= :yes (match [1 2 3] [x y z w] :no1 [x y z $] :yes [x y z] :no2)) "match dollar suffix 2")
|
(assert (= :yes (match [1 2 3] [x y z w] :no1 [x y z $] :yes [x y z] :no2)) "match dollar suffix 2")
|
||||||
|
(setdyn *lint-warn* nil)
|
||||||
|
|
||||||
# Issue #1687
|
# Issue #1687
|
||||||
(assert-no-error "def destructure splice works 1" (do (def [a] [;[1]]) a))
|
(assert-no-error "def destructure splice works 1" (do (def [a] [;[1]]) a))
|
||||||
(assert-no-error "def destructure splice works 2" (do (def (n) [(splice [])]) n))
|
(assert-no-error "def destructure splice works 2" (do (def (n) [(splice [])]) n))
|
||||||
(assert-no-error "var destructure splice works" (do (var [a] [;[1]]) a))
|
(assert-no-error "var destructure splice works" (do (var [a] [;[1]]) a))
|
||||||
|
|
||||||
(end-suite)
|
# Issue #1709
|
||||||
|
(assert (= (macex1 '|(set (my-table [2 1]) 'foo))
|
||||||
|
'(fn :short-fn [] (set (my-table [2 1]) (quote foo))))
|
||||||
|
"Macro expand inside set preserves tuple type correctly")
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
|
|||||||
@@ -21,6 +21,8 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
|
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
|
||||||
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
|
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
|
||||||
|
|
||||||
|
|||||||
@@ -55,4 +55,33 @@
|
|||||||
(ev/sleep 0.2)
|
(ev/sleep 0.2)
|
||||||
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
|
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
|
||||||
|
|
||||||
|
# Issue #1705 - ev select
|
||||||
|
(def supervisor (ev/chan 10))
|
||||||
|
|
||||||
|
(def ch (ev/chan))
|
||||||
|
(def ch2 (ev/chan))
|
||||||
|
|
||||||
|
(ev/go |(do
|
||||||
|
(ev/select ch ch2)
|
||||||
|
(:close ch)
|
||||||
|
"close ch...")
|
||||||
|
nil supervisor)
|
||||||
|
|
||||||
|
(ev/go |(do
|
||||||
|
(ev/sleep 0.05)
|
||||||
|
(:close ch2)
|
||||||
|
"close ch2...")
|
||||||
|
nil supervisor)
|
||||||
|
|
||||||
|
(assert (let [[status] (ev/take supervisor)] (= status :ok)) "status 1 ev/select")
|
||||||
|
(assert (let [[status] (ev/take supervisor)] (= status :ok)) "status 2 ev/select")
|
||||||
|
(ev/sleep 0.1) # can we do better?
|
||||||
|
(assert (= 0 (ev/count supervisor)) "empty supervisor")
|
||||||
|
|
||||||
|
# Issue #1707
|
||||||
|
(def f (coro (repeat 10 (yield 1))))
|
||||||
|
(resume f)
|
||||||
|
(assert-error "cannot schedule non-new fiber"
|
||||||
|
(ev/go f))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
@@ -21,7 +21,7 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
(def has-ffi (dyn 'ffi/native))
|
(var has-ffi (dyn 'ffi/native))
|
||||||
(def has-full-ffi
|
(def has-full-ffi
|
||||||
(and has-ffi
|
(and has-ffi
|
||||||
(when-let [entry (dyn 'ffi/calling-conventions)]
|
(when-let [entry (dyn 'ffi/calling-conventions)]
|
||||||
|
|||||||
@@ -24,8 +24,8 @@
|
|||||||
(assert true)
|
(assert true)
|
||||||
|
|
||||||
(def chan (ev/chan 1000))
|
(def chan (ev/chan 1000))
|
||||||
(def is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
(var is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
||||||
(def is-linux (= :linux (os/which)))
|
(var is-linux (= :linux (os/which)))
|
||||||
|
|
||||||
# If not supported, exit early
|
# If not supported, exit early
|
||||||
(def [supported msg] (protect (filewatch/new chan)))
|
(def [supported msg] (protect (filewatch/new chan)))
|
||||||
|
|||||||
@@ -21,6 +21,9 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
# Disable linting warnings
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
# some tests for bigint
|
# some tests for bigint
|
||||||
# 319575c
|
# 319575c
|
||||||
(def i64 int/s64)
|
(def i64 int/s64)
|
||||||
|
|||||||
@@ -81,10 +81,12 @@
|
|||||||
"marshal nested fibers")
|
"marshal nested fibers")
|
||||||
|
|
||||||
# issue #53 - f4908ebc4
|
# issue #53 - f4908ebc4
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
(def issue-53-x
|
(def issue-53-x
|
||||||
(fiber/new
|
(fiber/new
|
||||||
(fn []
|
(fn []
|
||||||
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||||
|
(setdyn *lint-warn* nil)
|
||||||
|
|
||||||
(check-image issue-53-x "issue 53 regression")
|
(check-image issue-53-x "issue 53 regression")
|
||||||
|
|
||||||
|
|||||||
@@ -31,13 +31,13 @@
|
|||||||
[rng]
|
[rng]
|
||||||
(assert (all identity (seq [i :range [0 1000]]
|
(assert (all identity (seq [i :range [0 1000]]
|
||||||
(<= (math/rng-int rng i) i))) "math/rng-int test")
|
(<= (math/rng-int rng i) i))) "math/rng-int test")
|
||||||
(assert (all identity (seq [i :range [0 1000]]
|
(assert (all identity (seq [_ :range [0 1000]]
|
||||||
(def x (math/rng-uniform rng))
|
(def x (math/rng-uniform rng))
|
||||||
(and (>= x 0) (< x 1))))
|
(and (>= x 0) (< x 1))))
|
||||||
"math/rng-uniform test"))
|
"math/rng-uniform test"))
|
||||||
|
|
||||||
(def seedrng (math/rng 123))
|
(def seedrng (math/rng 123))
|
||||||
(for i 0 75
|
(for _ 0 75
|
||||||
(test-rng (math/rng (:int seedrng))))
|
(test-rng (math/rng (:int seedrng))))
|
||||||
|
|
||||||
# 70328437f
|
# 70328437f
|
||||||
@@ -49,7 +49,7 @@
|
|||||||
# 027b2a8
|
# 027b2a8
|
||||||
(defn assert-many [f n e]
|
(defn assert-many [f n e]
|
||||||
(var good true)
|
(var good true)
|
||||||
(loop [i :range [0 n]]
|
(loop [_ :range [0 n]]
|
||||||
(if (not (f))
|
(if (not (f))
|
||||||
(set good false)))
|
(set good false)))
|
||||||
(assert good e))
|
(assert good e))
|
||||||
|
|||||||
35
test/suite-net.janet
Normal file
35
test/suite-net.janet
Normal file
@@ -0,0 +1,35 @@
|
|||||||
|
# Copyright (c) 2026 Calvin Rose & contributors
|
||||||
|
#
|
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
# deal in the Software without restriction, including without limitation the
|
||||||
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
# sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
# furnished to do so, subject to the following conditions:
|
||||||
|
#
|
||||||
|
# The above copyright notice and this permission notice shall be included in
|
||||||
|
# all copies or substantial portions of the Software.
|
||||||
|
#
|
||||||
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
|
# Expand on ev testing with some extra network protocol testing.
|
||||||
|
|
||||||
|
(import ./helper :prefix "" :exit true)
|
||||||
|
(start-suite)
|
||||||
|
|
||||||
|
# Smoke
|
||||||
|
(assert true)
|
||||||
|
|
||||||
|
# Raw socket testing
|
||||||
|
(def s (net/socket :datagram :ipv4))
|
||||||
|
(assert-no-error "multicast ipv4" (net/setsockopt s :ip-multicast-ttl 255))
|
||||||
|
#(def s6 (net/socket :datagram :ipv6))
|
||||||
|
#(assert-no-error "multicast ipv6" (net/setsockopt s6 :ipv6-multicast-hops 255))
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
@@ -63,7 +63,10 @@
|
|||||||
"strftime january 2014")
|
"strftime january 2014")
|
||||||
(assert (= (try (os/strftime "%%%d%t") ([err] err))
|
(assert (= (try (os/strftime "%%%d%t") ([err] err))
|
||||||
"invalid conversion specifier '%t'")
|
"invalid conversion specifier '%t'")
|
||||||
"invalid conversion specifier")
|
"invalid conversion specifier 1")
|
||||||
|
(assert (= (try (os/strftime "%H:%M:%") ([err] err))
|
||||||
|
"invalid conversion specifier")
|
||||||
|
"invalid conversion specifier 2")
|
||||||
|
|
||||||
# 07db4c530
|
# 07db4c530
|
||||||
(os/setenv "TESTENV1" "v1")
|
(os/setenv "TESTENV1" "v1")
|
||||||
@@ -174,8 +177,27 @@
|
|||||||
:px
|
:px
|
||||||
{:out dn :err dn})))
|
{:out dn :err dn})))
|
||||||
|
|
||||||
|
# os/execute IO redirection with more windows flags
|
||||||
|
(assert-no-error "IO redirection more windows flags"
|
||||||
|
(defn devnull []
|
||||||
|
(def os (os/which))
|
||||||
|
(def path (if (or (= os :mingw) (= os :windows))
|
||||||
|
"NUL"
|
||||||
|
"/dev/null"))
|
||||||
|
(os/open path (if (= os :windows) :wWI :wW)))
|
||||||
|
(with [dn (devnull)]
|
||||||
|
(os/execute [;run janet
|
||||||
|
"-e"
|
||||||
|
"(print :foo) (eprint :bar)"]
|
||||||
|
:px
|
||||||
|
{:out dn :err dn})))
|
||||||
|
|
||||||
# Issue 16922
|
# Issue 16922
|
||||||
(assert-error "os/realpath errors when path does not exist"
|
(assert-error "os/realpath errors when path does not exist"
|
||||||
(os/realpath "abc123def456"))
|
(os/realpath "abc123def456"))
|
||||||
|
|
||||||
|
# os/which changes
|
||||||
|
(assert (os/which (os/which)) "os/which 1 arg")
|
||||||
|
(assert (not (os/which :gobbledegook)) "os/which 2")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
@@ -67,7 +67,7 @@
|
|||||||
(def str
|
(def str
|
||||||
(if rewrite
|
(if rewrite
|
||||||
(peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " "))
|
(peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " "))
|
||||||
(fn [mtch eol] eol) text)
|
(fn [_mtch eol] eol) text)
|
||||||
text))
|
text))
|
||||||
|
|
||||||
(def first-eol (cond
|
(def first-eol (cond
|
||||||
@@ -177,12 +177,12 @@
|
|||||||
(def p1 (parser/new))
|
(def p1 (parser/new))
|
||||||
(parser/state p1)
|
(parser/state p1)
|
||||||
(parser/consume p1 step1)
|
(parser/consume p1 step1)
|
||||||
(loop [v :iterate (parser/produce p1)])
|
(loop [_ :iterate (parser/produce p1)])
|
||||||
(parser/state p1)
|
(parser/state p1)
|
||||||
(def p2 (parser/clone p1))
|
(def p2 (parser/clone p1))
|
||||||
(parser/state p2)
|
(parser/state p2)
|
||||||
(parser/consume p2 step2)
|
(parser/consume p2 step2)
|
||||||
(loop [v :iterate (parser/produce p2)])
|
(loop [_ :iterate (parser/produce p2)])
|
||||||
(parser/state p2)
|
(parser/state p2)
|
||||||
|
|
||||||
# parser delimiter errors
|
# parser delimiter errors
|
||||||
|
|||||||
@@ -101,9 +101,9 @@
|
|||||||
# 798c88b4c
|
# 798c88b4c
|
||||||
(def csv
|
(def csv
|
||||||
'{:field (+
|
'{:field (+
|
||||||
(* `"` (% (any (+ (<- (if-not `"` 1))
|
(* `"` (% (any (+ (<- (if-not `"` 1))
|
||||||
(* (constant `"`) `""`)))) `"`)
|
(* (constant `"`) `""`)))) `"`)
|
||||||
(<- (any (if-not (set ",\n") 1))))
|
(<- (any (if-not (set ",\n") 1))))
|
||||||
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
||||||
|
|
||||||
(defn check-csv
|
(defn check-csv
|
||||||
@@ -266,6 +266,12 @@
|
|||||||
(marshpeg '(sub "abcdf" "abc"))
|
(marshpeg '(sub "abcdf" "abc"))
|
||||||
(marshpeg '(* (sub 1 1)))
|
(marshpeg '(* (sub 1 1)))
|
||||||
(marshpeg '(split "," (+ "a" "b" "c")))
|
(marshpeg '(split "," (+ "a" "b" "c")))
|
||||||
|
(marshpeg "")
|
||||||
|
(marshpeg 1)
|
||||||
|
(marshpeg 0)
|
||||||
|
(marshpeg -1)
|
||||||
|
(marshpeg '(drop 1))
|
||||||
|
(marshpeg '(accumulate 1))
|
||||||
|
|
||||||
# Peg swallowing errors
|
# Peg swallowing errors
|
||||||
# 159651117
|
# 159651117
|
||||||
@@ -345,16 +351,16 @@
|
|||||||
# Using a large test grammar
|
# Using a large test grammar
|
||||||
# cf05ff610
|
# cf05ff610
|
||||||
(def- specials {'fn true
|
(def- specials {'fn true
|
||||||
'var true
|
'var true
|
||||||
'do true
|
'do true
|
||||||
'while true
|
'while true
|
||||||
'def true
|
'def true
|
||||||
'splice true
|
'splice true
|
||||||
'set true
|
'set true
|
||||||
'unquote true
|
'unquote true
|
||||||
'quasiquote true
|
'quasiquote true
|
||||||
'quote true
|
'quote true
|
||||||
'if true})
|
'if true})
|
||||||
|
|
||||||
(defn- check-number [text] (and (scan-number text) text))
|
(defn- check-number [text] (and (scan-number text) text))
|
||||||
|
|
||||||
@@ -399,7 +405,7 @@
|
|||||||
:struct (* '"{" :root2 (+ '"}" (error "")))
|
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||||
:parray (* '"@" :ptuple)
|
:parray (* '"@" :ptuple)
|
||||||
:barray (* '"@" :btuple)
|
:barray (* '"@" :btuple)
|
||||||
:dict (* '"@" :struct)
|
:dict (* '"@" :struct)
|
||||||
:main (+ :root (error ""))})
|
:main (+ :root (error ""))})
|
||||||
|
|
||||||
(def p (peg/compile grammar))
|
(def p (peg/compile grammar))
|
||||||
@@ -563,18 +569,18 @@
|
|||||||
(assert (= (string (f peg subst text)) expected) name))
|
(assert (= (string (f peg subst text)) expected) name))
|
||||||
|
|
||||||
(peg-test "peg/replace has access to captures"
|
(peg-test "peg/replace has access to captures"
|
||||||
peg/replace
|
peg/replace
|
||||||
~(sequence "." (capture (set "ab")))
|
~(sequence "." (capture (set "ab")))
|
||||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||||
".a.b.c"
|
".a.b.c"
|
||||||
".a -> A, .b.c")
|
".a -> A, .b.c")
|
||||||
|
|
||||||
(peg-test "peg/replace-all has access to captures"
|
(peg-test "peg/replace-all has access to captures"
|
||||||
peg/replace-all
|
peg/replace-all
|
||||||
~(sequence "." (capture (set "ab")))
|
~(sequence "." (capture (set "ab")))
|
||||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||||
".a.b.c"
|
".a.b.c"
|
||||||
".a -> A, .b -> B, .c")
|
".a -> A, .b -> B, .c")
|
||||||
|
|
||||||
# Peg bug
|
# Peg bug
|
||||||
# eab5f67c5
|
# eab5f67c5
|
||||||
@@ -648,20 +654,20 @@
|
|||||||
|
|
||||||
# issue #1026 - 9341081a4
|
# issue #1026 - 9341081a4
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||||
@[]) "peg not")
|
@[]) "peg not")
|
||||||
|
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||||
@[]) "peg if-not")
|
@[]) "peg if-not")
|
||||||
|
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||||
@[]) "peg if-not drop")
|
@[]) "peg if-not drop")
|
||||||
|
|
||||||
(assert (deep=
|
(assert (deep=
|
||||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||||
@[]) "peg if not")
|
@[]) "peg if not")
|
||||||
|
|
||||||
(defn test [name peg input expected]
|
(defn test [name peg input expected]
|
||||||
(assert-no-error "compile peg" (peg/compile peg))
|
(assert-no-error "compile peg" (peg/compile peg))
|
||||||
@@ -669,143 +675,143 @@
|
|||||||
(assert (deep= (peg/match peg input) expected) name))
|
(assert (deep= (peg/match peg input) expected) name))
|
||||||
|
|
||||||
(test "sub: matches the same input twice"
|
(test "sub: matches the same input twice"
|
||||||
~(sub "abcd" "abc")
|
~(sub "abcd" "abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "sub: second pattern cannot match more than the first pattern"
|
(test "sub: second pattern cannot match more than the first pattern"
|
||||||
~(sub "abcd" "abcde")
|
~(sub "abcd" "abcde")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "sub: fails if first pattern fails"
|
(test "sub: fails if first pattern fails"
|
||||||
~(sub "x" "abc")
|
~(sub "x" "abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "sub: fails if second pattern fails"
|
(test "sub: fails if second pattern fails"
|
||||||
~(sub "abc" "x")
|
~(sub "abc" "x")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "sub: keeps captures from both patterns"
|
(test "sub: keeps captures from both patterns"
|
||||||
~(sub '"abcd" '"abc")
|
~(sub '"abcd" '"abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@["abcd" "abc"])
|
@["abcd" "abc"])
|
||||||
|
|
||||||
(test "sub: second pattern can reference captures from first"
|
(test "sub: second pattern can reference captures from first"
|
||||||
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[5 "abc" "abc"])
|
@[5 "abc" "abc"])
|
||||||
|
|
||||||
(test "sub: second pattern can't see past what the first pattern matches"
|
(test "sub: second pattern can't see past what the first pattern matches"
|
||||||
~(sub "abc" (* "abc" -1))
|
~(sub "abc" (* "abc" -1))
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "sub: positions inside second match are still relative to the entire input"
|
(test "sub: positions inside second match are still relative to the entire input"
|
||||||
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
||||||
"one\ntwo\nthree\n"
|
"one\ntwo\nthree\n"
|
||||||
@[6 2 3])
|
@[6 2 3])
|
||||||
|
|
||||||
(test "sub: advances to the end of the first pattern's match"
|
(test "sub: advances to the end of the first pattern's match"
|
||||||
~(* (sub "abc" "ab") "d")
|
~(* (sub "abc" "ab") "d")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "til: basic matching"
|
(test "til: basic matching"
|
||||||
~(til "d" "abc")
|
~(til "d" "abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "til: second pattern can't see past the first occurrence of first pattern"
|
(test "til: second pattern can't see past the first occurrence of first pattern"
|
||||||
~(til "d" (* "abc" -1))
|
~(til "d" (* "abc" -1))
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "til: fails if first pattern fails"
|
(test "til: fails if first pattern fails"
|
||||||
~(til "x" "abc")
|
~(til "x" "abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "til: fails if second pattern fails"
|
(test "til: fails if second pattern fails"
|
||||||
~(til "abc" "x")
|
~(til "abc" "x")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "til: discards captures from initial pattern"
|
(test "til: discards captures from initial pattern"
|
||||||
~(til '"d" '"abc")
|
~(til '"d" '"abc")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@["abc"])
|
@["abc"])
|
||||||
|
|
||||||
(test "til: positions inside second match are still relative to the entire input"
|
(test "til: positions inside second match are still relative to the entire input"
|
||||||
~(* "one\ntw" (til 0 (* ($) (line) (column))))
|
~(* "one\ntw" (til 0 (* ($) (line) (column))))
|
||||||
"one\ntwo\nthree\n"
|
"one\ntwo\nthree\n"
|
||||||
@[6 2 3])
|
@[6 2 3])
|
||||||
|
|
||||||
(test "til: advances to the end of the first pattern's first occurrence"
|
(test "til: advances to the end of the first pattern's first occurrence"
|
||||||
~(* (til "d" "ab") "e")
|
~(* (til "d" "ab") "e")
|
||||||
"abcdef"
|
"abcdef"
|
||||||
@[])
|
@[])
|
||||||
|
|
||||||
(test "split: basic functionality"
|
(test "split: basic functionality"
|
||||||
~(split "," '1)
|
~(split "," '1)
|
||||||
"a,b,c"
|
"a,b,c"
|
||||||
@["a" "b" "c"])
|
@["a" "b" "c"])
|
||||||
|
|
||||||
(test "split: drops captures from separator pattern"
|
(test "split: drops captures from separator pattern"
|
||||||
~(split '"," '1)
|
~(split '"," '1)
|
||||||
"a,b,c"
|
"a,b,c"
|
||||||
@["a" "b" "c"])
|
@["a" "b" "c"])
|
||||||
|
|
||||||
(test "split: can match empty subpatterns"
|
(test "split: can match empty subpatterns"
|
||||||
~(split "," ':w*)
|
~(split "," ':w*)
|
||||||
",a,,bar,,,c,,"
|
",a,,bar,,,c,,"
|
||||||
@["" "a" "" "bar" "" "" "c" "" ""])
|
@["" "a" "" "bar" "" "" "c" "" ""])
|
||||||
|
|
||||||
(test "split: subpattern is limited to only text before the separator"
|
(test "split: subpattern is limited to only text before the separator"
|
||||||
~(split "," '(to -1))
|
~(split "," '(to -1))
|
||||||
"a,,bar,c"
|
"a,,bar,c"
|
||||||
@["a" "" "bar" "c"])
|
@["a" "" "bar" "c"])
|
||||||
|
|
||||||
(test "split: fails if any subpattern fails"
|
(test "split: fails if any subpattern fails"
|
||||||
~(split "," '"a")
|
~(split "," '"a")
|
||||||
"a,a,b"
|
"a,a,b"
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "split: separator does not have to match anything"
|
(test "split: separator does not have to match anything"
|
||||||
~(split "x" '(to -1))
|
~(split "x" '(to -1))
|
||||||
"a,a,b"
|
"a,a,b"
|
||||||
@["a,a,b"])
|
@["a,a,b"])
|
||||||
|
|
||||||
(test "split: always consumes entire input"
|
(test "split: always consumes entire input"
|
||||||
~(split 1 '"")
|
~(split 1 '"")
|
||||||
"abc"
|
"abc"
|
||||||
@["" "" "" ""])
|
@["" "" "" ""])
|
||||||
|
|
||||||
(test "split: separator can be an arbitrary PEG"
|
(test "split: separator can be an arbitrary PEG"
|
||||||
~(split :s+ '(to -1))
|
~(split :s+ '(to -1))
|
||||||
"a b c"
|
"a b c"
|
||||||
@["a" "b" "c"])
|
@["a" "b" "c"])
|
||||||
|
|
||||||
(test "split: does not advance past the end of the input"
|
(test "split: does not advance past the end of the input"
|
||||||
~(* (split "," ':w+) 0)
|
~(* (split "," ':w+) 0)
|
||||||
"a,b,c"
|
"a,b,c"
|
||||||
@["a" "b" "c"])
|
@["a" "b" "c"])
|
||||||
|
|
||||||
(test "nth 1"
|
(test "nth 1"
|
||||||
~{:prefix (number :d+ nil :n)
|
~{:prefix (number :d+ nil :n)
|
||||||
:word '(lenprefix (-> :n) :w)
|
:word '(lenprefix (-> :n) :w)
|
||||||
:main (some (nth 1 (* :prefix ":" :word)))}
|
:main (some (nth 1 (* :prefix ":" :word)))}
|
||||||
"5:apple6:banana6:cherry"
|
"5:apple6:banana6:cherry"
|
||||||
@["apple" "banana" "cherry"])
|
@["apple" "banana" "cherry"])
|
||||||
|
|
||||||
(test "only-tags 1"
|
(test "only-tags 1"
|
||||||
~{:prefix (number :d+ nil :n)
|
~{:prefix (number :d+ nil :n)
|
||||||
:word (capture (lenprefix (-> :n) :w) :W)
|
:word (capture (lenprefix (-> :n) :w) :W)
|
||||||
:main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
|
:main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
|
||||||
"5:apple6:banana6:cherry"
|
"5:apple6:banana6:cherry"
|
||||||
@["apple" "banana" "cherry"])
|
@["apple" "banana" "cherry"])
|
||||||
|
|
||||||
# Issue #1539 - make sure split with "" doesn't infinite loop/oom
|
# Issue #1539 - make sure split with "" doesn't infinite loop/oom
|
||||||
(test "issue 1539"
|
(test "issue 1539"
|
||||||
@@ -814,9 +820,9 @@
|
|||||||
nil)
|
nil)
|
||||||
|
|
||||||
(test "issue 1539 pt. 2"
|
(test "issue 1539 pt. 2"
|
||||||
~(split "," (capture 0))
|
~(split "," (capture 0))
|
||||||
"abc123,,,,"
|
"abc123,,,,"
|
||||||
@["" "" "" "" ""])
|
@["" "" "" "" ""])
|
||||||
|
|
||||||
# Issue #1549 - allow buffers as peg literals
|
# Issue #1549 - allow buffers as peg literals
|
||||||
(test "issue 1549"
|
(test "issue 1549"
|
||||||
@@ -845,4 +851,106 @@
|
|||||||
"abc"
|
"abc"
|
||||||
@[["b" "b" "b"]])
|
@[["b" "b" "b"]])
|
||||||
|
|
||||||
|
# Debug and ?? tests.
|
||||||
|
(defn test-stderr [name peg input expected-matches expected-stderr]
|
||||||
|
(with-dyns [:err @""]
|
||||||
|
(test name peg input expected-matches))
|
||||||
|
(def actual @"")
|
||||||
|
(with-dyns [:err actual *err-color* true]
|
||||||
|
(peg/match peg input))
|
||||||
|
(assert (deep= (string actual) expected-stderr)))
|
||||||
|
|
||||||
|
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
|
||||||
|
(with-dyns [:err @""]
|
||||||
|
(test name peg input expected-matches))
|
||||||
|
(def actual @"")
|
||||||
|
(with-dyns [:err actual *err-color* false]
|
||||||
|
(peg/match peg input))
|
||||||
|
(assert (deep= (string actual) expected-stderr)))
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? long form"
|
||||||
|
'(* (debug) "abc")
|
||||||
|
"abc"
|
||||||
|
@[]
|
||||||
|
"?? at [abc] (index 0)\n")
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? short form"
|
||||||
|
'(* (??) "abc")
|
||||||
|
"abc"
|
||||||
|
@[]
|
||||||
|
"?? at [abc] (index 0)\n")
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? end of text"
|
||||||
|
'(* "abc" (??))
|
||||||
|
"abc"
|
||||||
|
@[]
|
||||||
|
"?? at [] (index 3)\n")
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? between rules"
|
||||||
|
'(* "a" (??) "bc")
|
||||||
|
"abc"
|
||||||
|
@[]
|
||||||
|
"?? at [bc] (index 1)\n")
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? stack display, string"
|
||||||
|
'(* (<- "a") (??) "bc")
|
||||||
|
"abc"
|
||||||
|
@["a"]
|
||||||
|
(string/format "?? at [bc] (index 1)\nstack [1]:\n [0]: %M\n" "a"))
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? stack display, multiple types"
|
||||||
|
'(* (<- "a") (number :d) (constant true) (constant {}) (constant @[]) (??) "bc")
|
||||||
|
"a1bc"
|
||||||
|
@["a" 1 true {} @[]]
|
||||||
|
(string/format "?? at [bc] (index 2)\nstack [5]:\n [0]: %M\n [1]: %M\n [2]: %M\n [3]: %M\n [4]: %M\n" "a" 1 true {} @[]))
|
||||||
|
|
||||||
|
(marshpeg '(* (??) "abc"))
|
||||||
|
(marshpeg '(* (some (debug)) (??) "abc"))
|
||||||
|
|
||||||
|
(test-stderr
|
||||||
|
"?? displays when capture fails"
|
||||||
|
'(* '1 (??) "x")
|
||||||
|
"abc"
|
||||||
|
nil
|
||||||
|
(string/format "?? at [bc] (index 1)\nstack [1]:\n [0]: %M\n" "a"))
|
||||||
|
|
||||||
|
(test-stderr-no-color
|
||||||
|
"?? displays accumuate and tagged captures"
|
||||||
|
'(* '1 '2 (% (* '1 (??) (<- 2 :tag) '3 (backref :tag) (??))))
|
||||||
|
"aksjndkajsnd"
|
||||||
|
@["a" "ks" "jndkajnd"]
|
||||||
|
(string/replace-all
|
||||||
|
# In case on windows someone messes with line endings.
|
||||||
|
"\r" ""
|
||||||
|
```
|
||||||
|
?? at [ndkajsnd] (index 4)
|
||||||
|
accumulate buffer: @"j"
|
||||||
|
stack [2]:
|
||||||
|
[0]: "a"
|
||||||
|
[1]: "ks"
|
||||||
|
tag stack [3]:
|
||||||
|
[0] tag=0: "a"
|
||||||
|
[1] tag=0: "ks"
|
||||||
|
[2] tag=0: "j"
|
||||||
|
?? at [snd] (index 9)
|
||||||
|
accumulate buffer: @"jndkajnd"
|
||||||
|
stack [2]:
|
||||||
|
[0]: "a"
|
||||||
|
[1]: "ks"
|
||||||
|
tag stack [6]:
|
||||||
|
[0] tag=0: "a"
|
||||||
|
[1] tag=0: "ks"
|
||||||
|
[2] tag=0: "j"
|
||||||
|
[3] tag=1: "nd"
|
||||||
|
[4] tag=0: "kaj"
|
||||||
|
[5] tag=0: "nd"
|
||||||
|
|
||||||
|
```))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
@@ -21,6 +21,9 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
# Disable linting warnings
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
# Regression Test #137
|
# Regression Test #137
|
||||||
# affcb5b45
|
# affcb5b45
|
||||||
(def [a b c] (range 10))
|
(def [a b c] (range 10))
|
||||||
|
|||||||
@@ -21,6 +21,9 @@
|
|||||||
(import ./helper :prefix "" :exit true)
|
(import ./helper :prefix "" :exit true)
|
||||||
(start-suite)
|
(start-suite)
|
||||||
|
|
||||||
|
# Disable linting warnings
|
||||||
|
(setdyn *lint-warn* :none)
|
||||||
|
|
||||||
# Set global variables to prevent some possible compiler optimizations
|
# Set global variables to prevent some possible compiler optimizations
|
||||||
# that defeat point of the test
|
# that defeat point of the test
|
||||||
# 2771171
|
# 2771171
|
||||||
|
|||||||
@@ -64,11 +64,11 @@
|
|||||||
# b9c0fc820
|
# b9c0fc820
|
||||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||||
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad)))
|
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([_err] :bad)))
|
||||||
"calling table too many arguments")
|
"calling table too many arguments")
|
||||||
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad)))
|
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([_err] :bad)))
|
||||||
"calling keyword too many arguments")
|
"calling keyword too many arguments")
|
||||||
(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops)))
|
(assert (= :oops (try ((+ 2 -1) 1) ([_err] :oops)))
|
||||||
"calling number fails")
|
"calling number fails")
|
||||||
|
|
||||||
# Method test
|
# Method test
|
||||||
@@ -119,7 +119,7 @@
|
|||||||
(with-dyns []
|
(with-dyns []
|
||||||
(ev/sleep 0)
|
(ev/sleep 0)
|
||||||
(error "oops")))
|
(error "oops")))
|
||||||
([err] :caught))))
|
([_err] :caught))))
|
||||||
"regression #638"))
|
"regression #638"))
|
||||||
|
|
||||||
#
|
#
|
||||||
|
|||||||
Binary file not shown.
@@ -87,7 +87,9 @@
|
|||||||
<Directory Id="BinDir" Name="bin"/>
|
<Directory Id="BinDir" Name="bin"/>
|
||||||
<Directory Id="CDir" Name="C"/>
|
<Directory Id="CDir" Name="C"/>
|
||||||
<Directory Id="DocsDir" Name="docs"/>
|
<Directory Id="DocsDir" Name="docs"/>
|
||||||
<Directory Id="LibraryDir" Name="Library"/>
|
<Directory Id="LibraryDir" Name="Library">
|
||||||
|
<Directory Id="LibBinDir" Name="bin"/>
|
||||||
|
</Directory>
|
||||||
</Directory>
|
</Directory>
|
||||||
</Directory>
|
</Directory>
|
||||||
<Directory Id="ProgramMenuFolder">
|
<Directory Id="ProgramMenuFolder">
|
||||||
@@ -169,6 +171,7 @@
|
|||||||
<Component Id="SetEnvVarsPerMachine" Directory="ApplicationProgramsFolder" Guid="57b1e1ef-89c8-4ce4-9f0f-37618677c5a4" KeyPath="yes">
|
<Component Id="SetEnvVarsPerMachine" Directory="ApplicationProgramsFolder" Guid="57b1e1ef-89c8-4ce4-9f0f-37618677c5a4" KeyPath="yes">
|
||||||
<Condition>ALLUSERS=1</Condition>
|
<Condition>ALLUSERS=1</Condition>
|
||||||
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
|
<Environment Id="PATH_PERMACHINE" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
|
||||||
|
<Environment Id="PATH2_PERMACHINE" Name="PATH" Value="[LibBinDir]" Action="set" Permanent="no" System="yes" Part="last"/>
|
||||||
<Environment Id="JANET_BINPATH_PERMACHINE" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="yes"/>
|
<Environment Id="JANET_BINPATH_PERMACHINE" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="yes"/>
|
||||||
<Environment Id="JANET_MANPATH_PERMACHINE" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="yes"/>
|
<Environment Id="JANET_MANPATH_PERMACHINE" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="yes"/>
|
||||||
<Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
|
<Environment Id="JANET_PATH_PERMACHINE" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="yes" />
|
||||||
@@ -178,6 +181,7 @@
|
|||||||
<Component Id="SetEnvVarsPerUser" Directory="ApplicationProgramsFolder" Guid="128be307-488b-49aa-971a-d2ae00a1a584" KeyPath="yes">
|
<Component Id="SetEnvVarsPerUser" Directory="ApplicationProgramsFolder" Guid="128be307-488b-49aa-971a-d2ae00a1a584" KeyPath="yes">
|
||||||
<Condition>NOT ALLUSERS=1</Condition>
|
<Condition>NOT ALLUSERS=1</Condition>
|
||||||
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
|
<Environment Id="PATH_PERUSER" Name="PATH" Value="[BinDir]" Action="set" Permanent="no" System="no" Part="last"/>
|
||||||
|
<Environment Id="PATH2_PERUSER" Name="PATH" Value="[LibBinDir]" Action="set" Permanent="no" System="no" Part="last"/>
|
||||||
<Environment Id="JANET_BINPATH_PERUSER" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="no"/>
|
<Environment Id="JANET_BINPATH_PERUSER" Name="JANET_BINPATH" Value="[BinDir]" Action="set" Permanent="no" System="no"/>
|
||||||
<Environment Id="JANET_MANPATH_PERUSER" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="no"/>
|
<Environment Id="JANET_MANPATH_PERUSER" Name="JANET_MANPATH" Value="[DocsDir]" Action="set" Permanent="no" System="no"/>
|
||||||
<Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />
|
<Environment Id="JANET_PATH_PERUSER" Name="JANET_PATH" Value="[LibraryDir]" Action="set" Permanent="no" System="no" />
|
||||||
|
|||||||
Reference in New Issue
Block a user