1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-22 02:04:49 +00:00

Compare commits

...

92 Commits

Author SHA1 Message Date
Calvin Rose
5adfb75a25 Revert some changes. 2024-12-19 18:59:53 -06:00
Calvin Rose
611b2a6c3a Add more test cases for #1535 2024-12-19 18:37:51 -06:00
Calvin Rose
8043caf581 Update CHANGELOG. 2024-12-19 18:31:05 -06:00
Calvin Rose
b2d2690eb9 Merge pull request #1534 from pyrmont/bugfix.windows-longstrings
Support dedenting long-strings with Windows EOLs
2024-12-19 16:24:21 -08:00
Calvin Rose
7f745a34c3 Allow for mutable keys correctly in deep= 2024-12-19 18:20:05 -06:00
Calvin Rose
b16cf17246 Merge pull request #1533 from pyrmont/feature.file-socket
Add `ev/to-file` for synchronous resource operations
2024-12-17 20:50:47 -08:00
Michael Camilleri
67e8518ba6 Support dedenting longstrings with Windows EOLs 2024-12-17 05:14:59 +09:00
Michael Camilleri
e94e8dc484 Remove special casing for MinGW 2024-12-16 08:12:14 +09:00
Michael Camilleri
1a24d4fc86 Raise error if using ev/to-file on MinGW 2024-12-15 21:00:52 +09:00
Michael Camilleri
6ee05785d1 Disable buffering for files created with ev/to-file 2024-12-15 20:37:58 +09:00
Michael Camilleri
268ff666d2 Move <fcntl.h> header to general imports 2024-12-15 20:02:41 +09:00
Michael Camilleri
91bb34c3bf Add missing <io.h> header for Windows 2024-12-15 19:17:48 +09:00
Michael Camilleri
17d5fb3210 Fix ev/to-file on Windows 2024-12-15 18:56:35 +09:00
Michael Camilleri
687b987f7e Add ev/to-file for synchronous resource operations 2024-12-15 17:38:01 +09:00
Calvin Rose
4daecc9a41 Prevent await inside janet_call - address #1531
This was partially implemented before, but not in the case where the
await or other signal itself was created by a C function. We have to
separate code paths for generating signals - one via normal returns in
janet_vm_continue, and the other via longjump. This adds handling for
the longjump case, as well as improved messaging.
2024-12-14 10:34:36 -06:00
Calvin Rose
a85eacadda Merge pull request #1532 from strangepete/fstat-directory-test
file/open: check if directory
2024-12-14 06:00:41 -08:00
peteee
ed63987fd1 use fileno()
Should use fileno() instead of direct
2024-12-14 07:17:28 -05:00
peteee
ff173047f4 file/open: check if directory
Adds fstat() directory test after fopen(), which can return non-NULL when passed a directory name on Linux
2024-12-13 00:20:44 -05:00
Calvin Rose
83e8aab289 Prepare for 1.37.1 release and fix CI. 2024-12-05 20:18:16 -06:00
Calvin Rose
85cb35e68f Prepare for 1.37.0 release. 2024-12-05 17:51:06 -06:00
Calvin Rose
5b79b48ae0 Address #1524 - fix meson cross compilation linking.
In the cross compilation case, we need to resolve our
dependencies on libc twice, once for the build machine and once for the
target machine. This includes pthreads, -libc, and android-spawn.
2024-12-03 21:05:37 -06:00
Calvin Rose
7c44127bcb Merge pull request #1526 from sogaiu/master
Additional tweak to address #1523
2024-12-02 05:46:00 -08:00
sogaiu
9338312103 Additional tweak to address #1523 2024-12-02 11:21:56 +09:00
Calvin Rose
a0eeb630e7 Correct documentation for issue #1523
net/* API documentation was not consistent with the implementation. The
`ev/*` module documentation was, however. On timeout, all networking
function calls raise an error and do not return nil. That was the old
behavior.
2024-12-01 09:04:03 -06:00
Calvin Rose
6535d72bd4 Merge pull request #1522 from sogaiu/remove-pstatus
Remove unused var pstatus
2024-11-25 06:15:43 -08:00
sogaiu
a7d424bc81 Remove unused var pstatus 2024-11-25 12:39:53 +09:00
Calvin Rose
2bceba4a7a Assertf with no arguments does not make sense. 2024-11-24 19:14:18 -06:00
Calvin Rose
e3159bb0f5 Update CHANGELOG.md 2024-11-23 10:29:03 -06:00
Calvin Rose
5d1bd8a932 Add an extra has mix round to string hashes.
This should improve hashing quality of strings.
2024-11-17 11:31:12 -06:00
Calvin Rose
bafa6bfff0 Merge pull request #1519 from ianthehenry/fix-string-equal-with-byteview
fix janet_string_equalconst
2024-11-17 07:33:47 -08:00
Ian Henry
e2eb7ab4b2 fix janet_string_equalconst
Check string length before pointer equality, so that a string is not considered
equal to a prefix slice of itself.
2024-11-16 21:20:26 -08:00
Calvin Rose
9f4497a5ae Merge pull request #1518 from pyrmont/bugfix.s390x-workflow
Update Docker command to use `--platform` flag
2024-11-11 12:24:20 -08:00
Michael Camilleri
70de8bf092 Update Docker command to use --platform flag 2024-11-12 04:02:54 +09:00
Calvin Rose
e52575e23a Merge pull request #1517 from sogaiu/add-assertf
Add assertf and use in boot.janet. Address #1516
2024-10-31 07:27:05 -07:00
sogaiu
10994cbc6a Add some tests for assertf 2024-10-30 23:41:31 +09:00
sogaiu
abad9d7db9 Add assertf and use in boot.janet. Address #1516 2024-10-30 17:43:00 +09:00
Calvin Rose
5e443cd29d Merge pull request #1514 from ArtSin/fix-formatb-int32_t-arg
Cast arguments to `int32_t` before passing to `janet_formatb` with `%d` format specifier
2024-10-25 05:36:08 -07:00
Calvin Rose
7bf3a9d24c Merge pull request #1515 from sogaiu/tweak-install-info-in-readme
Clarify installation info a bit
2024-10-25 05:34:53 -07:00
sogaiu
d80a7094ae Clarify installation info a bit 2024-10-25 20:04:56 +09:00
ArtSin
ad77bc391c Cast arguments to int32_t before passing to janet_formatb with %d format specifier
`s->line` and `s->column` in `delim_error` are `size_t`, which is typically 64-bit, but `va_arg` in `janet_formatbv` reads `int32_t` for `%d`.
2024-10-20 12:03:40 +04:00
Calvin Rose
2b84fb14b4 Fix Issue #1512 2024-10-18 18:17:06 -05:00
Calvin Rose
07155ce657 Don't error on empty struct. 2024-10-18 17:53:21 -05:00
Calvin Rose
046d28662d Merge pull request #1513 from sogaiu/add-nth-and-only-tags-to-changelog
Mention nth and only-tags in changelog
2024-10-18 05:45:36 -07:00
sogaiu
84dd3db620 Mention nth and only-tags in changelog 2024-10-16 14:16:05 +09:00
Calvin Rose
282f2671ea Formatting. 2024-10-11 20:10:46 -05:00
Calvin Rose
3fc2be3e6e Use _Exit since it is standard in c99 2024-10-11 20:10:04 -05:00
Calvin Rose
d10c1fe759 Use msvc compiler intrinsics for atomics.
This will let us use GCC atomics on mingw.
2024-10-11 20:03:06 -05:00
Calvin Rose
d18472b07d More CI testing - add meson min build for windows. 2024-10-10 20:42:12 -05:00
Calvin Rose
43a68dcd2a Include windows.h for atomics always in capi.c 2024-10-10 20:32:28 -05:00
Calvin Rose
3d93028088 Test bundle 2024-10-05 12:37:23 -05:00
Calvin Rose
99f0af92bd Fix bundle/install with :check true installation failure. 2024-10-05 12:34:10 -05:00
Calvin Rose
71d81b14a2 Setting a profile will mess with imports. 2024-10-05 12:13:44 -05:00
Calvin Rose
3894f4021a Update copyright date. 2024-09-29 16:07:24 -05:00
Calvin Rose
72c659d1ee Github has fewer runners than I thought. 2024-09-29 07:17:28 -05:00
Calvin Rose
8f879b4adc Remove financial support link. 2024-09-29 07:15:56 -05:00
Calvin Rose
18f2847dc1 Add test for older windows. 2024-09-29 07:14:31 -05:00
Calvin Rose
89b7ff9daf Merge pull request #1510 from sogaiu/badge-swap
Replace gitter badge with zulip one
2024-09-27 17:52:16 -07:00
sogaiu
26c263d6be Replace gitter badge with zulip one 2024-09-25 23:45:04 +09:00
Calvin Rose
2570e0f7a0 Add *repl-prompt*. 2024-09-21 08:58:04 -05:00
Calvin Rose
8084e4c728 Add support for multiple directories in JANET_PATH.
Use a colon ":" as the separator on posix, and semicolon ";" on
windows (and mingw).
2024-09-20 23:05:02 -05:00
Calvin Rose
ee90f9df62 Merge pull request #1506 from sogaiu/tweak-signal-doc
Add some detail to signal docstring
2024-09-18 16:50:13 -07:00
sogaiu
906a982ace Add some detail to signal docstring 2024-09-17 20:04:16 +09:00
Calvin Rose
88e60c309c Add overflow check. 2024-09-12 17:28:53 -05:00
Calvin Rose
9694aee819 Add rules for nth and only-tags. Address #1503
These rules allow selecting from a number of sub-captures
while dropping the rest. `nth` is more succinct in many cases, but `only-tags` is
more general and corresponds to an internal mechanism already present.
2024-09-12 17:23:34 -05:00
Calvin Rose
2697b0e425 More CI testing.
Add multiple windows versions, and differentiate between arm and intel
macs.
2024-09-08 20:55:10 -05:00
Calvin Rose
c0d7a49b19 Prepare for 1.36.0 release. 2024-09-07 12:33:28 -05:00
Calvin Rose
f9a6f52d9c Improve error messages even more for copyfile. 2024-09-07 10:02:26 -05:00
Calvin Rose
c02c2e3f02 Update CHANGELOG.md 2024-09-07 09:32:42 -05:00
Calvin Rose
1fcd47dd7b Improve error messages in bundle/add if files are missing.
Instead of cryptic "error: unknown method :close invoked on nil" errors, let
user know file or path does not exist before failing to copy files.
2024-09-07 09:19:15 -05:00
Calvin Rose
384ee4f6a9 Merge pull request #1498 from sogaiu/remove-janet-def
Don't try to copy janet.def
2024-09-06 17:03:25 -07:00
Calvin Rose
e9deec8231 Change directory before running make ... 2024-09-06 18:35:50 -05:00
Calvin Rose
2fc77a1b63 Tweak argumnets. 2024-09-06 18:31:57 -05:00
Calvin Rose
442fe8209d Non interative run for qemu 2024-09-06 18:29:36 -05:00
Calvin Rose
968a0dc4ac Follow github directions for qemu multiarch. 2024-09-06 18:28:00 -05:00
Calvin Rose
40c93d0786 Try using just scripts for testing. 2024-09-06 18:23:55 -05:00
Calvin Rose
83b0bc688c Try running inside a container. 2024-09-06 18:05:03 -05:00
sogaiu
6185b253be Don't try to copy janet.def 2024-09-07 00:57:13 +09:00
Calvin Rose
17da53d0d9 Add github workflow for qemu + s390x 2024-09-06 10:28:54 -05:00
Calvin Rose
9ffec43d2b Fix endianess issues on s390x architecture.
Endianess code should use memcpy instead of unions. This apparently
is more correct on old, optimizing compilers. Technically, this is
compilers being really stupid but we work with what we got.

That said, this endianess code is more complicated than needed.
2024-09-06 10:23:31 -05:00
Calvin Rose
e4f4a42751 Add regression test for chat server issues. Address #1496 2024-09-06 08:05:56 -05:00
Calvin Rose
4f65c2707e Undo workaround for unsetting reference from streams -> fibers after
async event completes. Moves this logic back into janet_async_end.
2024-09-06 00:20:50 -05:00
Calvin Rose
75bdea5155 Fix memory leak with weak table frees.
The backing buffer for weak arrays and tables was not freed upon
being garbage collected. This shows up in traces and valgrind. Verified
by running `make valtest` with changes.
2024-09-06 00:15:17 -05:00
Calvin Rose
f553c5da47 Update ev.c with workaround for failing chat server.
2 issues:
- With poll backend, we were polling for writes even after we finished
  writing. Presents as wasting a lot of CPU.
- Fixes  strange closing behavior of chat server.
2024-09-06 00:00:09 -05:00
Calvin Rose
5f70a85f7e Add chat server example. 2024-09-05 23:09:02 -05:00
Calvin Rose
c82fd106a7 Merge pull request #1494 from pyrmont/bugfix.changelog 2024-09-04 18:31:21 -07:00
Michael Camilleri
0e9b866b98 Move unreleased change out of v1.35.2 section 2024-09-05 08:29:45 +09:00
Calvin Rose
67a8c6df09 Merge pull request #1492 from sogaiu/tweak-changelog
Move bundle/add-bin changelog line to unreleased
2024-09-04 05:39:30 -07:00
sogaiu
86cf8127b6 Move bundle/add-bin changelog line to unreleased 2024-09-04 17:47:10 +09:00
Calvin Rose
828e0a07cd Don't check for docstrings when explicitly disabled. 2024-08-31 17:23:28 -05:00
Calvin Rose
90018b35c0 Begin standardizing of event properties for filewatch.
- `:file-name` for the name of the file that triggered the event.
- `:dir-name` for the containing directory of the file
- `:type` for the event type.
2024-08-31 14:26:08 -05:00
Calvin Rose
5a199716cb Save :source-form in environment when debugging is enabled. 2024-08-29 21:12:53 -05:00
Calvin Rose
43ecd4f2d8 Add fixes for marshalling weak containers - Fix #1488
Weak containers did not preserve their weakness when marshalled. This
fixes that for tables and arrays, as well as adds some tests for this.
Also exposes functions for creating weak tables in janet.h
2024-08-22 19:37:41 -05:00
84 changed files with 1274 additions and 492 deletions

View File

@@ -19,3 +19,8 @@ tasks:
ninja ninja
ninja test ninja test
sudo ninja install sudo ninja install
- meson_min: |
cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
cd build_meson_min
ninja

View File

@@ -17,7 +17,7 @@ jobs:
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
strategy: strategy:
matrix: matrix:
os: [ ubuntu-latest, macos-latest ] os: [ ubuntu-latest, macos-13 ]
steps: steps:
- name: Checkout the repository - name: Checkout the repository
uses: actions/checkout@master uses: actions/checkout@master
@@ -39,6 +39,35 @@ jobs:
build/c/janet.c build/c/janet.c
build/c/shell.c build/c/shell.c
release-arm:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ macos-latest ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=$(tr '[A-Z]' '[a-z]' <<< $RUNNER_OS)" >> $GITHUB_ENV
- name: Compile the project
run: make clean && make
- name: Build the artifact
run: JANET_DIST_DIR=janet-${{ env.version }}-${{ env.platform }} make build/janet-${{ env.version }}-${{ env.platform }}-aarch64.tar.gz
- name: Draft the release
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
build/*.gz
build/janet.h
build/c/janet.c
build/c/shell.c
release-windows: release-windows:
permissions: permissions:
contents: write # for softprops/action-gh-release to create GitHub release contents: write # for softprops/action-gh-release to create GitHub release

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
strategy: strategy:
matrix: matrix:
os: [ ubuntu-latest, macos-latest ] os: [ ubuntu-latest, macos-latest, macos-13 ]
steps: steps:
- name: Checkout the repository - name: Checkout the repository
uses: actions/checkout@master uses: actions/checkout@master
@@ -23,7 +23,10 @@ jobs:
test-windows: test-windows:
name: Build and test on Windows name: Build and test on Windows
runs-on: windows-latest strategy:
matrix:
os: [ windows-latest, windows-2019 ]
runs-on: ${{ matrix.os }}
steps: steps:
- name: Checkout the repository - name: Checkout the repository
uses: actions/checkout@master uses: actions/checkout@master
@@ -35,28 +38,61 @@ jobs:
- name: Test the project - name: Test the project
shell: cmd shell: cmd
run: build_win test run: build_win test
- name: Test installer build
shell: cmd
run: build_win dist
test-windows-min:
name: Build and test on Windows Minimal build
strategy:
matrix:
os: [ windows-2019 ]
runs-on: ${{ matrix.os }}
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup MSVC
uses: ilammy/msvc-dev-cmd@v1
- name: Setup Python
uses: actions/setup-python@v2
with:
python-version: '3.x'
- name: Install Python Dependencies
run: pip install meson ninja
- name: Build
shell: cmd
run: |
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dreduced_os=true -Dffi=false
cd build_meson_min
ninja
test-mingw: test-mingw:
name: Build on Windows with Mingw (no test yet) name: Build on Windows with Mingw
runs-on: windows-latest runs-on: windows-latest
defaults: defaults:
run: run:
shell: msys2 {0} shell: msys2 {0}
strategy:
matrix:
msystem: [ UCRT64, CLANG64 ]
steps: steps:
- name: Checkout the repository - name: Checkout the repository
uses: actions/checkout@master uses: actions/checkout@master
- name: Setup Mingw - name: Setup Mingw
uses: msys2/setup-msys2@v2 uses: msys2/setup-msys2@v2
with: with:
msystem: UCRT64 msystem: ${{ matrix.msystem }}
update: true update: true
install: >- install: >-
base-devel base-devel
git git
gcc gcc
- name: Build the project - name: Build
shell: cmd shell: cmd
run: make -j4 CC=gcc JANET_NO_AMALG=1 run: make -j4 CC=gcc
- name: Test
shell: cmd
run: make -j4 CC=gcc test
test-mingw-linux: test-mingw-linux:
name: Build and test with Mingw on Linux + Wine name: Build and test with Mingw on Linux + Wine
@@ -86,6 +122,17 @@ jobs:
sudo apt-get update sudo apt-get update
sudo apt-get install gcc-arm-linux-gnueabi qemu-user sudo apt-get install gcc-arm-linux-gnueabi qemu-user
- name: Compile the project - name: Compile the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
- name: Test the project - name: Test the project
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1 run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
test-s390x-linux:
name: Build and test s390x in qemu
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Do Qemu build and test
run: |
docker run --rm --privileged multiarch/qemu-user-static --reset -p yes
docker run --rm -v .:/janet --platform linux/s390x ubuntu bash -c "apt-get -y update && apt-get -y install git build-essential && cd /janet && make -j3 && make test"

View File

@@ -1,18 +1,45 @@
# 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 - ??? ## ??? - Unreleased
- Add experimental `filewatch/` module for listening to file system changes. - Add `struct/rawget` to get values from a struct without a prototype.
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys. Keys are now compared by value rather than
structure to avoid degenerate cases.
- Long strings will now dedent on `\r\n` instead of just `\n`.
- Add `ev/to-file` for synchronous resource operations
## 1.37.1 - 2024-12-05
- Fix meson cross compilation
- Update timeout documentation for networking APIs: timeouts raise errors and do not return nil.
- Add `janet_addtimeout_nil(double sec);` to the C API.
- Change string hashing.
- Fix string equality bug.
- Add `assertf`
- Change how JANET_PROFILE is loaded to allow more easily customizing the environment.
- Add `*repl-prompt*` dynamic binding to allow customizing the built in repl.
- Add multiple path support in the `JANET_PATH` environment variables. This lets
user more easily import modules from many directories.
- Add `nth` and `only-tags` PEG specials to select from sub-captures while
dropping the rest.
## 1.36.0 - 2024-09-07
- Improve error messages in `bundle/add*` functions.
- Add CI testing and verify tests pass on the s390x architecture.
- Save `:source-form` in environment entries when `*debug*` is set.
- Add experimental `filewatch/` module for listening to file system changes on Linux and Windows.
- Add `bundle/who-is` to query which bundle a file on disk was installed by. - Add `bundle/who-is` to query which bundle a file on disk was installed by.
- Add `geomean` function - Add `geomean` function
- Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems. - Add `:R` and `:W` flags to `os/pipe` to create blocking pipes on Posix and Windows systems.
These streams cannot be directly read to and written from, but can be passed to subprocesses. These streams cannot be directly read to and written from, but can be passed to subprocesses.
- Add `array/join` - Add `array/join`
- Add `tuple/join` - Add `tuple/join`
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
- Fix marshalling weak tables and weak arrays.
- Fix bug in `ev/` module that could accidentally close sockets on accident.
- Expose C functions for constructing weak tables in janet.h
- Let range take non-integer values.
## 1.35.2 - 2024-06-16 ## 1.35.2 - 2024-06-16
- Add `bundle/add-bin` to make installing scripts easier. This also establishes a packaging convention for it.
- Let range take non-integer values.
- Fix some documentation typos. - Fix some documentation typos.
- Allow using `:only` in import without quoting. - Allow using `:only` in import without quoting.

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose # Copyright (c) 2024 Calvin Rose
# #
# Permission is hereby granted, free of charge, to any person obtaining a copy # Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to # of this software and associated documentation files (the "Software"), to
@@ -43,6 +43,7 @@ JANET_DIST_DIR?=janet-dist
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)' JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
JANET_TARGET_OBJECTS=build/janet.o build/shell.o JANET_TARGET_OBJECTS=build/janet.o build/shell.o
JPM_TAG?=master JPM_TAG?=master
SPORK_TAG?=master
HAS_SHARED?=1 HAS_SHARED?=1
DEBUGGER=gdb DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname, SONAME_SETTER=-Wl,-soname,
@@ -205,9 +206,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
######################## ########################
ifeq ($(UNAME), Darwin) ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.35.dylib SONAME=libjanet.1.37.dylib
else else
SONAME=libjanet.so.1.35 SONAME=libjanet.so.1.37
endif endif
build/c/shell.c: src/mainclient/shell.c build/c/shell.c: src/mainclient/shell.c
@@ -359,6 +360,12 @@ install-jpm-git: $(JANET_TARGET)
JANET_LIBPATH='$(LIBDIR)' \ JANET_LIBPATH='$(LIBDIR)' \
$(RUN) ../../$(JANET_TARGET) ./bootstrap.janet $(RUN) ../../$(JANET_TARGET) ./bootstrap.janet
install-spork-git: $(JANET_TARGET)
mkdir -p build
rm -rf build/spork
git clone --depth=1 --branch='$(SPORK_TAG)' https://github.com/janet-lang/spork.git build/spork
$(JANET_TARGET) -e '(bundle/install "build/spork")'
uninstall: uninstall:
-rm '$(DESTDIR)$(BINDIR)/janet' -rm '$(DESTDIR)$(BINDIR)/janet'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet' -rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'

View File

@@ -1,4 +1,4 @@
[![Join the chat](https://badges.gitter.im/janet-language/community.svg)](https://gitter.im/janet-language/community) [![Join the chat](https://img.shields.io/badge/zulip-join_chat-brightgreen.svg)](https://janet.zulipchat.com)
&nbsp; &nbsp;
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?) [![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?) [![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/master/openbsd.yml?)
@@ -18,9 +18,6 @@ to run script files. This client program is separate from the core runtime, so
Janet can be embedded in other programs. Try Janet in your browser at Janet can be embedded in other programs. Try Janet in your browser at
<https://janet-lang.org>. <https://janet-lang.org>.
If you'd like to financially support the ongoing development of Janet, consider
[sponsoring its primary author](https://github.com/sponsors/bakpakin) through GitHub.
<br> <br>
## Examples ## Examples
@@ -253,8 +250,10 @@ Emacs, and Atom each have syntax packages for the Janet language, though.
## Installation ## Installation
See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want If you just want to try out the language, you don't need to install anything.
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it. In this case you can also move the `janet` executable wherever you want on
your system and run it. However, for a fuller setup, please see the
[Introduction](https://janet-lang.org/docs/index.html) for more details.
## Usage ## Usage

View File

@@ -121,7 +121,6 @@ copy README.md dist\README.md
copy janet.lib dist\janet.lib copy janet.lib dist\janet.lib
copy janet.exp dist\janet.exp copy janet.exp dist\janet.exp
copy janet.def dist\janet.def
janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h janet.exe tools\patch-header.janet src\include\janet.h src\conf\janetconf.h build\janet.h
copy build\janet.h dist\janet.h copy build\janet.h dist\janet.h
@@ -139,7 +138,8 @@ if defined APPVEYOR_REPO_TAG_NAME (
set RELEASE_VERSION=%JANET_VERSION% set RELEASE_VERSION=%JANET_VERSION%
) )
if defined CI ( if defined CI (
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\" set WIXBIN="%WIX%bin\"
echo WIXBIN = %WIXBIN%
) else ( ) else (
set WIXBIN= set WIXBIN=
) )

35
examples/chatserver.janet Normal file
View File

@@ -0,0 +1,35 @@
(def conmap @{})
(defn broadcast [em msg]
(eachk par conmap
(if (not= par em)
(if-let [tar (get conmap par)]
(net/write tar (string/format "[%s]:%s" em msg))))))
(defn handler
[connection]
(print "connection: " connection)
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(print name " connected")
(if (get conmap name)
(do
(net/write connection "Name already taken!")
(:close connection))
(do
(put conmap name connection)
(net/write connection (string/format "Welcome %s\n" name))
(defer (do
(put conmap name nil)
(:close connection))
(while (def msg (ev/read connection 100))
(broadcast name (string msg)))
(print name " disconnected")))))
(defn main [& args]
(printf "STARTING SERVER...")
(flush)
(def my-server (net/listen "127.0.0.1" "8000"))
(forever
(def connection (net/accept my-server))
(ev/call handler connection)))

View File

@@ -0,0 +1 @@
(def abc 123)

View File

@@ -0,0 +1,7 @@
(defn install
[manifest &]
(bundle/add-file manifest "badmod.janet"))
(defn check
[&]
(error "Check failed!"))

View File

@@ -255,7 +255,8 @@ and then arguments to the script.
.RS .RS
The location to look for Janet libraries. This is the only environment variable Janet needs to The location to look for Janet libraries. This is the only environment variable Janet needs to
find native and source code modules. If no JANET_PATH is set, Janet will look in find native and source code modules. If no JANET_PATH is set, Janet will look in
the default location set at compile time. the default location set at compile time. This should be a list of as well as a colon
separate list of such directories.
.RE .RE
.B JANET_PROFILE .B JANET_PROFILE

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose and contributors # Copyright (c) 2024 Calvin Rose and contributors
# #
# Permission is hereby granted, free of charge, to any person obtaining a copy # Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to # of this software and associated documentation files (the "Software"), to
@@ -20,14 +20,23 @@
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.35.2') version : '1.37.1')
# 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')
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet') header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
# Link math library on all systems # Compilers
cc = meson.get_compiler('c') cc = meson.get_compiler('c')
native_cc = meson.get_compiler('c', native : true)
# Native deps
native_m_dep = native_cc.find_library('m', required : false)
native_dl_dep = native_cc.find_library('dl', required : false)
native_android_spawn_dep = native_cc.find_library('android-spawn', required : false)
native_thread_dep = dependency('threads', native : true)
# Deps
m_dep = cc.find_library('m', required : false) m_dep = cc.find_library('m', required : false)
dl_dep = cc.find_library('dl', required : false) dl_dep = cc.find_library('dl', required : false)
android_spawn_dep = cc.find_library('android-spawn', required : false) android_spawn_dep = cc.find_library('android-spawn', required : false)
@@ -164,11 +173,18 @@ mainclient_src = [
'src/mainclient/shell.c' 'src/mainclient/shell.c'
] ]
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
janet_native_dependencies += native_thread_dep
endif
# Build boot binary # Build boot binary
janet_boot = executable('janet-boot', core_src, boot_src, janet_boot = executable('janet-boot', core_src, boot_src,
include_directories : incdir, include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP', c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep], dependencies : janet_native_dependencies,
native : true) native : true)
# Build janet.c # Build janet.c
@@ -181,11 +197,6 @@ janetc = custom_target('janetc',
'JANET_PATH', janet_path 'JANET_PATH', janet_path
]) ])
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
# Allow building with no shared library # Allow building with no shared library
if cc.has_argument('-fvisibility=hidden') if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden'] lib_cflags = ['-fvisibility=hidden']
@@ -231,7 +242,7 @@ if meson.is_cross_build()
endif endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src, janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir, include_directories : incdir,
dependencies : janet_dependencies, dependencies : janet_native_dependencies,
c_args : extra_native_cflags, c_args : extra_native_cflags,
native : true) native : true)
else else

View File

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

View File

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

View File

@@ -39,6 +39,7 @@
(buffer/format buf "%j" (in args index)) (buffer/format buf "%j" (in args index))
(set index (+ index 1))) (set index (+ index 1)))
(array/push modifiers (string buf ")\n\n" docstr)) (array/push modifiers (string buf ")\n\n" docstr))
(if (dyn :debug) (array/push modifiers {:source-form (dyn :macro-form)}))
# Build return value # Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start))))) ~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
@@ -203,6 +204,16 @@
[fmt & args] [fmt & args]
(error (string/format fmt ;args))) (error (string/format fmt ;args)))
(defmacro assertf
"Convenience macro that combines `assert` and `string/format`."
[x fmt & args]
(def v (gensym))
~(do
(def ,v ,x)
(if ,v
,v
(,errorf ,fmt ,;args))))
(defmacro default (defmacro default
``Define a default value for an optional argument. ``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.`` Expands to `(def sym (if (= nil sym) val sym))`.``
@@ -1852,6 +1863,9 @@
(defdyn *pretty-format* (defdyn *pretty-format*
"Format specifier for the `pp` function") "Format specifier for the `pp` function")
(defdyn *repl-prompt*
"Allow setting a custom prompt at the default REPL. Not all REPLs will respect this binding.")
(defn pp (defn pp
``Pretty-print to stdout or `(dyn *out*)`. The format string used is `(dyn *pretty-format* "%q")`.`` ``Pretty-print to stdout or `(dyn *out*)`. The format string used is `(dyn *pretty-format* "%q")`.``
[x] [x]
@@ -2205,43 +2219,6 @@
(map-template :some res pred ind inds) (map-template :some res pred ind inds)
res) res)
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(case tx
:tuple (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:array (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:struct (deep-not= (kvs x) (kvs y))
:table (deep-not= (table/to-struct x) (table/to-struct y))
:buffer (not= (string x) (string y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn freeze (defn freeze
`Freeze an object (make it immutable) and do a deep copy, making `Freeze an object (make it immutable) and do a deep copy, making
child values also immutable. Closures, fibers, and abstract types child values also immutable. Closures, fibers, and abstract types
@@ -2270,6 +2247,43 @@
:string (buffer ds) :string (buffer ds)
ds)) ds))
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(cond
(or (= tx :tuple) (= tx :array))
(or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
(or (= tx :struct) (= tx :table))
(or (not= (length x) (length y))
(do
(def rawget (if (= tx :table) table/rawget struct/rawget))
(var ret false)
(eachp [k v] x
(def yv (rawget y k))
(if (= nil yv) (break (set ret true)))
(if (deep-not= yv v) (break (set ret true))))
ret))
(= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn macex (defn macex
``Expand macros completely. ``Expand macros completely.
`on-binding` is an optional callback for whenever a normal symbolic binding `on-binding` is an optional callback for whenever a normal symbolic binding
@@ -2651,7 +2665,6 @@
(do (do
(var pindex 0) (var pindex 0)
(var pstatus nil)
(def len (length buf)) (def len (length buf))
(when (= len 0) (when (= len 0)
(:eof p) (:eof p)
@@ -2826,6 +2839,24 @@
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative]) (array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
mp) mp)
# Don't expose this externally yet - could break if custom module/paths is setup.
(defn- module/add-syspath
```
Add a custom syspath to `module/paths` by duplicating all entries that being with `:sys:` and
adding duplicates with a specific path prefix instead.
```
[path]
(def copies @[])
(var last-index 0)
(def mp (dyn *module-paths* module/paths))
(eachp [index entry] mp
(def pattern (first entry))
(when (and (string? pattern) (string/has-prefix? ":sys:/" pattern))
(set last-index index)
(array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)])))
(array/insert mp (+ 1 last-index) ;copies)
mp)
(module/add-paths ":native:" :native) (module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source) (module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source) (module/add-paths ".janet" :source)
@@ -3912,7 +3943,7 @@
(defn make-sig [] (defn make-sig []
(ffi/signature :default real-ret-type ;computed-type-args)) (ffi/signature :default real-ret-type ;computed-type-args))
(defn make-ptr [] (defn make-ptr []
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol))) (assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
(if lazy (if lazy
~(defn ,alias ,;meta [,;formal-args] ~(defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args)) (,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
@@ -4055,15 +4086,18 @@
(defn- copyfile (defn- copyfile
[from to] [from to]
(def mode (os/stat from :permissions)) (if-with [ffrom (file/open from :rb)]
(def b (buffer/new 0x10000)) (if-with [fto (file/open to :wb)]
(with [ffrom (file/open from :rb)] (do
(with [fto (file/open to :wb)] (def perm (os/stat from :permissions))
(forever (def b (buffer/new 0x10000))
(file/read ffrom 0x10000 b) (forever
(when (empty? b) (buffer/trim b) (os/chmod to mode) (break)) (file/read ffrom 0x10000 b)
(file/write fto b) (when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
(buffer/clear b))))) (file/write fto b)
(buffer/clear b)))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "source file %s cannot be opened for reading" from)))
(defn- copyrf (defn- copyrf
[from to] [from to]
@@ -4086,7 +4120,7 @@
"Get the manifest for a give installed bundle" "Get the manifest for a give installed bundle"
[bundle-name] [bundle-name]
(def name (get-manifest-filename bundle-name)) (def name (get-manifest-filename bundle-name))
(assert (fexists name) (string "no bundle " bundle-name " found")) (assertf (fexists name) "no bundle %v found" bundle-name)
(parse (slurp name))) (parse (slurp name)))
(defn- get-bundle-module (defn- get-bundle-module
@@ -4229,11 +4263,9 @@
(def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d))) (def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
(when (next missing) (errorf "missing dependencies %s" (string/join missing ", ")))) (when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
(def bundle-name (get config :name default-bundle-name)) (def bundle-name (get config :name default-bundle-name))
(assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path)) (assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
(assert (not (string/check-set "\\/" bundle-name)) (assertf (not (string/check-set "\\/" bundle-name))
(string "bundle name " "bundle name %v cannot contain path separators" bundle-name)
bundle-name
" cannot contain path separators"))
(assert (next bundle-name) "cannot use empty bundle-name") (assert (next bundle-name) "cannot use empty bundle-name")
(assert (not (fexists (get-manifest-filename bundle-name))) (assert (not (fexists (get-manifest-filename bundle-name)))
"bundle is already installed") "bundle is already installed")
@@ -4270,10 +4302,10 @@
(do-hook module bundle-name :clean man)) (do-hook module bundle-name :clean man))
(do-hook module bundle-name :build man) (do-hook module bundle-name :build man)
(do-hook module bundle-name :install man) (do-hook module bundle-name :install man)
(when check
(do-hook module bundle-name :check man))
(if (empty? (get man :files)) (print "no files installed, is this a valid bundle?")) (if (empty? (get man :files)) (print "no files installed, is this a valid bundle?"))
(sync-manifest man)) (sync-manifest man)
(when check
(do-hook module bundle-name :check man)))
(print "installed " bundle-name) (print "installed " bundle-name)
bundle-name) bundle-name)
@@ -4285,7 +4317,7 @@
(var i 0) (var i 0)
(def man (bundle/manifest bundle-name)) (def man (bundle/manifest bundle-name))
(def files (get man :files @[])) (def files (get man :files @[]))
(assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)")) (assertf (os/mkdir dest-dir) "could not create directory %v (or it already exists)" dest-dir)
(def s (sep)) (def s (sep))
(os/mkdir (string dest-dir s "bundle")) (os/mkdir (string dest-dir s "bundle"))
(def install-hook (string dest-dir s "bundle" s "init.janet")) (def install-hook (string dest-dir s "bundle" s "init.janet"))
@@ -4381,12 +4413,15 @@
[manifest src &opt dest chmod-mode] [manifest src &opt dest chmod-mode]
(default dest src) (default dest src)
(def s (sep)) (def s (sep))
(case (os/stat src :mode) (def mode (os/stat src :mode))
(if-not mode (errorf "file %s does not exist" src))
(case mode
:directory :directory
(let [absdest (bundle/add-directory manifest dest chmod-mode)] (let [absdest (bundle/add-directory manifest dest chmod-mode)]
(each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode)) (each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode))
absdest) absdest)
:file (bundle/add-file manifest src dest chmod-mode))) :file (bundle/add-file manifest src dest chmod-mode)
(errorf "bad path %s - file is a %s" src mode)))
(defn bundle/add-bin (defn bundle/add-bin
`Shorthand for adding scripts during an install. Scripts will be installed to `Shorthand for adding scripts during an install. Scripts will be installed to
@@ -4481,7 +4516,12 @@
(var error-level nil) (var error-level nil)
(var expect-image false) (var expect-image false)
(if-let [jp (getenv-alias "JANET_PATH")] (setdyn *syspath* jp)) (when-let [jp (getenv-alias "JANET_PATH")]
(def path-sep (if (index-of (os/which) [:windows :mingw]) ";" ":"))
(def paths (reverse! (string/split path-sep jp)))
(for i 1 (length paths)
(module/add-syspath (get paths i)))
(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 (set colorize (and
(not (getenv-alias "NO_COLOR")) (not (getenv-alias "NO_COLOR"))
@@ -4613,17 +4653,15 @@
(if-not quiet (if-not quiet
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help")) (print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
(flush) (flush)
(def env (make-env))
(defn getprompt [p] (defn getprompt [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 _] (defn getstdin [prompt buf _]
(file/write stdout prompt) (file/write stdout prompt)
(file/flush stdout) (file/flush stdout)
(file/read stdin :line buf)) (file/read stdin :line buf))
(def env (make-env))
(when-let [profile.janet (dyn *profilepath*)]
(def new-env (dofile profile.janet :exit true))
(merge-module env new-env "" false))
(when debug-flag (when debug-flag
(put env *debug* true) (put env *debug* true)
(put env *redef* true)) (put env *redef* true))
@@ -4635,6 +4673,9 @@
(setdyn *doc-color* (if colorize true)) (setdyn *doc-color* (if colorize true))
(setdyn *lint-error* error-level) (setdyn *lint-error* error-level)
(setdyn *lint-warn* error-level) (setdyn *lint-warn* error-level)
(when-let [profile.janet (dyn *profilepath*)]
(dofile profile.janet :exit true :env env)
(put env *current-file* nil))
(repl getchunk nil env))))) (repl getchunk nil env)))))
### ###
@@ -4654,6 +4695,10 @@
(put flat :doc nil)) (put flat :doc nil))
(when (boot/config :no-sourcemaps) (when (boot/config :no-sourcemaps)
(put flat :source-map nil)) (put flat :source-map nil))
(unless (boot/config :no-docstrings)
(unless (v :private)
(unless (v :doc)
(errorf "no docs: %v %p" k v)))) # make sure we have docs
# Fix directory separators on windows to make image identical between windows and non-windows # Fix directory separators on windows to make image identical between windows and non-windows
(when-let [sm (get flat :source-map)] (when-let [sm (get flat :source-map)]
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)])) (put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))

View File

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

View File

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

View File

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

View File

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

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H #define JANETCONF_H
#define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 36 #define JANET_VERSION_MINOR 37
#define JANET_VERSION_PATCH 0 #define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA "-dev" #define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.36.0-dev" #define JANET_VERSION "1.37.1"
/* #define JANET_BUILD "local" */ /* #define JANET_BUILD "local" */

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -371,17 +371,15 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
janet_fixarity(argc, 3); janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1); int reverse = should_reverse_bytes(argv, 1);
union { uint16_t data = janet_getuinteger16(argv, 2);
uint16_t data; uint8_t bytes[sizeof(data)];
uint8_t bytes[2]; memcpy(bytes, &data, sizeof(bytes));
} u;
u.data = janet_getuinteger16(argv, 2);
if (reverse) { if (reverse) {
uint8_t temp = u.bytes[1]; uint8_t temp = bytes[1];
u.bytes[1] = u.bytes[0]; bytes[1] = bytes[0];
u.bytes[0] = temp; bytes[0] = temp;
} }
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes); janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0]; return argv[0];
} }
@@ -392,14 +390,12 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
janet_fixarity(argc, 3); janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1); int reverse = should_reverse_bytes(argv, 1);
union { uint32_t data = janet_getuinteger(argv, 2);
uint32_t data; uint8_t bytes[sizeof(data)];
uint8_t bytes[4]; memcpy(bytes, &data, sizeof(bytes));
} u;
u.data = janet_getuinteger(argv, 2);
if (reverse) if (reverse)
reverse_u32(u.bytes); reverse_u32(bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0]; return argv[0];
} }
@@ -410,14 +406,12 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
janet_fixarity(argc, 3); janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1); int reverse = should_reverse_bytes(argv, 1);
union { uint64_t data = janet_getuinteger64(argv, 2);
uint64_t data; uint8_t bytes[sizeof(data)];
uint8_t bytes[8]; memcpy(bytes, &data, sizeof(bytes));
} u;
u.data = janet_getuinteger64(argv, 2);
if (reverse) if (reverse)
reverse_u64(u.bytes); reverse_u64(bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0]; return argv[0];
} }
@@ -428,14 +422,12 @@ JANET_CORE_FN(cfun_buffer_push_float32,
janet_fixarity(argc, 3); janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1); int reverse = should_reverse_bytes(argv, 1);
union { float data = (float) janet_getnumber(argv, 2);
float data; uint8_t bytes[sizeof(data)];
uint8_t bytes[4]; memcpy(bytes, &data, sizeof(bytes));
} u;
u.data = (float) janet_getnumber(argv, 2);
if (reverse) if (reverse)
reverse_u32(u.bytes); reverse_u32(bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes); janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0]; return argv[0];
} }
@@ -446,14 +438,12 @@ JANET_CORE_FN(cfun_buffer_push_float64,
janet_fixarity(argc, 3); janet_fixarity(argc, 3);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
int reverse = should_reverse_bytes(argv, 1); int reverse = should_reverse_bytes(argv, 1);
union { double data = janet_getnumber(argv, 2);
double data; uint8_t bytes[sizeof(data)];
uint8_t bytes[8]; memcpy(bytes, &data, sizeof(bytes));
} u;
u.data = janet_getnumber(argv, 2);
if (reverse) if (reverse)
reverse_u64(u.bytes); reverse_u64(bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes); janet_buffer_push_bytes(buffer, bytes, sizeof(bytes));
return argv[0]; return argv[0];
} }

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -31,11 +31,13 @@
#ifndef JANET_SINGLE_THREADED #ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
#include <pthread.h> #include <pthread.h>
#else
#include <windows.h>
#endif #endif
#endif #endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
#ifdef JANET_USE_STDATOMIC #ifdef JANET_USE_STDATOMIC
#include <stdatomic.h> #include <stdatomic.h>
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations. /* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
@@ -60,6 +62,13 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
void janet_signalv(JanetSignal sig, Janet message) { void janet_signalv(JanetSignal sig, Janet message) {
if (janet_vm.return_reg != NULL) { if (janet_vm.return_reg != NULL) {
/* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */
if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) {
if (sig != JANET_SIGNAL_ERROR) {
message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig]));
}
sig = JANET_SIGNAL_ERROR;
}
*janet_vm.return_reg = message; *janet_vm.return_reg = message;
if (NULL != janet_vm.fiber) { if (NULL != janet_vm.fiber) {
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP; janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
@@ -546,8 +555,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
/* Atomic refcounts */ /* Atomic refcounts */
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) { JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS #ifdef _MSC_VER
return InterlockedIncrement(x); return _InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC) #elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1; return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#else #else
@@ -556,8 +565,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
} }
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) { JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS #ifdef _MSC_VER
return InterlockedDecrement(x); return _InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC) #elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1; return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#else #else
@@ -566,8 +575,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
} }
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) { JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS #ifdef _MSC_VER
return InterlockedOr(x, 0); return _InterlockedOr(x, 0);
#elif defined(JANET_USE_STDATOMIC) #elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire); return atomic_load_explicit(x, memory_order_acquire);
#else #else

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -700,7 +700,15 @@ JANET_CORE_FN(janet_core_is_lengthable,
JANET_CORE_FN(janet_core_signal, JANET_CORE_FN(janet_core_signal,
"(signal what x)", "(signal what x)",
"Raise a signal with payload x. ") { "Raise a signal with payload x. `what` can be an integer\n"
"from 0 through 7 indicating user(0-7), or one of:\n\n"
"* :ok\n"
"* :error\n"
"* :debug\n"
"* :yield\n"
"* :user(0-7)\n"
"* :interrupt\n"
"* :await") {
janet_arity(argc, 1, 2); janet_arity(argc, 1, 2);
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil(); Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
if (janet_checkint(argv[0])) { if (janet_checkint(argv[0])) {
@@ -993,12 +1001,12 @@ static void make_apply(JanetTable *env) {
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG, janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm), "apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n" JDOC("(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args " "Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to " "is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to " "be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n" "f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n" "\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000.")); "sums the first 10 integers and 1000."));
} }
static const uint32_t error_asm[] = { static const uint32_t error_asm[] = {
@@ -1151,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP, janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm), "cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n" JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater " "Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type.")); "than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT, janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm), "next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n" JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through " "Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed " "the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated " "to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next " "during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through.")); "returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP, janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm), "propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n" JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and " "Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal " "set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. " "value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include " "The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, " "frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. " "resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing " "This function can be used to re-raise an error without losing "
"the original stack trace.")); "the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG, janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm), "debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n" JDOC("(debug &opt x)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect " "Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume.")); "the running state of the current fiber. Returns the value passed in by resume."));
janet_quick_asm(env, JANET_FUN_ERROR, janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm), "error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n" JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber.")); "Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD, janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm), "yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n" JDOC("(yield &opt x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until " "Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will " "another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume.")); "return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL, janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm), "cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n" JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. " "Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume.")); "Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME, janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm), "resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n" JDOC("(resume fiber &opt x)\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that " "Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to " "will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of " "the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber.")); "the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_IN, janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm), "in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n" JDOC("(in ds key &opt dflt)\n\n"
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, " "Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, " "strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can " "and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found.")); "take any value as a key except nil and will return nil or dflt if not found."));
janet_quick_asm(env, JANET_FUN_GET, janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm), "get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
JDOC("(get ds key &opt dflt)\n\n" JDOC("(get ds key &opt dflt)\n\n"
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. " "Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure " "Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw " "unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error.")); "an error."));
janet_quick_asm(env, JANET_FUN_PUT, janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm), "put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n" JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures " "Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds " "(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra " "value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype " "space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting " "will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds.")); "a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH, janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm), "length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n" JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For " "Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure.")); "structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT, janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm), "bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x.")); JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@@ -1235,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */ /* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD, templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
JDOC("(+ & xs)\n\n" JDOC("(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0.")); "Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT, templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n" JDOC("(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the " "Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of " "negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements.")); "the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY, templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
JDOC("(* & xs)\n\n" JDOC("(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1.")); "Returns the product of all elements in xs. If xs is empty, returns 1."));
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE, templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
JDOC("(/ & xs)\n\n" JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns " "Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values.")); "values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR, templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n" JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns " "Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining " "the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values.")); "values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO, templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n" JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. " "Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`.")); "`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER, templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n" JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value.")); "Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND, templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n" JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR, templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
JDOC("(bor & xs)\n\n" JDOC("(bor & xs)\n\n"
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer.")); "Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR, templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
JDOC("(bxor & xs)\n\n" JDOC("(bxor & xs)\n\n"
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer.")); "Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT, templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n" JDOC("(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x " "Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT, templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n" JDOC("(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer.")); "and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED, templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n" JDOC("(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x " "Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so " "and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive.")); "for positive shifts the return value will always be positive."));
/* Variadic comparators */ /* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN, templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
JDOC("(> & xs)\n\n" JDOC("(> & xs)\n\n"
"Check if xs is in descending order. Returns a boolean.")); "Check if xs is in descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN, templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
JDOC("(< & xs)\n\n" JDOC("(< & xs)\n\n"
"Check if xs is in ascending order. Returns a boolean.")); "Check if xs is in ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL, templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
JDOC("(>= & xs)\n\n" JDOC("(>= & xs)\n\n"
"Check if xs is in non-ascending order. Returns a boolean.")); "Check if xs is in non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL, templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
JDOC("(<= & xs)\n\n" JDOC("(<= & xs)\n\n"
"Check if xs is in non-descending order. Returns a boolean.")); "Check if xs is in non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS, templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n" JDOC("(= & xs)\n\n"
"Check if all values in xs are equal. Returns a boolean.")); "Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS, templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n" JDOC("(not= & xs)\n\n"
"Check if any values in xs are not equal. Returns a boolean.")); "Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */ /* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION), janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@@ -1311,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program.")); JDOC("The build identifier of the running janet program."));
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS), janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
JDOC("The flag set of config options from janetconf.h which is used to check " JDOC("The flag set of config options from janetconf.h which is used to check "
"if native modules are compatible with the host program.")); "if native modules are compatible with the host program."));
/* Allow references to the environment */ /* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env), janet_def(env, "root-env", janet_wrap_table(env),

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -32,9 +32,11 @@
#ifdef JANET_EV #ifdef JANET_EV
#include <math.h> #include <math.h>
#include <fcntl.h>
#ifdef JANET_WINDOWS #ifdef JANET_WINDOWS
#include <winsock2.h> #include <winsock2.h>
#include <windows.h> #include <windows.h>
#include <io.h>
#else #else
#include <pthread.h> #include <pthread.h>
#include <limits.h> #include <limits.h>
@@ -43,7 +45,6 @@
#include <signal.h> #include <signal.h>
#include <sys/ioctl.h> #include <sys/ioctl.h>
#include <sys/types.h> #include <sys/types.h>
#include <fcntl.h>
#include <netinet/in.h> #include <netinet/in.h>
#include <netinet/tcp.h> #include <netinet/tcp.h>
#include <netdb.h> #include <netdb.h>
@@ -255,6 +256,12 @@ static void add_timeout(JanetTimeout to) {
void janet_async_end(JanetFiber *fiber) { void janet_async_end(JanetFiber *fiber) {
if (fiber->ev_callback) { if (fiber->ev_callback) {
if (fiber->ev_stream->read_fiber == fiber) {
fiber->ev_stream->read_fiber = NULL;
}
if (fiber->ev_stream->write_fiber == fiber) {
fiber->ev_stream->write_fiber = NULL;
}
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT); fiber->ev_callback(fiber, JANET_ASYNC_EVENT_DEINIT);
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream)); janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
fiber->ev_callback = NULL; fiber->ev_callback = NULL;
@@ -619,6 +626,18 @@ void janet_addtimeout(double sec) {
add_timeout(to); add_timeout(to);
} }
/* Set timeout for the current root fiber but resume with nil instead of raising an error */
void janet_addtimeout_nil(double sec) {
JanetFiber *fiber = janet_vm.root_fiber;
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = fiber;
to.curr_fiber = NULL;
to.sched_id = fiber->sched_id;
to.is_error = 0;
add_timeout(to);
}
void janet_ev_inc_refcount(void) { void janet_ev_inc_refcount(void) {
janet_atomic_inc(&janet_vm.listener_count); janet_atomic_inc(&janet_vm.listener_count);
} }
@@ -2361,6 +2380,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
} else { } else {
janet_schedule(fiber, janet_wrap_nil()); janet_schedule(fiber, janet_wrap_nil());
} }
stream->read_fiber = NULL;
janet_async_end(fiber); janet_async_end(fiber);
break; break;
} }
@@ -3256,6 +3276,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
return argv[0]; return argv[0];
} }
static JanetFile *get_file_for_stream(JanetStream *stream) {
int32_t flags = 0;
char fmt[4] = {0};
int index = 0;
if (stream->flags & JANET_STREAM_READABLE) {
flags |= JANET_FILE_READ;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
fmt[index++] = 'r';
}
if (stream->flags & JANET_STREAM_WRITABLE) {
flags |= JANET_FILE_WRITE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
int currindex = index;
fmt[index++] = (currindex == 0) ? 'w' : '+';
}
if (index == 0) return NULL;
/* duplicate handle when converting stream to file */
#ifdef JANET_WINDOWS
int htype = 0;
if (fmt[0] == 'r' && fmt[1] == '+') {
htype = _O_RDWR;
} else if (fmt[0] == 'r') {
htype = _O_RDONLY;
} else if (fmt[0] == 'w') {
htype = _O_WRONLY;
}
int fd = _open_osfhandle((intptr_t) stream->handle, htype);
if (fd < 0) return NULL;
int fd_dup = _dup(fd);
if (fd_dup < 0) return NULL;
FILE *f = _fdopen(fd_dup, fmt);
if (NULL == f) {
_close(fd_dup);
return NULL;
}
#else
int fd_dup = dup(stream->handle);
if (fd_dup < 0) return NULL;
FILE *f = fdopen(fd_dup, fmt);
if (NULL == f) {
close(fd_dup);
return NULL;
}
#endif
return janet_makejfile(f, flags);
}
JANET_CORE_FN(janet_cfun_to_file,
"(ev/to-file)",
"Create core/file copy of the stream. This value can be used "
"when blocking IO behavior is needed.") {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
JanetFile *iof = get_file_for_stream(stream);
if (iof == NULL) janet_panic("cannot make file from stream");
return janet_wrap_abstract(iof);
}
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 fibers that are being used by the scheduler.") {
@@ -3300,6 +3378,7 @@ void janet_lib_ev(JanetTable *env) {
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock), JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release), JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release), JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
JANET_CORE_REG("ev/to-file", janet_cfun_to_file),
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks), JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
JANET_REG_END JANET_REG_END
}; };

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -400,7 +400,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
JanetFFIStruct *st = janet_abstract(&janet_struct_type, JanetFFIStruct *st = janet_abstract(&janet_struct_type,
sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember)); sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember));
st->field_count = member_count; st->field_count = 0;
st->size = 0; st->size = 0;
st->align = 1; st->align = 1;
if (argc == 0) { if (argc == 0) {
@@ -418,6 +418,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->fields[i].type = decode_ffi_type(argv[j]); st->fields[i].type = decode_ffi_type(argv[j]);
size_t el_size = type_size(st->fields[i].type); size_t el_size = type_size(st->fields[i].type);
size_t el_align = type_align(st->fields[i].type); size_t el_align = type_align(st->fields[i].type);
if (el_align <= 0) janet_panicf("bad field type %V", argv[j]);
if (all_packed || pack_one) { if (all_packed || pack_one) {
if (st->size % el_align != 0) is_aligned = 0; if (st->size % el_align != 0) is_aligned = 0;
st->fields[i].offset = st->size; st->fields[i].offset = st->size;
@@ -433,6 +434,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->size += (st->align - 1); st->size += (st->align - 1);
st->size /= st->align; st->size /= st->align;
st->size *= st->align; st->size *= st->align;
st->field_count = member_count;
return st; return st;
} }

View File

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

View File

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

View File

@@ -47,7 +47,7 @@ typedef struct {
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
JanetStream *stream; JanetStream *stream;
#endif #endif
JanetTable* watch_descriptors; JanetTable *watch_descriptors;
JanetChannel *channel; JanetChannel *channel;
uint32_t default_flags; uint32_t default_flags;
int is_watching; int is_watching;
@@ -85,9 +85,9 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
} }
JanetKeyword keyw = janet_unwrap_keyword(options[i]); JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux, const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName), sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName), sizeof(JanetWatchFlagName),
keyw); keyw);
if (!result) { if (!result) {
janet_panicf("unknown inotify flag %v", options[i]); janet_panicf("unknown inotify flag %v", options[i]);
} }
@@ -154,82 +154,97 @@ static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
janet_schedule(fiber, janet_wrap_nil()); janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber); janet_async_end(fiber);
break; break;
case JANET_ASYNC_EVENT_ERR: case JANET_ASYNC_EVENT_ERR: {
{ janet_schedule(fiber, janet_wrap_nil());
janet_schedule(fiber, janet_wrap_nil()); janet_async_end(fiber);
break;
}
read_more:
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
case JANET_ASYNC_EVENT_READ: {
Janet name = janet_wrap_nil();
/* Assumption - read will never return partial events *
* From documentation:
*
* The behavior when the buffer given to read(2) is too small to
* return information about the next event depends on the kernel
* version: before Linux 2.6.21, read(2) returns 0; since Linux
* 2.6.21, read(2) fails with the error EINVAL. Specifying a buffer
* of size
*
* sizeof(struct inotify_event) + NAME_MAX + 1
*
* will be sufficient to read at least one event. */
ssize_t nread;
do {
nread = read(stream->handle, buf, sizeof(buf));
} while (nread == -1 && errno == EINTR);
/* Check for errors - special case errors that can just be waited on to fix */
if (nread == -1) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
break;
}
janet_cancel(fiber, janet_ev_lasterr());
fiber->ev_state = NULL;
janet_async_end(fiber); janet_async_end(fiber);
break; break;
} }
read_more: if (nread < (ssize_t) sizeof(struct inotify_event)) break;
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
case JANET_ASYNC_EVENT_READ:
{
Janet name = janet_wrap_nil();
/* Assumption - read will never return partial events * /* Iterate through all events read from the buffer */
* From documentation: char *cursor = buf;
* while (cursor < buf + nread) {
* The behavior when the buffer given to read(2) is too small to struct inotify_event inevent;
* return information about the next event depends on the kernel memcpy(&inevent, cursor, sizeof(inevent));
* version: before Linux 2.6.21, read(2) returns 0; since Linux cursor += sizeof(inevent);
* 2.6.21, read(2) fails with the error EINVAL. Specifying a buffer /* Read path of inevent */
* of size if (inevent.len) {
* name = janet_cstringv(cursor);
* sizeof(struct inotify_event) + NAME_MAX + 1 cursor += inevent.len;
*
* will be sufficient to read at least one event. */
ssize_t nread;
do {
nread = read(stream->handle, buf, sizeof(buf));
} while (nread == -1 && errno == EINTR);
/* Check for errors - special case errors that can just be waited on to fix */
if (nread == -1) {
if (errno == EAGAIN || errno == EWOULDBLOCK) {
break;
}
janet_cancel(fiber, janet_ev_lasterr());
fiber->ev_state = NULL;
janet_async_end(fiber);
break;
}
if (nread < (ssize_t) sizeof(struct inotify_event)) break;
/* Iterate through all events read from the buffer */
char *cursor = buf;
while (cursor < buf + nread) {
struct inotify_event inevent;
memcpy(&inevent, cursor, sizeof(inevent));
cursor += sizeof(inevent);
/* Read path of inevent */
if (inevent.len) {
name = janet_cstringv(cursor);
cursor += inevent.len;
}
/* Got an event */
Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd));
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
janet_struct_put(event, janet_ckeywordv("mask"), janet_wrap_integer(inevent.mask));
janet_struct_put(event, janet_ckeywordv("path"), name);
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
Janet etype = janet_ckeywordv("type");
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) {
if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name));
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
} }
/* Read some more if possible */ /* Got an event */
goto read_more; Janet path = janet_table_get(watcher->watch_descriptors, janet_wrap_integer(inevent.wd));
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), janet_wrap_integer(inevent.wd));
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
if (janet_checktype(name, JANET_NIL)) {
/* We were watching a file directly, so path is the full path. Split into dirname / basename */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
} else {
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
janet_struct_put(event, janet_ckeywordv("file-name"), name);
}
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_integer(inevent.cookie));
Janet etype = janet_ckeywordv("type");
const JanetWatchFlagName *wfn_end = watcher_flags_linux + sizeof(watcher_flags_linux) / sizeof(watcher_flags_linux[0]);
for (const JanetWatchFlagName *wfn = watcher_flags_linux; wfn < wfn_end; wfn++) {
if ((inevent.mask & wfn->flag) == wfn->flag) janet_struct_put(event, etype, janet_ckeywordv(wfn->name));
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
} }
break;
/* Read some more if possible */
goto read_more;
}
break;
} }
} }
@@ -256,7 +271,8 @@ static void janet_watcher_unlisten(JanetWatcher *watcher) {
#define WATCHFLAG_RECURSIVE 0x100000u #define WATCHFLAG_RECURSIVE 0x100000u
static const JanetWatchFlagName watcher_flags_windows[] = { static const JanetWatchFlagName watcher_flags_windows[] = {
{"all", {
"all",
FILE_NOTIFY_CHANGE_ATTRIBUTES | FILE_NOTIFY_CHANGE_ATTRIBUTES |
FILE_NOTIFY_CHANGE_CREATION | FILE_NOTIFY_CHANGE_CREATION |
FILE_NOTIFY_CHANGE_DIR_NAME | FILE_NOTIFY_CHANGE_DIR_NAME |
@@ -265,7 +281,8 @@ static const JanetWatchFlagName watcher_flags_windows[] = {
FILE_NOTIFY_CHANGE_LAST_WRITE | FILE_NOTIFY_CHANGE_LAST_WRITE |
FILE_NOTIFY_CHANGE_SECURITY | FILE_NOTIFY_CHANGE_SECURITY |
FILE_NOTIFY_CHANGE_SIZE | FILE_NOTIFY_CHANGE_SIZE |
WATCHFLAG_RECURSIVE}, WATCHFLAG_RECURSIVE
},
{"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES}, {"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES},
{"creation", FILE_NOTIFY_CHANGE_CREATION}, {"creation", FILE_NOTIFY_CHANGE_CREATION},
{"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME}, {"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME},
@@ -285,9 +302,9 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
} }
JanetKeyword keyw = janet_unwrap_keyword(options[i]); JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows, const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName), sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName), sizeof(JanetWatchFlagName),
keyw); keyw);
if (!result) { if (!result) {
janet_panicf("unknown windows filewatch flag %v", options[i]); janet_panicf("unknown windows filewatch flag %v", options[i]);
} }
@@ -322,19 +339,19 @@ typedef struct {
static void read_dir_changes(OverlappedWatch *ow) { static void read_dir_changes(OverlappedWatch *ow) {
BOOL result = ReadDirectoryChangesW(ow->stream->handle, BOOL result = ReadDirectoryChangesW(ow->stream->handle,
(NotifyChange *) ow->buf, (NotifyChange *) ow->buf,
FILE_INFO_PADDING, FILE_INFO_PADDING,
(ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE, (ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE,
ow->flags & ~WATCHFLAG_RECURSIVE, ow->flags & ~WATCHFLAG_RECURSIVE,
NULL, NULL,
(OVERLAPPED *) ow, (OVERLAPPED *) ow,
NULL); NULL);
if (!result) { if (!result) {
janet_panicv(janet_ev_lasterr()); janet_panicv(janet_ev_lasterr());
} }
} }
static const char* watcher_actions_windows[] = { static const char *watcher_actions_windows[] = {
"unknown", "unknown",
"added", "added",
"removed", "removed",
@@ -365,48 +382,47 @@ static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
case JANET_ASYNC_EVENT_FAILED: case JANET_ASYNC_EVENT_FAILED:
janet_stream_close(ow->stream); janet_stream_close(ow->stream);
break; break;
case JANET_ASYNC_EVENT_COMPLETE: case JANET_ASYNC_EVENT_COMPLETE: {
{ if (!watcher->is_watching) {
if (!watcher->is_watching) { janet_stream_close(ow->stream);
janet_stream_close(ow->stream); break;
break;
}
NotifyChange *fni = (NotifyChange *) ow->buf;
while (1) {
/* Got an event */
/* Extract name */
Janet filename;
if (fni->FileNameLength) {
int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL);
janet_assert(nbytes, "bad utf8 path");
uint8_t *into = janet_string_begin(nbytes);
WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL);
filename = janet_wrap_string(janet_string_end(into));
} else {
filename = janet_cstringv("");
}
JanetKV *event = janet_struct_begin(3);
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
janet_struct_put(event, janet_ckeywordv("dir"), janet_wrap_string(ow->dir_path));
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
/* Next event */
if (!fni->NextEntryOffset) break;
fni = (NotifyChange *) ((char *)fni + fni->NextEntryOffset);
}
/* Make another call to read directory changes */
read_dir_changes(ow);
janet_async_in_flight(fiber);
} }
break;
NotifyChange *fni = (NotifyChange *) ow->buf;
while (1) {
/* Got an event */
/* Extract name */
Janet filename;
if (fni->FileNameLength) {
int32_t nbytes = (int32_t) WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), NULL, 0, NULL, NULL);
janet_assert(nbytes, "bad utf8 path");
uint8_t *into = janet_string_begin(nbytes);
WideCharToMultiByte(CP_UTF8, 0, fni->FileName, fni->FileNameLength / sizeof(wchar_t), (char *) into, nbytes, NULL, NULL);
filename = janet_wrap_string(janet_string_end(into));
} else {
filename = janet_cstringv("");
}
JanetKV *event = janet_struct_begin(3);
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_actions_windows[fni->Action]));
janet_struct_put(event, janet_ckeywordv("file-name"), filename);
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(ow->dir_path));
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
/* Next event */
if (!fni->NextEntryOffset) break;
fni = (NotifyChange *)((char *)fni + fni->NextEntryOffset);
}
/* Make another call to read directory changes */
read_dir_changes(ow);
janet_async_in_flight(fiber);
}
break;
} }
} }
@@ -422,12 +438,12 @@ static void start_listening_ow(OverlappedWatch *ow) {
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) { static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
HANDLE handle = CreateFileA(path, HANDLE handle = CreateFileA(path,
FILE_LIST_DIRECTORY | GENERIC_READ, FILE_LIST_DIRECTORY | GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE, FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL, NULL,
OPEN_EXISTING, OPEN_EXISTING,
FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS, FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS,
NULL); NULL);
if (handle == INVALID_HANDLE_VALUE) { if (handle == INVALID_HANDLE_VALUE) {
janet_panicv(janet_ev_lasterr()); janet_panicv(janet_ev_lasterr());
} }
@@ -557,8 +573,21 @@ static const JanetAbstractType janet_filewatch_at = {
}; };
JANET_CORE_FN(cfun_filewatch_make, JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel &opt default-flags)", "(filewatch/new channel &opt default-flags)",
"Create a new filewatcher that will give events to a channel channel.") { "Create a new filewatcher that will give events to a channel channel. See `filewatch/add` for available flags.\n\n"
"When an event is triggered by the filewatcher, a struct containing information will be given to channel as with `ev/give`. "
"The contents of the channel depend on the OS, but will contain some common keys:\n\n"
"* `:type` -- the type of the event that was raised.\n\n"
"* `:file-name` -- the base file name of the file that triggered the event.\n\n"
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, -1); janet_arity(argc, 1, -1);
JanetChannel *channel = janet_getchannel(argv, 0); JanetChannel *channel = janet_getchannel(argv, 0);
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher)); JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
@@ -568,8 +597,44 @@ JANET_CORE_FN(cfun_filewatch_make,
} }
JANET_CORE_FN(cfun_filewatch_add, JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path &opt flags)", "(filewatch/add watcher path &opt flags)",
"Add a path to the watcher.") { "Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to FILE_NOTIFY_CHANGE_* flags in win32 documentation):\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n"
"* `:attributes` - FILE_NOTIFY_CHANGE_ATTRIBUTES\n\n"
"* `:creation` - FILE_NOTIFY_CHANGE_CREATION\n\n"
"* `:dir-name` - FILE_NOTIFY_CHANGE_DIR_NAME\n\n"
"* `:last-access` - FILE_NOTIFY_CHANGE_LAST_ACCESS\n\n"
"* `:last-write` - FILE_NOTIFY_CHANGE_LAST_WRITE\n\n"
"* `:security` - FILE_NOTIFY_CHANGE_SECURITY\n\n"
"* `:size` - FILE_NOTIFY_CHANGE_SIZE\n\n"
"* `:recursive` - watch subdirectories recursively\n\n"
"Linux (flags correspond to IN_* flags from <sys/inotify.h>):\n\n"
"* `:access` - IN_ACCESS\n\n"
"* `:all` - IN_ALL_EVENTS\n\n"
"* `:attrib` - IN_ATTRIB\n\n"
"* `:close-nowrite` - IN_CLOSE_NOWRITE\n\n"
"* `:close-write` - IN_CLOSE_WRITE\n\n"
"* `:create` - IN_CREATE\n\n"
"* `:delete` - IN_DELETE\n\n"
"* `:delete-self` - IN_DELETE_SELF\n\n"
"* `:ignored` - IN_IGNORED\n\n"
"* `:modify` - IN_MODIFY\n\n"
"* `:move-self` - IN_MOVE_SELF\n\n"
"* `:moved-from` - IN_MOVED_FROM\n\n"
"* `:moved-to` - IN_MOVED_TO\n\n"
"* `:open` - IN_OPEN\n\n"
"* `:q-overflow` - IN_Q_OVERFLOW\n\n"
"* `:unmount` - IN_UNMOUNT\n\n\n"
"On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n"
"* `:added`\n\n"
"* `:removed`\n\n"
"* `:modified`\n\n"
"* `:renamed-old`\n\n"
"* `:renamed-new`\n\n"
"On Linux, events will a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") {
janet_arity(argc, 2, -1); janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1); const char *path = janet_getcstring(argv, 1);
@@ -579,8 +644,8 @@ JANET_CORE_FN(cfun_filewatch_add,
} }
JANET_CORE_FN(cfun_filewatch_remove, JANET_CORE_FN(cfun_filewatch_remove,
"(filewatch/remove watcher path)", "(filewatch/remove watcher path)",
"Remove a path from the watcher.") { "Remove a path from the watcher.") {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1); const char *path = janet_getcstring(argv, 1);
@@ -589,8 +654,8 @@ JANET_CORE_FN(cfun_filewatch_remove,
} }
JANET_CORE_FN(cfun_filewatch_listen, JANET_CORE_FN(cfun_filewatch_listen,
"(filewatch/listen watcher)", "(filewatch/listen watcher)",
"Listen for changes in the watcher.") { "Listen for changes in the watcher.") {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_listen(watcher); janet_watcher_listen(watcher);
@@ -598,8 +663,8 @@ JANET_CORE_FN(cfun_filewatch_listen,
} }
JANET_CORE_FN(cfun_filewatch_unlisten, JANET_CORE_FN(cfun_filewatch_unlisten,
"(filewatch/unlisten watcher)", "(filewatch/unlisten watcher)",
"Stop listening for changes on a given watcher.") { "Stop listening for changes on a given watcher.") {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_unlisten(watcher); janet_watcher_unlisten(watcher);

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -321,9 +321,13 @@ static void janet_deinit_block(JanetGCObject *mem) {
janet_symbol_deinit(((JanetStringHead *) mem)->data); janet_symbol_deinit(((JanetStringHead *) mem)->data);
break; break;
case JANET_MEMORY_ARRAY: case JANET_MEMORY_ARRAY:
case JANET_MEMORY_ARRAY_WEAK:
janet_free(((JanetArray *) mem)->data); janet_free(((JanetArray *) mem)->data);
break; break;
case JANET_MEMORY_TABLE: case JANET_MEMORY_TABLE:
case JANET_MEMORY_TABLE_WEAKK:
case JANET_MEMORY_TABLE_WEAKV:
case JANET_MEMORY_TABLE_WEAKKV:
janet_free(((JanetTable *) mem)->data); janet_free(((JanetTable *) mem)->data);
break; break;
case JANET_MEMORY_FIBER: { case JANET_MEMORY_FIBER: {

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -31,6 +31,7 @@
#ifndef JANET_WINDOWS #ifndef JANET_WINDOWS
#include <fcntl.h> #include <fcntl.h>
#include <sys/stat.h>
#include <sys/wait.h> #include <sys/wait.h>
#include <unistd.h> #include <unistd.h>
#endif #endif
@@ -164,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen,
} }
FILE *f = fopen((const char *)fname, (const char *)fmode); FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) { if (f != NULL) {
#ifndef JANET_WINDOWS
struct stat st;
fstat(fileno(f), &st);
if (S_ISDIR(st.st_mode)) {
fclose(f);
janet_panicf("cannot open directory: %s", fname);
}
#endif
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ); size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) { if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize); int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -68,8 +68,15 @@ enum {
LB_STRUCT_PROTO, /* 223 */ LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV #ifdef JANET_EV
LB_THREADED_ABSTRACT, /* 224 */ LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */ LB_POINTER_BUFFER, /* 225 */
#endif #endif
LB_TABLE_WEAKK, /* 226 */
LB_TABLE_WEAKV, /* 227 */
LB_TABLE_WEAKKV, /* 228 */
LB_TABLE_WEAKK_PROTO, /* 229 */
LB_TABLE_WEAKV_PROTO, /* 230 */
LB_TABLE_WEAKKV_PROTO, /* 231 */
LB_ARRAY_WEAK, /* 232 */
} LeadBytes; } LeadBytes;
/* Helper to look inside an entry in an environment */ /* Helper to look inside an entry in an environment */
@@ -569,7 +576,8 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
int32_t i; int32_t i;
JanetArray *a = janet_unwrap_array(x); JanetArray *a = janet_unwrap_array(x);
MARK_SEEN(); MARK_SEEN();
pushbyte(st, LB_ARRAY); enum JanetMemoryType memtype = janet_gc_type(a);
pushbyte(st, memtype == JANET_MEMORY_ARRAY_WEAK ? LB_ARRAY_WEAK : LB_ARRAY);
pushint(st, a->count); pushint(st, a->count);
for (i = 0; i < a->count; i++) for (i = 0; i < a->count; i++)
marshal_one(st, a->data[i], flags + 1); marshal_one(st, a->data[i], flags + 1);
@@ -592,7 +600,16 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_TABLE: { case JANET_TABLE: {
JanetTable *t = janet_unwrap_table(x); JanetTable *t = janet_unwrap_table(x);
MARK_SEEN(); MARK_SEEN();
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE); enum JanetMemoryType memtype = janet_gc_type(t);
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
pushbyte(st, t->proto ? LB_TABLE_WEAKK_PROTO : LB_TABLE_WEAKK);
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKV_PROTO : LB_TABLE_WEAKV);
} else if (memtype == JANET_MEMORY_TABLE_WEAKKV) {
pushbyte(st, t->proto ? LB_TABLE_WEAKKV_PROTO : LB_TABLE_WEAKKV);
} else {
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
}
pushint(st, t->count); pushint(st, t->count);
if (t->proto) if (t->proto)
marshal_one(st, janet_wrap_table(t->proto), flags + 1); marshal_one(st, janet_wrap_table(t->proto), flags + 1);
@@ -1417,11 +1434,18 @@ static const uint8_t *unmarshal_one(
} }
case LB_REFERENCE: case LB_REFERENCE:
case LB_ARRAY: case LB_ARRAY:
case LB_ARRAY_WEAK:
case LB_TUPLE: case LB_TUPLE:
case LB_STRUCT: case LB_STRUCT:
case LB_STRUCT_PROTO: case LB_STRUCT_PROTO:
case LB_TABLE: case LB_TABLE:
case LB_TABLE_PROTO: case LB_TABLE_PROTO:
case LB_TABLE_WEAKK:
case LB_TABLE_WEAKV:
case LB_TABLE_WEAKKV:
case LB_TABLE_WEAKK_PROTO:
case LB_TABLE_WEAKV_PROTO:
case LB_TABLE_WEAKKV_PROTO:
/* Things that open with integers */ /* Things that open with integers */
{ {
data++; data++;
@@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one(
if (lead != LB_REFERENCE) { if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len); MARSH_EOS(st, data - 1 + len);
} }
if (lead == LB_ARRAY) { if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
/* Array */ /* Array */
JanetArray *array = janet_array(len); JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
array->count = len; array->count = len;
*out = janet_wrap_array(array); *out = janet_wrap_array(array);
janet_v_push(st->lookup, *out); janet_v_push(st->lookup, *out);
@@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one(
*out = st->lookup[len]; *out = st->lookup[len];
} else { } else {
/* Table */ /* Table */
JanetTable *t = janet_table(len); JanetTable *t;
if (lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKK) {
t = janet_table_weakk(len);
} else if (lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKV) {
t = janet_table_weakv(len);
} else if (lead == LB_TABLE_WEAKKV_PROTO || lead == LB_TABLE_WEAKKV) {
t = janet_table_weakkv(len);
} else {
t = janet_table(len);
}
*out = janet_wrap_table(t); *out = janet_wrap_table(t);
janet_v_push(st->lookup, *out); janet_v_push(st->lookup, *out);
if (lead == LB_TABLE_PROTO) { if (lead == LB_TABLE_PROTO || lead == LB_TABLE_WEAKK_PROTO || lead == LB_TABLE_WEAKV_PROTO || lead == LB_TABLE_WEAKKV_PROTO) {
Janet proto; Janet proto;
data = unmarshal_one(st, data, &proto, flags + 1); data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE, st); janet_asserttype(proto, JANET_TABLE, st);

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose and contributors. * Copyright (c) 2024 Calvin Rose and contributors.
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -829,7 +829,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JANET_CORE_FN(cfun_stream_accept, JANET_CORE_FN(cfun_stream_accept,
"(net/accept stream &opt timeout)", "(net/accept stream &opt timeout)",
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. " "Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
"Takes an optional timeout in seconds, after which will return nil. " "Takes an optional timeout in seconds, after which will raise an error. "
"Returns a new duplex stream which represents a connection to the client.") { "Returns a new duplex stream which represents a connection to the client.") {
janet_arity(argc, 1, 2); janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -844,7 +844,7 @@ JANET_CORE_FN(cfun_stream_read,
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. " "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. " "`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. " "If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. " "Takes an optional timeout in seconds, after which will raise an error. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") { "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -864,7 +864,7 @@ JANET_CORE_FN(cfun_stream_read,
JANET_CORE_FN(cfun_stream_chunk, JANET_CORE_FN(cfun_stream_chunk,
"(net/chunk stream nbytes &opt buf timeout)", "(net/chunk stream nbytes &opt buf timeout)",
"Same a net/read, but will wait for all n bytes to arrive rather than return early. " "Same a net/read, but will wait for all n bytes to arrive rather than return early. "
"Takes an optional timeout in seconds, after which will return nil.") { "Takes an optional timeout in seconds, after which will raise an error.") {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@@ -878,7 +878,7 @@ JANET_CORE_FN(cfun_stream_chunk,
JANET_CORE_FN(cfun_stream_recv_from, JANET_CORE_FN(cfun_stream_recv_from,
"(net/recv-from stream nbytes buf &opt timeout)", "(net/recv-from stream nbytes buf &opt timeout)",
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the " "Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.") { "packet came from. Takes an optional timeout in seconds, after which will raise an error.") {
janet_arity(argc, 3, 4); janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET); janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@@ -892,7 +892,7 @@ JANET_CORE_FN(cfun_stream_recv_from,
JANET_CORE_FN(cfun_stream_write, JANET_CORE_FN(cfun_stream_write,
"(net/write stream data &opt timeout)", "(net/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write " "Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. " "completes. Takes an optional timeout in seconds, after which will raise an error. "
"Returns nil, or raises an error if the write failed.") { "Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3); janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -911,7 +911,7 @@ JANET_CORE_FN(cfun_stream_write,
JANET_CORE_FN(cfun_stream_send_to, JANET_CORE_FN(cfun_stream_send_to,
"(net/send-to stream dest data &opt timeout)", "(net/send-to stream dest data &opt timeout)",
"Writes a datagram to a server stream. dest is a the destination address of the packet. " "Writes a datagram to a server stream. dest is a the destination address of the packet. "
"Takes an optional timeout in seconds, after which will return nil. " "Takes an optional timeout in seconds, after which will raise an error. "
"Returns stream.") { "Returns stream.") {
janet_arity(argc, 3, 4); janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose and contributors. * Copyright (c) 2024 Calvin Rose and contributors.
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -27,9 +27,10 @@
#include "gc.h" #include "gc.h"
#endif #endif
#include <stdlib.h>
#ifndef JANET_REDUCED_OS #ifndef JANET_REDUCED_OS
#include <stdlib.h>
#include <time.h> #include <time.h>
#include <fcntl.h> #include <fcntl.h>
#include <errno.h> #include <errno.h>
@@ -174,6 +175,8 @@ JANET_CORE_FN(os_arch,
"* :riscv64\n\n" "* :riscv64\n\n"
"* :sparc\n\n" "* :sparc\n\n"
"* :wasm\n\n" "* :wasm\n\n"
"* :s390\n\n"
"* :s390x\n\n"
"* :unknown\n") { "* :unknown\n") {
janet_fixarity(argc, 0); janet_fixarity(argc, 0);
(void) argv; (void) argv;
@@ -200,6 +203,10 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("ppc"); return janet_ckeywordv("ppc");
#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC)) #elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
return janet_ckeywordv("ppc64"); return janet_ckeywordv("ppc64");
#elif (defined(__s390x__))
return janet_ckeywordv("s390x");
#elif (defined(__s390__))
return janet_ckeywordv("s390");
#else #else
return janet_ckeywordv("unknown"); return janet_ckeywordv("unknown");
#endif #endif
@@ -245,7 +252,7 @@ JANET_CORE_FN(os_exit,
} }
janet_deinit(); janet_deinit();
if (argc >= 2 && janet_truthy(argv[1])) { if (argc >= 2 && janet_truthy(argv[1])) {
_exit(status); _Exit(status);
} else { } else {
exit(status); exit(status);
} }

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -231,7 +231,7 @@ static void delim_error(JanetParser *parser, size_t stack_index, char c, const c
janet_buffer_push_u8(buffer, '`'); janet_buffer_push_u8(buffer, '`');
} }
} }
janet_formatb(buffer, " opened at line %d, column %d", s->line, s->column); janet_formatb(buffer, " opened at line %d, column %d", (int32_t) s->line, (int32_t) s->column);
} }
parser->error = (const char *) janet_string(buffer->data, buffer->count); parser->error = (const char *) janet_string(buffer->data, buffer->count);
parser->flag |= JANET_PARSER_GENERATED_ERROR; parser->flag |= JANET_PARSER_GENERATED_ERROR;
@@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) {
JanetParseState top = p->states[p->statecount - 1]; JanetParseState top = p->states[p->statecount - 1];
int32_t indent_col = (int32_t) top.column - 1; int32_t indent_col = (int32_t) top.column - 1;
uint8_t *r = bufstart, *end = r + buflen; uint8_t *r = bufstart, *end = r + buflen;
/* Check if there are any characters before the start column - /* Unless there are only spaces before EOLs, disable reindenting */
* if so, do not reindent. */
int reindent = 1; int reindent = 1;
while (reindent && (r < end)) { while (reindent && (r < end)) {
if (*r++ == '\n') { if (*r++ == '\n') {
@@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) {
break; break;
} }
} }
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1;
} }
} }
/* Now reindent if able to, otherwise just drop leading newline. */ /* Now reindent if able */
if (!reindent) { if (reindent) {
if (buflen > 0 && bufstart[0] == '\n') {
buflen--;
bufstart++;
}
} else {
uint8_t *w = bufstart; uint8_t *w = bufstart;
r = bufstart; r = bufstart;
while (r < end) { while (r < end) {
if (*r == '\n') { if (*r == '\n') {
if (r == bufstart) { *w++ = *r++;
/* Skip leading newline */
r++;
} else {
*w++ = *r++;
}
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++); for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++;
} else { } else {
*w++ = *r++; *w++ = *r++;
} }
} }
buflen = (int32_t)(w - bufstart); buflen = (int32_t)(w - bufstart);
} }
/* Check for trailing newline character so we can remove it */ /* Check for leading EOL so we can remove it */
if (buflen > 0 && bufstart[buflen - 1] == '\n') { if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
bufstart = bufstart + 2;
} else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */
buflen--;
bufstart++;
}
/* Check for trailing EOL so we can remove it */
if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
} else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */
buflen--; buflen--;
} }
} }

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -465,6 +465,16 @@ tail:
return result; return result;
} }
case RULE_ONLY_TAGS: {
CapState cs = cap_save(s);
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
up1(s);
if (!result) return NULL;
cap_load_keept(s, cs);
return result;
}
case RULE_GROUP: { case RULE_GROUP: {
uint32_t tag = rule[2]; uint32_t tag = rule[2];
int oldmode = s->mode; int oldmode = s->mode;
@@ -486,6 +496,30 @@ tail:
return result; return result;
} }
case RULE_NTH: {
uint32_t nth = rule[1];
if (nth > INT32_MAX) nth = INT32_MAX;
uint32_t tag = rule[3];
int oldmode = s->mode;
CapState cs = cap_save(s);
s->mode = PEG_MODE_NORMAL;
down1(s);
const uint8_t *result = peg_rule(s, s->bytecode + rule[2], text);
up1(s);
s->mode = oldmode;
if (!result) return NULL;
int32_t num_sub_captures = s->captures->count - cs.cap;
Janet cap;
if (num_sub_captures > (int32_t) nth) {
cap = s->captures->data[cs.cap + nth];
} else {
return NULL;
}
cap_load_keept(s, cs);
pushcap(s, cap, tag);
return result;
}
case RULE_SUB: { case RULE_SUB: {
const uint8_t *text_start = text; const uint8_t *text_start = text;
const uint32_t *rule_window = s->bytecode + rule[1]; const uint32_t *rule_window = s->bytecode + rule[1];
@@ -1061,6 +1095,9 @@ static void spec_thru(Builder *b, int32_t argc, const Janet *argv) {
static void spec_drop(Builder *b, int32_t argc, const Janet *argv) { static void spec_drop(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_DROP); spec_onerule(b, argc, argv, RULE_DROP);
} }
static void spec_only_tags(Builder *b, int32_t argc, const Janet *argv) {
spec_onerule(b, argc, argv, RULE_ONLY_TAGS);
}
/* Rule of the form [rule, tag] */ /* Rule of the form [rule, tag] */
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) { static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -1084,6 +1121,15 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
spec_cap1(b, argc, argv, RULE_UNREF); spec_cap1(b, argc, argv, RULE_UNREF);
} }
static void spec_nth(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 2, 3);
Reserve r = reserve(b, 4);
uint32_t nth = peg_getnat(b, argv[0]);
uint32_t rule = peg_compile1(b, argv[1]);
uint32_t tag = (argc == 3) ? emit_tag(b, argv[2]) : 0;
emit_3(r, RULE_NTH, nth, rule, tag);
}
static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) { static void spec_capture_number(Builder *b, int32_t argc, const Janet *argv) {
peg_arity(b, argc, 1, 3); peg_arity(b, argc, 1, 3);
Reserve r = reserve(b, 4); Reserve r = reserve(b, 4);
@@ -1262,7 +1308,9 @@ static const SpecialPair peg_specials[] = {
{"line", spec_line}, {"line", spec_line},
{"look", spec_look}, {"look", spec_look},
{"not", spec_not}, {"not", spec_not},
{"nth", spec_nth},
{"number", spec_capture_number}, {"number", spec_capture_number},
{"only-tags", spec_only_tags},
{"opt", spec_opt}, {"opt", spec_opt},
{"position", spec_position}, {"position", spec_position},
{"quote", spec_capture}, {"quote", spec_capture},
@@ -1619,6 +1667,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break; break;
case RULE_ERROR: case RULE_ERROR:
case RULE_DROP: case RULE_DROP:
case RULE_ONLY_TAGS:
case RULE_NOT: case RULE_NOT:
case RULE_TO: case RULE_TO:
case RULE_THRU: case RULE_THRU:
@@ -1632,6 +1681,12 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad; if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3; i += 3;
break; break;
case RULE_NTH:
/* [nth, rule, tag] */
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x01;
i += 4;
break;
default: default:
goto bad; goto bad;
} }

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -100,6 +100,7 @@ struct JanetVM {
* return point for panics. */ * return point for panics. */
jmp_buf *signal_buf; jmp_buf *signal_buf;
Janet *return_reg; Janet *return_reg;
int coerce_error;
/* The global registry for c functions. Used to store meta-data /* The global registry for c functions. Used to store meta-data
* along with otherwise bare c function pointers. */ * along with otherwise bare c function pointers. */

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -71,10 +71,10 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash) { int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash) {
int32_t lhash = janet_string_hash(lhs); int32_t lhash = janet_string_hash(lhs);
int32_t llen = janet_string_length(lhs); int32_t llen = janet_string_length(lhs);
if (lhs == rhs)
return 1;
if (lhash != rhash || llen != rlen) if (lhash != rhash || llen != rlen)
return 0; return 0;
if (lhs == rhs)
return 1;
return !memcmp(lhs, rhs, rlen); return !memcmp(lhs, rhs, rlen);
} }

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -497,8 +497,8 @@ int janet_scan_numeric(
Janet *out) { Janet *out) {
int result; int result;
double num; double num;
int64_t i64; int64_t i64 = 0;
uint64_t u64; uint64_t u64 = 0;
if (len < 2 || str[len - 2] != ':') { if (len < 2 || str[len - 2] != ':') {
result = janet_scan_number_base(str, len, 0, &num); result = janet_scan_number_base(str, len, 0, &num);
*out = janet_wrap_number(num); *out = janet_wrap_number(num);

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table,
return janet_wrap_table(tab); return janet_wrap_table(tab);
} }
JANET_CORE_FN(cfun_struct_rawget,
"(struct/rawget st key)",
"Gets a value from a struct `st` without looking at the prototype struct. "
"If `st` does not contain the key directly, the function will return "
"nil without checking the prototype. Returns the value in the struct.") {
janet_fixarity(argc, 2);
JanetStruct st = janet_getstruct(argv, 0);
return janet_struct_rawget(st, argv[1]);
}
/* Load the struct module */ /* Load the struct module */
void janet_lib_struct(JanetTable *env) { void janet_lib_struct(JanetTable *env) {
JanetRegExt struct_cfuns[] = { JanetRegExt struct_cfuns[] = {
@@ -301,6 +311,7 @@ void janet_lib_struct(JanetTable *env) {
JANET_CORE_REG("struct/getproto", cfun_struct_getproto), JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten), JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
JANET_CORE_REG("struct/to-table", cfun_struct_to_table), JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
JANET_CORE_REG("struct/rawget", cfun_struct_rawget),
JANET_REG_END JANET_REG_END
}; };
janet_core_cfuns_ext(env, NULL, struct_cfuns); janet_core_cfuns_ext(env, NULL, struct_cfuns);

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -79,6 +79,7 @@ const char *const janet_type_names[16] = {
"pointer" "pointer"
}; };
/* Docstring for signal lists these */
const char *const janet_signal_names[14] = { const char *const janet_signal_names[14] = {
"ok", "ok",
"error", "error",
@@ -96,6 +97,7 @@ const char *const janet_signal_names[14] = {
"await" "await"
}; };
/* Docstring for fiber/status lists these */
const char *const janet_status_names[16] = { const char *const janet_status_names[16] = {
"dead", "dead",
"error", "error",
@@ -115,14 +117,20 @@ const char *const janet_status_names[16] = {
"alive" "alive"
}; };
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
}
#ifndef JANET_PRF #ifndef JANET_PRF
int32_t janet_string_calchash(const uint8_t *str, int32_t len) { int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
if (NULL == str) return 5381; if (NULL == str || len == 0) return 5381;
const uint8_t *end = str + len; const uint8_t *end = str + len;
uint32_t hash = 5381; uint32_t hash = 5381;
while (str < end) while (str < end)
hash = (hash << 5) + hash + *str++; hash = (hash << 5) + hash + *str++;
hash = janet_hash_mix(hash, (uint32_t) len);
return (int32_t) hash; return (int32_t) hash;
} }
@@ -238,11 +246,6 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
#endif #endif
uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
uint32_t mix1 = (more + 0x9e3779b9 + (input << 6) + (input >> 2));
return input ^ (0x9e3779b9 + (mix1 << 6) + (mix1 >> 2));
}
/* Computes hash of an array of values */ /* Computes hash of an array of values */
int32_t janet_array_calchash(const Janet *array, int32_t len) { int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len; const Janet *end = array + len;

View File

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

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Run vm */ /* Run vm */
janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP; janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
int old_coerce_error = janet_vm.coerce_error;
janet_vm.coerce_error = 1;
JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil()); JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
janet_vm.coerce_error = old_coerce_error;
/* Teardown */ /* Teardown */
janet_vm.stackn = oldn; janet_vm.stackn = oldn;
@@ -1384,6 +1387,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
} }
if (signal != JANET_SIGNAL_OK) { if (signal != JANET_SIGNAL_OK) {
/* Should match logic in janet_signalv */
if (signal != JANET_SIGNAL_ERROR) {
*janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal]));
}
janet_panicv(*janet_vm.return_reg); janet_panicv(*janet_vm.return_reg);
} }
@@ -1430,8 +1437,10 @@ void janet_try_init(JanetTryState *state) {
state->vm_fiber = janet_vm.fiber; state->vm_fiber = janet_vm.fiber;
state->vm_jmp_buf = janet_vm.signal_buf; state->vm_jmp_buf = janet_vm.signal_buf;
state->vm_return_reg = janet_vm.return_reg; state->vm_return_reg = janet_vm.return_reg;
state->coerce_error = janet_vm.coerce_error;
janet_vm.return_reg = &(state->payload); janet_vm.return_reg = &(state->payload);
janet_vm.signal_buf = &(state->buf); janet_vm.signal_buf = &(state->buf);
janet_vm.coerce_error = 0;
} }
void janet_restore(JanetTryState *state) { void janet_restore(JanetTryState *state) {
@@ -1440,6 +1449,7 @@ void janet_restore(JanetTryState *state) {
janet_vm.fiber = state->vm_fiber; janet_vm.fiber = state->vm_fiber;
janet_vm.signal_buf = state->vm_jmp_buf; janet_vm.signal_buf = state->vm_jmp_buf;
janet_vm.return_reg = state->vm_return_reg; janet_vm.return_reg = state->vm_return_reg;
janet_vm.coerce_error = state->coerce_error;
} }
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) { static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {

View File

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

View File

@@ -1,5 +1,5 @@
/* /*
* Copyright (c) 2023 Calvin Rose * Copyright (c) 2024 Calvin Rose
* *
* Permission is hereby granted, free of charge, to any person obtaining a copy * Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to * of this software and associated documentation files (the "Software"), to
@@ -1261,6 +1261,7 @@ typedef struct {
/* new state */ /* new state */
jmp_buf buf; jmp_buf buf;
Janet payload; Janet payload;
int coerce_error;
} JanetTryState; } JanetTryState;
/***** END SECTION TYPES *****/ /***** END SECTION TYPES *****/
@@ -1442,6 +1443,7 @@ JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
/* For use inside listeners - adds a timeout to the current fiber, such that /* For use inside listeners - adds a timeout to the current fiber, such that
* it will be resumed after sec seconds if no other event schedules the current fiber. */ * it will be resumed after sec seconds if no other event schedules the current fiber. */
JANET_API void janet_addtimeout(double sec); JANET_API void janet_addtimeout(double sec);
JANET_API void janet_addtimeout_nil(double sec);
JANET_API void janet_ev_inc_refcount(void); JANET_API void janet_ev_inc_refcount(void);
JANET_API void janet_ev_dec_refcount(void); JANET_API void janet_ev_dec_refcount(void);
@@ -1742,6 +1744,9 @@ JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key); JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table); JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table); JANET_API void janet_table_clear(JanetTable *table);
JANET_API JanetTable *janet_table_weakk(int32_t capacity);
JANET_API JanetTable *janet_table_weakv(int32_t capacity);
JANET_API JanetTable *janet_table_weakkv(int32_t capacity);
/* Fiber */ /* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv); JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
@@ -2177,7 +2182,9 @@ typedef enum {
RULE_UNREF, /* [rule, tag] */ RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */ RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */ RULE_SUB, /* [rule, rule] */
RULE_SPLIT /* [rule, rule] */ RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */
} JanetPegOpcod; } JanetPegOpcod;
typedef struct { typedef struct {

View File

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

View File

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

View File

@@ -4,14 +4,20 @@
(var num-tests-run 0) (var num-tests-run 0)
(var suite-name 0) (var suite-name 0)
(var start-time 0) (var start-time 0)
(var skip-count 0)
(var skip-n 0)
(def is-verbose (os/getenv "VERBOSE")) (def 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."
[x &opt e] [x &opt e]
(default e "assert error")
(++ num-tests-run) (++ num-tests-run)
(when (pos? skip-n)
(-- skip-n)
(++ skip-count)
(break x))
(default e "assert error")
(when x (++ num-tests-passed)) (when x (++ num-tests-passed))
(def str (string e)) (def str (string e))
(def stack (debug/stack (fiber/current))) (def stack (debug/stack (fiber/current)))
@@ -24,9 +30,16 @@
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush))) (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
x) x)
(defn skip-asserts
"Skip some asserts"
[n]
(+= skip-n n)
nil)
(defmacro assert (defmacro assert
[x &opt e] [x &opt e]
(def xx (gensym)) (def xx (gensym))
(default e ~',x)
~(do ~(do
(def ,xx ,x) (def ,xx ,x)
(,assert-no-tail ,xx ,e) (,assert-no-tail ,xx ,e)
@@ -62,8 +75,8 @@
(defn end-suite [] (defn end-suite []
(def delta (- (os/clock) start-time)) (def delta (- (os/clock) start-time))
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta) (eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.") (eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).")
(if (not= num-tests-passed num-tests-run) (os/exit 1))) (if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1)))
(defn rmrf (defn rmrf
"rm -rf in janet" "rm -rf in janet"

View File

@@ -46,7 +46,6 @@
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3") (assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
(assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4") (assert (deep= (array/remove @[1 2 3 4 5] -2 200) @[1 2 3]) "array/remove 4")
# array/peek # array/peek
(assert (nil? (array/peek @[])) "array/peek empty") (assert (nil? (array/peek @[])) "array/peek empty")

View File

@@ -979,4 +979,30 @@
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn") (assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2)))) (assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(setdyn *debug* true)
(def source '(defn a [x] (+ x x)))
(eval source)
(assert (= 20 (a 10)))
(assert (deep= (get (dyn 'a) :source-form) source))
(setdyn *debug* nil)
# issue #1516
(assert-error "assertf 1 argument" (macex '(assertf true)))
(assert (assertf true "fun message") "assertf 2 arguments")
(assert (assertf true "%s message" "mystery") "assertf 3 arguments")
(assert (assertf (not nil) "%s message" "ordinary") "assertf not nil")
(assert-error "assertf error 2" (assertf false "fun message"))
(assert-error "assertf error 3" (assertf false "%s message" "mystery"))
(assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob"))
# issue #1535
(loop [i :range [1 1000]]
(assert (deep-not= @{:key1 "value1" @"key" "value2"}
@{:key1 "value1" @"key" "value2"}) "deep= mutable keys"))
(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key")
(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys")
(def k1 @"")
(def k2 @"")
(assert (deep= {k1 1 k2 2} {k1 1 k2 2}) "deep= duplicate mutable keys 2")
(end-suite) (end-suite)

View File

@@ -117,6 +117,11 @@
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7") (assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8") (assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
# Try installing a bundle that fails check
(assert-error "bad test" (bundle/install "./examples/sample-bad-bundle" :check true))
(assert (= 0 (length (bundle/list))) "check failure 0")
(assert (= 0 (length (bundle/topolist))) "check failure 1")
(rmrf syspath) (rmrf syspath)
(end-suite) (end-suite)

View File

@@ -375,4 +375,109 @@
(ev/cancel f (gensym)) (ev/cancel f (gensym))
(ev/take superv) (ev/take superv)
# Chat server test
(def conmap @{})
(defn broadcast [em msg]
(eachk par conmap
(if (not= par em)
(if-let [tar (get conmap par)]
(net/write tar (string/format "[%s]:%s" em msg))))))
(defn handler
[connection]
(net/write connection "Whats your name?\n")
(def name (string/trim (string (ev/read connection 100))))
(if (get conmap name)
(do
(net/write connection "Name already taken!")
(:close connection))
(do
(put conmap name connection)
(net/write connection (string/format "Welcome %s\n" name))
(defer (do
(put conmap name nil)
(:close connection))
(while (def msg (ev/read connection 100))
(broadcast name (string msg)))))))
# Now launch the chat server
(def chat-server (net/listen test-host test-port))
(ev/spawn
(forever
(def [ok connection] (protect (net/accept chat-server)))
(if (and ok connection)
(ev/call handler connection)
(break))))
# Read from socket
(defn expect-read
[stream text]
(def result (string (net/read stream 100)))
(assert (= result text) (string/format "expected %v, got %v" text result)))
# Now do our telnet chat
(def bob (net/connect test-host test-port :stream))
(expect-read bob "Whats your name?\n")
(if (= :mingw (os/which))
(net/write bob "bob")
(do
(def fbob (ev/to-file bob))
(file/write fbob "bob")
(file/flush fbob)
(:close fbob)))
(expect-read bob "Welcome bob\n")
(def alice (net/connect test-host test-port))
(expect-read alice "Whats your name?\n")
(net/write alice "alice")
(expect-read alice "Welcome alice\n")
# Bob says hello, alice gets the message
(net/write bob "hello\n")
(expect-read alice "[bob]:hello\n")
# Alice says hello, bob gets the message
(net/write alice "hi\n")
(expect-read bob "[alice]:hi\n")
# Ted joins the chat server
(def ted (net/connect test-host test-port))
(expect-read ted "Whats your name?\n")
(net/write ted "ted")
(expect-read ted "Welcome ted\n")
# Ted says hi, alice and bob get message
(net/write ted "hi\n")
(expect-read alice "[ted]:hi\n")
(expect-read bob "[ted]:hi\n")
# Bob leaves for work. Now it's just ted and alice
(:close bob)
# Alice messages ted, ted gets message
(net/write alice "wuzzup\n")
(expect-read ted "[alice]:wuzzup\n")
(net/write ted "not much\n")
(expect-read alice "[ted]:not much\n")
# Alice bounces
(:close alice)
# Ted can send messages, nobody gets them :(
(net/write ted "hello?\n")
(:close ted)
# Close chat server
(:close chat-server)
# Issue #1531
(def c (ev/chan 0))
(ev/spawn (while (def x (ev/take c))))
(defn print-to-chan [x] (ev/give c x))
(assert-error "coerce await inside janet_call to error"
(with-dyns [*out* print-to-chan]
(pp :foo)))
(ev/chan-close c)
(end-suite) (end-suite)

View File

@@ -52,5 +52,7 @@
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) (assert (= 26 (ffi/size [:char :pack :int @[:char 21]]))
"array struct size")) "array struct size"))
(end-suite) (compwhen has-ffi
(assert-error "bad struct issue #1512" (ffi/struct :void)))
(end-suite)

View File

@@ -38,13 +38,16 @@
(gccollect) (gccollect)
(defn- expect (defn- expect
[key value] [key value & more-kvs]
(ev/with-deadline (ev/with-deadline
1 1
(def event (ev/take chan)) (def event (ev/take chan))
(when is-verbose (pp event)) (when is-verbose (pp event))
(assert event "check event") (assert event "check event")
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)))) (assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value))
(when (next more-kvs)
(each [k v] (partition 2 more-kvs)
(assert (= v (get event k)) (string/format "got %p, expected %p" (get event k) v))))))
(defn- expect-empty (defn- expect-empty
[] []
@@ -80,14 +83,18 @@
(def fw (filewatch/new chan)) (def fw (filewatch/new chan))
(def td1 (randdir)) (def td1 (randdir))
(def td2 (randdir)) (def td2 (randdir))
(def td3 (randdir))
(rmrf td1) (rmrf td1)
(rmrf td2) (rmrf td2)
(os/mkdir td1) (os/mkdir td1)
(os/mkdir td2) (os/mkdir td2)
(os/mkdir td3)
(spit-file td3 "file3.txt")
(when is-win (when is-win
(filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive) (filewatch/add fw td1 :last-write :last-access :file-name :dir-name :size :attributes :recursive)
(filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes)) (filewatch/add fw td2 :last-write :last-access :file-name :dir-name :size :attributes))
(when is-linux (when is-linux
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
(filewatch/add fw td1 :close-write :create :delete) (filewatch/add fw td1 :close-write :create :delete)
(filewatch/add fw td2 :close-write :create :delete :ignored)) (filewatch/add fw td2 :close-write :create :delete :ignored))
(assert-no-error "filewatch/listen no error" (filewatch/listen fw)) (assert-no-error "filewatch/listen no error" (filewatch/listen fw))
@@ -98,7 +105,7 @@
(when is-win (when is-win
(spit-file td1 "file1.txt") (spit-file td1 "file1.txt")
(expect :type :added) (expect :type :added :file-name "file1.txt" :dir-name td1)
(expect :type :modified) (expect :type :modified)
(expect-maybe :type :modified) # for mingw + wine (expect-maybe :type :modified) # for mingw + wine
(gccollect) (gccollect)
@@ -144,7 +151,7 @@
(when is-linux (when is-linux
(spit-file td1 "file1.txt") (spit-file td1 "file1.txt")
(expect :type :create) (expect :type :create :file-name "file1.txt" :dir-name td1)
(expect :type :close-write) (expect :type :close-write)
(expect-empty) (expect-empty)
(gccollect) (gccollect)
@@ -153,6 +160,11 @@
(expect-empty) (expect-empty)
(gccollect) (gccollect)
# Check file3.txt
(spit-file td3 "file3.txt")
(expect :type :close-write :file-name "file3.txt" :dir-name td3)
(expect-empty)
# Check td2 # Check td2
(spit-file td2 "file2.txt") (spit-file td2 "file2.txt")
(expect :type :create) (expect :type :create)
@@ -187,5 +199,6 @@
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw)) (assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
(assert-no-error "cleanup 1" (rmrf td1)) (assert-no-error "cleanup 1" (rmrf td1))
(assert-no-error "cleanup 2" (rmrf td2)) (assert-no-error "cleanup 2" (rmrf td2))
(assert-no-error "cleanup 3" (rmrf td3))
(end-suite) (end-suite)

View File

@@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(def item (ev/take newchan)) (def item (ev/take newchan))
(assert (= item newchan) "ev/chan marshalling")) (assert (= item newchan) "ev/chan marshalling"))
(end-suite) # Issue #1488 - marshalling weak values
(testmarsh (array/weak 10) "marsh array/weak")
(testmarsh (table/weak-keys 10) "marsh table/weak-keys")
(testmarsh (table/weak-values 10) "marsh table/weak-values")
(testmarsh (table/weak 10) "marsh table/weak")
# Now check that gc works with weak containers after marshalling
# Turn off automatic GC for testing weak references
(gcsetinterval 0x7FFFFFFF)
# array
(def a (array/weak 1))
(array/push a @"")
(assert (= 1 (length a)) "array/weak marsh 1")
(def aclone (-> a marshal unmarshal))
(assert (= 1 (length aclone)) "array/weak marsh 2")
(gccollect)
(assert (= 1 (length aclone)) "array/weak marsh 3")
(assert (= 1 (length a)) "array/weak marsh 4")
(assert (= nil (get a 0)) "array/weak marsh 5")
(assert (= nil (get aclone 0)) "array/weak marsh 6")
(assert (deep= (freeze a) (freeze aclone)) "array/weak marsh 7")
# table weak keys and values
(def t (table/weak 1))
(def keep-key :key)
(def keep-value :value)
(put t :abc @"")
(put t :key :value)
(assert (= 2 (length t)) "table/weak marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak marsh 3")
(assert (= 1 (length t)) "table/weak marsh 4")
(assert (= keep-value (get t keep-key)) "table/weak marsh 5")
(assert (= keep-value (get tclone keep-key)) "table/weak marsh 6")
(assert (deep= t tclone) "table/weak marsh 7")
# table weak keys
(def t (table/weak-keys 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
(gccollect)
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
(assert (= 1 (length t)) "table/weak-keys marsh 4")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-keys marsh 5")
# table weak values
(def t (table/weak-values 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
(table/setproto t @{:abc 123})
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
(assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4")
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
(end-suite)

View File

@@ -57,6 +57,8 @@
(for i (+ index 1) (+ index indent 1) (for i (+ index 1) (+ index indent 1)
(case (get text i) (case (get text i)
nil (break) nil (break)
(chr "\r") (if-not (= (chr "\n") (get text (inc i)))
(set rewrite false))
(chr "\n") (break) (chr "\n") (break)
(chr " ") nil (chr " ") nil
(set rewrite false)))) (set rewrite false))))
@@ -64,12 +66,17 @@
# Only re-indent if no dedented characters. # Only re-indent if no dedented characters.
(def str (def str
(if rewrite (if rewrite
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text) (peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " "))
(fn [mtch eol] eol) text)
text)) text))
(def first-nl (= (chr "\n") (first str))) (def first-eol (cond
(def last-nl (= (chr "\n") (last str))) (string/has-prefix? "\r\n" str) :crlf
(string/slice str (if first-nl 1 0) (if last-nl -2))) (string/has-prefix? "\n" str) :lf))
(def last-eol (cond
(string/has-suffix? "\r\n" str) :crlf
(string/has-suffix? "\n" str) :lf))
(string/slice str (case first-eol :crlf 2 :lf 1 0) (case last-eol :crlf -3 :lf -2)))
(defn reindent-reference (defn reindent-reference
"Same as reindent but use parser functionality. Useful for "Same as reindent but use parser functionality. Useful for
@@ -89,8 +96,10 @@
(let [a (reindent text indent) (let [a (reindent text indent)
b (reindent-reference text indent)] b (reindent-reference text indent)]
(assert (= a b) (assert (= a b)
(string "indent " indent-counter " (indent=" indent ")")))) (string/format "reindent: %q, parse: %q (indent-test #%d with indent of %d)" a b indent-counter indent)
)))
# Unix EOLs
(check-indent "" 0) (check-indent "" 0)
(check-indent "\n" 0) (check-indent "\n" 0)
(check-indent "\n" 1) (check-indent "\n" 1)
@@ -106,6 +115,17 @@
(check-indent "\n Hello, world!\n " 4) (check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n dedented text\n " 4) (check-indent "\n Hello, world!\n dedented text\n " 4)
(check-indent "\n Hello, world!\n indented text\n " 4) (check-indent "\n Hello, world!\n indented text\n " 4)
# Windows EOLs
(check-indent "\r\n" 0)
(check-indent "\r\n" 1)
(check-indent "\r\n\r\n" 0)
(check-indent "\r\n\r\n" 1)
(check-indent "\r\nHello, world!" 0)
(check-indent "\r\nHello, world!" 1)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n dedented text\r\n " 4)
(check-indent "\r\n Hello, world!\r\n indented text\r\n " 4)
# Symbols with @ character # Symbols with @ character
# d68eae9 # d68eae9

View File

@@ -664,6 +664,8 @@
@[]) "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 "marshal/unmarshal peg" (-> peg marshal unmarshal))
(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"
@@ -756,5 +758,19 @@
"a,b,c" "a,b,c"
@["a" "b" "c"]) @["a" "b" "c"])
(test "nth 1"
~{:prefix (number :d+ nil :n)
:word '(lenprefix (-> :n) :w)
:main (some (nth 1 (* :prefix ":" :word)))}
"5:apple6:banana6:cherry"
@["apple" "banana" "cherry"])
(test "only-tags 1"
~{:prefix (number :d+ nil :n)
:word (capture (lenprefix (-> :n) :w) :W)
:main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
"5:apple6:banana6:cherry"
@["apple" "banana" "cherry"])
(end-suite) (end-suite)

View File

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