1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 06:07:43 +00:00

Compare commits

...

223 Commits

Author SHA1 Message Date
Calvin Rose
73334f3485 Prepare for 1.38.0 release. 2025-03-18 21:14:45 -05:00
Calvin Rose
a5b8da8d67 Merge pull request #1572 from tsujamin/janet-ffi-define-fix
Remove janet_lib_ffi() dependency on JANET_EV
2025-03-18 19:12:44 -07:00
Benjamin Roberts
e8cccfced5 Remove janet_lib_ffi() dependency on JANET_EV 2025-03-18 10:54:18 -04:00
Calvin Rose
88984f7ffb Add bundle/replace
Slight generalization of bundle/reinstall to allow inplace upgrades
of a bundle without reinstalling all dependent bundles as well.
2025-03-17 17:58:40 -05:00
Calvin Rose
182170b3be Make installed manifests nicer to work with. 2025-03-16 20:39:16 -05:00
Calvin Rose
f92412841b Merge pull request #1569 from sogaiu/vm-bug-1566 2025-03-12 21:13:49 -07:00
sogaiu
18c00e89da Fix vm bugs from #1566 2025-03-13 11:43:43 +09:00
Calvin Rose
7c38a55a9a Merge pull request #1568 from rwtolbert/msys2_mingw_build_fix
Update Makefile and meson to build with msys2 gcc and clang
2025-03-10 17:56:00 -07:00
Bob Tolbert
a15916ec9c Update Makefile and meson to build with msys2 gcc and clang 2025-03-10 10:13:36 -05:00
Calvin Rose
3583d4c92f Fix defdyn in flychecking. 2025-03-08 20:03:02 -06:00
Calvin Rose
a456c67a7b Merge pull request #1564 from pyrmont/bugfix.qemu-segfault
Use Alpine Linux as base image for s390x testing
2025-03-05 05:52:20 -08:00
Michael Camilleri
6e226e4073 Use sh rather than bash on Alpine Linux 2025-03-04 15:19:44 +09:00
Michael Camilleri
d23e6614b1 Use Alpine Linux as the base image rather than Ubuntu 2025-03-04 15:17:07 +09:00
Michael Camilleri
ab6afa72fd Use simpler base image 2025-03-04 15:01:25 +09:00
Calvin Rose
9538b8a77c Merge pull request #1562 from pyrmont/bugfix.subprocess-cleanup
Improve subprocess-related docstrings and functions
2025-03-03 18:47:59 -08:00
Calvin Rose
36d3804dd2 Merge pull request #1563 from pyrmont/bugfix.copyright-dates
Add script to update copyright dates
2025-03-03 18:47:38 -08:00
Michael Camilleri
a34b8ea68f Update older dates to 2025 2025-03-04 11:32:15 +09:00
Michael Camilleri
55c10f98bb Check more file extensions 2025-03-04 11:31:56 +09:00
Michael Camilleri
4b5a2a14c0 Update year in copyright disclaimer to 2025 2025-03-04 11:24:09 +09:00
Michael Camilleri
665705d06d Add Janet script to update copyright disclaimer 2025-03-04 11:23:26 +09:00
Michael Camilleri
cc8cd4bace Use uraimo GitHub action for s390x testing 2025-03-04 09:14:05 +09:00
Michael Camilleri
8f8b6ed001 Remove note on cancellation and tidy up wording 2025-03-03 23:28:37 +09:00
Calvin Rose
aa9efee868 Expose bundle operations in the CLI.
Bundle installation is a fairly natural command on the command line.
2025-03-03 08:14:09 -06:00
Calvin Rose
e0a0e2ed42 Prevent multi-scheduling with os/proc-wait. (address #1562) 2025-03-02 10:44:15 -06:00
Michael Camilleri
39f5c539d7 Clarify wording of docstrings further 2025-03-02 13:25:14 +09:00
Michael Camilleri
1b6437a4f8 Remove unnecessary returns 2025-03-02 08:30:51 +09:00
Michael Camilleri
c62c1a58f0 Reword documentation relating to subprocess creation 2025-03-02 08:29:32 +09:00
Calvin Rose
3441bcbd69 Add more cases for checking coerce error.
Channel operations inside a janet_call could wreak more
havoc later, when scheduled fibers are shooting off when they shouldn't
be. The easiest way to prevent this is simply check that we are not
inside janet_call before doing channel operations. We also get nicer
error messages this way.
2025-02-16 10:40:38 -06:00
Calvin Rose
2e6001316a Work on bug #1556 2025-02-16 09:09:33 -06:00
Calvin Rose
53bcc15207 Merge pull request #1557 from sogaiu/update-changelog-2025-02
Update CHANGELOG.md
2025-02-09 23:22:45 -08:00
sogaiu
dd609bb1bb Update CHANGELOG.md 2025-02-08 14:29:22 +09:00
Calvin Rose
5c56c7fa91 Formatting in peg.c 2025-02-07 21:05:28 -06:00
Calvin Rose
9a892363a3 Address issue #1558
Don't attempt SO_REUSEPORT on unix domain sockets since it doesn't make
sense and may cause a failure to bind without extra effort by the
programmer.
2025-02-07 21:05:07 -06:00
Calvin Rose
5f550ea5d4 Merge pull request #1555 from sogaiu/tweak-apply-short-fn-docstrings
Tweak apply and short-fn docstrings
2025-02-06 16:44:45 -08:00
sogaiu
1b6cc023a5 Tweak apply and short-fn docstrings 2025-02-06 22:35:59 +09:00
Calvin Rose
410f8d69bc Merge pull request #1528 from ianthehenry/til-peg-special
add (til) PEG special
2025-02-03 19:07:08 -08:00
Calvin Rose
6da44bdb6a Get rid of early termination rule in all finite loops. 2025-02-03 07:36:00 -06:00
Calvin Rose
d30fd27575 Address #1554 - capture first 0-width match in repeating rules and
optionals.

This fixes some undesirable interplay between lookaheads and looping
(repeating) rules where lookaheads caused the loop to immediately
terminate _and_ discard any captures. This change adds an exception if
there is a 0-width match at the first iteration of the loop, in which
case captures will be kept, although the loop will still be terminated
(any further iteration of the loop would possibly cause an infinite
 loop).

This allows optionals to work as expected when combined with lookahead.
There is also a question of whether or not optional should be
implemented as separate rule rather than as `(between 0 1 subrule)`.
2025-02-02 20:34:36 -06:00
Calvin Rose
1b278fc657 Update reduce2 documentation to fix issue #1545 2025-02-01 17:31:55 -06:00
Calvin Rose
eecffe01a5 Add some more test cases for hex floats. 2025-02-01 08:09:57 -06:00
Calvin Rose
f63a33884f Add hexfloats - Address #1550 2025-01-30 07:36:18 -06:00
Calvin Rose
fa75a395cb Add support for buffer peg literals - address #1549 2025-01-26 09:48:48 -06:00
Calvin Rose
1f34ec9902 Merge pull request #1547 from pyrmont/bugfix.codeql-upgrade
Update CodeQL actions to latest version
2025-01-25 09:24:40 -08:00
Michael Camilleri
f75c08a78e Add 'tools: linked' to CodeQL workflow 2025-01-24 04:00:52 +09:00
Michael Camilleri
5e93f0e34b Trigger workflow to run again 2025-01-24 03:02:15 +09:00
Calvin Rose
49f151e265 Allocate parser with GC.
This fixes janet_dobytes, which manually allocated a parser on the
stack, and then possibly ran garbage collection before it was
deallocated.
2025-01-22 09:21:56 -06:00
Michael Camilleri
2b73a15ad8 Update CodeQL actions to latest version 2025-01-22 23:47:44 +09:00
Calvin Rose
06d581dde3 Fix #1546 - large ranges.
Raise an error for very large ranges instead of internal assert.
2025-01-20 09:02:22 -06:00
Calvin Rose
2b49903c82 Merge pull request #1544 from cideM/docstring-fixes
Fix docstrings for int/u64, int/s64 and int/to-number
2025-01-14 06:30:08 -08:00
Florian Beeres
a17ae977a5 docstring int/u64 int/s64: supports number as well
Update the docstrings of the u64 and s64 functions to indicate that they
work on numbers as well strings. Previously the docstring only mentioned
string support.
2025-01-11 22:51:21 +01:00
Florian Beeres
8a6b44cb4e docstring int/to-number: supports int64, not int32
Update the cfun_to_number docstring to indicate that it handles values
up to JANET_INTMAX_INT64 (75845c0283),
rather than up to int32, what the current docstring says.
2025-01-11 22:46:44 +01:00
Calvin Rose
60d9f97750 Address issue #1539 - infinite loop in peg split
Other looping rules ensure forward progress by terminating if an
iteration is at the same location as the previous iteration. Do the same
for split.
2025-01-01 11:28:10 -06:00
Calvin Rose
f252933f62 Merge pull request #1541 from rwtolbert/feature/win_arm64_dist
Brief: Add Arm64 .msi support on Windows
2025-01-01 09:19:57 -08:00
Calvin Rose
6dbd7b476c Merge pull request #1538 from sogaiu/tweak-exit-value-doc
Tweak *exit-value* doc - address #1537
2024-12-31 10:28:03 -08:00
Bob Tolbert
a47eb847fb Brief: Add Arm64 .msi support on Windows
Summary: Small update to add Windows on Arm64 support.

Also requires the latest version 3.14 of the WiX toolset.
2024-12-31 11:47:27 -06:00
Calvin Rose
ba5990ef21 Add switch to turn off "reuse" behavior for server sockets. 2024-12-31 09:05:54 -06:00
sogaiu
753911fe2d Tweak *exit-value* doc - address #1537 2024-12-27 16:02:45 +09:00
Calvin Rose
746ced5501 Revert behavior of deep= on mutable keys.
Mutable keys are a minefield for comparisons, as resolving
equality require re-implementing a lot of the internal structures, as
well as dealing with multiple mutable keys that are in the same
equivalency class by deep=.

Simplifying the implementation to not resole mutable keys is much
simpler, faster, and has the benefit that deep= and deep-not= do not
need to allocate.
2024-12-21 09:03:01 -06:00
Calvin Rose
1b49934e4f Allow table/to-struct to take a prototype.
Use this prototype struct in freeze.
2024-12-19 19:41:19 -06:00
Calvin Rose
682f0f584f freeze with mutable keys should be determinsic help address #1535 2024-12-19 19:31:01 -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
Ian Henry
952906279c add (til) PEG special
(til sep subpattern) is a specialized (sub) that behaves like
(sub (to sep) subpattern), but advances over the input like (thru sep).
2024-12-04 21:17:10 -08: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
Calvin Rose
c5a9602be9 Better handle extra filewatch events on wine. 2024-08-20 18:30:56 -05:00
Calvin Rose
e88aab6d68 Fix mingw build warnings. 2024-08-20 18:24:54 -05:00
Calvin Rose
ce528251d5 Fix mingw build warnings. 2024-08-20 18:06:57 -05:00
Calvin Rose
9e334da2d6 Exit early when filewatch is not supported.
Currently we have no poll implementation.
2024-08-18 16:25:47 -05:00
Calvin Rose
c0e508e334 filewatch on mingw has same semantics as windows 2024-08-18 16:18:09 -05:00
Calvin Rose
b63b3bef74 Add testing for Linux. 2024-08-18 15:44:59 -05:00
Calvin Rose
05d0b5ac05 Add mostly stubbed filewatch test suite. 2024-08-18 14:42:44 -05:00
Calvin Rose
c56d6e8fc1 Add suite for testing filewatch.
Currently expects windows events.
2024-08-18 10:12:33 -07:00
Calvin Rose
33d2f9a522 More changes how we use WideCharToMutliByte
Handle case where there is no data pushed in.
2024-08-18 07:23:06 -07:00
Calvin Rose
e53d22fad2 Add unlisten for linux. 2024-08-18 06:25:25 -07:00
Calvin Rose
33f55dc32f Go back to ReadDirectoryChangesExW since it is better. 2024-08-18 05:29:08 -07:00
Calvin Rose
7e6aad2221 filewatch/make -> filewatch/new
Add support for :recursive on windows.
2024-08-17 16:37:30 -07:00
Calvin Rose
3c0c22259c ReadDirectoryChangesExW is only supported in recent windows.
Also break mingw builds it seems.
2024-08-17 13:33:39 -07:00
Calvin Rose
42f6af4bf1 First working version of filewatch on windows. 2024-08-17 12:37:58 -07:00
Calvin Rose
f274b02653 More changes for filewatch windows. 2024-08-17 10:26:43 -05:00
Calvin Rose
70c29b4e5d More updates to windows build. 2024-08-17 10:21:50 -05:00
Calvin Rose
84d43d1039 Add failure to initialize protections for filewatch module. 2024-08-17 10:12:36 -05:00
Calvin Rose
5c67c1165d Merge branch 'filewatch' 2024-08-17 10:08:37 -05:00
Calvin Rose
85028967d8 Add aliases for bundle/module - issue #1486
info.jdn -> bundle/info.jdn
bundle.janet -> bundle/init.janet
2024-08-17 09:58:40 -05:00
Calvin Rose
6ceff6ecc9 Work on the filewatch module.
Currently a wrapper around inotify, should be expanded to work with
kqueue, icop, and eventually a implementation with polling and stat.
2024-08-16 19:44:17 -05:00
Calvin Rose
06eec06ff0 More work on ICOP 2024-08-16 19:44:07 -05:00
Calvin Rose
2dcc0adc0e Merge pull request #1485 from sogaiu/tweak-add-bin-dest-arg
Prefix bin+sep to add-bin dest argument
2024-08-15 05:47:10 -07:00
sogaiu
8ca1e44af1 Prefix bin+sep to add-bin dest argument 2024-08-15 15:53:35 +09:00
Calvin Rose
2aedc6beff Begin stubbing out win32 abstraction.
Win32 abstraction will use ReadDirectoryChanges with overlapped
IO to get results. Some work will be required to allow for single file
watches, as well as allow for recursive watching on Linux.
Unfortunately, various operating systems have very differnet
abstractions here. I would rather expose inotify, kqueue, and
ReadDirectoryChanges fairly transparently before
adding shims to make cross platform code easier.
2024-08-14 21:24:27 -05:00
Calvin Rose
af2eb06298 Expose janet_channel_make and janet_channel_make_threaded 2024-08-14 17:34:48 -05:00
Calvin Rose
7ff545bd2e Stop out better configuration. 2024-08-11 18:43:10 -05:00
Calvin Rose
a59b5765b6 Work on the filewatch module.
Currently a wrapper around inotify, should be expanded to work with
kqueue, icop, and eventually a implementation with polling and stat.
2024-08-11 17:50:58 -05:00
Calvin Rose
6bd58dd4c0 Update CHANGELOG.md 2024-08-11 08:47:10 -05:00
Calvin Rose
e3406cd922 Update changelog and ensure consistent version strings. 2024-08-10 15:21:43 -05:00
Calvin Rose
ab70524d85 Add array/join and tuple/join
Utilities for combining indexed types more efficiently. `array/join`
also solves some interface issues with array/concat
2024-08-10 15:16:28 -05:00
Calvin Rose
ce36c4c0d6 Only raise IOCP error on readable, writable, or acceptable streams.
We may create streams whose sole purpose is to wrap a file descriptor
and therefor don't need to be IOCP enabled / nonblocking.
2024-08-06 07:08:16 -05:00
Calvin Rose
2b01b780da Only raise IOCP error on readable, writable, or acceptable streams.
We may create streams whose sole purpose is to wrap a file descriptor
and therefor don't need to be IOCP enabled / nonblocking.
2024-08-06 07:06:34 -05:00
Calvin Rose
f3048a3d6b Update documentation. 2024-08-05 20:17:00 -05:00
Calvin Rose
accac6c662 Add options to os/pipe for custom blocking behavior.
Useful for create pipelines on unix.

Also add bundle/whois to help diagnose where bundle installed files
came from.
2024-08-05 19:52:20 -05:00
Calvin Rose
631622aa48 Use gensym in do-compare macro.
Improve hygiene of macro in case later changes introduce subtle bugs.
2024-07-31 11:19:44 -05:00
Calvin Rose
aaeaa3a944 Add geomean function. 2024-07-31 09:47:00 -05:00
Calvin Rose
d1104b5a65 Merge pull request #1480 from pyrmont/bugfix.fallback-compare
Fix fallback support in polymorphic compare
2024-07-31 06:05:27 -07:00
Michael Camilleri
1f074671ce Fix polymorphic support in compare 2024-07-29 16:16:41 +09:00
Calvin Rose
872b39cc32 Add syntax literals for signed and unsigned 64 bit integers.
Number literals can now take an optional "representation" suffix

- Use `:n` for normal numbers (IEEE-754 doubles)
- Use `:s` for signed 64 bit integers
- Use `:u` for unsigned 64 bit integers
- Other suffix will fallthrough the usual parseing logic. This means
  that they will only possibly resolve to symbols if they start with -,
  +, or .

The syntax does not collide with any existing valid Janet and is only
enabled with JANET_INTTYPES. This also leaves open a syntax for other
number types such as bignums, ratios, decimals, etc.
2024-07-21 09:45:44 -05:00
Calvin Rose
9eab57d194 Merge pull request #1476 from sogaiu/no-warning-for-empty-body-loop 2024-07-18 05:05:59 -07:00
sogaiu
8edd873c3e Do not warn when loop body is empty 2024-07-18 12:02:39 +09:00
Calvin Rose
771956b5b6 Fix some -fsanitize=undefined behavior for #1475
Also fix issue with os/clock and default values that were incorrect.
The api shold have been a little nicer here to prevent this issue.
2024-07-17 08:50:02 -05:00
Calvin Rose
ecc4da5113 Include math.h for corelib.c
This is the downside of the forced amalgamated build. Strange build
constraints.
2024-07-13 12:44:46 -05:00
Calvin Rose
f5555d21b9 Update CHANGELOG.md 2024-07-13 12:43:35 -05:00
Calvin Rose
342a29c7be Fix formatting. 2024-07-12 15:22:46 -05:00
Calvin Rose
368b891499 Merge branch 'linspace-range' 2024-07-12 15:15:46 -05:00
Calvin Rose
f62539ad55 Add shorthand for installing scripts via bundle/add-bin.
Establishing a convention for scripts is beneficial for various tools.
However, we do not install scripts on anyones PATH - instead they go
to a self contained (dyn *syspath*) /bin folder which could be added to
path, or symlinks could be added.
2024-07-12 15:14:40 -05:00
Calvin Rose
4835ecb950 Work on making range take non-integer values. 2024-07-11 08:05:52 -05:00
Calvin Rose
31f0ff0d84 Merge pull request #1472 from Andriamanitra/compile-default-output-file
Add default output path for --compile (-c)
2024-07-08 05:14:33 -07:00
Andriamanitra
b7b594205c Add default output path for --compile (-c) 2024-07-08 11:55:50 +03:00
Calvin Rose
190056b863 Merge pull request #1471 from Darazaki/repl-ctrl-arrow
Add ctrl + left/right arrow support to the REPL
2024-07-03 12:58:16 -07:00
Naqua Darazaki
ae6b359109 Add ctrl + left/right arrow support to the REPL
Ctrl + left/right arrow would simply input "5D"/"5C" into the REPL
which was useless and confusing

With this change, it instead goes to the previous/next word which is
usually expected in readline-like interfaces
2024-07-03 14:17:57 +02:00
Calvin Rose
3078686f8f Merge pull request #1468 from SyrupThinker/st/aarch64_ffi
Add support for the AAPCS64 calling convention
2024-06-26 06:55:04 -07:00
Calvin Rose
0f4ecd93ab Fix #1469 2024-06-26 08:54:26 -05:00
Valentin Anger
4af187d0ca Add support for the AAPCS64 calling convention 2024-06-23 18:22:25 +02:00
Calvin Rose
a5d6b22838 Check for __GLIBC__ instead of _GNU_SOURCE
musl doesn't obey this behavior.
2024-06-21 17:17:22 -05:00
Calvin Rose
fda0a081f5 Fix quoting for import. 2024-06-16 10:57:14 -05:00
Calvin Rose
94b7a69741 More fixes for patch release. 2024-06-16 10:22:49 -05:00
Calvin Rose
6518257129 Merge pull request #1460 from pnelson/fix-typos
Fix typos
2024-06-16 08:21:52 -07:00
Calvin Rose
dc325188d0 Prepare for 1.35.1 2024-06-16 10:20:01 -05:00
Philip Nelson
0b51ab157d Fix typos 2024-06-16 06:59:27 -07:00
Calvin Rose
f95de25b15 Update docstrings. 2024-06-16 07:58:38 -05:00
Calvin Rose
f424f2936b Merge pull request #1459 from sogaiu/dynvar-docstring-tweaks
Tweak some docstrings
2024-06-16 05:50:43 -07:00
sogaiu
2d6c2ee7c0 Tweak some dyn var docstrings 2024-06-16 08:48:30 +09:00
Calvin Rose
7cd106a10c Prepare for 1.35.0 release. 2024-06-15 16:11:32 -05:00
Calvin Rose
0d9e999113 Prepare for 1.35.0 release. 2024-06-15 07:11:48 -05:00
Calvin Rose
75710ccabd Error on buffer/push-uint16 with non 16 bit unsigned integer. 2024-06-15 06:47:47 -05:00
Calvin Rose
0f60115f27 Merge pull request #1457 from pnelson/buffer-push-uint
Fix buffer push uint max
2024-06-15 06:31:46 -05:00
Philip Nelson
16a3c85baa Fix buffer push uint max 2024-06-14 18:15:31 -07:00
Calvin Rose
92ff1d3be4 Add only option to merge-module and import.
This allows importing only selected bindings.

For example,

    (import foo :only [bar baz])

    (foo/bar) # works
    (foo/buzz) # doesn't work, even if the foo module has a buzz
    function.
2024-06-14 17:01:27 -05:00
Calvin Rose
58441dc49f Update gitignore. 2024-06-12 19:22:08 -05:00
118 changed files with 3512 additions and 712 deletions

View File

@@ -19,3 +19,8 @@ tasks:
ninja
ninja test
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

@@ -27,15 +27,16 @@ jobs:
uses: actions/checkout@v3
- name: Initialize CodeQL
uses: github/codeql-action/init@v2
uses: github/codeql-action/init@v3
with:
languages: ${{ matrix.language }}
queries: +security-and-quality
tools: linked
- name: Autobuild
uses: github/codeql-action/autobuild@v2
uses: github/codeql-action/autobuild@v3
- name: Perform CodeQL Analysis
uses: github/codeql-action/analyze@v2
uses: github/codeql-action/analyze@v3
with:
category: "/language:${{ matrix.language }}"

View File

@@ -17,7 +17,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest ]
os: [ ubuntu-latest, macos-13 ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -39,6 +39,35 @@ jobs:
build/c/janet.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:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, macos-latest ]
os: [ ubuntu-latest, macos-latest, macos-13 ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -23,7 +23,10 @@ jobs:
test-windows:
name: Build and test on Windows
runs-on: windows-latest
strategy:
matrix:
os: [ windows-latest, windows-2019 ]
runs-on: ${{ matrix.os }}
steps:
- name: Checkout the repository
uses: actions/checkout@master
@@ -35,28 +38,61 @@ jobs:
- name: Test the project
shell: cmd
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:
name: Build on Windows with Mingw (no test yet)
name: Build on Windows with Mingw
runs-on: windows-latest
defaults:
run:
shell: msys2 {0}
strategy:
matrix:
msystem: [ UCRT64, CLANG64 ]
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: Setup Mingw
uses: msys2/setup-msys2@v2
with:
msystem: UCRT64
msystem: ${{ matrix.msystem }}
update: true
install: >-
base-devel
git
gcc
- name: Build the project
- name: Build
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:
name: Build and test with Mingw on Linux + Wine
@@ -86,6 +122,17 @@ jobs:
sudo apt-get update
sudo apt-get install gcc-arm-linux-gnueabi qemu-user
- 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
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: Enable qemu
run: docker run --privileged --rm tonistiigi/binfmt --install s390x
- name: Build and run on emulated architecture
run: docker run --rm -v .:/janet --platform linux/s390x alpine sh -c "apk update && apk add --no-interactive git build-base && cd /janet && make -j3 && make test"

1
.gitignore vendored
View File

@@ -49,6 +49,7 @@ janet.wasm
*.gen.h
*.gen.c
*.tmp
temp.*
# Generate test files
*.out

View File

@@ -1,7 +1,58 @@
# Changelog
All notable changes to this project will be documented in this file.
## Unreleased - ???
## 1.38.0 - 2025-03-18
- Add `bundle/replace`
- Add CLI flags for the `bundle/` module to install and manage bundles.
- Improve `?` peg special termination behavior
- Add IEEE hex floats to grammar.
- Add buffer peg literal support
- Improve `split` peg special edge case behavior
- Add Arm64 .msi support
- Add `no-reuse` argument to `net/listen` to disable reusing server sockets
- Add `struct/rawget`
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys
- Long strings will now dedent on `\r\n` instead of just `\n`.
- Add `ev/to-file` for synchronous resource operations
- Improve `file/open` error message by including path
## 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 `geomean` function
- 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.
- Add `array/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
- Fix some documentation typos.
- Allow using `:only` in import without quoting.
## 1.35.0 - 2024-06-15
- Add `:only` argument to `import` to allow for easier control over imported bindings.
- Add extra optional `env` argument to `eval` and `eval-string`.
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
accidentally adding new bindings.
@@ -113,7 +164,7 @@ All notable changes to this project will be documented in this file.
See http://no-color.org/
- Disallow using `(splice x)` in contexts where it doesn't make sense rather than silently coercing to `x`.
Instead, raise a compiler error.
- Change the names of `:user8` and `:user9` sigals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` signals to `:interrupt` and `:await`
- Change the names of `:user8` and `:user9` fiber statuses to `:interrupted` and `:suspended`.
- Add `ev/all-tasks` to see all currently suspended fibers.
- Add `keep-syntax` and `keep-syntax!` functions to make writing macros easier.
@@ -284,7 +335,7 @@ All notable changes to this project will be documented in this file.
- Add the ability to close channels with `ev/chan-close` (or `:close`).
- Add threaded channels with `ev/thread-chan`.
- Add `JANET_FN` and `JANET_REG` macros to more easily define C functions that export their source mapping information.
- Add `janet_interpreter_interupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `janet_interpreter_interrupt` and `janet_loop1_interrupt` to interrupt the interpreter while running.
- Add `table/clear`
- Add build option to disable the threading library without disabling all threads.
- Remove JPM from the main Janet distribution. Instead, JPM must be installed
@@ -338,7 +389,7 @@ saving and restoring the entire VM state.
- Sort keys in pretty printing output.
## 1.15.3 - 2021-02-28
- Fix a fiber bug that occured in deeply nested fibers
- Fix a fiber bug that occurred in deeply nested fibers
- Add `unref` combinator to pegs.
- Small docstring changes.
@@ -488,13 +539,13 @@ saving and restoring the entire VM state.
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Change `compare-primitive` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexadecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18

View File

@@ -1,4 +1,4 @@
Copyright (c) 2023 Calvin Rose and contributors
Copyright (c) 2025 Calvin Rose and contributors
Permission is hereby granted, free of charge, to any person obtaining a copy of
this software and associated documentation files (the "Software"), to deal in

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -43,6 +43,7 @@ JANET_DIST_DIR?=janet-dist
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
JPM_TAG?=master
SPORK_TAG?=master
HAS_SHARED?=1
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
@@ -56,6 +57,7 @@ LDFLAGS?=-rdynamic
LIBJANET_LDFLAGS?=$(LD_FLAGS)
RUN:=$(RUN)
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
@@ -93,12 +95,18 @@ endif
endif
# Mingw
MINGW_COMPILER=
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
MINGW_COMPILER=gcc
CLIBS:=-lws2_32 -lpsapi -lwsock32
LDFLAGS:=-Wl,--out-implib,$(JANET_IMPORT_LIB)
LIBJANET_LDFLAGS:=-Wl,--out-implib,$(JANET_LIBRARY_IMPORT_LIB)
JANET_TARGET:=$(JANET_TARGET).exe
JANET_BOOT:=$(JANET_BOOT).exe
COMPILER_VERSION:=$(shell $(CC) --version)
ifeq ($(findstring clang,$(COMPILER_VERSION)), clang)
MINGW_COMPILER=clang
endif
endif
@@ -139,6 +147,7 @@ JANET_CORE_SOURCES=src/core/abstract.c \
src/core/ev.c \
src/core/ffi.c \
src/core/fiber.c \
src/core/filewatch.c \
src/core/gc.c \
src/core/inttypes.c \
src/core/io.c \
@@ -204,9 +213,14 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.34.dylib
SONAME=libjanet.1.38.dylib
else
SONAME=libjanet.so.1.34
SONAME=libjanet.so.1.38
endif
ifeq ($(MINGW_COMPILER), clang)
SONAME=
SONAME_SETTER=
endif
build/c/shell.c: src/mainclient/shell.c
@@ -358,6 +372,12 @@ install-jpm-git: $(JANET_TARGET)
JANET_LIBPATH='$(LIBDIR)' \
$(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:
-rm '$(DESTDIR)$(BINDIR)/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;
[![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?)
@@ -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
<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>
## Examples
@@ -210,7 +207,7 @@ Alternatively, install the package directly with `pkgin install janet`.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases).
6. Run `build_win dist`.
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.
@@ -253,8 +250,10 @@ Emacs, and Atom each have syntax packages for the Janet language, though.
## Installation
See the [Introduction](https://janet-lang.org/docs/index.html) for more details. If you just want
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
If you just want to try out the language, you don't need to install anything.
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

View File

@@ -50,6 +50,7 @@ for %%f in (src\boot\*.c) do (
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
@if not errorlevel 0 goto :BUILDFAIL
build\janet_boot . > build\c\janet.c
@if not errorlevel 0 goto :BUILDFAIL
@rem Build the sources
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
@@ -59,6 +60,7 @@ build\janet_boot . > build\c\janet.c
@rem Build the resources
rc /nologo /fobuild\janet_win.res janet_win.rc
@if not errorlevel 0 goto :BUILDFAIL
@rem Link everything to main client
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
@@ -89,7 +91,7 @@ exit /b 0
@rem Clean build artifacts
:CLEAN
del *.exe *.lib *.exp
del *.exe *.lib *.exp *.msi *.wixpdb
rd /s /q build
if exist dist (
rd /s /q dist
@@ -119,7 +121,6 @@ copy README.md dist\README.md
copy janet.lib dist\janet.lib
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
copy build\janet.h dist\janet.h
@@ -137,11 +138,18 @@ if defined APPVEYOR_REPO_TAG_NAME (
set RELEASE_VERSION=%JANET_VERSION%
)
if defined CI (
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
set WIXBIN="%WIX%bin\"
echo WIXBIN = %WIXBIN%
) else (
set WIXBIN=
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
set WIXARCH=%BUILDARCH%
if "%WIXARCH%"=="aarch64" (
set WIXARCH=arm64
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
exit /b 0

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

@@ -35,6 +35,11 @@ typedef struct {
int c;
} intintint;
typedef struct {
uint64_t a;
uint64_t b;
} uint64pair;
typedef struct {
int64_t a;
int64_t b;
@@ -203,3 +208,20 @@ EXPORTER
int sixints_fn_3(SixInts s, int x) {
return x + s.u + s.v + s.w + s.x + s.y + s.z;
}
EXPORTER
intint stack_spill_fn(uint8_t a, uint8_t b, uint8_t c, uint8_t d,
uint8_t e, uint8_t f, uint8_t g, uint8_t h,
float i, float j, float k, float l,
float m, float n, float o, float p,
float s1, int8_t s2, uint8_t s3, double s4, uint8_t s5, intint s6) {
return (intint) {
(a | b | c | d | e | f | g | h) + (i + j + k + l + m + n + o + p),
s1 *s6.a + s2 *s6.b + s3 *s4 *s5
};
}
EXPORTER
double stack_spill_fn_2(uint64pair a, uint64pair b, uint64pair c, int8_t d, uint64pair e, int8_t f) {
return (double)(a.a * c.a + a.b * c.b + b.a * e.a) * f - (double)(b.b * e.b) + d;
}

View File

@@ -8,11 +8,13 @@
(if is-windows
(os/execute ["cl.exe" "/nologo" "/LD" ffi/source-loc "/link" "/DLL" (string "/OUT:" ffi/loc)] :px)
(os/execute ["cc" ffi/source-loc "-shared" "-o" ffi/loc] :px))
(os/execute ["cc" ffi/source-loc "-g" "-shared" "-o" ffi/loc] :px))
(ffi/context ffi/loc)
(def intint (ffi/struct :int :int))
(def intintint (ffi/struct :int :int :int))
(def uint64pair (ffi/struct :u64 :u64))
(def big (ffi/struct :s64 :s64 :s64))
(def split (ffi/struct :int :int :float :float))
(def split-flip (ffi/struct :float :float :int :int))
@@ -55,6 +57,13 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind stack-spill-fn intint
[a :u8 b :u8 c :u8 d :u8
e :u8 f :u8 g :u8 h :u8
i :float j :float k :float l :float
m :float n :float o :float p :float
s1 :float s2 :s8 s3 :u8 s4 :double s5 :u8 s6 intint])
(ffi/defbind stack-spill-fn-2 :double [a uint64pair b uint64pair c uint64pair d :s8 e uint64pair f :s8])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
@@ -132,5 +141,10 @@
(assert (= 21 (math/round (double-many 1 2 3 4 5 6.01))))
(assert (= 19 (double-lots 1 2 3 4 5 6 7 8 9 10)))
(assert (= 204 (float-fn 8 4 17)))
(assert (= [0 38534415] (stack-spill-fn
0 0 0 0 0 0 0 0
0 0 0 0 0 0 0 0
1.5 -32 196 65536.5 3 [-15 32])))
(assert (= -2806 (stack-spill-fn-2 [2 3] [5 7] [9 11] -19 [13 17] -23)))
(print "Done.")

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

@@ -0,0 +1 @@
(defn fun [x] (range x))

View File

@@ -0,0 +1,3 @@
(defn install
[manifest &]
(bundle/add-file manifest "aliases-mod.janet"))

View File

@@ -0,0 +1,4 @@
@{
:name "sample-bundle-aliases"
:dependencies ["sample-dep1" "sample-dep2"]
}

View File

@@ -255,7 +255,8 @@ and then arguments to the script.
.RS
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
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
.B JANET_PROFILE

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose and contributors
# Copyright (c) 2025 Calvin Rose and contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -20,16 +20,34 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.34.0')
version : '1.38.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
# Link math library on all systems
# Compilers
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)
dl_dep = cc.find_library('dl', required : false)
# for MINGW/MSYS2
native_ws2_dep = native_cc.find_library('ws2_32', required: false)
native_psapi_dep = native_cc.find_library('psapi', required: false)
native_wsock_dep = native_cc.find_library('wsock32', required: false)
ws2_dep = cc.find_library('ws2_32', required: false)
psapi_dep = cc.find_library('psapi', required: false)
wsock_dep = cc.find_library('wsock32', required: false)
android_spawn_dep = cc.find_library('android-spawn', required : false)
thread_dep = dependency('threads')
@@ -79,6 +97,7 @@ conf.set('JANET_EV_NO_KQUEUE', not get_option('kqueue'))
conf.set('JANET_NO_INTERPRETER_INTERRUPT', not get_option('interpreter_interrupt'))
conf.set('JANET_NO_FFI', not get_option('ffi'))
conf.set('JANET_NO_FFI_JIT', not get_option('ffi_jit'))
conf.set('JANET_NO_FILEWATCH', not get_option('filewatch'))
conf.set('JANET_NO_CRYPTORAND', not get_option('cryptorand'))
if get_option('os_name') != ''
conf.set('JANET_OS_NAME', get_option('os_name'))
@@ -122,6 +141,7 @@ core_src = [
'src/core/ev.c',
'src/core/ffi.c',
'src/core/fiber.c',
'src/core/filewatch.c',
'src/core/gc.c',
'src/core/inttypes.c',
'src/core/io.c',
@@ -162,11 +182,18 @@ mainclient_src = [
'src/mainclient/shell.c'
]
janet_dependencies = [m_dep, dl_dep, android_spawn_dep, ws2_dep, psapi_dep, wsock_dep]
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep, native_ws2_dep, native_psapi_dep, native_wsock_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
janet_native_dependencies += native_thread_dep
endif
# Build boot binary
janet_boot = executable('janet-boot', core_src, boot_src,
include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
dependencies : janet_native_dependencies,
native : true)
# Build janet.c
@@ -179,11 +206,6 @@ janetc = custom_target('janetc',
'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
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
@@ -229,7 +251,7 @@ if meson.is_cross_build()
endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
dependencies : janet_native_dependencies,
c_args : extra_native_cflags,
native : true)
else
@@ -257,6 +279,7 @@ test_files = [
'test/suite-debug.janet',
'test/suite-ev.janet',
'test/suite-ffi.janet',
'test/suite-filewatch.janet',
'test/suite-inttypes.janet',
'test/suite-io.janet',
'test/suite-marsh.janet',
@@ -271,6 +294,7 @@ test_files = [
'test/suite-struct.janet',
'test/suite-symcache.janet',
'test/suite-table.janet',
'test/suite-tuple.janet',
'test/suite-unknown.janet',
'test/suite-value.janet',
'test/suite-vm.janet'

View File

@@ -22,6 +22,7 @@ option('kqueue', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : true)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)
option('filewatch', type : 'boolean', value : true)
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
# The core janet library
# Copyright 2024 © Calvin Rose
# Copyright 2025 © Calvin Rose
###
###
@@ -39,6 +39,7 @@
(buffer/format buf "%j" (in args index))
(set index (+ index 1)))
(array/push modifiers (string buf ")\n\n" docstr))
(if (dyn :debug) (array/push modifiers {:source-form (dyn :macro-form)}))
# Build return value
~(def ,name ,;modifiers (fn ,name ,;(tuple/slice more start)))))
@@ -116,7 +117,7 @@
(defn nil? "Check if x is nil." [x] (= x nil))
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
# For macros, we define an imcomplete odd? function that will be overriden.
# For macros, we define an incomplete odd? function that will be overridden.
(defn odd? [x] (= 1 (mod x 2)))
(def- non-atomic-types
@@ -153,11 +154,66 @@
,v
(,error ,(if err err (string/format "assert failure in %j" x))))))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".``
[alias & more]
(assert (symbol? alias) "alias must be a symbol")
(assert (> (length alias) 2) "name must have leading and trailing '*' characters")
(assert (= 42 (get alias 0) (get alias (- (length alias) 1))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
~(def ,alias :dyn ,;more ,kw))
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
(defdyn *lint-error*
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
(defdyn *lint-warn*
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
(defdyn *lint-levels*
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
(defdyn *macro-lints*
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
To indicate an error or warning, a macro author should use `maclintf`.``)
(defn maclintf
``When inside a macro, call this function to add a linter warning. Takes
a `fmt` argument like `string/format`, which is used to format the message.``
[level fmt & args]
(def lints (dyn *macro-lints*))
(if lints
(do
(def form (dyn *macro-form*))
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
(def l (if (not= -1 l) l))
(def c (if (not= -1 c) c))
(def msg (string/format fmt ;args))
(array/push lints [level l c msg])))
nil)
(defn errorf
"A combination of `error` and `string/format`. Equivalent to `(error (string/format fmt ;args))`."
[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
``Define a default value for an optional argument.
Expands to `(def sym (if (= nil sym) val sym))`.``
@@ -531,6 +587,11 @@
[x ds & body]
(each-template x ds :each body))
(defn- check-empty-body
[body]
(if (= (length body) 0)
(maclintf :normal "empty loop body")))
(defmacro loop
```
A general purpose loop macro. This macro is similar to the Common Lisp loop
@@ -609,6 +670,7 @@
See `loop` for details.``
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
(defmacro catseq
@@ -616,6 +678,7 @@
See `loop` for details.``
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
(defmacro tabseq
@@ -629,6 +692,7 @@
``Create a generator expression using the `loop` syntax. Returns a fiber
that yields all values inside the loop in order. See `loop` for details.``
[head & body]
(check-empty-body body)
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
(defmacro coro
@@ -658,6 +722,19 @@
(each x xs (+= accum x) (++ total))
(/ accum total))))
(defn geomean
"Returns the geometric mean of xs. If empty, returns NaN."
[xs]
(if (lengthable? xs)
(do
(var accum 0)
(each x xs (+= accum (math/log x)))
(math/exp (/ accum (length xs))))
(do
(var [accum total] [0 0])
(each x xs (+= accum (math/log x)) (++ total))
(math/exp (/ accum total)))))
(defn product
"Returns the product of xs. If xs is empty, returns 1."
[xs]
@@ -766,11 +843,21 @@
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(def f (gensym))
(def f-res (gensym))
(def g (gensym))
(def g-res (gensym))
~(do
(def ,f (,get ,x :compare))
(def ,f-res (if ,f (,f ,x ,y)))
(if ,f-res
,f-res
(do
(def ,g (,get ,y :compare))
(def ,g-res (if ,g (,- (,g ,y ,x))))
(if ,g-res
,g-res
(,cmp ,x ,y))))))
(defn compare
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
@@ -909,7 +996,7 @@
(defn reduce2
``The 2-argument version of `reduce` that does not take an initialization value.
Instead, the first element of the array is used for initialization.``
Instead, the first element of the array is used for initialization. If `ind` is empty, will evaluate to nil.``
[f ind]
(var k (next ind))
(if (= nil k) (break nil))
@@ -1207,19 +1294,6 @@
(array/push parts (tuple apply f $args)))
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
alias is a normal, lexically scoped binding that can be used instead of
a keyword to prevent typos. `defdyn` does not set dynamic bindings or otherwise
replace `dyn` and `setdyn`. The alias _must_ start and end with the `*` character, usually
called "earmuffs".``
[alias & more]
(assert (symbol? alias) "alias must be a symbol")
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
~(def ,alias :dyn ,;more ,kw))
(defn has-key?
"Check if a data structure `ds` contains the key `key`."
[ds key]
@@ -1237,21 +1311,9 @@
(defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.")
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
(defdyn *macro-form*
"Inside a macro, is bound to the source form that invoked the macro")
(defdyn *lint-error*
"The current lint error level. The error level is the lint level at which compilation will exit with an error and not continue.")
(defdyn *lint-warn*
"The current lint warning level. The warning level is the lint level at which and error will be printed but compilation will continue as normal.")
(defdyn *lint-levels*
"A table of keyword alias to numbers denoting a lint level. Can be used to provided custom aliases for numeric lint levels.")
(defdyn *current-file*
"Bound to the name of the currently compiling file.")
@@ -1801,6 +1863,9 @@
(defdyn *pretty-format*
"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
``Pretty-print to stdout or `(dyn *out*)`. The format string used is `(dyn *pretty-format* "%q")`.``
[x]
@@ -2035,24 +2100,6 @@
###
###
(defdyn *macro-lints*
``Bound to an array of lint messages that will be reported by the compiler inside a macro.
To indicate an error or warning, a macro author should use `maclintf`.``)
(defn maclintf
``When inside a macro, call this function to add a linter warning. Takes
a `fmt` argument like `string/format`, which is used to format the message.``
[level fmt & args]
(def lints (dyn *macro-lints*))
(when lints
(def form (dyn *macro-form*))
(def [l c] (if (tuple? form) (tuple/sourcemap form) [nil nil]))
(def l (if-not (= -1 l) l))
(def c (if-not (= -1 c) c))
(def msg (string/format fmt ;args))
(array/push lints [level l c msg]))
nil)
(defn macex1
``Expand macros in a form, but do not recursively expand macros.
See `macex` docs for info on `on-binding`.``
@@ -2172,56 +2219,31 @@
(map-template :some res pred ind inds)
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
`Freeze an object (make it immutable) and do a deep copy, making
child values also immutable. Closures, fibers, and abstract types
will not be recursively frozen, but all other types will.`
[x]
(case (type x)
:array (tuple/slice (map freeze x))
:tuple (tuple/slice (map freeze x))
:table (if-let [p (table/getproto x)]
(freeze (merge (table/clone p) x))
(struct ;(map freeze (kvs x))))
:struct (struct ;(map freeze (kvs x)))
:buffer (string x)
(def tx (type x))
(cond
(or (= tx :array) (= tx :tuple))
(tuple/slice (map freeze x))
(or (= tx :table) (= tx :struct))
(let [temp-tab @{}]
# Handle multiple unique keys that freeze. Result should
# be independent of iteration order.
(eachp [k v] x
(def kk (freeze k))
(def vv (freeze v))
(def old (get temp-tab kk))
(def new (if (= nil old) vv (max vv old)))
(put temp-tab kk new))
(table/to-struct temp-tab (freeze (getproto x))))
(= tx :buffer)
(string x)
x))
(defn thaw
@@ -2237,6 +2259,41 @@
:string (buffer 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 :struct) struct/rawget table/rawget))
(var ret false)
(eachp [k v] x
(if (deep-not= (rawget y k) 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
``Expand macros completely.
`on-binding` is an optional callback for whenever a normal symbolic binding
@@ -2288,17 +2345,11 @@
(defmacro short-fn
```
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the 0-indexed
argument of the function. `$` is also an alias for the first (index 0) argument.
The `$&` symbol will make the anonymous function variadic if it appears in the
body of the function, and can be combined with positional arguments.
Example usage:
(short-fn (+ $ $)) # A function that doubles its arguments.
(short-fn (string $0 $1)) # accepting multiple args.
|(+ $ $) # use pipe reader macro for terse function literals.
|(+ $&) # variadic functions
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the
0-indexed argument of the function. `$` is also an alias for the
first (index 0) argument. The `$&` symbol will make the anonymous
function variadic if it appears in the body of the function, and
can be combined with positional arguments.
```
[arg &opt name]
(var max-param-seen -1)
@@ -2618,7 +2669,6 @@
(do
(var pindex 0)
(var pstatus nil)
(def len (length buf))
(when (= len 0)
(:eof p)
@@ -2654,7 +2704,7 @@
(defn eval
``Evaluates a form in the current environment. If more control over the
environment is needed, use `run-context`.``
environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.``
[form &opt env]
(def res (compile form env :eval))
(if (= (type res) :function)
@@ -2694,7 +2744,7 @@
(defn eval-string
``Evaluates a string in the current environment. If more control over the
environment is needed, use `run-context`.``
environment is needed, use `run-context`. Optionally pass in an `env` table with available bindings.``
[str &opt env]
(var ret nil)
(each x (parse-all str) (set ret (eval x env)))
@@ -2746,8 +2796,8 @@
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module-paths* "Dynamic binding for overriding `module/paths`")
(defdyn *module-loading* "Dynamic binding for overriding `module/loading`")
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
@@ -2793,6 +2843,24 @@
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
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 "/init.janet" :source)
(module/add-paths ".janet" :source)
@@ -3040,9 +3108,10 @@
``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro.
This lets users emulate the behavior of `import` with a custom module table.
If `export` is truthy, then merged functions are not marked as private. Returns
the modified target environment.``
[target source &opt prefix export]
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))]
the modified target environment. If a tuple or array `only` is passed, only merge keys in `only`.``
[target source &opt prefix export only]
(def only-set (if only (invert only)))
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))]
(def newv (table/setproto @{:private (not export)} v))
(put target (symbol prefix k) newv))
target)
@@ -3055,13 +3124,14 @@
(def kargs (table ;args))
(def {:as as
:prefix prefix
:export ep} kargs)
:export ep
:only only} kargs)
(def newenv (require-1 path args kargs))
(def prefix (or
(and as (string as "/"))
prefix
(string (last (string/split "/" path)) "/")))
(merge-module env newenv prefix ep))
(merge-module env newenv prefix ep only))
(defmacro import
``Import a module. First requires the module, and then merges its
@@ -3071,10 +3141,11 @@
to re-export the imported symbols. If "`:exit true`" is given as an argument,
any errors encountered at the top level in the module will cause `(os/exit 1)`
to be called. Dynamic bindings will NOT be imported. Use :fresh to bypass the
module cache.``
module cache. Use `:only [foo bar baz]` to only import select bindings into the
current environment.``
[path & args]
(def ps (partition 2 args))
(def argm (mapcat (fn [[k v]] [k (if (= k :as) (string v) v)]) ps))
(def argm (mapcat (fn [[k v]] [k (case k :as (string v) :only ~(quote ,v) v)]) ps))
(tuple import* (string path) ;argm))
(defmacro use
@@ -3742,7 +3813,7 @@
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
(defmacro ev/with-wlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
``Run a body of code after acquiring write access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
@@ -3806,8 +3877,8 @@
(compwhen (dyn 'net/listen)
(defn net/server
"Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream."
[host port &opt handler type]
(def s (net/listen host port type))
[host port &opt handler type no-reuse]
(def s (net/listen host port type no-reuse))
(if handler
(ev/go (fn [] (net/accept-loop s handler))))
s))
@@ -3844,7 +3915,7 @@
(string/replace-all "-" "_" name))
(defn ffi/context
"Set the path of the dynamic library to implictly bind, as well
"Set the path of the dynamic library to implicitly bind, as well
as other global state for ease of creating native bindings."
[&opt native-path &named map-symbols lazy]
(default map-symbols default-mangle)
@@ -3876,7 +3947,7 @@
(defn make-sig []
(ffi/signature :default real-ret-type ;computed-type-args))
(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
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
@@ -3913,7 +3984,7 @@
(def- safe-forms {'defn true 'varfn true 'defn- true 'defmacro true 'defmacro- true
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
'defglobal is-safe-def 'varglobal is-safe-def})
'defglobal is-safe-def 'varglobal is-safe-def 'defdyn true})
(def- importers {'import true 'import* true 'dofile true 'require true})
(defn- use-2 [evaluator args]
@@ -4019,15 +4090,18 @@
(defn- copyfile
[from to]
(def mode (os/stat from :permissions))
(def b (buffer/new 0x10000))
(with [ffrom (file/open from :rb)]
(with [fto (file/open to :wb)]
(forever
(file/read ffrom 0x10000 b)
(when (empty? b) (buffer/trim b) (os/chmod to mode) (break))
(file/write fto b)
(buffer/clear b)))))
(if-with [ffrom (file/open from :rb)]
(if-with [fto (file/open to :wb)]
(do
(def perm (os/stat from :permissions))
(def b (buffer/new 0x10000))
(forever
(file/read ffrom 0x10000 b)
(when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
(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
[from to]
@@ -4044,13 +4118,17 @@
[manifest]
(def bn (get manifest :name))
(def manifest-name (get-manifest-filename bn))
(spit manifest-name (string/format "%j\n" manifest)))
(def b @"")
(buffer/format b "%j" manifest) # make sure it is valid jdn
(buffer/clear b)
(buffer/format b "%.99m\n" manifest)
(spit manifest-name b))
(defn bundle/manifest
"Get the manifest for a give installed bundle"
[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)))
(defn- get-bundle-module
@@ -4063,7 +4141,7 @@
(os/cd workdir)
([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
(defer (os/cd dir)
(def new-env (make-env (curenv)))
(def new-env (make-env))
(put new-env *module-cache* @{})
(put new-env *module-loading* @{})
(put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env)))
@@ -4078,7 +4156,6 @@
[module bundle-name hook & args]
(def hookf (module/value module (symbol hook)))
(unless hookf (break))
(def manifest (bundle/manifest bundle-name))
(def dir (os/cwd))
(os/cd (get module :workdir "."))
(defer (os/cd dir)
@@ -4176,14 +4253,15 @@
(not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install
"Install a bundle from the local filesystem with a name `bundle-name`."
"Install a bundle from the local filesystem. The name of the bundle will be inferred from the bundle, or passed as a parameter :name in `config`."
[path &keys config]
(def path (bundle-rpath path))
(def clean (get config :clean))
(def check (get config :check))
(def s (sep))
# Check meta file for dependencies and default name
(def infofile-pre (string path s "bundle" s "info.jdn"))
(def infofile-pre-1 (string path s "bundle" s "info.jdn"))
(def infofile-pre (if (fexists infofile-pre-1) infofile-pre-1 (string path s "info.jdn"))) # allow for alias
(var default-bundle-name nil)
(when (os/stat infofile-pre :mode)
(def info (-> infofile-pre slurp parse))
@@ -4192,17 +4270,19 @@
(def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
(when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
(def bundle-name (get config :name default-bundle-name))
(assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path))
(assert (not (string/check-set "\\/" bundle-name))
(string "bundle name "
bundle-name
" cannot contain path separators"))
(assertf bundle-name "unable to infer bundle name for %v, use :name argument" path)
(assertf (not (string/check-set "\\/" bundle-name))
"bundle name %v cannot contain path separators" bundle-name)
(assert (next bundle-name) "cannot use empty bundle-name")
(assert (not (fexists (get-manifest-filename bundle-name)))
"bundle is already installed")
(assertf (not (fexists (get-manifest-filename bundle-name)))
"bundle %v is already installed" bundle-name)
# Setup installed paths
(prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name))
# Aliases for common bundle/ files
(def bundle.janet (string path s "bundle.janet"))
(when (fexists bundle.janet) (copyfile bundle.janet (bundle-file bundle-name "init.janet")))
(when (fexists infofile-pre) (copyfile infofile-pre (bundle-file bundle-name "info.jdn")))
# Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode))
@@ -4229,10 +4309,10 @@
(do-hook module bundle-name :clean man))
(do-hook module bundle-name :build 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?"))
(sync-manifest man))
(sync-manifest man)
(when check
(do-hook module bundle-name :check man)))
(print "installed " bundle-name)
bundle-name)
@@ -4244,7 +4324,7 @@
(var i 0)
(def man (bundle/manifest bundle-name))
(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))
(os/mkdir (string dest-dir s "bundle"))
(def install-hook (string dest-dir s "bundle" s "init.janet"))
@@ -4268,14 +4348,15 @@
(spit install-hook b))
dest-dir)
(defn bundle/reinstall
"Reinstall an existing bundle from the local source code."
[bundle-name &keys new-config]
(defn bundle/replace
"Reinstall an existing bundle from a new directory. Similar to bundle/reinstall,
but installs the replacement bundle from any directory. This is necesarry to replace a package without
breaking any dependencies."
[bundle-name path &keys new-config]
(def manifest (bundle/manifest bundle-name))
(def path (get manifest :local-source))
(def config (get manifest :config @{}))
(def s (sep))
(assert (= :directory (os/stat path :mode)) "local source not available")
(assertf (= :directory (os/stat path :mode)) "local source %v not available" path)
(def backup-dir (string (dyn *syspath*) s bundle-name ".backup"))
(rmrf backup-dir)
(def backup-bundle-source (bundle/pack bundle-name backup-dir true))
@@ -4288,6 +4369,14 @@
(rmrf backup-bundle-source)
bundle-name)
(defn bundle/reinstall
"Reinstall an existing bundle from the local source code."
[bundle-name &keys new-config]
(def manifest (bundle/manifest bundle-name))
(def path (get manifest :local-source))
(bundle/replace bundle-name path ;(kvs new-config))
bundle-name)
(defn bundle/add-directory
"Add a directory during the install process relative to `(dyn *syspath*)`"
[manifest dest &opt chmod-mode]
@@ -4303,6 +4392,19 @@
(print "add " absdest)
absdest)
(defn bundle/whois
"Given a file path, figure out which bundle installed it."
[path]
(var ret nil)
(def rpath (bundle-rpath path))
(each bundle-name (bundle/list)
(def files (get (bundle/manifest bundle-name) :files []))
(def has-file (index-of rpath files))
(when has-file
(set ret bundle-name)
(break)))
ret)
(defn bundle/add-file
"Add files during an install relative to `(dyn *syspath*)`"
[manifest src &opt dest chmod-mode]
@@ -4327,12 +4429,25 @@
[manifest src &opt dest chmod-mode]
(default dest src)
(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
(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))
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
`Shorthand for adding scripts during an install. Scripts will be installed to
(string (dyn *syspath*) "/bin") by default and will be set to be executable.`
[manifest src &opt dest chmod-mode]
(def s (sep))
(default dest (last (string/split s src)))
(default chmod-mode 8r755)
(os/mkdir (string (dyn *syspath*) s "bin"))
(bundle/add-file manifest src (string "bin" s dest) chmod-mode))
(defn bundle/update-all
"Reinstall all bundles"
@@ -4395,6 +4510,12 @@
"-nocolor" "n"
"-color" "N"
"-library" "l"
"-install" "b"
"-reinstall" "B"
"-uninstall" "u"
"-update-all" "U"
"-list" "L"
"-prune" "P"
"-lint-warn" "w"
"-lint-error" "x"})
@@ -4405,7 +4526,7 @@
(setdyn *args* args)
(var should-repl false)
(var should-repl nil)
(var no-file true)
(var quiet false)
(var raw-stdin false)
@@ -4418,7 +4539,12 @@
(var error-level nil)
(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))
(set colorize (and
(not (getenv-alias "NO_COLOR"))
@@ -4455,6 +4581,12 @@
--library (-l) lib : Use a module before processing more arguments
--lint-warn (-w) level : Set the lint warning level - default is "normal"
--lint-error (-x) level : Set the lint error level - default is "none"
--install (-b) dirpath : Install a bundle from a directory
--reinstall (-B) name : Reinstall a bundle by bundle name
--uninstall (-u) name : Uninstall a bundle by bundle name
--update-all (-U) : Reinstall all installed bundles
--prune (-P) : Uninstalled all bundles that are orphaned
--list (-L) : List all installed bundles
-- : Stop handling options
```)
(os/exit 0)
@@ -4472,7 +4604,13 @@
"c" (fn c-switch [i &]
(def path (in args (+ i 1)))
(def e (dofile path))
(spit (in args (+ i 2)) (make-image e))
(def output-path
(if (< (+ i 2) (length args))
(in args (+ i 2))
(string
(if (string/has-suffix? ".janet" path) (string/slice path 0 -7) path)
".jimage")))
(spit output-path (make-image e))
(set no-file false)
3)
"-" (fn [&] (set handleopts false) 1)
@@ -4493,6 +4631,30 @@
((thunk) ;subargs)
(error (get thunk :error)))
math/inf)
"b"
(compif (dyn 'bundle/install)
(fn [i &] (bundle/install (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
(fn [i &] (eprint "--install not supported with reduced os") 2))
"B"
(compif (dyn 'bundle/reinstall)
(fn [i &] (bundle/reinstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
(fn [i &] (eprint "--reinstall not supported with reduced os") 2))
"u"
(compif (dyn 'bundle/uninstall)
(fn [i &] (bundle/uninstall (in args (+ i 1))) (set no-file false) (if (= nil should-repl) (set should-repl false)) 2)
(fn [i &] (eprint "--uninstall not supported with reduced os") 2))
"P"
(compif (dyn 'bundle/prune)
(fn [i &] (bundle/prune) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
(fn [i &] (eprint "--prune not supported with reduced os") 1))
"U"
(compif (dyn 'bundle/update-all)
(fn [i &] (bundle/update-all) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
(fn [i &] (eprint "--update-all not supported with reduced os") 1))
"L"
(compif (dyn 'bundle/list)
(fn [i &] (each l (bundle/list) (print l)) (set no-file false) (if (= nil should-repl) (set should-repl false)) 1)
(fn [i &] (eprint "--list not supported with reduced os") 1))
"d" (fn [&] (set debug-flag true) 1)
"w" (fn [i &] (set warn-level (get-lint-level i)) 2)
"x" (fn [i &] (set error-level (get-lint-level i)) 2)
@@ -4544,17 +4706,15 @@
(if-not quiet
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch) "/" (os/compiler) " - '(doc)' for help"))
(flush)
(def env (make-env))
(defn getprompt [p]
(when-let [custom-prompt (get env *repl-prompt*)] (break (custom-prompt p)))
(def [line] (parser/where p))
(string "repl:" line ":" (parser/state p :delimiters) "> "))
(defn getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)
(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
(put env *debug* true)
(put env *redef* true))
@@ -4566,6 +4726,9 @@
(setdyn *doc-color* (if colorize true))
(setdyn *lint-error* 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)))))
###
@@ -4585,6 +4748,10 @@
(put flat :doc nil))
(when (boot/config :no-sourcemaps)
(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
(when-let [sm (get flat :source-map)]
(put flat :source-map [(string/replace-all "\\" "/" (sm 0)) (sm 1) (sm 2)]))
@@ -4642,6 +4809,7 @@
"src/core/ev.c"
"src/core/ffi.c"
"src/core/fiber.c"
"src/core/filewatch.c"
"src/core/gc.c"
"src/core/inttypes.c"
"src/core/io.c"

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -22,7 +22,7 @@
#include <janet.h>
#include <assert.h>
#include <stdio.h>
#include <string.h>
#include <math.h>
#include "tests.h"
@@ -35,6 +35,11 @@ int system_test() {
assert(sizeof(void *) == 8);
#endif
/* Check the version defines are self consistent */
char version_combined[256];
sprintf(version_combined, "%d.%d.%d%s", JANET_VERSION_MAJOR, JANET_VERSION_MINOR, JANET_VERSION_PATCH, JANET_VERSION_EXTRA);
assert(!strcmp(JANET_VERSION, version_combined));
/* Reflexive testing and nanbox testing */
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));

View File

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

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 34
#define JANET_VERSION_MINOR 38
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.34.0"
#define JANET_VERSION "1.38.0"
/* #define JANET_BUILD "local" */
@@ -29,6 +29,7 @@
/* #define JANET_NO_NET */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_EV */
/* #define JANET_NO_FILEWATCH */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -275,6 +275,31 @@ JANET_CORE_FN(cfun_array_concat,
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_join,
"(array/join arr & parts)",
"Join a variable number of arrays and tuples into the first argument, "
"which must be an array. "
"Return the modified array `arr`.") {
int32_t i;
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
for (i = 1; i < argc; i++) {
int32_t j, len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (array->data == vals) {
int32_t newcount = array->count + len;
janet_array_ensure(array, newcount, 2);
janet_indexed_view(argv[i], &vals, &len);
}
for (j = 0; j < len; j++)
janet_array_push(array, vals[j]);
}
return janet_wrap_array(array);
}
JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
@@ -385,6 +410,7 @@ void janet_lib_array(JanetTable *env) {
JANET_CORE_REG("array/remove", cfun_array_remove),
JANET_CORE_REG("array/trim", cfun_array_trim),
JANET_CORE_REG("array/clear", cfun_array_clear),
JANET_CORE_REG("array/join", cfun_array_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, array_cfuns);

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -140,7 +140,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in DS field of instruction */
old_jump_target = i + (((int32_t)instr) >> 8);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 8;
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 8;
break;
case JOP_JUMP_IF:
case JOP_JUMP_IF_NIL:
@@ -149,7 +149,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
/* relative pc is in ES field of instruction */
old_jump_target = i + (((int32_t)instr) >> 16);
new_jump_target = pc_map[old_jump_target];
instr += (new_jump_target - old_jump_target + (i - j)) << 16;
instr += (uint32_t)(new_jump_target - old_jump_target + (i - j)) << 16;
break;
default:
break;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -25,16 +25,19 @@
#include <janet.h>
#include "state.h"
#include "fiber.h"
#include "util.h"
#endif
#ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS
#include <pthread.h>
#else
#include <windows.h>
#endif
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
#ifdef JANET_USE_STDATOMIC
#include <stdatomic.h>
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
@@ -59,6 +62,18 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
void janet_signalv(JanetSignal sig, Janet message) {
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) {
#ifdef JANET_EV
if (NULL != janet_vm.root_fiber && sig == JANET_SIGNAL_EVENT) {
janet_vm.root_fiber->sched_id++;
}
#endif
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;
if (NULL != janet_vm.fiber) {
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;
@@ -303,11 +318,28 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint(x)) {
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
}
return janet_unwrap_integer(x);
return (uint32_t) janet_unwrap_number(x);
}
int16_t janet_getinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x);
}
return (int16_t) janet_unwrap_number(x);
}
uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x);
}
return (uint16_t) janet_unwrap_number(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);
@@ -446,6 +478,33 @@ void janet_setdyn(const char *name, Janet value) {
}
}
/* Create a function that when called, returns X. Trivial in Janet, a pain in C. */
JanetFunction *janet_thunk_delay(Janet x) {
static const uint32_t bytecode[] = {
JOP_LOAD_CONSTANT,
JOP_RETURN
};
JanetFuncDef *def = janet_funcdef_alloc();
def->arity = 0;
def->min_arity = 0;
def->max_arity = INT32_MAX;
def->flags = JANET_FUNCDEF_FLAG_VARARG;
def->slotcount = 1;
def->bytecode = janet_malloc(sizeof(bytecode));
def->bytecode_length = (int32_t)(sizeof(bytecode) / sizeof(uint32_t));
def->constants = janet_malloc(sizeof(Janet));
def->constants_length = 1;
def->name = NULL;
if (!def->bytecode || !def->constants) {
JANET_OUT_OF_MEMORY;
}
def->constants[0] = x;
memcpy(def->bytecode, bytecode, sizeof(bytecode));
janet_def_addflags(def);
/* janet_verify(def); */
return janet_thunk(def);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
uint64_t ret = 0;
const uint8_t *keyw = janet_getkeyword(argv, n);
@@ -501,8 +560,8 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
/* Atomic refcounts */
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedIncrement(x);
#ifdef _MSC_VER
return _InterlockedIncrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
#else
@@ -511,8 +570,8 @@ JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
}
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedDecrement(x);
#ifdef _MSC_VER
return _InterlockedDecrement(x);
#elif defined(JANET_USE_STDATOMIC)
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
#else
@@ -521,8 +580,8 @@ JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
}
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
#ifdef JANET_WINDOWS
return InterlockedOr(x, 0);
#ifdef _MSC_VER
return _InterlockedOr(x, 0);
#elif defined(JANET_USE_STDATOMIC)
return atomic_load_explicit(x, memory_order_acquire);
#else

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -262,7 +262,7 @@ void janetc_popscope(JanetCompiler *c);
void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot);
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destory slots */
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol */

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -432,27 +432,39 @@ JANET_CORE_FN(janet_core_range,
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
int32_t start = 0, stop = 0, step = 1, count = 0;
double start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
step = janet_getinteger(argv, 2);
count = (step > 0) ? (stop - start - 1) / step + 1 :
((step < 0) ? (stop - start + 1) / step + 1 : 0);
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
step = janet_getnumber(argv, 2);
count = (step > 0) ? (stop - start) / step :
((step < 0) ? (stop - start) / step : 0);
} else if (argc == 2) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
start = janet_getnumber(argv, 0);
stop = janet_getnumber(argv, 1);
count = stop - start;
} else {
stop = janet_getinteger(argv, 0);
stop = janet_getnumber(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
array->data[i] = janet_wrap_number(start + i * step);
int32_t int_count;
janet_assert(count >= 0, "bad range code");
if (count > (double) INT32_MAX) {
janet_panicf("range is too large, %f elements", count);
} else {
int_count = (int32_t) ceil(count);
}
array->count = count;
if (step > 0.0) {
janet_assert(start + int_count * step >= stop, "bad range code");
} else {
janet_assert(start + int_count * step <= stop, "bad range code");
}
JanetArray *array = janet_array(int_count);
for (int32_t i = 0; i < int_count; i++) {
array->data[i] = janet_wrap_number((double) start + (double) i * step);
}
array->count = int_count;
return janet_wrap_array(array);
}
@@ -689,7 +701,15 @@ JANET_CORE_FN(janet_core_is_lengthable,
JANET_CORE_FN(janet_core_signal,
"(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 payload = argc == 2 ? argv[1] : janet_wrap_nil();
if (janet_checkint(argv[0])) {
@@ -976,18 +996,17 @@ static void make_apply(JanetTable *env) {
/* Push the array */
S(JOP_PUSH_ARRAY, 5),
/* Call the funciton */
/* Call the function */
S(JOP_TAILCALL, 0)
};
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n"
"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 "
"be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000."));
"Applies a function f 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 be an array or a tuple. "
"Each element in this last argument is then also pushed as an "
"argument to f."));
}
static const uint32_t error_asm[] = {
@@ -1121,6 +1140,9 @@ static void janet_load_libs(JanetTable *env) {
#endif
#ifdef JANET_EV
janet_lib_ev(env);
#ifdef JANET_FILEWATCH
janet_lib_filewatch(env);
#endif
#endif
#ifdef JANET_NET
janet_lib_net(env);
@@ -1137,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"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."));
"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."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"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 "
"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 "
"returns nil, there are no more keys 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 "
"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 "
"returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
"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."));
"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."));
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
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,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n"
"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 "
"return the value that was passed to resume."));
"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 "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
"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 "
"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."));
"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 "
"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."));
janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n"
"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, "
"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."));
"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, "
"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."));
janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
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. "
"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 "
"an error."));
"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 "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error."));
janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n"
"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 "
"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 "
"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."));
"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 "
"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 "
"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."));
janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n"
"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."));
"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."));
janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@@ -1221,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
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,
JDOC("(- & xs)\n\n"
"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 "
"the rest of the elements."));
"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 "
"the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
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,
JDOC("(/ & xs)\n\n"
"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 "
"values."));
"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 "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"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 "
"values."));
"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 "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"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`."));
"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`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
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,
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,
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,
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,
JDOC("(blshift x & shifts)\n\n"
"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."));
"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."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n"
"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."));
"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."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n"
"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 "
"for positive shifts the return value will always be positive."));
"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 "
"for positive shifts the return value will always be positive."));
/* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
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,
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,
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,
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,
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,
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 */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@@ -1297,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program."));
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 "
"if native modules are compatible with the host program."));
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env),

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -102,7 +102,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
}
/* Error reporting. This can be emulated from within Janet, but for
* consitency with the top level code it is defined once. */
* consistency with the top level code it is defined once. */
void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
int32_t fi;

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -32,9 +32,11 @@
#ifdef JANET_EV
#include <math.h>
#include <fcntl.h>
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <io.h>
#else
#include <pthread.h>
#include <limits.h>
@@ -43,7 +45,6 @@
#include <signal.h>
#include <sys/ioctl.h>
#include <sys/types.h>
#include <fcntl.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <netdb.h>
@@ -74,7 +75,7 @@ typedef struct {
} mode;
} JanetChannelPending;
typedef struct {
struct JanetChannel {
JanetQueue items;
JanetQueue read_pending;
JanetQueue write_pending;
@@ -86,7 +87,7 @@ typedef struct {
#else
pthread_mutex_t lock;
#endif
} JanetChannel;
};
typedef struct {
JanetFiber *fiber;
@@ -255,6 +256,12 @@ static void add_timeout(JanetTimeout to) {
void janet_async_end(JanetFiber *fiber) {
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);
janet_gcunroot(janet_wrap_abstract(fiber->ev_stream));
fiber->ev_callback = NULL;
@@ -276,8 +283,7 @@ void janet_async_in_flight(JanetFiber *fiber) {
#endif
}
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
JanetFiber *fiber = janet_vm.root_fiber;
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
janet_assert(!fiber->ev_callback, "double async on fiber");
if (mode & JANET_ASYNC_LISTEN_READ) {
stream->read_fiber = fiber;
@@ -291,6 +297,10 @@ void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback
janet_gcroot(janet_wrap_abstract(stream));
fiber->ev_state = state;
callback(fiber, JANET_ASYNC_EVENT_INIT);
}
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
janet_async_start_fiber(janet_vm.root_fiber, stream, mode, callback, state);
janet_await();
}
@@ -316,8 +326,9 @@ static const JanetMethod ev_default_stream_methods[] = {
};
/* Create a stream*/
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
JanetStream *stream = janet_abstract(&janet_stream_type, sizeof(JanetStream));
JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size) {
janet_assert(size >= sizeof(JanetStream), "bad size");
JanetStream *stream = janet_abstract(&janet_stream_type, size);
stream->handle = handle;
stream->flags = flags;
stream->read_fiber = NULL;
@@ -329,6 +340,10 @@ JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod
return stream;
}
JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods) {
return janet_stream_ext(handle, flags, methods, sizeof(JanetStream));
}
static void janet_stream_close_impl(JanetStream *stream) {
stream->flags |= JANET_STREAM_CLOSED;
#ifdef JANET_WINDOWS
@@ -433,7 +448,7 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
}
janet_marshal_int64(ctx, (int64_t)(duph));
#else
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
/* Marshal after dup because it is easier than maintaining our own ref counting. */
int duph = dup(s->handle);
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
janet_marshal_int(ctx, (int32_t)(duph));
@@ -469,7 +484,7 @@ static Janet janet_stream_next(void *p, Janet key) {
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
JanetStream *stream = p;
/* Let user print the file descriptor for debugging */
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
janet_formatb(buffer, "[fd=%d]", stream->handle);
}
const JanetAbstractType janet_stream_type = {
@@ -595,7 +610,7 @@ void janet_ev_deinit_common(void) {
/* Shorthand to yield to event loop */
void janet_await(void) {
/* Store the fiber in a gobal table */
/* Store the fiber in a global table */
janet_signalv(JANET_SIGNAL_EVENT, janet_wrap_nil());
}
@@ -611,6 +626,18 @@ void janet_addtimeout(double sec) {
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) {
janet_atomic_inc(&janet_vm.listener_count);
}
@@ -866,7 +893,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
/* No root fiber, we are in completion on a root fiber. Don't block. */
if (mode == 2) {
janet_chan_unlock(channel);
return 0;
return 1;
}
/* Pushed successfully, but should block. */
JanetChannelPending pending;
@@ -922,6 +949,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
int is_threaded = janet_chan_is_threaded(channel);
if (janet_q_pop(&channel->items, item, sizeof(Janet))) {
/* Queue empty */
if (is_choice == 2) return 0; // Skip pending read
JanetChannelPending pending;
pending.thread = &janet_vm;
pending.fiber = janet_vm.root_fiber,
@@ -979,6 +1007,28 @@ JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, Janet
}
}
int janet_channel_give(JanetChannel *channel, Janet x) {
return janet_channel_push(channel, x, 2);
}
int janet_channel_take(JanetChannel *channel, Janet *out) {
return janet_channel_pop(channel, out, 2);
}
JanetChannel *janet_channel_make(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
return channel;
}
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
return channel;
}
/* Channel Methods */
JANET_CORE_FN(cfun_channel_push,
@@ -987,6 +1037,9 @@ JANET_CORE_FN(cfun_channel_push,
"Returns the channel if the write succeeded, nil otherwise.") {
janet_fixarity(argc, 2);
JanetChannel *channel = janet_getchannel(argv, 0);
if (janet_vm.coerce_error) {
janet_panic("cannot give to channel inside janet_call");
}
if (janet_channel_push(channel, argv[1], 0)) {
janet_await();
}
@@ -999,6 +1052,9 @@ JANET_CORE_FN(cfun_channel_pop,
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getchannel(argv, 0);
Janet item;
if (janet_vm.coerce_error) {
janet_panic("cannot take from channel inside janet_call");
}
if (janet_channel_pop(channel, &item, 0)) {
janet_schedule(janet_vm.root_fiber, item);
}
@@ -1035,6 +1091,10 @@ JANET_CORE_FN(cfun_channel_choice,
int32_t len;
const Janet *data;
if (janet_vm.coerce_error) {
janet_panic("cannot select from channel inside janet_call");
}
/* Check channels for immediate reads and writes */
for (int32_t i = 0; i < argc; i++) {
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
@@ -1471,13 +1531,16 @@ void janet_ev_deinit(void) {
static void janet_register_stream(JanetStream *stream) {
if (NULL == CreateIoCompletionPort(stream->handle, janet_vm.iocp, (ULONG_PTR) stream, 0)) {
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_WRITABLE | JANET_STREAM_ACCEPTABLE)) {
janet_panicf("failed to listen for events: %V", janet_ev_lasterr());
}
stream->flags |= JANET_STREAM_UNREGISTERED;
}
}
void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
ULONG_PTR completionKey = 0;
DWORD num_bytes_transfered = 0;
DWORD num_bytes_transferred = 0;
LPOVERLAPPED overlapped = NULL;
/* Calculate how long to wait before timeout */
@@ -1492,7 +1555,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
} else {
waittime = INFINITE;
}
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transfered, &completionKey, &overlapped, (DWORD) waittime);
BOOL result = GetQueuedCompletionStatus(janet_vm.iocp, &num_bytes_transferred, &completionKey, &overlapped, (DWORD) waittime);
if (result || overlapped) {
if (0 == completionKey) {
@@ -1515,7 +1578,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
if (fiber != NULL) {
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
/* System is done with this, we can reused this data */
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transfered;
overlapped->InternalHigh = (ULONG_PTR) num_bytes_transferred;
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
} else {
janet_free((void *) overlapped);
@@ -1736,6 +1799,22 @@ void janet_stream_edge_triggered(JanetStream *stream) {
}
void janet_stream_level_triggered(JanetStream *stream) {
/* On macos, we seem to need to delete any registered events before re-registering without
* EV_CLEAR, otherwise the new event will still have EV_CLEAR set erroneously. This could be a
* kernel bug, but unfortunately the specification is vague here, esp. in regards to where and when
* EV_CLEAR is set automatically. */
struct kevent kevs[2];
int length = 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream);
}
int status;
do {
status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL);
} while (status == -1 && errno == EINTR);
janet_register_stream_impl(stream, 0);
}
@@ -2327,6 +2406,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
} else {
janet_schedule(fiber, janet_wrap_nil());
}
stream->read_fiber = NULL;
janet_async_end(fiber);
break;
}
@@ -2699,6 +2779,7 @@ static volatile long PipeSerialNumber;
* mode = 0: both sides non-blocking.
* mode = 1: only read side non-blocking: write side sent to subprocess
* mode = 2: only write side non-blocking: read side sent to subprocess
* mode = 3: both sides blocking - for use in two subprocesses (making pipeline from external processes)
*/
int janet_make_pipe(JanetHandle handles[2], int mode) {
#ifdef JANET_WINDOWS
@@ -2712,6 +2793,11 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
memset(&saAttr, 0, sizeof(saAttr));
saAttr.nLength = sizeof(saAttr);
saAttr.bInheritHandle = TRUE;
if (mode == 3) {
/* No overlapped IO involved, just call CreatePipe */
if (!CreatePipe(handles, handles + 1, &saAttr, 0)) return -1;
return 0;
}
sprintf(PipeNameBuffer,
"\\\\.\\Pipe\\JanetPipeFile.%08x.%08x",
(unsigned int) GetCurrentProcessId(),
@@ -2757,8 +2843,8 @@ int janet_make_pipe(JanetHandle handles[2], int mode) {
if (pipe(handles)) return -1;
if (mode != 2 && fcntl(handles[0], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFD, FD_CLOEXEC)) goto error;
if (mode != 2 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 1 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 2 && mode != 3 && fcntl(handles[0], F_SETFL, O_NONBLOCK)) goto error;
if (mode != 1 && mode != 3 && fcntl(handles[1], F_SETFL, O_NONBLOCK)) goto error;
return 0;
error:
close(handles[0]);
@@ -2832,7 +2918,7 @@ static JanetEVGenericMessage janet_go_thread_subr(JanetEVGenericMessage args) {
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));
}
/* Get supervsior */
/* Get supervisor */
if (flags & JANET_THREAD_SUPERVISOR_FLAG) {
Janet sup =
janet_unmarshal(nextbytes, endbytes - nextbytes,
@@ -3216,6 +3302,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
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,
"(ev/all-tasks)",
"Get an array of all active fibers that are being used by the scheduler.") {
@@ -3260,6 +3404,7 @@ void janet_lib_ev(JanetTable *env) {
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-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_REG_END
};
@@ -3269,6 +3414,8 @@ void janet_lib_ev(JanetTable *env) {
janet_register_abstract_type(&janet_channel_type);
janet_register_abstract_type(&janet_mutex_type);
janet_register_abstract_type(&janet_rwlock_type);
janet_lib_filewatch(env);
}
#endif

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -56,6 +56,9 @@
#if (defined(__x86_64__) || defined(_M_X64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_SYSV64_ENABLED
#endif
#if (defined(__aarch64__) || defined(_M_ARM64)) && !defined(JANET_WINDOWS)
#define JANET_FFI_AAPCS64_ENABLED
#endif
typedef struct JanetFFIType JanetFFIType;
typedef struct JanetFFIStruct JanetFFIStruct;
@@ -140,7 +143,13 @@ typedef enum {
JANET_WIN64_REGISTER,
JANET_WIN64_STACK,
JANET_WIN64_REGISTER_REF,
JANET_WIN64_STACK_REF
JANET_WIN64_STACK_REF,
JANET_AAPCS64_GENERAL,
JANET_AAPCS64_SSE,
JANET_AAPCS64_GENERAL_REF,
JANET_AAPCS64_STACK,
JANET_AAPCS64_STACK_REF,
JANET_AAPCS64_NONE
} JanetFFIWordSpec;
/* Describe how each Janet argument is interpreted in terms of machine words
@@ -155,13 +164,16 @@ typedef struct {
typedef enum {
JANET_FFI_CC_NONE,
JANET_FFI_CC_SYSV_64,
JANET_FFI_CC_WIN_64
JANET_FFI_CC_WIN_64,
JANET_FFI_CC_AAPCS64
} JanetFFICallingConvention;
#ifdef JANET_FFI_WIN64_ENABLED
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_WIN_64
#elif defined(JANET_FFI_SYSV64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_SYSV_64
#elif defined(JANET_FFI_AAPCS64_ENABLED)
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_AAPCS64
#else
#define JANET_FFI_CC_DEFAULT JANET_FFI_CC_NONE
#endif
@@ -301,6 +313,9 @@ static JanetFFICallingConvention decode_ffi_cc(const uint8_t *name) {
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
if (!janet_cstrcmp(name, "sysv64")) return JANET_FFI_CC_SYSV_64;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
if (!janet_cstrcmp(name, "aapcs64")) return JANET_FFI_CC_AAPCS64;
#endif
if (!janet_cstrcmp(name, "default")) return JANET_FFI_CC_DEFAULT;
janet_panicf("unknown calling convention %s", name);
@@ -385,7 +400,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
JanetFFIStruct *st = janet_abstract(&janet_struct_type,
sizeof(JanetFFIStruct) + argc * sizeof(JanetFFIStructMember));
st->field_count = member_count;
st->field_count = 0;
st->size = 0;
st->align = 1;
if (argc == 0) {
@@ -403,6 +418,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->fields[i].type = decode_ffi_type(argv[j]);
size_t el_size = type_size(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 (st->size % el_align != 0) is_aligned = 0;
st->fields[i].offset = st->size;
@@ -418,6 +434,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
st->size += (st->align - 1);
st->size /= st->align;
st->size *= st->align;
st->field_count = member_count;
return st;
}
@@ -475,7 +492,7 @@ JANET_CORE_FN(cfun_ffi_align,
static void *janet_ffi_getpointer(const Janet *argv, int32_t n) {
switch (janet_type(argv[n])) {
default:
janet_panicf("bad slot #%d, expected ffi pointer convertable type, got %v", n, argv[n]);
janet_panicf("bad slot #%d, expected ffi pointer convertible type, got %v", n, argv[n]);
case JANET_POINTER:
case JANET_STRING:
case JANET_KEYWORD:
@@ -763,6 +780,101 @@ static JanetFFIWordSpec sysv64_classify(JanetFFIType type) {
}
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
/* Procedure Call Standard for the Arm® 64-bit Architecture (AArch64) 2023Q3 October 6, 2023
* See section 6.8.2 Parameter passing rules.
* https://github.com/ARM-software/abi-aa/releases/download/2023Q3/aapcs64.pdf
*
* Additional documentation needed for Apple platforms.
* https://developer.apple.com/documentation/xcode/writing-arm64-code-for-apple-platforms */
#define JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment) (ptr = ((ptr) + ((alignment) - 1)) & ~((alignment) - 1))
#if !defined(JANET_APPLE)
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) ((void) alignment, JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, 8))
#else
#define JANET_FFI_AAPCS64_STACK_ALIGN(ptr, alignment) JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ptr, alignment)
#endif
typedef struct {
uint64_t a;
uint64_t b;
} Aapcs64Variant1ReturnGeneral;
typedef struct {
double a;
double b;
double c;
double d;
} Aapcs64Variant2ReturnSse;
/* Workaround for passing a return value pointer through x8.
* Limits struct returns to 128 bytes. */
typedef struct {
uint64_t a;
uint64_t b;
uint64_t c;
uint64_t d;
uint64_t e;
uint64_t f;
uint64_t g;
uint64_t h;
uint64_t i;
uint64_t j;
uint64_t k;
uint64_t l;
uint64_t m;
uint64_t n;
uint64_t o;
uint64_t p;
} Aapcs64Variant3ReturnPointer;
static JanetFFIWordSpec aapcs64_classify(JanetFFIType type) {
switch (type.prim) {
case JANET_FFI_TYPE_PTR:
case JANET_FFI_TYPE_STRING:
case JANET_FFI_TYPE_BOOL:
case JANET_FFI_TYPE_INT8:
case JANET_FFI_TYPE_INT16:
case JANET_FFI_TYPE_INT32:
case JANET_FFI_TYPE_INT64:
case JANET_FFI_TYPE_UINT8:
case JANET_FFI_TYPE_UINT16:
case JANET_FFI_TYPE_UINT32:
case JANET_FFI_TYPE_UINT64:
return JANET_AAPCS64_GENERAL;
case JANET_FFI_TYPE_DOUBLE:
case JANET_FFI_TYPE_FLOAT:
return JANET_AAPCS64_SSE;
case JANET_FFI_TYPE_STRUCT: {
JanetFFIStruct *st = type.st;
if (st->field_count <= 4 && aapcs64_classify(st->fields[0].type) == JANET_AAPCS64_SSE) {
bool is_hfa = true;
for (uint32_t i = 1; i < st->field_count; i++) {
if (st->fields[0].type.prim != st->fields[i].type.prim) {
is_hfa = false;
break;
}
}
if (is_hfa) {
return JANET_AAPCS64_SSE;
}
}
if (type_size(type) > 16) {
return JANET_AAPCS64_GENERAL_REF;
}
return JANET_AAPCS64_GENERAL;
}
case JANET_FFI_TYPE_VOID:
return JANET_AAPCS64_NONE;
default:
janet_panic("nyi");
return JANET_AAPCS64_NONE;
}
}
#endif
JANET_CORE_FN(cfun_ffi_signature,
"(ffi/signature calling-convention ret-type & arg-types)",
"Create a function signature object that can be used to make calls "
@@ -960,6 +1072,96 @@ JANET_CORE_FN(cfun_ffi_signature,
}
break;
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64: {
uint32_t next_general_reg = 0;
uint32_t next_fp_reg = 0;
uint32_t stack_offset = 0;
uint32_t ref_stack_offset = 0;
JanetFFIWordSpec ret_spec = aapcs64_classify(ret_type);
ret.spec = ret_spec;
if (ret_spec == JANET_AAPCS64_SSE) {
variant = 1;
} else if (ret_spec == JANET_AAPCS64_GENERAL_REF) {
if (type_size(ret_type) > sizeof(Aapcs64Variant3ReturnPointer)) {
janet_panic("return value bigger than supported");
}
variant = 2;
} else {
variant = 0;
}
for (uint32_t i = 0; i < arg_count; i++) {
mappings[i].type = decode_ffi_type(argv[i + 2]);
mappings[i].spec = aapcs64_classify(mappings[i].type);
size_t arg_size = type_size(mappings[i].type);
switch (mappings[i].spec) {
case JANET_AAPCS64_GENERAL: {
bool arg_is_struct = mappings[i].type.prim == JANET_FFI_TYPE_STRUCT;
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_general_reg + needed_registers <= 8) {
mappings[i].offset = next_general_reg;
next_general_reg += needed_registers;
} else {
size_t arg_align = arg_is_struct ? 8 : type_align(mappings[i].type);
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, arg_align);
#if !defined(JANET_APPLE)
stack_offset += arg_size > 8 ? arg_size : 8;
#else
stack_offset += arg_size;
#endif
next_general_reg = 8;
}
break;
}
case JANET_AAPCS64_GENERAL_REF:
if (next_general_reg < 8) {
mappings[i].offset = next_general_reg++;
} else {
mappings[i].spec = JANET_AAPCS64_STACK_REF;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
stack_offset += 8;
}
mappings[i].offset2 = JANET_FFI_AAPCS64_FORCE_STACK_ALIGN(ref_stack_offset, 8);
ref_stack_offset += arg_size;
break;
case JANET_AAPCS64_SSE: {
uint32_t needed_registers = (arg_size + 7) / 8;
if (next_fp_reg + needed_registers <= 8) {
mappings[i].offset = next_fp_reg;
next_fp_reg += needed_registers;
} else {
mappings[i].spec = JANET_AAPCS64_STACK;
mappings[i].offset = JANET_FFI_AAPCS64_STACK_ALIGN(stack_offset, 8);
#if !defined(JANET_APPLE)
stack_offset += 8;
#else
stack_offset += arg_size;
#endif
}
break;
}
default:
janet_panic("nyi");
}
}
stack_offset = (stack_offset + 15) & ~0xFUL;
ref_stack_offset = (ref_stack_offset + 15) & ~0xFUL;
stack_count = stack_offset + ref_stack_offset;
for (uint32_t i = 0; i < arg_count; i++) {
if (mappings[i].spec == JANET_AAPCS64_GENERAL_REF || mappings[i].spec == JANET_AAPCS64_STACK_REF) {
mappings[i].offset2 = stack_offset + mappings[i].offset2;
}
}
}
break;
#endif
}
/* Create signature abstract value */
@@ -1294,6 +1496,99 @@ static Janet janet_ffi_win64(JanetFFISignature *signature, void *function_pointe
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
static void janet_ffi_aapcs64_standard_callback(void *ctx, void *userdata) {
janet_ffi_trampoline(ctx, userdata);
}
typedef Aapcs64Variant1ReturnGeneral janet_aapcs64_variant_1(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant2ReturnSse janet_aapcs64_variant_2(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
typedef Aapcs64Variant3ReturnPointer janet_aapcs64_variant_3(uint64_t x0, uint64_t x1, uint64_t x2, uint64_t x3, uint64_t x4, uint64_t x5, uint64_t x6, uint64_t x7,
double v0, double v1, double v2, double v3, double v4, double v5, double v6, double v7);
static Janet janet_ffi_aapcs64(JanetFFISignature *signature, void *function_pointer, const Janet *argv) {
union {
Aapcs64Variant1ReturnGeneral general_return;
Aapcs64Variant2ReturnSse sse_return;
Aapcs64Variant3ReturnPointer pointer_return;
} retu;
uint64_t regs[8];
double fp_regs[8];
void *ret_mem = &retu.general_return;
/* Apple's stack values do not need to be 8-byte aligned,
* thus all stack offsets refer to actual byte positions. */
uint8_t *stack = alloca(signature->stack_count);
#if defined(JANET_APPLE)
/* Values must be zero-extended by the caller instead of the callee. */
memset(stack, 0, signature->stack_count);
#endif
for (uint32_t i = 0; i < signature->arg_count; i++) {
int32_t n = i + 2;
JanetFFIMapping arg = signature->args[i];
void *to = NULL;
switch (arg.spec) {
case JANET_AAPCS64_GENERAL:
to = regs + arg.offset;
break;
case JANET_AAPCS64_GENERAL_REF:
to = stack + arg.offset2;
regs[arg.offset] = (uint64_t) to;
break;
case JANET_AAPCS64_SSE:
to = fp_regs + arg.offset;
break;
case JANET_AAPCS64_STACK:
to = stack + arg.offset;
break;
case JANET_AAPCS64_STACK_REF:
to = stack + arg.offset2;
uint64_t *ptr = (uint64_t *) stack + arg.offset;
*ptr = (uint64_t) to;
break;
default:
janet_panic("nyi");
}
if (to) {
janet_ffi_write_one(to, argv, n, arg.type, JANET_FFI_MAX_RECUR);
}
}
switch (signature->variant) {
case 0:
retu.general_return = ((janet_aapcs64_variant_1 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 1:
retu.sse_return = ((janet_aapcs64_variant_2 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
break;
case 2: {
retu.pointer_return = ((janet_aapcs64_variant_3 *)(function_pointer))(
regs[0], regs[1], regs[2], regs[3],
regs[4], regs[5], regs[6], regs[7],
fp_regs[0], fp_regs[1], fp_regs[2], fp_regs[3],
fp_regs[4], fp_regs[5], fp_regs[6], fp_regs[7]);
}
}
return janet_ffi_read_one(ret_mem, signature->ret.type, JANET_FFI_MAX_RECUR);
}
#endif
/* Allocate executable memory chunks in sizes of a page. Ideally we would keep
* an allocator around so that multiple JIT allocations would point to the same
* region but it isn't really worth it. */
@@ -1373,6 +1668,10 @@ JANET_CORE_FN(cfun_ffi_call,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_ffi_sysv64(signature, function_pointer, argv);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_ffi_aapcs64(signature, function_pointer, argv);
#endif
}
}
@@ -1442,6 +1741,10 @@ JANET_CORE_FN(cfun_ffi_get_callback_trampoline,
#ifdef JANET_FFI_SYSV64_ENABLED
case JANET_FFI_CC_SYSV_64:
return janet_wrap_pointer(janet_ffi_sysv64_standard_callback);
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
case JANET_FFI_CC_AAPCS64:
return janet_wrap_pointer(janet_ffi_aapcs64_standard_callback);
#endif
}
}
@@ -1561,6 +1864,9 @@ JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
#endif
#ifdef JANET_FFI_SYSV64_ENABLED
janet_array_push(array, janet_ckeywordv("sysv64"));
#endif
#ifdef JANET_FFI_AAPCS64_ENABLED
janet_array_push(array, janet_ckeywordv("aapcs64"));
#endif
janet_array_push(array, janet_ckeywordv("none"));
return janet_wrap_array(array);

View File

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

View File

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

688
src/core/filewatch.c Normal file
View File

@@ -0,0 +1,688 @@
/*
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
* deal in the Software without restriction, including without limitation the
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
* sell copies of the Software, and to permit persons to whom the Software is
* furnished to do so, subject to the following conditions:
*
* The above copyright notice and this permission notice shall be included in
* all copies or substantial portions of the Software.
*
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
* IN THE SOFTWARE.
*/
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#ifdef JANET_EV
#ifdef JANET_FILEWATCH
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
typedef struct {
const char *name;
uint32_t flag;
} JanetWatchFlagName;
typedef struct {
#ifndef JANET_WINDOWS
JanetStream *stream;
#endif
JanetTable *watch_descriptors;
JanetChannel *channel;
uint32_t default_flags;
int is_watching;
} JanetWatcher;
#ifdef JANET_LINUX
#include <sys/inotify.h>
#include <unistd.h>
static const JanetWatchFlagName watcher_flags_linux[] = {
{"access", IN_ACCESS},
{"all", IN_ALL_EVENTS},
{"attrib", IN_ATTRIB},
{"close-nowrite", IN_CLOSE_NOWRITE},
{"close-write", IN_CLOSE_WRITE},
{"create", IN_CREATE},
{"delete", IN_DELETE},
{"delete-self", IN_DELETE_SELF},
{"ignored", IN_IGNORED},
{"modify", IN_MODIFY},
{"move-self", IN_MOVE_SELF},
{"moved-from", IN_MOVED_FROM},
{"moved-to", IN_MOVED_TO},
{"open", IN_OPEN},
{"q-overflow", IN_Q_OVERFLOW},
{"unmount", IN_UNMOUNT},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_linux,
sizeof(watcher_flags_linux) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown inotify flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
int fd;
do {
fd = inotify_init1(IN_NONBLOCK | IN_CLOEXEC);
} while (fd == -1 && errno == EINTR);
if (fd == -1) {
janet_panicv(janet_ev_lasterr());
}
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
watcher->stream = janet_stream(fd, JANET_STREAM_READABLE, NULL);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
if (watcher->stream == NULL) janet_panic("watcher closed");
int result;
do {
result = inotify_add_watch(watcher->stream->handle, path, flags);
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
Janet name = janet_cstringv(path);
Janet wd = janet_wrap_integer(result);
janet_table_put(watcher->watch_descriptors, name, wd);
janet_table_put(watcher->watch_descriptors, wd, name);
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
int watch_handle = janet_unwrap_integer(check);
int result;
do {
result = inotify_rm_watch(watcher->stream->handle, watch_handle);
} while (result != -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
}
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
JanetWatcher *watcher = *((JanetWatcher **) fiber->ev_state);
char buf[1024];
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(watcher));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
case JANET_ASYNC_EVENT_ERR: {
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);
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);
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);
}
/* Read some more if possible */
goto read_more;
}
break;
}
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
JanetWatcher **state = janet_malloc(sizeof(JanetWatcher *)); /* Gross */
*state = watcher;
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
janet_stream_close(watcher->stream);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#elif JANET_WINDOWS
#define WATCHFLAG_RECURSIVE 0x100000u
static const JanetWatchFlagName watcher_flags_windows[] = {
{
"all",
FILE_NOTIFY_CHANGE_ATTRIBUTES |
FILE_NOTIFY_CHANGE_CREATION |
FILE_NOTIFY_CHANGE_DIR_NAME |
FILE_NOTIFY_CHANGE_FILE_NAME |
FILE_NOTIFY_CHANGE_LAST_ACCESS |
FILE_NOTIFY_CHANGE_LAST_WRITE |
FILE_NOTIFY_CHANGE_SECURITY |
FILE_NOTIFY_CHANGE_SIZE |
WATCHFLAG_RECURSIVE
},
{"attributes", FILE_NOTIFY_CHANGE_ATTRIBUTES},
{"creation", FILE_NOTIFY_CHANGE_CREATION},
{"dir-name", FILE_NOTIFY_CHANGE_DIR_NAME},
{"file-name", FILE_NOTIFY_CHANGE_FILE_NAME},
{"last-access", FILE_NOTIFY_CHANGE_LAST_ACCESS},
{"last-write", FILE_NOTIFY_CHANGE_LAST_WRITE},
{"recursive", WATCHFLAG_RECURSIVE},
{"security", FILE_NOTIFY_CHANGE_SECURITY},
{"size", FILE_NOTIFY_CHANGE_SIZE},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_windows,
sizeof(watcher_flags_windows) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown windows filewatch flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
}
/* Since the file info padding includes embedded file names, we want to include more space for data.
* We also need to handle manually calculating changes if path names are too long, but ideally just avoid
* that scenario as much as possible */
#define FILE_INFO_PADDING (4096 * 4)
typedef struct {
OVERLAPPED overlapped;
JanetStream *stream;
JanetWatcher *watcher;
JanetFiber *fiber;
JanetString dir_path;
uint32_t flags;
uint64_t buf[FILE_INFO_PADDING / sizeof(uint64_t)]; /* Ensure alignment */
} OverlappedWatch;
#define NotifyChange FILE_NOTIFY_INFORMATION
static void read_dir_changes(OverlappedWatch *ow) {
BOOL result = ReadDirectoryChangesW(ow->stream->handle,
(NotifyChange *) ow->buf,
FILE_INFO_PADDING,
(ow->flags & WATCHFLAG_RECURSIVE) ? TRUE : FALSE,
ow->flags & ~WATCHFLAG_RECURSIVE,
NULL,
(OVERLAPPED *) ow,
NULL);
if (!result) {
janet_panicv(janet_ev_lasterr());
}
}
static const char *watcher_actions_windows[] = {
"unknown",
"added",
"removed",
"modified",
"renamed-old",
"renamed-new",
};
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
OverlappedWatch *ow = (OverlappedWatch *) fiber->ev_state;
JanetWatcher *watcher = ow->watcher;
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_INIT:
janet_async_in_flight(fiber);
break;
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(watcher));
janet_mark(janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_table_remove(ow->watcher->watch_descriptors, janet_wrap_string(ow->dir_path));
break;
case JANET_ASYNC_EVENT_ERR:
case JANET_ASYNC_EVENT_FAILED:
janet_stream_close(ow->stream);
break;
case JANET_ASYNC_EVENT_COMPLETE: {
if (!watcher->is_watching) {
janet_stream_close(ow->stream);
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;
}
}
static void start_listening_ow(OverlappedWatch *ow) {
read_dir_changes(ow);
JanetStream *stream = ow->stream;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
fiber->supervisor_channel = janet_root_fiber()->supervisor_channel;
ow->fiber = fiber;
janet_async_start_fiber(fiber, stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, ow);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
HANDLE handle = CreateFileA(path,
FILE_LIST_DIRECTORY | GENERIC_READ,
FILE_SHARE_READ | FILE_SHARE_WRITE | FILE_SHARE_DELETE,
NULL,
OPEN_EXISTING,
FILE_FLAG_OVERLAPPED | FILE_FLAG_BACKUP_SEMANTICS,
NULL);
if (handle == INVALID_HANDLE_VALUE) {
janet_panicv(janet_ev_lasterr());
}
JanetStream *stream = janet_stream(handle, JANET_STREAM_READABLE, NULL);
OverlappedWatch *ow = janet_malloc(sizeof(OverlappedWatch));
memset(ow, 0, sizeof(OverlappedWatch));
ow->stream = stream;
ow->dir_path = janet_cstring(path);
ow->fiber = NULL;
Janet pathv = janet_wrap_string(ow->dir_path);
ow->flags = flags | watcher->default_flags;
ow->watcher = watcher;
ow->overlapped.hEvent = CreateEvent(NULL, FALSE, 0, NULL); /* Do we need this */
Janet streamv = janet_wrap_pointer(ow);
janet_table_put(watcher->watch_descriptors, pathv, streamv);
if (watcher->is_watching) {
start_listening_ow(ow);
}
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
Janet pathv = janet_cstringv(path);
Janet streamv = janet_table_get(watcher->watch_descriptors, pathv);
if (janet_checktype(streamv, JANET_NIL)) {
janet_panicf("path %v is not being watched", pathv);
}
janet_table_remove(watcher->watch_descriptors, pathv);
OverlappedWatch *ow = janet_unwrap_pointer(streamv);
janet_stream_close(ow->stream);
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
start_listening_ow(ow);
}
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_stream_close(ow->stream);
}
janet_table_clear(watcher->watch_descriptors);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#else
/* Default implementation */
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
(void) options;
(void) n;
return 0;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
(void) watcher;
(void) channel;
(void) default_flags;
janet_panic("filewatch not supported on this platform");
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
(void) watcher;
(void) flags;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
(void) watcher;
(void) path;
janet_panic("nyi");
}
static void janet_watcher_listen(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
(void) watcher;
janet_panic("nyi");
}
#endif
/* C Functions */
static int janet_filewatch_mark(void *p, size_t s) {
JanetWatcher *watcher = (JanetWatcher *) p;
(void) s;
if (watcher->channel == NULL) return 0; /* Incomplete initialization */
#ifdef JANET_WINDOWS
for (int32_t i = 0; i < watcher->watch_descriptors->capacity; i++) {
const JanetKV *kv = watcher->watch_descriptors->data + i;
if (!janet_checktype(kv->value, JANET_POINTER)) continue;
OverlappedWatch *ow = janet_unwrap_pointer(kv->value);
janet_mark(janet_wrap_fiber(ow->fiber));
janet_mark(janet_wrap_abstract(ow->stream));
janet_mark(janet_wrap_string(ow->dir_path));
}
#else
janet_mark(janet_wrap_abstract(watcher->stream));
#endif
janet_mark(janet_wrap_abstract(watcher->channel));
janet_mark(janet_wrap_table(watcher->watch_descriptors));
return 0;
}
static const JanetAbstractType janet_filewatch_at = {
"filewatch/watcher",
NULL,
janet_filewatch_mark,
JANET_ATEND_GCMARK
};
JANET_CORE_FN(cfun_filewatch_make,
"(filewatch/new channel &opt default-flags)",
"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);
JanetChannel *channel = janet_getchannel(argv, 0);
JanetWatcher *watcher = janet_abstract(&janet_filewatch_at, sizeof(JanetWatcher));
uint32_t default_flags = decode_watch_flags(argv + 1, argc - 1);
janet_watcher_init(watcher, channel, default_flags);
return janet_wrap_abstract(watcher);
}
JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path &opt flags)",
"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);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
uint32_t flags = watcher->default_flags | decode_watch_flags(argv + 2, argc - 2);
janet_watcher_add(watcher, path, flags);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_remove,
"(filewatch/remove watcher path)",
"Remove a path from the watcher.") {
janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
const char *path = janet_getcstring(argv, 1);
janet_watcher_remove(watcher, path);
return argv[0];
}
JANET_CORE_FN(cfun_filewatch_listen,
"(filewatch/listen watcher)",
"Listen for changes in the watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_listen(watcher);
return janet_wrap_nil();
}
JANET_CORE_FN(cfun_filewatch_unlisten,
"(filewatch/unlisten watcher)",
"Stop listening for changes on a given watcher.") {
janet_fixarity(argc, 1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
janet_watcher_unlisten(watcher);
return janet_wrap_nil();
}
/* Module entry point */
void janet_lib_filewatch(JanetTable *env) {
JanetRegExt cfuns[] = {
JANET_CORE_REG("filewatch/new", cfun_filewatch_make),
JANET_CORE_REG("filewatch/add", cfun_filewatch_add),
JANET_CORE_REG("filewatch/remove", cfun_filewatch_remove),
JANET_CORE_REG("filewatch/listen", cfun_filewatch_listen),
JANET_CORE_REG("filewatch/unlisten", cfun_filewatch_unlisten),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, cfuns);
}
#endif
#endif

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -64,7 +64,7 @@ enum JanetMemoryType {
};
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
* and then call when janet_enablegc when it is initailize and reachable by the gc (on the JANET stack) */
* and then call when janet_enablegc when it is initialized and reachable by the gc (on the JANET stack) */
void *janet_gcalloc(enum JanetMemoryType type, size_t size);
#endif

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose & contributors
* Copyright (c) 2025 Calvin Rose & contributors
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) {
JANET_CORE_FN(cfun_it_s64_new,
"(int/s64 value)",
"Create a boxed signed 64 bit integer from a string value.") {
"Create a boxed signed 64 bit integer from a string value or a number.") {
janet_fixarity(argc, 1);
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}
JANET_CORE_FN(cfun_it_u64_new,
"(int/u64 value)",
"Create a boxed unsigned 64 bit integer from a string value.") {
"Create a boxed unsigned 64 bit integer from a string value or a number.") {
janet_fixarity(argc, 1);
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
JANET_CORE_FN(cfun_to_number,
"(int/to-number value)",
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") {
janet_fixarity(argc, 1);
if (janet_type(argv[0]) == JANET_ABSTRACT) {
void *abst = janet_unwrap_abstract(argv[0]);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -31,6 +31,7 @@
#ifndef JANET_WINDOWS
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <unistd.h>
#endif
@@ -164,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen,
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
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);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
@@ -294,7 +303,7 @@ int janet_file_close(JanetFile *file) {
if (!(file->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
ret = fclose(file->file);
file->flags |= JANET_FILE_CLOSED;
file->file = NULL; /* NULL derefence is easier to debug then other problems */
file->file = NULL; /* NULL dereference is easier to debug then other problems */
return ret;
}
return 0;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -68,8 +68,15 @@ enum {
LB_STRUCT_PROTO, /* 223 */
#ifdef JANET_EV
LB_THREADED_ABSTRACT, /* 224 */
LB_POINTER_BUFFER, /* 224 */
LB_POINTER_BUFFER, /* 225 */
#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;
/* 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;
JanetArray *a = janet_unwrap_array(x);
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);
for (i = 0; i < a->count; i++)
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: {
JanetTable *t = janet_unwrap_table(x);
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);
if (t->proto)
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_ARRAY:
case LB_ARRAY_WEAK:
case LB_TUPLE:
case LB_STRUCT:
case LB_STRUCT_PROTO:
case LB_TABLE:
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 */
{
data++;
@@ -1430,9 +1454,9 @@ static const uint8_t *unmarshal_one(
if (lead != LB_REFERENCE) {
MARSH_EOS(st, data - 1 + len);
}
if (lead == LB_ARRAY) {
if (lead == LB_ARRAY || lead == LB_ARRAY_WEAK) {
/* Array */
JanetArray *array = janet_array(len);
JanetArray *array = (lead == LB_ARRAY_WEAK) ? janet_array_weak(len) : janet_array(len);
array->count = len;
*out = janet_wrap_array(array);
janet_v_push(st->lookup, *out);
@@ -1472,10 +1496,19 @@ static const uint8_t *unmarshal_one(
*out = st->lookup[len];
} else {
/* 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);
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;
data = unmarshal_one(st, data, &proto, flags + 1);
janet_asserttype(proto, JANET_TABLE, st);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -85,10 +85,10 @@ void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
uint8_t state[16] = {0};
for (int32_t i = 0; i < len; i++)
state[i & 0xF] ^= bytes[i];
rng->a = state[0] + (state[1] << 8) + (state[2] << 16) + (state[3] << 24);
rng->b = state[4] + (state[5] << 8) + (state[6] << 16) + (state[7] << 24);
rng->c = state[8] + (state[9] << 8) + (state[10] << 16) + (state[11] << 24);
rng->d = state[12] + (state[13] << 8) + (state[14] << 16) + (state[15] << 24);
rng->a = state[0] + ((uint32_t) state[1] << 8) + ((uint32_t) state[2] << 16) + ((uint32_t) state[3] << 24);
rng->b = state[4] + ((uint32_t) state[5] << 8) + ((uint32_t) state[6] << 16) + ((uint32_t) state[7] << 24);
rng->c = state[8] + ((uint32_t) state[9] << 8) + ((uint32_t) state[10] << 16) + ((uint32_t) state[11] << 24);
rng->d = state[12] + ((uint32_t) state[13] << 8) + ((uint32_t) state[14] << 16) + ((uint32_t) state[15] << 24);
rng->counter = 0u;
/* a, b, c, d can't all be 0 */
if (rng->a == 0) rng->a = 1u;

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose and contributors.
* Copyright (c) 2025 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -325,7 +325,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
#endif
/* Adress info */
/* Address info */
static int janet_get_sockettype(Janet *argv, int32_t argc, int32_t n) {
JanetKeyword stype = janet_optkeyword(argv, argc, n, NULL);
@@ -554,7 +554,10 @@ JANET_CORE_FN(cfun_net_connect,
int err = WSAGetLastError();
freeaddrinfo(ai);
#else
int status = connect(sock, addr, addrlen);
int status;
do {
status = connect(sock, addr, addrlen);
} while (status == -1 && errno == EINTR);
int err = errno;
if (is_unix) {
janet_free(ai);
@@ -578,17 +581,23 @@ JANET_CORE_FN(cfun_net_connect,
net_sched_connect(stream);
}
static const char *serverify_socket(JSock sfd) {
static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
/* Set various socket options */
int enable = 1;
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
if (reuse_addr) {
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
}
}
if (reuse_port) {
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
#else
(void) reuse_port;
#endif
}
janet_net_socknoblock(sfd);
return NULL;
}
@@ -642,19 +651,21 @@ JANET_CORE_FN(cfun_net_shutdown,
}
JANET_CORE_FN(cfun_net_listen,
"(net/listen host port &opt type)",
"(net/listen host port &opt type no-reuse)",
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.") {
":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will "
"disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") {
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
janet_arity(argc, 2, 3);
janet_arity(argc, 2, 4);
/* Get host, port, and handler*/
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
int reuse = !(argc >= 4 && janet_truthy(argv[3]));
JSock sfd = JSOCKDEFAULT;
#ifndef JANET_WINDOWS
@@ -664,7 +675,7 @@ JANET_CORE_FN(cfun_net_listen,
janet_free(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
const char *err = serverify_socket(sfd);
const char *err = serverify_socket(sfd, reuse, 0);
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
JSOCKCLOSE(sfd);
janet_free(ai);
@@ -687,7 +698,7 @@ JANET_CORE_FN(cfun_net_listen,
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (!JSOCKVALID(sfd)) continue;
const char *err = serverify_socket(sfd);
const char *err = serverify_socket(sfd, reuse, reuse);
if (NULL != err) {
JSOCKCLOSE(sfd);
continue;
@@ -829,7 +840,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JANET_CORE_FN(cfun_stream_accept,
"(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. "
"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.") {
janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -844,7 +855,7 @@ JANET_CORE_FN(cfun_stream_read,
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"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.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -864,7 +875,7 @@ JANET_CORE_FN(cfun_stream_read,
JANET_CORE_FN(cfun_stream_chunk,
"(net/chunk stream nbytes &opt buf timeout)",
"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);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@@ -878,7 +889,7 @@ JANET_CORE_FN(cfun_stream_chunk,
JANET_CORE_FN(cfun_stream_recv_from,
"(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 "
"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);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@@ -892,7 +903,7 @@ JANET_CORE_FN(cfun_stream_recv_from,
JANET_CORE_FN(cfun_stream_write,
"(net/write stream data &opt timeout)",
"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.") {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@@ -911,7 +922,7 @@ JANET_CORE_FN(cfun_stream_write,
JANET_CORE_FN(cfun_stream_send_to,
"(net/send-to stream dest data &opt timeout)",
"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.") {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose and contributors.
* Copyright (c) 2025 Calvin Rose and contributors.
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -27,9 +27,10 @@
#include "gc.h"
#endif
#include <stdlib.h>
#ifndef JANET_REDUCED_OS
#include <stdlib.h>
#include <time.h>
#include <fcntl.h>
#include <errno.h>
@@ -174,6 +175,8 @@ JANET_CORE_FN(os_arch,
"* :riscv64\n\n"
"* :sparc\n\n"
"* :wasm\n\n"
"* :s390\n\n"
"* :s390x\n\n"
"* :unknown\n") {
janet_fixarity(argc, 0);
(void) argv;
@@ -200,6 +203,10 @@ JANET_CORE_FN(os_arch,
return janet_ckeywordv("ppc");
#elif (defined(__ppc64__) || defined(_ARCH_PPC64) || defined(_M_PPC))
return janet_ckeywordv("ppc64");
#elif (defined(__s390x__))
return janet_ckeywordv("s390x");
#elif (defined(__s390__))
return janet_ckeywordv("s390");
#else
return janet_ckeywordv("unknown");
#endif
@@ -245,7 +252,7 @@ JANET_CORE_FN(os_exit,
}
janet_deinit();
if (argc >= 2 && janet_truthy(argv[1])) {
_exit(status);
_Exit(status);
} else {
exit(status);
}
@@ -534,11 +541,12 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
proc->flags &= ~JANET_PROC_WAITING;
janet_gcunroot(janet_wrap_abstract(proc));
janet_gcunroot(janet_wrap_fiber(args.fiber));
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
if (janet_fiber_can_resume(args.fiber)) {
uint32_t sched_id = (uint32_t) args.argi;
if (janet_fiber_can_resume(args.fiber) && args.fiber->sched_id == sched_id) {
if ((status != 0) && (proc->flags & JANET_PROC_ERROR_NONZERO)) {
JanetString s = janet_formatc("command failed with non-zero exit code %d", status);
janet_cancel(args.fiber, janet_wrap_string(s));
} else {
janet_schedule(args.fiber, janet_wrap_integer(status));
}
}
@@ -596,6 +604,7 @@ os_proc_wait_impl(JanetProc *proc) {
memset(&targs, 0, sizeof(targs));
targs.argp = proc;
targs.fiber = janet_root_fiber();
targs.argi = (uint32_t) targs.fiber->sched_id;
janet_gcroot(janet_wrap_abstract(proc));
janet_gcroot(janet_wrap_fiber(targs.fiber));
janet_ev_threaded_call(janet_proc_wait_subr, targs, janet_proc_wait_cb);
@@ -622,16 +631,15 @@ os_proc_wait_impl(JanetProc *proc) {
JANET_CORE_FN(os_proc_wait,
"(os/proc-wait proc)",
"Suspend the current fiber until the subprocess completes. Returns the subprocess return code. "
"os/proc-wait cannot be called twice on the same process. If `ev/with-deadline` cancels `os/proc-wait` "
"with an error or os/proc-wait is cancelled with any error caused by anything else, os/proc-wait still "
"finishes in the background. Only after os/proc-wait finishes, a process is cleaned up by the operating "
"system. Thus, a process becomes a zombie process if os/proc-wait is not called.") {
"Suspend the current fiber until the subprocess `proc` completes. Once `proc` "
"completes, return the exit code of `proc`. If called more than once on the same "
"core/process value, will raise an error. When creating subprocesses using "
"`os/spawn`, this function should be called on the returned value to avoid zombie "
"processes.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
os_proc_wait_impl(proc);
return janet_wrap_nil();
#else
return os_proc_wait_impl(proc);
#endif
@@ -736,12 +744,13 @@ static int get_signal_kw(const Janet *argv, int32_t n) {
JANET_CORE_FN(os_proc_kill,
"(os/proc-kill proc &opt wait signal)",
"Kill a subprocess by sending SIGKILL to it on posix systems, or by closing the process "
"handle on windows. If os/proc-wait already finished for proc, os/proc-kill raises an error. After "
"sending signal to proc, if `wait` is truthy, will wait for the process to finish and return the exit "
"code by calling os/proc-wait. Otherwise, returns `proc`. If signal is specified, send it instead. "
"Signal keywords are named after their C counterparts but in lowercase with the leading `SIG` stripped. "
"Signals are ignored on windows.") {
"Kill the subprocess `proc` by sending SIGKILL to it on POSIX systems, or by closing "
"the process handle on Windows. If `proc` has already completed, raise an error. If "
"`wait` is truthy, will wait for `proc` to complete and return the exit code (this "
"will raise an error if `proc` is being waited for). Otherwise, return `proc`. If "
"`signal` is provided, send it instead of SIGKILL. Signal keywords are named after "
"their C counterparts but in lowercase with the leading SIG stripped. `signal` is "
"ignored on Windows.") {
janet_arity(argc, 1, 3);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
if (proc->flags & JANET_PROC_WAITED) {
@@ -769,7 +778,6 @@ JANET_CORE_FN(os_proc_kill,
if (argc > 1 && janet_truthy(argv[1])) {
#ifdef JANET_EV
os_proc_wait_impl(proc);
return janet_wrap_nil();
#else
return os_proc_wait_impl(proc);
#endif
@@ -780,9 +788,9 @@ JANET_CORE_FN(os_proc_kill,
JANET_CORE_FN(os_proc_close,
"(os/proc-close proc)",
"Close pipes created by `os/spawn` if they have not been closed. Then, if os/proc-wait was not already "
"called on proc, os/proc-wait is called on it, and it returns the exit code returned by os/proc-wait. "
"Otherwise, returns nil.") {
"Close pipes created for subprocess `proc` by `os/spawn` if they have not been "
"closed. Then, if `proc` is not being waited for, wait. If this function waits, when "
"`proc` completes, return the exit code of `proc`. Otherwise, return nil.") {
janet_fixarity(argc, 1);
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
#ifdef JANET_EV
@@ -800,7 +808,6 @@ JANET_CORE_FN(os_proc_close,
}
#ifdef JANET_EV
os_proc_wait_impl(proc);
return janet_wrap_nil();
#else
return os_proc_wait_impl(proc);
#endif
@@ -1261,9 +1268,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
/* exec mode */
if (mode == JANET_EXECUTE_EXEC) {
#ifdef JANET_WINDOWS
janet_panic("not supported on windows");
#else
int status;
if (!use_environ) {
environ = envp;
@@ -1276,7 +1280,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
}
} while (status == -1 && errno == EINTR);
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
#endif
}
/* Use posix_spawn to spawn new process */
@@ -1377,45 +1380,56 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
JANET_CORE_FN(os_execute,
"(os/execute args &opt flags env)",
"Execute a program on the system and pass it string arguments. `flags` "
"is a keyword that modifies how the program will execute.\n"
"* :e - enables passing an environment to the program. Without :e, the "
"Execute a program on the system and return the exit code. `args` is an array/tuple "
"of strings. The first string is the name of the program and the remainder are "
"arguments passed to the program. `flags` is a keyword made from the following "
"characters that modifies how the program executes:\n"
"* :e - enables passing an environment to the program. Without 'e', the "
"current environment is inherited.\n"
"* :p - allows searching the current PATH for the binary to execute. "
"Without this flag, binaries must use absolute paths.\n"
"* :x - raise error if exit code is non-zero.\n"
"* :d - Don't try and terminate the process on garbage collection (allow spawning zombies).\n"
"`env` is a table or struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the subprocess. "
":in, :out, and :err should be core/file values or core/stream values. core/file values and core/stream "
"values passed to :in, :out, and :err should be closed manually because os/execute doesn't close them. "
"Returns the exit code of the program.") {
"* :p - allows searching the current PATH for the program to execute. "
"Without this flag, the first element of `args` must be an absolute path.\n"
"* :x - raises error if exit code is non-zero.\n"
"* :d - prevents the garbage collector terminating the program (if still running) "
"and calling the equivalent of `os/proc-wait` (allows zombie processes).\n"
"`env` is a table/struct mapping environment variables to values. It can also "
"contain the keys :in, :out, and :err, which allow redirecting stdio in the "
"subprocess. :in, :out, and :err should be core/file or core/stream values. "
"If core/stream values are used, the caller is responsible for ensuring pipes do not "
"cause the program to block and deadlock.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_EXECUTE);
}
JANET_CORE_FN(os_spawn,
"(os/spawn args &opt flags env)",
"Execute a program on the system and return a handle to the process. Otherwise, takes the "
"same arguments as `os/execute`. Does not wait for the process. For each of the :in, :out, and :err keys "
"of the `env` argument, one can also pass in the keyword `:pipe` to get streams for standard IO of the "
"subprocess that can be read from and written to. The returned value `proc` has the fields :in, :out, "
":err, and the additional field :pid on unix-like platforms. `(os/proc-wait proc)` must be called to "
"rejoin the subprocess. After `(os/proc-wait proc)` finishes, proc gains a new field, :return-code. "
"If :x flag is passed to os/spawn, non-zero exit code will cause os/proc-wait to raise an error. "
"If pipe streams created with :pipe keyword are not closed in time, janet can run out of file "
"descriptors. They can be closed individually, or `os/proc-close` can close all pipe streams on proc. "
"If pipe streams aren't read before `os/proc-wait` finishes, then pipe buffers become full, and the "
"process cannot finish because the process cannot print more on pipe buffers which are already full. "
"If the process cannot finish, os/proc-wait cannot finish, either.") {
"Execute a program on the system and return a core/process value representing the "
"spawned subprocess. Takes the same arguments as `os/execute` but does not wait for "
"the subprocess to complete. Unlike `os/execute`, the value `:pipe` can be used for "
":in, :out and :err keys in `env`. If used, the returned core/process will have a "
"writable stream in the :in field and readable streams in the :out and :err fields. "
"On non-Windows systems, the subprocess PID will be in the :pid field. The caller is "
"responsible for waiting on the process (e.g. by calling `os/proc-wait` on the "
"returned core/process value) to avoid creating zombie process. After the subprocess "
"completes, the exit value is in the :return-code field. If `flags` includes 'x', a "
"non-zero exit code will cause a waiting fiber to raise an error. The use of "
"`:pipe` may fail if there are too many active file descriptors. The caller is "
"responsible for closing pipes created by `:pipe` (either individually or using "
"`os/proc-close`). Similar to `os/execute`, the caller is responsible for ensuring "
"pipes do not cause the program to block and deadlock.") {
return os_execute_impl(argc, argv, JANET_EXECUTE_SPAWN);
}
JANET_CORE_FN(os_posix_exec,
"(os/posix-exec args &opt flags env)",
"Use the execvpe or execve system calls to replace the current process with an interface similar to os/execute. "
"Hoever, instead of creating a subprocess, the current process is replaced. Is not supported on windows, and "
"However, instead of creating a subprocess, the current process is replaced. Is not supported on Windows, and "
"does not allow redirection of stdio.") {
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("not supported on Windows");
#else
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
#endif
}
JANET_CORE_FN(os_posix_fork,
@@ -1426,7 +1440,7 @@ JANET_CORE_FN(os_posix_fork,
janet_fixarity(argc, 0);
(void) argv;
#ifdef JANET_WINDOWS
janet_panic("not supported");
janet_panic("not supported on Windows");
#else
pid_t result;
do {
@@ -1582,8 +1596,8 @@ JANET_CORE_FN(os_clock,
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
janet_arity(argc, 0, 2);
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, NULL);
if (sourcestr == NULL || janet_cstrcmp(sourcestr, "realtime") == 0) {
source = JANET_TIME_REALTIME;
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
source = JANET_TIME_MONOTONIC;
@@ -1596,8 +1610,8 @@ JANET_CORE_FN(os_clock,
struct timespec tv;
if (janet_gettime(&tv, source)) janet_panic("could not get time");
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, NULL);
if (formatstr == NULL || janet_cstrcmp(formatstr, "double") == 0) {
double dtime = (double)(tv.tv_sec + (tv.tv_nsec / 1E9));
return janet_wrap_number(dtime);
} else if (janet_cstrcmp(formatstr, "int") == 0) {
@@ -1873,7 +1887,6 @@ JANET_CORE_FN(os_mktime,
/* utc time */
#ifdef JANET_NO_UTC_MKTIME
janet_panic("os/mktime UTC not supported on this platform");
return janet_wrap_nil();
#else
t = timegm(&t_info);
#endif
@@ -1940,8 +1953,7 @@ JANET_CORE_FN(os_link,
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/link not supported on Windows");
return janet_wrap_nil();
janet_panic("not supported on Windows");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -1959,8 +1971,7 @@ JANET_CORE_FN(os_symlink,
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/symlink not supported on Windows");
return janet_wrap_nil();
janet_panic("not supported on Windows");
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
@@ -2062,8 +2073,7 @@ JANET_CORE_FN(os_readlink,
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/readlink not supported on Windows");
return janet_wrap_nil();
janet_panic("not supported on Windows");
#else
static char buffer[PATH_MAX];
const char *path = janet_getcstring(argv, 0);
@@ -2319,7 +2329,6 @@ static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
return sg->fn(&st);
}
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
return janet_wrap_nil();
}
}
@@ -2668,7 +2677,7 @@ JANET_CORE_FN(os_open,
} else if (write_flag && !read_flag) {
open_flags |= O_WRONLY;
} else {
open_flags = O_RDWR;
open_flags |= O_RDWR;
}
do {
@@ -2680,16 +2689,24 @@ JANET_CORE_FN(os_open,
}
JANET_CORE_FN(os_pipe,
"(os/pipe)",
"(os/pipe &opt flags)",
"Create a readable stream and a writable stream that are connected. Returns a two-element "
"tuple where the first element is a readable stream and the second element is the writable "
"stream.") {
"stream. `flags` is a keyword set of flags to disable non-blocking settings on the ends of the pipe. "
"This may be desired if passing the pipe to a subprocess with `os/spawn`.\n\n"
"* :W - sets the writable end of the pipe to a blocking stream.\n"
"* :R - sets the readable end of the pipe to a blocking stream.\n\n"
"By default, both ends of the pipe are non-blocking for use with the `ev` module.") {
(void) argv;
janet_fixarity(argc, 0);
janet_arity(argc, 0, 1);
JanetHandle fds[2];
if (janet_make_pipe(fds, 0)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], JANET_STREAM_WRITABLE, NULL);
int flags = 0;
if (argc > 0 && !janet_checktype(argv[0], JANET_NIL)) {
flags = (int) janet_getflags(argv, 0, "WR");
}
if (janet_make_pipe(fds, flags)) janet_panicv(janet_ev_lasterr());
JanetStream *reader = janet_stream(fds[0], (flags & 2) ? 0 : JANET_STREAM_READABLE, NULL);
JanetStream *writer = janet_stream(fds[1], (flags & 1) ? 0 : JANET_STREAM_WRITABLE, NULL);
Janet tup[2] = {janet_wrap_abstract(reader), janet_wrap_abstract(writer)};
return janet_wrap_tuple(janet_tuple_n(tup, 2));
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -231,7 +231,7 @@ static void delim_error(JanetParser *parser, size_t stack_index, char c, const c
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->flag |= JANET_PARSER_GENERATED_ERROR;
@@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) {
JanetParseState top = p->states[p->statecount - 1];
int32_t indent_col = (int32_t) top.column - 1;
uint8_t *r = bufstart, *end = r + buflen;
/* Check if there are any characters before the start column -
* if so, do not reindent. */
/* Unless there are only spaces before EOLs, disable reindenting */
int reindent = 1;
while (reindent && (r < end)) {
if (*r++ == '\n') {
@@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) {
break;
}
}
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1;
}
}
/* Now reindent if able to, otherwise just drop leading newline. */
if (!reindent) {
if (buflen > 0 && bufstart[0] == '\n') {
buflen--;
bufstart++;
}
} else {
/* Now reindent if able */
if (reindent) {
uint8_t *w = bufstart;
r = bufstart;
while (r < end) {
if (*r == '\n') {
if (r == bufstart) {
/* Skip leading newline */
r++;
} else {
*w++ = *r++;
}
*w++ = *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 {
*w++ = *r++;
}
}
buflen = (int32_t)(w - bufstart);
}
/* Check for trailing newline character so we can remove it */
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
/* Check for leading EOL so we can remove it */
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--;
}
}
@@ -467,8 +468,13 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
}
ret = janet_keywordv(p->buf + 1, blen - 1);
#ifdef JANET_INT_TYPES
} else if (start_num && !janet_scan_numeric(p->buf, blen, &ret)) {
(void) numval;
#else
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
ret = janet_wrap_number(numval);
#endif
} else if (!check_str_const("nil", p->buf, blen)) {
ret = janet_wrap_nil();
} else if (!check_str_const("false", p->buf, blen)) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -134,7 +134,7 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
* a newline character is consider to be on the same line as the character before
* (\n is line terminator, not line separator).
* - in the not-found case, we still want to find the greatest-indexed newline that
* is before position. we use that to calcuate the line and column.
* is before position. we use that to calculate the line and column.
* - in the case that lo = 0 and s->linemap[0] is still greater than position, we
* are on the first line and our column is position + 1. */
int32_t hi = s->linemaplen; /* hi is greater than the actual line */
@@ -342,7 +342,7 @@ tail:
while (captured < hi) {
CapState cs2 = cap_save(s);
next_text = peg_rule(s, rule_a, text);
if (!next_text || next_text == text) {
if (!next_text || ((next_text == text) && (hi == UINT32_MAX))) {
cap_load(s, cs2);
break;
}
@@ -465,6 +465,16 @@ tail:
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: {
uint32_t tag = rule[2];
int oldmode = s->mode;
@@ -486,6 +496,30 @@ tail:
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: {
const uint8_t *text_start = text;
const uint32_t *rule_window = s->bytecode + rule[1];
@@ -510,41 +544,80 @@ tail:
return window_end;
}
case RULE_TIL: {
const uint32_t *rule_terminus = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *terminus_start = text;
const uint8_t *terminus_end = NULL;
down1(s);
while (terminus_start <= s->text_end) {
CapState cs2 = cap_save(s);
terminus_end = peg_rule(s, rule_terminus, terminus_start);
cap_load(s, cs2);
if (terminus_end) {
break;
}
terminus_start++;
}
up1(s);
if (!terminus_end) {
return NULL;
}
const uint8_t *saved_end = s->text_end;
s->text_end = terminus_start;
down1(s);
const uint8_t *matched = peg_rule(s, rule_subpattern, text);
up1(s);
s->text_end = saved_end;
if (!matched) {
return NULL;
}
return terminus_end;
}
case RULE_SPLIT: {
const uint8_t *saved_end = s->text_end;
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
const uint8_t *chunk_start = text;
const uint8_t *chunk_end = NULL;
while (text <= saved_end) {
/* Find next split (or end of text) */
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
while (text <= saved_end) {
chunk_end = text;
const uint8_t *check = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (separator_end) {
if (check) {
text = check;
break;
}
text++;
}
up1(s);
if (separator_end) {
s->text_end = text;
text = separator_end;
}
/* Match between splits */
s->text_end = chunk_end;
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) return NULL; /* Don't match anything */
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
/* Ensure forward progress */
if (text == chunk_start) return NULL;
chunk_start = text;
}
s->text_end = saved_end;
return s->text_end;
}
@@ -667,11 +740,11 @@ tail:
case RULE_READINT: {
uint32_t tag = rule[2];
uint32_t signedness = rule[1] & 0x10;
uint32_t endianess = rule[1] & 0x20;
uint32_t endianness = rule[1] & 0x20;
int width = (int)(rule[1] & 0xF);
if (text + width > s->text_end) return NULL;
uint64_t accum = 0;
if (endianess) {
if (endianness) {
/* BE */
for (int i = 0; i < width; i++) accum = (accum << 8) | text[i];
} else {
@@ -1061,6 +1134,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) {
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] */
static void spec_cap1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
@@ -1084,6 +1160,15 @@ static void spec_unref(Builder *b, int32_t argc, const Janet *argv) {
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) {
peg_arity(b, argc, 1, 3);
Reserve r = reserve(b, 4);
@@ -1181,6 +1266,14 @@ static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
emit_2(r, RULE_SUB, subrule1, subrule2);
}
static void spec_til(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_TIL, subrule1, subrule2);
}
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
@@ -1262,7 +1355,9 @@ static const SpecialPair peg_specials[] = {
{"line", spec_line},
{"look", spec_look},
{"not", spec_not},
{"nth", spec_nth},
{"number", spec_capture_number},
{"only-tags", spec_only_tags},
{"opt", spec_opt},
{"position", spec_position},
{"quote", spec_capture},
@@ -1275,6 +1370,7 @@ static const SpecialPair peg_specials[] = {
{"split", spec_split},
{"sub", spec_sub},
{"thru", spec_thru},
{"til", spec_til},
{"to", spec_to},
{"uint", spec_uint_le},
{"uint-be", spec_uint_be},
@@ -1368,6 +1464,11 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_BUFFER: {
const JanetBuffer *buf = janet_unwrap_buffer(peg);
emit_bytes(b, RULE_LITERAL, buf->count, buf->data);
break;
}
case JANET_TABLE: {
/* Build grammar table */
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
@@ -1609,6 +1710,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 4;
break;
case RULE_SUB:
case RULE_TIL:
case RULE_SPLIT:
/* [rule, rule] */
if (rule[1] >= blen) goto bad;
@@ -1619,6 +1721,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
break;
case RULE_ERROR:
case RULE_DROP:
case RULE_ONLY_TAGS:
case RULE_NOT:
case RULE_TO:
case RULE_THRU:
@@ -1628,10 +1731,16 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 2;
break;
case RULE_READINT:
/* [ width | (endianess << 5) | (signedness << 6), tag ] */
/* [ width | (endianness << 5) | (signedness << 6), tag ] */
if (rule[1] > JANET_MAX_READINT_WIDTH) goto bad;
i += 3;
break;
case RULE_NTH:
/* [nth, rule, tag] */
if (rule[2] >= blen) goto bad;
op_flags[rule[2]] |= 0x01;
i += 4;
break;
default:
goto bad;
}
@@ -1725,7 +1834,7 @@ static JanetPeg *compile_peg(Janet x) {
JANET_CORE_FN(cfun_peg_compile,
"(peg/compile peg)",
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to suppliment "
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
"the grammar of the peg for otherwise undefined peg keywords.") {
janet_fixarity(argc, 1);
JanetPeg *peg = compile_peg(argv[0]);

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -28,7 +28,7 @@
/* Run a string */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser parser;
JanetParser *parser;
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
@@ -37,14 +37,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (where) janet_gcroot(janet_wrap_string(where));
if (NULL == sourcePath) sourcePath = "<unknown>";
janet_parser_init(&parser);
parser = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_init(parser);
janet_gcroot(janet_wrap_abstract(parser));
/* While we haven't seen an error */
while (!done) {
/* Evaluate parsed values */
while (janet_parser_has_more(&parser)) {
Janet form = janet_parser_produce(&parser);
while (janet_parser_has_more(parser)) {
Janet form = janet_parser_produce(parser);
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
@@ -58,8 +60,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
@@ -81,16 +83,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
switch (janet_parser_status(parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
const char *e = janet_parser_error(parser);
errflags |= 0x04;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
@@ -98,9 +100,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
janet_parser_eof(parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
janet_parser_consume(parser, bytes[index++]);
}
break;
}
@@ -108,7 +110,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
/* Clean up and return errors */
janet_parser_deinit(&parser);
janet_gcunroot(janet_wrap_abstract(parser));
if (where) janet_gcunroot(janet_wrap_string(where));
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -58,7 +58,7 @@ void janet_vm_load(JanetVM *from) {
}
/* Trigger suspension of the Janet vm by trying to
* exit the interpeter loop when convenient. You can optionally
* exit the interpreter loop when convenient. You can optionally
* use NULL to interrupt the current VM when convenient */
void janet_interpreter_interrupt(JanetVM *vm) {
vm = vm ? vm : &janet_vm;

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -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) {
int32_t lhash = janet_string_hash(lhs);
int32_t llen = janet_string_length(lhs);
if (lhs == rhs)
return 1;
if (lhash != rhash || llen != rlen)
return 0;
if (lhs == rhs)
return 1;
return !memcmp(lhs, rhs, rlen);
}

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -34,9 +34,9 @@
* because E is a valid digit in bases 15 or greater. For bases greater than
* 10, the letters are used as digits. A through Z correspond to the digits 10
* through 35, and the lowercase letters have the same values. The radix number
* is always in base 10. For example, a hexidecimal number could be written
* is always in base 10. For example, a hexadecimal number could be written
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
* hexidecimal literals. The previous number could also be written
* hexadecimal literals. The previous number could also be written
* '0xdeadbeef'.
*/
@@ -301,6 +301,7 @@ int janet_scan_number_base(
if (base == 0) {
base = 10;
}
int exp_base = base;
/* Skip leading zeros */
while (str < end && (*str == '0' || *str == '.')) {
@@ -322,6 +323,12 @@ int janet_scan_number_base(
} else if (*str == '&') {
foundexp = 1;
break;
} else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */
foundexp = 1;
exp_base = 10;
base = 2;
ex *= 4; /* We need to correct the current exponent after we change the base */
break;
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
foundexp = 1;
break;
@@ -360,9 +367,9 @@ int janet_scan_number_base(
}
while (str < end) {
int digit = digit_lookup[*str & 0x7F];
if (*str > 127 || digit >= base) goto error;
if (*str > 127 || digit >= exp_base) goto error;
if (ee < (INT32_MAX / 40)) {
ee = base * ee + digit;
ee = exp_base * ee + digit;
}
str++;
seenadigit = 1;
@@ -489,6 +496,40 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
return 0;
}
/* Similar to janet_scan_number but allows for
* more numeric types with a given suffix. */
int janet_scan_numeric(
const uint8_t *str,
int32_t len,
Janet *out) {
int result;
double num;
int64_t i64 = 0;
uint64_t u64 = 0;
if (len < 2 || str[len - 2] != ':') {
result = janet_scan_number_base(str, len, 0, &num);
*out = janet_wrap_number(num);
return result;
}
switch (str[len - 1]) {
default:
return 1;
case 'n':
result = janet_scan_number_base(str, len - 2, 0, &num);
*out = janet_wrap_number(num);
return result;
/* Condition is inverted janet_scan_int64 and janet_scan_uint64 */
case 's':
result = !janet_scan_int64(str, len - 2, &i64);
*out = janet_wrap_s64(i64);
return result;
case 'u':
result = !janet_scan_uint64(str, len - 2, &u64);
*out = janet_wrap_u64(u64);
return result;
}
}
#endif
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table,
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 */
void janet_lib_struct(JanetTable *env) {
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/proto-flatten", cfun_struct_flatten),
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
JANET_CORE_REG("struct/rawget", cfun_struct_rawget),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, struct_cfuns);

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -67,7 +67,7 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
return table;
}
/* Initialize a table (for use withs scratch memory) */
/* Initialize a table (for use with scratch memory) */
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
return janet_table_init_impl(table, capacity, 1);
}
@@ -372,12 +372,14 @@ JANET_CORE_FN(cfun_table_setproto,
}
JANET_CORE_FN(cfun_table_tostruct,
"(table/to-struct tab)",
"Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.") {
janet_fixarity(argc, 1);
"(table/to-struct tab &opt proto)",
"Convert a table to a struct. Returns a new struct.") {
janet_arity(argc, 1, 2);
JanetTable *t = janet_gettable(argv, 0);
return janet_wrap_struct(janet_table_to_struct(t));
JanetStruct proto = janet_optstruct(argv, argc, 1, NULL);
JanetStruct st = janet_table_to_struct(t);
janet_struct_proto(st) = proto;
return janet_wrap_struct(st);
}
JANET_CORE_FN(cfun_table_rawget,

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -116,6 +116,34 @@ JANET_CORE_FN(cfun_tuple_setmap,
return argv[0];
}
JANET_CORE_FN(cfun_tuple_join,
"(tuple/join & parts)",
"Create a tuple by joining together other tuples and arrays.") {
janet_arity(argc, 0, -1);
int32_t total_len = 0;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
if (!janet_indexed_view(argv[i], &vals, &len)) {
janet_panicf("expected indexed type for argument %d, got %v", i, argv[i]);
}
if (INT32_MAX - total_len < len) {
janet_panic("tuple too large");
}
total_len += len;
}
Janet *tup = janet_tuple_begin(total_len);
Janet *tup_cursor = tup;
for (int32_t i = 0; i < argc; i++) {
int32_t len = 0;
const Janet *vals = NULL;
janet_indexed_view(argv[i], &vals, &len);
memcpy(tup_cursor, vals, len * sizeof(Janet));
tup_cursor += len;
}
return janet_wrap_tuple(janet_tuple_end(tup));
}
/* Load the tuple module */
void janet_lib_tuple(JanetTable *env) {
JanetRegExt tuple_cfuns[] = {
@@ -124,6 +152,7 @@ void janet_lib_tuple(JanetTable *env) {
JANET_CORE_REG("tuple/type", cfun_tuple_type),
JANET_CORE_REG("tuple/sourcemap", cfun_tuple_sourcemap),
JANET_CORE_REG("tuple/setmap", cfun_tuple_setmap),
JANET_CORE_REG("tuple/join", cfun_tuple_join),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, tuple_cfuns);

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -79,6 +79,7 @@ const char *const janet_type_names[16] = {
"pointer"
};
/* Docstring for signal lists these */
const char *const janet_signal_names[14] = {
"ok",
"error",
@@ -96,6 +97,7 @@ const char *const janet_signal_names[14] = {
"await"
};
/* Docstring for fiber/status lists these */
const char *const janet_status_names[16] = {
"dead",
"error",
@@ -115,14 +117,20 @@ const char *const janet_status_names[16] = {
"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
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;
uint32_t hash = 5381;
while (str < end)
hash = (hash << 5) + hash + *str++;
hash = janet_hash_mix(hash, (uint32_t) len);
return (int32_t) hash;
}
@@ -238,11 +246,6 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
#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 */
int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len;
@@ -826,6 +829,20 @@ int janet_checkuint64(Janet x) {
return janet_checkuint64range(dval);
}
int janet_checkint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkint16range(dval);
}
int janet_checkuint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuint16range(dval);
}
int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@@ -958,7 +975,7 @@ const char *janet_strerror(int e) {
#ifdef JANET_WINDOWS
/* Microsoft strerror seems sane here and is thread safe by default */
return strerror(e);
#elif defined(_GNU_SOURCE)
#elif defined(__GLIBC__)
/* See https://linux.die.net/man/3/strerror_r */
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
#else

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -33,6 +33,7 @@
#include <errno.h>
#include <stddef.h>
#include <stdbool.h>
#include <math.h>
#ifdef JANET_EV
#ifndef JANET_WINDOWS
@@ -141,7 +142,7 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source);
#define strdup(x) _strdup(x)
#endif
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libraries
* with native code. */
#if defined(JANET_NO_DYNAMIC_MODULES)
typedef int Clib;
@@ -189,9 +190,6 @@ void janet_lib_debug(JanetTable *env);
#ifdef JANET_PEG
void janet_lib_peg(JanetTable *env);
#endif
#ifdef JANET_TYPED_ARRAY
void janet_lib_typed_array(JanetTable *env);
#endif
#ifdef JANET_INT_TYPES
void janet_lib_inttypes(JanetTable *env);
#endif
@@ -202,7 +200,11 @@ extern const JanetAbstractType janet_address_type;
#ifdef JANET_EV
void janet_lib_ev(JanetTable *env);
void janet_ev_mark(void);
void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
int janet_make_pipe(JanetHandle handles[2], int mode);
#ifdef JANET_FILEWATCH
void janet_lib_filewatch(JanetTable *env);
#endif
#endif
#ifdef JANET_FFI
void janet_lib_ffi(JanetTable *env);

View File

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

View File

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

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -798,14 +798,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
vm_pcnext();
VM_OP(JOP_JUMP)
pc += DS;
vm_maybe_auto_suspend(DS <= 0);
pc += DS;
vm_next();
VM_OP(JOP_JUMP_IF)
if (janet_truthy(stack[A])) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
pc += ES;
} else {
pc++;
}
@@ -815,15 +815,15 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_truthy(stack[A])) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
pc += ES;
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
pc += ES;
} else {
pc++;
}
@@ -833,8 +833,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
if (janet_checktype(stack[A], JANET_NIL)) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
pc += ES;
}
vm_next();
@@ -1268,7 +1268,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
/*
* Execute a single instruction in the fiber. Does this by inspecting
* the fiber, setting a breakpoint at the next instruction, executing, and
* reseting breakpoints to how they were prior. Yes, it's a bit hacky.
* resetting breakpoints to how they were prior. Yes, it's a bit hacky.
*/
JanetSignal janet_step(JanetFiber *fiber, Janet in, Janet *out) {
/* No finished or currently alive fibers. */
@@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Run vm */
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());
janet_vm.coerce_error = old_coerce_error;
/* Teardown */
janet_vm.stackn = oldn;
@@ -1384,6 +1387,15 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
}
if (signal != JANET_SIGNAL_OK) {
/* Should match logic in janet_signalv */
#ifdef JANET_EV
if (janet_vm.root_fiber != NULL && signal == JANET_SIGNAL_EVENT) {
janet_vm.root_fiber->sched_id++;
}
#endif
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);
}
@@ -1430,8 +1442,10 @@ void janet_try_init(JanetTryState *state) {
state->vm_fiber = janet_vm.fiber;
state->vm_jmp_buf = janet_vm.signal_buf;
state->vm_return_reg = janet_vm.return_reg;
state->coerce_error = janet_vm.coerce_error;
janet_vm.return_reg = &(state->payload);
janet_vm.signal_buf = &(state->buf);
janet_vm.coerce_error = 0;
}
void janet_restore(JanetTryState *state) {
@@ -1440,6 +1454,7 @@ void janet_restore(JanetTryState *state) {
janet_vm.fiber = state->vm_fiber;
janet_vm.signal_buf = state->vm_jmp_buf;
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) {
@@ -1613,7 +1628,7 @@ int janet_init(void) {
janet_vm.registry_count = 0;
janet_vm.registry_dirty = 0;
/* Intialize abstract registry */
/* Initialize abstract registry */
janet_vm.abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm.abstract_registry));

View File

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

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -46,7 +46,7 @@ extern "C" {
#endif
/*
* Detect OS and endianess.
* Detect OS and endianness.
* From webkit source. There is likely some extreneous
* detection for unsupported platforms
*/
@@ -210,6 +210,11 @@ extern "C" {
#define JANET_EV
#endif
/* Enable or disable the filewatch/ module */
#if !defined(JANET_NO_FILEWATCH)
#define JANET_FILEWATCH
#endif
/* Enable or disable networking */
#if defined(JANET_EV) && !defined(JANET_NO_NET) && !defined(__EMSCRIPTEN__)
#define JANET_NET
@@ -262,7 +267,7 @@ extern "C" {
#endif
#endif
/* Tell complier some functions don't return */
/* Tell compiler some functions don't return */
#ifndef JANET_NO_RETURN
#ifdef JANET_WINDOWS
#define JANET_NO_RETURN __declspec(noreturn)
@@ -272,7 +277,7 @@ extern "C" {
#endif
/* Prevent some recursive functions from recursing too deeply
* ands crashing (the parser). Instead, error out. */
* and crashing (the parser). Instead, error out. */
#define JANET_RECURSION_GUARD 1024
/* Maximum depth to follow table prototypes before giving up and returning nil. */
@@ -354,6 +359,7 @@ typedef struct {
#ifdef JANET_EV
typedef struct JanetOSMutex JanetOSMutex;
typedef struct JanetOSRWLock JanetOSRWLock;
typedef struct JanetChannel JanetChannel;
#endif
/***** END SECTION CONFIG *****/
@@ -627,7 +633,9 @@ typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
* call when ever an event is sent from the event loop. state is an optional (can be NULL)
* pointer to data allocated with janet_malloc. This pointer will be passed to callback as
* fiber->ev_state. It will also be freed for you by the runtime when the event loop determines
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct. */
* it can no longer be referenced. On windows, the contents of state MUST contained an OVERLAPPED struct at the 0 offset. */
JANET_API void janet_async_start_fiber(JanetFiber *fiber, JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
JANET_API JANET_NO_RETURN void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state);
/* Do not send any more events to the given callback. Call this after scheduling fiber to be resume
@@ -897,12 +905,16 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
/* End of tagged union implementation */
#endif
JANET_API int janet_checkint16(Janet x);
JANET_API int janet_checkuint16(Janet x);
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkuint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x))
#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x))
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
@@ -1249,6 +1261,7 @@ typedef struct {
/* new state */
jmp_buf buf;
Janet payload;
int coerce_error;
} JanetTryState;
/***** END SECTION TYPES *****/
@@ -1409,6 +1422,7 @@ JANET_API void janet_loop1_interrupt(JanetVM *vm);
/* Wrapper around streams */
JANET_API JanetStream *janet_stream(JanetHandle handle, uint32_t flags, const JanetMethod *methods);
JANET_API JanetStream *janet_stream_ext(JanetHandle handle, uint32_t flags, const JanetMethod *methods, size_t size); /* Allow for type punning streams */
JANET_API void janet_stream_close(JanetStream *stream);
JANET_API Janet janet_cfun_stream_close(int32_t argc, Janet *argv);
JANET_API Janet janet_cfun_stream_read(int32_t argc, Janet *argv);
@@ -1429,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
* 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_nil(double sec);
JANET_API void janet_ev_inc_refcount(void);
JANET_API void janet_ev_dec_refcount(void);
@@ -1439,6 +1454,14 @@ JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t s
JANET_API int32_t janet_abstract_incref(void *abst);
JANET_API int32_t janet_abstract_decref(void *abst);
/* Expose channel utilities */
JanetChannel *janet_channel_make(uint32_t limit);
JanetChannel *janet_channel_make_threaded(uint32_t limit);
JanetChannel *janet_getchannel(const Janet *argv, int32_t n);
JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_t n, JanetChannel *dflt);
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
/* Expose some OS sync primitives */
JANET_API size_t janet_os_mutex_size(void);
JANET_API size_t janet_os_rwlock_size(void);
@@ -1594,6 +1617,9 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
JANET_API int janet_scan_number_base(const uint8_t *str, int32_t len, int32_t base, double *out);
JANET_API int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out);
JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#ifdef JANET_INT_TYPES
JANET_API int janet_scan_numeric(const uint8_t *str, int32_t len, Janet *out);
#endif
/* Debugging */
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
@@ -1718,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 JanetTable *janet_table_clone(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 */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
@@ -1781,6 +1810,7 @@ JANET_API void janet_gcpressure(size_t s);
/* Functions */
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
JANET_API JanetFunction *janet_thunk_delay(Janet x);
JANET_API int janet_verify(JanetFuncDef *def);
/* Pretty printing */
@@ -2020,7 +2050,10 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n);
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n);
JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n);
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
@@ -2143,13 +2176,16 @@ typedef enum {
RULE_TO, /* [rule] */
RULE_THRU, /* [rule] */
RULE_LENPREFIX, /* [rule_a, rule_b (repeat rule_b rule_a times)] */
RULE_READINT, /* [(signedness << 4) | (endianess << 5) | bytewidth, tag] */
RULE_READINT, /* [(signedness << 4) | (endianness << 5) | bytewidth, tag] */
RULE_LINE, /* [tag] */
RULE_COLUMN, /* [tag] */
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */
RULE_SPLIT /* [rule, rule] */
RULE_TIL, /* [rule, rule] */
RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */
} JanetPegOpcod;
typedef struct {

View File

@@ -1,5 +1,5 @@
/*
* Copyright (c) 2023 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@@ -867,7 +867,7 @@ static int line() {
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
for (;;) {
char c;
char seq[3];
char seq[5];
int rc;
do {
@@ -991,6 +991,20 @@ static int line() {
default:
break;
}
} else if (seq[2] == ';') {
if (read_console(seq + 3, 2) == -1) break;
if (seq[3] == '5') {
switch (seq[4]) {
case 'C': /* ctrl-right */
krightw();
break;
case 'D': /* ctrl-left */
kleftw();
break;
default:
break;
}
}
}
} else if (seq[0] == 'O') {
if (read_console(seq + 1, 1) == -1) break;
@@ -1163,6 +1177,7 @@ int main(int argc, char **argv) {
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
Janet mainargs[1] = { janet_wrap_array(args) };
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
janet_gcroot(janet_wrap_fiber(fiber));
fiber->env = env;
/* Run the fiber in an event loop */

View File

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

View File

@@ -4,24 +4,47 @@
(var num-tests-run 0)
(var suite-name 0)
(var start-time 0)
(var skip-count 0)
(var skip-n 0)
(def is-verbose (os/getenv "VERBOSE"))
(defn assert
(defn- assert-no-tail
"Override's the default assert with some nice error handling."
[x &opt e]
(default e "assert error")
(++ num-tests-run)
(when (pos? skip-n)
(-- skip-n)
(++ skip-count)
(break x))
(default e "assert error")
(when x (++ num-tests-passed))
(def str (string e))
(def frame (last (debug/stack (fiber/current))))
(def stack (debug/stack (fiber/current)))
(def frame (last stack))
(def line-info (string/format "%s:%d"
(frame :source) (frame :source-line)))
(if x
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(do (eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
x)
(defn skip-asserts
"Skip some asserts"
[n]
(+= skip-n n)
nil)
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
~(do
(def ,xx ,x)
(,assert-no-tail ,xx ,e)
,xx))
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
@@ -52,5 +75,22 @@
(defn end-suite []
(def delta (- (os/clock) start-time))
(eprinf "Finished suite %s in %.3f seconds - " suite-name delta)
(eprint num-tests-passed " of " num-tests-run " tests passed.")
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
(eprint num-tests-passed " of " num-tests-run " tests passed (" skip-count " skipped).")
(if (not= (+ skip-count num-tests-passed) num-tests-run) (os/exit 1)))
(defn rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
(defn randdir
"Get a random directory name"
[]
(string "tmp_dir_" (slice (string (math/random) ".tmp") 2)))

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -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 3]) "array/remove 4")
# array/peek
(assert (nil? (array/peek @[])) "array/peek empty")
@@ -76,6 +75,16 @@
(array/trim a)
(array/ensure @[1 1] 6 2)
# array/join
(assert (deep= @[1 2 3] (array/join @[] [1] [2] [3])) "array/join 1")
(assert (deep= @[] (array/join @[])) "array/join 2")
(assert (deep= @[1 :a :b :c] (array/join @[1] @[:a :b] [] [:c])) "array/join 3")
(assert (deep= @[:x :y :z "abc123" "def456"] (array/join @[:x :y :z] ["abc123" "def456"])) "array/join 4")
(assert-error "array/join error 1" (array/join))
(assert-error "array/join error 2" (array/join []))
(assert-error "array/join error 3" (array/join [] "abc123"))
(assert-error "array/join error 4" (array/join @[] "abc123"))
(assert-error "array/join error 5" (array/join @[] "abc123"))
(end-suite)

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -754,7 +754,7 @@
(default name (string "has-key? " (++ test-has-key-auto)))
(assert (= expected (has-key? col key)) name)
(if
# guarenteed by `has-key?` to never fail
# guaranteed by `has-key?` to never fail
expected (in col key)
# if `has-key?` is false, then `in` should fail (for indexed types)
#
@@ -896,11 +896,18 @@
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
(table/setproto table-to-freeze @{:a @[1 2 3]})
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
(freeze table-to-freeze)))
(assert (deep= struct-to-thaw (freeze table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
# Check that freezing mutable keys is deterministic
# for issue #1535
(def hashes @{})
(repeat 200
(def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5}))
(put hashes (hash x) true))
(assert (= 1 (length hashes)) "freeze mutable keys is deterministic")
# Make sure Carriage Returns don't end up in doc strings
# e528b86
(assert (not (string/find "\r"
@@ -979,4 +986,34 @@
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(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")
(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2")
(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3")
(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4")
(assert (deep-not= @{:key1 "value1" @"key2" @"value2"}
@{:key1 "value1" @"key2" "value2"}) "deep= mutable keys")
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
(end-suite)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2024 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -85,9 +85,11 @@
(buffer/push-uint16 buffer-uint16-le :le 0x0102)
(assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
(def buffer-uint16-negative @"")
(buffer/push-uint16 buffer-uint16-negative :be -1)
(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
(def buffer-uint16-max @"")
(buffer/push-uint16 buffer-uint16-max :be 0xFFFF)
(assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max")
(assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF))
(assert-error "too small" (buffer/push-uint16 @"" -0x1))
(def buffer-uint32-be @"")
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
@@ -97,9 +99,9 @@
(buffer/push-uint32 buffer-uint32-le :le 0x01020304)
(assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
(def buffer-uint32-negative @"")
(buffer/push-uint32 buffer-uint32-negative :be -1)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
(def buffer-uint32-max @"")
(buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max")
(def buffer-float32-be @"")
(buffer/push-float32 buffer-float32-be :be 1.234)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2024 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -23,30 +23,20 @@
(assert true) # smoke test
# Testing here is stateful since we are manipulating the filesystem.
# Copy since not exposed in boot.janet
(defn- bundle-rpath
[path]
(string/replace-all "\\" "/" (os/realpath path)))
(defn- rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
# Test mkdir -> rmdir
(assert (os/mkdir "tempdir123"))
(rmrf "tempdir123")
# Setup a temporary syspath for manipultation
(math/seedrandom (os/cryptorand 16))
(def syspath (string (math/random) "_jpm_tree.tmp"))
(def syspath (randdir))
(rmrf syspath)
(assert (os/mkdir syspath))
(put root-env *syspath* (bundle-rpath syspath))
@@ -100,6 +90,13 @@
(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
(bundle/uninstall "sample-dep1"))
# Check bundle file aliases
(assert-no-error "sample-bundle-aliases install" (bundle/install "./examples/sample-bundle-aliases"))
(assert (= 4 (length (bundle/list))) "bundles are listed correctly 5")
(assert-no-error "import aliases" (import aliases-mod))
(assert (deep= (range 12) (aliases-mod/fun 12)) "using sample-bundle-aliases")
(assert-no-error "aliases uninstall" (bundle/uninstall "sample-bundle-aliases"))
# Now re-install sample-bundle as auto-remove
(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
@@ -120,6 +117,11 @@
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
(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)
(end-suite)

View File

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

View File

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

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -69,6 +69,13 @@
(seq [n :range [0 10]] (% n 5 3))
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
# linspace range
(assert (deep= @[0 1 2 3] (range 4)) "range 1")
(assert (deep= @[0 1 2 3] (range 3.01)) "range 2")
(assert (deep= @[0 1 2 3] (range 3.999)) "range 3")
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 4")
(assert (deep= @[0.8 1.8 2.8 3.8] (range 0.8 3.999)) "range 5")
(assert (< 1.0 nil false true
(fiber/new (fn [] 1))
"hi"
@@ -167,6 +174,7 @@
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
(assert-error "large range" (range 0xFFFFFFFFFF))
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range -10)) 0) "(range -10)")

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose & contributors
# Copyright (c) 2025 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -199,7 +199,7 @@
(assert s "made server 1")
(defn test-echo [msg]
(with [conn (net/connect test-host test-port)]
(with [conn (assert (net/connect test-host test-port))]
(net/write conn msg)
(def res (net/read conn 1024))
(assert (= (string res) msg) (string "echo " msg))))
@@ -213,6 +213,7 @@
# Test on both server and client
# 504411e
(var iterations 0)
(defn names-handler
[stream]
(defer (:close stream)
@@ -220,21 +221,26 @@
(ev/read stream 1)
(def [host port] (net/localname stream))
(assert (= host test-host) "localname host server")
(assert (= port (scan-number test-port)) "localname port server")))
(assert (= port (scan-number test-port)) "localname port server")
(++ iterations)
(ev/write stream " ")))
# Test localname and peername
# 077bf5eba
(repeat 10
(with [s (net/server test-host test-port names-handler)]
(repeat 10
(with [conn (net/connect test-host test-port)]
(with [conn (assert (net/connect test-host test-port))]
(def [host port] (net/peername conn))
(assert (= host test-host) "peername host client ")
(assert (= port (scan-number test-port)) "peername port client")
# let server close
(ev/write conn " "))))
(++ iterations)
(ev/write conn " ")
(ev/read conn 1))))
(gccollect))
(assert (= iterations 200) "localname and peername not enough checks")
# Create pipe
# 12f09ad2d
(var pipe-counter 0)
@@ -375,4 +381,173 @@
(ev/cancel f (gensym))
(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))))
# Make sure we can't bind again with no-reuse
(assert-error "no-reuse"
(net/listen test-host test-port :stream true))
# 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 (assert (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 (assert (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 (assert (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
(defn sleep-print [x] (ev/sleep 0) (print x))
(protect (with-dyns [*out* sleep-print] (prin :foo)))
(defn level-trigger-handling [conn &] (:close conn))
(def s (assert (net/server test-host test-port level-trigger-handling)))
(def c (assert (net/connect test-host test-port)))
(:close s)
# Issue #1531 no. 2
(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)
# soreuseport on unix domain sockets
(compwhen (or (= :macos (os/which)) (= :linux (os/which)))
(assert-no-error "unix-domain socket reuseaddr"
(let [s (net/listen :unix "./unix-domain-socket" :stream)]
(:close s))))
# net/accept-loop level triggering
(gccollect)
(def maxconn 50)
(var connect-count 0)
(defn level-trigger-handling
[conn &]
(with [conn conn]
(ev/write conn (ev/read conn 4096))
(++ connect-count)))
(def s (assert (net/server test-host test-port level-trigger-handling)))
(def cons @[])
(repeat maxconn (array/push cons (assert (net/connect test-host test-port))))
(assert (= maxconn (length cons)))
(defn do-connect [i]
(with [c (get cons i)]
(ev/write c "abc123")
(ev/read c 4096)))
(for i 0 maxconn (ev/spawn (do-connect i)))
(ev/sleep 0.1)
(assert (= maxconn connect-count))
(:close s)
# Cancel os/proc-wait with ev/deadline
(let [p (os/spawn [;run janet "-e" "(os/sleep 4)"] :p)]
(var terminated-normally false)
(assert-error "deadline expired"
(ev/with-deadline 0.01
(os/proc-wait p)
(print "uhoh")
(set terminated-normally true)))
(assert (not terminated-normally) "early termination failure")
# Without this kill, janet will wait the full 4 seconds for the subprocess to complete before exiting.
(assert-no-error "kill proc after wait failed" (os/proc-kill p)))
# Cancel os/proc-wait with ev/deadline 2
(let [p (os/spawn [;run janet "-e" "(os/sleep 0.1)"] :p)]
(var terminated-normally false)
(assert-error "deadline expired"
(ev/with-deadline 0.05
(os/proc-wait p)
(print "uhoh")
(set terminated-normally true)))
(assert (not terminated-normally) "early termination failure 2")
(ev/sleep 0.15)
(assert (not terminated-normally) "early termination failure 3"))
(end-suite)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose & contributors
# Copyright (c) 2025 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -21,7 +21,6 @@
(import ./helper :prefix "" :exit true)
(start-suite)
# We should get ARM support...
(def has-ffi (dyn 'ffi/native))
(def has-full-ffi
(and has-ffi
@@ -53,5 +52,7 @@
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]]))
"array struct size"))
(end-suite)
(compwhen has-ffi
(assert-error "bad struct issue #1512" (ffi/struct :void)))
(end-suite)

204
test/suite-filewatch.janet Normal file
View File

@@ -0,0 +1,204 @@
# Copyright (c) 2025 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite)
(assert true)
(def chan (ev/chan 1000))
(def is-win (or (= :mingw (os/which)) (= :windows (os/which))))
(def is-linux (= :linux (os/which)))
# If not supported, exit early
(def [supported msg] (protect (filewatch/new chan)))
(when (and (not supported) (string/find "filewatch not supported" msg))
(end-suite)
(quit))
# Test GC
(assert-no-error "filewatch/new" (filewatch/new chan))
(gccollect)
(defn- expect
[key value & more-kvs]
(ev/with-deadline
1
(def event (ev/take chan))
(when is-verbose (pp event))
(assert event "check event")
(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
[]
(assert (zero? (ev/count chan)) "channel check empty")
(ev/sleep 0) # turn the event loop
(assert (zero? (ev/count chan)) "channel check empty")
# Drain if not empty, help with failures after this
(while (pos? (ev/count chan)) (printf "extra: %p" (ev/take chan))))
(defn- expect-maybe
"On wine + mingw, we get an extra event. This is a wine peculiarity."
[key value]
(ev/with-deadline
1
(ev/sleep 0)
(when (pos? (ev/count chan))
(def event (ev/take chan))
(when is-verbose (pp event))
(assert event "check event")
(assert (= value (get event key)) (string/format "got %p, expected %p" (get event key) value)))))
(defn spit-file
[dir name]
(def path (string dir "/" name))
(spit path "test text"))
# Different operating systems report events differently. While it would be nice to
# normalize this, each system has very large limitations in what can be reported when
# compared with other systems. As such, the maximum subset of common functionality here
# is quite small. Instead, test the capabilities of each system.
# Create a file watcher on two test directories
(def fw (filewatch/new chan))
(def td1 (randdir))
(def td2 (randdir))
(def td3 (randdir))
(rmrf td1)
(rmrf td2)
(os/mkdir td1)
(os/mkdir td2)
(os/mkdir td3)
(spit-file td3 "file3.txt")
(when is-win
(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))
(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 td2 :close-write :create :delete :ignored))
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
#
# Windows file writing
#
(when is-win
(spit-file td1 "file1.txt")
(expect :type :added :file-name "file1.txt" :dir-name td1)
(expect :type :modified)
(expect-maybe :type :modified) # for mingw + wine
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :modified)
(expect :type :modified)
(expect-empty)
(gccollect)
# Check td2
(spit-file td2 "file2.txt")
(expect :type :added)
(expect :type :modified)
(expect-maybe :type :modified)
# Remove a file, then wait for remove event
(rmrf (string td1 "/file1.txt"))
(expect :type :removed)
(expect-empty)
# Unlisten to some events
(filewatch/remove fw td2)
# Check that we don't get anymore events from test directory 2
(spit-file td2 "file2.txt")
(expect-empty)
# Repeat and things should still work with test directory 1
(spit-file td1 "file1.txt")
(expect :type :added)
(expect :type :modified)
(expect-maybe :type :modified)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :modified)
(expect :type :modified)
(expect-maybe :type :modified)
(gccollect))
#
# Linux file writing
#
(when is-linux
(spit-file td1 "file1.txt")
(expect :type :create :file-name "file1.txt" :dir-name td1)
(expect :type :close-write)
(expect-empty)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :close-write)
(expect-empty)
(gccollect)
# Check file3.txt
(spit-file td3 "file3.txt")
(expect :type :close-write :file-name "file3.txt" :dir-name td3)
(expect-empty)
# Check td2
(spit-file td2 "file2.txt")
(expect :type :create)
(expect :type :close-write)
(expect-empty)
# Remove a file, then wait for remove event
(rmrf (string td1 "/file1.txt"))
(expect :type :delete)
(expect-empty)
# Unlisten to some events
(filewatch/remove fw td2)
(expect :type :ignored)
(expect-empty)
# Check that we don't get anymore events from test directory 2
(spit-file td2 "file2.txt")
(expect-empty)
# Repeat and things should still work with test directory 1
(spit-file td1 "file1.txt")
(expect :type :create)
(expect :type :close-write)
(expect-empty)
(gccollect)
(spit-file td1 "file1.txt")
(expect :type :close-write)
(expect-empty)
(gccollect))
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
(assert-no-error "cleanup 1" (rmrf td1))
(assert-no-error "cleanup 2" (rmrf td2))
(assert-no-error "cleanup 3" (rmrf td3))
(end-suite)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose & contributors
# Copyright (c) 2025 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -47,6 +47,14 @@
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
# New parser
(assert (= (u64 "123") 123:u) "u64 parsing")
(assert (= (u64 "0") 0:u) "u64 parsing")
(assert (= (u64 "0xFFFF_FFFF_FFFF_FFFF") 0xFFFF_FFFF_FFFF_FFFF:u) "u64 parsing")
(assert (= (i64 "123") 123:s) "s64 parsing")
(assert (= (i64 "-123") -123:s) "s64 parsing")
(assert (= (i64 "0") 0:s) "s64 parsing")
(assert-error
"u64 out of bounds for safe integer"
(int/to-number (u64 "9007199254740993"))

View File

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

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2025 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -146,5 +146,80 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(def item (ev/take newchan))
(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= a 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= t 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

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

Some files were not shown because too many files have changed in this diff Show More