mirror of
https://github.com/janet-lang/janet
synced 2026-04-05 06:21:29 +00:00
Compare commits
413 Commits
bytecode_o
...
use-size_t
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
421f7a2906 | ||
|
|
6e82123fdb | ||
|
|
d0acf6426d | ||
|
|
1baa04572e | ||
|
|
a53921b369 | ||
|
|
6eb371e076 | ||
|
|
09c384a2e9 | ||
|
|
ef04bf557f | ||
|
|
2d17e08a8b | ||
|
|
3558237570 | ||
|
|
a3e5afd610 | ||
|
|
8d3574066b | ||
|
|
c5af2a9313 | ||
|
|
b483c9e2e4 | ||
|
|
3f54b282dd | ||
|
|
46bf5d1ce5 | ||
|
|
3be71dcc0b | ||
|
|
e08e3ba46f | ||
|
|
5991e48d6d | ||
|
|
3f4f71cf87 | ||
|
|
af872a4cae | ||
|
|
b3010e618e | ||
|
|
ed800bd39a | ||
|
|
7b0e5e31db | ||
|
|
a58fc4c8c1 | ||
|
|
88765ee1de | ||
|
|
f077af8d61 | ||
|
|
ee8a1694ba | ||
|
|
bf19920d65 | ||
|
|
2f0c789ea1 | ||
|
|
a9b8f8e8a9 | ||
|
|
f92f3eb6fa | ||
|
|
89e74dca3e | ||
|
|
f2e86d2f8d | ||
|
|
623da131e5 | ||
|
|
e89ec31ae5 | ||
|
|
68a6ed208e | ||
|
|
c01b32c4f3 | ||
|
|
ee11ff9da9 | ||
|
|
ed56d5d6ff | ||
|
|
b317ab755c | ||
|
|
9819994999 | ||
|
|
e9dbaa81d2 | ||
|
|
9f9146ffae | ||
|
|
9d9732af97 | ||
|
|
ebb8fa9787 | ||
|
|
9e6abbf4d4 | ||
|
|
6032a6d658 | ||
|
|
c29ab22e6d | ||
|
|
592ac4904c | ||
|
|
03ae2ec153 | ||
|
|
3bc42d0d37 | ||
|
|
12630d3e54 | ||
|
|
c9897f99c3 | ||
|
|
e66dc14b3a | ||
|
|
7a2868c147 | ||
|
|
9e0daaee09 | ||
|
|
c293c7de93 | ||
|
|
49eb5f8563 | ||
|
|
674b375b2c | ||
|
|
7e94c091eb | ||
|
|
5885ccba61 | ||
|
|
431ecd3d1a | ||
|
|
f6df8ff935 | ||
|
|
3fd70f0951 | ||
|
|
bebb635d4f | ||
|
|
354896bc4b | ||
|
|
5ddefff27e | ||
|
|
91827eef4f | ||
|
|
9c14c09962 | ||
|
|
e85a84171f | ||
|
|
3a4f86c3d7 | ||
|
|
5e75963312 | ||
|
|
184d9289b5 | ||
|
|
b7ff9577c0 | ||
|
|
942a1aaac6 | ||
|
|
69f0fe004d | ||
|
|
2a04347a42 | ||
|
|
1394f1a5c0 | ||
|
|
cf4d19a8ea | ||
|
|
23b0fe9f8e | ||
|
|
1ba718b15e | ||
|
|
df5f79ff35 | ||
|
|
6d7e8528ea | ||
|
|
197bb73a62 | ||
|
|
f91e599451 | ||
|
|
5b9aa9237c | ||
|
|
61f38fab37 | ||
|
|
9142f38cbc | ||
|
|
e8ed961572 | ||
|
|
be11a2a1ad | ||
|
|
ea75086300 | ||
|
|
9eeefbd79a | ||
|
|
c573a98363 | ||
|
|
11d7af3f95 | ||
|
|
a10b4f61d8 | ||
|
|
a0cb7514f1 | ||
|
|
b066edc116 | ||
|
|
938f5a689e | ||
|
|
772f4c26e8 | ||
|
|
6b5d151beb | ||
|
|
a9176a77e6 | ||
|
|
16f409c6a9 | ||
|
|
9593c930de | ||
|
|
56f33f514b | ||
|
|
1ccd544b94 | ||
|
|
93c83a2ee2 | ||
|
|
f459e32ada | ||
|
|
9b640c8e9c | ||
|
|
a3228f4997 | ||
|
|
715eb69d92 | ||
|
|
df2d5cb3d3 | ||
|
|
3b189eab64 | ||
|
|
609b629c22 | ||
|
|
e74365fe38 | ||
|
|
46b34833c2 | ||
|
|
045c80869d | ||
|
|
2ea2e72ddd | ||
|
|
1b17e12fd6 | ||
|
|
cc5beda0d2 | ||
|
|
a363fd926d | ||
|
|
21ebede529 | ||
|
|
15d67e9191 | ||
|
|
b5996f5f02 | ||
|
|
83204dc293 | ||
|
|
e3f4142d2a | ||
|
|
f18ad36b1b | ||
|
|
cb25a2ecd6 | ||
|
|
741a5036e8 | ||
|
|
549ee95f3d | ||
|
|
6ae81058aa | ||
|
|
267c603824 | ||
|
|
a8f583a372 | ||
|
|
2b5d90f73a | ||
|
|
4139e426fe | ||
|
|
a775a89e01 | ||
|
|
990f6352e0 | ||
|
|
b344702304 | ||
|
|
d497612bce | ||
|
|
2a3b101bd8 | ||
|
|
63e93af421 | ||
|
|
ab055b3ebe | ||
|
|
a9a013473f | ||
|
|
87de1e5766 | ||
|
|
894aaef267 | ||
|
|
e209e54ffe | ||
|
|
7511eadaa7 | ||
|
|
6c4906605a | ||
|
|
8a9be9d837 | ||
|
|
b72098cc71 | ||
|
|
defe60e08b | ||
|
|
7f852b8af4 | ||
|
|
d71c100ca7 | ||
|
|
5442c8e86d | ||
|
|
cf4901e713 | ||
|
|
4b8c1ac2d2 | ||
|
|
555e0c0b85 | ||
|
|
dc301305de | ||
|
|
f1111c135b | ||
|
|
3905e92965 | ||
|
|
1418ada38f | ||
|
|
9256a66b76 | ||
|
|
e8c013a778 | ||
|
|
fea8242ea7 | ||
|
|
7bfb17c209 | ||
|
|
e7e4341e70 | ||
|
|
6186be4443 | ||
|
|
d07f01d7cb | ||
|
|
73291a30a0 | ||
|
|
a3b129845b | ||
|
|
0ff8f58be8 | ||
|
|
66292beec9 | ||
|
|
bf2af1051f | ||
|
|
b6e3020d4c | ||
|
|
8f516a1e28 | ||
|
|
5f2e287efd | ||
|
|
8c0d65cf9f | ||
|
|
fa609a5079 | ||
|
|
c708ff9708 | ||
|
|
2ea90334a3 | ||
|
|
eea8aa555f | ||
|
|
51a75e1872 | ||
|
|
af7ed4322e | ||
|
|
7cdd7cf6eb | ||
|
|
26aa622afc | ||
|
|
84ad161f1e | ||
|
|
6efb965dab | ||
|
|
8c90a12e0f | ||
|
|
2d54e88e74 | ||
|
|
16ea5323e0 | ||
|
|
7a23ce2367 | ||
|
|
e05bc7eb54 | ||
|
|
b3a6e25ce0 | ||
|
|
b63d41102e | ||
|
|
964295b59d | ||
|
|
d19db30f3d | ||
|
|
d12464fc0e | ||
|
|
a96971c8a7 | ||
|
|
f6f769503a | ||
|
|
82917ac6e3 | ||
|
|
a6ffafb1a2 | ||
|
|
fb8c529f2e | ||
|
|
1ee98e1e66 | ||
|
|
81f35f5dd1 | ||
|
|
1b402347cd | ||
|
|
7599656784 | ||
|
|
dccb60ba35 | ||
|
|
ae642ceca0 | ||
|
|
471b6f9966 | ||
|
|
5dd18bac2c | ||
|
|
018f4e0891 | ||
|
|
e85809a98a | ||
|
|
e6e9bd8147 | ||
|
|
221645d2ce | ||
|
|
2f4a6214a2 | ||
|
|
e00a461c26 | ||
|
|
c31314be38 | ||
|
|
ee142c4be0 | ||
|
|
aeacc0b31b | ||
|
|
7b4c3bdbcc | ||
|
|
910b9cf1fd | ||
|
|
b10aaceab0 | ||
|
|
169bd812c9 | ||
|
|
34767f1e13 | ||
|
|
4f642c0843 | ||
|
|
4e5889ed59 | ||
|
|
a1b848ad76 | ||
|
|
dbcc1fad3e | ||
|
|
db366558e7 | ||
|
|
a23c03fbd0 | ||
|
|
ff18b92eb0 | ||
|
|
7f148522ab | ||
|
|
159c612924 | ||
|
|
b95dfd4bdf | ||
|
|
e69954af2f | ||
|
|
a5ff26f602 | ||
|
|
a7536268e1 | ||
|
|
541469371a | ||
|
|
a13aeaf955 | ||
|
|
9cf674cdcb | ||
|
|
51c0cf97bc | ||
|
|
4cb1f616c5 | ||
|
|
645109048b | ||
|
|
f969fb69e1 | ||
|
|
bfb60fdb84 | ||
|
|
2f43cb843e | ||
|
|
874fd2aba7 | ||
|
|
33d1371186 | ||
|
|
d2dd241e6b | ||
|
|
4ecadfabf4 | ||
|
|
ffd79c6097 | ||
|
|
35a8d2a519 | ||
|
|
21eab7e9cc | ||
|
|
d9605c2856 | ||
|
|
70a467d469 | ||
|
|
6e8979336d | ||
|
|
ee01045db5 | ||
|
|
b7f8224588 | ||
|
|
ca4c1e4259 | ||
|
|
91712add3d | ||
|
|
7198dcb416 | ||
|
|
08e20e912d | ||
|
|
f45571033c | ||
|
|
2ac36a0572 | ||
|
|
3df1d54847 | ||
|
|
f3969b6066 | ||
|
|
6222f35bc8 | ||
|
|
2f178963c0 | ||
|
|
15760b0950 | ||
|
|
43a6a70e1e | ||
|
|
cd36f1ef5f | ||
|
|
cdd7083c86 | ||
|
|
8df7364319 | ||
|
|
63023722d1 | ||
|
|
79c12e5116 | ||
|
|
53e16944a1 | ||
|
|
7475362c85 | ||
|
|
9238b82cde | ||
|
|
7049f658ec | ||
|
|
701913fb19 | ||
|
|
831f41a62b | ||
|
|
0ea1da80e7 | ||
|
|
06eea74b98 | ||
|
|
c8c0e112bc | ||
|
|
7417e82c51 | ||
|
|
ecc4d80a5a | ||
|
|
3df24c52f4 | ||
|
|
8a70fb95b5 | ||
|
|
d8b45ecd61 | ||
|
|
61712bae9c | ||
|
|
4ff81a5a25 | ||
|
|
08f0e55d8f | ||
|
|
080b37cb31 | ||
|
|
bbdcd035ba | ||
|
|
f9233ef90b | ||
|
|
cd3573a4d2 | ||
|
|
738fe24e6d | ||
|
|
c2e55b5486 | ||
|
|
989f0726e3 | ||
|
|
bdefd3ba1e | ||
|
|
4efcff33bd | ||
|
|
8183cc5a8d | ||
|
|
f3bda1536d | ||
|
|
3b6371e03d | ||
|
|
b5d3c87253 | ||
|
|
f73b8c550a | ||
|
|
5437744126 | ||
|
|
5a5e70b001 | ||
|
|
348a5bc0a9 | ||
|
|
026c64fa01 | ||
|
|
e38663c457 | ||
|
|
117c741c29 | ||
|
|
9bc5bec9f1 | ||
|
|
a5f4e4d328 | ||
|
|
db0abfde72 | ||
|
|
edf263bcb5 | ||
|
|
60fba585e3 | ||
|
|
ebb6fe5be3 | ||
|
|
d91c95bf92 | ||
|
|
2007438424 | ||
|
|
81423635ad | ||
|
|
58d297364a | ||
|
|
db902c90c4 | ||
|
|
42ccd0f790 | ||
|
|
20ec6f574e | ||
|
|
b3db367ae7 | ||
|
|
8a62c742e6 | ||
|
|
b125cbeac9 | ||
|
|
3f7a2c2197 | ||
|
|
f6248369fe | ||
|
|
c83f3ec097 | ||
|
|
0cd00da354 | ||
|
|
4b7b285aa9 | ||
|
|
d63379e777 | ||
|
|
b219b146fa | ||
|
|
ff90b81ec3 | ||
|
|
9120eaef79 | ||
|
|
1ccd879916 | ||
|
|
f977ace7f8 | ||
|
|
c3f4dc0c15 | ||
|
|
78eed9b11c | ||
|
|
3a4d56afca | ||
|
|
63bb93fc07 | ||
|
|
5a39a04a79 | ||
|
|
2fde34b519 | ||
|
|
1ef5c038db | ||
|
|
e2459cfb47 | ||
|
|
cfffc0bcf1 | ||
|
|
7272f43191 | ||
|
|
2a7ea27bb7 | ||
|
|
32c5b816ae | ||
|
|
e54ea7a1d8 | ||
|
|
1077efd03a | ||
|
|
f9ab91511d | ||
|
|
2c3ca2984e | ||
|
|
94722e566c | ||
|
|
163f7ee85d | ||
|
|
52d3470cbe | ||
|
|
0bd6e85c61 | ||
|
|
e35c6b876f | ||
|
|
9a2897e741 | ||
|
|
70b2e8179d | ||
|
|
5317edc65d | ||
|
|
866d83579e | ||
|
|
a238391b36 | ||
|
|
5e152d30db | ||
|
|
57c954783d | ||
|
|
b5407ac708 | ||
|
|
472ec730b5 | ||
|
|
8c819b1f91 | ||
|
|
528a516390 | ||
|
|
6509e37c84 | ||
|
|
649173f661 | ||
|
|
1efb0adb35 | ||
|
|
88a8e2c1df | ||
|
|
bb4ff05d35 | ||
|
|
dd3b601c87 | ||
|
|
e22d101a62 | ||
|
|
4b3c813f5a | ||
|
|
67f375bea2 | ||
|
|
88ba99b87e | ||
|
|
53447e9d0b | ||
|
|
c4c86f8671 | ||
|
|
658941d26d | ||
|
|
e4bf27b01c | ||
|
|
7d48b75f81 | ||
|
|
5f56bf836c | ||
|
|
c0f5f97ddb | ||
|
|
15177ac2e9 | ||
|
|
8360bc93ac | ||
|
|
e0ea844d50 | ||
|
|
9675411f35 | ||
|
|
e97299fc65 | ||
|
|
26a113927e | ||
|
|
d0aa7ef590 | ||
|
|
5de889419f | ||
|
|
0fcbda2da7 | ||
|
|
14e33c295f | ||
|
|
644ac8caf8 | ||
|
|
77189b6e66 | ||
|
|
4f8f7f66ee | ||
|
|
961c6ea15a | ||
|
|
ad7bf80611 | ||
|
|
e78a3d1c19 | ||
|
|
c099ec05ee | ||
|
|
a20612478e | ||
|
|
f778e8bbd1 | ||
|
|
7203c046f9 | ||
|
|
754b61c593 | ||
|
|
927e9e4e4d | ||
|
|
699f9622d7 | ||
|
|
765eb84c33 | ||
|
|
12a1849090 |
@@ -1,4 +1,4 @@
|
||||
image: freebsd/12.x
|
||||
image: freebsd/14.x
|
||||
sources:
|
||||
- https://git.sr.ht/~bakpakin/janet
|
||||
packages:
|
||||
@@ -9,3 +9,4 @@ tasks:
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
sudo gmake uninstall
|
||||
|
||||
@@ -11,6 +11,7 @@ tasks:
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
doas gmake uninstall
|
||||
- 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
|
||||
@@ -29,4 +30,3 @@ tasks:
|
||||
ninja
|
||||
ninja test
|
||||
doas ninja install
|
||||
|
||||
|
||||
17
.github/workflows/test.yml
vendored
17
.github/workflows/test.yml
vendored
@@ -56,7 +56,7 @@ jobs:
|
||||
gcc
|
||||
- name: Build the project
|
||||
shell: cmd
|
||||
run: make -j CC=gcc
|
||||
run: make -j4 CC=gcc JANET_NO_AMALG=1
|
||||
|
||||
test-mingw-linux:
|
||||
name: Build and test with Mingw on Linux + Wine
|
||||
@@ -74,3 +74,18 @@ jobs:
|
||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||
- name: Test the project
|
||||
run: make test UNAME=MINGW RUN=wine
|
||||
|
||||
test-arm-linux:
|
||||
name: Build and test ARM32 cross compilation
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
- name: Setup qemu and cross compiler
|
||||
run: |
|
||||
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
|
||||
- name: Test the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
|
||||
|
||||
6
.gitignore
vendored
6
.gitignore
vendored
@@ -34,8 +34,11 @@ local
|
||||
|
||||
# Common test files I use.
|
||||
temp.janet
|
||||
temp*.janet
|
||||
temp.c
|
||||
temp*janet
|
||||
temp*.c
|
||||
scratch.janet
|
||||
scratch.c
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
@@ -57,6 +60,7 @@ xxd.exe
|
||||
# VSCode
|
||||
.vs
|
||||
.clangd
|
||||
.cache
|
||||
|
||||
# Swap files
|
||||
*.swp
|
||||
|
||||
88
CHANGELOG.md
88
CHANGELOG.md
@@ -1,7 +1,93 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## ??? - Unreleased
|
||||
## 1.34.0 - 2024-03-22
|
||||
- Add a new (split) PEG special by @ianthehenry
|
||||
- Add buffer/push-* sized int and float by @pnelson
|
||||
- Documentation improvements: @amano-kenji, @llmII, @MaxGyver83, @pepe, @sogaiu.
|
||||
- Expose _exit to skip certain cleanup with os/exit.
|
||||
- Swap set / body order for each by @sogaiu.
|
||||
- Abort on assert failure instead of exit.
|
||||
- Fix: os/proc-wait by @llmII.
|
||||
- Fix macex1 to keep syntax location for all tuples.
|
||||
- Restore if-let tail calls.
|
||||
- Don't try and resume fibers that can't be resumed.
|
||||
- Register stream on unmarshal.
|
||||
- Fix asm roundtrip issue.
|
||||
|
||||
## 1.33.0 - 2024-01-07
|
||||
- Add more + and * keywords to default-peg-grammar by @sogaiu.
|
||||
- Use libc strlen in janet_buffer_push_cstring by @williewillus.
|
||||
- Be a bit safer with reference counting.
|
||||
- Add support for atomic loads in Janet's atomic abstraction.
|
||||
- Fix poll event loop CPU usage issue.
|
||||
- Add ipv6, shared, and cryptorand options to meson.
|
||||
- Add more ipv6 feature detection.
|
||||
- Fix loop for forever loop.
|
||||
- Cleaned up unused NetStateConnect, fixed janet_async_end() ev refcount by @zevv.
|
||||
- Fix warnings w/ MSVC and format.
|
||||
- Fix marshal_one_env w/ JANET_MARSHAL_UNSAFE.
|
||||
- Fix `(default)`.
|
||||
- Fix cannot marshal fiber with c stackframe, in a dynamic way that is fairly conservative.
|
||||
- Fix typo for SIGALARM in os/proc-kill.
|
||||
- Prevent bytecode optimization from remove mk* instructions.
|
||||
- Fix arity typo in peg.c by @pepe.
|
||||
- Update Makefile for MinGW.
|
||||
- Fix canceling waiting fiber.
|
||||
- Add a new (sub) PEG special by @ianthehenry.
|
||||
- Fix if net/server's handler has incorrect arity.
|
||||
- Fix macex raising on ().
|
||||
|
||||
## 1.32.1 - 2023-10-15
|
||||
- Fix return value from C function `janet_dobytes` when called on Janet functions that yield to event loop.
|
||||
- Change C API for event loop interaction - get rid of JanetListener and instead use `janet_async_start` and `janet_async_end`.
|
||||
- Rework event loop to make fewer system calls on kqueue and epoll.
|
||||
- Expose atomic refcount abstraction in janet.h
|
||||
- Add `array/weak` for weak references in arrays
|
||||
- Add support for weak tables via `table/weak`, `table/weak-keys`, and `table/weak-values`.
|
||||
- Fix compiler bug with using the result of `(break x)` expression in some contexts.
|
||||
- Rework internal event loop code to be better behaved on Windows
|
||||
- Update meson build to work better on windows
|
||||
|
||||
## 1.31.0 - 2023-09-17
|
||||
- Report line and column when using `janet_dobytes`
|
||||
- Add `:unless` loop modifier
|
||||
- Allow calling `reverse` on generators.
|
||||
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
|
||||
- Add `lengthable?`
|
||||
- Add `os/sigaction`
|
||||
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
|
||||
- Fix bug with garbage collecting threaded abstract types.
|
||||
- Add `:signal` to the `sandbox` function to allow intercepting signals.
|
||||
|
||||
## 1.30.0 - 2023-08-05
|
||||
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
|
||||
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
|
||||
- Fix bug with marshalling channels
|
||||
- Add `div` for floored division
|
||||
- Make `div` and `mod` variadic
|
||||
- Support `bnot` for integer types.
|
||||
- Define `(mod x 0)` as `x`
|
||||
- Add `ffi/pointer-cfunction` to convert pointers to cfunctions
|
||||
|
||||
## 1.29.1 - 2023-06-19
|
||||
- Add support for passing booleans to PEGs for "always" and "never" matching.
|
||||
- Allow dictionary types for `take` and `drop`
|
||||
- Fix bug with closing channels while other fibers were waiting on them - `ev/take`, `ev/give`, and `ev/select` will now return the correct (documented) value when another fiber closes the channel.
|
||||
- Add `ffi/calling-conventions` to show all available calling conventions for FFI.
|
||||
- Add `net/setsockopt`
|
||||
- Add `signal` argument to `os/proc-kill` to send signals besides `SIGKILL` on Posix.
|
||||
- Add `source` argument to `os/clock` to get different time sources.
|
||||
- Various combinator functions now are variadic like `map`
|
||||
- Add `file/lines` to iterate over lines in a file lazily.
|
||||
- Reorganize test suite to be sorted by module rather than pseudo-randomly.
|
||||
- Add `*task-id*`
|
||||
- Add `env` argument to `fiber/new`.
|
||||
- Add `JANET_NO_AMALG` flag to Makefile to properly incremental builds
|
||||
- Optimize bytecode compiler to generate fewer instructions and improve loops.
|
||||
- Fix bug with `ev/gather` and hung fibers.
|
||||
- Add `os/isatty`
|
||||
- Add `has-key?` and `has-value?`
|
||||
- Make imperative arithmetic macros variadic
|
||||
- `ev/connect` now yields to the event loop instead of blocking while waiting for an ACK.
|
||||
|
||||
|
||||
58
Makefile
58
Makefile
@@ -33,27 +33,39 @@ CLIBS=-lm -lpthread
|
||||
JANET_TARGET=build/janet
|
||||
JANET_BOOT=build/janet_boot
|
||||
JANET_IMPORT_LIB=build/janet.lib
|
||||
JANET_LIBRARY_IMPORT_LIB=build/libjanet.lib
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
JANET_MANPATH?=$(PREFIX)/share/man/man1/
|
||||
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
JANET_DIST_DIR?=janet-dist
|
||||
JANET_BOOT_FLAGS:=. JANET_PATH '$(JANET_PATH)'
|
||||
JANET_TARGET_OBJECTS=build/janet.o build/shell.o
|
||||
JPM_TAG?=master
|
||||
HAS_SHARED?=1
|
||||
DEBUGGER=gdb
|
||||
SONAME_SETTER=-Wl,-soname,
|
||||
|
||||
# For cross compilation
|
||||
HOSTCC?=$(CC)
|
||||
HOSTAR?=$(AR)
|
||||
# Symbols are (optionally) removed later, keep -g as default!
|
||||
CFLAGS?=-O2 -g
|
||||
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)
|
||||
|
||||
# Disable amalgamated build
|
||||
ifeq ($(JANET_NO_AMALG), 1)
|
||||
JANET_TARGET_OBJECTS+=$(patsubst src/%.c,build/%.bin.o,$(JANET_CORE_SOURCES))
|
||||
JANET_BOOT_FLAGS+=image-only
|
||||
endif
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
|
||||
@@ -84,12 +96,17 @@ endif
|
||||
ifeq ($(findstring MINGW,$(UNAME)), MINGW)
|
||||
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
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
|
||||
$(shell mkdir -p build/core build/c build/boot build/mainclient)
|
||||
all: $(JANET_TARGET) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
ifeq ($(HAS_SHARED), 1)
|
||||
all: $(JANET_LIBRARY)
|
||||
endif
|
||||
|
||||
######################
|
||||
##### Name Files #####
|
||||
@@ -172,17 +189,24 @@ $(JANET_BOOT): $(JANET_BOOT_OBJECTS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/c/janet.c: $(JANET_BOOT) src/boot/boot.janet
|
||||
$(RUN) $(JANET_BOOT) . JANET_PATH '$(JANET_PATH)' > $@
|
||||
$(RUN) $(JANET_BOOT) $(JANET_BOOT_FLAGS) > $@
|
||||
cksum $@
|
||||
|
||||
##################
|
||||
##### Quicky #####
|
||||
##################
|
||||
|
||||
build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -o $@ -c $<
|
||||
|
||||
########################
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
ifeq ($(UNAME), Darwin)
|
||||
SONAME=libjanet.1.28.dylib
|
||||
SONAME=libjanet.1.34.dylib
|
||||
else
|
||||
SONAME=libjanet.so.1.28
|
||||
SONAME=libjanet.so.1.34
|
||||
endif
|
||||
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
@@ -200,13 +224,13 @@ build/janet.o: build/c/janet.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
build/shell.o: build/c/shell.c $(JANETCONF_HEADER) src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(JANET_TARGET): $(JANET_TARGET_OBJECTS)
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_LIBRARY): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
$(JANET_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||
$(HOSTCC) $(LIBJANET_LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_TARGET_OBJECTS)
|
||||
$(HOSTAR) rcs $@ $^
|
||||
|
||||
###################
|
||||
@@ -247,20 +271,25 @@ dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_STATIC_LIBRARY) \
|
||||
README.md build/c/janet.c build/c/shell.c
|
||||
mkdir -p build/$(JANET_DIST_DIR)/bin
|
||||
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
|
||||
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
|
||||
mkdir -p build/$(JANET_DIST_DIR)/include
|
||||
cp build/janet.h build/$(JANET_DIST_DIR)/include/
|
||||
mkdir -p build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_STATIC_LIBRARY) build/$(JANET_DIST_DIR)/lib/
|
||||
cp $(JANET_LIBRARY) build/$(JANET_DIST_DIR)/lib/ || true
|
||||
mkdir -p build/$(JANET_DIST_DIR)/man/man1/
|
||||
cp janet.1 build/$(JANET_DIST_DIR)/man/man1/janet.1
|
||||
mkdir -p build/$(JANET_DIST_DIR)/src/
|
||||
cp build/c/janet.c build/c/shell.c build/$(JANET_DIST_DIR)/src/
|
||||
cp CONTRIBUTING.md LICENSE README.md build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ ./$(JANET_DIST_DIR)
|
||||
ifeq ($(HAS_SHARED), 1)
|
||||
build/janet-%.tar.gz: $(JANET_LIBRARY)
|
||||
endif
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
@@ -293,7 +322,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc build/janet.h
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip '$(DESTDIR)$(BINDIR)/janet'
|
||||
strip -x -S '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
cp -r build/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
ln -sf ./janet/janet.h '$(DESTDIR)$(INCLUDEDIR)/janet.h'
|
||||
@@ -314,6 +343,7 @@ install: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.pc
|
||||
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
|
||||
cp '$(JANET_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
cp '$(JANET_LIBRARY_IMPORT_LIB)' '$(DESTDIR)$(LIBDIR)' || echo 'no import lib to install (mingw only)'
|
||||
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || echo "You can ignore this error for non-Linux systems or local installs"
|
||||
|
||||
install-jpm-git: $(JANET_TARGET)
|
||||
@@ -342,14 +372,14 @@ uninstall:
|
||||
#################
|
||||
|
||||
format:
|
||||
tools/format.sh
|
||||
sh tools/format.sh
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(RUN) $(JANET_TARGET) $< > $@
|
||||
|
||||
compile-commands:
|
||||
# Requires pip install copmiledb
|
||||
# Requires pip install compiledb
|
||||
compiledb make
|
||||
|
||||
clean:
|
||||
|
||||
155
README.md
155
README.md
@@ -6,10 +6,12 @@
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||
Lisp-like language, but lists are replaced
|
||||
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
|
||||
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
**Janet** is a programming language for system scripting, expressive automation, and
|
||||
extending programs written in C or C++ with user scripting capabilities.
|
||||
|
||||
Janet makes a good system scripting language, or a language to embed in other programs.
|
||||
It's like Lua and GNU Guile in that regard. It has more built-in functionality and a richer core language than
|
||||
Lua, but smaller than GNU Guile or Python. However, it is much easier to embed and port than Python or Guile.
|
||||
|
||||
There is a REPL for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
@@ -21,38 +23,109 @@ If you'd like to financially support the ongoing development of Janet, consider
|
||||
|
||||
<br>
|
||||
|
||||
## Use Cases
|
||||
## Examples
|
||||
|
||||
Janet makes a good system scripting language, or a language to embed in other programs.
|
||||
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
|
||||
Lua, but smaller than GNU Guile or Python.
|
||||
See the examples directory for all provided example programs.
|
||||
|
||||
## Features
|
||||
### Game of Life
|
||||
|
||||
* Configurable at build time - turn features on or off for a smaller or more featureful build
|
||||
* Minimal setup - one binary and you are good to go!
|
||||
```janet
|
||||
# John Conway's Game of Life
|
||||
|
||||
(def- window
|
||||
(seq [x :range [-1 2]
|
||||
y :range [-1 2]
|
||||
:when (not (and (zero? x) (zero? y)))]
|
||||
[x y]))
|
||||
|
||||
(defn- neighbors
|
||||
[[x y]]
|
||||
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
|
||||
|
||||
(defn tick
|
||||
"Get the next state in the Game Of Life."
|
||||
[state]
|
||||
(def cell-set (frequencies state))
|
||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||
(seq [coord :keys neighbor-set
|
||||
:let [count (get neighbor-set coord)]
|
||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||
coord))
|
||||
|
||||
(defn draw
|
||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
||||
[state x1 y1 x2 y2]
|
||||
(def cellset @{})
|
||||
(each cell state (put cellset cell true))
|
||||
(loop [x :range [x1 (+ 1 x2)]
|
||||
:after (print)
|
||||
y :range [y1 (+ 1 y2)]]
|
||||
(file/write stdout (if (get cellset [x y]) "X " ". ")))
|
||||
(print))
|
||||
|
||||
# Print the first 20 generations of a glider
|
||||
(var *state* '[(0 0) (-1 0) (1 0) (1 1) (0 2)])
|
||||
(for i 0 20
|
||||
(print "generation " i)
|
||||
(draw *state* -7 -7 7 7)
|
||||
(set *state* (tick *state*)))
|
||||
```
|
||||
|
||||
### TCP Echo Server
|
||||
|
||||
```janet
|
||||
# A simple TCP echo server using the built-in socket networking and event loop.
|
||||
|
||||
(defn handler
|
||||
"Simple handler for connections."
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
(def id (gensym))
|
||||
(def b @"")
|
||||
(print "Connection " id "!")
|
||||
(while (:read stream 1024 b)
|
||||
(printf " %v -> %v" id b)
|
||||
(:write stream b)
|
||||
(buffer/clear b))
|
||||
(printf "Done %v!" id)
|
||||
(ev/sleep 0.5)))
|
||||
|
||||
(net/server "127.0.0.1" "8000" handler)
|
||||
```
|
||||
|
||||
### Windows FFI Hello, World!
|
||||
|
||||
```janet
|
||||
# Use the FFI to popup a Windows message box - no C required
|
||||
|
||||
(ffi/context "user32.dll")
|
||||
|
||||
(ffi/defbind MessageBoxA :int
|
||||
[w :ptr text :string cap :string typ :int])
|
||||
|
||||
(MessageBoxA nil "Hello, World!" "Test" 0)
|
||||
```
|
||||
|
||||
## Language Features
|
||||
|
||||
* 600+ functions and macros in the core library
|
||||
* Built-in socket networking, threading, subprocesses, and file system functions.
|
||||
* Parsing Expression Grammars (PEG) engine as a more robust Regex alternative
|
||||
* Macros and compile-time computation
|
||||
* Per-thread event loop for efficient IO (epoll/IOCP/kqueue)
|
||||
* First-class green threads (continuations) as well as OS threads
|
||||
* Erlang-style supervision trees that integrate with the event loop
|
||||
* First-class closures
|
||||
* Garbage collection
|
||||
* First-class green threads (continuations)
|
||||
* Distributed as janet.c and janet.h for embedding into a larger program.
|
||||
* Python-style generators (implemented as a plain macro)
|
||||
* Mutable and immutable arrays (array/tuple)
|
||||
* Mutable and immutable hashtables (table/struct)
|
||||
* Mutable and immutable strings (buffer/string)
|
||||
* Macros
|
||||
* Multithreading
|
||||
* Per-thread event loop for efficient evented IO
|
||||
* Bytecode interpreter with an assembly interface, as well as bytecode verification
|
||||
* Tail-call optimization
|
||||
* Direct interop with C via abstract types and C functions
|
||||
* Dynamically load C libraries
|
||||
* Functional and imperative standard library
|
||||
* Lexical scoping
|
||||
* Imperative programming as well as functional
|
||||
* REPL
|
||||
* Parsing Expression Grammars built into the core library
|
||||
* 400+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
* Tail recursion
|
||||
* Interface with C functions and dynamically load plugins ("natives").
|
||||
* Built-in C FFI for when the native bindings are too much work
|
||||
* REPL development with debugger and inspectable runtime
|
||||
|
||||
## Documentation
|
||||
|
||||
@@ -240,10 +313,6 @@ there is no need for dynamic modules, add the define
|
||||
|
||||
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
|
||||
|
||||
## Examples
|
||||
|
||||
See the examples directory for some example Janet code.
|
||||
|
||||
## Discussion
|
||||
|
||||
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
|
||||
@@ -251,6 +320,20 @@ Gitter provides Matrix and IRC bridges as well.
|
||||
|
||||
## FAQ
|
||||
|
||||
### How fast is it?
|
||||
|
||||
It is about the same speed as most interpreted languages without a JIT compiler. Tight, critical
|
||||
loops should probably be written in C or C++ . Programs tend to be a bit faster than
|
||||
they would be in a language like Python due to the discouragement of slow Object-Oriented abstraction
|
||||
with lots of hash-table lookups, and making late-binding explicit. All values are boxed in an 8-byte
|
||||
representation by default and allocated on the heap, with the exception of numbers, nils and booleans. The
|
||||
PEG engine is a specialized interpreter that can efficiently process string and buffer data.
|
||||
|
||||
The GC is simple and stop-the-world, but GC knobs are exposed in the core library and separate threads
|
||||
have isolated heaps and garbage collectors. Data that is shared between threads is reference counted.
|
||||
|
||||
YMMV.
|
||||
|
||||
### Where is (favorite feature from other language)?
|
||||
|
||||
It may exist, it may not. If you want to propose a major language feature, go ahead and open an issue, but
|
||||
@@ -268,7 +351,7 @@ Nope. There are no cons cells here.
|
||||
### Is this a Clojure port?
|
||||
|
||||
No. It's similar to Clojure superficially because I like Lisps and I like the aesthetics.
|
||||
Internally, Janet is not at all like Clojure.
|
||||
Internally, Janet is not at all like Clojure, Scheme, or Common Lisp.
|
||||
|
||||
### Are the immutable data structures (tuples and structs) implemented as hash tries?
|
||||
|
||||
@@ -297,6 +380,14 @@ Usually, one of a few reasons:
|
||||
without feeling "bolted on", especially when compared to ALGOL-like languages. Adding features
|
||||
to the core also makes it a bit more difficult to keep Janet maximally portable.
|
||||
|
||||
### Can I bind to Rust/Zig/Go/Java/Nim/C++/D/Pascal/Fortran/Odin/Jai/(Some new "Systems" Programming Language)?
|
||||
|
||||
Probably, if that language has a good interface with C. But the programmer may need to do
|
||||
some extra work to map Janet's internal memory model to that of the bound language. Janet
|
||||
also uses `setjmp`/`longjmp` for non-local returns internally. This
|
||||
approach is out of favor with many programmers now and doesn't always play well with other languages
|
||||
that have exceptions or stack-unwinding.
|
||||
|
||||
### Why is my terminal spitting out junk when I run the REPL?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
|
||||
@@ -41,32 +41,32 @@ if not exist build\boot mkdir build\boot
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
for %%f in (src\boot\*.c) do (
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
build\janet_boot . > build\c\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build the resources
|
||||
rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\janet.obj build\shell.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
@rem Build static library (libjanet.lib)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\janet.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@if not errorlevel 0 goto :BUILDFAIL
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
@@ -91,14 +91,16 @@ exit /b 0
|
||||
:CLEAN
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
rd /s /q dist
|
||||
if exist dist (
|
||||
rd /s /q dist
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@rem Run tests
|
||||
:TEST
|
||||
for %%f in (test/suite*.janet) do (
|
||||
janet.exe test\%%f
|
||||
@if errorlevel 1 goto TESTFAIL
|
||||
@if not errorlevel 0 goto TESTFAIL
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@@ -117,6 +119,7 @@ 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
|
||||
|
||||
@@ -78,7 +78,6 @@ double double_lots(
|
||||
return i + j;
|
||||
}
|
||||
|
||||
|
||||
EXPORTER
|
||||
double double_lots_2(
|
||||
double a,
|
||||
@@ -204,5 +203,3 @@ EXPORTER
|
||||
int sixints_fn_3(SixInts s, int x) {
|
||||
return x + s.u + s.v + s.w + s.x + s.y + s.z;
|
||||
}
|
||||
|
||||
|
||||
|
||||
@@ -70,7 +70,7 @@ void num_array_put(void *p, Janet key, Janet value) {
|
||||
if (!janet_checktype(value, JANET_NUMBER))
|
||||
janet_panic("expected number value");
|
||||
|
||||
index = (size_t)janet_unwrap_integer(key);
|
||||
index = janet_unwrap_size(key);
|
||||
if (index < array->size) {
|
||||
array->data[index] = janet_unwrap_number(value);
|
||||
}
|
||||
@@ -96,7 +96,7 @@ int num_array_get(void *p, Janet key, Janet *out) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), methods, out);
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = (size_t)janet_unwrap_integer(key);
|
||||
index = janet_unwrap_size(key);
|
||||
if (index >= array->size) {
|
||||
return 0;
|
||||
} else {
|
||||
|
||||
5
examples/posix-exec.janet
Normal file
5
examples/posix-exec.janet
Normal file
@@ -0,0 +1,5 @@
|
||||
# Switch to python
|
||||
|
||||
(print "running in Janet")
|
||||
(os/posix-exec ["python"] :p)
|
||||
(print "will not print")
|
||||
41
examples/sigaction.janet
Normal file
41
examples/sigaction.janet
Normal file
@@ -0,0 +1,41 @@
|
||||
###
|
||||
### Usage: janet examples/sigaction.janet 1|2|3|4 &
|
||||
###
|
||||
### Then at shell: kill -s SIGTERM $!
|
||||
###
|
||||
|
||||
(defn action
|
||||
[]
|
||||
(print "Handled SIGTERM!")
|
||||
(flush)
|
||||
(os/exit 1))
|
||||
|
||||
(defn main1
|
||||
[]
|
||||
(os/sigaction :term action true)
|
||||
(forever))
|
||||
|
||||
(defn main2
|
||||
[]
|
||||
(os/sigaction :term action)
|
||||
(forever))
|
||||
|
||||
(defn main3
|
||||
[]
|
||||
(os/sigaction :term action true)
|
||||
(forever (ev/sleep math/inf)))
|
||||
|
||||
(defn main4
|
||||
[]
|
||||
(os/sigaction :term action)
|
||||
(forever (ev/sleep math/inf)))
|
||||
|
||||
(defn main
|
||||
[& args]
|
||||
(def which (scan-number (get args 1 "1")))
|
||||
(case which
|
||||
1 (main1) # should work
|
||||
2 (main2) # will not work
|
||||
3 (main3) # should work
|
||||
4 (main4) # should work
|
||||
(error "bad main")))
|
||||
20
examples/weak-tables.janet
Normal file
20
examples/weak-tables.janet
Normal file
@@ -0,0 +1,20 @@
|
||||
(def weak-k (table/weak-keys 10))
|
||||
(def weak-v (table/weak-values 10))
|
||||
(def weak-kv (table/weak 10))
|
||||
|
||||
(put weak-kv (gensym) 10)
|
||||
(put weak-kv :hello :world)
|
||||
(put weak-k :abc123zz77asda :stuff)
|
||||
(put weak-k true :abc123zz77asda)
|
||||
(put weak-k :zyzzyz false)
|
||||
(put weak-v (gensym) 10)
|
||||
(put weak-v 20 (gensym))
|
||||
(print "before gc")
|
||||
(tracev weak-k)
|
||||
(tracev weak-v)
|
||||
(tracev weak-kv)
|
||||
(gccollect)
|
||||
(print "after gc")
|
||||
(tracev weak-k)
|
||||
(tracev weak-v)
|
||||
(tracev weak-kv)
|
||||
115
meson.build
115
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.28.0')
|
||||
version : '1.34.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -61,6 +61,7 @@ conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_NET', not get_option('net'))
|
||||
conf.set('JANET_NO_IPV6', not get_option('ipv6'))
|
||||
conf.set('JANET_NO_EV', not get_option('ev') or get_option('single_threaded'))
|
||||
conf.set('JANET_REDUCED_OS', get_option('reduced_os'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
@@ -78,6 +79,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_CRYPTORAND', not get_option('cryptorand'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
@@ -169,7 +171,7 @@ janet_boot = executable('janet-boot', core_src, boot_src,
|
||||
|
||||
# Build janet.c
|
||||
janetc = custom_target('janetc',
|
||||
input : [janet_boot],
|
||||
input : [janet_boot, 'src/boot/boot.janet'],
|
||||
output : 'janet.c',
|
||||
capture : true,
|
||||
command : [
|
||||
@@ -182,25 +184,41 @@ if not get_option('single_threaded')
|
||||
janet_dependencies += thread_dep
|
||||
endif
|
||||
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
install : true)
|
||||
|
||||
# Allow building with no shared library
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
lib_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
lib_cflags = []
|
||||
endif
|
||||
if get_option('shared')
|
||||
libjanet = library('janet', janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
version: meson.project_version(),
|
||||
soversion: version_parts[0] + '.' + version_parts[1],
|
||||
c_args : lib_cflags,
|
||||
install : true)
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden']
|
||||
if cc.has_argument('-fvisibility=hidden')
|
||||
extra_cflags = ['-fvisibility=hidden', '-DJANET_DLL_IMPORT']
|
||||
else
|
||||
extra_cflags = ['-DJANET_DLL_IMPORT']
|
||||
endif
|
||||
janet_mainclient = executable('janet', mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
link_with: [libjanet],
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
else
|
||||
extra_cflags = []
|
||||
# No shared library
|
||||
janet_mainclient = executable('janet', mainclient_src, janetc,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : lib_cflags,
|
||||
install : true)
|
||||
endif
|
||||
janet_mainclient = executable('janet', janetc, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : janet_dependencies,
|
||||
c_args : extra_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
@@ -227,21 +245,34 @@ docs = custom_target('docs',
|
||||
|
||||
# Tests
|
||||
test_files = [
|
||||
'test/suite0000.janet',
|
||||
'test/suite0001.janet',
|
||||
'test/suite0002.janet',
|
||||
'test/suite0003.janet',
|
||||
'test/suite0004.janet',
|
||||
'test/suite0005.janet',
|
||||
'test/suite0006.janet',
|
||||
'test/suite0007.janet',
|
||||
'test/suite0008.janet',
|
||||
'test/suite0009.janet',
|
||||
'test/suite0010.janet',
|
||||
'test/suite0011.janet',
|
||||
'test/suite0012.janet',
|
||||
'test/suite0013.janet',
|
||||
'test/suite0014.janet'
|
||||
'test/suite-array.janet',
|
||||
'test/suite-asm.janet',
|
||||
'test/suite-boot.janet',
|
||||
'test/suite-buffer.janet',
|
||||
'test/suite-capi.janet',
|
||||
'test/suite-cfuns.janet',
|
||||
'test/suite-compile.janet',
|
||||
'test/suite-corelib.janet',
|
||||
'test/suite-debug.janet',
|
||||
'test/suite-ev.janet',
|
||||
'test/suite-ffi.janet',
|
||||
'test/suite-inttypes.janet',
|
||||
'test/suite-io.janet',
|
||||
'test/suite-marsh.janet',
|
||||
'test/suite-math.janet',
|
||||
'test/suite-os.janet',
|
||||
'test/suite-parse.janet',
|
||||
'test/suite-peg.janet',
|
||||
'test/suite-pp.janet',
|
||||
'test/suite-specials.janet',
|
||||
'test/suite-string.janet',
|
||||
'test/suite-strtod.janet',
|
||||
'test/suite-struct.janet',
|
||||
'test/suite-symcache.janet',
|
||||
'test/suite-table.janet',
|
||||
'test/suite-unknown.janet',
|
||||
'test/suite-value.janet',
|
||||
'test/suite-vm.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -251,14 +282,15 @@ endforeach
|
||||
run_target('repl', command : [janet_nativeclient])
|
||||
|
||||
# For use as meson subproject (wrap)
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
|
||||
if get_option('shared')
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
# pkgconfig
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
pkg = import('pkgconfig')
|
||||
pkg.generate(libjanet,
|
||||
subdirs: 'janet',
|
||||
description: 'Library for the Janet programming language.')
|
||||
endif
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
@@ -268,11 +300,12 @@ patched_janet = custom_target('patched-janeth',
|
||||
install : true,
|
||||
install_dir : join_paths(get_option('includedir'), 'janet'),
|
||||
build_by_default : true,
|
||||
output : ['janet.h'],
|
||||
output : ['janet_' + meson.project_version() + '.h'],
|
||||
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@'])
|
||||
|
||||
# Create a version of the janet.h header that matches what jpm often expects
|
||||
if meson.version().version_compare('>=0.61')
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet.h', install_dir: get_option('includedir'))
|
||||
install_symlink('janet.h', pointing_to: 'janet/janet_' + meson.project_version() + '.h', install_dir: get_option('includedir'))
|
||||
install_symlink('janet.h', pointing_to: 'janet_' + meson.project_version() + '.h', install_dir: join_paths(get_option('includedir'), 'janet'))
|
||||
endif
|
||||
|
||||
|
||||
@@ -11,14 +11,15 @@ option('peg', type : 'boolean', value : true)
|
||||
option('int_types', type : 'boolean', value : true)
|
||||
option('prf', type : 'boolean', value : false)
|
||||
option('net', type : 'boolean', value : true)
|
||||
option('ipv6', type : 'boolean', value : true)
|
||||
option('ev', type : 'boolean', value : true)
|
||||
option('processes', type : 'boolean', value : true)
|
||||
option('umask', type : 'boolean', value : true)
|
||||
option('realpath', type : 'boolean', value : true)
|
||||
option('simple_getline', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : false)
|
||||
option('kqueue', type : 'boolean', value : false)
|
||||
option('interpreter_interrupt', type : 'boolean', value : false)
|
||||
option('epoll', type : 'boolean', value : true)
|
||||
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)
|
||||
|
||||
@@ -29,3 +30,5 @@ option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7f
|
||||
|
||||
option('arch_name', type : 'string', value: '')
|
||||
option('os_name', type : 'string', value: '')
|
||||
option('shared', type : 'boolean', value: true)
|
||||
option('cryptorand', type : 'boolean', value: true)
|
||||
|
||||
@@ -26,8 +26,6 @@
|
||||
#include "tests.h"
|
||||
|
||||
int array_test() {
|
||||
|
||||
int i;
|
||||
JanetArray *array1, *array2;
|
||||
|
||||
array1 = janet_array(10);
|
||||
@@ -53,7 +51,7 @@ int array_test() {
|
||||
janet_array_push(array2, janet_cstringv("six"));
|
||||
janet_array_push(array2, janet_cstringv("seven"));
|
||||
|
||||
for (i = 0; i < array2->count; i++) {
|
||||
for (size_t i = 0; i < array2->count; i++) {
|
||||
assert(janet_equals(array1->data[i], array2->data[i]));
|
||||
}
|
||||
|
||||
|
||||
@@ -104,7 +104,7 @@ int main(int argc, const char **argv) {
|
||||
}
|
||||
fclose(boot_file);
|
||||
|
||||
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
|
||||
status = janet_dobytes(env, boot_buffer, boot_size, boot_filename, NULL);
|
||||
janet_free(boot_buffer);
|
||||
|
||||
/* Deinitialize vm */
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -26,8 +26,6 @@
|
||||
#include "tests.h"
|
||||
|
||||
int buffer_test() {
|
||||
|
||||
int i;
|
||||
JanetBuffer *buffer1, *buffer2;
|
||||
|
||||
buffer1 = janet_buffer(100);
|
||||
@@ -54,7 +52,7 @@ int buffer_test() {
|
||||
assert(buffer1->capacity >= buffer1->count);
|
||||
assert(buffer2->capacity >= buffer2->count);
|
||||
|
||||
for (i = 0; i < buffer1->count; i++) {
|
||||
for (size_t i = 0; i < buffer1->count; i++) {
|
||||
assert(buffer1->data[i] == buffer2->data[i]);
|
||||
}
|
||||
|
||||
|
||||
@@ -38,7 +38,7 @@ static void test_valid_str(const char *str) {
|
||||
double cnum, jnum;
|
||||
jnum = 0.0;
|
||||
cnum = atof(str);
|
||||
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
|
||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
||||
assert(!err);
|
||||
assert(cnum == jnum);
|
||||
}
|
||||
|
||||
@@ -70,6 +70,5 @@ int system_test() {
|
||||
|
||||
assert(janet_equals(tuple1, tuple2));
|
||||
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 28
|
||||
#define JANET_VERSION_MINOR 34
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.28.0-dev"
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.34.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -52,6 +52,9 @@
|
||||
/* #define JANET_EV_NO_EPOLL */
|
||||
/* #define JANET_EV_NO_KQUEUE */
|
||||
/* #define JANET_NO_INTERPRETER_INTERRUPT */
|
||||
/* #define JANET_NO_IPV6 */
|
||||
/* #define JANET_NO_CRYPTORAND */
|
||||
/* #define JANET_USE_STDATOMIC */
|
||||
|
||||
/* Custom vm allocator support */
|
||||
/* #include <mimalloc.h> */
|
||||
|
||||
@@ -31,8 +31,6 @@
|
||||
#ifdef JANET_EV
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#else
|
||||
#include <stdatomic.h>
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -97,14 +95,6 @@ size_t janet_os_rwlock_size(void) {
|
||||
return sizeof(void *);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return InterlockedIncrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return InterlockedDecrement((LONG volatile *) &ab->gc.data.refcount);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
InitializeCriticalSection((CRITICAL_SECTION *) mutex);
|
||||
}
|
||||
@@ -157,14 +147,6 @@ size_t janet_os_rwlock_size(void) {
|
||||
return sizeof(pthread_rwlock_t);
|
||||
}
|
||||
|
||||
static int32_t janet_incref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, 1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
static int32_t janet_decref(JanetAbstractHead *ab) {
|
||||
return __atomic_add_fetch(&ab->gc.data.refcount, -1, __ATOMIC_RELAXED);
|
||||
}
|
||||
|
||||
void janet_os_mutex_init(JanetOSMutex *mutex) {
|
||||
pthread_mutexattr_t attr;
|
||||
pthread_mutexattr_init(&attr);
|
||||
@@ -212,11 +194,11 @@ void janet_os_rwlock_wunlock(JanetOSRWLock *rwlock) {
|
||||
#endif
|
||||
|
||||
int32_t janet_abstract_incref(void *abst) {
|
||||
return janet_incref(janet_abstract_head(abst));
|
||||
return janet_atomic_inc(&janet_abstract_head(abst)->gc.data.refcount);
|
||||
}
|
||||
|
||||
int32_t janet_abstract_decref(void *abst) {
|
||||
return janet_decref(janet_abstract_head(abst));
|
||||
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
104
src/core/array.c
104
src/core/array.c
@@ -30,13 +30,11 @@
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
static void janet_array_impl(JanetArray *array, size_t capacity) {
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm.next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) janet_malloc(sizeof(Janet) * (size_t) capacity);
|
||||
data = (Janet *) janet_malloc(sizeof(Janet) * capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -44,15 +42,28 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
array->count = 0;
|
||||
array->capacity = capacity;
|
||||
array->data = data;
|
||||
}
|
||||
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(size_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
janet_array_impl(array, capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
/* Creates a new array with weak references */
|
||||
JanetArray *janet_array_weak(size_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY_WEAK, sizeof(JanetArray));
|
||||
janet_array_impl(array, capacity);
|
||||
return array;
|
||||
}
|
||||
|
||||
/* Creates a new array from n elements. */
|
||||
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
JanetArray *janet_array_n(const Janet *elements, size_t n) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
array->capacity = n;
|
||||
array->count = n;
|
||||
array->data = janet_malloc(sizeof(Janet) * (size_t) n);
|
||||
array->data = janet_malloc(sizeof(Janet) * n);
|
||||
if (!array->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -61,13 +72,13 @@ JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
}
|
||||
|
||||
/* Ensure the array has enough capacity for elements */
|
||||
void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
void janet_array_ensure(JanetArray *array, size_t capacity, size_t growth) {
|
||||
Janet *newData;
|
||||
Janet *old = array->data;
|
||||
if (capacity <= array->capacity) return;
|
||||
int64_t new_capacity = ((int64_t) capacity) * growth;
|
||||
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
|
||||
capacity = (int32_t) new_capacity;
|
||||
size_t new_capacity = (capacity) * growth;
|
||||
if (new_capacity > JANET_INTMAX_SIZE) new_capacity = JANET_INTMAX_SIZE;
|
||||
capacity = new_capacity;
|
||||
newData = janet_realloc(old, capacity * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -78,11 +89,9 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
}
|
||||
|
||||
/* Set the count of an array. Extend with nil if needed. */
|
||||
void janet_array_setcount(JanetArray *array, int32_t count) {
|
||||
if (count < 0)
|
||||
return;
|
||||
void janet_array_setcount(JanetArray *array, size_t count) {
|
||||
if (count > array->count) {
|
||||
int32_t i;
|
||||
size_t i;
|
||||
janet_array_ensure(array, count, 1);
|
||||
for (i = array->count; i < count; i++) {
|
||||
array->data[i] = janet_wrap_nil();
|
||||
@@ -93,10 +102,10 @@ void janet_array_setcount(JanetArray *array, int32_t count) {
|
||||
|
||||
/* Push a value to the top of the array */
|
||||
void janet_array_push(JanetArray *array, Janet x) {
|
||||
if (array->count == INT32_MAX) {
|
||||
if (array->count == JANET_INTMAX_SIZE) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
int32_t newcount = array->count + 1;
|
||||
size_t newcount = array->count + 1;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
array->data[array->count] = x;
|
||||
array->count = newcount;
|
||||
@@ -127,19 +136,28 @@ JANET_CORE_FN(cfun_array_new,
|
||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||
"`(array)` but can be more efficient if the maximum size of an array is known.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
JanetArray *array = janet_array(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_weak,
|
||||
"(array/weak capacity)",
|
||||
"Creates a new empty array with a pre-allocated capacity and support for weak references. Similar to `array/new`.") {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
JanetArray *array = janet_array_weak(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_new_filled,
|
||||
"(array/new-filled count &opt value)",
|
||||
"Creates a new array of `count` elements, all set to `value`, which defaults to nil. Returns the new array.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getnat(argv, 0);
|
||||
size_t count = janet_getsize(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
JanetArray *array = janet_array(count);
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
array->count = count;
|
||||
@@ -153,7 +171,7 @@ JANET_CORE_FN(cfun_array_fill,
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
|
||||
for (int32_t i = 0; i < array->count; i++) {
|
||||
for (size_t i = 0; i < array->count; i++) {
|
||||
array->data[i] = x;
|
||||
}
|
||||
return argv[0];
|
||||
@@ -177,14 +195,14 @@ JANET_CORE_FN(cfun_array_peek,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_array_push,
|
||||
"(array/push arr x)",
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.") {
|
||||
"(array/push arr & xs)",
|
||||
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
if (INT32_MAX - argc + 1 <= array->count) {
|
||||
if ((size_t) JANET_INTMAX_SIZE - argc + 1 <= array->count) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
int32_t newcount = array->count - 1 + argc;
|
||||
size_t newcount = array->count - 1 + argc;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
if (argc > 1) memcpy(array->data + array->count, argv + 1, (size_t)(argc - 1) * sizeof(Janet));
|
||||
array->count = newcount;
|
||||
@@ -199,8 +217,8 @@ JANET_CORE_FN(cfun_array_ensure,
|
||||
"Otherwise, the backing memory will be reallocated so that there is enough space.") {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = janet_getinteger(argv, 1);
|
||||
int32_t growth = janet_getinteger(argv, 2);
|
||||
size_t newcount = janet_getsize(argv, 1);
|
||||
size_t growth = janet_getsize(argv, 2);
|
||||
if (newcount < 1) janet_panic("expected positive integer");
|
||||
janet_array_ensure(array, newcount, growth);
|
||||
return argv[0];
|
||||
@@ -211,7 +229,7 @@ JANET_CORE_FN(cfun_array_slice,
|
||||
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the "
|
||||
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
|
||||
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
|
||||
"Note that if the range is negative, it is taken as (start, end] to allow a full "
|
||||
"negative slice range. Returns a new array.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
@@ -228,21 +246,20 @@ JANET_CORE_FN(cfun_array_concat,
|
||||
"which must be an array. If any of the parts are arrays or tuples, their elements will "
|
||||
"be inserted into the array. Otherwise, each part in `parts` will be appended to `arr` in order. "
|
||||
"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++) {
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
switch (janet_type(argv[i])) {
|
||||
default:
|
||||
janet_array_push(array, argv[i]);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t j, len = 0;
|
||||
size_t j, len = 0;
|
||||
const Janet *vals = NULL;
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
if (array->data == vals) {
|
||||
int32_t newcount = array->count + len;
|
||||
size_t newcount = array->count + len;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
}
|
||||
@@ -259,20 +276,20 @@ 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 "
|
||||
"0 and the length of the array. A negative value for `at` will index backwards from "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.") {
|
||||
"the end of the array, inserting after the index such that inserting at -1 appends to "
|
||||
"the array. Returns the array.") {
|
||||
size_t chunksize, restsize;
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
ssize_t at = janet_getssize(argv, 1);
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||
if (at < 0 || (size_t) at > array->count)
|
||||
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||
chunksize = (argc - 2) * sizeof(Janet);
|
||||
restsize = (array->count - at) * sizeof(Janet);
|
||||
if (INT32_MAX - (argc - 2) < array->count) {
|
||||
if ((size_t) JANET_INTMAX_SIZE - (argc - 2) < array->count) {
|
||||
janet_panic("array overflow");
|
||||
}
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
@@ -294,17 +311,15 @@ JANET_CORE_FN(cfun_array_remove,
|
||||
"Returns the array.") {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
int32_t n = 1;
|
||||
ssize_t at = janet_getssize(argv, 1);
|
||||
size_t n = 1;
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
at = array->count + at;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
if (at < 0 || (size_t) at > array->count)
|
||||
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||
if (argc == 3) {
|
||||
n = janet_getinteger(argv, 2);
|
||||
if (n < 0)
|
||||
janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
|
||||
n = janet_getsize(argv, 2);
|
||||
}
|
||||
if (at + n > array->count) {
|
||||
n = array->count - at;
|
||||
@@ -352,6 +367,7 @@ JANET_CORE_FN(cfun_array_clear,
|
||||
void janet_lib_array(JanetTable *env) {
|
||||
JanetRegExt array_cfuns[] = {
|
||||
JANET_CORE_REG("array/new", cfun_array_new),
|
||||
JANET_CORE_REG("array/weak", cfun_array_weak),
|
||||
JANET_CORE_REG("array/new-filled", cfun_array_new_filled),
|
||||
JANET_CORE_REG("array/fill", cfun_array_fill),
|
||||
JANET_CORE_REG("array/pop", cfun_array_pop),
|
||||
|
||||
@@ -75,6 +75,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"cncl", JOP_CANCEL},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divf", JOP_DIVIDE_FLOOR},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"eq", JOP_EQUALS},
|
||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||
@@ -137,6 +138,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"sru", JOP_SHIFT_RIGHT_UNSIGNED},
|
||||
{"sruim", JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE},
|
||||
{"sub", JOP_SUBTRACT},
|
||||
{"subim", JOP_SUBTRACT_IMMEDIATE},
|
||||
{"tcall", JOP_TAILCALL},
|
||||
{"tchck", JOP_TYPECHECK}
|
||||
};
|
||||
@@ -280,7 +282,7 @@ static int32_t doarg_1(
|
||||
case JANET_TUPLE: {
|
||||
const Janet *t = janet_unwrap_tuple(x);
|
||||
if (argtype == JANET_OAT_TYPE) {
|
||||
int32_t i = 0;
|
||||
size_t i = 0;
|
||||
ret = 0;
|
||||
for (i = 0; i < janet_tuple_length(t); i++) {
|
||||
ret |= doarg_1(a, JANET_OAT_SIMPLETYPE, t[i]);
|
||||
@@ -490,7 +492,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
JanetAssembler a;
|
||||
Janet s = source;
|
||||
JanetFuncDef *def;
|
||||
int32_t count, i;
|
||||
size_t count, i;
|
||||
const Janet *arr;
|
||||
Janet x;
|
||||
(void) flags;
|
||||
@@ -558,6 +560,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Initialize slotcount */
|
||||
def->slotcount = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG) + def->arity;
|
||||
|
||||
/* Check structarg */
|
||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
@@ -573,8 +578,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
Janet v = arr[i];
|
||||
if (janet_checktype(v, JANET_TUPLE)) {
|
||||
const Janet *t = janet_unwrap_tuple(v);
|
||||
int32_t j;
|
||||
for (j = 0; j < janet_tuple_length(t); j++) {
|
||||
for (size_t j = 0; j < janet_tuple_length(t); j++) {
|
||||
if (!janet_checktype(t[j], JANET_SYMBOL))
|
||||
janet_asm_error(&a, "slot names must be symbols");
|
||||
janet_table_put(&a.slots, t[j], janet_wrap_integer(i));
|
||||
@@ -591,7 +595,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = janet_malloc(sizeof(Janet) * (size_t) count);
|
||||
def->constants = janet_malloc(sizeof(Janet) * count);
|
||||
if (NULL == def->constants) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -610,8 +614,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("defs"));
|
||||
}
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
JanetAssembleResult subres;
|
||||
Janet subname;
|
||||
int32_t newlen;
|
||||
@@ -696,7 +699,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Check for source mapping */
|
||||
x = janet_get1(s, janet_ckeywordv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
janet_asm_assert(&a, count == (size_t) def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = janet_malloc(sizeof(JanetSourceMapping) * (size_t) count);
|
||||
if (NULL == def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -770,7 +773,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (def->environments_length) {
|
||||
def->environments = janet_realloc(def->environments, def->environments_length * sizeof(int32_t));
|
||||
}
|
||||
for (int32_t i = 0; i < count; i++) {
|
||||
for (size_t i = 0; i < count; i++) {
|
||||
if (!janet_checkint(arr[i])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
@@ -782,8 +785,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Verify the func def */
|
||||
if (janet_verify(def)) {
|
||||
janet_asm_error(&a, "invalid assembly");
|
||||
int verify_status = janet_verify(def);
|
||||
if (verify_status) {
|
||||
janet_asm_errorv(&a, janet_formatc("invalid assembly (%d)", verify_status));
|
||||
}
|
||||
|
||||
/* Add final flags */
|
||||
@@ -949,7 +953,6 @@ static Janet janet_disasm_symbolslots(JanetFuncDef *def) {
|
||||
return janet_wrap_array(symbolslots);
|
||||
}
|
||||
|
||||
|
||||
static Janet janet_disasm_bytecode(JanetFuncDef *def) {
|
||||
JanetArray *bcode = janet_array(def->bytecode_length);
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
|
||||
@@ -36,11 +36,13 @@ static void janet_buffer_can_realloc(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity) {
|
||||
static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, size_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity < 4) capacity = 4;
|
||||
if (capacity > JANET_INTMAX_SIZE)
|
||||
capacity = JANET_INTMAX_SIZE;
|
||||
janet_gcpressure(capacity);
|
||||
data = janet_malloc(sizeof(uint8_t) * (size_t) capacity);
|
||||
data = janet_malloc(sizeof(uint8_t) * capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -51,7 +53,7 @@ static JanetBuffer *janet_buffer_init_impl(JanetBuffer *buffer, int32_t capacity
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, size_t capacity) {
|
||||
janet_buffer_init_impl(buffer, capacity);
|
||||
buffer->gc.data.next = NULL;
|
||||
buffer->gc.flags = JANET_MEM_DISABLED;
|
||||
@@ -59,8 +61,7 @@ JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
}
|
||||
|
||||
/* Initialize an unmanaged buffer */
|
||||
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count) {
|
||||
if (count < 0) janet_panic("count < 0");
|
||||
JanetBuffer *janet_pointer_buffer_unsafe(void *memory, size_t capacity, size_t count) {
|
||||
if (capacity < count) janet_panic("capacity < count");
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
buffer->gc.flags |= JANET_BUFFER_FLAG_NO_REALLOC;
|
||||
@@ -78,21 +79,21 @@ void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer(int32_t capacity) {
|
||||
JanetBuffer *janet_buffer(size_t capacity) {
|
||||
JanetBuffer *buffer = janet_gcalloc(JANET_MEMORY_BUFFER, sizeof(JanetBuffer));
|
||||
return janet_buffer_init_impl(buffer, capacity);
|
||||
}
|
||||
|
||||
/* Ensure that the buffer has enough internal capacity */
|
||||
void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth) {
|
||||
void janet_buffer_ensure(JanetBuffer *buffer, size_t capacity, size_t growth) {
|
||||
uint8_t *new_data;
|
||||
uint8_t *old = buffer->data;
|
||||
if (capacity <= buffer->capacity) return;
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
uint64_t big_capacity = (uint64_t) capacity*growth;
|
||||
capacity = big_capacity > JANET_INTMAX_SIZE ? JANET_INTMAX_SIZE : (size_t) big_capacity;
|
||||
janet_gcpressure(capacity - buffer->capacity);
|
||||
new_data = janet_realloc(old, (size_t) capacity * sizeof(uint8_t));
|
||||
new_data = janet_realloc(old, capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -101,11 +102,9 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
}
|
||||
|
||||
/* Ensure that the buffer has enough internal capacity */
|
||||
void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
|
||||
if (count < 0)
|
||||
return;
|
||||
void janet_buffer_setcount(JanetBuffer *buffer, size_t count) {
|
||||
if (count > buffer->count) {
|
||||
int32_t oldcount = buffer->count;
|
||||
size_t oldcount = buffer->count;
|
||||
janet_buffer_ensure(buffer, count, 1);
|
||||
memset(buffer->data + oldcount, 0, count - oldcount);
|
||||
}
|
||||
@@ -114,15 +113,15 @@ void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
|
||||
|
||||
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
|
||||
* next n bytes pushed to the buffer will not cause a reallocation */
|
||||
void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
void janet_buffer_extra(JanetBuffer *buffer, size_t n) {
|
||||
/* Check for buffer overflow */
|
||||
if ((int64_t)n + buffer->count > INT32_MAX) {
|
||||
if ((int64_t)n + buffer->count > JANET_INTMAX_SIZE) {
|
||||
janet_panic("buffer overflow");
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
size_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
janet_buffer_can_realloc(buffer);
|
||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||
size_t new_capacity = (new_size > (JANET_INTMAX_SIZE / 2)) ? JANET_INTMAX_SIZE : (new_size * 2);
|
||||
uint8_t *new_data = janet_realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
@@ -135,13 +134,12 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
|
||||
/* Push a cstring to buffer */
|
||||
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
int32_t len = 0;
|
||||
while (cstring[len]) ++len;
|
||||
size_t len = strlen(cstring);
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
}
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, size_t length) {
|
||||
if (0 == length) return;
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
@@ -198,7 +196,7 @@ JANET_CORE_FN(cfun_buffer_new,
|
||||
"Creates a new, empty buffer with enough backing memory for `capacity` bytes. "
|
||||
"Returns a new buffer of length 0.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(cap);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
@@ -208,8 +206,7 @@ JANET_CORE_FN(cfun_buffer_new_filled,
|
||||
"Creates a new buffer of length `count` filled with `byte`. By default, `byte` is 0. "
|
||||
"Returns the new buffer.") {
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t count = janet_getinteger(argv, 0);
|
||||
if (count < 0) count = 0;
|
||||
size_t count = janet_getsize(argv, 0);
|
||||
int32_t byte = 0;
|
||||
if (argc == 2) {
|
||||
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||
@@ -221,6 +218,19 @@ JANET_CORE_FN(cfun_buffer_new_filled,
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_frombytes,
|
||||
"(buffer/from-bytes & byte-vals)",
|
||||
"Creates a buffer from integer parameters with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.") {
|
||||
JanetBuffer *buffer = janet_buffer(argc);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
size_t c = janet_getsize(argv, i);
|
||||
buffer->data[i] = c & 0xFF;
|
||||
}
|
||||
buffer->count = argc;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_fill,
|
||||
"(buffer/fill buffer &opt byte)",
|
||||
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
|
||||
@@ -245,7 +255,7 @@ JANET_CORE_FN(cfun_buffer_trim,
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
janet_buffer_can_realloc(buffer);
|
||||
if (buffer->count < buffer->capacity) {
|
||||
int32_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
size_t newcap = buffer->count > 4 ? buffer->count : 4;
|
||||
uint8_t *newData = janet_realloc(buffer->data, newcap);
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -260,10 +270,9 @@ JANET_CORE_FN(cfun_buffer_u8,
|
||||
"(buffer/push-byte buffer & xs)",
|
||||
"Append bytes to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||
}
|
||||
return argv[0];
|
||||
@@ -274,10 +283,9 @@ JANET_CORE_FN(cfun_buffer_word,
|
||||
"Append machine words to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
double number = janet_getnumber(argv, i);
|
||||
uint32_t word = (uint32_t) number;
|
||||
if (word != number)
|
||||
@@ -293,10 +301,9 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||
"Will accept any of strings, keywords, symbols, and buffers. "
|
||||
"Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.") {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.bytes == buffer->data) {
|
||||
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||
@@ -307,6 +314,143 @@ JANET_CORE_FN(cfun_buffer_chars,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int should_reverse_bytes(const Janet *argv, int32_t argc) {
|
||||
JanetKeyword order_kw = janet_getkeyword(argv, argc);
|
||||
if (!janet_cstrcmp(order_kw, "le")) {
|
||||
#if JANET_BIG_ENDIAN
|
||||
return 1;
|
||||
#endif
|
||||
} else if (!janet_cstrcmp(order_kw, "be")) {
|
||||
#if JANET_LITTLE_ENDIAN
|
||||
return 1;
|
||||
#endif
|
||||
} else if (!janet_cstrcmp(order_kw, "native")) {
|
||||
return 0;
|
||||
} else {
|
||||
janet_panicf("expected endianness :le, :be or :native, got %v", argv[1]);
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void reverse_u32(uint8_t bytes[4]) {
|
||||
uint8_t temp;
|
||||
temp = bytes[3];
|
||||
bytes[3] = bytes[0];
|
||||
bytes[0] = temp;
|
||||
temp = bytes[2];
|
||||
bytes[2] = bytes[1];
|
||||
bytes[1] = temp;
|
||||
}
|
||||
|
||||
static void reverse_u64(uint8_t bytes[8]) {
|
||||
uint8_t temp;
|
||||
temp = bytes[7];
|
||||
bytes[7] = bytes[0];
|
||||
bytes[0] = temp;
|
||||
temp = bytes[6];
|
||||
bytes[6] = bytes[1];
|
||||
bytes[1] = temp;
|
||||
temp = bytes[5];
|
||||
bytes[5] = bytes[2];
|
||||
bytes[2] = temp;
|
||||
temp = bytes[4];
|
||||
bytes[4] = bytes[3];
|
||||
bytes[3] = temp;
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint16,
|
||||
"(buffer/push-uint16 buffer order data)",
|
||||
"Push a 16 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
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);
|
||||
if (reverse) {
|
||||
uint8_t temp = u.bytes[1];
|
||||
u.bytes[1] = u.bytes[0];
|
||||
u.bytes[0] = temp;
|
||||
}
|
||||
janet_buffer_push_u16(buffer, *(uint16_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint32,
|
||||
"(buffer/push-uint32 buffer order data)",
|
||||
"Push a 32 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
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);
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_uint64,
|
||||
"(buffer/push-uint64 buffer order data)",
|
||||
"Push a 64 bit unsigned integer data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
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);
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_float32,
|
||||
"(buffer/push-float32 buffer order data)",
|
||||
"Push the underlying bytes of a 32 bit float data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
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);
|
||||
if (reverse)
|
||||
reverse_u32(u.bytes);
|
||||
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_push_float64,
|
||||
"(buffer/push-float64 buffer order data)",
|
||||
"Push the underlying bytes of a 64 bit float data onto the end of the buffer. "
|
||||
"Returns the modified buffer.") {
|
||||
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);
|
||||
if (reverse)
|
||||
reverse_u64(u.bytes);
|
||||
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static void buffer_push_impl(JanetBuffer *buffer, Janet *argv, int32_t argc_offset, int32_t argc) {
|
||||
for (int32_t i = argc_offset; i < argc; i++) {
|
||||
if (janet_checktype(argv[i], JANET_NUMBER)) {
|
||||
@@ -328,9 +472,9 @@ JANET_CORE_FN(cfun_buffer_push_at,
|
||||
" at index `index`.") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t index = janet_getinteger(argv, 1);
|
||||
int32_t old_count = buffer->count;
|
||||
if (index < 0 || index > old_count) {
|
||||
size_t index = janet_getsize(argv, 1);
|
||||
size_t old_count = buffer->count;
|
||||
if (index > old_count) {
|
||||
janet_panicf("index out of range [0, %d)", old_count);
|
||||
}
|
||||
buffer->count = index;
|
||||
@@ -354,7 +498,6 @@ JANET_CORE_FN(cfun_buffer_push,
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
JANET_CORE_FN(cfun_buffer_clear,
|
||||
"(buffer/clear buffer)",
|
||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||
@@ -370,8 +513,7 @@ JANET_CORE_FN(cfun_buffer_popn,
|
||||
"Removes the last `n` bytes from the buffer. Returns the modified buffer.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
if (n < 0) janet_panic("n must be non-negative");
|
||||
size_t n = janet_getsize(argv, 1);
|
||||
if (buffer->count < n) {
|
||||
buffer->count = 0;
|
||||
} else {
|
||||
@@ -395,17 +537,17 @@ JANET_CORE_FN(cfun_buffer_slice,
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, int *bit) {
|
||||
static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, size_t *index, int *bit) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
double x = janet_getnumber(argv, 1);
|
||||
int64_t bitindex = (int64_t) x;
|
||||
int64_t byteindex = bitindex >> 3;
|
||||
int which_bit = bitindex & 7;
|
||||
if (bitindex != x || bitindex < 0 || byteindex >= buffer->count)
|
||||
if (bitindex != x || bitindex < 0 || (size_t) byteindex >= buffer->count)
|
||||
janet_panicf("invalid bit index %v", argv[1]);
|
||||
*b = buffer;
|
||||
*index = (int32_t) byteindex;
|
||||
*index = (size_t) byteindex;
|
||||
*bit = which_bit;
|
||||
}
|
||||
|
||||
@@ -413,7 +555,7 @@ JANET_CORE_FN(cfun_buffer_bitset,
|
||||
"(buffer/bit-set buffer index)",
|
||||
"Sets the bit at the given bit-index. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
size_t index;
|
||||
JanetBuffer *buffer;
|
||||
bitloc(argc, argv, &buffer, &index, &bit);
|
||||
buffer->data[index] |= 1 << bit;
|
||||
@@ -424,7 +566,7 @@ JANET_CORE_FN(cfun_buffer_bitclear,
|
||||
"(buffer/bit-clear buffer index)",
|
||||
"Clears the bit at the given bit-index. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
size_t index;
|
||||
JanetBuffer *buffer;
|
||||
bitloc(argc, argv, &buffer, &index, &bit);
|
||||
buffer->data[index] &= ~(1 << bit);
|
||||
@@ -435,7 +577,7 @@ JANET_CORE_FN(cfun_buffer_bitget,
|
||||
"(buffer/bit buffer index)",
|
||||
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
size_t index;
|
||||
JanetBuffer *buffer;
|
||||
bitloc(argc, argv, &buffer, &index, &bit);
|
||||
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||
@@ -445,7 +587,7 @@ JANET_CORE_FN(cfun_buffer_bittoggle,
|
||||
"(buffer/bit-toggle buffer index)",
|
||||
"Toggles the bit at the given bit index in buffer. Returns the buffer.") {
|
||||
int bit;
|
||||
int32_t index;
|
||||
size_t index;
|
||||
JanetBuffer *buffer;
|
||||
bitloc(argc, argv, &buffer, &index, &bit);
|
||||
buffer->data[index] ^= (1 << bit);
|
||||
@@ -461,24 +603,25 @@ JANET_CORE_FN(cfun_buffer_blit,
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
int same_buf = src.bytes == dest->data;
|
||||
int32_t offset_dest = 0;
|
||||
int32_t offset_src = 0;
|
||||
if (argc > 2)
|
||||
size_t offset_dest = 0;
|
||||
size_t offset_src = 0;
|
||||
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
|
||||
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
||||
if (argc > 3)
|
||||
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
|
||||
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
||||
int32_t length_src;
|
||||
size_t length_src;
|
||||
if (argc > 4) {
|
||||
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||
size_t src_end = src.len;
|
||||
if (!janet_checktype(argv[4], JANET_NIL))
|
||||
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||
length_src = src_end - offset_src;
|
||||
if (length_src < 0) length_src = 0;
|
||||
} else {
|
||||
length_src = src.len - offset_src;
|
||||
}
|
||||
int64_t last = (int64_t) offset_dest + length_src;
|
||||
if (last > INT32_MAX)
|
||||
size_t last = offset_dest + length_src;
|
||||
if (last > JANET_INTMAX_SIZE)
|
||||
janet_panic("buffer blit out of range");
|
||||
int32_t last32 = (int32_t) last;
|
||||
size_t last32 = (size_t) last;
|
||||
janet_buffer_ensure(dest, last32, 2);
|
||||
if (last32 > dest->count) dest->count = last32;
|
||||
if (length_src) {
|
||||
@@ -508,11 +651,17 @@ void janet_lib_buffer(JanetTable *env) {
|
||||
JanetRegExt buffer_cfuns[] = {
|
||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
|
||||
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
|
||||
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
|
||||
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
|
||||
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),
|
||||
JANET_CORE_REG("buffer/push-word", cfun_buffer_word),
|
||||
JANET_CORE_REG("buffer/push-string", cfun_buffer_chars),
|
||||
JANET_CORE_REG("buffer/push-uint16", cfun_buffer_push_uint16),
|
||||
JANET_CORE_REG("buffer/push-uint32", cfun_buffer_push_uint32),
|
||||
JANET_CORE_REG("buffer/push-uint64", cfun_buffer_push_uint64),
|
||||
JANET_CORE_REG("buffer/push-float32", cfun_buffer_push_float32),
|
||||
JANET_CORE_REG("buffer/push-float64", cfun_buffer_push_float64),
|
||||
JANET_CORE_REG("buffer/push", cfun_buffer_push),
|
||||
JANET_CORE_REG("buffer/push-at", cfun_buffer_push_at),
|
||||
JANET_CORE_REG("buffer/popn", cfun_buffer_popn),
|
||||
|
||||
@@ -37,11 +37,13 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_0, /* JOP_RETURN_NIL, */
|
||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_ADD, */
|
||||
JINT_SSI, /* JOP_SUBTRACT_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_SUBTRACT, */
|
||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_DIVIDE_FLOOR */
|
||||
JINT_SSS, /* JOP_MODULO, */
|
||||
JINT_SSS, /* JOP_REMAINDER, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
@@ -170,6 +172,7 @@ void janet_bytecode_remove_noops(JanetFuncDef *def) {
|
||||
}
|
||||
|
||||
def->bytecode_length = new_bytecode_length;
|
||||
def->bytecode = janet_realloc(def->bytecode, def->bytecode_length * sizeof(uint32_t));
|
||||
janet_sfree(pc_map);
|
||||
}
|
||||
|
||||
@@ -223,6 +226,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_LOAD_TRUE:
|
||||
case JOP_LOAD_FALSE:
|
||||
case JOP_LOAD_SELF:
|
||||
break;
|
||||
case JOP_MAKE_ARRAY:
|
||||
case JOP_MAKE_BUFFER:
|
||||
case JOP_MAKE_STRING:
|
||||
@@ -230,6 +234,8 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_MAKE_TABLE:
|
||||
case JOP_MAKE_TUPLE:
|
||||
case JOP_MAKE_BRACKET_TUPLE:
|
||||
/* Reads from the stack, don't remove */
|
||||
janetc_regalloc_touch(&ra, DD);
|
||||
break;
|
||||
|
||||
/* Read A */
|
||||
@@ -249,6 +255,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_SIGNAL:
|
||||
/* Write A, Read B */
|
||||
case JOP_ADD_IMMEDIATE:
|
||||
case JOP_SUBTRACT_IMMEDIATE:
|
||||
case JOP_MULTIPLY_IMMEDIATE:
|
||||
case JOP_DIVIDE_IMMEDIATE:
|
||||
case JOP_SHIFT_LEFT_IMMEDIATE:
|
||||
@@ -300,6 +307,7 @@ void janet_bytecode_movopt(JanetFuncDef *def) {
|
||||
case JOP_SUBTRACT:
|
||||
case JOP_MULTIPLY:
|
||||
case JOP_DIVIDE:
|
||||
case JOP_DIVIDE_FLOOR:
|
||||
case JOP_MODULO:
|
||||
case JOP_REMAINDER:
|
||||
case JOP_SHIFT_LEFT:
|
||||
|
||||
169
src/core/capi.c
169
src/core/capi.c
@@ -35,6 +35,13 @@
|
||||
#endif
|
||||
#endif
|
||||
|
||||
#ifdef JANET_USE_STDATOMIC
|
||||
#include <stdatomic.h>
|
||||
/* We don't need stdatomic on most compilers since we use compiler builtins for atomic operations.
|
||||
* Some (TCC), explicitly require using stdatomic.h and don't have any exposed builtins (that I know of).
|
||||
* For TCC and similar compilers, one would need -std=c11 or similar then to get access. */
|
||||
#endif
|
||||
|
||||
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
|
||||
#ifdef JANET_TOP_LEVEL_SIGNAL
|
||||
JANET_TOP_LEVEL_SIGNAL(msg);
|
||||
@@ -131,7 +138,7 @@ type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, type dflt) { \
|
||||
}
|
||||
|
||||
#define DEFINE_OPTLEN(name, NAME, type) \
|
||||
type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len) { \
|
||||
type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, size_t dflt_len) { \
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {\
|
||||
return janet_##name(dflt_len); \
|
||||
}\
|
||||
@@ -216,12 +223,32 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
}
|
||||
|
||||
const char *janet_getcbytes(const Janet *argv, int32_t n) {
|
||||
/* Ensure buffer 0-padded */
|
||||
if (janet_checktype(argv[n], JANET_BUFFER)) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(argv[n]);
|
||||
if ((b->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC) && b->count == b->capacity) {
|
||||
/* Make a copy with janet_smalloc in the rare case we have a buffer that
|
||||
* cannot be realloced and pushing a 0 byte would panic. */
|
||||
char *new_string = janet_smalloc(b->count + 1);
|
||||
memcpy(new_string, b->data, b->count);
|
||||
new_string[b->count] = 0;
|
||||
if (strlen(new_string) != b->count) goto badzeros;
|
||||
return new_string;
|
||||
} else {
|
||||
/* Ensure trailing 0 */
|
||||
janet_buffer_push_u8(b, 0);
|
||||
b->count--;
|
||||
if (strlen((char *)b->data) != b->count) goto badzeros;
|
||||
return (const char *) b->data;
|
||||
}
|
||||
}
|
||||
JanetByteView view = janet_getbytes(argv, n);
|
||||
const char *cstr = (const char *)view.bytes;
|
||||
if (strlen(cstr) != (size_t) view.len) {
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
if (strlen(cstr) != view.len) goto badzeros;
|
||||
return cstr;
|
||||
|
||||
badzeros:
|
||||
janet_panic("bytes contain embedded 0s");
|
||||
}
|
||||
|
||||
const char *janet_optcbytes(const Janet *argv, int32_t argc, int32_t n, const char *dflt) {
|
||||
@@ -273,6 +300,14 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
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);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
#ifdef JANET_INT_TYPES
|
||||
return janet_unwrap_s64(argv[n]);
|
||||
@@ -290,7 +325,7 @@ uint64_t janet_getuinteger64(const Janet *argv, int32_t n) {
|
||||
return janet_unwrap_u64(argv[n]);
|
||||
#else
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
if (!janet_checkuint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit unsigned integer, got %v", n, x);
|
||||
}
|
||||
return (uint64_t) janet_unwrap_number(x);
|
||||
@@ -302,25 +337,47 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||
if (!janet_checksize(x)) {
|
||||
janet_panicf("bad slot #%d, expected size, got %v", n, x);
|
||||
}
|
||||
return (size_t) janet_unwrap_number(x);
|
||||
return janet_unwrap_size(x);
|
||||
}
|
||||
|
||||
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
int32_t not_raw = raw;
|
||||
ssize_t janet_getssize(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkssize(x)) {
|
||||
janet_panicf("bad slot #%d, expected ssize, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_ssize(x);
|
||||
}
|
||||
|
||||
size_t janet_gethalfrange(const Janet *argv, int32_t n, size_t length, const char *which) {
|
||||
ssize_t raw = janet_getssize(argv, n);
|
||||
ssize_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length + 1;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
|
||||
return not_raw;
|
||||
if (not_raw < 0 || (size_t) not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d]", which, (int64_t) raw, -(int64_t)length - 1, (int64_t) length);
|
||||
return (size_t) not_raw;
|
||||
}
|
||||
|
||||
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||
int32_t raw = janet_getinteger(argv, n);
|
||||
int32_t not_raw = raw;
|
||||
size_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, size_t length) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return 0;
|
||||
}
|
||||
return janet_gethalfrange(argv, n, length, "start");
|
||||
}
|
||||
|
||||
size_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, size_t length) {
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
|
||||
return length;
|
||||
}
|
||||
return janet_gethalfrange(argv, n, length, "end");
|
||||
}
|
||||
|
||||
size_t janet_getargindex(const Janet *argv, int32_t n, size_t length, const char *which) {
|
||||
ssize_t raw = janet_getssize(argv, n);
|
||||
ssize_t not_raw = raw;
|
||||
if (not_raw < 0) not_raw += length;
|
||||
if (not_raw < 0 || not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
|
||||
return not_raw;
|
||||
if (not_raw < 0 || (size_t) not_raw > length)
|
||||
janet_panicf("%s index %d out of range [%d,%d)", which, (int64_t)raw, -(int64_t)length, (int64_t)length);
|
||||
return (size_t) not_raw;
|
||||
}
|
||||
|
||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||
@@ -365,25 +422,11 @@ void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *a
|
||||
JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetRange range;
|
||||
int32_t length = janet_length(argv[0]);
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = length;
|
||||
} else {
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = janet_checktype(argv[2], JANET_NIL)
|
||||
? length
|
||||
: janet_gethalfrange(argv, 2, length, "end");
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
}
|
||||
size_t length = janet_length(argv[0]);
|
||||
range.start = janet_getstartrange(argv, argc, 1, length);
|
||||
range.end = janet_getendrange(argv, argc, 2, length);
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
return range;
|
||||
}
|
||||
|
||||
@@ -414,13 +457,13 @@ void janet_setdyn(const char *name, Janet value) {
|
||||
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);
|
||||
int32_t klen = janet_string_length(keyw);
|
||||
int32_t flen = (int32_t) strlen(flags);
|
||||
size_t klen = janet_string_length(keyw);
|
||||
size_t flen = strlen(flags);
|
||||
if (flen > 64) {
|
||||
flen = 64;
|
||||
}
|
||||
for (int32_t j = 0; j < klen; j++) {
|
||||
for (int32_t i = 0; i < flen; i++) {
|
||||
for (size_t j = 0; j < klen; j++) {
|
||||
for (size_t i = 0; i < flen; i++) {
|
||||
if (((uint8_t) flags[i]) == keyw[j]) {
|
||||
ret |= 1ULL << i;
|
||||
goto found;
|
||||
@@ -457,15 +500,53 @@ size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt) {
|
||||
return janet_getsize(argv, n);
|
||||
}
|
||||
|
||||
ssize_t janet_optssize(const Janet *argv, int32_t argc, int32_t n, ssize_t dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getssize(argv, n);
|
||||
}
|
||||
|
||||
void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getabstract(argv, n, at);
|
||||
}
|
||||
|
||||
/* Atomic refcounts */
|
||||
|
||||
JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedIncrement(x);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_fetch_add_explicit(x, 1, memory_order_relaxed) + 1;
|
||||
#else
|
||||
return __atomic_add_fetch(x, 1, __ATOMIC_RELAXED);
|
||||
#endif
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedDecrement(x);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_fetch_add_explicit(x, -1, memory_order_acq_rel) - 1;
|
||||
#else
|
||||
return __atomic_add_fetch(x, -1, __ATOMIC_ACQ_REL);
|
||||
#endif
|
||||
}
|
||||
|
||||
JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x) {
|
||||
#ifdef JANET_WINDOWS
|
||||
return InterlockedOr(x, 0);
|
||||
#elif defined(JANET_USE_STDATOMIC)
|
||||
return atomic_load_explicit(x, memory_order_acquire);
|
||||
#else
|
||||
return __atomic_load_n(x, __ATOMIC_ACQUIRE);
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
|
||||
return janet_struct_head(st);
|
||||
}
|
||||
|
||||
@@ -473,10 +554,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
||||
return janet_abstract_head(abstract);
|
||||
}
|
||||
|
||||
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
|
||||
return janet_string_head(s);
|
||||
}
|
||||
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
|
||||
return janet_tuple_head(tuple);
|
||||
}
|
||||
|
||||
@@ -99,7 +99,7 @@ static JanetSlot opfunction(
|
||||
static int can_be_imm(Janet x, int8_t *out) {
|
||||
if (!janet_checkint(x)) return 0;
|
||||
int32_t integer = janet_unwrap_integer(x);
|
||||
if (integer > 127 || integer < -127) return 0;
|
||||
if (integer > INT8_MAX || integer < INT8_MIN) return 0;
|
||||
*out = (int8_t) integer;
|
||||
return 1;
|
||||
}
|
||||
@@ -116,12 +116,11 @@ static JanetSlot opreduce(
|
||||
JanetSlot *args,
|
||||
int op,
|
||||
int opim,
|
||||
Janet nullary) {
|
||||
Janet nullary,
|
||||
Janet unary) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int32_t i, len;
|
||||
int8_t imm = 0;
|
||||
int neg = opim < 0;
|
||||
if (opim < 0) opim = -opim;
|
||||
len = janet_v_count(args);
|
||||
JanetSlot t;
|
||||
if (len == 0) {
|
||||
@@ -132,19 +131,19 @@ static JanetSlot opreduce(
|
||||
if (op == JOP_SUBTRACT) {
|
||||
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
|
||||
janetc_emit_sss(c, op, t, janetc_cslot(unary), args[0], 1);
|
||||
}
|
||||
return t;
|
||||
}
|
||||
t = janetc_gettarget(opts);
|
||||
if (opim && can_slot_be_imm(args[1], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
|
||||
janetc_emit_ssi(c, opim, t, args[0], imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, args[0], args[1], 1);
|
||||
}
|
||||
for (i = 2; i < len; i++) {
|
||||
if (opim && can_slot_be_imm(args[i], &imm)) {
|
||||
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
|
||||
janetc_emit_ssi(c, opim, t, t, imm, 1);
|
||||
} else {
|
||||
janetc_emit_sss(c, op, t, t, args[i], 1);
|
||||
}
|
||||
@@ -155,7 +154,7 @@ static JanetSlot opreduce(
|
||||
/* Function optimizers */
|
||||
|
||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||
@@ -172,7 +171,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
return t;
|
||||
}
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
if (janet_v_count(args) == 3) {
|
||||
@@ -192,20 +191,14 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
c->buffer[label] |= (current - label) << 16;
|
||||
return t;
|
||||
} else {
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
}
|
||||
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
|
||||
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
|
||||
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil(), janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
@@ -262,34 +255,43 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_SUBTRACT, JOP_SUBTRACT_IMMEDIATE, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_divf(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_DIVIDE_FLOOR, 0, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_integer(0), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
|
||||
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1), janet_wrap_integer(-1));
|
||||
}
|
||||
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
|
||||
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0), janet_wrap_integer(0));
|
||||
}
|
||||
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
|
||||
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1), janet_wrap_integer(1));
|
||||
}
|
||||
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_BNOT, args[0]);
|
||||
@@ -383,10 +385,11 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity2, do_propagate},
|
||||
{arity2or3, do_get},
|
||||
{arity1or2, do_next},
|
||||
{fixarity2, do_modulo},
|
||||
{fixarity2, do_remainder},
|
||||
{NULL, do_modulo},
|
||||
{NULL, do_remainder},
|
||||
{fixarity2, do_cmp},
|
||||
{fixarity2, do_cancel},
|
||||
{NULL, do_divf}
|
||||
};
|
||||
|
||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||
|
||||
@@ -418,12 +418,11 @@ JanetSlot janetc_gettarget(JanetFopts opts) {
|
||||
}
|
||||
|
||||
/* Get a bunch of slots for function arguments */
|
||||
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len) {
|
||||
int32_t i;
|
||||
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, size_t len) {
|
||||
JanetSlot *ret = NULL;
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
||||
for (i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
janet_v_push(ret, janetc_value(subopts, vals[i]));
|
||||
}
|
||||
return ret;
|
||||
@@ -435,9 +434,9 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
subopts.flags |= JANET_FOPTS_ACCEPT_SPLICE;
|
||||
const JanetKV *kvs = NULL;
|
||||
int32_t cap = 0, len = 0;
|
||||
size_t cap = 0, len = 0;
|
||||
janet_dictionary_view(ds, &kvs, &len, &cap);
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
for (size_t i = 0; i < cap; i++) {
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||
janet_v_push(ret, janetc_value(subopts, kvs[i].key));
|
||||
janet_v_push(ret, janetc_value(subopts, kvs[i].value));
|
||||
@@ -746,12 +745,14 @@ static int macroexpand1(
|
||||
int lock = janet_gclock();
|
||||
Janet mf_kw = janet_ckeywordv("macro-form");
|
||||
janet_table_put(c->env, mf_kw, x);
|
||||
Janet ml_kw = janet_ckeywordv("macro-lints");
|
||||
if (c->lints) {
|
||||
janet_table_put(c->env, ml_kw, janet_wrap_array(c->lints));
|
||||
}
|
||||
Janet tempOut;
|
||||
JanetSignal status = janet_continue(fiberp, janet_wrap_nil(), &tempOut);
|
||||
janet_table_put(c->env, mf_kw, janet_wrap_nil());
|
||||
if (c->lints) {
|
||||
janet_table_put(c->env, janet_ckeywordv("macro-lints"), janet_wrap_array(c->lints));
|
||||
}
|
||||
janet_table_put(c->env, ml_kw, janet_wrap_nil());
|
||||
janet_gcunlock(lock);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
const uint8_t *es = janet_formatc("(macro) %V", tempOut);
|
||||
@@ -971,12 +972,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
for (int32_t i = 0; i < janet_v_count(scope->syms); i++) {
|
||||
SymPair pair = scope->syms[i];
|
||||
if (pair.sym2) {
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
pair.death_pc = def->bytecode_length;
|
||||
}
|
||||
JanetSymbolMap jsm;
|
||||
jsm.birth_pc = pair.birth_pc;
|
||||
jsm.death_pc = pair.death_pc;
|
||||
if (pair.death_pc == UINT32_MAX) {
|
||||
jsm.death_pc = def->bytecode_length;
|
||||
} else {
|
||||
jsm.death_pc = pair.death_pc - scope->bytecode_start;
|
||||
}
|
||||
/* Handle birth_pc == 0 correctly */
|
||||
if ((uint32_t) scope->bytecode_start > pair.birth_pc) {
|
||||
jsm.birth_pc = 0;
|
||||
} else {
|
||||
jsm.birth_pc = pair.birth_pc - scope->bytecode_start;
|
||||
}
|
||||
janet_assert(jsm.birth_pc <= jsm.death_pc, "birth pc after death pc");
|
||||
janet_assert(jsm.birth_pc < (uint32_t) def->bytecode_length, "bad birth pc");
|
||||
janet_assert(jsm.death_pc <= (uint32_t) def->bytecode_length, "bad death pc");
|
||||
jsm.slot_index = pair.slot.index;
|
||||
jsm.symbol = pair.sym2;
|
||||
janet_v_push(locals, jsm);
|
||||
|
||||
@@ -69,6 +69,7 @@ typedef enum {
|
||||
#define JANET_FUN_REMAINDER 30
|
||||
#define JANET_FUN_CMP 31
|
||||
#define JANET_FUN_CANCEL 32
|
||||
#define JANET_FUN_DIVIDE_FLOOR 33
|
||||
|
||||
/* Compiler typedefs */
|
||||
typedef struct JanetCompiler JanetCompiler;
|
||||
@@ -231,7 +232,7 @@ void janetc_throwaway(JanetFopts opts, Janet x);
|
||||
JanetSlot janetc_gettarget(JanetFopts opts);
|
||||
|
||||
/* Get a bunch of slots for function arguments */
|
||||
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
||||
JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, size_t len);
|
||||
|
||||
/* Get a bunch of slots for function arguments */
|
||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||
|
||||
@@ -92,7 +92,7 @@ static const char *janet_dyncstring(const char *name, const char *dflt) {
|
||||
}
|
||||
const uint8_t *jstr = janet_unwrap_string(x);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
if (strlen(cstr) != janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s", x);
|
||||
}
|
||||
return cstr;
|
||||
@@ -110,14 +110,14 @@ JANET_CORE_FN(janet_core_expand_path,
|
||||
"(module/expand-path path template)",
|
||||
"Expands a path template as found in `module/paths` for `module/find`. "
|
||||
"This takes in a path (the argument to require) and a template string, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files. The replacements are as follows:\n\n"
|
||||
"to expand the path to a path that can be used for importing files. "
|
||||
"The replacements are as follows:\n\n"
|
||||
"* :all: -- the value of path verbatim.\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character,\n"
|
||||
" the first path segment is replaced with a dynamic binding\n"
|
||||
" `(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the current file, or (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory containing the current file\n\n"
|
||||
"* :@all: -- Same as :all:, but if `path` starts with the @ character, "
|
||||
"the first path segment is replaced with a dynamic binding "
|
||||
"`(dyn <first path segment as keyword>)`.\n\n"
|
||||
"* :cur: -- the directory portion, if any, of (dyn :current-file)\n\n"
|
||||
"* :dir: -- the directory portion, if any, of the path argument\n\n"
|
||||
"* :name: -- the name component of path, with extension if given\n\n"
|
||||
"* :native: -- the extension used to load natives, .so or .dll\n\n"
|
||||
"* :sys: -- the system path, or (dyn :syspath)") {
|
||||
@@ -426,6 +426,36 @@ JANET_CORE_FN(janet_core_slice,
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_range,
|
||||
"(range & args)",
|
||||
"Create an array of values [start, end) with a given step. "
|
||||
"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;
|
||||
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);
|
||||
} else if (argc == 2) {
|
||||
start = janet_getinteger(argv, 0);
|
||||
stop = janet_getinteger(argv, 1);
|
||||
count = stop - start;
|
||||
} else {
|
||||
stop = janet_getinteger(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);
|
||||
}
|
||||
array->count = count;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_table,
|
||||
"(table & kvs)",
|
||||
"Creates a new table from a variadic number of keys and values. "
|
||||
@@ -629,6 +659,34 @@ ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_bytes,
|
||||
"(bytes? x)",
|
||||
"Check if x is a string, symbol, keyword, or buffer.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_indexed,
|
||||
"(indexed? x)",
|
||||
"Check if x is an array or tuple.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_dictionary,
|
||||
"(dictionary? x)",
|
||||
"Check if x is a table or struct.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_is_lengthable,
|
||||
"(lengthable? x)",
|
||||
"Check if x is a bytes, indexed, or dictionary.") {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(janet_core_signal,
|
||||
"(signal what x)",
|
||||
"Raise a signal with payload x. ") {
|
||||
@@ -660,12 +718,12 @@ JANET_CORE_FN(janet_core_memcmp,
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetByteView a = janet_getbytes(argv, 0);
|
||||
JanetByteView b = janet_getbytes(argv, 1);
|
||||
int32_t len = janet_optnat(argv, argc, 2, a.len < b.len ? a.len : b.len);
|
||||
int32_t offset_a = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t offset_b = janet_optnat(argv, argc, 4, 0);
|
||||
size_t len = janet_optsize(argv, argc, 2, a.len < b.len ? a.len : b.len);
|
||||
size_t offset_a = janet_optsize(argv, argc, 3, 0);
|
||||
size_t offset_b = janet_optsize(argv, argc, 4, 0);
|
||||
if (offset_a + len > a.len) janet_panicf("invalid offset-a: %d", offset_a);
|
||||
if (offset_b + len > b.len) janet_panicf("invalid offset-b: %d", offset_b);
|
||||
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, (size_t) len));
|
||||
return janet_wrap_integer(memcmp(a.bytes + offset_a, b.bytes + offset_b, len));
|
||||
}
|
||||
|
||||
typedef struct SandboxOption {
|
||||
@@ -677,6 +735,9 @@ static const SandboxOption sandbox_options[] = {
|
||||
{"all", JANET_SANDBOX_ALL},
|
||||
{"env", JANET_SANDBOX_ENV},
|
||||
{"ffi", JANET_SANDBOX_FFI},
|
||||
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
||||
{"ffi-jit", JANET_SANDBOX_FFI_JIT},
|
||||
{"ffi-use", JANET_SANDBOX_FFI_USE},
|
||||
{"fs", JANET_SANDBOX_FS},
|
||||
{"fs-read", JANET_SANDBOX_FS_READ},
|
||||
{"fs-temp", JANET_SANDBOX_FS_TEMP},
|
||||
@@ -687,6 +748,7 @@ static const SandboxOption sandbox_options[] = {
|
||||
{"net-connect", JANET_SANDBOX_NET_CONNECT},
|
||||
{"net-listen", JANET_SANDBOX_NET_LISTEN},
|
||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||
{"signal", JANET_SANDBOX_SIGNAL},
|
||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||
{NULL, 0}
|
||||
};
|
||||
@@ -698,6 +760,9 @@ JANET_CORE_FN(janet_core_sandbox,
|
||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||
"* :env - disallow reading and write env variables\n"
|
||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
||||
"* :ffi-jit - disallow calling `ffi/jitfn`\n"
|
||||
"* :ffi-use - disallow using any previously bound FFI functions and memory-unsafe functions.\n"
|
||||
"* :fs - disallow access to the file system\n"
|
||||
"* :fs-read - disallow read access to the file system\n"
|
||||
"* :fs-temp - disallow creating temporary files\n"
|
||||
@@ -708,6 +773,7 @@ JANET_CORE_FN(janet_core_sandbox,
|
||||
"* :net-connect - disallow making outbound network connections\n"
|
||||
"* :net-listen - disallow accepting inbound network connections\n"
|
||||
"* :sandbox - disallow calling this function\n"
|
||||
"* :signal - disallow adding or removing signal handlers\n"
|
||||
"* :subprocess - disallow running subprocesses") {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
@@ -979,14 +1045,6 @@ static const uint32_t next_asm[] = {
|
||||
JOP_NEXT | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t modulo_asm[] = {
|
||||
JOP_MODULO | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t remainder_asm[] = {
|
||||
JOP_REMAINDER | (1 << 24),
|
||||
JOP_RETURN
|
||||
};
|
||||
static const uint32_t cmp_asm[] = {
|
||||
JOP_COMPARE | (1 << 24),
|
||||
JOP_RETURN
|
||||
@@ -1025,7 +1083,12 @@ static void janet_load_libs(JanetTable *env) {
|
||||
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
|
||||
JANET_CORE_REG("int?", janet_core_check_int),
|
||||
JANET_CORE_REG("nat?", janet_core_check_nat),
|
||||
JANET_CORE_REG("bytes?", janet_core_is_bytes),
|
||||
JANET_CORE_REG("indexed?", janet_core_is_indexed),
|
||||
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
|
||||
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
|
||||
JANET_CORE_REG("slice", janet_core_slice),
|
||||
JANET_CORE_REG("range", janet_core_range),
|
||||
JANET_CORE_REG("signal", janet_core_signal),
|
||||
JANET_CORE_REG("memcmp", janet_core_memcmp),
|
||||
JANET_CORE_REG("getproto", janet_core_getproto),
|
||||
@@ -1071,14 +1134,6 @@ static void janet_load_libs(JanetTable *env) {
|
||||
|
||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||
janet_quick_asm(env, JANET_FUN_MODULO,
|
||||
"mod", 2, 2, 2, 2, modulo_asm, sizeof(modulo_asm),
|
||||
JDOC("(mod dividend divisor)\n\n"
|
||||
"Returns the modulo of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_REMAINDER,
|
||||
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."));
|
||||
janet_quick_asm(env, JANET_FUN_CMP,
|
||||
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
|
||||
JDOC("(cmp x y)\n\n"
|
||||
@@ -1089,17 +1144,20 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
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 they data structure is not mutated "
|
||||
"to be seen only once per iteration if the data structure is not mutated "
|
||||
"during iteration. If key is nil, next returns the first key. If next "
|
||||
"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. 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"
|
||||
@@ -1177,6 +1235,18 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"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."));
|
||||
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`."));
|
||||
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."));
|
||||
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."));
|
||||
@@ -1269,7 +1339,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
||||
JanetTable *lid = janet_unwrap_table(lidv);
|
||||
JanetTable *mid = janet_unwrap_table(midv);
|
||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
||||
for (size_t i = 0; i < lid->capacity; i++) {
|
||||
const JanetKV *kv = lid->data + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(mid, kv->value, kv->key);
|
||||
@@ -1287,7 +1357,7 @@ JanetTable *janet_core_lookup_table(JanetTable *replacements) {
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
for (size_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
|
||||
@@ -314,6 +314,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
if (frame->func && frame->pc) {
|
||||
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||
JanetArray *slots;
|
||||
janet_assert(def != NULL, "def != NULL");
|
||||
off = (int32_t)(frame->pc - def->bytecode);
|
||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||
if (def->sourcemap) {
|
||||
@@ -387,8 +388,8 @@ JANET_CORE_FN(cfun_debug_stack,
|
||||
JANET_CORE_FN(cfun_debug_stacktrace,
|
||||
"(debug/stacktrace fiber &opt err prefix)",
|
||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||
"an error value to print the stack trace with. If `err` is nil or not "
|
||||
"provided, and no prefix is given, will skip the error line. Returns the fiber.") {
|
||||
"an error value to print the stack trace with. If `prefix` is nil or not "
|
||||
"provided, will skip the error line. Returns the fiber.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
|
||||
@@ -26,6 +26,7 @@
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "regalloc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Get a register */
|
||||
@@ -128,7 +129,8 @@ static void janetc_movenear(JanetCompiler *c,
|
||||
((uint32_t)(src.envindex) << 16) |
|
||||
((uint32_t)(dest) << 8) |
|
||||
JOP_LOAD_UPVALUE);
|
||||
} else if (src.index > 0xFF || src.index != dest) {
|
||||
} else if (src.index != dest) {
|
||||
janet_assert(src.index >= 0, "bad slot");
|
||||
janetc_emit(c,
|
||||
((uint32_t)(src.index) << 16) |
|
||||
((uint32_t)(dest) << 8) |
|
||||
@@ -155,6 +157,7 @@ static void janetc_moveback(JanetCompiler *c,
|
||||
((uint32_t)(src) << 8) |
|
||||
JOP_SET_UPVALUE);
|
||||
} else if (dest.index != src) {
|
||||
janet_assert(dest.index >= 0, "bad slot");
|
||||
janetc_emit(c,
|
||||
((uint32_t)(dest.index) << 16) |
|
||||
((uint32_t)(src) << 8) |
|
||||
|
||||
1196
src/core/ev.c
1196
src/core/ev.c
File diff suppressed because it is too large
Load Diff
@@ -107,7 +107,7 @@ static const JanetFFIPrimInfo janet_ffi_type_info[] = {
|
||||
struct JanetFFIType {
|
||||
JanetFFIStruct *st;
|
||||
JanetFFIPrimType prim;
|
||||
int32_t array_count;
|
||||
ssize_t array_count;
|
||||
};
|
||||
|
||||
typedef struct {
|
||||
@@ -408,7 +408,7 @@ static JanetFFIStruct *build_struct_type(int32_t argc, const Janet *argv) {
|
||||
st->fields[i].offset = st->size;
|
||||
st->size += (uint32_t) el_size;
|
||||
} else {
|
||||
if (el_align > st->align) st->align = (uint32_t) el_align;
|
||||
if (el_align > (size_t) st->align) st->align = (uint32_t) el_align;
|
||||
st->fields[i].offset = (uint32_t)(((st->size + el_align - 1) / el_align) * el_align);
|
||||
st->size = (uint32_t)(el_size + st->fields[i].offset);
|
||||
}
|
||||
@@ -432,13 +432,13 @@ static JanetFFIType decode_ffi_type(Janet x) {
|
||||
ret.st = janet_unwrap_abstract(x);
|
||||
return ret;
|
||||
}
|
||||
int32_t len;
|
||||
size_t len;
|
||||
const Janet *els;
|
||||
if (janet_indexed_view(x, &els, &len)) {
|
||||
if (janet_checktype(x, JANET_ARRAY)) {
|
||||
if (len != 2 && len != 1) janet_panicf("array type must be of form @[type count], got %v", x);
|
||||
ret = decode_ffi_type(els[0]);
|
||||
int32_t array_count = len == 1 ? 0 : janet_getnat(els, 1);
|
||||
ssize_t array_count = len == 1 ? 0 : janet_getssize(els, 1);
|
||||
ret.array_count = array_count;
|
||||
} else {
|
||||
ret.st = build_struct_type(len, els);
|
||||
@@ -518,11 +518,11 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
|
||||
el_type.array_count = -1;
|
||||
size_t el_size = type_size(el_type);
|
||||
JanetView els = janet_getindexed(argv, n);
|
||||
if (els.len != type.array_count) {
|
||||
if (els.len != (size_t) type.array_count) {
|
||||
janet_panicf("bad array length, expected %d, got %d", type.array_count, els.len);
|
||||
}
|
||||
char *cursor = to;
|
||||
for (int32_t i = 0; i < els.len; i++) {
|
||||
for (size_t i = 0; i < els.len; i++) {
|
||||
janet_ffi_write_one(cursor, els.items, i, el_type, recur - 1);
|
||||
cursor += el_size;
|
||||
}
|
||||
@@ -541,7 +541,7 @@ static void janet_ffi_write_one(void *to, const Janet *argv, int32_t n, JanetFFI
|
||||
janet_panicf("wrong number of fields in struct, expected %d, got %d",
|
||||
(int32_t) st->field_count, els.len);
|
||||
}
|
||||
for (int32_t i = 0; i < els.len; i++) {
|
||||
for (size_t i = 0; i < els.len; i++) {
|
||||
JanetFFIType tp = st->fields[i].type;
|
||||
janet_ffi_write_one((char *) to + st->fields[i].offset, els.items, i, tp, recur - 1);
|
||||
}
|
||||
@@ -1303,12 +1303,12 @@ JANET_CORE_FN(cfun_ffi_jitfn,
|
||||
"(ffi/jitfn bytes)",
|
||||
"Create an abstract type that can be used as the pointer argument to `ffi/call`. The content "
|
||||
"of `bytes` is architecture specific machine code that will be copied into executable memory.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_JIT);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
|
||||
/* Quick hack to align to page boundary, we should query OS. FIXME */
|
||||
size_t alloc_size = ((size_t) bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
|
||||
size_t alloc_size = (bytes.len + FFI_PAGE_MASK) & ~FFI_PAGE_MASK;
|
||||
|
||||
#ifdef JANET_FFI_JIT
|
||||
#ifdef JANET_EV
|
||||
@@ -1356,7 +1356,7 @@ JANET_CORE_FN(cfun_ffi_call,
|
||||
"(ffi/call pointer signature & args)",
|
||||
"Call a raw pointer as a function pointer. The function signature specifies "
|
||||
"how Janet values in `args` are converted to native machine types.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 2, -1);
|
||||
void *function_pointer = janet_ffi_get_callable_pointer(argv, 0);
|
||||
JanetFFISignature *signature = janet_getabstract(argv, 1, &janet_signature_type);
|
||||
@@ -1364,6 +1364,7 @@ JANET_CORE_FN(cfun_ffi_call,
|
||||
switch (signature->cc) {
|
||||
default:
|
||||
case JANET_FFI_CC_NONE:
|
||||
(void) function_pointer;
|
||||
janet_panic("calling convention not supported");
|
||||
#ifdef JANET_FFI_WIN64_ENABLED
|
||||
case JANET_FFI_CC_WIN_64:
|
||||
@@ -1380,14 +1381,14 @@ JANET_CORE_FN(cfun_ffi_buffer_write,
|
||||
"(ffi/write ffi-type data &opt buffer index)",
|
||||
"Append a native type to a buffer such as it would appear in memory. This can be used "
|
||||
"to pass pointers to structs in the ffi, or send C/C++/native structs over the network "
|
||||
"or to files. Returns a modifed buffer or a new buffer if one is not supplied.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
"or to files. Returns a modified buffer or a new buffer if one is not supplied.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 2, 4);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
uint32_t el_size = (uint32_t) type_size(type);
|
||||
size_t el_size = type_size(type);
|
||||
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, el_size);
|
||||
int32_t index = janet_optnat(argv, argc, 3, 0);
|
||||
int32_t old_count = buffer->count;
|
||||
size_t index = janet_optsize(argv, argc, 3, 0);
|
||||
size_t old_count = buffer->count;
|
||||
if (index > old_count) janet_panic("index out of bounds");
|
||||
buffer->count = index;
|
||||
janet_buffer_extra(buffer, el_size);
|
||||
@@ -1404,17 +1405,17 @@ JANET_CORE_FN(cfun_ffi_buffer_read,
|
||||
"Parse a native struct out of a buffer and convert it to normal Janet data structures. "
|
||||
"This function is the inverse of `ffi/write`. `bytes` can also be a raw pointer, although "
|
||||
"this is unsafe.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetFFIType type = decode_ffi_type(argv[0]);
|
||||
size_t offset = (size_t) janet_optnat(argv, argc, 2, 0);
|
||||
size_t offset = janet_optsize(argv, argc, 2, 0);
|
||||
if (janet_checktype(argv[1], JANET_POINTER)) {
|
||||
uint8_t *ptr = janet_unwrap_pointer(argv[1]);
|
||||
return janet_ffi_read_one(ptr + offset, type, JANET_FFI_MAX_RECUR);
|
||||
} else {
|
||||
size_t el_size = type_size(type);
|
||||
JanetByteView bytes = janet_getbytes(argv, 1);
|
||||
if ((size_t) bytes.len < offset + el_size) janet_panic("read out of range");
|
||||
if (bytes.len < offset + el_size) janet_panic("read out of range");
|
||||
return janet_ffi_read_one(bytes.bytes + offset, type, JANET_FFI_MAX_RECUR);
|
||||
}
|
||||
}
|
||||
@@ -1451,7 +1452,7 @@ JANET_CORE_FN(janet_core_raw_native,
|
||||
" or run any code from it. This is different than `native`, which will "
|
||||
"run initialization code to get a module table. If `path` is nil, opens the current running binary. "
|
||||
"Returns a `core/native`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *path = janet_optcstring(argv, argc, 0, NULL);
|
||||
Clib lib = load_clib(path);
|
||||
@@ -1467,7 +1468,7 @@ JANET_CORE_FN(janet_core_native_lookup,
|
||||
"(ffi/lookup native symbol-name)",
|
||||
"Lookup a symbol from a native object. All symbol lookups will return a raw pointer "
|
||||
"if the symbol is found, else nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
|
||||
janet_fixarity(argc, 2);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
const char *sym = janet_getcstring(argv, 1);
|
||||
@@ -1481,7 +1482,7 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
"(ffi/close native)",
|
||||
"Free a native object. Dereferencing pointers to symbols in the object will have undefined "
|
||||
"behavior after freeing.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_DEFINE);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAbstractNative *anative = janet_getabstract(argv, 0, &janet_native_type);
|
||||
if (anative->closed) janet_panic("native object already closed");
|
||||
@@ -1494,7 +1495,7 @@ JANET_CORE_FN(janet_core_native_close,
|
||||
JANET_CORE_FN(cfun_ffi_malloc,
|
||||
"(ffi/malloc size)",
|
||||
"Allocates memory directly using the janet memory allocator. Memory allocated in this way must be freed manually! Returns a raw pointer, or nil if size = 0.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_fixarity(argc, 1);
|
||||
size_t size = janet_getsize(argv, 0);
|
||||
if (size == 0) return janet_wrap_nil();
|
||||
@@ -1504,7 +1505,7 @@ JANET_CORE_FN(cfun_ffi_malloc,
|
||||
JANET_CORE_FN(cfun_ffi_free,
|
||||
"(ffi/free pointer)",
|
||||
"Free memory allocated with `ffi/malloc`. Returns nil.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_fixarity(argc, 1);
|
||||
if (janet_checktype(argv[0], JANET_NIL)) return janet_wrap_nil();
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
@@ -1519,16 +1520,52 @@ JANET_CORE_FN(cfun_ffi_pointer_buffer,
|
||||
"to be manipulated with buffer functions. Attempts to resize or extend the buffer "
|
||||
"beyond its initial capacity will raise an error. As with many FFI functions, this is memory "
|
||||
"unsafe and can potentially allow out of bounds memory access. Returns a new buffer.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI);
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 2, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
int32_t capacity = janet_getnat(argv, 1);
|
||||
int32_t count = janet_optnat(argv, argc, 2, 0);
|
||||
size_t capacity = janet_getsize(argv, 1);
|
||||
size_t count = janet_optsize(argv, argc, 2, 0);
|
||||
int64_t offset = janet_optinteger64(argv, argc, 3, 0);
|
||||
uint8_t *offset_pointer = ((uint8_t *) pointer) + offset;
|
||||
return janet_wrap_buffer(janet_pointer_buffer_unsafe(offset_pointer, capacity, count));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_pointer_cfunction,
|
||||
"(ffi/pointer-cfunction pointer &opt name source-file source-line)",
|
||||
"Create a C Function from a raw pointer. Optionally give the cfunction a name and "
|
||||
"source location for stack traces and debugging.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FFI_USE);
|
||||
janet_arity(argc, 1, 4);
|
||||
void *pointer = janet_getpointer(argv, 0);
|
||||
const char *name = janet_optcstring(argv, argc, 1, NULL);
|
||||
const char *source = janet_optcstring(argv, argc, 2, NULL);
|
||||
int32_t line = janet_optinteger(argv, argc, 3, -1);
|
||||
if ((name != NULL) || (source != NULL) || (line != -1)) {
|
||||
janet_registry_put((JanetCFunction) pointer, name, NULL, source, line);
|
||||
}
|
||||
return janet_wrap_cfunction((JanetCFunction) pointer);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_ffi_supported_calling_conventions,
|
||||
"(ffi/calling-conventions)",
|
||||
"Get an array of all supported calling conventions on the current architecture. Some architectures may have some FFI "
|
||||
"functionality (ffi/malloc, ffi/free, ffi/read, ffi/write, etc.) but not support "
|
||||
"any calling conventions. This function can be used to get all supported calling conventions "
|
||||
"that can be used on this architecture. All architectures support the :none calling "
|
||||
"convention which is a placeholder that cannot be used at runtime.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
JanetArray *array = janet_array(4);
|
||||
#ifdef JANET_FFI_WIN64_ENABLED
|
||||
janet_array_push(array, janet_ckeywordv("win64"));
|
||||
#endif
|
||||
#ifdef JANET_FFI_SYSV64_ENABLED
|
||||
janet_array_push(array, janet_ckeywordv("sysv64"));
|
||||
#endif
|
||||
janet_array_push(array, janet_ckeywordv("none"));
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
void janet_lib_ffi(JanetTable *env) {
|
||||
JanetRegExt ffi_cfuns[] = {
|
||||
JANET_CORE_REG("ffi/native", janet_core_raw_native),
|
||||
@@ -1546,6 +1583,8 @@ void janet_lib_ffi(JanetTable *env) {
|
||||
JANET_CORE_REG("ffi/malloc", cfun_ffi_malloc),
|
||||
JANET_CORE_REG("ffi/free", cfun_ffi_free),
|
||||
JANET_CORE_REG("ffi/pointer-buffer", cfun_ffi_pointer_buffer),
|
||||
JANET_CORE_REG("ffi/pointer-cfunction", cfun_ffi_pointer_cfunction),
|
||||
JANET_CORE_REG("ffi/calling-conventions", cfun_ffi_supported_calling_conventions),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, ffi_cfuns);
|
||||
|
||||
@@ -39,14 +39,16 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->ev_callback = NULL;
|
||||
fiber->ev_state = NULL;
|
||||
fiber->ev_stream = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
static JanetFiber *fiber_alloc(size_t capacity) {
|
||||
Janet *data;
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
if (capacity < 32) {
|
||||
@@ -81,10 +83,10 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
|
||||
}
|
||||
fiber->stacktop = newstacktop;
|
||||
}
|
||||
/* Don't panic on failure since we use this to implement janet_pcall */
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->supervisor_channel = NULL;
|
||||
#endif
|
||||
return fiber;
|
||||
@@ -194,7 +196,7 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t oldframe = fiber->frame;
|
||||
int32_t nextframe = fiber->stackstart;
|
||||
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
int32_t next_arity = (int32_t) fiber->stacktop - fiber->stackstart;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (next_arity < func->def->min_arity) return 1;
|
||||
@@ -237,8 +239,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -329,7 +331,7 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t i;
|
||||
int32_t nextframetop = fiber->frame + func->def->slotcount;
|
||||
int32_t nextstacktop = nextframetop + JANET_FRAME_SIZE;
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
int32_t next_arity = (int32_t) fiber->stacktop - fiber->stackstart;
|
||||
int32_t stacksize;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
@@ -368,8 +370,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
}
|
||||
stacksize = tuplehead - fiber->stackstart + 1;
|
||||
} else {
|
||||
@@ -477,10 +479,10 @@ JANET_CORE_FN(cfun_fiber_setenv,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_new,
|
||||
"(fiber/new func &opt sigmask)",
|
||||
"(fiber/new func &opt sigmask env)",
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a keyword where each character "
|
||||
"take a set of signals `sigmask` to capture from child fibers, "
|
||||
"and an environment table `env`. The mask is specified as a keyword where each character "
|
||||
"is used to indicate a signal to block. If the ev module is enabled, and "
|
||||
"this fiber is used as an argument to `ev/go`, these \"blocked\" signals "
|
||||
"will result in messages being sent to the supervisor channel. "
|
||||
@@ -502,19 +504,22 @@ JANET_CORE_FN(cfun_fiber_new,
|
||||
"exclusive flags are present, the last flag takes precedence.\n\n"
|
||||
"* :i - inherit the environment from the current fiber\n"
|
||||
"* :p - the environment table's prototype is the current environment table") {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
if (func->def->min_arity > 1) {
|
||||
janet_panicf("fiber function must accept 0 or 1 arguments");
|
||||
}
|
||||
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
janet_assert(fiber != NULL, "bad fiber arity check");
|
||||
if (argc == 3 && !janet_checktype(argv[2], JANET_NIL)) {
|
||||
fiber->env = janet_gettable(argv, 2);
|
||||
}
|
||||
if (argc >= 2) {
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
fiber->flags = JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
for (i = 0; i < view.len; i++) {
|
||||
for (size_t i = 0; i < view.len; i++) {
|
||||
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
|
||||
fiber->flags |= JANET_FIBER_MASK_USERN(view.bytes[i] - '0');
|
||||
} else {
|
||||
@@ -656,7 +661,7 @@ JANET_CORE_FN(cfun_fiber_can_resume,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_last_value,
|
||||
"(fiber/last-value)",
|
||||
"(fiber/last-value fiber)",
|
||||
"Get the last value returned or signaled from the fiber.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
|
||||
@@ -59,6 +59,9 @@
|
||||
#define JANET_FIBER_EV_FLAG_CANCELED 0x10000
|
||||
#define JANET_FIBER_EV_FLAG_SUSPENDED 0x20000
|
||||
#define JANET_FIBER_FLAG_ROOT 0x40000
|
||||
#define JANET_FIBER_EV_FLAG_IN_FLIGHT 0x1
|
||||
|
||||
/* used only on windows, should otherwise be unset */
|
||||
|
||||
#define janet_fiber_set_status(f, s) do {\
|
||||
(f)->flags &= ~JANET_FIBER_STATUS_MASK;\
|
||||
|
||||
179
src/core/gc.c
179
src/core/gc.c
@@ -122,7 +122,7 @@ static void janet_mark_abstract(void *adata) {
|
||||
}
|
||||
|
||||
/* Mark a bunch of items in memory */
|
||||
static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
static void janet_mark_many(const Janet *values, size_t n) {
|
||||
if (values == NULL)
|
||||
return;
|
||||
const Janet *end = values + n;
|
||||
@@ -132,6 +132,24 @@ static void janet_mark_many(const Janet *values, int32_t n) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_keys(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
janet_mark(kvs->key);
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_values(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
while (kvs < end) {
|
||||
janet_mark(kvs->value);
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
|
||||
/* Mark a bunch of key values items in memory */
|
||||
static void janet_mark_kvs(const JanetKV *kvs, int32_t n) {
|
||||
const JanetKV *end = kvs + n;
|
||||
@@ -146,7 +164,9 @@ static void janet_mark_array(JanetArray *array) {
|
||||
if (janet_gc_reachable(array))
|
||||
return;
|
||||
janet_gc_mark(array);
|
||||
janet_mark_many(array->data, array->count);
|
||||
if (janet_gc_type((JanetGCObject *) array) == JANET_MEMORY_ARRAY) {
|
||||
janet_mark_many(array->data, array->count);
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_mark_table(JanetTable *table) {
|
||||
@@ -154,7 +174,15 @@ recur: /* Manual tail recursion */
|
||||
if (janet_gc_reachable(table))
|
||||
return;
|
||||
janet_gc_mark(table);
|
||||
janet_mark_kvs(table->data, table->capacity);
|
||||
enum JanetMemoryType memtype = janet_gc_type(table);
|
||||
if (memtype == JANET_MEMORY_TABLE_WEAKK) {
|
||||
janet_mark_values(table->data, table->capacity);
|
||||
} else if (memtype == JANET_MEMORY_TABLE_WEAKV) {
|
||||
janet_mark_keys(table->data, table->capacity);
|
||||
} else if (memtype == JANET_MEMORY_TABLE) {
|
||||
janet_mark_kvs(table->data, table->capacity);
|
||||
}
|
||||
/* do nothing for JANET_MEMORY_TABLE_WEAKKV */
|
||||
if (table->proto) {
|
||||
table = table->proto;
|
||||
goto recur;
|
||||
@@ -234,7 +262,7 @@ static void janet_mark_function(JanetFunction *func) {
|
||||
}
|
||||
|
||||
static void janet_mark_fiber(JanetFiber *fiber) {
|
||||
int32_t i, j;
|
||||
size_t i, j;
|
||||
JanetStackFrame *frame;
|
||||
recur:
|
||||
if (janet_gc_reachable(fiber))
|
||||
@@ -268,6 +296,12 @@ recur:
|
||||
if (fiber->supervisor_channel) {
|
||||
janet_mark_abstract(fiber->supervisor_channel);
|
||||
}
|
||||
if (fiber->ev_stream) {
|
||||
janet_mark_abstract(fiber->ev_stream);
|
||||
}
|
||||
if (fiber->ev_callback) {
|
||||
fiber->ev_callback(fiber, JANET_ASYNC_EVENT_MARK);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Explicit tail recursion */
|
||||
@@ -292,9 +326,17 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
case JANET_MEMORY_TABLE:
|
||||
janet_free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
janet_free(((JanetFiber *)mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER: {
|
||||
JanetFiber *f = (JanetFiber *)mem;
|
||||
#ifdef JANET_EV
|
||||
if (f->ev_state && !(f->flags & JANET_FIBER_EV_FLAG_IN_FLIGHT)) {
|
||||
janet_ev_dec_refcount();
|
||||
janet_free(f->ev_state);
|
||||
}
|
||||
#endif
|
||||
janet_free(f->data);
|
||||
}
|
||||
break;
|
||||
case JANET_MEMORY_BUFFER:
|
||||
janet_buffer_deinit((JanetBuffer *) mem);
|
||||
break;
|
||||
@@ -326,12 +368,98 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Check that a value x has been visited in the mark phase */
|
||||
static int janet_check_liveref(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
return 1;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TABLE:
|
||||
case JANET_FUNCTION:
|
||||
case JANET_BUFFER:
|
||||
case JANET_FIBER:
|
||||
return janet_gc_reachable(janet_unwrap_pointer(x));
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_gc_reachable(janet_string_head(janet_unwrap_string(x)));
|
||||
case JANET_ABSTRACT:
|
||||
return janet_gc_reachable(janet_abstract_head(janet_unwrap_abstract(x)));
|
||||
case JANET_TUPLE:
|
||||
return janet_gc_reachable(janet_tuple_head(janet_unwrap_tuple(x)));
|
||||
case JANET_STRUCT:
|
||||
return janet_gc_reachable(janet_struct_head(janet_unwrap_struct(x)));
|
||||
}
|
||||
}
|
||||
|
||||
/* Iterate over all allocated memory, and free memory that is not
|
||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||
void janet_sweep() {
|
||||
JanetGCObject *previous = NULL;
|
||||
JanetGCObject *current = janet_vm.blocks;
|
||||
JanetGCObject *current = janet_vm.weak_blocks;
|
||||
JanetGCObject *next;
|
||||
|
||||
/* Sweep weak heap to drop weak refs */
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
/* Check for dead references */
|
||||
enum JanetMemoryType type = janet_gc_type(current);
|
||||
if (type == JANET_MEMORY_ARRAY_WEAK) {
|
||||
JanetArray *array = (JanetArray *) current;
|
||||
for (uint32_t i = 0; i < (uint32_t) array->count; i++) {
|
||||
if (!janet_check_liveref(array->data[i])) {
|
||||
array->data[i] = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
} else {
|
||||
JanetTable *table = (JanetTable *) current;
|
||||
int check_values = (type == JANET_MEMORY_TABLE_WEAKV) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
||||
int check_keys = (type == JANET_MEMORY_TABLE_WEAKK) || (type == JANET_MEMORY_TABLE_WEAKKV);
|
||||
JanetKV *end = table->data + table->capacity;
|
||||
JanetKV *kvs = table->data;
|
||||
while (kvs < end) {
|
||||
int drop = 0;
|
||||
if (check_keys && !janet_check_liveref(kvs->key)) drop = 1;
|
||||
if (check_values && !janet_check_liveref(kvs->value)) drop = 1;
|
||||
if (drop) {
|
||||
/* Inlined from janet_table_remove without search */
|
||||
table->count--;
|
||||
table->deleted++;
|
||||
kvs->key = janet_wrap_nil();
|
||||
kvs->value = janet_wrap_false();
|
||||
}
|
||||
kvs++;
|
||||
}
|
||||
}
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
/* Sweep weak heap to free blocks */
|
||||
previous = NULL;
|
||||
current = janet_vm.weak_blocks;
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
previous = current;
|
||||
current->flags &= ~JANET_MEM_REACHABLE;
|
||||
} else {
|
||||
janet_vm.block_count--;
|
||||
janet_deinit_block(current);
|
||||
if (NULL != previous) {
|
||||
previous->data.next = next;
|
||||
} else {
|
||||
janet_vm.weak_blocks = next;
|
||||
}
|
||||
janet_free(current);
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
/* Sweep main heap to free blocks */
|
||||
previous = NULL;
|
||||
current = janet_vm.blocks;
|
||||
while (NULL != current) {
|
||||
next = current->data.next;
|
||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||
@@ -349,10 +477,11 @@ void janet_sweep() {
|
||||
}
|
||||
current = next;
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
/* Sweep threaded abstract types for references to decrement */
|
||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
for (size_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
||||
|
||||
/* If item was not visited during the mark phase, then this
|
||||
@@ -370,14 +499,15 @@ void janet_sweep() {
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
/* Free memory */
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
items[i].value = janet_wrap_false();
|
||||
janet_vm.threaded_abstracts.deleted++;
|
||||
janet_vm.threaded_abstracts.count--;
|
||||
}
|
||||
|
||||
/* Reset for next sweep */
|
||||
@@ -405,8 +535,15 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
|
||||
/* Prepend block to heap list */
|
||||
janet_vm.next_collection += size;
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
if (type < JANET_MEMORY_TABLE_WEAKK) {
|
||||
/* normal heap */
|
||||
mem->data.next = janet_vm.blocks;
|
||||
janet_vm.blocks = mem;
|
||||
} else {
|
||||
/* weak heap */
|
||||
mem->data.next = janet_vm.weak_blocks;
|
||||
janet_vm.weak_blocks = mem;
|
||||
}
|
||||
janet_vm.block_count++;
|
||||
|
||||
return (void *)mem;
|
||||
@@ -437,7 +574,8 @@ void janet_collect(void) {
|
||||
uint32_t i;
|
||||
if (janet_vm.gc_suspend) return;
|
||||
depth = JANET_RECURSION_GUARD;
|
||||
/* Try and prevent many major collections back to back.
|
||||
janet_vm.gc_mark_phase = 1;
|
||||
/* Try to prevent many major collections back to back.
|
||||
* A full collection will take O(janet_vm.block_count) time.
|
||||
* If we have a large heap, make sure our interval is not too
|
||||
* small so we won't make many collections over it. This is just a
|
||||
@@ -456,6 +594,7 @@ void janet_collect(void) {
|
||||
Janet x = janet_vm.roots[--janet_vm.root_count];
|
||||
janet_mark(x);
|
||||
}
|
||||
janet_vm.gc_mark_phase = 0;
|
||||
janet_sweep();
|
||||
janet_vm.next_collection = 0;
|
||||
janet_free_all_scratch();
|
||||
@@ -526,7 +665,7 @@ int janet_gcunrootall(Janet root) {
|
||||
void janet_clear_memory(void) {
|
||||
#ifdef JANET_EV
|
||||
JanetKV *items = janet_vm.threaded_abstracts.data;
|
||||
for (int32_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
for (size_t i = 0; i < janet_vm.threaded_abstracts.capacity; i++) {
|
||||
if (janet_checktype(items[i].key, JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(items[i].key);
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
@@ -559,7 +698,9 @@ void janet_gcunlock(int handle) {
|
||||
janet_vm.gc_suspend = handle;
|
||||
}
|
||||
|
||||
/* Scratch memory API */
|
||||
/* Scratch memory API
|
||||
* Scratch memory allocations do not need to be free (but optionally can be), and will be automatically cleaned
|
||||
* up in the next call to janet_collect. */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
JanetScratch *s = janet_malloc(sizeof(JanetScratch) + size);
|
||||
|
||||
@@ -57,6 +57,10 @@ enum JanetMemoryType {
|
||||
JANET_MEMORY_FUNCENV,
|
||||
JANET_MEMORY_FUNCDEF,
|
||||
JANET_MEMORY_THREADED_ABSTRACT,
|
||||
JANET_MEMORY_TABLE_WEAKK,
|
||||
JANET_MEMORY_TABLE_WEAKV,
|
||||
JANET_MEMORY_TABLE_WEAKKV,
|
||||
JANET_MEMORY_ARRAY_WEAK
|
||||
};
|
||||
|
||||
/* To allocate collectable memory, one must call janet_alloc, initialize the memory,
|
||||
|
||||
@@ -118,10 +118,9 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (int64_t)dbl;
|
||||
break;
|
||||
double d = janet_unwrap_number(x);
|
||||
if (!janet_checkint64range(d)) break;
|
||||
return (int64_t) d;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
int64_t value;
|
||||
@@ -147,12 +146,9 @@ uint64_t janet_unwrap_u64(Janet x) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
/* Allow negative values to be cast to "wrap around".
|
||||
* This let's addition and subtraction work as expected. */
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
return (uint64_t)dbl;
|
||||
break;
|
||||
double d = janet_unwrap_number(x);
|
||||
if (!janet_checkuint64range(d)) break;
|
||||
return (uint64_t) d;
|
||||
}
|
||||
case JANET_STRING: {
|
||||
uint64_t value;
|
||||
@@ -243,7 +239,7 @@ JANET_CORE_FN(cfun_to_bytes,
|
||||
"Write the bytes of an `int/s64` or `int/u64` into a buffer.\n"
|
||||
"The `buffer` parameter specifies an existing buffer to write to, if unset a new buffer will be created.\n"
|
||||
"Returns the modified buffer.\n"
|
||||
"The `endianness` paramater indicates the byte order:\n"
|
||||
"The `endianness` parameter indicates the byte order:\n"
|
||||
"- `nil` (unset): system byte order\n"
|
||||
"- `:le`: little-endian, least significant byte first\n"
|
||||
"- `:be`: big-endian, most significant byte first\n") {
|
||||
@@ -307,8 +303,8 @@ static int compare_double_double(double x, double y) {
|
||||
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
return 0;
|
||||
} else if ((y > JANET_INTMIN_DOUBLE) && (y < JANET_INTMAX_DOUBLE)) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
@@ -323,10 +319,10 @@ static int compare_int64_double(int64_t x, double y) {
|
||||
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
return 0;
|
||||
} else if (y < 0) {
|
||||
return 1;
|
||||
} else if ((y >= 0) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
} else if ((y >= 0) && (y < JANET_INTMAX_DOUBLE)) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) UINT64_MAX)) {
|
||||
@@ -339,8 +335,9 @@ static int compare_uint64_double(uint64_t x, double y) {
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64)
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64) {
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
}
|
||||
int64_t x = janet_unwrap_s64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
@@ -355,7 +352,6 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
int64_t y = *(int64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_u64_type) {
|
||||
// comparing signed to unsigned -- be careful!
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
if (x < 0) {
|
||||
return janet_wrap_number(-1);
|
||||
@@ -374,8 +370,9 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) // is this needed?
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) {
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
}
|
||||
uint64_t x = janet_unwrap_u64(argv[0]);
|
||||
switch (janet_type(argv[1])) {
|
||||
default:
|
||||
@@ -390,7 +387,6 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
uint64_t y = *(uint64_t *)abst;
|
||||
return janet_wrap_number((x < y) ? -1 : (x > y ? 1 : 0));
|
||||
} else if (janet_abstract_type(abst) == &janet_s64_type) {
|
||||
// comparing unsigned to signed -- be careful!
|
||||
int64_t y = *(int64_t *)abst;
|
||||
if (y < 0) {
|
||||
return janet_wrap_number(1);
|
||||
@@ -431,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -440,6 +436,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define UNARYMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVZERO(name) DIVZERO_##name
|
||||
#define DIVZERO_div janet_panic("division by zero")
|
||||
#define DIVZERO_rem janet_panic("division by zero")
|
||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
@@ -447,19 +456,19 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
@@ -471,7 +480,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
for (int32_t i = 1; i < argc; i++) { \
|
||||
T value = janet_unwrap_##type(argv[i]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
} \
|
||||
@@ -479,26 +488,50 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
T value = janet_unwrap_##type(argv[0]); \
|
||||
if (value == 0) janet_panic("division by zero"); \
|
||||
if (value == 0) DIVZERO(name); \
|
||||
if ((value == -1) && (*box == INT64_MIN)) janet_panic("INT64_MIN divided by -1"); \
|
||||
*box oper##= value; \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
if (op2 == 0) janet_panic("division by zero");
|
||||
int64_t x = op1 / op2;
|
||||
*box = x - (((op1 ^ op2) < 0) && (x * op2 != op1));
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op2 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
@@ -507,37 +540,43 @@ static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
int64_t op1 = janet_unwrap_s64(argv[1]);
|
||||
int64_t x = op1 % op2;
|
||||
*box = (op1 > 0)
|
||||
? ((op2 > 0) ? x : (0 == x ? x : x + op2))
|
||||
: ((op2 > 0) ? (0 == x ? x : x + op2) : x);
|
||||
if (op2 == 0) {
|
||||
*box = op1;
|
||||
} else {
|
||||
int64_t x = op1 % op2;
|
||||
*box = (((op1 ^ op2) < 0) && (x != 0)) ? x + op2 : x;
|
||||
}
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
OPMETHOD(int64_t, s64, add, +)
|
||||
OPMETHOD(int64_t, s64, sub, -)
|
||||
OPMETHODINVERT(int64_t, s64, subi, -)
|
||||
OPMETHODINVERT(int64_t, s64, sub, -)
|
||||
OPMETHOD(int64_t, s64, mul, *)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHOD_SIGNED(int64_t, s64, rem, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, divi, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, remi, %)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, div, /)
|
||||
DIVMETHODINVERT_SIGNED(int64_t, s64, rem, %)
|
||||
OPMETHOD(int64_t, s64, and, &)
|
||||
OPMETHOD(int64_t, s64, or, |)
|
||||
OPMETHOD(int64_t, s64, xor, ^)
|
||||
UNARYMETHOD(int64_t, s64, not, ~)
|
||||
OPMETHOD(int64_t, s64, lshift, <<)
|
||||
OPMETHOD(int64_t, s64, rshift, >>)
|
||||
OPMETHOD(uint64_t, u64, add, +)
|
||||
OPMETHOD(uint64_t, u64, sub, -)
|
||||
OPMETHODINVERT(uint64_t, u64, subi, -)
|
||||
OPMETHODINVERT(uint64_t, u64, sub, -)
|
||||
OPMETHOD(uint64_t, u64, mul, *)
|
||||
DIVMETHOD(uint64_t, u64, div, /)
|
||||
DIVMETHOD(uint64_t, u64, rem, %)
|
||||
DIVMETHOD(uint64_t, u64, mod, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, divi, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, modi, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, div, /)
|
||||
DIVMETHODINVERT(uint64_t, u64, rem, %)
|
||||
DIVMETHODINVERT(uint64_t, u64, mod, %)
|
||||
OPMETHOD(uint64_t, u64, and, &)
|
||||
OPMETHOD(uint64_t, u64, or, |)
|
||||
OPMETHOD(uint64_t, u64, xor, ^)
|
||||
UNARYMETHOD(uint64_t, u64, not, ~)
|
||||
OPMETHOD(uint64_t, u64, lshift, <<)
|
||||
OPMETHOD(uint64_t, u64, rshift, >>)
|
||||
|
||||
@@ -555,6 +594,8 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r*", cfun_it_s64_mul},
|
||||
{"/", cfun_it_s64_div},
|
||||
{"r/", cfun_it_s64_divi},
|
||||
{"div", cfun_it_s64_divf},
|
||||
{"rdiv", cfun_it_s64_divfi},
|
||||
{"mod", cfun_it_s64_mod},
|
||||
{"rmod", cfun_it_s64_modi},
|
||||
{"%", cfun_it_s64_rem},
|
||||
@@ -565,6 +606,7 @@ static JanetMethod it_s64_methods[] = {
|
||||
{"r|", cfun_it_s64_or},
|
||||
{"^", cfun_it_s64_xor},
|
||||
{"r^", cfun_it_s64_xor},
|
||||
{"~", cfun_it_s64_not},
|
||||
{"<<", cfun_it_s64_lshift},
|
||||
{">>", cfun_it_s64_rshift},
|
||||
{"compare", cfun_it_s64_compare},
|
||||
@@ -580,16 +622,19 @@ static JanetMethod it_u64_methods[] = {
|
||||
{"r*", cfun_it_u64_mul},
|
||||
{"/", cfun_it_u64_div},
|
||||
{"r/", cfun_it_u64_divi},
|
||||
{"div", cfun_it_u64_div},
|
||||
{"rdiv", cfun_it_u64_divi},
|
||||
{"mod", cfun_it_u64_mod},
|
||||
{"rmod", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_mod},
|
||||
{"r%", cfun_it_u64_modi},
|
||||
{"%", cfun_it_u64_rem},
|
||||
{"r%", cfun_it_u64_remi},
|
||||
{"&", cfun_it_u64_and},
|
||||
{"r&", cfun_it_u64_and},
|
||||
{"|", cfun_it_u64_or},
|
||||
{"r|", cfun_it_u64_or},
|
||||
{"^", cfun_it_u64_xor},
|
||||
{"r^", cfun_it_u64_xor},
|
||||
{"~", cfun_it_u64_not},
|
||||
{"<<", cfun_it_u64_lshift},
|
||||
{">>", cfun_it_u64_rshift},
|
||||
{"compare", cfun_it_u64_compare},
|
||||
|
||||
@@ -59,8 +59,7 @@ const JanetAbstractType janet_file_type = {
|
||||
/* Check arguments to fopen */
|
||||
static int32_t checkflags(const uint8_t *str) {
|
||||
int32_t flags = 0;
|
||||
int32_t i;
|
||||
int32_t len = janet_string_length(str);
|
||||
size_t len = janet_string_length(str);
|
||||
if (!len || len > 10)
|
||||
janet_panic("file mode must have a length between 1 and 10");
|
||||
switch (*str) {
|
||||
@@ -80,7 +79,7 @@ static int32_t checkflags(const uint8_t *str) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
break;
|
||||
}
|
||||
for (i = 1; i < len; i++) {
|
||||
for (size_t i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
janet_panicf("invalid flag %c, expected +, b, or n", str[i]);
|
||||
@@ -131,7 +130,7 @@ JANET_CORE_FN(cfun_io_temp,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_io_fopen,
|
||||
"(file/open path &opt mode)",
|
||||
"(file/open path &opt mode buffer-size)",
|
||||
"Open a file. `path` is an absolute or relative path, and "
|
||||
"`mode` is a set of flags indicating the mode to open the file in. "
|
||||
"`mode` is a keyword where each character represents a flag. If the file "
|
||||
@@ -143,8 +142,9 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
|
||||
"* b - open the file in binary mode (rather than text mode)\n\n"
|
||||
"* + - append to the file instead of overwriting it\n\n"
|
||||
"* n - error if the file cannot be opened instead of returning nil") {
|
||||
janet_arity(argc, 1, 2);
|
||||
"* n - error if the file cannot be opened instead of returning nil\n\n"
|
||||
"See fopen (<stdio.h>, C99) for further details.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int32_t flags;
|
||||
@@ -157,6 +157,15 @@ JANET_CORE_FN(cfun_io_fopen,
|
||||
flags = JANET_FILE_READ;
|
||||
}
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
if (f != NULL) {
|
||||
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
|
||||
if (bufsize != BUFSIZ) {
|
||||
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);
|
||||
if (result) {
|
||||
janet_panic("failed to set buffer size for file");
|
||||
}
|
||||
}
|
||||
}
|
||||
return f ? janet_makefile(f, flags)
|
||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
||||
: janet_wrap_nil();
|
||||
@@ -194,11 +203,11 @@ JANET_CORE_FN(cfun_io_fread,
|
||||
} else {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
}
|
||||
int32_t bufstart = buffer->count;
|
||||
size_t bufstart = buffer->count;
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
int32_t sizeBefore;
|
||||
size_t sizeBefore;
|
||||
do {
|
||||
sizeBefore = buffer->count;
|
||||
read_chunk(iof, buffer, 4096);
|
||||
@@ -479,7 +488,7 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
}
|
||||
}
|
||||
for (int32_t i = offset; i < argc; ++i) {
|
||||
int32_t len;
|
||||
size_t len;
|
||||
const uint8_t *vstr;
|
||||
if (janet_checktype(argv[i], JANET_BUFFER)) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(argv[i]);
|
||||
@@ -504,7 +513,6 @@ static Janet cfun_io_print_impl_x(int32_t argc, Janet *argv, int newline,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
Janet x = janet_dyn(name);
|
||||
|
||||
218
src/core/marsh.c
218
src/core/marsh.c
@@ -96,12 +96,12 @@ static Janet entry_getval(Janet env_entry) {
|
||||
/* Merge values from an environment into an existing lookup table. */
|
||||
void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
|
||||
while (env) {
|
||||
for (int32_t i = 0; i < env->capacity; i++) {
|
||||
for (size_t i = 0; i < env->capacity; i++) {
|
||||
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
|
||||
if (prefix) {
|
||||
int32_t prelen = (int32_t) strlen(prefix);
|
||||
size_t prelen = strlen(prefix);
|
||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
||||
int32_t oldlen = janet_string_length(oldsym);
|
||||
size_t oldlen = janet_string_length(oldsym);
|
||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
||||
safe_memcpy(symbuf, prefix, prelen);
|
||||
safe_memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
@@ -154,11 +154,11 @@ static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
static void pushpointer(MarshalState *st, void *ptr) {
|
||||
static void pushpointer(MarshalState *st, const void *ptr) {
|
||||
janet_buffer_push_bytes(st->buf, (const uint8_t *) &ptr, sizeof(ptr));
|
||||
}
|
||||
|
||||
/* Marshal a size_t onto the buffer */
|
||||
/* Marshal a uint64_t onto the buffer */
|
||||
static void push64(MarshalState *st, uint64_t x) {
|
||||
if (x <= 0xF0) {
|
||||
/* Single byte */
|
||||
@@ -176,6 +176,11 @@ static void push64(MarshalState *st, uint64_t x) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Marshal a size_t onto the buffer */
|
||||
static void pushsize(MarshalState *st, size_t x) {
|
||||
push64(st, (uint64_t)x);
|
||||
}
|
||||
|
||||
/* Forward declaration to enable mutual recursion. */
|
||||
static void marshal_one(MarshalState *st, Janet x, int flags);
|
||||
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags);
|
||||
@@ -185,6 +190,19 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags);
|
||||
/* Prevent stack overflows */
|
||||
#define MARSH_STACKCHECK if ((flags & 0xFFFF) > JANET_RECURSION_GUARD) janet_panic("stack overflow")
|
||||
|
||||
/* Quick check if a fiber cannot be marshalled. This is will
|
||||
* have no false positives, but may have false negatives. */
|
||||
static int fiber_cannot_be_marshalled(JanetFiber *fiber) {
|
||||
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE) return 1;
|
||||
size_t i = fiber->frame;
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (!frame->func) return 1; /* has cfunction on stack */
|
||||
i = frame->prevframe;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Marshal a function env */
|
||||
static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
@@ -197,7 +215,9 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
|
||||
}
|
||||
janet_env_valid(env);
|
||||
janet_v_push(st->seen_envs, env);
|
||||
if (env->offset > 0 && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
|
||||
|
||||
/* Special case for early detachment */
|
||||
if (env->offset > 0 && fiber_cannot_be_marshalled(env->as.fiber)) {
|
||||
pushint(st, 0);
|
||||
pushint(st, env->length);
|
||||
Janet *values = env->as.fiber->data + env->offset;
|
||||
@@ -246,6 +266,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
/* Add to lookup */
|
||||
janet_v_push(st->seen_defs, def);
|
||||
|
||||
pushint(st, def->flags);
|
||||
pushint(st, def->slotcount);
|
||||
pushint(st, def->arity);
|
||||
@@ -266,14 +287,14 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal constants */
|
||||
for (int32_t i = 0; i < def->constants_length; i++)
|
||||
marshal_one(st, def->constants[i], flags);
|
||||
marshal_one(st, def->constants[i], flags + 1);
|
||||
|
||||
/* Marshal symbol map, if needed */
|
||||
for (int32_t i = 0; i < def->symbolmap_length; i++) {
|
||||
pushint(st, (int32_t) def->symbolmap[i].birth_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].death_pc);
|
||||
pushint(st, (int32_t) def->symbolmap[i].slot_index);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags);
|
||||
marshal_one(st, janet_wrap_symbol(def->symbolmap[i].symbol), flags + 1);
|
||||
}
|
||||
|
||||
/* marshal the bytecode */
|
||||
@@ -327,9 +348,9 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
while (i > 0) {
|
||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||
if (frame->env) frame->flags |= JANET_STACKFRAME_HASENV;
|
||||
if (!frame->func) janet_panic("cannot marshal fiber with c stackframe");
|
||||
if (!frame->func) janet_panicf("cannot marshal fiber with c stackframe (%v)", janet_wrap_cfunction((JanetCFunction) frame->pc));
|
||||
pushint(st, frame->flags);
|
||||
pushint(st, frame->prevframe);
|
||||
pushsize(st, frame->prevframe);
|
||||
int32_t pcdiff = (int32_t)(frame->pc - frame->func->def->bytecode);
|
||||
pushint(st, pcdiff);
|
||||
marshal_one(st, janet_wrap_function(frame->func), flags + 1);
|
||||
@@ -362,6 +383,15 @@ void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
||||
pushint(st, value);
|
||||
}
|
||||
|
||||
/* Only use in unsafe - don't marshal pointers otherwise */
|
||||
void janet_marshal_ptr(JanetMarshalContext *ctx, const void *ptr) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only marshal pointers in unsafe mode");
|
||||
}
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushpointer(st, ptr);
|
||||
}
|
||||
|
||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushbyte(st, value);
|
||||
@@ -378,18 +408,27 @@ void janet_marshal_janet(JanetMarshalContext *ctx, Janet x) {
|
||||
marshal_one(st, x, ctx->flags + 1);
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
Janet _check = janet_table_get(&st->seen, x); \
|
||||
if (!janet_checktype(_check, JANET_NIL)) janet_eprintf("double MARK_SEEN on %v\n", x); \
|
||||
janet_eprintf("made reference %d (%t) to %v\n", st->nextid, x, x); \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#else
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) { \
|
||||
janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); \
|
||||
} } while (0)
|
||||
#endif
|
||||
|
||||
void janet_marshal_abstract(JanetMarshalContext *ctx, void *abstract) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
if (st->maybe_cycles) {
|
||||
janet_table_put(&st->seen,
|
||||
janet_wrap_abstract(abstract),
|
||||
janet_wrap_integer(st->nextid++));
|
||||
}
|
||||
Janet x = janet_wrap_abstract(abstract);
|
||||
MARK_SEEN();
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
do { if (st->maybe_cycles) janet_table_put(&st->seen, x, janet_wrap_integer(st->nextid++)); } while (0)
|
||||
|
||||
static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
#ifdef JANET_EV
|
||||
@@ -411,7 +450,7 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
if (at->marshal) {
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL, at};
|
||||
JanetMarshalContext context = {st, NULL, flags + 1, NULL, at};
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("cannot marshal %p", x);
|
||||
@@ -461,7 +500,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
MARK_SEEN();
|
||||
const uint8_t *regname = janet_unwrap_symbol(check);
|
||||
pushbyte(st, LB_REGISTRY);
|
||||
pushint(st, janet_string_length(regname));
|
||||
pushsize(st, janet_string_length(regname));
|
||||
pushbytes(st, regname, janet_string_length(regname));
|
||||
return;
|
||||
}
|
||||
@@ -501,14 +540,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
int32_t length = janet_string_length(str);
|
||||
size_t length = janet_string_length(str);
|
||||
/* Record reference */
|
||||
MARK_SEEN();
|
||||
uint8_t lb = (type == JANET_STRING) ? LB_STRING :
|
||||
(type == JANET_SYMBOL) ? LB_SYMBOL :
|
||||
LB_KEYWORD;
|
||||
pushbyte(st, lb);
|
||||
pushint(st, length);
|
||||
pushsize(st, length);
|
||||
pushbytes(st, str, length);
|
||||
return;
|
||||
}
|
||||
@@ -520,34 +559,34 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
if ((flags & JANET_MARSHAL_UNSAFE) &&
|
||||
(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
pushbyte(st, LB_POINTER_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushint(st, buffer->capacity);
|
||||
pushsize(st, buffer->count);
|
||||
pushsize(st, buffer->capacity);
|
||||
pushpointer(st, buffer->data);
|
||||
return;
|
||||
}
|
||||
#endif
|
||||
pushbyte(st, LB_BUFFER);
|
||||
pushint(st, buffer->count);
|
||||
pushsize(st, buffer->count);
|
||||
pushbytes(st, buffer->data, buffer->count);
|
||||
return;
|
||||
}
|
||||
case JANET_ARRAY: {
|
||||
int32_t i;
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, LB_ARRAY);
|
||||
pushint(st, a->count);
|
||||
for (i = 0; i < a->count; i++)
|
||||
pushsize(st, a->count);
|
||||
for (size_t i = 0; i < a->count; i++)
|
||||
marshal_one(st, a->data[i], flags + 1);
|
||||
return;
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
int32_t i, count, flag;
|
||||
size_t i, count;
|
||||
int32_t flag;
|
||||
const Janet *tup = janet_unwrap_tuple(x);
|
||||
count = janet_tuple_length(tup);
|
||||
flag = janet_tuple_flag(tup) >> 16;
|
||||
pushbyte(st, LB_TUPLE);
|
||||
pushint(st, count);
|
||||
pushsize(st, count);
|
||||
pushint(st, flag);
|
||||
for (i = 0; i < count; i++)
|
||||
marshal_one(st, tup[i], flags + 1);
|
||||
@@ -559,10 +598,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
||||
pushint(st, t->count);
|
||||
pushsize(st, t->count);
|
||||
if (t->proto)
|
||||
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
||||
for (int32_t i = 0; i < t->capacity; i++) {
|
||||
for (size_t i = 0; i < t->capacity; i++) {
|
||||
if (janet_checktype(t->data[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, t->data[i].key, flags + 1);
|
||||
@@ -571,14 +610,14 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
return;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
int32_t count;
|
||||
size_t count;
|
||||
const JanetKV *struct_ = janet_unwrap_struct(x);
|
||||
count = janet_struct_length(struct_);
|
||||
pushbyte(st, janet_struct_proto(struct_) ? LB_STRUCT_PROTO : LB_STRUCT);
|
||||
pushint(st, count);
|
||||
pushsize(st, count);
|
||||
if (janet_struct_proto(struct_))
|
||||
marshal_one(st, janet_wrap_struct(janet_struct_proto(struct_)), flags + 1);
|
||||
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
||||
if (janet_checktype(struct_[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, struct_[i].key, flags + 1);
|
||||
@@ -728,9 +767,26 @@ static uint64_t read64(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
static size_t readsize(UnmarshalState *st, const uint8_t **atdata) {
|
||||
return (size_t)read64(st, atdata);
|
||||
}
|
||||
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
static void dump_reference_table(UnmarshalState *st) {
|
||||
for (int32_t i = 0; i < janet_v_count(st->lookup); i++) {
|
||||
janet_eprintf(" reference %d (%t) = %v\n", i, st->lookup[i], st->lookup[i]);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Assert a janet type */
|
||||
static void janet_asserttype(Janet x, JanetType t) {
|
||||
static void janet_asserttype(Janet x, JanetType t, UnmarshalState *st) {
|
||||
if (!janet_checktype(x, t)) {
|
||||
#ifdef JANET_MARSHAL_DEBUG
|
||||
dump_reference_table(st);
|
||||
#else
|
||||
(void) st;
|
||||
#endif
|
||||
janet_panicf("expected type %T, got %v", 1 << t, x);
|
||||
}
|
||||
}
|
||||
@@ -782,7 +838,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
Janet fiberv;
|
||||
/* On stack variant */
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Negative offset indicates untrusted input */
|
||||
env->offset = -offset;
|
||||
@@ -880,13 +936,13 @@ static const uint8_t *unmarshal_one_def(
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASNAME) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->name = janet_unwrap_string(x);
|
||||
}
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCE) {
|
||||
Janet x;
|
||||
data = unmarshal_one(st, data, &x, flags + 1);
|
||||
janet_asserttype(x, JANET_STRING);
|
||||
janet_asserttype(x, JANET_STRING, st);
|
||||
def->source = janet_unwrap_string(x);
|
||||
}
|
||||
|
||||
@@ -916,8 +972,9 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->symbolmap[i].slot_index = (uint32_t) readint(st, &data);
|
||||
Janet value;
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
if (!janet_checktype(value, JANET_SYMBOL))
|
||||
janet_panic("expected symbol in symbol map");
|
||||
if (!janet_checktype(value, JANET_SYMBOL)) {
|
||||
janet_panicf("corrupted symbolmap when unmarshalling debug info, got %v", value);
|
||||
}
|
||||
def->symbolmap[i].symbol = janet_unwrap_symbol(value);
|
||||
}
|
||||
def->symbolmap_length = (uint32_t) symbolmap_length;
|
||||
@@ -1015,9 +1072,11 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->env = NULL;
|
||||
fiber->last_value = janet_wrap_nil();
|
||||
#ifdef JANET_EV
|
||||
fiber->waiting = NULL;
|
||||
fiber->sched_id = 0;
|
||||
fiber->supervisor_channel = NULL;
|
||||
fiber->ev_state = NULL;
|
||||
fiber->ev_callback = NULL;
|
||||
fiber->ev_stream = NULL;
|
||||
#endif
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
@@ -1032,7 +1091,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
JanetTable *fiber_env = NULL;
|
||||
|
||||
/* Check for bad flags and ints */
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
if ((frame + JANET_FRAME_SIZE) > fiber_stackstart ||
|
||||
fiber_stackstart > fiber_stacktop ||
|
||||
fiber_stacktop > fiber_maxstack) {
|
||||
janet_panic("fiber has incorrect stack setup");
|
||||
@@ -1066,7 +1125,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
/* Get function */
|
||||
Janet funcv;
|
||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||
janet_asserttype(funcv, JANET_FUNCTION);
|
||||
janet_asserttype(funcv, JANET_FUNCTION, st);
|
||||
func = janet_unwrap_function(funcv);
|
||||
def = func->def;
|
||||
|
||||
@@ -1078,7 +1137,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
|
||||
/* Error checking */
|
||||
int32_t expected_framesize = def->slotcount;
|
||||
if (expected_framesize != stacktop - stack) {
|
||||
if (expected_framesize != (int32_t) stacktop - stack) {
|
||||
janet_panic("fiber stackframe size mismatch");
|
||||
}
|
||||
if (pcdiff >= def->bytecode_length) {
|
||||
@@ -1112,7 +1171,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet envv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
janet_asserttype(envv, JANET_TABLE, st);
|
||||
fiber_env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
@@ -1121,7 +1180,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet fiberv;
|
||||
fiber_flags &= ~JANET_FIBER_FLAG_HASCHILD;
|
||||
data = unmarshal_one(st, data, &fiberv, flags + 1);
|
||||
janet_asserttype(fiberv, JANET_FIBER);
|
||||
janet_asserttype(fiberv, JANET_FIBER, st);
|
||||
fiber->child = janet_unwrap_fiber(fiberv);
|
||||
}
|
||||
|
||||
@@ -1165,6 +1224,18 @@ int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
||||
return read64(st, &(ctx->data));
|
||||
}
|
||||
|
||||
void *janet_unmarshal_ptr(JanetMarshalContext *ctx) {
|
||||
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
|
||||
janet_panic("can only unmarshal pointers in unsafe mode");
|
||||
}
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
void *ptr;
|
||||
MARSH_EOS(st, ctx->data + sizeof(void *) - 1);
|
||||
memcpy((char *) &ptr, ctx->data, sizeof(void *));
|
||||
ctx->data += sizeof(void *);
|
||||
return ptr;
|
||||
}
|
||||
|
||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data);
|
||||
@@ -1200,6 +1271,18 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
|
||||
return p;
|
||||
}
|
||||
|
||||
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
|
||||
#ifdef JANET_THREADS
|
||||
void *p = janet_abstract_threaded(ctx->at, size);
|
||||
janet_unmarshal_abstract_reuse(ctx, p);
|
||||
return p;
|
||||
#else
|
||||
(void) ctx;
|
||||
(void) size;
|
||||
janet_panic("threaded abstracts not supported");
|
||||
#endif
|
||||
}
|
||||
|
||||
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
|
||||
Janet key;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
@@ -1207,7 +1290,9 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
if (at == NULL) janet_panic("unknown abstract type");
|
||||
if (at->unmarshal) {
|
||||
JanetMarshalContext context = {NULL, st, flags, data, at};
|
||||
*out = janet_wrap_abstract(at->unmarshal(&context));
|
||||
void *abst = at->unmarshal(&context);
|
||||
janet_assert(abst != NULL, "null pointer abstract");
|
||||
*out = janet_wrap_abstract(abst);
|
||||
if (context.at != NULL) {
|
||||
janet_panic("janet_unmarshal_abstract not called");
|
||||
}
|
||||
@@ -1279,7 +1364,7 @@ static const uint8_t *unmarshal_one(
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY: {
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
size_t len = readsize(st, &data);
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
if (lead == LB_STRING) {
|
||||
const uint8_t *str = janet_string(data, len);
|
||||
@@ -1308,7 +1393,7 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
case LB_FIBER: {
|
||||
JanetFiber *fiber;
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags);
|
||||
data = unmarshal_one_fiber(st, data + 1, &fiber, flags + 1);
|
||||
*out = janet_wrap_fiber(fiber);
|
||||
return data;
|
||||
}
|
||||
@@ -1323,6 +1408,9 @@ static const uint8_t *unmarshal_one(
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
len * sizeof(JanetFuncEnv));
|
||||
func->def = NULL;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
func->envs[i] = NULL;
|
||||
}
|
||||
*out = janet_wrap_function(func);
|
||||
janet_v_push(st->lookup, *out);
|
||||
data = unmarshal_one_def(st, data, &def, flags + 1);
|
||||
@@ -1337,6 +1425,14 @@ static const uint8_t *unmarshal_one(
|
||||
return unmarshal_one_abstract(st, data, out, flags);
|
||||
}
|
||||
case LB_REFERENCE:
|
||||
{
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
return data;
|
||||
}
|
||||
case LB_ARRAY:
|
||||
case LB_TUPLE:
|
||||
case LB_STRUCT:
|
||||
@@ -1346,7 +1442,7 @@ static const uint8_t *unmarshal_one(
|
||||
/* Things that open with integers */
|
||||
{
|
||||
data++;
|
||||
int32_t len = readnat(st, &data);
|
||||
size_t len = readsize(st, &data);
|
||||
/* DOS check */
|
||||
if (lead != LB_REFERENCE) {
|
||||
MARSH_EOS(st, data - 1 + len);
|
||||
@@ -1357,7 +1453,7 @@ static const uint8_t *unmarshal_one(
|
||||
array->count = len;
|
||||
*out = janet_wrap_array(array);
|
||||
janet_v_push(st->lookup, *out);
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one(st, data, array->data + i, flags + 1);
|
||||
}
|
||||
} else if (lead == LB_TUPLE) {
|
||||
@@ -1365,7 +1461,7 @@ static const uint8_t *unmarshal_one(
|
||||
Janet *tup = janet_tuple_begin(len);
|
||||
int32_t flag = readint(st, &data);
|
||||
janet_tuple_flag(tup) |= flag << 16;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one(st, data, tup + i, flags + 1);
|
||||
}
|
||||
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
||||
@@ -1376,10 +1472,10 @@ static const uint8_t *unmarshal_one(
|
||||
if (lead == LB_STRUCT_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_STRUCT);
|
||||
janet_asserttype(proto, JANET_STRUCT, st);
|
||||
janet_struct_proto(struct_) = janet_unwrap_struct(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
Janet key, value;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
@@ -1387,10 +1483,6 @@ static const uint8_t *unmarshal_one(
|
||||
}
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
/* Table */
|
||||
JanetTable *t = janet_table(len);
|
||||
@@ -1399,10 +1491,10 @@ static const uint8_t *unmarshal_one(
|
||||
if (lead == LB_TABLE_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
janet_asserttype(proto, JANET_TABLE);
|
||||
janet_asserttype(proto, JANET_TABLE, st);
|
||||
t->proto = janet_unwrap_table(proto);
|
||||
}
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
Janet key, value;
|
||||
data = unmarshal_one(st, data, &key, flags + 1);
|
||||
data = unmarshal_one(st, data, &value, flags + 1);
|
||||
@@ -1432,8 +1524,8 @@ static const uint8_t *unmarshal_one(
|
||||
#ifdef JANET_EV
|
||||
case LB_POINTER_BUFFER: {
|
||||
data++;
|
||||
int32_t count = readnat(st, &data);
|
||||
int32_t capacity = readnat(st, &data);
|
||||
size_t count = readsize(st, &data);
|
||||
size_t capacity = readsize(st, &data);
|
||||
MARSH_EOS(st, data + sizeof(void *));
|
||||
union {
|
||||
void *ptr;
|
||||
|
||||
@@ -81,9 +81,9 @@ void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||
for (int i = 0; i < 16; i++) janet_rng_u32(rng);
|
||||
}
|
||||
|
||||
void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len) {
|
||||
void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, size_t len) {
|
||||
uint8_t state[16] = {0};
|
||||
for (int32_t i = 0; i < len; i++)
|
||||
for (size_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);
|
||||
@@ -119,7 +119,7 @@ double janet_rng_double(JanetRNG *rng) {
|
||||
|
||||
JANET_CORE_FN(cfun_rng_make,
|
||||
"(math/rng &opt seed)",
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"Creates a Pseudo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer or a buffer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type."
|
||||
) {
|
||||
@@ -411,11 +411,11 @@ void janet_lib_math(JanetTable *env) {
|
||||
JANET_CORE_DEF(env, "math/int32-min", janet_wrap_number(INT32_MIN),
|
||||
"The minimum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int32-max", janet_wrap_number(INT32_MAX),
|
||||
"The maximum contiguous integer represtenable by a 32 bit signed integer");
|
||||
"The maximum contiguous integer representable by a 32 bit signed integer");
|
||||
JANET_CORE_DEF(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
|
||||
"The minimum contiguous integer representable by a double (2^53)");
|
||||
JANET_CORE_DEF(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
|
||||
"The maximum contiguous integer represtenable by a double (-(2^53))");
|
||||
"The maximum contiguous integer representable by a double (-(2^53))");
|
||||
#ifdef NAN
|
||||
JANET_CORE_DEF(env, "math/nan", janet_wrap_number(NAN), "Not a number (IEEE-754 NaN)");
|
||||
#else
|
||||
|
||||
171
src/core/net.c
171
src/core/net.c
@@ -24,6 +24,7 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NET
|
||||
@@ -78,12 +79,20 @@ const JanetAbstractType janet_address_type = {
|
||||
|
||||
/* maximum number of bytes in a socket address host (post name resolution) */
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_NO_IPV6
|
||||
#define SA_ADDRSTRLEN (INET_ADDRSTRLEN + 1)
|
||||
#else
|
||||
#define SA_ADDRSTRLEN (INET6_ADDRSTRLEN + 1)
|
||||
#endif
|
||||
typedef unsigned short in_port_t;
|
||||
#else
|
||||
#define JANET_SA_MAX(a, b) (((a) > (b))? (a) : (b))
|
||||
#ifdef JANET_NO_IPV6
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#else
|
||||
#define SA_ADDRSTRLEN JANET_SA_MAX(INET6_ADDRSTRLEN + 1, (sizeof ((struct sockaddr_un *)0)->sun_path) + 1)
|
||||
#endif
|
||||
#endif
|
||||
|
||||
static JanetStream *make_stream(JSock handle, uint32_t flags);
|
||||
|
||||
@@ -111,12 +120,57 @@ static void janet_net_socknoblock(JSock s) {
|
||||
#endif
|
||||
}
|
||||
|
||||
/* State machine for async connect */
|
||||
|
||||
void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
#ifndef JANET_WINDOWS
|
||||
/* Wait until we have an actual event before checking.
|
||||
* Windows doesn't support async connect with this, just try immediately.*/
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
#endif
|
||||
case JANET_ASYNC_EVENT_DEINIT:
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_cancel(fiber, janet_cstringv("stream closed"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
int res = 0;
|
||||
int size = sizeof(res);
|
||||
int r = getsockopt((SOCKET)stream->handle, SOL_SOCKET, SO_ERROR, (char *)&res, &size);
|
||||
#else
|
||||
int res = 0;
|
||||
socklen_t size = sizeof res;
|
||||
int r = getsockopt(stream->handle, SOL_SOCKET, SO_ERROR, &res, &size);
|
||||
#endif
|
||||
if (r == 0) {
|
||||
if (res == 0) {
|
||||
janet_schedule(fiber, janet_wrap_abstract(stream));
|
||||
} else {
|
||||
janet_cancel(fiber, janet_cstringv(strerror(res)));
|
||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||
}
|
||||
} else {
|
||||
janet_cancel(fiber, janet_ev_lasterr());
|
||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||
}
|
||||
janet_async_end(fiber);
|
||||
}
|
||||
|
||||
static JANET_NO_RETURN void net_sched_connect(JanetStream *stream) {
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_WRITE, net_callback_connect, NULL);
|
||||
}
|
||||
|
||||
/* State machine for accepting connections. */
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
WSAOVERLAPPED overlapped;
|
||||
JanetFunction *function;
|
||||
JanetStream *lstream;
|
||||
@@ -124,10 +178,10 @@ typedef struct {
|
||||
char buf[1024];
|
||||
} NetStateAccept;
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err);
|
||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err);
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
@@ -138,55 +192,60 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
if (state->astream->flags & JANET_STREAM_CLOSED) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
if (NO_ERROR != setsockopt((SOCKET) state->astream->handle, SOL_SOCKET, SO_UPDATE_ACCEPT_CONTEXT,
|
||||
(char *) &lsock, sizeof(lsock))) {
|
||||
janet_cancel(s->fiber, janet_cstringv("failed to accept connection"));
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_cancel(fiber, janet_cstringv("failed to accept connection"));
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
|
||||
Janet streamv = janet_wrap_abstract(state->astream);
|
||||
if (state->function) {
|
||||
/* Schedule worker */
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
||||
/* Now listen again for next connection */
|
||||
Janet err;
|
||||
if (net_sched_accept_impl(state, &err)) {
|
||||
janet_cancel(s->fiber, err);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
if (net_sched_accept_impl(state, fiber, &err)) {
|
||||
janet_cancel(fiber, err);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, streamv);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
Janet err;
|
||||
JanetListenerState *s = janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
||||
memset(&state->overlapped, 0, sizeof(WSAOVERLAPPED));
|
||||
memset(&state->buf, 0, 1024);
|
||||
state->function = fun;
|
||||
state->lstream = stream;
|
||||
s->tag = &state->overlapped;
|
||||
if (net_sched_accept_impl(state, &err)) janet_panicv(err);
|
||||
janet_await();
|
||||
if (net_sched_accept_impl(state, janet_root_fiber(), &err)) {
|
||||
janet_free(state);
|
||||
janet_panicv(err);
|
||||
}
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
||||
}
|
||||
|
||||
static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||
static int net_sched_accept_impl(NetStateAccept *state, JanetFiber *fiber, Janet *err) {
|
||||
SOCKET lsock = (SOCKET) state->lstream->handle;
|
||||
SOCKET asock = WSASocketW(AF_INET, SOCK_STREAM, IPPROTO_TCP, NULL, 0, WSA_FLAG_OVERLAPPED);
|
||||
if (asock == INVALID_SOCKET) {
|
||||
@@ -198,7 +257,11 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||
int socksize = sizeof(SOCKADDR_STORAGE) + 16;
|
||||
if (FALSE == AcceptEx(lsock, asock, state->buf, 0, socksize, socksize, NULL, &state->overlapped)) {
|
||||
int code = WSAGetLastError();
|
||||
if (code == WSA_IO_PENDING) return 0; /* indicates io is happening async */
|
||||
if (code == WSA_IO_PENDING) {
|
||||
/* indicates io is happening async */
|
||||
janet_async_in_flight(fiber);
|
||||
return 0;
|
||||
}
|
||||
*err = janet_ev_lasterr();
|
||||
return 1;
|
||||
}
|
||||
@@ -208,12 +271,12 @@ static int net_sched_accept_impl(NetStateAccept *state, Janet *err) {
|
||||
#else
|
||||
|
||||
typedef struct {
|
||||
JanetListenerState head;
|
||||
JanetFunction *function;
|
||||
} NetStateAccept;
|
||||
|
||||
JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event) {
|
||||
NetStateAccept *state = (NetStateAccept *)s;
|
||||
void net_callback_accept(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
NetStateAccept *state = (NetStateAccept *)fiber->ev_state;
|
||||
switch (event) {
|
||||
default:
|
||||
break;
|
||||
@@ -222,41 +285,43 @@ JanetAsyncStatus net_machine_accept(JanetListenerState *s, JanetAsyncEvent event
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(s->fiber, janet_wrap_nil());
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
#if defined(JANET_LINUX)
|
||||
JSock connfd = accept4(s->stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
JSock connfd = accept4(stream->handle, NULL, NULL, SOCK_CLOEXEC);
|
||||
#else
|
||||
/* On BSDs, CLOEXEC should be inherited from server socket */
|
||||
JSock connfd = accept(s->stream->handle, NULL, NULL);
|
||||
JSock connfd = accept(stream->handle, NULL, NULL);
|
||||
#endif
|
||||
if (JSOCKVALID(connfd)) {
|
||||
janet_net_socknoblock(connfd);
|
||||
JanetStream *stream = make_stream(connfd, JANET_STREAM_READABLE | JANET_STREAM_WRITABLE);
|
||||
Janet streamv = janet_wrap_abstract(stream);
|
||||
if (state->function) {
|
||||
JanetFiber *fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
fiber->supervisor_channel = s->fiber->supervisor_channel;
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
JanetFiber *sub_fiber = janet_fiber(state->function, 64, 1, &streamv);
|
||||
sub_fiber->supervisor_channel = fiber->supervisor_channel;
|
||||
janet_schedule(sub_fiber, janet_wrap_nil());
|
||||
} else {
|
||||
janet_schedule(s->fiber, streamv);
|
||||
return JANET_ASYNC_STATUS_DONE;
|
||||
janet_schedule(fiber, streamv);
|
||||
janet_async_end(fiber);
|
||||
return;
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
return JANET_ASYNC_STATUS_NOT_DONE;
|
||||
}
|
||||
|
||||
JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunction *fun) {
|
||||
NetStateAccept *state = (NetStateAccept *) janet_listen(stream, net_machine_accept, JANET_ASYNC_LISTEN_READ, sizeof(NetStateAccept), NULL);
|
||||
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
|
||||
memset(state, 0, sizeof(NetStateAccept));
|
||||
state->function = fun;
|
||||
janet_await();
|
||||
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
|
||||
}
|
||||
|
||||
|
||||
#endif
|
||||
|
||||
/* Adress info */
|
||||
@@ -417,7 +482,6 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
/* Create socket */
|
||||
JSock sock = JSOCKDEFAULT;
|
||||
void *addr = NULL;
|
||||
@@ -498,7 +562,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
}
|
||||
#endif
|
||||
|
||||
if (status != 0) {
|
||||
if (status) {
|
||||
#ifdef JANET_WINDOWS
|
||||
if (err != WSAEWOULDBLOCK) {
|
||||
#else
|
||||
@@ -510,10 +574,7 @@ JANET_CORE_FN(cfun_net_connect,
|
||||
}
|
||||
}
|
||||
|
||||
/* Handle the connect() result in the event loop*/
|
||||
janet_ev_connect(stream, MSG_NOSIGNAL);
|
||||
|
||||
janet_await();
|
||||
net_sched_connect(stream);
|
||||
}
|
||||
|
||||
static const char *serverify_socket(JSock sfd) {
|
||||
@@ -684,6 +745,7 @@ static Janet janet_so_getname(const void *sa_any) {
|
||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai->sin_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||
}
|
||||
#ifndef JANET_NO_IPV6
|
||||
case AF_INET6: {
|
||||
const struct sockaddr_in6 *sai6 = sa_any;
|
||||
if (!inet_ntop(AF_INET6, &(sai6->sin6_addr), buffer, sizeof(buffer))) {
|
||||
@@ -692,6 +754,7 @@ static Janet janet_so_getname(const void *sa_any) {
|
||||
Janet pair[2] = {janet_cstringv(buffer), janet_wrap_integer(ntohs(sai6->sin6_port))};
|
||||
return janet_wrap_tuple(janet_tuple_n(pair, 2));
|
||||
}
|
||||
#endif
|
||||
#ifndef JANET_WINDOWS
|
||||
case AF_UNIX: {
|
||||
const struct sockaddr_un *sun = sa_any;
|
||||
@@ -758,6 +821,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
|
||||
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
|
||||
janet_stream_flags(stream, JANET_STREAM_ACCEPTABLE | JANET_STREAM_SOCKET);
|
||||
JanetFunction *fun = janet_getfunction(argv, 1);
|
||||
if (fun->def->min_arity < 1) janet_panic("handler function must take at least 1 argument");
|
||||
janet_sched_accept(stream, fun);
|
||||
}
|
||||
|
||||
@@ -794,7 +858,6 @@ JANET_CORE_FN(cfun_stream_read,
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_chunk,
|
||||
@@ -809,7 +872,6 @@ JANET_CORE_FN(cfun_stream_chunk,
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvchunk(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_recv_from,
|
||||
@@ -824,7 +886,6 @@ JANET_CORE_FN(cfun_stream_recv_from,
|
||||
double to = janet_optnumber(argv, argc, 3, INFINITY);
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_recvfrom(stream, buffer, n, MSG_NOSIGNAL);
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_write,
|
||||
@@ -844,7 +905,6 @@ JANET_CORE_FN(cfun_stream_write,
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_send_string(stream, bytes.bytes, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_send_to,
|
||||
@@ -865,7 +925,6 @@ JANET_CORE_FN(cfun_stream_send_to,
|
||||
if (to != INFINITY) janet_addtimeout(to);
|
||||
janet_ev_sendto_string(stream, bytes.bytes, dest, MSG_NOSIGNAL);
|
||||
}
|
||||
janet_await();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_stream_flush,
|
||||
@@ -899,8 +958,10 @@ static const struct sockopt_type sockopt_type_list[] = {
|
||||
{ "ip-multicast-ttl", IPPROTO_IP, IP_MULTICAST_TTL, JANET_NUMBER },
|
||||
{ "ip-add-membership", IPPROTO_IP, IP_ADD_MEMBERSHIP, JANET_POINTER },
|
||||
{ "ip-drop-membership", IPPROTO_IP, IP_DROP_MEMBERSHIP, JANET_POINTER },
|
||||
#ifndef JANET_NO_IPV6
|
||||
{ "ipv6-join-group", IPPROTO_IPV6, IPV6_JOIN_GROUP, JANET_POINTER },
|
||||
{ "ipv6-leave-group", IPPROTO_IPV6, IPV6_LEAVE_GROUP, JANET_POINTER },
|
||||
#endif
|
||||
{ NULL, 0, 0, JANET_POINTER }
|
||||
};
|
||||
|
||||
@@ -937,7 +998,9 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||
union {
|
||||
int v_int;
|
||||
struct ip_mreq v_mreq;
|
||||
#ifndef JANET_NO_IPV6
|
||||
struct ipv6_mreq v_mreq6;
|
||||
#endif
|
||||
} val;
|
||||
|
||||
void *optval = (void *)&val;
|
||||
@@ -955,12 +1018,14 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
||||
val.v_mreq.imr_interface.s_addr = htonl(INADDR_ANY);
|
||||
inet_pton(AF_INET, addr, &val.v_mreq.imr_multiaddr.s_addr);
|
||||
optlen = sizeof(val.v_mreq);
|
||||
#ifndef JANET_NO_IPV6
|
||||
} else if (st->optname == IPV6_JOIN_GROUP || st->optname == IPV6_LEAVE_GROUP) {
|
||||
const char *addr = janet_getcstring(argv, 2);
|
||||
memset(&val.v_mreq6, 0, sizeof val.v_mreq6);
|
||||
val.v_mreq6.ipv6mr_interface = 0;
|
||||
inet_pton(AF_INET6, addr, &val.v_mreq6.ipv6mr_multiaddr);
|
||||
optlen = sizeof(val.v_mreq6);
|
||||
#endif
|
||||
} else {
|
||||
janet_panicf("invalid socket option type");
|
||||
}
|
||||
|
||||
377
src/core/os.c
377
src/core/os.c
@@ -229,10 +229,11 @@ JANET_CORE_FN(os_compiler,
|
||||
#undef janet_stringify
|
||||
|
||||
JANET_CORE_FN(os_exit,
|
||||
"(os/exit &opt x)",
|
||||
"(os/exit &opt x force)",
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
"the exit with status equal the hash of x. If `force` is truthy will exit immediately and "
|
||||
"skip cleanup code.") {
|
||||
janet_arity(argc, 0, 2);
|
||||
int status;
|
||||
if (argc == 0) {
|
||||
status = EXIT_SUCCESS;
|
||||
@@ -242,7 +243,11 @@ JANET_CORE_FN(os_exit,
|
||||
status = EXIT_FAILURE;
|
||||
}
|
||||
janet_deinit();
|
||||
exit(status);
|
||||
if (argc >= 2 && janet_truthy(argv[1])) {
|
||||
_exit(status);
|
||||
} else {
|
||||
exit(status);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -289,7 +294,6 @@ JANET_CORE_FN(os_cpu_count,
|
||||
#endif
|
||||
}
|
||||
|
||||
|
||||
#ifndef JANET_NO_PROCESSES
|
||||
|
||||
/* Get env for os_execute */
|
||||
@@ -305,7 +309,7 @@ static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
|
||||
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||
#ifdef JANET_WINDOWS
|
||||
JanetBuffer *temp = janet_buffer(10);
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
for (size_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
@@ -321,26 +325,26 @@ static EnvBlock os_execute_env(int32_t argc, const Janet *argv) {
|
||||
memcpy(ret, temp->data, temp->count);
|
||||
return ret;
|
||||
#else
|
||||
char **envp = janet_smalloc(sizeof(char *) * ((size_t)dict.len + 1));
|
||||
char **envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
for (size_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||
int32_t klen = janet_string_length(keys);
|
||||
int32_t vlen = janet_string_length(vals);
|
||||
size_t klen = janet_string_length(keys);
|
||||
size_t vlen = janet_string_length(vals);
|
||||
/* Check keys has no embedded 0s or =s. */
|
||||
int skip = 0;
|
||||
for (int32_t k = 0; k < klen; k++) {
|
||||
for (size_t k = 0; k < klen; k++) {
|
||||
if (keys[k] == '\0' || keys[k] == '=') {
|
||||
skip = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (skip) continue;
|
||||
char *envitem = janet_smalloc((size_t) klen + (size_t) vlen + 2);
|
||||
char *envitem = janet_smalloc(klen + vlen + 2);
|
||||
memcpy(envitem, keys, klen);
|
||||
envitem[klen] = '=';
|
||||
memcpy(envitem + klen + 1, vals, vlen);
|
||||
@@ -376,7 +380,7 @@ static void os_execute_cleanup(EnvBlock envp, const char **child_argv) {
|
||||
* a single string of this format. Returns a buffer that can be cast into a c string. */
|
||||
static JanetBuffer *os_exec_escape(JanetView args) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < args.len; i++) {
|
||||
for (size_t i = 0; i < args.len; i++) {
|
||||
const char *arg = janet_getcstring(args.items, i);
|
||||
|
||||
/* Push leading space if not first */
|
||||
@@ -501,8 +505,11 @@ static int proc_get_status(JanetProc *proc) {
|
||||
status = WEXITSTATUS(status);
|
||||
} else if (WIFSTOPPED(status)) {
|
||||
status = WSTOPSIG(status) + 128;
|
||||
} else {
|
||||
} else if (WIFSIGNALED(status)) {
|
||||
status = WTERMSIG(status) + 128;
|
||||
} else {
|
||||
/* Could possibly return -1 but for now, just panic */
|
||||
janet_panicf("Undefined status code for process termination, %d.", status);
|
||||
}
|
||||
return status;
|
||||
}
|
||||
@@ -518,7 +525,6 @@ static JanetEVGenericMessage janet_proc_wait_subr(JanetEVGenericMessage args) {
|
||||
|
||||
/* Callback that is called in main thread when subroutine completes. */
|
||||
static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
janet_ev_dec_refcount();
|
||||
JanetProc *proc = (JanetProc *) args.argp;
|
||||
if (NULL != proc) {
|
||||
int status = args.tag;
|
||||
@@ -531,7 +537,9 @@ static void janet_proc_wait_cb(JanetEVGenericMessage args) {
|
||||
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));
|
||||
if (janet_fiber_can_resume(args.fiber)) {
|
||||
janet_schedule(args.fiber, janet_wrap_integer(status));
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -613,7 +621,11 @@ os_proc_wait_impl(JanetProc *proc) {
|
||||
|
||||
JANET_CORE_FN(os_proc_wait,
|
||||
"(os/proc-wait proc)",
|
||||
"Block until the subprocess completes. Returns the subprocess return code.") {
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@@ -642,7 +654,7 @@ static const struct keyword_signal signal_keywords[] = {
|
||||
#ifdef SIGTERM
|
||||
{"term", SIGTERM},
|
||||
#endif
|
||||
#ifdef SIGARLM
|
||||
#ifdef SIGALRM
|
||||
{"alrm", SIGALRM},
|
||||
#endif
|
||||
#ifdef SIGHUP
|
||||
@@ -707,15 +719,28 @@ static const struct keyword_signal signal_keywords[] = {
|
||||
#endif
|
||||
{NULL, 0},
|
||||
};
|
||||
|
||||
static int get_signal_kw(const Janet *argv, int32_t n) {
|
||||
JanetKeyword signal_kw = janet_getkeyword(argv, n);
|
||||
const struct keyword_signal *ptr = signal_keywords;
|
||||
while (ptr->keyword) {
|
||||
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
|
||||
return ptr->signal;
|
||||
}
|
||||
ptr++;
|
||||
}
|
||||
janet_panicf("undefined signal %v", argv[n]);
|
||||
}
|
||||
#endif
|
||||
|
||||
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 `wait` is truthy, will wait for the process to finish and "
|
||||
"returns the exit code. 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.") {
|
||||
"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.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
if (proc->flags & JANET_PROC_WAITED) {
|
||||
@@ -732,18 +757,7 @@ JANET_CORE_FN(os_proc_kill,
|
||||
#else
|
||||
int signal = -1;
|
||||
if (argc == 3) {
|
||||
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
|
||||
const struct keyword_signal *ptr = signal_keywords;
|
||||
while (ptr->keyword) {
|
||||
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
|
||||
signal = ptr->signal;
|
||||
break;
|
||||
}
|
||||
ptr++;
|
||||
}
|
||||
if (signal == -1) {
|
||||
janet_panic("undefined signal");
|
||||
}
|
||||
signal = get_signal_kw(argv, 2);
|
||||
}
|
||||
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
||||
if (status) {
|
||||
@@ -765,8 +779,9 @@ JANET_CORE_FN(os_proc_kill,
|
||||
|
||||
JANET_CORE_FN(os_proc_close,
|
||||
"(os/proc-close proc)",
|
||||
"Wait on a process if it has not been waited on, and close pipes created by `os/spawn` "
|
||||
"if they have not been closed. Returns nil.") {
|
||||
"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.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetProc *proc = janet_getabstract(argv, 0, &ProcAT);
|
||||
#ifdef JANET_EV
|
||||
@@ -804,6 +819,106 @@ static void close_handle(JanetHandle handle) {
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
static void janet_signal_callback(JanetEVGenericMessage msg) {
|
||||
int sig = msg.tag;
|
||||
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
|
||||
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
|
||||
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
|
||||
/* Let another thread/process try to handle this */
|
||||
sigset_t set;
|
||||
sigemptyset(&set);
|
||||
sigaddset(&set, sig);
|
||||
#ifdef JANET_THREADS
|
||||
pthread_sigmask(SIG_BLOCK, &set, NULL);
|
||||
#else
|
||||
sigprocmask(SIG_BLOCK, &set, NULL);
|
||||
#endif
|
||||
raise(sig);
|
||||
return;
|
||||
}
|
||||
JanetFunction *handler = janet_unwrap_function(handlerv);
|
||||
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
|
||||
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
|
||||
}
|
||||
|
||||
static void janet_signal_trampoline_no_interrupt(int sig) {
|
||||
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
|
||||
JanetEVGenericMessage msg;
|
||||
memset(&msg, 0, sizeof(msg));
|
||||
msg.tag = sig;
|
||||
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
|
||||
}
|
||||
|
||||
static void janet_signal_trampoline(int sig) {
|
||||
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
|
||||
JanetEVGenericMessage msg;
|
||||
memset(&msg, 0, sizeof(msg));
|
||||
msg.tag = sig;
|
||||
msg.argi = 1;
|
||||
janet_interpreter_interrupt(NULL);
|
||||
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
|
||||
}
|
||||
#endif
|
||||
|
||||
JANET_CORE_FN(os_sigaction,
|
||||
"(os/sigaction which &opt handler interrupt-interpreter)",
|
||||
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
|
||||
"All signal handlers are the same as supported by `os/proc-kill`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
|
||||
janet_arity(argc, 1, 3);
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) argv;
|
||||
janet_panic("unsupported on this platform");
|
||||
#else
|
||||
/* TODO - per thread signal masks */
|
||||
int rc;
|
||||
int sig = get_signal_kw(argv, 0);
|
||||
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
|
||||
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
|
||||
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
|
||||
if (!janet_checktype(oldhandler, JANET_NIL)) {
|
||||
janet_gcunroot(oldhandler);
|
||||
}
|
||||
if (NULL != handler) {
|
||||
Janet handlerv = janet_wrap_function(handler);
|
||||
janet_gcroot(handlerv);
|
||||
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
|
||||
} else {
|
||||
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
|
||||
}
|
||||
struct sigaction action;
|
||||
sigset_t mask;
|
||||
sigaddset(&mask, sig);
|
||||
memset(&action, 0, sizeof(action));
|
||||
action.sa_flags |= SA_RESTART;
|
||||
if (can_interrupt) {
|
||||
#ifdef JANET_NO_INTERPRETER_INTERRUPT
|
||||
janet_panic("interpreter interrupt not enabled");
|
||||
#else
|
||||
action.sa_handler = janet_signal_trampoline;
|
||||
#endif
|
||||
} else {
|
||||
action.sa_handler = janet_signal_trampoline_no_interrupt;
|
||||
}
|
||||
action.sa_mask = mask;
|
||||
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
|
||||
sigset_t set;
|
||||
sigemptyset(&set);
|
||||
sigaddset(&set, sig);
|
||||
#ifdef JANET_THREADS
|
||||
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
|
||||
#else
|
||||
sigprocmask(SIG_UNBLOCK, &set, NULL);
|
||||
#endif
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
|
||||
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
|
||||
up by the calling function. If everything goes well, *handle is owned by the calling function,
|
||||
@@ -983,11 +1098,18 @@ static JanetFile *get_stdio_for_handle(JanetHandle handle, void *orig, int iswri
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
typedef enum {
|
||||
JANET_EXECUTE_EXECUTE,
|
||||
JANET_EXECUTE_SPAWN,
|
||||
JANET_EXECUTE_EXEC
|
||||
} JanetExecuteMode;
|
||||
|
||||
static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
int is_spawn = mode == JANET_EXECUTE_SPAWN;
|
||||
uint64_t flags = 0;
|
||||
if (argc > 1) {
|
||||
flags = janet_getflags(argv, 1, "epxd");
|
||||
@@ -1011,7 +1133,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
int pipe_owner_flags = (is_spawn && (flags & 0x8)) ? JANET_PROC_ALLOW_ZOMBIE : 0;
|
||||
|
||||
/* Get optional redirections */
|
||||
if (argc > 2) {
|
||||
if (argc > 2 && (mode != JANET_EXECUTE_EXEC)) {
|
||||
JanetDictView tab = janet_getdictionary(argv, 2);
|
||||
Janet maybe_stdin = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("in"));
|
||||
Janet maybe_stdout = janet_dictionary_get(tab.kvs, tab.cap, janet_ckeywordv("out"));
|
||||
@@ -1076,7 +1198,6 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
startupInfo.hStdInput = (HANDLE) _get_osfhandle(0);
|
||||
}
|
||||
|
||||
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
startupInfo.hStdOutput = pipe_out;
|
||||
} else if (new_out != JANET_HANDLE_NONE) {
|
||||
@@ -1125,20 +1246,40 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * ((size_t) exargs.len + 1));
|
||||
for (int32_t i = 0; i < exargs.len; i++)
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
|
||||
for (size_t i = 0; i < exargs.len; i++)
|
||||
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||
child_argv[exargs.len] = NULL;
|
||||
/* Coerce to form that works for spawn. I'm fairly confident no implementation
|
||||
* of posix_spawn would modify the argv array passed in. */
|
||||
char *const *cargv = (char *const *)child_argv;
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
if (use_environ) {
|
||||
janet_lock_environ();
|
||||
}
|
||||
|
||||
/* exec mode */
|
||||
if (mode == JANET_EXECUTE_EXEC) {
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported on windows");
|
||||
#else
|
||||
int status;
|
||||
if (!use_environ) {
|
||||
environ = envp;
|
||||
}
|
||||
do {
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = execvp(cargv[0], cargv);
|
||||
} else {
|
||||
status = execv(cargv[0], cargv);
|
||||
}
|
||||
} while (status == -1 && errno == EINTR);
|
||||
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
|
||||
/* Posix spawn setup */
|
||||
posix_spawn_file_actions_t actions;
|
||||
posix_spawn_file_actions_init(&actions);
|
||||
@@ -1147,14 +1288,16 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, int is_spawn) {
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_in);
|
||||
} else if (new_in != JANET_HANDLE_NONE && new_in != 0) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_in, 0);
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
if (new_in != new_out && new_in != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_in);
|
||||
}
|
||||
if (pipe_out != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, pipe_out);
|
||||
} else if (new_out != JANET_HANDLE_NONE && new_out != 1) {
|
||||
posix_spawn_file_actions_adddup2(&actions, new_out, 1);
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
if (new_out != new_err)
|
||||
posix_spawn_file_actions_addclose(&actions, new_out);
|
||||
}
|
||||
if (pipe_err != JANET_HANDLE_NONE) {
|
||||
posix_spawn_file_actions_adddup2(&actions, pipe_err, 2);
|
||||
@@ -1243,22 +1386,63 @@ JANET_CORE_FN(os_execute,
|
||||
"* :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. "
|
||||
"These arguments should be core/file values. "
|
||||
"Returns the exit status of the program.") {
|
||||
return os_execute_impl(argc, argv, 0);
|
||||
":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.") {
|
||||
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 to 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, :return-code, and "
|
||||
"the additional field :pid on unix-like platforms. Use `(os/proc-wait proc)` to rejoin the "
|
||||
"subprocess or `(os/proc-kill proc)`.") {
|
||||
return os_execute_impl(argc, argv, 1);
|
||||
"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.") {
|
||||
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 "
|
||||
"does not allow redirection of stdio.") {
|
||||
return os_execute_impl(argc, argv, JANET_EXECUTE_EXEC);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_posix_fork,
|
||||
"(os/posix-fork)",
|
||||
"Make a `fork` system call and create a new process. Return nil if in the new process, otherwise a core/process object (as returned by os/spawn). "
|
||||
"Not supported on all systems (POSIX only).") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_SUBPROCESS);
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
janet_panic("not supported");
|
||||
#else
|
||||
pid_t result;
|
||||
do {
|
||||
result = fork();
|
||||
} while (result == -1 && errno == EINTR);
|
||||
if (result == -1) {
|
||||
janet_panic(strerror(errno));
|
||||
}
|
||||
if (result) {
|
||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||
memset(proc, 0, sizeof(JanetProc));
|
||||
proc->pid = result;
|
||||
proc->flags = JANET_PROC_ALLOW_ZOMBIE;
|
||||
return janet_wrap_abstract(proc);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
@@ -1334,8 +1518,8 @@ JANET_CORE_FN(os_getenv,
|
||||
janet_sandbox_assert(JANET_SANDBOX_ENV);
|
||||
janet_arity(argc, 1, 2);
|
||||
const char *cstr = janet_getcstring(argv, 0);
|
||||
const char *res = getenv(cstr);
|
||||
janet_lock_environ();
|
||||
const char *res = getenv(cstr);
|
||||
Janet ret = res
|
||||
? janet_cstringv(res)
|
||||
: argc == 2
|
||||
@@ -1380,34 +1564,51 @@ JANET_CORE_FN(os_time,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_clock,
|
||||
"(os/clock &opt source)",
|
||||
"Return the number of whole + fractional seconds of the requested clock source.\n\n"
|
||||
"(os/clock &opt source format)",
|
||||
"Return the current time of the requested clock source.\n\n"
|
||||
"The `source` argument selects the clock source to use, when not specified the default "
|
||||
"is `:realtime`:\n"
|
||||
"- :realtime: Return the real (i.e., wall-clock) time. This clock is affected by discontinuous "
|
||||
" jumps in the system time\n"
|
||||
"- :monotonic: Return the number of whole + fractional seconds since some fixed point in "
|
||||
" time. The clock is guaranteed to be non-decreasing in real time.\n"
|
||||
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n") {
|
||||
"- :cputime: Return the CPU time consumed by this process (i.e. all threads in the process)\n"
|
||||
"The `format` argument selects the type of output, when not specified the default is `:double`:\n"
|
||||
"- :double: Return the number of seconds + fractional seconds as a double\n"
|
||||
"- :int: Return the number of seconds as an integer\n"
|
||||
"- :tuple: Return a 2 integer tuple [seconds, nanoseconds]\n") {
|
||||
enum JanetTimeSource source;
|
||||
janet_sandbox_assert(JANET_SANDBOX_HRTIME);
|
||||
janet_arity(argc, 0, 1);
|
||||
enum JanetTimeSource source = JANET_TIME_REALTIME;
|
||||
if (argc == 1) {
|
||||
JanetKeyword sourcestr = janet_getkeyword(argv, 0);
|
||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||
source = JANET_TIME_REALTIME;
|
||||
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
||||
source = JANET_TIME_MONOTONIC;
|
||||
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
||||
source = JANET_TIME_CPUTIME;
|
||||
} else {
|
||||
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
||||
}
|
||||
janet_arity(argc, 0, 2);
|
||||
|
||||
JanetKeyword sourcestr = janet_optkeyword(argv, argc, 0, (const uint8_t *) "realtime");
|
||||
if (janet_cstrcmp(sourcestr, "realtime") == 0) {
|
||||
source = JANET_TIME_REALTIME;
|
||||
} else if (janet_cstrcmp(sourcestr, "monotonic") == 0) {
|
||||
source = JANET_TIME_MONOTONIC;
|
||||
} else if (janet_cstrcmp(sourcestr, "cputime") == 0) {
|
||||
source = JANET_TIME_CPUTIME;
|
||||
} else {
|
||||
janet_panicf("expected :realtime, :monotonic, or :cputime, got %v", argv[0]);
|
||||
}
|
||||
|
||||
struct timespec tv;
|
||||
if (janet_gettime(&tv, source)) janet_panic("could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
return janet_wrap_number(dtime);
|
||||
|
||||
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
|
||||
if (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) {
|
||||
return janet_wrap_number((double)(tv.tv_sec));
|
||||
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
|
||||
Janet tup[2] = {janet_wrap_number((double)tv.tv_sec),
|
||||
janet_wrap_number((double)tv.tv_nsec)
|
||||
};
|
||||
return janet_wrap_tuple(janet_tuple_n(tup, 2));
|
||||
} else {
|
||||
janet_panicf("expected :double, :int, or :tuple, got %v", argv[1]);
|
||||
}
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_sleep,
|
||||
@@ -1431,6 +1632,23 @@ JANET_CORE_FN(os_sleep,
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_isatty,
|
||||
"(os/isatty &opt file)",
|
||||
"Returns true if `file` is a terminal. If `file` is not specified, "
|
||||
"it will default to standard output.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
FILE *f = (argc == 1) ? janet_getfile(argv, 0, NULL) : stdout;
|
||||
#ifdef JANET_WINDOWS
|
||||
int fd = _fileno(f);
|
||||
if (fd == -1) janet_panic("not a valid stream");
|
||||
return janet_wrap_boolean(_isatty(fd));
|
||||
#else
|
||||
int fd = fileno(f);
|
||||
if (fd == -1) janet_panic(strerror(errno));
|
||||
return janet_wrap_boolean(isatty(fd));
|
||||
#endif
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_cwd,
|
||||
"(os/cwd)",
|
||||
"Returns the current working directory.") {
|
||||
@@ -1452,9 +1670,8 @@ JANET_CORE_FN(os_cryptorand,
|
||||
"Get or append `n` bytes of good quality random data provided by the OS. Returns a new buffer or `buf`.") {
|
||||
JanetBuffer *buffer;
|
||||
janet_arity(argc, 1, 2);
|
||||
int32_t offset;
|
||||
int32_t n = janet_getinteger(argv, 0);
|
||||
if (n < 0) janet_panic("expected positive integer");
|
||||
size_t offset;
|
||||
size_t n = janet_getsize(argv, 0);
|
||||
if (argc == 2) {
|
||||
buffer = janet_getbuffer(argv, 1);
|
||||
offset = buffer->count;
|
||||
@@ -2469,6 +2686,7 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/date", os_date), /* not high resolution */
|
||||
JANET_CORE_REG("os/strftime", os_strftime),
|
||||
JANET_CORE_REG("os/sleep", os_sleep),
|
||||
JANET_CORE_REG("os/isatty", os_isatty),
|
||||
|
||||
/* env functions */
|
||||
JANET_CORE_REG("os/environ", os_environ),
|
||||
@@ -2505,6 +2723,8 @@ void janet_lib_os(JanetTable *env) {
|
||||
JANET_CORE_REG("os/execute", os_execute),
|
||||
JANET_CORE_REG("os/spawn", os_spawn),
|
||||
JANET_CORE_REG("os/shell", os_shell),
|
||||
JANET_CORE_REG("os/posix-fork", os_posix_fork),
|
||||
JANET_CORE_REG("os/posix-exec", os_posix_exec),
|
||||
/* no need to sandbox process management if you can't create processes
|
||||
* (allows for limited functionality if use exposes C-functions to create specific processes) */
|
||||
JANET_CORE_REG("os/proc-wait", os_proc_wait),
|
||||
@@ -2518,6 +2738,7 @@ void janet_lib_os(JanetTable *env) {
|
||||
#ifdef JANET_EV
|
||||
JANET_CORE_REG("os/open", os_open), /* fs read and write */
|
||||
JANET_CORE_REG("os/pipe", os_pipe),
|
||||
JANET_CORE_REG("os/sigaction", os_sigaction),
|
||||
#endif
|
||||
#endif
|
||||
JANET_REG_END
|
||||
|
||||
@@ -59,11 +59,11 @@ int janet_is_symbol_char(uint8_t c) {
|
||||
/* Validate some utf8. Useful for identifiers. Only validates
|
||||
* the encoding, does not check for valid code points (they
|
||||
* are less well defined than the encoding). */
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len) {
|
||||
int32_t i = 0;
|
||||
int32_t j;
|
||||
int janet_valid_utf8(const uint8_t *str, size_t len) {
|
||||
size_t i = 0;
|
||||
size_t j;
|
||||
while (i < len) {
|
||||
int32_t nexti;
|
||||
size_t nexti;
|
||||
uint8_t c = str[i];
|
||||
|
||||
/* Check the number of bytes in code point */
|
||||
@@ -259,6 +259,14 @@ static int checkescape(uint8_t c) {
|
||||
return '\f';
|
||||
case 'v':
|
||||
return '\v';
|
||||
case 'a':
|
||||
return '\a';
|
||||
case 'b':
|
||||
return '\b';
|
||||
case '\'':
|
||||
return '\'';
|
||||
case '?':
|
||||
return '?';
|
||||
case 'e':
|
||||
return 27;
|
||||
case '"':
|
||||
@@ -426,8 +434,8 @@ static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
|
||||
/* Check for string equality in the buffer */
|
||||
static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
|
||||
int32_t index;
|
||||
static int check_str_const(const char *cstr, const uint8_t *str, size_t len) {
|
||||
size_t index;
|
||||
for (index = 0; index < len; index++) {
|
||||
uint8_t c = str[index];
|
||||
uint8_t k = ((const uint8_t *)cstr)[index];
|
||||
@@ -441,14 +449,14 @@ static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
|
||||
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
Janet ret;
|
||||
double numval;
|
||||
int32_t blen;
|
||||
size_t blen;
|
||||
if (janet_is_symbol_char(c)) {
|
||||
push_buf(p, (uint8_t) c);
|
||||
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
|
||||
return 1;
|
||||
}
|
||||
/* Token finished */
|
||||
blen = (int32_t) p->bufcount;
|
||||
blen = p->bufcount;
|
||||
int start_dig = p->buf[0] >= '0' && p->buf[0] <= '9';
|
||||
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||
if (p->buf[0] == ':') {
|
||||
@@ -912,13 +920,13 @@ JANET_CORE_FN(cfun_parse_consume,
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (argc == 3) {
|
||||
int32_t offset = janet_getinteger(argv, 2);
|
||||
if (offset < 0 || offset > view.len)
|
||||
size_t offset = janet_getsize(argv, 2);
|
||||
if (offset > view.len)
|
||||
janet_panicf("invalid offset %d out of range [0,%d]", offset, view.len);
|
||||
view.len -= offset;
|
||||
view.bytes += offset;
|
||||
}
|
||||
int32_t i;
|
||||
size_t i;
|
||||
for (i = 0; i < view.len; i++) {
|
||||
janet_parser_consume(p, view.bytes[i]);
|
||||
switch (janet_parser_status(p)) {
|
||||
@@ -926,10 +934,10 @@ JANET_CORE_FN(cfun_parse_consume,
|
||||
case JANET_PARSE_PENDING:
|
||||
break;
|
||||
default:
|
||||
return janet_wrap_integer(i + 1);
|
||||
return janet_wrap_size(i + 1);
|
||||
}
|
||||
}
|
||||
return janet_wrap_integer(i);
|
||||
return janet_wrap_size(i);
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_parse_eof,
|
||||
@@ -966,7 +974,7 @@ JANET_CORE_FN(cfun_parse_insert,
|
||||
}
|
||||
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
|
||||
const uint8_t *str = janet_to_string(argv[1]);
|
||||
int32_t slen = janet_string_length(str);
|
||||
size_t slen = janet_string_length(str);
|
||||
size_t newcount = p->bufcount + slen;
|
||||
if (p->bufcap < newcount) {
|
||||
size_t newcap = 2 * newcount;
|
||||
|
||||
139
src/core/peg.c
139
src/core/peg.c
@@ -39,6 +39,10 @@
|
||||
typedef struct {
|
||||
const uint8_t *text_start;
|
||||
const uint8_t *text_end;
|
||||
/* text_end can be restricted by some rules, but
|
||||
outer_text_end will always contain the real end of
|
||||
input, which we need to generate a line mapping */
|
||||
const uint8_t *outer_text_end;
|
||||
const uint32_t *bytecode;
|
||||
const Janet *constants;
|
||||
JanetArray *captures;
|
||||
@@ -61,9 +65,9 @@ typedef struct {
|
||||
* to save state at branches, and then reload
|
||||
* if one branch fails and try a new branch. */
|
||||
typedef struct {
|
||||
int32_t cap;
|
||||
int32_t tcap;
|
||||
int32_t scratch;
|
||||
size_t cap;
|
||||
size_t tcap;
|
||||
size_t scratch;
|
||||
} CapState;
|
||||
|
||||
/* Save the current capture state */
|
||||
@@ -114,12 +118,12 @@ static LineCol get_linecol_from_position(PegState *s, int32_t position) {
|
||||
/* Generate if not made yet */
|
||||
if (s->linemaplen < 0) {
|
||||
int32_t newline_count = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
|
||||
if (*c == '\n') newline_count++;
|
||||
}
|
||||
int32_t *mem = janet_smalloc(sizeof(int32_t) * newline_count);
|
||||
size_t index = 0;
|
||||
for (const uint8_t *c = s->text_start; c < s->text_end; c++) {
|
||||
for (const uint8_t *c = s->text_start; c < s->outer_text_end; c++) {
|
||||
if (*c == '\n') mem[index++] = (int32_t)(c - s->text_start);
|
||||
}
|
||||
s->linemaplen = newline_count;
|
||||
@@ -179,7 +183,7 @@ static const uint8_t *peg_rule(
|
||||
const uint32_t *rule,
|
||||
const uint8_t *text) {
|
||||
tail:
|
||||
switch (*rule & 0x1F) {
|
||||
switch (*rule) {
|
||||
default:
|
||||
janet_panic("unexpected opcode");
|
||||
return NULL;
|
||||
@@ -419,10 +423,10 @@ tail:
|
||||
/* check number parsing */
|
||||
double x = 0.0;
|
||||
int32_t base = (int32_t) rule[2];
|
||||
if (janet_scan_number_base(text, (int32_t)(result - text), base, &x)) return NULL;
|
||||
if (janet_scan_number_base(text, (size_t)(result - text), base, &x)) return NULL;
|
||||
/* Specialized pushcap - avoid intermediate string creation */
|
||||
if (!s->has_backref && s->mode == PEG_MODE_ACCUMULATE) {
|
||||
janet_buffer_push_bytes(s->scratch, text, (int32_t)(result - text));
|
||||
janet_buffer_push_bytes(s->scratch, text, (size_t)(result - text));
|
||||
} else {
|
||||
uint32_t tag = rule[3];
|
||||
pushcap(s, janet_wrap_number(x), tag);
|
||||
@@ -482,6 +486,68 @@ tail:
|
||||
return result;
|
||||
}
|
||||
|
||||
case RULE_SUB: {
|
||||
const uint8_t *text_start = text;
|
||||
const uint32_t *rule_window = s->bytecode + rule[1];
|
||||
const uint32_t *rule_subpattern = s->bytecode + rule[2];
|
||||
down1(s);
|
||||
const uint8_t *window_end = peg_rule(s, rule_window, text);
|
||||
up1(s);
|
||||
if (!window_end) {
|
||||
return NULL;
|
||||
}
|
||||
const uint8_t *saved_end = s->text_end;
|
||||
s->text_end = window_end;
|
||||
down1(s);
|
||||
const uint8_t *next_text = peg_rule(s, rule_subpattern, text_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!next_text) {
|
||||
return NULL;
|
||||
}
|
||||
|
||||
return window_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;
|
||||
CapState cs = cap_save(s);
|
||||
down1(s);
|
||||
while (text <= s->text_end) {
|
||||
separator_end = peg_rule(s, rule_separator, text);
|
||||
cap_load(s, cs);
|
||||
if (separator_end) {
|
||||
break;
|
||||
}
|
||||
text++;
|
||||
}
|
||||
up1(s);
|
||||
|
||||
if (separator_end) {
|
||||
s->text_end = text;
|
||||
text = separator_end;
|
||||
}
|
||||
|
||||
down1(s);
|
||||
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
|
||||
up1(s);
|
||||
s->text_end = saved_end;
|
||||
|
||||
if (!subpattern_end) {
|
||||
return NULL;
|
||||
}
|
||||
} while (separator_end);
|
||||
|
||||
return s->text_end;
|
||||
}
|
||||
|
||||
case RULE_REPLACE:
|
||||
case RULE_MATCHTIME: {
|
||||
uint32_t tag = rule[3];
|
||||
@@ -531,7 +597,7 @@ tail:
|
||||
case RULE_ERROR: {
|
||||
int oldmode = s->mode;
|
||||
s->mode = PEG_MODE_NORMAL;
|
||||
int32_t old_cap = s->captures->count;
|
||||
size_t old_cap = s->captures->count;
|
||||
down1(s);
|
||||
const uint8_t *result = peg_rule(s, s->bytecode + rule[1], text);
|
||||
up1(s);
|
||||
@@ -859,7 +925,7 @@ static void spec_set(Builder *b, int32_t argc, const Janet *argv) {
|
||||
Reserve r = reserve(b, 9);
|
||||
const uint8_t *str = peg_getset(b, argv[0]);
|
||||
uint32_t bitmap[8] = {0};
|
||||
for (int32_t i = 0; i < janet_string_length(str); i++)
|
||||
for (size_t i = 0; i < janet_string_length(str); i++)
|
||||
bitmap_set(bitmap, str[i]);
|
||||
emit_rule(r, RULE_SET, 8, bitmap);
|
||||
}
|
||||
@@ -1107,6 +1173,22 @@ static void spec_matchtime(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_3(r, RULE_MATCHTIME, subrule, cindex, tag);
|
||||
}
|
||||
|
||||
static void spec_sub(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_SUB, subrule1, subrule2);
|
||||
}
|
||||
|
||||
static void spec_split(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_SPLIT, subrule1, subrule2);
|
||||
}
|
||||
|
||||
#ifdef JANET_INT_TYPES
|
||||
#define JANET_MAX_READINT_WIDTH 8
|
||||
#else
|
||||
@@ -1190,6 +1272,8 @@ static const SpecialPair peg_specials[] = {
|
||||
{"sequence", spec_sequence},
|
||||
{"set", spec_set},
|
||||
{"some", spec_some},
|
||||
{"split", spec_split},
|
||||
{"sub", spec_sub},
|
||||
{"thru", spec_thru},
|
||||
{"to", spec_to},
|
||||
{"uint", spec_uint_le},
|
||||
@@ -1261,6 +1345,13 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
default:
|
||||
peg_panic(b, "unexpected peg source");
|
||||
return 0;
|
||||
|
||||
case JANET_BOOLEAN: {
|
||||
int n = janet_unwrap_boolean(peg);
|
||||
Reserve r = reserve(b, 2);
|
||||
emit_1(r, n ? RULE_NCHAR : RULE_NOTNCHAR, 0);
|
||||
break;
|
||||
}
|
||||
case JANET_NUMBER: {
|
||||
int32_t n = peg_getinteger(b, peg);
|
||||
Reserve r = reserve(b, 2);
|
||||
@@ -1293,7 +1384,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
/* Build grammar table */
|
||||
const JanetKV *st = janet_unwrap_struct(peg);
|
||||
JanetTable *new_grammar = janet_table(2 * janet_struct_capacity(st));
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
if (janet_checktype(st[i].key, JANET_KEYWORD)) {
|
||||
janet_table_put(new_grammar, st[i].key, st[i].value);
|
||||
}
|
||||
@@ -1424,7 +1515,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
uint32_t instr = bytecode[i];
|
||||
uint32_t *rule = bytecode + i;
|
||||
op_flags[i] |= 0x02;
|
||||
switch (instr & 0x1F) {
|
||||
switch (instr) {
|
||||
case RULE_LITERAL:
|
||||
i += 2 + ((rule[1] + 3) >> 2);
|
||||
break;
|
||||
@@ -1517,6 +1608,15 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_SUB:
|
||||
case RULE_SPLIT:
|
||||
/* [rule, rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
op_flags[rule[2]] |= 0x01;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
@@ -1645,7 +1745,7 @@ typedef struct {
|
||||
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
PegCall ret;
|
||||
int32_t min = get_replace ? 3 : 2;
|
||||
janet_arity(argc, get_replace, -1);
|
||||
janet_arity(argc, min, -1);
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
|
||||
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
|
||||
ret.peg = janet_unwrap_abstract(argv[0]);
|
||||
@@ -1670,6 +1770,7 @@ static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
|
||||
ret.s.mode = PEG_MODE_NORMAL;
|
||||
ret.s.text_start = ret.bytes.bytes;
|
||||
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
|
||||
ret.s.outer_text_end = ret.s.text_end;
|
||||
ret.s.depth = JANET_RECURSION_GUARD;
|
||||
ret.s.captures = janet_array(0);
|
||||
ret.s.tagged_captures = janet_array(0);
|
||||
@@ -1704,7 +1805,7 @@ JANET_CORE_FN(cfun_peg_find,
|
||||
"(peg/find peg text &opt start & args)",
|
||||
"Find first index where the peg matches in text. Returns an integer, or nil if not found.") {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
for (size_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
return janet_wrap_integer(i);
|
||||
@@ -1717,7 +1818,7 @@ JANET_CORE_FN(cfun_peg_find_all,
|
||||
"Find all indexes where the peg matches in text. Returns an array of integers.") {
|
||||
PegCall c = peg_cfun_init(argc, argv, 0);
|
||||
JanetArray *ret = janet_array(0);
|
||||
for (int32_t i = c.start; i < c.bytes.len; i++) {
|
||||
for (size_t i = c.start; i < c.bytes.len; i++) {
|
||||
peg_call_reset(&c);
|
||||
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
|
||||
janet_array_push(ret, janet_wrap_integer(i));
|
||||
@@ -1728,8 +1829,8 @@ JANET_CORE_FN(cfun_peg_find_all,
|
||||
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
PegCall c = peg_cfun_init(argc, argv, 1);
|
||||
JanetBuffer *ret = janet_buffer(0);
|
||||
int32_t trail = 0;
|
||||
for (int32_t i = c.start; i < c.bytes.len;) {
|
||||
size_t trail = 0;
|
||||
for (size_t i = c.start; i < c.bytes.len;) {
|
||||
peg_call_reset(&c);
|
||||
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
|
||||
if (NULL != result) {
|
||||
@@ -1737,7 +1838,7 @@ static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
|
||||
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
|
||||
trail = i;
|
||||
}
|
||||
int32_t nexti = (int32_t)(result - c.bytes.bytes);
|
||||
size_t nexti = (size_t)(result - c.bytes.bytes);
|
||||
JanetByteView subst = janet_text_substitution(&c.subst, c.bytes.bytes + i, nexti - i, c.s.captures);
|
||||
janet_buffer_push_bytes(ret, subst.bytes, subst.len);
|
||||
trail = nexti;
|
||||
@@ -1764,7 +1865,7 @@ JANET_CORE_FN(cfun_peg_replace_all,
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_peg_replace,
|
||||
"(peg/replace peg repl text &opt start & args)",
|
||||
"(peg/replace peg subst text &opt start & args)",
|
||||
"Replace first match of `peg` in `text` with `subst`, returning a new buffer. "
|
||||
"The peg does not need to make captures to do replacement. "
|
||||
"If `subst` is a function, it will be called with the "
|
||||
|
||||
@@ -31,6 +31,7 @@
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <inttypes.h>
|
||||
#include <float.h>
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is simple and not that flexible, but fast. */
|
||||
@@ -38,11 +39,15 @@
|
||||
/* Temporary buffer size */
|
||||
#define BUFSIZE 64
|
||||
|
||||
/* Preprocessor hacks */
|
||||
#define STR_HELPER(x) #x
|
||||
#define STR(x) STR_HELPER(x)
|
||||
|
||||
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||
const char *fmt = (x == floor(x) &&
|
||||
x <= JANET_INTMAX_DOUBLE &&
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
|
||||
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : ("%." STR(DBL_DIG) "g");
|
||||
int count;
|
||||
if (x == 0.0) {
|
||||
/* Prevent printing of '-0' */
|
||||
@@ -129,9 +134,9 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
#undef POINTSIZE
|
||||
}
|
||||
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, size_t len) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
for (int32_t i = 0; i < len; ++i) {
|
||||
for (size_t i = 0; i < len; ++i) {
|
||||
uint8_t c = str[i];
|
||||
switch (c) {
|
||||
case '"':
|
||||
@@ -152,6 +157,12 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
case '\v':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||
break;
|
||||
case '\a':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
|
||||
break;
|
||||
case '\b':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
|
||||
break;
|
||||
case 27:
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||
break;
|
||||
@@ -244,6 +255,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *fun = janet_unwrap_function(x);
|
||||
JanetFuncDef *def = fun->def;
|
||||
if (def == NULL) {
|
||||
janet_buffer_push_cstring(buffer, "<incomplete function>");
|
||||
break;
|
||||
}
|
||||
if (def->name) {
|
||||
const uint8_t *n = def->name;
|
||||
janet_buffer_push_cstring(buffer, "<function ");
|
||||
@@ -264,10 +279,10 @@ void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||
|
||||
/* Check if a symbol or keyword contains no symbol characters */
|
||||
static int contains_bad_chars(const uint8_t *sym, int issym) {
|
||||
int32_t len = janet_string_length(sym);
|
||||
size_t len = janet_string_length(sym);
|
||||
if (len && issym && sym[0] >= '0' && sym[0] <= '9') return 1;
|
||||
if (!janet_valid_utf8(sym, len)) return 1;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
if (!janet_is_symbol_char(sym[i])) return 1;
|
||||
}
|
||||
return 0;
|
||||
@@ -376,7 +391,7 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
JanetTuple t = janet_unwrap_tuple(x);
|
||||
int isb = janet_tuple_flag(t) & JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
janet_buffer_push_u8(S->buffer, isb ? '[' : '(');
|
||||
for (int32_t i = 0; i < janet_tuple_length(t); i++) {
|
||||
for (size_t i = 0; i < janet_tuple_length(t); i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, t[i], depth - 1)) return 1;
|
||||
}
|
||||
@@ -387,7 +402,7 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
janet_table_put(&S->seen, x, janet_wrap_true());
|
||||
JanetArray *a = janet_unwrap_array(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@[");
|
||||
for (int32_t i = 0; i < a->count; i++) {
|
||||
for (size_t i = 0; i < a->count; i++) {
|
||||
if (i) janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (print_jdn_one(S, a->data[i], depth - 1)) return 1;
|
||||
}
|
||||
@@ -399,7 +414,7 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
JanetTable *tab = janet_unwrap_table(x);
|
||||
janet_buffer_push_cstring(S->buffer, "@{");
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < tab->capacity; i++) {
|
||||
for (size_t i = 0; i < tab->capacity; i++) {
|
||||
const JanetKV *kv = tab->data + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
@@ -415,7 +430,7 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
JanetStruct st = janet_unwrap_struct(x);
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
int isFirst = 1;
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
const JanetKV *kv = st + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) continue;
|
||||
if (!isFirst) janet_buffer_push_u8(S->buffer, ' ');
|
||||
@@ -521,7 +536,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
}
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i = 0, len = 0;
|
||||
size_t i = 0, len = 0;
|
||||
const Janet *arr = NULL;
|
||||
int isarray = janet_checktype(x, JANET_ARRAY);
|
||||
janet_indexed_view(x, &arr, &len);
|
||||
@@ -572,7 +587,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
|
||||
const uint8_t *n;
|
||||
int32_t len;
|
||||
size_t len;
|
||||
if (janet_bytes_view(name, &n, &len)) {
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
||||
@@ -589,7 +604,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_struct_get(proto, janet_ckeywordv("_name"));
|
||||
const uint8_t *n;
|
||||
int32_t len;
|
||||
size_t len;
|
||||
if (janet_bytes_view(name, &n, &len)) {
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
||||
@@ -608,7 +623,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
} else {
|
||||
int32_t i = 0, len = 0, cap = 0;
|
||||
size_t i = 0, len = 0, cap = 0;
|
||||
const JanetKV *kvs = NULL;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
@@ -762,6 +777,8 @@ struct FmtMapping {
|
||||
/* Janet uses fixed width integer types for most things, so map
|
||||
* format specifiers to these fixed sizes */
|
||||
static const struct FmtMapping format_mappings[] = {
|
||||
{'D', PRId64},
|
||||
{'I', PRIi64},
|
||||
{'d', PRId64},
|
||||
{'i', PRIi64},
|
||||
{'o', PRIo64},
|
||||
@@ -775,7 +792,7 @@ static const char *get_fmt_mapping(char c) {
|
||||
if (format_mappings[i].c == c)
|
||||
return format_mappings[i].mapping;
|
||||
}
|
||||
return NULL;
|
||||
janet_assert(0, "bad format mapping");
|
||||
}
|
||||
|
||||
static const char *scanformat(
|
||||
@@ -840,13 +857,19 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
c = scanformat(c, form, width, precision);
|
||||
switch (*c++) {
|
||||
case 'c': {
|
||||
int n = va_arg(args, long);
|
||||
int n = va_arg(args, int);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'd':
|
||||
case 'i': {
|
||||
int64_t n = va_arg(args, int);
|
||||
int64_t n = (int64_t) va_arg(args, int32_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
case 'D':
|
||||
case 'I': {
|
||||
int64_t n = va_arg(args, int64_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
@@ -854,7 +877,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 'X':
|
||||
case 'o':
|
||||
case 'u': {
|
||||
uint64_t n = va_arg(args, unsigned int);
|
||||
uint64_t n = va_arg(args, uint64_t);
|
||||
nb = snprintf(item, MAX_ITEM, form, n);
|
||||
break;
|
||||
}
|
||||
@@ -872,13 +895,13 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
case 's':
|
||||
case 'S': {
|
||||
const char *str = va_arg(args, const char *);
|
||||
int32_t len = c[-1] == 's'
|
||||
? (int32_t) strlen(str)
|
||||
size_t len = c[-1] == 's'
|
||||
? strlen(str)
|
||||
: janet_string_length((JanetString) str);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, (const uint8_t *) str, len);
|
||||
else {
|
||||
if (len != (int32_t) strlen((const char *) str))
|
||||
if (len != strlen((const char *) str))
|
||||
janet_panic("string contains zeros");
|
||||
if (!strchr(form, '.') && len >= 100) {
|
||||
janet_panic("no precision and string is too long to be formatted");
|
||||
@@ -898,7 +921,7 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
|
||||
break;
|
||||
case 'T': {
|
||||
int types = va_arg(args, long);
|
||||
int types = va_arg(args, int);
|
||||
pushtypes(b, types);
|
||||
break;
|
||||
}
|
||||
@@ -1007,6 +1030,8 @@ void janet_buffer_format(
|
||||
janet_getinteger(argv, arg));
|
||||
break;
|
||||
}
|
||||
case 'D':
|
||||
case 'I':
|
||||
case 'd':
|
||||
case 'i': {
|
||||
int64_t n = janet_getinteger64(argv, arg);
|
||||
|
||||
@@ -27,11 +27,12 @@
|
||||
#endif
|
||||
|
||||
/* Run a string */
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, size_t len, const char *sourcePath, Janet *out) {
|
||||
JanetParser parser;
|
||||
int errflags = 0, done = 0;
|
||||
int32_t index = 0;
|
||||
size_t index = 0;
|
||||
Janet ret = janet_wrap_nil();
|
||||
JanetFiber *fiber = NULL;
|
||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||
|
||||
if (where) janet_gcroot(janet_wrap_string(where));
|
||||
@@ -47,7 +48,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
@@ -57,12 +58,20 @@ 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;
|
||||
if ((cres.error_mapping.line > 0) &&
|
||||
(cres.error_mapping.column > 0)) {
|
||||
line = cres.error_mapping.line;
|
||||
col = cres.error_mapping.column;
|
||||
}
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_eprintf("%s:%d:%d: compile error", sourcePath,
|
||||
line, col);
|
||||
janet_stacktrace_ext(cres.macrofiber, ret, "");
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
|
||||
line, col, (const char *)cres.error);
|
||||
}
|
||||
errflags |= 0x02;
|
||||
done = 1;
|
||||
@@ -104,9 +113,14 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
#ifdef JANET_EV
|
||||
/* Enter the event loop if we are not already in it */
|
||||
if (janet_vm.stackn == 0) {
|
||||
janet_gcroot(ret);
|
||||
if (fiber) {
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
}
|
||||
janet_loop();
|
||||
janet_gcunroot(ret);
|
||||
if (fiber) {
|
||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||
ret = fiber->last_value;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
if (out) *out = ret;
|
||||
@@ -114,7 +128,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
|
||||
int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out) {
|
||||
int32_t len = 0;
|
||||
size_t len = 0;
|
||||
while (str[len]) ++len;
|
||||
return janet_dobytes(env, (const uint8_t *)str, len, sourcePath, out);
|
||||
}
|
||||
|
||||
@@ -72,7 +72,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
default:
|
||||
return janetc_cslot(x);
|
||||
case JANET_TUPLE: {
|
||||
int32_t i, len;
|
||||
size_t i, len;
|
||||
const Janet *tup = janet_unwrap_tuple(x);
|
||||
len = janet_tuple_length(tup);
|
||||
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
|
||||
@@ -96,16 +96,15 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x, int depth, int level) {
|
||||
: JOP_MAKE_TUPLE);
|
||||
}
|
||||
case JANET_ARRAY: {
|
||||
int32_t i;
|
||||
JanetArray *array = janet_unwrap_array(x);
|
||||
for (i = 0; i < array->count; i++)
|
||||
for (size_t i = 0; i < array->count; i++)
|
||||
janet_v_push(slots, quasiquote(subopts, array->data[i], depth - 1, level));
|
||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||
}
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *kv = NULL, *kvs = NULL;
|
||||
int32_t len, cap = 0;
|
||||
size_t len, cap = 0;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||
JanetSlot key = quasiquote(subopts, kv->key, depth - 1, level);
|
||||
@@ -149,17 +148,17 @@ static int destructure(JanetCompiler *c,
|
||||
JanetTable *attr) {
|
||||
switch (janet_type(left)) {
|
||||
default:
|
||||
janetc_error(c, janet_formatc("unexpected type in destruction, got %v", left));
|
||||
janetc_error(c, janet_formatc("unexpected type in destructuring, got %v", left));
|
||||
return 1;
|
||||
case JANET_SYMBOL:
|
||||
/* Leaf, assign right to left */
|
||||
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
||||
case JANET_TUPLE:
|
||||
case JANET_ARRAY: {
|
||||
int32_t len = 0;
|
||||
size_t len = 0;
|
||||
const Janet *values = NULL;
|
||||
janet_indexed_view(left, &values, &len);
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
for (size_t i = 0; i < len; i++) {
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
Janet subval = values[i];
|
||||
|
||||
@@ -170,11 +169,11 @@ static int destructure(JanetCompiler *c,
|
||||
}
|
||||
|
||||
if (i + 2 < len) {
|
||||
int32_t num_extra = len - i - 1;
|
||||
size_t num_extra = len - i - 1;
|
||||
Janet *extra = janet_tuple_begin(num_extra);
|
||||
janet_tuple_flag(extra) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
|
||||
for (int32_t j = 0; j < num_extra; ++j) {
|
||||
for (size_t j = 0; j < num_extra; ++j) {
|
||||
extra[j] = values[j + i + 1];
|
||||
}
|
||||
|
||||
@@ -182,7 +181,6 @@ static int destructure(JanetCompiler *c,
|
||||
return 1;
|
||||
}
|
||||
|
||||
|
||||
if (!janet_checktype(values[i + 1], JANET_SYMBOL)) {
|
||||
janetc_error(c, janet_formatc("expected symbol following '& in destructuring pattern, found %q", values[i + 1]));
|
||||
return 1;
|
||||
@@ -238,9 +236,9 @@ static int destructure(JanetCompiler *c,
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *kvs = NULL;
|
||||
int32_t cap = 0, len = 0;
|
||||
size_t cap = 0, len = 0;
|
||||
janet_dictionary_view(left, &kvs, &len, &cap);
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
for (size_t i = 0; i < cap; i++) {
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||
JanetSlot nextright = janetc_farslot(c);
|
||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||
@@ -306,12 +304,16 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
}
|
||||
|
||||
/* Add attributes to a global def or var table */
|
||||
static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv) {
|
||||
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
|
||||
int32_t i;
|
||||
JanetTable *tab = janet_table(2);
|
||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||
: "<multiple bindings>";
|
||||
if (argn < 2) {
|
||||
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
||||
return NULL;
|
||||
}
|
||||
for (i = 1; i < argn - 1; i++) {
|
||||
Janet attr = argv[i];
|
||||
switch (janet_type(attr)) {
|
||||
@@ -335,18 +337,52 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
return tab;
|
||||
}
|
||||
|
||||
static JanetSlot dohead(const char *kind, JanetCompiler *c, JanetFopts opts, Janet *head, int32_t argn, const Janet *argv) {
|
||||
typedef struct SlotHeadPair {
|
||||
Janet lhs;
|
||||
JanetSlot rhs;
|
||||
} SlotHeadPair;
|
||||
|
||||
SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopts opts, Janet lhs, Janet rhs) {
|
||||
|
||||
/* Detect if we can do an optimization to avoid some allocations */
|
||||
int can_destructure_lhs = janet_checktype(lhs, JANET_TUPLE)
|
||||
|| janet_checktype(lhs, JANET_ARRAY);
|
||||
int rhs_is_indexed = janet_checktype(rhs, JANET_ARRAY)
|
||||
|| (janet_checktype(rhs, JANET_TUPLE) && (janet_tuple_flag(janet_unwrap_tuple(rhs)) & JANET_TUPLE_FLAG_BRACKETCTOR));
|
||||
uint32_t has_drop = opts.flags & JANET_FOPTS_DROP;
|
||||
|
||||
JanetFopts subopts = janetc_fopts_default(c);
|
||||
JanetSlot ret;
|
||||
if (argn < 2) {
|
||||
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
*head = argv[0];
|
||||
subopts.flags = opts.flags & ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
||||
|
||||
if (has_drop && can_destructure_lhs && rhs_is_indexed) {
|
||||
/* Code is of the form (def [a b] [1 2]), avoid the allocation of two tuples */
|
||||
JanetView view_lhs = {0};
|
||||
JanetView view_rhs = {0};
|
||||
janet_indexed_view(lhs, &view_lhs.items, &view_lhs.len);
|
||||
janet_indexed_view(rhs, &view_rhs.items, &view_rhs.len);
|
||||
int found_amp = 0;
|
||||
for (size_t i = 0; i < view_lhs.len; i++) {
|
||||
if (janet_symeq(view_lhs.items[i], "&")) {
|
||||
found_amp = 1;
|
||||
/* Good error will be generated later. */
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (!found_amp) {
|
||||
for (size_t i = 0; i < view_lhs.len; i++) {
|
||||
Janet sub_rhs = view_rhs.len <= i ? janet_wrap_nil() : view_rhs.items[i];
|
||||
into = dohead_destructure(c, into, subopts, view_lhs.items[i], sub_rhs);
|
||||
}
|
||||
return into;
|
||||
}
|
||||
}
|
||||
|
||||
/* No optimization, do the simple way */
|
||||
subopts.hint = opts.hint;
|
||||
ret = janetc_value(subopts, argv[argn - 1]);
|
||||
return ret;
|
||||
JanetSlot ret = janetc_value(subopts, rhs);
|
||||
SlotHeadPair shp = {lhs, ret};
|
||||
janet_v_push(into, shp);
|
||||
return into;
|
||||
}
|
||||
|
||||
/* Def or var a symbol in a local scope */
|
||||
@@ -412,12 +448,23 @@ static int varleaf(
|
||||
|
||||
static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead("var", c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
JanetTable *attr_table = handleattr(c, "var", argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, varleaf, attr_table);
|
||||
}
|
||||
SlotHeadPair *into = NULL;
|
||||
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
|
||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
||||
janet_v_free(into);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot ret;
|
||||
janet_assert(janet_v_count(into) > 0, "bad destructure");
|
||||
for (int32_t i = 0; i < janet_v_count(into); i++) {
|
||||
destructure(c, into[i].lhs, into[i].rhs, varleaf, attr_table);
|
||||
ret = into[i].rhs;
|
||||
}
|
||||
janet_v_free(into);
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -461,16 +508,47 @@ static int defleaf(
|
||||
|
||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
Janet head;
|
||||
opts.flags &= ~JANET_FOPTS_HINT;
|
||||
JanetTable *attr_table = handleattr(c, argn, argv);
|
||||
JanetSlot ret = dohead("def", c, opts, &head, argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
JanetTable *attr_table = handleattr(c, "def", argn, argv);
|
||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
destructure(c, argv[0], ret, defleaf, attr_table);
|
||||
}
|
||||
opts.flags &= ~JANET_FOPTS_HINT;
|
||||
SlotHeadPair *into = NULL;
|
||||
into = dohead_destructure(c, into, opts, argv[0], argv[argn - 1]);
|
||||
if (c->result.status == JANET_COMPILE_ERROR) {
|
||||
janet_v_free(into);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot ret;
|
||||
janet_assert(janet_v_count(into) > 0, "bad destructure");
|
||||
for (int32_t i = 0; i < janet_v_count(into); i++) {
|
||||
destructure(c, into[i].lhs, into[i].rhs, defleaf, attr_table);
|
||||
ret = into[i].rhs;
|
||||
}
|
||||
janet_v_free(into);
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
|
||||
static int janetc_check_nil_form(Janet x, Janet *capture, uint32_t fun_tag) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
Janet op1 = tup[0];
|
||||
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(op1);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != fun_tag) return 0;
|
||||
if (janet_checktype(tup[1], JANET_NIL)) {
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
} else if (janet_checktype(tup[2], JANET_NIL)) {
|
||||
*capture = tup[1];
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* :condition
|
||||
* ...
|
||||
@@ -491,6 +569,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetScope condscope, tempscope;
|
||||
const int tail = opts.flags & JANET_FOPTS_TAIL;
|
||||
const int drop = opts.flags & JANET_FOPTS_DROP;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
|
||||
if (argn < 2 || argn > 3) {
|
||||
janetc_cerror(c, "expected 2 or 3 arguments to if");
|
||||
@@ -513,12 +592,24 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Compile condition */
|
||||
janetc_scope(&condscope, c, 0, "if");
|
||||
cond = janetc_value(condopts, argv[0]);
|
||||
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
} else if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
}
|
||||
|
||||
cond = janetc_value(condopts, condform);
|
||||
|
||||
/* Check constant condition. */
|
||||
/* TODO: Use type info for more short circuits */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
if (!janet_truthy(cond.constant)) {
|
||||
int swap_condition = 0;
|
||||
if (ifnjmp == JOP_JUMP_IF_NOT && !janet_truthy(cond.constant)) swap_condition = 1;
|
||||
if (ifnjmp == JOP_JUMP_IF_NIL && janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
|
||||
if (ifnjmp == JOP_JUMP_IF_NOT_NIL && !janet_checktype(cond.constant, JANET_NIL)) swap_condition = 1;
|
||||
if (swap_condition) {
|
||||
/* Swap the true and false bodies */
|
||||
Janet temp = falsebody;
|
||||
falsebody = truebody;
|
||||
@@ -536,7 +627,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
|
||||
/* Compile jump to right */
|
||||
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
|
||||
|
||||
/* Condition left body */
|
||||
janetc_scope(&tempscope, c, 0, "if-true");
|
||||
@@ -546,7 +637,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Compile jump to done */
|
||||
labeljd = janet_v_count(c->buffer);
|
||||
if (!tail) janetc_emit(c, JOP_JUMP);
|
||||
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
|
||||
|
||||
/* Compile right body */
|
||||
labelr = janet_v_count(c->buffer);
|
||||
@@ -592,7 +683,6 @@ static JanetSlot janetc_do(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
|
||||
/* Compile an upscope form. Upscope forms execute their body sequentially and
|
||||
* evaluate to the last expression in the body, but without lexical scope. */
|
||||
static JanetSlot janetc_upscope(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
@@ -658,9 +748,8 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||
/* Closure body with return argument */
|
||||
subopts.flags |= JANET_FOPTS_TAIL;
|
||||
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||
ret.flags |= JANET_SLOT_RETURNED;
|
||||
return ret;
|
||||
janetc_value(subopts, argv[0]);
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
} else {
|
||||
/* while loop IIFE or no argument */
|
||||
if (argn) {
|
||||
@@ -668,9 +757,7 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
janetc_value(subopts, argv[0]);
|
||||
}
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||
s.flags |= JANET_SLOT_RETURNED;
|
||||
return s;
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
} else {
|
||||
if (argn) {
|
||||
@@ -683,20 +770,6 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a form matches the pattern (not= nil _) */
|
||||
static int janetc_check_notnil_form(Janet x, Janet *capture) {
|
||||
if (!janet_checktype(x, JANET_TUPLE)) return 0;
|
||||
JanetTuple tup = janet_unwrap_tuple(x);
|
||||
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
|
||||
if (3 != janet_tuple_length(tup)) return 0;
|
||||
JanetFunction *fun = janet_unwrap_function(tup[0]);
|
||||
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
|
||||
if (tag != JANET_FUN_NEQ) return 0;
|
||||
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
|
||||
*capture = tup[2];
|
||||
return 1;
|
||||
}
|
||||
|
||||
/*
|
||||
* :whiletop
|
||||
* ...
|
||||
@@ -713,6 +786,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
JanetScope tempscope;
|
||||
int32_t labelwt, labeld, labeljt, labelc, i;
|
||||
int infinite = 0;
|
||||
int is_nil_form = 0;
|
||||
int is_notnil_form = 0;
|
||||
uint8_t ifjmp = JOP_JUMP_IF;
|
||||
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
|
||||
@@ -726,11 +800,16 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
|
||||
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||
|
||||
/* Check for `(not= nil _)` in condition, and if so, use the
|
||||
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
|
||||
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
|
||||
* more efficiently. */
|
||||
Janet condform = argv[0];
|
||||
if (janetc_check_notnil_form(condform, &condform)) {
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_EQ)) {
|
||||
is_nil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
}
|
||||
if (janetc_check_nil_form(condform, &condform, JANET_FUN_NEQ)) {
|
||||
is_notnil_form = 1;
|
||||
ifjmp = JOP_JUMP_IF_NOT_NIL;
|
||||
ifnjmp = JOP_JUMP_IF_NIL;
|
||||
@@ -742,7 +821,9 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Check for constant condition */
|
||||
if (cond.flags & JANET_SLOT_CONSTANT) {
|
||||
/* Loop never executes */
|
||||
int never_executes = is_notnil_form
|
||||
int never_executes = is_nil_form
|
||||
? !janet_checktype(cond.constant, JANET_NIL)
|
||||
: is_notnil_form
|
||||
? janet_checktype(cond.constant, JANET_NIL)
|
||||
: !janet_truthy(cond.constant);
|
||||
if (never_executes) {
|
||||
@@ -960,6 +1041,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
Janet param = params[i];
|
||||
if (!janet_checktype(param, JANET_SYMBOL)) {
|
||||
janet_assert(janet_v_count(destructed_params) > j, "out of bounds");
|
||||
JanetSlot reg = destructed_params[j++];
|
||||
destructure(c, param, reg, defleaf, NULL);
|
||||
janetc_freeslot(c, reg);
|
||||
@@ -1064,4 +1146,3 @@ const JanetSpecial *janetc_special(const uint8_t *name) {
|
||||
sizeof(JanetSpecial),
|
||||
name);
|
||||
}
|
||||
|
||||
|
||||
@@ -24,6 +24,11 @@
|
||||
#include "features.h"
|
||||
#include <janet.h>
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#include <windows.h>
|
||||
#endif
|
||||
|
||||
JANET_THREAD_LOCAL JanetVM janet_vm;
|
||||
@@ -57,5 +62,10 @@ void janet_vm_load(JanetVM *from) {
|
||||
* use NULL to interrupt the current VM when convenient */
|
||||
void janet_interpreter_interrupt(JanetVM *vm) {
|
||||
vm = vm ? vm : &janet_vm;
|
||||
vm->auto_suspend = 1;
|
||||
janet_atomic_inc(&vm->auto_suspend);
|
||||
}
|
||||
|
||||
void janet_interpreter_interrupt_handled(JanetVM *vm) {
|
||||
vm = vm ? vm : &janet_vm;
|
||||
janet_atomic_dec(&vm->auto_suspend);
|
||||
}
|
||||
|
||||
@@ -42,14 +42,14 @@ typedef struct JanetScratch {
|
||||
typedef struct {
|
||||
JanetGCObject *self;
|
||||
JanetGCObject *other;
|
||||
int32_t index;
|
||||
int32_t index2;
|
||||
size_t index;
|
||||
size_t index2;
|
||||
} JanetTraversalNode;
|
||||
|
||||
typedef struct {
|
||||
int32_t capacity;
|
||||
int32_t head;
|
||||
int32_t tail;
|
||||
size_t capacity;
|
||||
size_t head;
|
||||
size_t tail;
|
||||
void *data;
|
||||
} JanetQueue;
|
||||
|
||||
@@ -89,7 +89,7 @@ struct JanetVM {
|
||||
|
||||
/* If this flag is true, suspend on function calls and backwards jumps.
|
||||
* When this occurs, this flag will be reset to 0. */
|
||||
int auto_suspend;
|
||||
volatile JanetAtomicInt auto_suspend;
|
||||
|
||||
/* The current running fiber on the current thread.
|
||||
* Set and unset by functions in vm.c */
|
||||
@@ -121,10 +121,12 @@ struct JanetVM {
|
||||
|
||||
/* Garbage collection */
|
||||
void *blocks;
|
||||
void *weak_blocks;
|
||||
size_t gc_interval;
|
||||
size_t next_collection;
|
||||
size_t block_count;
|
||||
int gc_suspend;
|
||||
int gc_mark_phase;
|
||||
|
||||
/* GC roots */
|
||||
Janet *roots;
|
||||
@@ -154,12 +156,10 @@ struct JanetVM {
|
||||
JanetQueue spawn;
|
||||
JanetTimeout *tq;
|
||||
JanetRNG ev_rng;
|
||||
JanetListenerState **listeners;
|
||||
size_t listener_count;
|
||||
size_t listener_cap;
|
||||
size_t extra_listeners;
|
||||
volatile JanetAtomicInt listener_count; /* used in signal handler, must be volatile */
|
||||
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
|
||||
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
|
||||
JanetTable signal_handlers;
|
||||
#ifdef JANET_WINDOWS
|
||||
void **iocp;
|
||||
#elif defined(JANET_EV_EPOLL)
|
||||
@@ -175,6 +175,9 @@ struct JanetVM {
|
||||
int timer;
|
||||
int timer_enabled;
|
||||
#else
|
||||
JanetStream **streams;
|
||||
size_t stream_count;
|
||||
size_t stream_capacity;
|
||||
pthread_attr_t new_thread_attr;
|
||||
JanetHandle selfpipe[2];
|
||||
struct pollfd *fds;
|
||||
|
||||
@@ -31,8 +31,8 @@
|
||||
#include <string.h>
|
||||
|
||||
/* Begin building a string */
|
||||
uint8_t *janet_string_begin(int32_t length) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) length + 1);
|
||||
uint8_t *janet_string_begin(size_t length) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + length + 1);
|
||||
head->length = length;
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
data[length] = 0;
|
||||
@@ -46,8 +46,8 @@ const uint8_t *janet_string_end(uint8_t *str) {
|
||||
}
|
||||
|
||||
/* Load a buffer as a string */
|
||||
const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + (size_t) len + 1);
|
||||
const uint8_t *janet_string(const uint8_t *buf, size_t len) {
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_STRING, sizeof(JanetStringHead) + len + 1);
|
||||
head->length = len;
|
||||
head->hash = janet_string_calchash(buf, len);
|
||||
uint8_t *data = (uint8_t *)head->data;
|
||||
@@ -58,9 +58,9 @@ const uint8_t *janet_string(const uint8_t *buf, int32_t len) {
|
||||
|
||||
/* Compare two strings */
|
||||
int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
int32_t xlen = janet_string_length(lhs);
|
||||
int32_t ylen = janet_string_length(rhs);
|
||||
int32_t len = xlen > ylen ? ylen : xlen;
|
||||
size_t xlen = janet_string_length(lhs);
|
||||
size_t ylen = janet_string_length(rhs);
|
||||
size_t len = xlen > ylen ? ylen : xlen;
|
||||
int res = memcmp(lhs, rhs, len);
|
||||
if (res) return res > 0 ? 1 : -1;
|
||||
if (xlen == ylen) return 0;
|
||||
@@ -68,9 +68,9 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
|
||||
}
|
||||
|
||||
/* Compare a janet string with a piece of memory */
|
||||
int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash) {
|
||||
int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, size_t rlen, int32_t rhash) {
|
||||
int32_t lhash = janet_string_hash(lhs);
|
||||
int32_t llen = janet_string_length(lhs);
|
||||
size_t llen = janet_string_length(lhs);
|
||||
if (lhs == rhs)
|
||||
return 1;
|
||||
if (lhash != rhash || llen != rlen)
|
||||
@@ -92,10 +92,10 @@ const uint8_t *janet_cstring(const char *str) {
|
||||
/* Knuth Morris Pratt Algorithm */
|
||||
|
||||
struct kmp_state {
|
||||
int32_t i;
|
||||
int32_t j;
|
||||
int32_t textlen;
|
||||
int32_t patlen;
|
||||
size_t i;
|
||||
size_t j;
|
||||
size_t textlen;
|
||||
size_t patlen;
|
||||
int32_t *lookup;
|
||||
const uint8_t *text;
|
||||
const uint8_t *pat;
|
||||
@@ -103,8 +103,8 @@ struct kmp_state {
|
||||
|
||||
static void kmp_init(
|
||||
struct kmp_state *s,
|
||||
const uint8_t *text, int32_t textlen,
|
||||
const uint8_t *pat, int32_t patlen) {
|
||||
const uint8_t *text, size_t textlen,
|
||||
const uint8_t *pat, size_t patlen) {
|
||||
if (patlen == 0) {
|
||||
janet_panic("expected non-empty pattern");
|
||||
}
|
||||
@@ -121,7 +121,8 @@ static void kmp_init(
|
||||
s->patlen = patlen;
|
||||
/* Init state machine */
|
||||
{
|
||||
int32_t i, j;
|
||||
size_t i;
|
||||
int32_t j;
|
||||
for (i = 1, j = 0; i < patlen; i++) {
|
||||
while (j && pat[j] != pat[i]) j = lookup[j - 1];
|
||||
if (pat[j] == pat[i]) j++;
|
||||
@@ -140,10 +141,10 @@ static void kmp_seti(struct kmp_state *state, int32_t i) {
|
||||
}
|
||||
|
||||
static int32_t kmp_next(struct kmp_state *state) {
|
||||
int32_t i = state->i;
|
||||
int32_t j = state->j;
|
||||
int32_t textlen = state->textlen;
|
||||
int32_t patlen = state->patlen;
|
||||
size_t i = state->i;
|
||||
size_t j = state->j;
|
||||
size_t textlen = state->textlen;
|
||||
size_t patlen = state->patlen;
|
||||
const uint8_t *text = state->text;
|
||||
const uint8_t *pat = state->pat;
|
||||
int32_t *lookup = state->lookup;
|
||||
@@ -175,8 +176,9 @@ JANET_CORE_FN(cfun_string_slice,
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index `start` inclusive to index `end`, exclusive. All indexing "
|
||||
"is from 0. `start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the string. Note that index -1 is synonymous with "
|
||||
"index `(length bytes)` to allow a full negative slice range. ") {
|
||||
"from the end of the string. Note that if `start` is negative it is "
|
||||
"exclusive, and if `end` is negative it is inclusive, to allow a full "
|
||||
"negative slice range.") {
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
@@ -203,12 +205,11 @@ JANET_CORE_FN(cfun_string_repeat,
|
||||
"Returns a string that is `n` copies of `bytes` concatenated.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
int32_t rep = janet_getinteger(argv, 1);
|
||||
if (rep < 0) janet_panic("expected non-negative number of repetitions");
|
||||
size_t rep = janet_getsize(argv, 1);
|
||||
if (rep == 0) return janet_cstringv("");
|
||||
int64_t mulres = (int64_t) rep * view.len;
|
||||
if (mulres > INT32_MAX) janet_panic("result string is too long");
|
||||
uint8_t *newbuf = janet_string_begin((int32_t) mulres);
|
||||
uint64_t mulres = (uint64_t) rep * view.len;
|
||||
if (mulres > JANET_INTMAX_SIZE) janet_panic("result string is too long");
|
||||
uint8_t *newbuf = janet_string_begin(mulres);
|
||||
uint8_t *end = newbuf + mulres;
|
||||
for (uint8_t *p = newbuf; p < end; p += view.len) {
|
||||
safe_memcpy(p, view.bytes, view.len);
|
||||
@@ -222,7 +223,7 @@ JANET_CORE_FN(cfun_string_bytes,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
Janet *tup = janet_tuple_begin(view.len);
|
||||
int32_t i;
|
||||
size_t i;
|
||||
for (i = 0; i < view.len; i++) {
|
||||
tup[i] = janet_wrap_integer((int32_t) view.bytes[i]);
|
||||
}
|
||||
@@ -250,7 +251,7 @@ JANET_CORE_FN(cfun_string_asciilower,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
for (int32_t i = 0; i < view.len; i++) {
|
||||
for (size_t i = 0; i < view.len; i++) {
|
||||
uint8_t c = view.bytes[i];
|
||||
if (c >= 65 && c <= 90) {
|
||||
buf[i] = c + 32;
|
||||
@@ -269,7 +270,7 @@ JANET_CORE_FN(cfun_string_asciiupper,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
for (int32_t i = 0; i < view.len; i++) {
|
||||
for (size_t i = 0; i < view.len; i++) {
|
||||
uint8_t c = view.bytes[i];
|
||||
if (c >= 97 && c <= 122) {
|
||||
buf[i] = c - 32;
|
||||
@@ -286,7 +287,7 @@ JANET_CORE_FN(cfun_string_reverse,
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
uint8_t *buf = janet_string_begin(view.len);
|
||||
int32_t i, j;
|
||||
size_t i, j;
|
||||
for (i = 0, j = view.len - 1; i < view.len; i++, j--) {
|
||||
buf[i] = view.bytes[j];
|
||||
}
|
||||
@@ -473,13 +474,13 @@ JANET_CORE_FN(cfun_string_checkset,
|
||||
JanetByteView set = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
/* Populate set */
|
||||
for (int32_t i = 0; i < set.len; i++) {
|
||||
for (size_t i = 0; i < set.len; i++) {
|
||||
int index = set.bytes[i] >> 5;
|
||||
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
|
||||
bitset[index] |= mask;
|
||||
}
|
||||
/* Check set */
|
||||
for (int32_t i = 0; i < str.len; i++) {
|
||||
for (size_t i = 0; i < str.len; i++) {
|
||||
int index = str.bytes[i] >> 5;
|
||||
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
|
||||
if (!(bitset[index] & mask)) {
|
||||
@@ -503,24 +504,24 @@ JANET_CORE_FN(cfun_string_join,
|
||||
joiner.len = 0;
|
||||
}
|
||||
/* Check args */
|
||||
int32_t i;
|
||||
int64_t finallen = 0;
|
||||
size_t i;
|
||||
size_t finallen = 0;
|
||||
for (i = 0; i < parts.len; i++) {
|
||||
const uint8_t *chunk;
|
||||
int32_t chunklen = 0;
|
||||
size_t chunklen = 0;
|
||||
if (!janet_bytes_view(parts.items[i], &chunk, &chunklen)) {
|
||||
janet_panicf("item %d of parts is not a byte sequence, got %v", i, parts.items[i]);
|
||||
}
|
||||
if (i) finallen += joiner.len;
|
||||
finallen += chunklen;
|
||||
if (finallen > INT32_MAX)
|
||||
if (finallen > JANET_INTMAX_SIZE)
|
||||
janet_panic("result string too long");
|
||||
}
|
||||
uint8_t *buf, *out;
|
||||
out = buf = janet_string_begin((int32_t) finallen);
|
||||
out = buf = janet_string_begin(finallen);
|
||||
for (i = 0; i < parts.len; i++) {
|
||||
const uint8_t *chunk = NULL;
|
||||
int32_t chunklen = 0;
|
||||
size_t chunklen = 0;
|
||||
if (i) {
|
||||
safe_memcpy(out, joiner.bytes, joiner.len);
|
||||
out += joiner.len;
|
||||
@@ -548,12 +549,12 @@ JANET_CORE_FN(cfun_string_format,
|
||||
"- `a`, `A`: floating point number, formatted as a hexadecimal number.\n"
|
||||
"- `s`: formatted as a string, precision indicates padding and maximum length.\n"
|
||||
"- `t`: emit the type of the given value.\n"
|
||||
"- `v`: format with (describe x)"
|
||||
"- `V`: format with (string x)"
|
||||
"- `v`: format with (describe x)\n"
|
||||
"- `V`: format with (string x)\n"
|
||||
"- `j`: format to jdn (Janet data notation).\n"
|
||||
"\n"
|
||||
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
||||
"variants generate colored output. These speficiers can take a precision "
|
||||
"variants generate colored output. These specifiers can take a precision "
|
||||
"argument to specify the maximum nesting depth to print.\n"
|
||||
"- `p`, `P`: pretty format, truncating if necessary\n"
|
||||
"- `m`, `M`: pretty format without truncating.\n"
|
||||
@@ -567,23 +568,23 @@ JANET_CORE_FN(cfun_string_format,
|
||||
}
|
||||
|
||||
static int trim_help_checkset(JanetByteView set, uint8_t x) {
|
||||
for (int32_t j = 0; j < set.len; j++)
|
||||
for (size_t j = 0; j < set.len; j++)
|
||||
if (set.bytes[j] == x)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int32_t trim_help_leftedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = 0; i < str.len; i++)
|
||||
static size_t trim_help_leftedge(JanetByteView str, JanetByteView set) {
|
||||
for (size_t i = 0; i < str.len; i++)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i;
|
||||
return str.len;
|
||||
}
|
||||
|
||||
static int32_t trim_help_rightedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = str.len - 1; i >= 0; i--)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i + 1;
|
||||
static size_t trim_help_rightedge(JanetByteView str, JanetByteView set) {
|
||||
for (size_t i = 0; i < str.len; i++)
|
||||
if (!trim_help_checkset(set, str.bytes[str.len - i - 1]))
|
||||
return str.len - i;
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -604,8 +605,8 @@ JANET_CORE_FN(cfun_string_trim,
|
||||
"`set` is provided, consider only characters in `set` to be whitespace.") {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
size_t left_edge = trim_help_leftedge(str, set);
|
||||
size_t right_edge = trim_help_rightedge(str, set);
|
||||
if (right_edge < left_edge)
|
||||
return janet_stringv(NULL, 0);
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
|
||||
@@ -249,7 +249,7 @@ static double convert(
|
||||
* and integer, return 0. */
|
||||
int janet_scan_number_base(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
size_t len,
|
||||
int32_t base,
|
||||
double *out) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -385,7 +385,7 @@ error:
|
||||
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
size_t len,
|
||||
double *out) {
|
||||
return janet_scan_number_base(str, len, 0, out);
|
||||
}
|
||||
@@ -394,7 +394,7 @@ int janet_scan_number(
|
||||
|
||||
static int scan_uint64(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
size_t len,
|
||||
uint64_t *out,
|
||||
int *neg) {
|
||||
const uint8_t *end = str + len;
|
||||
@@ -457,7 +457,7 @@ static int scan_uint64(
|
||||
return 1;
|
||||
}
|
||||
|
||||
int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
int janet_scan_int64(const uint8_t *str, size_t len, int64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
@@ -477,7 +477,7 @@ int janet_scan_int64(const uint8_t *str, int32_t len, int64_t *out) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
||||
int janet_scan_uint64(const uint8_t *str, size_t len, uint64_t *out) {
|
||||
int neg;
|
||||
uint64_t bi;
|
||||
if (scan_uint64(str, len, &bi, &neg)) {
|
||||
|
||||
@@ -29,12 +29,18 @@
|
||||
#endif
|
||||
|
||||
/* Begin creation of a struct */
|
||||
JanetKV *janet_struct_begin(int32_t count) {
|
||||
JanetKV *janet_struct_begin(size_t count) {
|
||||
/* Calculate capacity as power of 2 after 2 * count. */
|
||||
int32_t capacity = janet_tablen(2 * count);
|
||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||
|
||||
size_t size = sizeof(JanetStructHead) + (size_t) capacity * sizeof(JanetKV);
|
||||
uint64_t double_count =
|
||||
(count > JANET_INTMAX_SIZE / 2) ? JANET_INTMAX_SIZE : 2 * count;
|
||||
uint64_t capacity = janet_tablen(double_count);
|
||||
|
||||
uint64_t part_size = capacity * sizeof(JanetKV);
|
||||
if (part_size > JANET_INTMAX_SIZE){
|
||||
part_size = JANET_INTMIN_SIZE;
|
||||
}
|
||||
size_t size = sizeof(JanetStructHead) + (uint64_t) part_size;
|
||||
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||
head->length = count;
|
||||
head->capacity = capacity;
|
||||
@@ -49,9 +55,9 @@ JanetKV *janet_struct_begin(int32_t count) {
|
||||
/* Find an item in a struct without looking for prototypes. Should be similar to janet_dict_find, but
|
||||
* specialized to structs (slightly more compact). */
|
||||
const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
int32_t index = janet_maphash(cap, janet_hash(key));
|
||||
int32_t i;
|
||||
size_t cap = janet_struct_capacity(st);
|
||||
size_t index = (size_t) janet_maphash(cap, janet_hash(key));
|
||||
size_t i;
|
||||
for (i = index; i < cap; i++)
|
||||
if (janet_checktype(st[i].key, JANET_NIL) || janet_equals(st[i].key, key))
|
||||
return st + i;
|
||||
@@ -70,20 +76,20 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
* hash map is independent of insertion order.
|
||||
*/
|
||||
void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
size_t cap = janet_struct_capacity(st);
|
||||
int32_t hash = janet_hash(key);
|
||||
int32_t index = janet_maphash(cap, hash);
|
||||
int32_t i, j, dist;
|
||||
int32_t bounds[4] = {index, cap, 0, index};
|
||||
size_t index = (size_t) janet_maphash(cap, hash);
|
||||
size_t i, j, dist;
|
||||
size_t bounds[4] = {index, cap, 0, index};
|
||||
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
|
||||
if (janet_checktype(key, JANET_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||
/* Avoid extra items */
|
||||
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
||||
if ((size_t) janet_struct_hash(st) == janet_struct_length(st)) return;
|
||||
for (dist = 0, j = 0; j < 4; j += 2)
|
||||
for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) {
|
||||
int status;
|
||||
int32_t otherhash;
|
||||
int32_t otherindex, otherdist;
|
||||
size_t otherindex, otherdist;
|
||||
JanetKV *kv = st + i;
|
||||
/* We found an empty slot, so just add key and value */
|
||||
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||
@@ -100,7 +106,7 @@ void janet_struct_put_ext(JanetKV *st, Janet key, Janet value, int replace) {
|
||||
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
||||
* Collisions are resolved via an insertion sort insertion. */
|
||||
otherhash = janet_hash(kv->key);
|
||||
otherindex = janet_maphash(cap, otherhash);
|
||||
otherindex = (size_t) janet_maphash(cap, otherhash);
|
||||
otherdist = (i + cap - otherindex) & (cap - 1);
|
||||
if (dist < otherdist)
|
||||
status = -1;
|
||||
@@ -139,12 +145,12 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
|
||||
/* Finish building a struct */
|
||||
const JanetKV *janet_struct_end(JanetKV *st) {
|
||||
if (janet_struct_hash(st) != janet_struct_length(st)) {
|
||||
if ((size_t) janet_struct_hash(st) != janet_struct_length(st)) {
|
||||
/* Error building struct, probably duplicate values. We need to rebuild
|
||||
* the struct using only the values that went in. The second creation should always
|
||||
* succeed. */
|
||||
JanetKV *newst = janet_struct_begin(janet_struct_hash(st));
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
JanetKV *kv = st + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_struct_put(newst, kv->key, kv->value);
|
||||
@@ -192,7 +198,7 @@ Janet janet_struct_get_ex(const JanetKV *st, Janet key, JanetStruct *which) {
|
||||
/* Convert struct to table */
|
||||
JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
JanetTable *table = janet_table(janet_struct_capacity(st));
|
||||
int32_t i;
|
||||
size_t i;
|
||||
for (i = 0; i < janet_struct_capacity(st); i++) {
|
||||
const JanetKV *kv = st + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
@@ -238,21 +244,21 @@ JANET_CORE_FN(cfun_struct_flatten,
|
||||
JanetStruct st = janet_getstruct(argv, 0);
|
||||
|
||||
/* get an upper bounds on the number of items in the final struct */
|
||||
int64_t pair_count = 0;
|
||||
size_t pair_count = 0;
|
||||
JanetStruct cursor = st;
|
||||
while (cursor) {
|
||||
pair_count += janet_struct_length(cursor);
|
||||
cursor = janet_struct_proto(cursor);
|
||||
}
|
||||
|
||||
if (pair_count > INT32_MAX) {
|
||||
if (pair_count > JANET_INTMAX_SIZE) {
|
||||
janet_panic("struct too large");
|
||||
}
|
||||
|
||||
JanetKV *accum = janet_struct_begin((int32_t) pair_count);
|
||||
JanetKV *accum = janet_struct_begin(pair_count);
|
||||
cursor = st;
|
||||
while (cursor) {
|
||||
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
const JanetKV *kv = cursor + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_struct_put_ext(accum, kv->key, kv->value, 0);
|
||||
@@ -283,7 +289,7 @@ JANET_CORE_FN(cfun_struct_to_table,
|
||||
}
|
||||
/* TODO - implement as memcpy since struct memory should be compatible
|
||||
* with table memory */
|
||||
for (int32_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
for (size_t i = 0; i < janet_struct_capacity(cursor); i++) {
|
||||
const JanetKV *kv = cursor + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(tab_cursor, kv->key, kv->value);
|
||||
|
||||
@@ -66,7 +66,7 @@ static const uint8_t JANET_SYMCACHE_DELETED[1] = {0};
|
||||
* where one would put it. */
|
||||
static const uint8_t **janet_symcache_findmem(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
size_t len,
|
||||
int32_t hash,
|
||||
int *success) {
|
||||
uint32_t bounds[4];
|
||||
@@ -108,6 +108,7 @@ static const uint8_t **janet_symcache_findmem(
|
||||
}
|
||||
notfound:
|
||||
*success = 0;
|
||||
janet_assert(firstEmpty != NULL, "symcache failed to get memory");
|
||||
return firstEmpty;
|
||||
}
|
||||
|
||||
@@ -115,10 +116,10 @@ notfound:
|
||||
janet_symcache_findmem((str), janet_string_length(str), janet_string_hash(str), (success))
|
||||
|
||||
/* Resize the cache. */
|
||||
static void janet_cache_resize(uint32_t newCapacity) {
|
||||
uint32_t i, oldCapacity;
|
||||
static void janet_cache_resize(size_t newCapacity) {
|
||||
size_t i, oldCapacity;
|
||||
const uint8_t **oldCache = janet_vm.cache;
|
||||
const uint8_t **newCache = janet_calloc(1, (size_t) newCapacity * sizeof(const uint8_t *));
|
||||
const uint8_t **newCache = janet_calloc(1, newCapacity * sizeof(const uint8_t *));
|
||||
if (newCache == NULL) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -168,14 +169,14 @@ void janet_symbol_deinit(const uint8_t *sym) {
|
||||
}
|
||||
|
||||
/* Create a symbol from a byte string */
|
||||
const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
const uint8_t *janet_symbol(const uint8_t *str, size_t len) {
|
||||
int32_t hash = janet_string_calchash(str, len);
|
||||
uint8_t *newstr;
|
||||
int success = 0;
|
||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||
if (success)
|
||||
return *bucket;
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + (size_t) len + 1);
|
||||
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||
head->hash = hash;
|
||||
head->length = len;
|
||||
newstr = (uint8_t *)(head->data);
|
||||
@@ -187,7 +188,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
||||
|
||||
/* Get a symbol from a cstring */
|
||||
const uint8_t *janet_csymbol(const char *cstr) {
|
||||
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||
return janet_symbol((const uint8_t *)cstr, strlen(cstr));
|
||||
}
|
||||
|
||||
/* Increment the gensym buffer */
|
||||
@@ -233,6 +234,7 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
head->hash = hash;
|
||||
sym = (uint8_t *)(head->data);
|
||||
memcpy(sym, janet_vm.gensym_counter, sizeof(janet_vm.gensym_counter));
|
||||
sym[head->length] = 0;
|
||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||
return (const uint8_t *)sym;
|
||||
}
|
||||
|
||||
@@ -30,9 +30,9 @@
|
||||
|
||||
#define JANET_TABLE_FLAG_STACK 0x10000
|
||||
|
||||
static void *janet_memalloc_empty_local(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = janet_smalloc((size_t) count * sizeof(JanetKV));
|
||||
static void *janet_memalloc_empty_local(size_t count) {
|
||||
size_t i;
|
||||
void *mem = janet_smalloc(count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
@@ -42,7 +42,7 @@ static void *janet_memalloc_empty_local(int32_t count) {
|
||||
return mem;
|
||||
}
|
||||
|
||||
static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, int stackalloc) {
|
||||
static JanetTable *janet_table_init_impl(JanetTable *table, size_t capacity, int stackalloc) {
|
||||
JanetKV *data;
|
||||
capacity = janet_tablen(capacity);
|
||||
if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK;
|
||||
@@ -68,12 +68,12 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
|
||||
}
|
||||
|
||||
/* Initialize a table (for use withs scratch memory) */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
JanetTable *janet_table_init(JanetTable *table, size_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 1);
|
||||
}
|
||||
|
||||
/* Initialize a table without using scratch memory */
|
||||
JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity) {
|
||||
JanetTable *janet_table_init_raw(JanetTable *table, size_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
@@ -87,11 +87,27 @@ void janet_table_deinit(JanetTable *table) {
|
||||
}
|
||||
|
||||
/* Create a new table */
|
||||
JanetTable *janet_table(int32_t capacity) {
|
||||
|
||||
JanetTable *janet_table(size_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakk(size_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKK, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakv(size_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKV, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
JanetTable *janet_table_weakkv(size_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE_WEAKKV, sizeof(JanetTable));
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
/* Find the bucket that contains the given key. Will also return
|
||||
* bucket where key should go if not in the table. */
|
||||
JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
||||
@@ -99,7 +115,7 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
||||
}
|
||||
|
||||
/* Resize the dictionary table. */
|
||||
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
static void janet_table_rehash(JanetTable *t, size_t size) {
|
||||
JanetKV *olddata = t->data;
|
||||
JanetKV *newdata;
|
||||
int islocal = t->gc.flags & JANET_TABLE_FLAG_STACK;
|
||||
@@ -111,12 +127,11 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
int32_t i, oldcapacity;
|
||||
oldcapacity = t->capacity;
|
||||
size_t oldcapacity = t->capacity;
|
||||
t->data = newdata;
|
||||
t->capacity = size;
|
||||
t->deleted = 0;
|
||||
for (i = 0; i < oldcapacity; i++) {
|
||||
for (size_t i = 0; i < oldcapacity; i++) {
|
||||
JanetKV *kv = olddata + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
JanetKV *newkv = janet_table_find(t, kv->key);
|
||||
@@ -220,7 +235,7 @@ static void janet_table_put_no_overwrite(JanetTable *t, Janet key, Janet value)
|
||||
|
||||
/* Clear a table */
|
||||
void janet_table_clear(JanetTable *t) {
|
||||
int32_t capacity = t->capacity;
|
||||
size_t capacity = t->capacity;
|
||||
JanetKV *data = t->data;
|
||||
janet_memempty(data, capacity);
|
||||
t->count = 0;
|
||||
@@ -238,13 +253,13 @@ JanetTable *janet_table_clone(JanetTable *table) {
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(newTable->data, table->data, (size_t) table->capacity * sizeof(JanetKV));
|
||||
memcpy(newTable->data, table->data, table->capacity * sizeof(JanetKV));
|
||||
return newTable;
|
||||
}
|
||||
|
||||
/* Merge a table or struct into a table */
|
||||
static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t cap) {
|
||||
int32_t i;
|
||||
static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, size_t cap) {
|
||||
size_t i;
|
||||
for (i = 0; i < cap; i++) {
|
||||
const JanetKV *kv = kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
@@ -298,11 +313,46 @@ JANET_CORE_FN(cfun_table_new,
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for `capacity` entries. This means that if one knows the number of "
|
||||
"entries going into a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.") {
|
||||
"can be avoided. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getnat(argv, 0);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
/*
|
||||
uint32_t flags = janet_getflags(argv, 1, "kv");
|
||||
if (flags == 0) return janet_wrap_table(janet_table(cap));
|
||||
if (flags == 1) return janet_wrap_table(janet_table_weakk(cap));
|
||||
if (flags == 2) return janet_wrap_table(janet_table_weakv(cap));
|
||||
return janet_wrap_table(janet_table_weakkv(cap));
|
||||
*/
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak,
|
||||
"(table/weak capacity)",
|
||||
"Creates a new empty table with weak references to keys and values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakkv(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak_keys,
|
||||
"(table/weak-keys capacity)",
|
||||
"Creates a new empty table with weak references to keys and normal references to values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakk(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_weak_values,
|
||||
"(table/weak-values capacity)",
|
||||
"Creates a new empty table with normal references to keys and weak references to values. Similar to `table/new`. "
|
||||
"Returns the new table.") {
|
||||
janet_fixarity(argc, 1);
|
||||
size_t cap = janet_getsize(argv, 0);
|
||||
return janet_wrap_table(janet_table_weakv(cap));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(cfun_table_getproto,
|
||||
"(table/getproto tab)",
|
||||
@@ -377,6 +427,9 @@ JANET_CORE_FN(cfun_table_proto_flatten,
|
||||
void janet_lib_table(JanetTable *env) {
|
||||
JanetRegExt table_cfuns[] = {
|
||||
JANET_CORE_REG("table/new", cfun_table_new),
|
||||
JANET_CORE_REG("table/weak", cfun_table_weak),
|
||||
JANET_CORE_REG("table/weak-keys", cfun_table_weak_keys),
|
||||
JANET_CORE_REG("table/weak-values", cfun_table_weak_values),
|
||||
JANET_CORE_REG("table/to-struct", cfun_table_tostruct),
|
||||
JANET_CORE_REG("table/getproto", cfun_table_getproto),
|
||||
JANET_CORE_REG("table/setproto", cfun_table_setproto),
|
||||
|
||||
@@ -31,8 +31,8 @@
|
||||
/* Create a new empty tuple of the given size. This will return memory
|
||||
* which should be filled with Janets. The memory will not be collected until
|
||||
* janet_tuple_end is called. */
|
||||
Janet *janet_tuple_begin(int32_t length) {
|
||||
size_t size = sizeof(JanetTupleHead) + ((size_t) length * sizeof(Janet));
|
||||
Janet *janet_tuple_begin(size_t length) {
|
||||
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||
head->sm_line = -1;
|
||||
head->sm_column = -1;
|
||||
@@ -47,7 +47,7 @@ const Janet *janet_tuple_end(Janet *tuple) {
|
||||
}
|
||||
|
||||
/* Build a tuple with n values */
|
||||
const Janet *janet_tuple_n(const Janet *values, int32_t n) {
|
||||
const Janet *janet_tuple_n(const Janet *values, size_t n) {
|
||||
Janet *t = janet_tuple_begin(n);
|
||||
safe_memcpy(t, values, sizeof(Janet) * n);
|
||||
return janet_tuple_end(t);
|
||||
@@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
|
||||
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
|
||||
"they default to 0 and the length of `arrtup`, respectively. "
|
||||
"`start` and `end` can also be negative to indicate indexing "
|
||||
"from the end of the input. Note that index -1 is synonymous with "
|
||||
"index `(length arrtup)` to allow a full negative slice range. "
|
||||
"Returns the new tuple.") {
|
||||
"from the end of the input. Note that if `start` is negative it is "
|
||||
"exclusive, and if `end` is negative it is inclusive, to allow a full "
|
||||
"negative slice range. Returns the new tuple.") {
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
|
||||
@@ -117,7 +117,7 @@ const char *const janet_status_names[16] = {
|
||||
|
||||
#ifndef JANET_PRF
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
int32_t janet_string_calchash(const uint8_t *str, size_t len) {
|
||||
if (NULL == str) return 5381;
|
||||
const uint8_t *end = str + len;
|
||||
uint32_t hash = 5381;
|
||||
@@ -230,7 +230,7 @@ void janet_init_hash_key(uint8_t new_key[JANET_HASH_KEY_SIZE]) {
|
||||
|
||||
/* Calculate hash for string */
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
|
||||
int32_t janet_string_calchash(const uint8_t *str, size_t len) {
|
||||
uint32_t hash;
|
||||
hash = halfsiphash(str, len, hash_key);
|
||||
return (int32_t)hash;
|
||||
@@ -244,7 +244,7 @@ uint32_t janet_hash_mix(uint32_t input, uint32_t more) {
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
int32_t janet_array_calchash(const Janet *array, size_t len) {
|
||||
const Janet *end = array + len;
|
||||
uint32_t hash = 33;
|
||||
while (array < end) {
|
||||
@@ -254,7 +254,7 @@ int32_t janet_array_calchash(const Janet *array, int32_t len) {
|
||||
}
|
||||
|
||||
/* Computes hash of an array of values */
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, size_t len) {
|
||||
const JanetKV *end = kvs + len;
|
||||
uint32_t hash = 33;
|
||||
while (kvs < end) {
|
||||
@@ -267,8 +267,7 @@ int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
|
||||
|
||||
/* Calculate next power of 2. May overflow. If n is 0,
|
||||
* will return 0. */
|
||||
int32_t janet_tablen(int32_t n) {
|
||||
if (n < 0) return 0;
|
||||
uint64_t janet_tablen(uint64_t n) {
|
||||
n |= n >> 1;
|
||||
n |= n >> 2;
|
||||
n |= n >> 4;
|
||||
@@ -285,9 +284,9 @@ void safe_memcpy(void *dest, const void *src, size_t len) {
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, size_t cap, Janet key) {
|
||||
int32_t index = janet_maphash(cap, janet_hash(key));
|
||||
int32_t i;
|
||||
size_t i;
|
||||
const JanetKV *first_bucket = NULL;
|
||||
/* Higher half */
|
||||
for (i = index; i < cap; i++) {
|
||||
@@ -303,7 +302,7 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
}
|
||||
}
|
||||
/* Lower half */
|
||||
for (i = 0; i < index; i++) {
|
||||
for (i = 0; i < (size_t) index; i++) {
|
||||
const JanetKV *kv = buckets + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||
if (janet_checktype(kv->value, JANET_NIL)) {
|
||||
@@ -319,7 +318,7 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
}
|
||||
|
||||
/* Get a value from a janet struct or table. */
|
||||
Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
|
||||
Janet janet_dictionary_get(const JanetKV *data, size_t cap, Janet key) {
|
||||
const JanetKV *kv = janet_dict_find(data, cap, key);
|
||||
if (kv && !janet_checktype(kv->key, JANET_NIL)) {
|
||||
return kv->value;
|
||||
@@ -328,7 +327,7 @@ Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
|
||||
}
|
||||
|
||||
/* Iterate through a struct or dictionary generically */
|
||||
const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv) {
|
||||
const JanetKV *janet_dictionary_next(const JanetKV *kvs, size_t cap, const JanetKV *kv) {
|
||||
const JanetKV *end = kvs + cap;
|
||||
kv = (kv == NULL) ? kvs : kv + 1;
|
||||
while (kv < end) {
|
||||
@@ -342,8 +341,8 @@ const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const Jane
|
||||
/* Compare a janet string with a cstring. More efficient than loading
|
||||
* c string as a janet string. */
|
||||
int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||
int32_t len = janet_string_length(str);
|
||||
int32_t index;
|
||||
size_t len = janet_string_length(str);
|
||||
size_t index;
|
||||
for (index = 0; index < len; index++) {
|
||||
uint8_t c = str[index];
|
||||
uint8_t k = ((const uint8_t *)other)[index];
|
||||
@@ -499,7 +498,7 @@ typedef struct {
|
||||
static void namebuf_init(NameBuf *namebuf, const char *prefix) {
|
||||
size_t plen = strlen(prefix);
|
||||
namebuf->plen = plen;
|
||||
namebuf->buf = janet_malloc(namebuf->plen + 256);
|
||||
namebuf->buf = janet_smalloc(namebuf->plen + 256);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -508,12 +507,12 @@ static void namebuf_init(NameBuf *namebuf, const char *prefix) {
|
||||
}
|
||||
|
||||
static void namebuf_deinit(NameBuf *namebuf) {
|
||||
janet_free(namebuf->buf);
|
||||
janet_sfree(namebuf->buf);
|
||||
}
|
||||
|
||||
static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
|
||||
size_t slen = strlen(suffix);
|
||||
namebuf->buf = janet_realloc(namebuf->buf, namebuf->plen + 2 + slen);
|
||||
namebuf->buf = janet_srealloc(namebuf->buf, namebuf->plen + 2 + slen);
|
||||
if (NULL == namebuf->buf) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -691,7 +690,7 @@ static JanetByteView to_byte_view(Janet value) {
|
||||
JanetByteView janet_text_substitution(
|
||||
Janet *subst,
|
||||
const uint8_t *bytes,
|
||||
uint32_t len,
|
||||
size_t len,
|
||||
JanetArray *extra_argv) {
|
||||
int32_t extra_argc = extra_argv == NULL ? 0 : extra_argv->count;
|
||||
JanetType type = janet_type(*subst);
|
||||
@@ -741,7 +740,7 @@ Janet janet_resolve_core(const char *name) {
|
||||
|
||||
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
||||
* view can be constructed, 0 if an invalid type. */
|
||||
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
int janet_indexed_view(Janet seq, const Janet **data, size_t *len) {
|
||||
if (janet_checktype(seq, JANET_ARRAY)) {
|
||||
*data = janet_unwrap_array(seq)->data;
|
||||
*len = janet_unwrap_array(seq)->count;
|
||||
@@ -756,7 +755,7 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
|
||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, size_t *len) {
|
||||
JanetType t = janet_type(str);
|
||||
if (t == JANET_STRING || t == JANET_SYMBOL || t == JANET_KEYWORD) {
|
||||
*data = janet_unwrap_string(str);
|
||||
@@ -783,7 +782,7 @@ int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
/* Read both structs and tables as the entries of a hashtable with
|
||||
* identical structure. Returns 1 if the view can be constructed and
|
||||
* 0 if the type is invalid. */
|
||||
int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t *cap) {
|
||||
int janet_dictionary_view(Janet tab, const JanetKV **data, size_t *len, size_t *cap) {
|
||||
if (janet_checktype(tab, JANET_TABLE)) {
|
||||
*data = janet_unwrap_table(tab)->data;
|
||||
*cap = janet_unwrap_table(tab)->capacity;
|
||||
@@ -805,6 +804,13 @@ int janet_checkint(Janet x) {
|
||||
return janet_checkintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkuint(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkuintrange(dval);
|
||||
}
|
||||
|
||||
int janet_checkint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
@@ -816,19 +822,21 @@ int janet_checkuint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return dval >= 0 && dval <= JANET_INTMAX_DOUBLE && dval == (uint64_t) dval;
|
||||
return janet_checkuint64range(dval);
|
||||
}
|
||||
|
||||
int janet_checksize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
if (dval != (double)((size_t) dval)) return 0;
|
||||
if (SIZE_MAX > JANET_INTMAX_INT64) {
|
||||
return dval <= JANET_INTMAX_INT64;
|
||||
} else {
|
||||
return dval <= SIZE_MAX;
|
||||
}
|
||||
return janet_checksizerange(dval);
|
||||
}
|
||||
|
||||
int janet_checkssize(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkssizerange(dval);
|
||||
}
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name) {
|
||||
@@ -841,21 +849,21 @@ JanetTable *janet_get_core_table(const char *name) {
|
||||
}
|
||||
|
||||
/* Sort keys of a dictionary type */
|
||||
int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer) {
|
||||
int32_t janet_sorted_keys(const JanetKV *dict, size_t cap, int32_t *index_buffer) {
|
||||
|
||||
/* First, put populated indices into index_buffer */
|
||||
int32_t next_index = 0;
|
||||
for (int32_t i = 0; i < cap; i++) {
|
||||
size_t next_index = 0;
|
||||
for (size_t i = 0; i < cap; i++) {
|
||||
if (!janet_checktype(dict[i].key, JANET_NIL)) {
|
||||
index_buffer[next_index++] = i;
|
||||
}
|
||||
}
|
||||
|
||||
/* Next, sort those (simple insertion sort here for now) */
|
||||
for (int32_t i = 1; i < next_index; i++) {
|
||||
for (size_t i = 1; i < next_index; i++) {
|
||||
int32_t index_to_insert = index_buffer[i];
|
||||
Janet lhs = dict[index_to_insert].key;
|
||||
for (int32_t j = i - 1; j >= 0; j--) {
|
||||
for (size_t j = i - 1; j > 0; j--) {
|
||||
index_buffer[j + 1] = index_buffer[j];
|
||||
Janet rhs = dict[index_buffer[j]].key;
|
||||
if (janet_compare(lhs, rhs) >= 0) {
|
||||
@@ -953,6 +961,7 @@ void arc4random_buf(void *buf, size_t nbytes);
|
||||
#endif
|
||||
|
||||
int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
#ifndef JANET_NO_CRYPTORAND
|
||||
#ifdef JANET_WINDOWS
|
||||
for (size_t i = 0; i < n; i += sizeof(unsigned int)) {
|
||||
unsigned int v;
|
||||
@@ -964,7 +973,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
#elif defined(JANET_LINUX) || defined(JANET_CYGWIN) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#else
|
||||
/* We should be able to call getrandom on linux, but it doesn't seem
|
||||
to be uniformly supported on linux distros.
|
||||
On Mac, arc4random_buf wasn't available on until 10.7.
|
||||
@@ -986,12 +998,10 @@ int janet_cryptorand(uint8_t *out, size_t n) {
|
||||
}
|
||||
RETRY_EINTR(rc, close(randfd));
|
||||
return 0;
|
||||
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||
arc4random_buf(out, n);
|
||||
return 0;
|
||||
#endif
|
||||
#else
|
||||
(void) n;
|
||||
(void) out;
|
||||
(void) n;
|
||||
return -1;
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -49,11 +49,11 @@
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "C runtime error at line %d in file %s: %s\n",\
|
||||
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
abort();\
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
@@ -66,18 +66,18 @@
|
||||
/* Utils */
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
||||
int janet_valid_utf8(const uint8_t *str, size_t len);
|
||||
int janet_is_symbol_char(uint8_t c);
|
||||
extern const char janet_base64[65];
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||
int32_t janet_tablen(int32_t n);
|
||||
int32_t janet_array_calchash(const Janet *array, size_t len);
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, size_t len);
|
||||
int32_t janet_string_calchash(const uint8_t *str, size_t len);
|
||||
uint64_t janet_tablen(uint64_t n);
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, size_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, size_t count);
|
||||
void *janet_memalloc_empty(size_t count);
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
void janet_def_addflags(JanetFuncDef *def);
|
||||
const void *janet_strbinsearch(
|
||||
@@ -96,7 +96,7 @@ JanetBinding janet_binding_from_entry(Janet entry);
|
||||
JanetByteView janet_text_substitution(
|
||||
Janet *subst,
|
||||
const uint8_t *bytes,
|
||||
uint32_t len,
|
||||
size_t len,
|
||||
JanetArray *extra_args);
|
||||
|
||||
/* Registry functions */
|
||||
|
||||
@@ -31,7 +31,7 @@
|
||||
|
||||
#include <math.h>
|
||||
|
||||
static void push_traversal_node(void *lhs, void *rhs, int32_t index2) {
|
||||
static void push_traversal_node(void *lhs, void *rhs, size_t index2) {
|
||||
JanetTraversalNode node;
|
||||
node.self = (JanetGCObject *) lhs;
|
||||
node.other = (JanetGCObject *) rhs;
|
||||
@@ -75,7 +75,7 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
if ((self->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_TUPLE) {
|
||||
/* Node is a tuple at index t->index */
|
||||
if (t->index < tself->length && t->index < tother->length) {
|
||||
int32_t index = t->index++;
|
||||
size_t index = t->index++;
|
||||
*x = tself->data[index];
|
||||
*y = tother->data[index];
|
||||
janet_vm.traversal = t;
|
||||
@@ -88,13 +88,13 @@ static int traversal_next(Janet *x, Janet *y) {
|
||||
/* Node is a struct at index t->index: if t->index2 is true, we should return the values. */
|
||||
if (t->index2) {
|
||||
t->index2 = 0;
|
||||
int32_t index = t->index++;
|
||||
size_t index = t->index++;
|
||||
*x = sself->data[index].value;
|
||||
*y = sother->data[index].value;
|
||||
janet_vm.traversal = t;
|
||||
return 0;
|
||||
}
|
||||
for (int32_t i = t->index; i < sself->capacity; i++) {
|
||||
for (size_t i = t->index; i < sself->capacity; i++) {
|
||||
t->index2 = 1;
|
||||
*x = sself->data[t->index].key;
|
||||
*y = sother->data[t->index].key;
|
||||
@@ -135,7 +135,7 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *start;
|
||||
int32_t cap;
|
||||
size_t cap;
|
||||
if (t == JANET_TABLE) {
|
||||
JanetTable *tab = janet_unwrap_table(ds);
|
||||
cap = tab->capacity;
|
||||
@@ -161,7 +161,7 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
case JANET_BUFFER:
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
int32_t i;
|
||||
size_t i;
|
||||
if (janet_checktype(key, JANET_NIL)) {
|
||||
i = 0;
|
||||
} else if (janet_checkint(key)) {
|
||||
@@ -169,7 +169,7 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
} else {
|
||||
break;
|
||||
}
|
||||
int32_t len;
|
||||
size_t len;
|
||||
if (t == JANET_BUFFER) {
|
||||
len = janet_unwrap_buffer(ds)->count;
|
||||
} else if (t == JANET_ARRAY) {
|
||||
@@ -179,8 +179,8 @@ Janet janet_next_impl(Janet ds, Janet key, int is_interpreter) {
|
||||
} else {
|
||||
len = janet_string_length(janet_unwrap_string(ds));
|
||||
}
|
||||
if (i < len && i >= 0) {
|
||||
return janet_wrap_integer(i);
|
||||
if (i < len) {
|
||||
return janet_wrap_size(i);
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -423,8 +423,8 @@ int janet_compare(Janet x, Janet y) {
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *lhs = janet_unwrap_struct(x);
|
||||
const JanetKV *rhs = janet_unwrap_struct(y);
|
||||
int32_t llen = janet_struct_capacity(lhs);
|
||||
int32_t rlen = janet_struct_capacity(rhs);
|
||||
size_t llen = janet_struct_capacity(lhs);
|
||||
size_t rlen = janet_struct_capacity(rhs);
|
||||
int32_t lhash = janet_struct_hash(lhs);
|
||||
int32_t rhash = janet_struct_hash(rhs);
|
||||
if (llen < rlen) return -1;
|
||||
@@ -439,10 +439,9 @@ int janet_compare(Janet x, Janet y) {
|
||||
return status - 2;
|
||||
}
|
||||
|
||||
static int32_t getter_checkint(JanetType type, Janet key, int32_t max) {
|
||||
if (!janet_checkint(key)) goto bad;
|
||||
int32_t ret = janet_unwrap_integer(key);
|
||||
if (ret < 0) goto bad;
|
||||
static size_t getter_checksize(JanetType type, Janet key, size_t max) {
|
||||
if (!janet_checksize(key)) goto bad;
|
||||
size_t ret = janet_unwrap_size(key);
|
||||
if (ret >= max) goto bad;
|
||||
return ret;
|
||||
bad:
|
||||
@@ -465,19 +464,19 @@ Janet janet_in(Janet ds, Janet key) {
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
int32_t index = getter_checkint(type, key, array->count);
|
||||
size_t index = getter_checksize(type, key, array->count);
|
||||
value = array->data[index];
|
||||
break;
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||
int32_t len = janet_tuple_length(tuple);
|
||||
value = tuple[getter_checkint(type, key, len)];
|
||||
size_t len = janet_tuple_length(tuple);
|
||||
value = tuple[getter_checksize(type, key, len)];
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
int32_t index = getter_checkint(type, key, buffer->count);
|
||||
size_t index = getter_checksize(type, key, buffer->count);
|
||||
value = janet_wrap_integer(buffer->data[index]);
|
||||
break;
|
||||
}
|
||||
@@ -485,7 +484,7 @@ Janet janet_in(Janet ds, Janet key) {
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
int32_t index = getter_checkint(type, key, janet_string_length(str));
|
||||
size_t index = getter_checksize(type, key, janet_string_length(str));
|
||||
value = janet_wrap_integer(str[index]);
|
||||
break;
|
||||
}
|
||||
@@ -519,9 +518,8 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
if (!janet_checkint(key)) return janet_wrap_nil();
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return janet_wrap_nil();
|
||||
if (!janet_checksize(key)) return janet_wrap_nil();
|
||||
size_t index = janet_unwrap_size(key);
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
if (index >= janet_string_length(str)) return janet_wrap_nil();
|
||||
return janet_wrap_integer(str[index]);
|
||||
@@ -539,8 +537,7 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
case JANET_TUPLE:
|
||||
case JANET_BUFFER: {
|
||||
if (!janet_checkint(key)) return janet_wrap_nil();
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return janet_wrap_nil();
|
||||
size_t index = janet_unwrap_size(key);
|
||||
if (t == JANET_ARRAY) {
|
||||
JanetArray *a = janet_unwrap_array(ds);
|
||||
if (index >= a->count) return janet_wrap_nil();
|
||||
@@ -573,9 +570,8 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
}
|
||||
}
|
||||
|
||||
Janet janet_getindex(Janet ds, int32_t index) {
|
||||
Janet janet_getindex(Janet ds, size_t index) {
|
||||
Janet value;
|
||||
if (index < 0) janet_panic("expected non-negative index");
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
@@ -638,7 +634,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
return value;
|
||||
}
|
||||
|
||||
int32_t janet_length(Janet x) {
|
||||
size_t janet_length(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||
@@ -661,14 +657,14 @@ int32_t janet_length(Janet x) {
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if (len > INT32_MAX) {
|
||||
if (len > JANET_INTMAX_SIZE) {
|
||||
janet_panicf("invalid integer length %u", len);
|
||||
}
|
||||
return (int32_t)(len);
|
||||
return len;
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
Janet len = janet_mcall("length", 1, argv);
|
||||
if (!janet_checkint(len))
|
||||
if (!janet_checksize(len))
|
||||
janet_panicf("invalid integer length %v", len);
|
||||
return janet_unwrap_integer(len);
|
||||
}
|
||||
@@ -682,27 +678,32 @@ Janet janet_lengthv(Janet x) {
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_wrap_integer(janet_string_length(janet_unwrap_string(x)));
|
||||
return janet_wrap_size(janet_string_length(janet_unwrap_string(x)));
|
||||
case JANET_ARRAY:
|
||||
return janet_wrap_integer(janet_unwrap_array(x)->count);
|
||||
return janet_wrap_size(janet_unwrap_array(x)->count);
|
||||
case JANET_BUFFER:
|
||||
return janet_wrap_integer(janet_unwrap_buffer(x)->count);
|
||||
return janet_wrap_size(janet_unwrap_buffer(x)->count);
|
||||
case JANET_TUPLE:
|
||||
return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x)));
|
||||
return janet_wrap_size(janet_tuple_length(janet_unwrap_tuple(x)));
|
||||
case JANET_STRUCT:
|
||||
return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x)));
|
||||
return janet_wrap_size(janet_struct_length(janet_unwrap_struct(x)));
|
||||
case JANET_TABLE:
|
||||
return janet_wrap_integer(janet_unwrap_table(x)->count);
|
||||
return janet_wrap_size(janet_unwrap_table(x)->count);
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *type = janet_abstract_type(abst);
|
||||
if (type->length != NULL) {
|
||||
size_t len = type->length(abst, janet_abstract_size(abst));
|
||||
if ((uint64_t) len <= (uint64_t) JANET_INTMAX_INT64) {
|
||||
/* If len is always less then double, we can never overflow */
|
||||
#ifdef JANET_32
|
||||
return janet_wrap_number(len);
|
||||
#else
|
||||
if (len < (size_t) JANET_INTMAX_INT64) {
|
||||
return janet_wrap_number((double) len);
|
||||
} else {
|
||||
janet_panicf("integer length %u too large", len);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
@@ -710,7 +711,7 @@ Janet janet_lengthv(Janet x) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
void janet_putindex(Janet ds, size_t index, Janet value) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v",
|
||||
@@ -737,13 +738,13 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
JanetTable *table = janet_unwrap_table(ds);
|
||||
janet_table_put(table, janet_wrap_integer(index), value);
|
||||
janet_table_put(table, janet_wrap_size(index), value);
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||
if (type->put) {
|
||||
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
||||
(type->put)(janet_unwrap_abstract(ds), janet_wrap_size(index), value);
|
||||
} else {
|
||||
janet_panicf("no setter for %v ", ds);
|
||||
}
|
||||
@@ -760,7 +761,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
case JANET_ARRAY: {
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||
size_t index = getter_checksize(type, key, JANET_INTMAX_SIZE - 1);
|
||||
if (index >= array->count) {
|
||||
janet_array_setcount(array, index + 1);
|
||||
}
|
||||
@@ -769,7 +770,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
}
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||
size_t index = getter_checksize(type, key, JANET_INTMAX_SIZE - 1);
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
|
||||
@@ -40,7 +40,7 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||
|
||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||
void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
int32_t *p;
|
||||
char *p;
|
||||
if (NULL == v) return NULL;
|
||||
size_t size = (size_t) itemsize * janet_v__cnt(v);
|
||||
p = janet_malloc(size);
|
||||
|
||||
102
src/core/vm.c
102
src/core/vm.c
@@ -116,7 +116,6 @@
|
||||
#else
|
||||
#define vm_maybe_auto_suspend(COND) do { \
|
||||
if ((COND) && janet_vm.auto_suspend) { \
|
||||
janet_vm.auto_suspend = 0; \
|
||||
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
|
||||
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
|
||||
} \
|
||||
@@ -138,7 +137,7 @@
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
#define _vm_bitop_immediate(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
@@ -147,13 +146,15 @@
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_checkgc_pcnext();\
|
||||
} else {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
stack[A] = janet_wrap_integer(x1 op CS);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op CS));\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t);
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t);
|
||||
#define vm_bitop_immediate(op) _vm_bitop_immediate(op, int32_t, janet_checkintrange, "32-bit signed integers");
|
||||
#define vm_bitopu_immediate(op) _vm_bitop_immediate(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers");
|
||||
#define _vm_binop(op, wrap)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
@@ -170,14 +171,18 @@
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
#define _vm_bitop(op, type1)\
|
||||
#define _vm_bitop(op, type1, rangecheck, msg)\
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {\
|
||||
type1 x1 = (type1) janet_unwrap_integer(op1);\
|
||||
int32_t x2 = janet_unwrap_integer(op2);\
|
||||
stack[A] = janet_wrap_integer(x1 op x2);\
|
||||
double y1 = janet_unwrap_number(op1);\
|
||||
double y2 = janet_unwrap_number(op2);\
|
||||
if (!rangecheck(y1)) { vm_commit(); janet_panicf("value %v out of range for " msg, op1); }\
|
||||
if (!janet_checkintrange(y2)) { vm_commit(); janet_panicf("rhs must be valid 32-bit signed integer, got %f", op2); }\
|
||||
type1 x1 = (type1) y1;\
|
||||
int32_t x2 = (int32_t) y2;\
|
||||
stack[A] = janet_wrap_number((type1) (x1 op x2));\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
@@ -185,8 +190,8 @@
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t, janet_checkintrange, "32-bit signed integers")
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t, janet_checkuintrange, "32-bit unsigned integers")
|
||||
#define vm_compop(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
@@ -295,6 +300,16 @@ static Janet janet_method_lookup(Janet x, const char *name) {
|
||||
return method_to_fun(janet_ckeywordv(name), x);
|
||||
}
|
||||
|
||||
static Janet janet_unary_call(const char *method, Janet arg) {
|
||||
Janet m = janet_method_lookup(arg, method);
|
||||
if (janet_checktype(m, JANET_NIL)) {
|
||||
janet_panicf("could not find method :%s for %v", method, arg);
|
||||
} else {
|
||||
Janet argv[1] = { arg };
|
||||
return janet_method_invoke(m, 1, argv);
|
||||
}
|
||||
}
|
||||
|
||||
/* Call a method first on the righthand side, and then on the left hand side with a prefix */
|
||||
static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lhs, Janet rhs) {
|
||||
Janet lm = janet_method_lookup(lhs, lmethod);
|
||||
@@ -331,11 +346,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT_IMMEDIATE,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_DIVIDE_FLOOR,
|
||||
&&label_JOP_MODULO,
|
||||
&&label_JOP_REMAINDER,
|
||||
&&label_JOP_BAND,
|
||||
@@ -576,8 +593,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
@@ -667,6 +682,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_ADD)
|
||||
vm_binop(+);
|
||||
|
||||
VM_OP(JOP_SUBTRACT_IMMEDIATE)
|
||||
vm_binop_immediate(-);
|
||||
|
||||
VM_OP(JOP_SUBTRACT)
|
||||
vm_binop(-);
|
||||
|
||||
@@ -682,14 +700,33 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
VM_OP(JOP_DIVIDE)
|
||||
vm_binop( /);
|
||||
|
||||
VM_OP(JOP_DIVIDE_FLOOR) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
stack[A] = janet_wrap_number(floor(x1 / x2));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_binop_call("div", "rdiv", op1, op2);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_MODULO) {
|
||||
Janet op1 = stack[B];
|
||||
Janet op2 = stack[C];
|
||||
if (janet_checktype(op1, JANET_NUMBER) && janet_checktype(op2, JANET_NUMBER)) {
|
||||
double x1 = janet_unwrap_number(op1);
|
||||
double x2 = janet_unwrap_number(op2);
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
if (x2 == 0) {
|
||||
stack[A] = janet_wrap_number(x1);
|
||||
} else {
|
||||
double intres = x2 * floor(x1 / x2);
|
||||
stack[A] = janet_wrap_number(x1 - intres);
|
||||
}
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
@@ -724,9 +761,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_BNOT) {
|
||||
Janet op = stack[E];
|
||||
vm_assert_type(op, JANET_NUMBER);
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
if (janet_checktype(op, JANET_NUMBER)) {
|
||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||
vm_pcnext();
|
||||
} else {
|
||||
vm_commit();
|
||||
stack[A] = janet_unary_call("~", op);
|
||||
vm_checkgc_pcnext();
|
||||
}
|
||||
}
|
||||
|
||||
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
|
||||
@@ -757,13 +799,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_JUMP)
|
||||
pc += DS;
|
||||
vm_maybe_auto_suspend(DS < 0);
|
||||
vm_maybe_auto_suspend(DS <= 0);
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF)
|
||||
if (janet_truthy(stack[A])) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -774,14 +816,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
VM_OP(JOP_JUMP_IF_NIL)
|
||||
if (janet_checktype(stack[A], JANET_NIL)) {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
} else {
|
||||
pc++;
|
||||
}
|
||||
@@ -792,7 +834,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
pc++;
|
||||
} else {
|
||||
pc += ES;
|
||||
vm_maybe_auto_suspend(ES < 0);
|
||||
vm_maybe_auto_suspend(ES <= 0);
|
||||
}
|
||||
vm_next();
|
||||
|
||||
@@ -819,7 +861,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
|
||||
stack[A] = janet_wrap_boolean(janet_checktype(stack[B], JANET_NUMBER) && (janet_unwrap_number(stack[B]) == (double) CS));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
@@ -827,7 +869,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
|
||||
stack[A] = janet_wrap_boolean(!janet_checktype(stack[B], JANET_NUMBER) || (janet_unwrap_number(stack[B]) != (double) CS));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
@@ -955,7 +997,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
|
||||
VM_OP(JOP_PUSH_ARRAY) {
|
||||
const Janet *vals;
|
||||
int32_t len;
|
||||
size_t len;
|
||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||
janet_fiber_pushn(fiber, vals, len);
|
||||
} else {
|
||||
@@ -980,7 +1022,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
vm_commit();
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
janet_panicf("%v called with %d argument%s, expected %d",
|
||||
@@ -1517,7 +1559,7 @@ JanetSignal janet_pcall(
|
||||
fiber = janet_fiber(fun, 64, argc, argv);
|
||||
}
|
||||
if (f) *f = fiber;
|
||||
if (!fiber) {
|
||||
if (NULL == fiber) {
|
||||
*out = janet_cstringv("arity mismatch");
|
||||
return JANET_SIGNAL_ERROR;
|
||||
}
|
||||
@@ -1543,9 +1585,11 @@ int janet_init(void) {
|
||||
|
||||
/* Garbage collection */
|
||||
janet_vm.blocks = NULL;
|
||||
janet_vm.weak_blocks = NULL;
|
||||
janet_vm.next_collection = 0;
|
||||
janet_vm.gc_interval = 0x400000;
|
||||
janet_vm.block_count = 0;
|
||||
janet_vm.gc_mark_phase = 0;
|
||||
|
||||
janet_symcache_init();
|
||||
|
||||
|
||||
@@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
|
||||
return janet_truthy(x);
|
||||
}
|
||||
|
||||
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||
JanetStruct(janet_unwrap_struct)(Janet x) {
|
||||
return janet_unwrap_struct(x);
|
||||
}
|
||||
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||
JanetTuple(janet_unwrap_tuple)(Janet x) {
|
||||
return janet_unwrap_tuple(x);
|
||||
}
|
||||
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||
@@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
|
||||
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||
return janet_unwrap_buffer(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||
JanetString(janet_unwrap_string)(Janet x) {
|
||||
return janet_unwrap_string(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||
JanetSymbol(janet_unwrap_symbol)(Janet x) {
|
||||
return janet_unwrap_symbol(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||
JanetKeyword(janet_unwrap_keyword)(Janet x) {
|
||||
return janet_unwrap_keyword(x);
|
||||
}
|
||||
void *(janet_unwrap_abstract)(Janet x) {
|
||||
JanetAbstract(janet_unwrap_abstract)(Janet x) {
|
||||
return janet_unwrap_abstract(x);
|
||||
}
|
||||
void *(janet_unwrap_pointer)(Janet x) {
|
||||
@@ -88,6 +88,12 @@ int (janet_unwrap_boolean)(Janet x) {
|
||||
int32_t (janet_unwrap_integer)(Janet x) {
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
size_t (janet_unwrap_size)(Janet x) {
|
||||
return janet_unwrap_size(x);
|
||||
}
|
||||
ssize_t (janet_unwrap_ssize)(Janet x) {
|
||||
return janet_unwrap_ssize(x);
|
||||
}
|
||||
|
||||
#if defined(JANET_NANBOX_32) || defined(JANET_NANBOX_64)
|
||||
Janet(janet_wrap_nil)(void) {
|
||||
@@ -102,22 +108,22 @@ Janet(janet_wrap_false)(void) {
|
||||
Janet(janet_wrap_boolean)(int x) {
|
||||
return janet_wrap_boolean(x);
|
||||
}
|
||||
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||
Janet(janet_wrap_string)(JanetString x) {
|
||||
return janet_wrap_string(x);
|
||||
}
|
||||
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||
Janet(janet_wrap_symbol)(JanetSymbol x) {
|
||||
return janet_wrap_symbol(x);
|
||||
}
|
||||
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||
Janet(janet_wrap_keyword)(JanetKeyword x) {
|
||||
return janet_wrap_keyword(x);
|
||||
}
|
||||
Janet(janet_wrap_array)(JanetArray *x) {
|
||||
return janet_wrap_array(x);
|
||||
}
|
||||
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||
Janet(janet_wrap_tuple)(JanetTuple x) {
|
||||
return janet_wrap_tuple(x);
|
||||
}
|
||||
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||
Janet(janet_wrap_struct)(JanetStruct x) {
|
||||
return janet_wrap_struct(x);
|
||||
}
|
||||
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||
@@ -135,7 +141,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
||||
Janet(janet_wrap_table)(JanetTable *x) {
|
||||
return janet_wrap_table(x);
|
||||
}
|
||||
Janet(janet_wrap_abstract)(void *x) {
|
||||
Janet(janet_wrap_abstract)(JanetAbstract x) {
|
||||
return janet_wrap_abstract(x);
|
||||
}
|
||||
Janet(janet_wrap_pointer)(void *x) {
|
||||
@@ -144,6 +150,12 @@ Janet(janet_wrap_pointer)(void *x) {
|
||||
Janet(janet_wrap_integer)(int32_t x) {
|
||||
return janet_wrap_integer(x);
|
||||
}
|
||||
Janet(janet_wrap_size)(size_t x) {
|
||||
return janet_wrap_size(x);
|
||||
}
|
||||
Janet(janet_wrap_ssize)(ssize_t x) {
|
||||
return janet_wrap_ssize(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NANBOX_32
|
||||
@@ -160,10 +172,10 @@ Janet(janet_wrap_number)(double x) {
|
||||
|
||||
/*****/
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = janet_malloc((size_t) count * sizeof(JanetKV));
|
||||
janet_vm.next_collection += (size_t) count * sizeof(JanetKV);
|
||||
void *janet_memalloc_empty(size_t count) {
|
||||
size_t i;
|
||||
void *mem = janet_malloc(count * sizeof(JanetKV));
|
||||
janet_vm.next_collection += count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -176,8 +188,8 @@ void *janet_memalloc_empty(int32_t count) {
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_memempty(JanetKV *mem, int32_t count) {
|
||||
int32_t i;
|
||||
void janet_memempty(JanetKV *mem, size_t count) {
|
||||
size_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
mem[i].key = janet_wrap_nil();
|
||||
mem[i].value = janet_wrap_nil();
|
||||
@@ -317,4 +329,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||
#undef JANET_WRAP_DEFINE
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
@@ -143,12 +143,6 @@ extern "C" {
|
||||
#define JANET_LITTLE_ENDIAN 1
|
||||
#endif
|
||||
|
||||
/* Limits for converting doubles to 64 bit integers */
|
||||
#define JANET_INTMAX_DOUBLE 9007199254740992.0
|
||||
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
|
||||
#define JANET_INTMAX_INT64 9007199254740992
|
||||
#define JANET_INTMIN_INT64 (-9007199254740992)
|
||||
|
||||
/* Check emscripten */
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define JANET_NO_DYNAMIC_MODULES
|
||||
@@ -234,10 +228,28 @@ extern "C" {
|
||||
#define JANET_EV_KQUEUE
|
||||
#endif
|
||||
|
||||
/* Use poll as last resort */
|
||||
#if !defined(JANET_WINDOWS) && !defined(JANET_EV_EPOLL) && !defined(JANET_EV_KQUEUE)
|
||||
#define JANET_EV_POLL
|
||||
#endif
|
||||
|
||||
/* How to export symbols */
|
||||
#ifndef JANET_EXPORT
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_EXPORT __declspec(dllexport)
|
||||
#else
|
||||
#define JANET_EXPORT __attribute__((visibility ("default")))
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* How declare API functions */
|
||||
#ifndef JANET_API
|
||||
#ifdef JANET_WINDOWS
|
||||
#ifdef JANET_DLL_IMPORT
|
||||
#define JANET_API __declspec(dllimport)
|
||||
#else
|
||||
#define JANET_API __declspec(dllexport)
|
||||
#endif
|
||||
#else
|
||||
#define JANET_API __attribute__((visibility ("default")))
|
||||
#endif
|
||||
@@ -354,6 +366,25 @@ typedef struct JanetOSRWLock JanetOSRWLock;
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* Limits for converting doubles to 64 bit integers */
|
||||
#define JANET_INTMAX_DOUBLE 9007199254740992.0
|
||||
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
|
||||
#define JANET_INTMAX_INT64 9007199254740992
|
||||
#define JANET_INTMIN_INT64 (-9007199254740992)
|
||||
#if defined(JANET_64)
|
||||
#define JANET_INTMAX_SIZE JANET_INTMAX_INT64
|
||||
#define JANET_INTMIN_SIZE JANET_INTMIN_INT64
|
||||
#else
|
||||
#define JANET_INTMAX_SIZE INT32_MAX
|
||||
#define JANET_INTMIN_SIZE INT32_MIN
|
||||
#endif
|
||||
|
||||
/* signed size */
|
||||
#ifdef _SSIZE_T
|
||||
typedef ssize_t ssize_t;
|
||||
#else
|
||||
typedef ptrdiff_t ssize_t;
|
||||
#endif
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
@@ -394,12 +425,11 @@ typedef enum {
|
||||
JANET_SIGNAL_USER6,
|
||||
JANET_SIGNAL_USER7,
|
||||
JANET_SIGNAL_USER8,
|
||||
JANET_SIGNAL_USER9
|
||||
JANET_SIGNAL_USER9,
|
||||
JANET_SIGNAL_INTERRUPT = JANET_SIGNAL_USER8,
|
||||
JANET_SIGNAL_EVENT = JANET_SIGNAL_USER9,
|
||||
} JanetSignal;
|
||||
|
||||
#define JANET_SIGNAL_EVENT JANET_SIGNAL_USER9
|
||||
#define JANET_SIGNAL_INTERRUPT JANET_SIGNAL_USER8
|
||||
|
||||
/* Fiber statuses - mostly corresponds to signals. */
|
||||
typedef enum {
|
||||
JANET_STATUS_DEAD,
|
||||
@@ -563,7 +593,7 @@ typedef void *JanetAbstract;
|
||||
|
||||
#define JANET_STREAM_CLOSED 0x1
|
||||
#define JANET_STREAM_SOCKET 0x2
|
||||
#define JANET_STREAM_IOCP 0x4
|
||||
#define JANET_STREAM_UNREGISTERED 0x4
|
||||
#define JANET_STREAM_READABLE 0x200
|
||||
#define JANET_STREAM_WRITABLE 0x400
|
||||
#define JANET_STREAM_ACCEPTABLE 0x800
|
||||
@@ -571,62 +601,67 @@ typedef void *JanetAbstract;
|
||||
#define JANET_STREAM_TOCLOSE 0x10000
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_EVENT_INIT,
|
||||
JANET_ASYNC_EVENT_MARK,
|
||||
JANET_ASYNC_EVENT_DEINIT,
|
||||
JANET_ASYNC_EVENT_CLOSE,
|
||||
JANET_ASYNC_EVENT_ERR,
|
||||
JANET_ASYNC_EVENT_HUP,
|
||||
JANET_ASYNC_EVENT_READ,
|
||||
JANET_ASYNC_EVENT_WRITE,
|
||||
JANET_ASYNC_EVENT_CANCEL,
|
||||
JANET_ASYNC_EVENT_COMPLETE, /* Used on windows for IOCP */
|
||||
JANET_ASYNC_EVENT_USER
|
||||
JANET_ASYNC_EVENT_INIT = 0,
|
||||
JANET_ASYNC_EVENT_MARK = 1,
|
||||
JANET_ASYNC_EVENT_DEINIT = 2,
|
||||
JANET_ASYNC_EVENT_CLOSE = 3,
|
||||
JANET_ASYNC_EVENT_ERR = 4,
|
||||
JANET_ASYNC_EVENT_HUP = 5,
|
||||
JANET_ASYNC_EVENT_READ = 6,
|
||||
JANET_ASYNC_EVENT_WRITE = 7,
|
||||
JANET_ASYNC_EVENT_COMPLETE = 8, /* Used on windows for IOCP */
|
||||
JANET_ASYNC_EVENT_FAILED = 9 /* Used on windows for IOCP */
|
||||
} JanetAsyncEvent;
|
||||
|
||||
#define JANET_ASYNC_LISTEN_READ (1 << JANET_ASYNC_EVENT_READ)
|
||||
#define JANET_ASYNC_LISTEN_WRITE (1 << JANET_ASYNC_EVENT_WRITE)
|
||||
|
||||
typedef enum {
|
||||
JANET_ASYNC_STATUS_NOT_DONE,
|
||||
JANET_ASYNC_STATUS_DONE
|
||||
} JanetAsyncStatus;
|
||||
JANET_ASYNC_LISTEN_READ = 1,
|
||||
JANET_ASYNC_LISTEN_WRITE,
|
||||
JANET_ASYNC_LISTEN_BOTH
|
||||
} JanetAsyncMode;
|
||||
|
||||
/* Typedefs */
|
||||
typedef struct JanetListenerState JanetListenerState;
|
||||
typedef struct JanetStream JanetStream;
|
||||
typedef JanetAsyncStatus(*JanetListener)(JanetListenerState *state, JanetAsyncEvent event);
|
||||
|
||||
/* Wrapper around file descriptors and HANDLEs that can be polled. */
|
||||
struct JanetStream {
|
||||
JanetHandle handle;
|
||||
uint32_t flags;
|
||||
/* Linked list of all in-flight IO routines for this stream */
|
||||
JanetListenerState *state;
|
||||
uint32_t index;
|
||||
JanetFiber *read_fiber;
|
||||
JanetFiber *write_fiber;
|
||||
const void *methods; /* Methods for this stream */
|
||||
/* internal - used to disallow multiple concurrent reads / writes on the same stream.
|
||||
* this constraint may be lifted later but allowing such would require more internal book keeping
|
||||
* for some implementations. You can read and write at the same time on the same stream, though. */
|
||||
int _mask;
|
||||
};
|
||||
|
||||
/* Interface for state machine based event loop */
|
||||
struct JanetListenerState {
|
||||
JanetListener machine;
|
||||
JanetFiber *fiber;
|
||||
JanetStream *stream;
|
||||
void *event; /* Used to pass data from asynchronous IO event. Contents depend on both
|
||||
implementation of the event loop and the particular event. */
|
||||
typedef void (*JanetEVCallback)(JanetFiber *fiber, JanetAsyncEvent event);
|
||||
|
||||
/* Start listening for events from a stream on the current root fiber. After
|
||||
* calling this, users should call janet_await() before returning from the
|
||||
* current C Function. This also will call janet_await.
|
||||
* mode is which events to listen for, and callback is the function pointer to
|
||||
* 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. */
|
||||
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
|
||||
* or canceled. */
|
||||
JANET_API void janet_async_end(JanetFiber *fiber);
|
||||
|
||||
/* Needed for windows to mark a fiber as waiting for an IOCP completion event. Noop on other platforms. */
|
||||
JANET_API void janet_async_in_flight(JanetFiber *fiber);
|
||||
|
||||
#endif
|
||||
|
||||
/* Janet uses atomic integers in several places for synchronization between threads and
|
||||
* signals. Define them here */
|
||||
#ifdef JANET_WINDOWS
|
||||
void *tag; /* Used to associate listeners with an overlapped structure */
|
||||
int bytes; /* Used to track how many bytes were transfered. */
|
||||
#endif
|
||||
/* internal */
|
||||
size_t _index;
|
||||
int _mask;
|
||||
JanetListenerState *_next;
|
||||
};
|
||||
typedef long JanetAtomicInt;
|
||||
#else
|
||||
typedef int32_t JanetAtomicInt;
|
||||
#endif
|
||||
JANET_API JanetAtomicInt janet_atomic_inc(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_dec(JanetAtomicInt volatile *x);
|
||||
JANET_API JanetAtomicInt janet_atomic_load(JanetAtomicInt volatile *x);
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
@@ -654,10 +689,10 @@ struct JanetListenerState {
|
||||
* external bindings, we should prefer using the Head structs directly, and
|
||||
* use the host language to add sugar around the manipulation of the Janet types. */
|
||||
|
||||
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
|
||||
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
|
||||
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
|
||||
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
|
||||
JANET_API JanetStringHead *janet_string_head(JanetString s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
|
||||
|
||||
/* Some language bindings won't have access to the macro versions. */
|
||||
|
||||
@@ -666,42 +701,46 @@ JANET_API int janet_checktype(Janet x, JanetType type);
|
||||
JANET_API int janet_checktypes(Janet x, int typeflags);
|
||||
JANET_API int janet_truthy(Janet x);
|
||||
|
||||
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
|
||||
JANET_API const Janet *janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetStruct janet_unwrap_struct(Janet x);
|
||||
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
|
||||
JANET_API JanetArray *janet_unwrap_array(Janet x);
|
||||
JANET_API JanetTable *janet_unwrap_table(Janet x);
|
||||
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_string(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
|
||||
JANET_API void *janet_unwrap_abstract(Janet x);
|
||||
JANET_API JanetString janet_unwrap_string(Janet x);
|
||||
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
|
||||
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
|
||||
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
|
||||
JANET_API void *janet_unwrap_pointer(Janet x);
|
||||
JANET_API JanetFunction *janet_unwrap_function(Janet x);
|
||||
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
|
||||
JANET_API int janet_unwrap_boolean(Janet x);
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
JANET_API int32_t janet_unwrap_integer(Janet x);
|
||||
JANET_API size_t janet_unwrap_size(Janet x);
|
||||
JANET_API ssize_t janet_unwrap_ssize(Janet x);
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_string(JanetString x);
|
||||
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
|
||||
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_tuple(JanetTuple x);
|
||||
JANET_API Janet janet_wrap_struct(JanetStruct x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
JANET_API Janet janet_wrap_size(size_t x);
|
||||
JANET_API Janet janet_wrap_ssize(ssize_t x);
|
||||
|
||||
/***** END SECTION NON-C API *****/
|
||||
|
||||
@@ -731,6 +770,7 @@ JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
? janet_nanbox_isnumber(x) \
|
||||
: janet_nanbox_checkauxtype((x), (t)))
|
||||
|
||||
/* Use JANET_API so that modules will use a local version of these functions if possible */
|
||||
JANET_API void *janet_nanbox_to_pointer(Janet x);
|
||||
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
|
||||
@@ -777,14 +817,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
|
||||
|
||||
/* Unwrap the pointer types */
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
|
||||
@@ -826,15 +866,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
@@ -849,15 +889,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_truthy(x) \
|
||||
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
|
||||
|
||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
|
||||
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
|
||||
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
|
||||
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
|
||||
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).as.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||
@@ -869,14 +909,24 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#endif
|
||||
|
||||
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 int janet_checkssize(Janet x);
|
||||
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
|
||||
#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))
|
||||
#define janet_checkuint64range(x) ((x) >= 0 && (x) <= JANET_INTMAX_DOUBLE && (x) == (uint64_t)(x))
|
||||
#define janet_checksizerange(x) ((x) >= 0 && (x) <= JANET_INTMAX_SIZE && (x) == (size_t)(x))
|
||||
#define janet_checkssizerange(x) ((x) >= JANET_INTMIN_SIZE && (x) <= JANET_INTMAX_SIZE && (x) == (ssize_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
#define janet_unwrap_size(x) ((size_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_size(x) janet_wrap_number((size_t)(x))
|
||||
#define janet_unwrap_ssize(x) ((ssize_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_ssize(x) janet_wrap_number((ssize_t)(x))
|
||||
|
||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||
|
||||
@@ -887,7 +937,7 @@ struct JanetGCObject {
|
||||
int32_t flags;
|
||||
union {
|
||||
JanetGCObject *next;
|
||||
int32_t refcount; /* For threaded abstract types */
|
||||
volatile JanetAtomicInt refcount; /* For threaded abstract types */
|
||||
} data;
|
||||
};
|
||||
|
||||
@@ -910,8 +960,10 @@ struct JanetFiber {
|
||||
* that is, fibers that are scheduled on the event loop and behave much like threads
|
||||
* in a multi-tasking system. It would be possible to move these fields to a new
|
||||
* type, say "JanetTask", that as separate from fibers to save a bit of space. */
|
||||
JanetListenerState *waiting;
|
||||
uint32_t sched_id; /* Increment everytime fiber is scheduled by event loop */
|
||||
JanetEVCallback ev_callback; /* Call this before starting scheduled fibers */
|
||||
JanetStream *ev_stream; /* which stream we are waiting on */
|
||||
void *ev_state; /* Extra data for ev callback state. On windows, first element must be OVERLAPPED. */
|
||||
void *supervisor_channel; /* Channel to push self to when complete */
|
||||
#endif
|
||||
};
|
||||
@@ -938,25 +990,25 @@ struct JanetStackFrame {
|
||||
/* A dynamic array type. */
|
||||
struct JanetArray {
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
size_t count;
|
||||
size_t capacity;
|
||||
Janet *data;
|
||||
};
|
||||
|
||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||
struct JanetBuffer {
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
size_t count;
|
||||
size_t capacity;
|
||||
uint8_t *data;
|
||||
};
|
||||
|
||||
/* A mutable associative data type. Backed by a hashtable. */
|
||||
struct JanetTable {
|
||||
JanetGCObject gc;
|
||||
int32_t count;
|
||||
int32_t capacity;
|
||||
int32_t deleted;
|
||||
size_t count;
|
||||
size_t capacity;
|
||||
size_t deleted;
|
||||
JanetKV *data;
|
||||
JanetTable *proto;
|
||||
};
|
||||
@@ -970,7 +1022,7 @@ struct JanetKV {
|
||||
/* Prefix for a tuple */
|
||||
struct JanetTupleHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
size_t length;
|
||||
int32_t hash;
|
||||
int32_t sm_line;
|
||||
int32_t sm_column;
|
||||
@@ -980,9 +1032,9 @@ struct JanetTupleHead {
|
||||
/* Prefix for a struct */
|
||||
struct JanetStructHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
size_t length;
|
||||
int32_t hash;
|
||||
int32_t capacity;
|
||||
size_t capacity;
|
||||
const JanetKV *proto;
|
||||
const JanetKV data[];
|
||||
};
|
||||
@@ -990,7 +1042,7 @@ struct JanetStructHead {
|
||||
/* Prefix for a string */
|
||||
struct JanetStringHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
size_t length;
|
||||
int32_t hash;
|
||||
const uint8_t data[];
|
||||
};
|
||||
@@ -1174,23 +1226,23 @@ struct JanetMethod {
|
||||
|
||||
struct JanetView {
|
||||
const Janet *items;
|
||||
int32_t len;
|
||||
size_t len;
|
||||
};
|
||||
|
||||
struct JanetByteView {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
size_t len;
|
||||
};
|
||||
|
||||
struct JanetDictView {
|
||||
const JanetKV *kvs;
|
||||
int32_t len;
|
||||
int32_t cap;
|
||||
size_t len;
|
||||
size_t cap;
|
||||
};
|
||||
|
||||
struct JanetRange {
|
||||
int32_t start;
|
||||
int32_t end;
|
||||
size_t start;
|
||||
size_t end;
|
||||
};
|
||||
|
||||
struct JanetRNG {
|
||||
@@ -1260,11 +1312,13 @@ enum JanetOpCode {
|
||||
JOP_RETURN_NIL,
|
||||
JOP_ADD_IMMEDIATE,
|
||||
JOP_ADD,
|
||||
JOP_SUBTRACT_IMMEDIATE,
|
||||
JOP_SUBTRACT,
|
||||
JOP_MULTIPLY_IMMEDIATE,
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE,
|
||||
JOP_DIVIDE_FLOOR,
|
||||
JOP_MODULO,
|
||||
JOP_REMAINDER,
|
||||
JOP_BAND,
|
||||
@@ -1384,9 +1438,7 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
|
||||
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
|
||||
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Start a state machine listening for events from a stream */
|
||||
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
|
||||
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
|
||||
|
||||
/* Shorthand for yielding to event loop in C */
|
||||
JANET_NO_RETURN JANET_API void janet_await(void);
|
||||
@@ -1474,23 +1526,22 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
|
||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
|
||||
/* Read async from a stream */
|
||||
JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_API void janet_ev_connect(JanetStream *stream, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recv(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
#endif
|
||||
|
||||
/* Write async to a stream */
|
||||
JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
#ifdef JANET_NET
|
||||
JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
|
||||
JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
|
||||
JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
|
||||
JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_send_buffer(JanetStream *stream, JanetBuffer *buf, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_send_string(JanetStream *stream, JanetString str, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_sendto_buffer(JanetStream *stream, JanetBuffer *buf, void *dest, int flags);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, JanetString str, void *dest, int flags);
|
||||
#endif
|
||||
|
||||
#endif
|
||||
@@ -1550,17 +1601,17 @@ JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
/* Execute strings */
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, size_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
|
||||
/* Run the entrypoint of a wrapped program */
|
||||
JANET_API int janet_loop_fiber(JanetFiber *fiber);
|
||||
|
||||
/* Number scanning */
|
||||
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);
|
||||
JANET_API int janet_scan_number(const uint8_t *str, size_t len, double *out);
|
||||
JANET_API int janet_scan_number_base(const uint8_t *str, size_t len, int32_t base, double *out);
|
||||
JANET_API int janet_scan_int64(const uint8_t *str, size_t len, int64_t *out);
|
||||
JANET_API int janet_scan_uint64(const uint8_t *str, size_t len, uint64_t *out);
|
||||
|
||||
/* Debugging */
|
||||
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
@@ -1573,29 +1624,30 @@ JANET_API void janet_debug_find(
|
||||
extern JANET_API const JanetAbstractType janet_rng_type;
|
||||
JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
|
||||
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, size_t len);
|
||||
JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
|
||||
JANET_API double janet_rng_double(JanetRNG *rng);
|
||||
|
||||
/* Array functions */
|
||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
||||
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
|
||||
JANET_API JanetArray *janet_array(size_t capacity);
|
||||
JANET_API JanetArray *janet_array_weak(size_t capacity);
|
||||
JANET_API JanetArray *janet_array_n(const Janet *elements, size_t n);
|
||||
JANET_API void janet_array_ensure(JanetArray *array, size_t capacity, size_t growth);
|
||||
JANET_API void janet_array_setcount(JanetArray *array, size_t count);
|
||||
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
||||
JANET_API Janet janet_array_pop(JanetArray *array);
|
||||
JANET_API Janet janet_array_peek(JanetArray *array);
|
||||
|
||||
/* Buffer functions */
|
||||
#define JANET_BUFFER_FLAG_NO_REALLOC 0x10000
|
||||
JANET_API JanetBuffer *janet_buffer(int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
|
||||
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t count);
|
||||
JANET_API JanetBuffer *janet_buffer(size_t capacity);
|
||||
JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, size_t capacity);
|
||||
JANET_API JanetBuffer *janet_pointer_buffer_unsafe(void *memory, size_t capacity, size_t count);
|
||||
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
JANET_API void janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, size_t capacity, size_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, size_t count);
|
||||
JANET_API void janet_buffer_extra(JanetBuffer *buffer, size_t n);
|
||||
JANET_API void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, size_t len);
|
||||
JANET_API void janet_buffer_push_string(JanetBuffer *buffer, JanetString string);
|
||||
JANET_API void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
@@ -1608,27 +1660,27 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
#define janet_tuple_sm_column(t) (janet_tuple_head(t)->sm_column)
|
||||
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API Janet *janet_tuple_begin(size_t length);
|
||||
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
|
||||
JANET_API JanetTuple janet_tuple_n(const Janet *values, size_t n);
|
||||
|
||||
/* String/Symbol functions */
|
||||
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||
#define janet_string_length(s) (janet_string_head(s)->length)
|
||||
#define janet_string_hash(s) (janet_string_head(s)->hash)
|
||||
JANET_API uint8_t *janet_string_begin(int32_t length);
|
||||
JANET_API uint8_t *janet_string_begin(size_t length);
|
||||
JANET_API JanetString janet_string_end(uint8_t *str);
|
||||
JANET_API JanetString janet_string(const uint8_t *buf, int32_t len);
|
||||
JANET_API JanetString janet_string(const uint8_t *buf, size_t len);
|
||||
JANET_API JanetString janet_cstring(const char *cstring);
|
||||
JANET_API int janet_string_compare(JanetString lhs, JanetString rhs);
|
||||
JANET_API int janet_string_equal(JanetString lhs, JanetString rhs);
|
||||
JANET_API int janet_string_equalconst(JanetString lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash);
|
||||
JANET_API int janet_string_equalconst(JanetString lhs, const uint8_t *rhs, size_t rlen, int32_t rhash);
|
||||
JANET_API JanetString janet_description(Janet x);
|
||||
JANET_API JanetString janet_to_string(Janet x);
|
||||
JANET_API void janet_to_string_b(JanetBuffer *buffer, Janet x);
|
||||
@@ -1640,7 +1692,7 @@ JANET_API JanetBuffer *janet_formatb(JanetBuffer *bufp, const char *format, ...)
|
||||
JANET_API void janet_formatbv(JanetBuffer *bufp, const char *format, va_list args);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, int32_t len);
|
||||
JANET_API JanetSymbol janet_symbol(const uint8_t *str, size_t len);
|
||||
JANET_API JanetSymbol janet_csymbol(const char *str);
|
||||
JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
#define janet_symbolv(str, len) janet_wrap_symbol(janet_symbol((str), (len)))
|
||||
@@ -1654,12 +1706,12 @@ JANET_API JanetSymbol janet_symbol_gen(void);
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
|
||||
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||
#define janet_struct_proto(t) (janet_struct_head(t)->proto)
|
||||
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||
JANET_API JanetKV *janet_struct_begin(size_t count);
|
||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API JanetStruct janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(JanetStruct st, Janet key);
|
||||
@@ -1669,9 +1721,9 @@ JANET_API JanetTable *janet_struct_to_table(JanetStruct st);
|
||||
JANET_API const JanetKV *janet_struct_find(JanetStruct st, Janet key);
|
||||
|
||||
/* Table functions */
|
||||
JANET_API JanetTable *janet_table(int32_t capacity);
|
||||
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
|
||||
JANET_API JanetTable *janet_table_init_raw(JanetTable *table, int32_t capacity);
|
||||
JANET_API JanetTable *janet_table(size_t capacity);
|
||||
JANET_API JanetTable *janet_table_init(JanetTable *table, size_t capacity);
|
||||
JANET_API JanetTable *janet_table_init_raw(JanetTable *table, size_t capacity);
|
||||
JANET_API void janet_table_deinit(JanetTable *table);
|
||||
JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
|
||||
@@ -1694,11 +1746,11 @@ JANET_API JanetFiber *janet_current_fiber(void);
|
||||
JANET_API JanetFiber *janet_root_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
JANET_API int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len);
|
||||
JANET_API int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t *cap);
|
||||
JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key);
|
||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, size_t *len);
|
||||
JANET_API int janet_bytes_view(Janet str, const uint8_t **data, size_t *len);
|
||||
JANET_API int janet_dictionary_view(Janet tab, const JanetKV **data, size_t *len, size_t *cap);
|
||||
JANET_API Janet janet_dictionary_get(const JanetKV *data, size_t cap, Janet key);
|
||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, size_t cap, const JanetKV *kv);
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
@@ -1774,17 +1826,17 @@ JANET_API int janet_cstrcmp(JanetString str, const char *other);
|
||||
JANET_API Janet janet_in(Janet ds, Janet key);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_next(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API Janet janet_getindex(Janet ds, size_t index);
|
||||
JANET_API size_t janet_length(Janet x);
|
||||
JANET_API Janet janet_lengthv(Janet x);
|
||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, size_t index, Janet value);
|
||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||
JANET_API Janet janet_wrap_number_safe(double x);
|
||||
JANET_API int janet_keyeq(Janet x, const char *cstring);
|
||||
JANET_API int janet_streq(Janet x, const char *cstring);
|
||||
JANET_API int janet_symeq(Janet x, const char *cstring);
|
||||
JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
|
||||
JANET_API int32_t janet_sorted_keys(const JanetKV *dict, size_t cap, int32_t *index_buffer);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1795,6 +1847,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
|
||||
JANET_API void janet_vm_save(JanetVM *into);
|
||||
JANET_API void janet_vm_load(JanetVM *from);
|
||||
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
||||
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
@@ -1809,13 +1862,17 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
||||
#define JANET_SANDBOX_SUBPROCESS 2
|
||||
#define JANET_SANDBOX_NET_CONNECT 4
|
||||
#define JANET_SANDBOX_NET_LISTEN 8
|
||||
#define JANET_SANDBOX_FFI 16
|
||||
#define JANET_SANDBOX_FFI_DEFINE 16
|
||||
#define JANET_SANDBOX_FS_WRITE 32
|
||||
#define JANET_SANDBOX_FS_READ 64
|
||||
#define JANET_SANDBOX_HRTIME 128
|
||||
#define JANET_SANDBOX_ENV 256
|
||||
#define JANET_SANDBOX_DYNAMIC_MODULES 512
|
||||
#define JANET_SANDBOX_FS_TEMP 1024
|
||||
#define JANET_SANDBOX_FFI_USE 2048
|
||||
#define JANET_SANDBOX_FFI_JIT 4096
|
||||
#define JANET_SANDBOX_SIGNAL 8192
|
||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
||||
@@ -1902,7 +1959,6 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
|
||||
|
||||
|
||||
/* Choose defaults for source mapping and docstring based on config defs */
|
||||
#if defined(JANET_NO_SOURCEMAPS) && defined(JANET_NO_DOCSTRINGS)
|
||||
#define JANET_REG JANET_REG_
|
||||
@@ -1939,10 +1995,10 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
#endif
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_MODULE_PREFIX JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
JANET_MODULE_PREFIX JANET_EXPORT JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_MODULE_PREFIX JANET_API void _janet_init
|
||||
JANET_MODULE_PREFIX JANET_EXPORT void _janet_init
|
||||
#else
|
||||
#define JANET_MODULE_ENTRY JANET_MODULE_PREFIX JANET_API void JANET_ENTRY_NAME
|
||||
#endif
|
||||
@@ -1985,13 +2041,16 @@ JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||
JANET_API int64_t janet_getinteger64(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 ssize_t janet_getssize(const Janet *argv, int32_t n);
|
||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
||||
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API size_t janet_gethalfrange(const Janet *argv, int32_t n, size_t length, const char *which);
|
||||
JANET_API size_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, size_t length);
|
||||
JANET_API size_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, size_t length);
|
||||
JANET_API size_t janet_getargindex(const Janet *argv, int32_t n, size_t length, const char *which);
|
||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||
|
||||
/* Optionals */
|
||||
@@ -2012,12 +2071,13 @@ JANET_API int32_t janet_optnat(const Janet *argv, int32_t argc, int32_t n, int32
|
||||
JANET_API int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt);
|
||||
JANET_API int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt);
|
||||
JANET_API size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt);
|
||||
JANET_API ssize_t janet_optssize(const Janet *argv, int32_t argc, int32_t n, ssize_t dflt);
|
||||
JANET_API JanetAbstract janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, JanetAbstract dflt);
|
||||
|
||||
/* Mutable optional types specify a size default, and construct a new value if none is provided */
|
||||
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
JANET_API JanetTable *janet_opttable(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, size_t dflt_len);
|
||||
JANET_API JanetTable *janet_opttable(const Janet *argv, int32_t argc, int32_t n, size_t dflt_len);
|
||||
JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n, size_t dflt_len);
|
||||
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
@@ -2049,6 +2109,7 @@ JANET_API int janet_cryptorand(uint8_t *out, size_t n);
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_ptr(JanetMarshalContext *ctx, const void *value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
@@ -2058,10 +2119,12 @@ JANET_API void janet_unmarshal_ensure(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API void *janet_unmarshal_ptr(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
|
||||
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
|
||||
|
||||
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||
@@ -2104,7 +2167,9 @@ typedef enum {
|
||||
RULE_LINE, /* [tag] */
|
||||
RULE_COLUMN, /* [tag] */
|
||||
RULE_UNREF, /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM /* [rule, tag] */
|
||||
RULE_CAPTURE_NUM, /* [rule, tag] */
|
||||
RULE_SUB, /* [rule, rule] */
|
||||
RULE_SPLIT /* [rule, rule] */
|
||||
} JanetPegOpcod;
|
||||
|
||||
typedef struct {
|
||||
@@ -2133,8 +2198,8 @@ JANET_API Janet janet_wrap_s64(int64_t x);
|
||||
JANET_API Janet janet_wrap_u64(uint64_t x);
|
||||
JANET_API int64_t janet_unwrap_s64(Janet x);
|
||||
JANET_API uint64_t janet_unwrap_u64(Janet x);
|
||||
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);
|
||||
JANET_API int janet_scan_int64(const uint8_t *str, size_t len, int64_t *out);
|
||||
JANET_API int janet_scan_uint64(const uint8_t *str, size_t len, uint64_t *out);
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
@@ -502,10 +502,10 @@ static void kright(void) {
|
||||
}
|
||||
|
||||
static void krightw(void) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
while (gbl_pos != gbl_len && isspace(gbl_buf[gbl_pos])) {
|
||||
while (gbl_pos != gbl_len && !isspace(gbl_buf[gbl_pos])) {
|
||||
gbl_pos++;
|
||||
}
|
||||
refresh();
|
||||
@@ -548,7 +548,6 @@ static void kdeletew(void) {
|
||||
refresh();
|
||||
}
|
||||
|
||||
|
||||
/* See tools/symchargen.c */
|
||||
static int is_symbol_char_gen(uint8_t c) {
|
||||
if (c & 0x80) return 1;
|
||||
@@ -627,7 +626,7 @@ static JanetByteView longest_common_prefix(void) {
|
||||
bv = gbl_matches[0];
|
||||
for (int i = 0; i < gbl_match_count; i++) {
|
||||
JanetByteView other = gbl_matches[i];
|
||||
int32_t minlen = other.len < bv.len ? other.len : bv.len;
|
||||
size_t minlen = other.len < bv.len ? other.len : bv.len;
|
||||
for (bv.len = 0; bv.len < minlen; bv.len++) {
|
||||
if (bv.bytes[bv.len] != other.bytes[bv.len]) {
|
||||
break;
|
||||
@@ -692,7 +691,7 @@ static void doc_format(JanetString doc, int32_t width) {
|
||||
int32_t current = 0;
|
||||
if (maxcol > 200) maxcol = 200;
|
||||
fprintf(stderr, " ");
|
||||
for (int32_t i = 0; i < janet_string_length(doc); i++) {
|
||||
for (size_t i = 0; i < janet_string_length(doc); i++) {
|
||||
uint8_t b = doc[i];
|
||||
switch (b) {
|
||||
default: {
|
||||
@@ -815,13 +814,13 @@ static void kshowcomp(void) {
|
||||
check_specials(prefix);
|
||||
|
||||
JanetByteView lcp = longest_common_prefix();
|
||||
for (int i = prefix.len; i < lcp.len; i++) {
|
||||
for (size_t i = prefix.len; i < lcp.len; i++) {
|
||||
insert(lcp.bytes[i], 0);
|
||||
}
|
||||
|
||||
if (!gbl_lines_below && prefix.len != lcp.len) return;
|
||||
|
||||
int32_t maxlen = 0;
|
||||
size_t maxlen = 0;
|
||||
for (int i = 0; i < gbl_match_count; i++)
|
||||
if (gbl_matches[i].len > maxlen)
|
||||
maxlen = gbl_matches[i].len;
|
||||
|
||||
@@ -2,7 +2,7 @@
|
||||
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var suite-name 0)
|
||||
(var start-time 0)
|
||||
|
||||
(def is-verbose (os/getenv "VERBOSE"))
|
||||
@@ -14,9 +14,12 @@
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(def str (string e))
|
||||
(def frame (last (debug/stack (fiber/current))))
|
||||
(def line-info (string/format "%s:%d"
|
||||
(frame :source) (frame :source-line)))
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %v" (describe e) x))
|
||||
(eprintf "\e[31m✘\e[0m %s: %v" (describe e) 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)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
@@ -31,16 +34,23 @@
|
||||
|
||||
(defmacro assert-no-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
(def e (gensym))
|
||||
(def f (gensym))
|
||||
(if is-verbose
|
||||
~(try (do ,;forms (,assert true ,msg)) ([,e ,f] (,assert false ,msg) (,debug/stacktrace ,f ,e "\e[31m✘\e[0m ")))
|
||||
~(try (do ,;forms (,assert true ,msg)) ([_] (,assert false ,msg)))))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(defn start-suite [&opt x]
|
||||
(default x (dyn :current-file))
|
||||
(set suite-name
|
||||
(cond
|
||||
(number? x) (string x)
|
||||
(string x)))
|
||||
(set start-time (os/clock))
|
||||
(eprint "Starting suite " x "..."))
|
||||
(eprint "Starting suite " suite-name "..."))
|
||||
|
||||
(defn end-suite []
|
||||
(def delta (- (os/clock) start-time))
|
||||
(eprinf "Finished suite %d in %.3f seconds - " suite-num delta)
|
||||
(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)))
|
||||
|
||||
81
test/suite-array.janet
Normal file
81
test/suite-array.janet
Normal file
@@ -0,0 +1,81 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Array tests
|
||||
# e05022f
|
||||
(defn array=
|
||||
"Check if two arrays are equal in an element by element comparison"
|
||||
[a b]
|
||||
(if (and (array? a) (array? b))
|
||||
(= (apply tuple a) (apply tuple b))))
|
||||
(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
|
||||
(def arr (array))
|
||||
(array/push arr :hello)
|
||||
(array/push arr :world)
|
||||
(assert (array= arr @[:hello :world]) "array comparison")
|
||||
(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
|
||||
(assert (array= @[:one :two :three :four :five]
|
||||
@[:one :two :three :four :five]) "array comparison 3")
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
|
||||
|
||||
# Array remove
|
||||
# 687a3c9
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
|
||||
(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")
|
||||
|
||||
# array/fill
|
||||
(assert (deep= (array/fill @[1 1] 2) @[2 2]) "array/fill 1")
|
||||
|
||||
# array/concat
|
||||
(assert (deep= (array/concat @[1 2] @[3 4] 5 6) @[1 2 3 4 5 6]) "array/concat 1")
|
||||
(def a @[1 2])
|
||||
(assert (deep= (array/concat a a) @[1 2 1 2]) "array/concat self")
|
||||
|
||||
# array/insert
|
||||
(assert (deep= (array/insert @[:a :a :a :a] 2 :b :b) @[:a :a :b :b :a :a]) "array/insert 1")
|
||||
(assert (deep= (array/insert @[:a :b] -1 :c :d) @[:a :b :c :d]) "array/insert 2")
|
||||
|
||||
# array/remove
|
||||
(assert-error "removal index 3 out of range [0,2]" (array/remove @[1 2] 3))
|
||||
(assert-error "expected non-negative integer for argument n, got -1" (array/remove @[1 2] 1 -1))
|
||||
|
||||
# array/pop
|
||||
(assert (= (array/pop @[1]) 1) "array/pop 1")
|
||||
(assert (= (array/pop @[]) nil) "array/pop empty")
|
||||
|
||||
# Code coverage
|
||||
(def a @[1])
|
||||
(array/pop a)
|
||||
(array/trim a)
|
||||
(array/ensure @[1 1] 6 2)
|
||||
|
||||
|
||||
(end-suite)
|
||||
|
||||
63
test/suite-asm.janet
Normal file
63
test/suite-asm.janet
Normal file
@@ -0,0 +1,63 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
# a679f60
|
||||
(def fibasm (asm '{
|
||||
:arity 1
|
||||
:bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
(assert (= 0 (fibasm 0)) "fibasm 1")
|
||||
(assert (= 1 (fibasm 1)) "fibasm 2")
|
||||
(assert (= 55 (fibasm 10)) "fibasm 3")
|
||||
(assert (= 6765 (fibasm 20)) "fibasm 4")
|
||||
|
||||
# dacbe29
|
||||
(def f (asm (disasm (fn [x] (fn [y] (+ x y))))))
|
||||
(assert (= ((f 10) 37) 47) "asm environment tables")
|
||||
|
||||
# issue #1424
|
||||
(assert-no-error "arity > used slots (issue #1424)"
|
||||
(asm
|
||||
(disasm
|
||||
(fn []
|
||||
(def foo (fn [one two] one))
|
||||
(foo 100 200)))))
|
||||
|
||||
(end-suite)
|
||||
|
||||
979
test/suite-boot.janet
Normal file
979
test/suite-boot.janet
Normal file
@@ -0,0 +1,979 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Let
|
||||
# 807f981
|
||||
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
|
||||
(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
|
||||
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10)
|
||||
"double destructured let")
|
||||
|
||||
# Macros
|
||||
# b305a7c
|
||||
(defn dub [x] (+ x x))
|
||||
(assert (= 2 (dub 1)) "defn macro")
|
||||
(do
|
||||
(defn trip [x] (+ x x x))
|
||||
(assert (= 3 (trip 1)) "defn macro triple"))
|
||||
(do
|
||||
(var i 0)
|
||||
(when true
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i))
|
||||
(assert (= i 6) "when macro"))
|
||||
|
||||
# Add truthy? to core
|
||||
# ded08b6
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
## Polymorphic comparison -- Issue #272
|
||||
# 81d301a42
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
|
||||
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
|
||||
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
||||
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
||||
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
||||
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
||||
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
||||
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
||||
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0)
|
||||
"compare less than or equal to reals")
|
||||
(assert (compare>= 6 5 4 4 3 2 1)
|
||||
"compare greater than or equal to integers")
|
||||
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0)
|
||||
"compare greater than or equal to reals")
|
||||
(assert (compare< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "compare type ordering")
|
||||
|
||||
# test polymorphic compare with 'objects' (table/setproto)
|
||||
(def mynum
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (cmp (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(cmp (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
(assert (= -1 (compare n3 4)) "compare object to num (2)")
|
||||
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3))
|
||||
"compare object to object")
|
||||
(assert (compare< 2 n3 4) "compare< poly")
|
||||
(assert (compare> 4 n3 2) "compare> poly")
|
||||
(assert (compare<= 2 3 n3 4) "compare<= poly")
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5])
|
||||
"polymorphic sort"))
|
||||
|
||||
# Add any? predicate to core
|
||||
# 7478ad11
|
||||
(assert (= nil (any? [])) "any? 1")
|
||||
(assert (= nil (any? [false nil])) "any? 2")
|
||||
(assert (= false (any? [nil false])) "any? 3")
|
||||
(assert (= 1 (any? [1])) "any? 4")
|
||||
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
||||
(assert (= true
|
||||
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
|
||||
"any? 6")
|
||||
|
||||
(assert (= true (every? [])) "every? 1")
|
||||
(assert (= true (every? [1 true])) "every? 2")
|
||||
(assert (= 1 (every? [true 1])) "every? 3")
|
||||
(assert (= nil (every? [nil])) "every? 4")
|
||||
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
|
||||
(assert (= false
|
||||
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
|
||||
"every? 6")
|
||||
|
||||
# Some higher order functions and macros
|
||||
# 5e2de33
|
||||
(def my-array @[1 2 3 4 5 6])
|
||||
(assert (= (if-let [x (get my-array 5)] x) 6) "if-let 1")
|
||||
(assert (= (if-let [y (get @{} :key)] 10 nil) nil) "if-let 2")
|
||||
(assert (= (if-let [a my-array k (next a)] :t :f) :t) "if-let 3")
|
||||
(assert (= (if-let [a my-array k (next a 5)] :t :f) :f) "if-let 4")
|
||||
(assert (= (if-let [[a b] my-array] a) 1) "if-let 5")
|
||||
(assert (= (if-let [{:a a :b b} {:a 1 :b 2}] b) 2) "if-let 6")
|
||||
(assert (= (if-let [[a b] nil] :t :f) :f) "if-let 7")
|
||||
|
||||
# #1191
|
||||
(var cnt 0)
|
||||
(defmacro upcnt [] (++ cnt))
|
||||
(assert (= (if-let [a true b true c true] nil (upcnt)) nil) "issue #1191")
|
||||
(assert (= cnt 1) "issue #1191")
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
# 5249228
|
||||
(assert
|
||||
(= :six (case (+ 1 2 3)
|
||||
1 :one
|
||||
2 :two
|
||||
3 :three
|
||||
4 :four
|
||||
5 :five
|
||||
6 :six
|
||||
7 :seven
|
||||
8 :eight
|
||||
9 :nine)) "case macro")
|
||||
|
||||
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
|
||||
|
||||
# Testing the seq, tabseq, catseq, and loop macros
|
||||
# 547529e
|
||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)]
|
||||
(tuple (/ x 2) x))))
|
||||
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
|
||||
|
||||
# 624be87c9
|
||||
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)]
|
||||
(tuple (/ x 2) x))))
|
||||
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
||||
|
||||
# Looping idea
|
||||
# 45f8db0
|
||||
(def xs
|
||||
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(def txs (apply tuple xs))
|
||||
|
||||
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
|
||||
"nested seq")
|
||||
|
||||
# :unless modifier
|
||||
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
|
||||
@[0 2 4 6 8])
|
||||
":unless modifier")
|
||||
|
||||
# 515891b03
|
||||
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||
@{0 0 1 3 2 6}))
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i)
|
||||
@{}))
|
||||
|
||||
# ccd874fe4
|
||||
(def xs (catseq [x :range [0 3]] [x x]))
|
||||
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
|
||||
|
||||
# :range-to and :down-to
|
||||
# e0c9910d8
|
||||
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x))
|
||||
"loop :range-to")
|
||||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
|
||||
"loop :down-to")
|
||||
|
||||
# one-term :range forms
|
||||
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
|
||||
"one-term :range")
|
||||
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
|
||||
"one-term :down")
|
||||
|
||||
# 7880d7320
|
||||
(def res @{})
|
||||
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
||||
(put res k v))
|
||||
(assert (and
|
||||
(= (get res 1) 2)
|
||||
(= (get res 3) 4)
|
||||
(= (get res 5) 6)) "loop :pairs")
|
||||
|
||||
# Issue #428
|
||||
# 08a3687eb
|
||||
(var result nil)
|
||||
(defn f [] (yield {:a :ok}))
|
||||
(assert-no-error "issue 428 1"
|
||||
(loop [{:a x} :in (fiber/new f)] (set result x)))
|
||||
(assert (= result :ok) "issue 428 2")
|
||||
|
||||
# Generators
|
||||
# 184fe31e0
|
||||
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
||||
(var gencount 0)
|
||||
(loop [x :in gen]
|
||||
(++ gencount)
|
||||
(assert (pos? (% x 4)) "generate in loop"))
|
||||
(assert (= gencount 75) "generate loop count")
|
||||
|
||||
# more loop checks
|
||||
(assert (deep= (seq [i :range [0 10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 1")
|
||||
(assert (deep= (seq [i :range [0 10 2]] i) @[0 2 4 6 8]) "seq 2")
|
||||
(assert (deep= (seq [i :range [10]] i) @[0 1 2 3 4 5 6 7 8 9]) "seq 3")
|
||||
(assert (deep= (seq [i :range-to [10]] i) @[0 1 2 3 4 5 6 7 8 9 10]) "seq 4")
|
||||
(def gen (generate [x :range-to [0 nil 2]] x))
|
||||
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit")
|
||||
(def gen (generate [x :range [0 nil 2]] x))
|
||||
(assert (deep= (take 5 gen) @[0 2 4 6 8]) "generate nil limit 2")
|
||||
|
||||
# Even and odd
|
||||
# ff163a5ae
|
||||
(assert (odd? 9) "odd? 1")
|
||||
(assert (odd? -9) "odd? 2")
|
||||
(assert (not (odd? 10)) "odd? 3")
|
||||
(assert (not (odd? 0)) "odd? 4")
|
||||
(assert (not (odd? -10)) "odd? 5")
|
||||
(assert (not (odd? 1.1)) "odd? 6")
|
||||
(assert (not (odd? -0.1)) "odd? 7")
|
||||
(assert (not (odd? -1.1)) "odd? 8")
|
||||
(assert (not (odd? -1.6)) "odd? 9")
|
||||
|
||||
(assert (even? 10) "even? 1")
|
||||
(assert (even? -10) "even? 2")
|
||||
(assert (even? 0) "even? 3")
|
||||
(assert (not (even? 9)) "even? 4")
|
||||
(assert (not (even? -9)) "even? 5")
|
||||
(assert (not (even? 0.1)) "even? 6")
|
||||
(assert (not (even? -0.1)) "even? 7")
|
||||
(assert (not (even? -10.1)) "even? 8")
|
||||
(assert (not (even? -10.6)) "even? 9")
|
||||
|
||||
# Map arities
|
||||
# 25ded775a
|
||||
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000])
|
||||
@[1111 2222 3333]))
|
||||
(assert (deep= (map +
|
||||
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
|
||||
[10000 20000 30000])
|
||||
@[11111 22222 33333]))
|
||||
# 77e62a2
|
||||
(assert (deep= (map +
|
||||
[1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]
|
||||
[10000 20000 30000] [100000 200000 300000])
|
||||
@[111111 222222 333333]))
|
||||
|
||||
# Mapping uses the shortest sequence
|
||||
# a69799aa4
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
|
||||
# 77e62a2
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
|
||||
|
||||
# Variadic arguments to map-like functions
|
||||
# 77e62a2
|
||||
(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
|
||||
(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1])
|
||||
@[1 1 3 5]))
|
||||
|
||||
(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
|
||||
|
||||
(assert (= (some not= (range 5) (range 5)) nil))
|
||||
(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
|
||||
|
||||
(assert (= (all = (range 5) (range 5)) true))
|
||||
(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
|
||||
|
||||
# 4194374
|
||||
(assert (= false (deep-not= [1] [1])) "issue #1149")
|
||||
|
||||
# Merge sort
|
||||
# f5b29b8
|
||||
# Imperative (and verbose) merge sort merge
|
||||
(defn merge-sort
|
||||
[xs ys]
|
||||
(def ret @[])
|
||||
(def xlen (length xs))
|
||||
(def ylen (length ys))
|
||||
(var i 0)
|
||||
(var j 0)
|
||||
# Main merge
|
||||
(while (if (< i xlen) (< j ylen))
|
||||
(def xi (get xs i))
|
||||
(def yj (get ys j))
|
||||
(if (< xi yj)
|
||||
(do (array/push ret xi) (set i (+ i 1)))
|
||||
(do (array/push ret yj) (set j (+ j 1)))))
|
||||
# Push rest of xs
|
||||
(while (< i xlen)
|
||||
(def xi (get xs i))
|
||||
(array/push ret xi)
|
||||
(set i (+ i 1)))
|
||||
# Push rest of ys
|
||||
(while (< j ylen)
|
||||
(def yj (get ys j))
|
||||
(array/push ret yj)
|
||||
(set j (+ j 1)))
|
||||
ret)
|
||||
|
||||
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6])) "merge sort merge 1")
|
||||
(assert (apply <= (merge-sort @[1 2 3] @[4 5 6])) "merge sort merge 2")
|
||||
(assert (apply <= (merge-sort @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
||||
(assert (apply <= (merge-sort '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
||||
|
||||
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
|
||||
(sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
||||
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}]
|
||||
(sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
||||
|
||||
# Sort function
|
||||
# 2ca9300bf
|
||||
(assert (deep=
|
||||
(range 99)
|
||||
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99)))))
|
||||
"sort 5")
|
||||
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
||||
|
||||
# #1283
|
||||
(assert (deep=
|
||||
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
|
||||
'@[(:a :b) (:c :d) (:e)]))
|
||||
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
|
||||
5.6))
|
||||
|
||||
# And and or
|
||||
# c16a9d846
|
||||
(assert (= (and true true) true) "and true true")
|
||||
(assert (= (and true false) false) "and true false")
|
||||
(assert (= (and false true) false) "and false true")
|
||||
(assert (= (and true true true) true) "and true true true")
|
||||
(assert (= (and 0 1 2) 2) "and 0 1 2")
|
||||
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
|
||||
(assert (= (and 1) 1) "and 1")
|
||||
(assert (= (and) true) "and with no arguments")
|
||||
(assert (= (and 1 true) true) "and with trailing true")
|
||||
(assert (= (and 1 true 2) 2) "and with internal true")
|
||||
|
||||
(assert (= (or true true) true) "or true true")
|
||||
(assert (= (or true false) true) "or true false")
|
||||
(assert (= (or false true) true) "or false true")
|
||||
(assert (= (or false false) false) "or false true")
|
||||
(assert (= (or true true false) true) "or true true false")
|
||||
(assert (= (or 0 1 2) 0) "or 0 1 2")
|
||||
(assert (= (or nil 1 2) 1) "or nil 1 2")
|
||||
(assert (= (or 1) 1) "or 1")
|
||||
(assert (= (or) nil) "or with no arguments")
|
||||
|
||||
# And/or checks
|
||||
# 6123c41f1
|
||||
(assert (= false (and false false)) "and 1")
|
||||
(assert (= false (or false false)) "or 1")
|
||||
|
||||
# 11cd1279d
|
||||
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
|
||||
|
||||
# bc8be266f
|
||||
(def- a 100)
|
||||
(assert (= a 100) "def-")
|
||||
|
||||
# bc8be266f
|
||||
(assert (= :first
|
||||
(match @[1 3 5]
|
||||
@[x y z] :first
|
||||
:second)) "match 1")
|
||||
|
||||
(def val1 :avalue)
|
||||
(assert (= :second
|
||||
(match val1
|
||||
@[x y z] :first
|
||||
:avalue :second
|
||||
:third)) "match 2")
|
||||
|
||||
(assert (= 100
|
||||
(match @[50 40]
|
||||
@[x x] (* x 3)
|
||||
@[x y] (+ x y 10)
|
||||
0)) "match 3")
|
||||
|
||||
# Match checks
|
||||
# 47e8f669f
|
||||
(assert (= :hi (match nil nil :hi)) "match 1")
|
||||
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
|
||||
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
|
||||
(assert (= nil (match [1 2] [a b c] a)) "match 4")
|
||||
(assert (= 2 (match [1 2] [a b] b)) "match 5")
|
||||
# db631097b
|
||||
(assert (= [2 :a :b] (match [1 2 :a :b] [o & rest] rest)) "match 6")
|
||||
(assert (= [] (match @[:a] @[x & r] r :fallback)) "match 7")
|
||||
(assert (= :fallback (match @[1] @[x y & r] r :fallback)) "match 8")
|
||||
(assert (= [1 2 3 4] (match @[1 2 3 4] @[x y z & r] [x y z ;r] :fallback))
|
||||
"match 9")
|
||||
|
||||
# Test cases for #293
|
||||
# d3b9b8d45
|
||||
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
|
||||
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
|
||||
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no))
|
||||
"match wildcard 3")
|
||||
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
|
||||
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
|
||||
(assert (= false (match {:a 1 :b 2 :c 3}
|
||||
{:a a :b _ :c _ :d _} :no
|
||||
{:a _ :b _ :c _} false
|
||||
:no)) "match wildcard 6")
|
||||
(assert (= nil (match {:a 1 :b 2 :c 3}
|
||||
{:a a :b _ :c _ :d _} :no
|
||||
{:a _ :b _ :c _} nil
|
||||
:no)) "match wildcard 7")
|
||||
# issue #529 - 602010600
|
||||
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
|
||||
|
||||
# quoted match test
|
||||
# 425a0fcf0
|
||||
(assert (= :yes (match 'john 'john :yes _ :nope)) "quoted literal match 1")
|
||||
(assert (= :nope (match 'john ''john :yes _ :nope)) "quoted literal match 2")
|
||||
|
||||
# Some macros
|
||||
# 7880d7320
|
||||
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
||||
(assert (= 3 (if-not false 3)) "if-not 2")
|
||||
(assert (= 3 (if-not nil 3 2)) "if-not 3")
|
||||
(assert (= nil (if-not true 3)) "if-not 4")
|
||||
|
||||
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
|
||||
|
||||
# take
|
||||
# 18da183ef
|
||||
(assert (deep= (take 0 []) []) "take 1")
|
||||
(assert (deep= (take 10 []) []) "take 2")
|
||||
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
|
||||
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
|
||||
(assert (deep= (take -1 [:a :b :c]) [:c]) "take 5")
|
||||
# 34019222c
|
||||
(assert (deep= (take 3 (generate [x :in [1 2 3 4 5]] x)) @[1 2 3])
|
||||
"take from fiber")
|
||||
# NB: repeatedly resuming a fiber created with `generate` includes a `nil`
|
||||
# as the final element. Thus a generate of 2 elements will create an array
|
||||
# of 3.
|
||||
(assert (= (length (take 4 (generate [x :in [1 2]] x))) 2)
|
||||
"take from short fiber")
|
||||
|
||||
# take-until
|
||||
# 18da183ef
|
||||
(assert (deep= (take-until pos? @[]) []) "take-until 1")
|
||||
(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
|
||||
(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
|
||||
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
|
||||
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
|
||||
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
|
||||
(assert (deep= (take-until |(= $ 115) (generate [x :in "books"] x))
|
||||
@[98 111 111 107]) "take-until from fiber")
|
||||
|
||||
# take-while
|
||||
# 18da183ef
|
||||
(assert (deep= (take-while neg? @[]) []) "take-while 1")
|
||||
(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
|
||||
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
|
||||
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
|
||||
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
|
||||
(assert (deep= (take-while neg? (generate [x :in @[-1 1 -2]] x))
|
||||
@[-1]) "take-while from fiber")
|
||||
|
||||
# drop
|
||||
# 18da183ef
|
||||
(assert (deep= (drop 0 []) []) "drop 1")
|
||||
(assert (deep= (drop 10 []) []) "drop 2")
|
||||
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
|
||||
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
|
||||
(assert (deep= (drop -1 [1 2 3]) [1 2]) "drop 5")
|
||||
(assert (deep= (drop -10 [1 2 3]) []) "drop 6")
|
||||
(assert (deep= (drop 1 "abc") "bc") "drop 7")
|
||||
(assert (deep= (drop 10 "abc") "") "drop 8")
|
||||
(assert (deep= (drop -1 "abc") "ab") "drop 9")
|
||||
(assert (deep= (drop -10 "abc") "") "drop 10")
|
||||
|
||||
# drop-until
|
||||
# 75dc08f
|
||||
(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
|
||||
(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
|
||||
(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
|
||||
(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
|
||||
|
||||
# take-drop symmetry #1178
|
||||
(def items-list ['abcde :abcde "abcde" @"abcde" [1 2 3 4 5] @[1 2 3 4 5]])
|
||||
|
||||
(each items items-list
|
||||
(def len (length items))
|
||||
(for i 0 (+ len 1)
|
||||
(assert (deep= (take i items) (drop (- i len) items)) (string/format "take-drop symmetry %q %d" items i))
|
||||
(assert (deep= (take (- i) items) (drop (- len i) items)) (string/format "take-drop symmetry %q %d" items i))))
|
||||
|
||||
(defn squares []
|
||||
(coro
|
||||
(var [a b] [0 1])
|
||||
(forever (yield a) (+= a b) (+= b 2))))
|
||||
|
||||
(def sqr1 (squares))
|
||||
(assert (deep= (take 10 sqr1) @[0 1 4 9 16 25 36 49 64 81]))
|
||||
(assert (deep= (take 1 sqr1) @[100]) "take fiber next value")
|
||||
|
||||
(def sqr2 (drop 10 (squares)))
|
||||
(assert (deep= (take 1 sqr2) @[100]) "drop fiber next value")
|
||||
|
||||
(def dict @{:a 1 :b 2 :c 3 :d 4 :e 5})
|
||||
(def dict1 (take 2 dict))
|
||||
(def dict2 (drop 2 dict))
|
||||
|
||||
(assert (= (length dict1) 2) "take dictionary")
|
||||
(assert (= (length dict2) 3) "drop dictionary")
|
||||
(assert (deep= (merge dict1 dict2) dict) "take-drop symmetry for dictionary")
|
||||
|
||||
# Comment macro
|
||||
# issue #110 - 698e89aba
|
||||
(comment 1)
|
||||
(comment 1 2)
|
||||
(comment 1 2 3)
|
||||
(comment 1 2 3 4)
|
||||
|
||||
# comp should be variadic
|
||||
# 5c83ebd75, 02ce3031
|
||||
(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
|
||||
(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
|
||||
(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
|
||||
(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
|
||||
(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
|
||||
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
|
||||
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4))
|
||||
"variadic comp 7")
|
||||
|
||||
# Function shorthand
|
||||
# 44e752d73
|
||||
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
|
||||
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
|
||||
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
|
||||
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
|
||||
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
|
||||
(assert (= (|4) 4) "function shorthand 6")
|
||||
(assert (= (((|||4))) 4) "function shorthand 7")
|
||||
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
|
||||
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
|
||||
# 5f5147652
|
||||
(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
|
||||
|
||||
# 655d4b3aa
|
||||
(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
|
||||
|
||||
# Simple take, drop, etc. tests.
|
||||
(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
|
||||
(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
|
||||
|
||||
# with-vars
|
||||
# 6ceaf9d28
|
||||
(var abc 123)
|
||||
(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
|
||||
(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
|
||||
(assert (= abc 123) "with-vars 3")
|
||||
|
||||
# Top level unquote
|
||||
# 2487162cc
|
||||
(defn constantly
|
||||
[]
|
||||
(comptime (math/random)))
|
||||
|
||||
(assert (= (constantly) (constantly)) "comptime 1")
|
||||
|
||||
# issue #232 - b872ee024
|
||||
(assert-error "arity issue in macro" (eval '(each [])))
|
||||
# c6b639b93
|
||||
(assert-error "comptime issue" (eval '(comptime (error "oops"))))
|
||||
|
||||
# 962cd7e5f
|
||||
(var counter 0)
|
||||
(when-with [x nil |$]
|
||||
(++ counter))
|
||||
(when-with [x 10 |$]
|
||||
(+= counter 10))
|
||||
|
||||
(assert (= 10 counter) "when-with 1")
|
||||
|
||||
(if-with [x nil |$] (++ counter) (+= counter 10))
|
||||
(if-with [x true |$] (+= counter 20) (+= counter 30))
|
||||
|
||||
(assert (= 40 counter) "if-with 1")
|
||||
|
||||
# a45509d28
|
||||
(def a @[])
|
||||
(eachk x [:a :b :c :d]
|
||||
(array/push a x))
|
||||
(assert (deep= (range 4) a) "eachk 1")
|
||||
|
||||
# issue 609 - 1fcaffe
|
||||
(with-dyns [:err @""]
|
||||
(tracev (def my-unique-var-name true))
|
||||
(assert my-unique-var-name "tracev upscopes"))
|
||||
|
||||
# Prompts and Labels
|
||||
# 59d288c
|
||||
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
|
||||
|
||||
(defn recur
|
||||
[lab x y]
|
||||
(when (= x y) (return lab :done))
|
||||
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
|
||||
(if lab :oops res))
|
||||
(assert (= :done (recur nil 0 10)) "label 2")
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10)))))
|
||||
"prompt 1")
|
||||
|
||||
(defn- inner-loop
|
||||
[i]
|
||||
(if (= i 5)
|
||||
(return :a 10)))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
|
||||
|
||||
(defn- inner-loop2
|
||||
[i]
|
||||
(try
|
||||
(if (= i 5)
|
||||
(error 10))
|
||||
([err] (return :a err))))
|
||||
|
||||
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
|
||||
|
||||
# chr
|
||||
# issue 304 - 77343e02e
|
||||
(assert (= (chr "a") 97) "chr 1")
|
||||
|
||||
# Reduce2
|
||||
# 3eb0927a2
|
||||
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
|
||||
# 65379741f
|
||||
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
|
||||
(assert (= nil (reduce2 * [])) "reduce2 3")
|
||||
|
||||
# Accumulate
|
||||
# 3eb0927a2
|
||||
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
|
||||
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
|
||||
# 65379741f
|
||||
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
|
||||
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
|
||||
|
||||
# in vs get regression
|
||||
# issue #340 - b63a0796f
|
||||
(assert (nil? (first @"")) "in vs get 1")
|
||||
(assert (nil? (last @"")) "in vs get 1")
|
||||
|
||||
# index-of
|
||||
# 259812314
|
||||
(assert (= nil (index-of 10 [])) "index-of 1")
|
||||
(assert (= nil (index-of 10 [1 2 3])) "index-of 2")
|
||||
(assert (= 1 (index-of 2 [1 2 3])) "index-of 3")
|
||||
(assert (= 0 (index-of :a [:a :b :c])) "index-of 4")
|
||||
(assert (= nil (index-of :a {})) "index-of 5")
|
||||
(assert (= :a (index-of :A {:a :A :b :B})) "index-of 6")
|
||||
(assert (= :a (index-of :A @{:a :A :b :B})) "index-of 7")
|
||||
(assert (= 0 (index-of (chr "a") "abc")) "index-of 8")
|
||||
(assert (= nil (index-of (chr "a") "")) "index-of 9")
|
||||
(assert (= nil (index-of 10 @[])) "index-of 10")
|
||||
(assert (= nil (index-of 10 @[1 2 3])) "index-of 11")
|
||||
|
||||
# e78a3d1
|
||||
# NOTE: These is a motivation for the has-value? and has-key? functions below
|
||||
|
||||
# returns false despite key present
|
||||
(assert (= false (index-of 8 {true 7 false 8}))
|
||||
"index-of corner key (false) 1")
|
||||
(assert (= false (index-of 8 @{false 8}))
|
||||
"index-of corner key (false) 2")
|
||||
# still returns null
|
||||
(assert (= nil (index-of 7 {false 8})) "index-of corner key (false) 3")
|
||||
|
||||
# has-value?
|
||||
(assert (= false (has-value? [] "foo")) "has-value? 1")
|
||||
(assert (= true (has-value? [4 7 1 3] 4)) "has-value? 2")
|
||||
(assert (= false (has-value? [4 7 1 3] 22)) "has-value? 3")
|
||||
(assert (= false (has-value? @[1 2 3] 4)) "has-value? 4")
|
||||
(assert (= true (has-value? @[:a :b :c] :a)) "has-value? 5")
|
||||
(assert (= false (has-value? {} :foo)) "has-value? 6")
|
||||
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
|
||||
(assert (= true (has-value? {:a :A :b :B} :A)) "has-value? 7")
|
||||
(assert (= true (has-value? @{:a :A :b :B} :A)) "has-value? 8")
|
||||
(assert (= true (has-value? "abc" (chr "a"))) "has-value? 9")
|
||||
(assert (= false (has-value? "abc" "1")) "has-value? 10")
|
||||
# weird true/false corner cases, should align with "index-of corner
|
||||
# key {k}" cases
|
||||
(assert (= true (has-value? {true 7 false 8} 8))
|
||||
"has-value? corner key (false) 1")
|
||||
(assert (= true (has-value? @{false 8} 8))
|
||||
"has-value? corner key (false) 2")
|
||||
(assert (= false (has-value? {false 8} 7))
|
||||
"has-value? corner key (false) 3")
|
||||
|
||||
# has-key?
|
||||
(do
|
||||
(var test-has-key-auto 0)
|
||||
(defn test-has-key [col key expected &keys {:name name}]
|
||||
``Test that has-key has the outcome `expected`, and that if
|
||||
the result is true, then ensure (in key) does not fail either``
|
||||
(assert (boolean? expected))
|
||||
(default name (string "has-key? " (++ test-has-key-auto)))
|
||||
(assert (= expected (has-key? col key)) name)
|
||||
(if
|
||||
# guarenteed by `has-key?` to never fail
|
||||
expected (in col key)
|
||||
# if `has-key?` is false, then `in` should fail (for indexed types)
|
||||
#
|
||||
# For dictionary types, it should return nil
|
||||
(let [[success retval] (protect (in col key))]
|
||||
(def should-succeed (dictionary? col))
|
||||
(assert
|
||||
(= success should-succeed)
|
||||
(string/format
|
||||
"%s: expected (in col key) to %s, but got %q"
|
||||
name (if expected "succeed" "fail") retval)))))
|
||||
|
||||
(test-has-key [] 0 false) # 1
|
||||
(test-has-key [4 7 1 3] 2 true) # 2
|
||||
(test-has-key [4 7 1 3] 22 false) # 3
|
||||
(test-has-key @[1 2 3] 4 false) # 4
|
||||
(test-has-key @[:a :b :c] 2 true) # 5
|
||||
(test-has-key {} :foo false) # 6
|
||||
(test-has-key {:a :A :b :B} :a true) # 7
|
||||
(test-has-key {:a :A :b :B} :A false) # 8
|
||||
(test-has-key @{:a :A :b :B} :a true) # 9
|
||||
(test-has-key "abc" 1 true) # 10
|
||||
(test-has-key "abc" 4 false) # 11
|
||||
# weird true/false corner cases
|
||||
#
|
||||
# Tries to mimic the corresponding corner cases in has-value? and
|
||||
# index-of, but with keys/values inverted
|
||||
#
|
||||
# in the first two cases (truthy? (get val col)) would have given false
|
||||
# negatives
|
||||
(test-has-key {7 true 8 false} 8 true :name
|
||||
"has-key? corner value (false) 1")
|
||||
(test-has-key @{8 false} 8 true :name
|
||||
"has-key? corner value (false) 2")
|
||||
(test-has-key @{8 false} 7 false :name
|
||||
"has-key? corner value (false) 3"))
|
||||
|
||||
# Regression
|
||||
# issue #463 - 7e7498350
|
||||
(assert (= {:x 10} (|(let [x $] ~{:x ,x}) 10)) "issue 463")
|
||||
|
||||
# macex testing
|
||||
# 7e7498350
|
||||
(assert (deep= (macex1 '~{1 2 3 4}) '~{1 2 3 4}) "macex1 qq struct")
|
||||
(assert (deep= (macex1 '~@{1 2 3 4}) '~@{1 2 3 4}) "macex1 qq table")
|
||||
(assert (deep= (macex1 '~(1 2 3 4)) '~[1 2 3 4]) "macex1 qq tuple")
|
||||
(assert (= :brackets (tuple/type (1 (macex1 '~[1 2 3 4]))))
|
||||
"macex1 qq bracket tuple")
|
||||
(assert (deep= (macex1 '~@[1 2 3 4 ,blah]) '~@[1 2 3 4 ,blah])
|
||||
"macex1 qq array")
|
||||
|
||||
# Sourcemaps in threading macros
|
||||
# b6175e429
|
||||
(defn check-threading [macro expansion]
|
||||
(def expanded (macex1 (tuple macro 0 '(x) '(y))))
|
||||
(assert (= expanded expansion) (string macro " expansion value"))
|
||||
(def smap-x (tuple/sourcemap (get expanded 1)))
|
||||
(def smap-y (tuple/sourcemap expanded))
|
||||
(def line first)
|
||||
(defn column [t] (t 1))
|
||||
(assert (not= smap-x [-1 -1]) (string macro " x sourcemap existence"))
|
||||
(assert (not= smap-y [-1 -1]) (string macro " y sourcemap existence"))
|
||||
(assert (or (< (line smap-x) (line smap-y))
|
||||
(and (= (line smap-x) (line smap-y))
|
||||
(< (column smap-x) (column smap-y))))
|
||||
(string macro " relation between x and y sourcemap")))
|
||||
|
||||
(check-threading '-> '(y (x 0)))
|
||||
(check-threading '->> '(y (x 0)))
|
||||
|
||||
# keep-syntax
|
||||
# b6175e429
|
||||
(let [brak '[1 2 3]
|
||||
par '(1 2 3)]
|
||||
|
||||
(tuple/setmap brak 2 1)
|
||||
|
||||
(assert (deep= (keep-syntax brak @[1 2 3]) @[1 2 3])
|
||||
"keep-syntax brackets ignore array")
|
||||
(assert (= (keep-syntax! brak @[1 2 3]) '[1 2 3])
|
||||
"keep-syntax! brackets replace array")
|
||||
|
||||
(assert (= (keep-syntax! par (map inc @[1 2 3])) '(2 3 4))
|
||||
"keep-syntax! parens coerce array")
|
||||
(assert (not= (keep-syntax! brak @[1 2 3]) '(1 2 3))
|
||||
"keep-syntax! brackets not parens")
|
||||
(assert (not= (keep-syntax! par @[1 2 3]) '[1 2 3])
|
||||
"keep-syntax! parens not brackets")
|
||||
(assert (= (tuple/sourcemap brak)
|
||||
(tuple/sourcemap (keep-syntax! brak @[1 2 3])))
|
||||
"keep-syntax! brackets source map")
|
||||
|
||||
(keep-syntax par brak)
|
||||
(assert (not= (tuple/sourcemap brak) (tuple/sourcemap par))
|
||||
"keep-syntax no mutate")
|
||||
(assert (= (keep-syntax 1 brak) brak) "keep-syntax brackets ignore type"))
|
||||
|
||||
# Curenv
|
||||
# 28439d822, f7c556e
|
||||
(assert (= (curenv) (curenv 0)) "curenv 1")
|
||||
(assert (= (table/getproto (curenv)) (curenv 1)) "curenv 2")
|
||||
(assert (= nil (curenv 1000000)) "curenv 3")
|
||||
(assert (= root-env (curenv 1)) "curenv 4")
|
||||
|
||||
# Import macro test
|
||||
# a31e079f9
|
||||
(assert-no-error "import macro 1" (macex '(import a :as b :fresh maybe)))
|
||||
(assert (deep= ~(,import* "a" :as "b" :fresh maybe)
|
||||
(macex '(import a :as b :fresh maybe))) "import macro 2")
|
||||
|
||||
# #477 walk preserving bracket type
|
||||
# 0a1d902f4
|
||||
(assert (= :brackets (tuple/type (postwalk identity '[])))
|
||||
"walk square brackets 1")
|
||||
(assert (= :brackets (tuple/type (walk identity '[])))
|
||||
"walk square brackets 2")
|
||||
|
||||
# Issue #751
|
||||
# 547fda6a4
|
||||
(def t {:side false})
|
||||
(assert (nil? (get-in t [:side :note])) "get-in with false value")
|
||||
(assert (= (get-in t [:side :note] "dflt") "dflt")
|
||||
"get-in with false value and default")
|
||||
|
||||
# Evaluate stream with `dofile`
|
||||
# 9cc4e4812
|
||||
(def [r w] (os/pipe))
|
||||
(:write w "(setdyn :x 10)")
|
||||
(:close w)
|
||||
(def stream-env (dofile r))
|
||||
(assert (= (stream-env :x) 10) "dofile stream 1")
|
||||
|
||||
# Test thaw and freeze
|
||||
# 9cc0645a1
|
||||
(def table-to-freeze @{:c 22 :b [1 2 3 4] :d @"test" :e "test2"})
|
||||
(def table-to-freeze-with-inline-proto
|
||||
@{:a @[1 2 3] :b @[1 2 3 4] :c 22 :d @"test" :e @"test2"})
|
||||
(def struct-to-thaw
|
||||
(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= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
|
||||
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings
|
||||
# e528b86
|
||||
(assert (not (string/find "\r"
|
||||
(get ((fiber/getenv (fiber/current)) 'cond)
|
||||
:doc "")))
|
||||
"no \\r in doc strings")
|
||||
|
||||
# cff718f37
|
||||
(var counter 0)
|
||||
(def thunk (delay (++ counter)))
|
||||
(assert (= (thunk) 1) "delay 1")
|
||||
(assert (= counter 1) "delay 2")
|
||||
(assert (= (thunk) 1) "delay 3")
|
||||
(assert (= counter 1) "delay 4")
|
||||
|
||||
# maclintf
|
||||
(def env (table/clone (curenv)))
|
||||
((compile '(defmacro foo [] (maclintf :strict "oops")) env :anonymous))
|
||||
(def lints @[])
|
||||
(compile (tuple/setmap '(foo) 1 2) env :anonymous lints)
|
||||
(assert (deep= lints @[[:strict 1 2 "oops"]]) "maclintf 1")
|
||||
|
||||
(def env (table/clone (curenv)))
|
||||
((compile '(defmacro foo [& body] (maclintf :strict "foo-oops") ~(do ,;body)) env :anonymous))
|
||||
((compile '(defmacro bar [] (maclintf :strict "bar-oops")) env :anonymous))
|
||||
(def lints @[])
|
||||
# Compile (foo (bar)), but with explicit source map values
|
||||
(def bar-invoke (tuple/setmap '(bar) 3 4))
|
||||
(compile (tuple/setmap ~(foo ,bar-invoke) 1 2) env :anonymous lints)
|
||||
(assert (deep= lints @[[:strict 1 2 "foo-oops"]
|
||||
[:strict 3 4 "bar-oops"]])
|
||||
"maclintf 2")
|
||||
|
||||
# Bad bytecode wrt. using result from break expression
|
||||
(defn bytecode-roundtrip
|
||||
[f]
|
||||
(assert-no-error "bytecode round-trip" (unmarshal (marshal f make-image-dict))))
|
||||
|
||||
(defn case-1 [&] (def x (break 1)))
|
||||
(bytecode-roundtrip case-1)
|
||||
(defn foo [&])
|
||||
(defn case-2 [&]
|
||||
(foo (break (foo)))
|
||||
(foo))
|
||||
(bytecode-roundtrip case-2)
|
||||
(defn case-3 [&]
|
||||
(def x (break (do (foo)))))
|
||||
(bytecode-roundtrip case-3)
|
||||
(defn case-4 [&]
|
||||
(def x (break (break (foo)))))
|
||||
(bytecode-roundtrip case-4)
|
||||
(defn case-4 [&]
|
||||
(def x (break (break (break)))))
|
||||
(bytecode-roundtrip case-4)
|
||||
(defn case-5 []
|
||||
(def foo (fn [one two] one))
|
||||
(foo 100 200))
|
||||
(bytecode-roundtrip case-5)
|
||||
|
||||
# Debug bytecode of these functions
|
||||
# (pp (disasm case-1))
|
||||
# (pp (disasm case-2))
|
||||
# (pp (disasm case-3))
|
||||
|
||||
# Regression #1330
|
||||
(defn regress-1330 [&]
|
||||
(def a [1 2 3])
|
||||
(def b [;a])
|
||||
(identity a))
|
||||
(assert (= [1 2 3] (regress-1330)) "regression 1330")
|
||||
|
||||
# Issue 1341
|
||||
(assert (= () '() (macex '())) "macex ()")
|
||||
(assert (= '[] (macex '[])) "macex []")
|
||||
|
||||
(end-suite)
|
||||
166
test/suite-buffer.janet
Normal file
166
test/suite-buffer.janet
Normal file
@@ -0,0 +1,166 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Buffer blitting
|
||||
# 16ebb1118
|
||||
(def b (buffer/new-filled 100))
|
||||
(buffer/bit-set b 100)
|
||||
(buffer/bit-clear b 100)
|
||||
(assert (zero? (sum b)) "buffer bit set and clear")
|
||||
(assert (= false (buffer/bit b 101)) "bit get false")
|
||||
(buffer/bit-toggle b 101)
|
||||
(assert (= true (buffer/bit b 101)) "bit get true")
|
||||
(assert (= 32 (sum b)) "buffer bit set and clear")
|
||||
(assert-error "invalid bit index 1000" (buffer/bit-toggle b 1000))
|
||||
|
||||
(def b2 @"hello world")
|
||||
|
||||
(buffer/blit b2 "joyto ")
|
||||
(assert (= (string b2) "joyto world") "buffer/blit 1")
|
||||
|
||||
(buffer/blit b2 "joyto" 6)
|
||||
(assert (= (string b2) "joyto joyto") "buffer/blit 2")
|
||||
|
||||
(buffer/blit b2 "abcdefg" 5 6)
|
||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||
|
||||
# buffer/push
|
||||
|
||||
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
|
||||
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
|
||||
(def b @"AA")
|
||||
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
|
||||
|
||||
# buffer/push-byte
|
||||
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
|
||||
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/push-byte @"AA" :flap))
|
||||
|
||||
# Buffer push word
|
||||
# e755f9830
|
||||
(def b3 @"")
|
||||
(buffer/push-word b3 0xFF 0x11)
|
||||
(assert (= 8 (length b3)) "buffer/push-word 1")
|
||||
(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
|
||||
(buffer/clear b3)
|
||||
(buffer/push-word b3 0xFFFFFFFF 0x1100)
|
||||
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||
(assert-error "cannot convert 0.5 to machine word" (buffer/push-word @"" 0.5))
|
||||
|
||||
# Buffer push string
|
||||
# 175925207
|
||||
(def b4 (buffer/new-filled 10 0))
|
||||
(buffer/push-string b4 b4)
|
||||
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4))
|
||||
"buffer/push-buffer 1")
|
||||
(def b5 @"123")
|
||||
(buffer/push-string b5 "456" @"789")
|
||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||
|
||||
(def buffer-uint16-be @"")
|
||||
(buffer/push-uint16 buffer-uint16-be :be 0x0102)
|
||||
(assert (= "\x01\x02" (string buffer-uint16-be)) "buffer/push-uint16 big endian")
|
||||
|
||||
(def buffer-uint16-le @"")
|
||||
(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-uint32-be @"")
|
||||
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
|
||||
(assert (= "\x01\x02\x03\x04" (string buffer-uint32-be)) "buffer/push-uint32 big endian")
|
||||
|
||||
(def buffer-uint32-le @"")
|
||||
(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-float32-be @"")
|
||||
(buffer/push-float32 buffer-float32-be :be 1.234)
|
||||
(assert (= "\x3f\x9d\xf3\xb6" (string buffer-float32-be)) "buffer/push-float32 big endian")
|
||||
|
||||
(def buffer-float32-le @"")
|
||||
(buffer/push-float32 buffer-float32-le :le 1.234)
|
||||
(assert (= "\xb6\xf3\x9d\x3f" (string buffer-float32-le)) "buffer/push-float32 little endian")
|
||||
|
||||
(def buffer-float64-be @"")
|
||||
(buffer/push-float64 buffer-float64-be :be 1.234)
|
||||
(assert (= "\x3f\xf3\xbe\x76\xc8\xb4\x39\x58" (string buffer-float64-be)) "buffer/push-float64 big endian")
|
||||
|
||||
(def buffer-float64-le @"")
|
||||
(buffer/push-float64 buffer-float64-le :le 1.234)
|
||||
(assert (= "\x58\x39\xb4\xc8\x76\xbe\xf3\x3f" (string buffer-float64-le)) "buffer/push-float64 little endian")
|
||||
|
||||
# Buffer from bytes
|
||||
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
|
||||
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
|
||||
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
|
||||
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
|
||||
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
|
||||
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
|
||||
|
||||
# some tests for buffer/format
|
||||
# 029394d
|
||||
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
|
||||
"%6.3f")
|
||||
(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142")
|
||||
"%6.3f")
|
||||
(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi))
|
||||
"pi = 3.141592653589793116") "%6.3f")
|
||||
|
||||
(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 = 3.142")
|
||||
"UTF-8")
|
||||
(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927")
|
||||
"π")
|
||||
(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi))
|
||||
"\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||
|
||||
# Regression #301
|
||||
# a3d4ecddb
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
|
||||
|
||||
(def a @"abcdefghijklm")
|
||||
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
|
||||
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
|
||||
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
|
||||
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
|
||||
(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
|
||||
|
||||
# buffer/push-at
|
||||
# c55d93512
|
||||
(assert (deep= @"abc456" (buffer/push-at @"abc123" 3 "456"))
|
||||
"buffer/push-at 1")
|
||||
(assert (deep= @"abc456789" (buffer/push-at @"abc123" 3 "456789"))
|
||||
"buffer/push-at 2")
|
||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
||||
"buffer/push-at 3")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
# Copyright (c) 2023 Calvin Rose & contributors
|
||||
# Copyright (c) 2023 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
|
||||
@@ -19,25 +19,26 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 13)
|
||||
(start-suite)
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
|
||||
@{0 0 1 3 2 6}))
|
||||
# Tuple types
|
||||
# c6edf03ae
|
||||
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
||||
(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
|
||||
(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
|
||||
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens)
|
||||
"normal tuple marshalled/unmarshalled")
|
||||
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets)
|
||||
"normal tuple marshalled/unmarshalled")
|
||||
|
||||
(assert (deep= (tabseq [i :in (range 3)] i)
|
||||
@{}))
|
||||
|
||||
(def- sym-prefix-peg
|
||||
(peg/compile
|
||||
~{:symchar (+ (range "\x80\xff" "AZ" "az" "09") (set "!$%&*+-./:<?=>@^_"))
|
||||
:anchor (drop (cmt ($) ,|(= $ 0)))
|
||||
:cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
|
||||
:recur (+ :cap (> -1 :recur))
|
||||
:main (> -1 :recur)}))
|
||||
|
||||
(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"]) "peg lookback")
|
||||
(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"]) "peg lookback 2")
|
||||
|
||||
(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch)) "xxx" "aba cdc efa") @"xxx xxx efa") "peg replace-all 1")
|
||||
# Dynamic bindings
|
||||
# 7918add47, 513d551d
|
||||
(setdyn :a 10)
|
||||
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
|
||||
(assert (= 10 (dyn :a)) "dyn usage 2")
|
||||
(assert (= nil (dyn :b)) "dyn usage 3")
|
||||
(setdyn :a 100)
|
||||
(assert (= 100 (dyn :a)) "dyn usage 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
34
test/suite-cfuns.janet
Normal file
34
test/suite-cfuns.janet
Normal file
@@ -0,0 +1,34 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Inline 3 argument get
|
||||
# a1ea62a
|
||||
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
|
||||
|
||||
# Regression #24
|
||||
# f28477649
|
||||
(def t (put @{} :hi 1))
|
||||
(assert (deep= t @{:hi 1}) "regression #24")
|
||||
|
||||
(end-suite)
|
||||
|
||||
77
test/suite-compile.janet
Normal file
77
test/suite-compile.janet
Normal file
@@ -0,0 +1,77 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Regression Test
|
||||
# 0378ba78
|
||||
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||
|
||||
# Fix a compiler bug in the do special form
|
||||
# 3e1e2585
|
||||
(defn myfun [x]
|
||||
(var a 10)
|
||||
(set a (do
|
||||
(def y x)
|
||||
(if x 8 9))))
|
||||
|
||||
(assert (= (myfun true) 8) "check do form regression")
|
||||
(assert (= (myfun false) 9) "check do form regression")
|
||||
|
||||
# Check x:digits: works as symbol and not a hex number
|
||||
# 5baf70f4
|
||||
(def x1 100)
|
||||
(assert (= x1 100) "x1 as symbol")
|
||||
(def X1 100)
|
||||
(assert (= X1 100) "X1 as symbol")
|
||||
|
||||
# Edge case should cause old compilers to fail due to
|
||||
# if statement optimization
|
||||
# 17283241
|
||||
(var var-a 1)
|
||||
(var var-b (if false 2 (string "hello")))
|
||||
|
||||
(assert (= var-b "hello") "regression 1")
|
||||
|
||||
# d28925fda
|
||||
(assert (= (string '()) (string [])) "empty bracket tuple literal")
|
||||
|
||||
# Bracket tuple issue
|
||||
# 340a6c4
|
||||
(let [do 3]
|
||||
(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms"))
|
||||
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||
|
||||
# Crash issue #1174 - bad debug info
|
||||
# e97299f
|
||||
(defn crash []
|
||||
(debug/stack (fiber/current)))
|
||||
(do
|
||||
(math/random)
|
||||
(defn foo [_]
|
||||
(crash)
|
||||
1)
|
||||
(foo 0)
|
||||
10)
|
||||
|
||||
(end-suite)
|
||||
|
||||
181
test/suite-corelib.janet
Normal file
181
test/suite-corelib.janet
Normal file
@@ -0,0 +1,181 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# ac50f62
|
||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||
(assert (= -8 (- 1 2 3 4)) "subtraction")
|
||||
(assert (= 24 (* 1 2 3 4)) "multiplication")
|
||||
# d6967a5
|
||||
(assert (= 4 (blshift 1 2)) "left shift")
|
||||
(assert (= 1 (brshift 4 2)) "right shift")
|
||||
# unsigned shift
|
||||
(assert (= 32768 (brushift 0x80000000 16)) "right shift unsigned 1")
|
||||
(assert-error "right shift unsigned 2" (= -32768 (brshift 0x80000000 16)))
|
||||
(assert (= -1 (brshift -1 16)) "right shift unsigned 3")
|
||||
# non-immediate forms
|
||||
(assert (= 32768 (brushift 0x80000000 (+ 0 16))) "right shift unsigned non-immediate")
|
||||
(assert-error "right shift non-immediate" (= -32768 (brshift 0x80000000 (+ 0 16))))
|
||||
(assert (= -1 (brshift -1 (+ 0 16))) "right shift non-immediate 2")
|
||||
(assert (= 32768 (blshift 1 (+ 0 15))) "left shift non-immediate")
|
||||
# 7e46ead
|
||||
(assert (< 1 2 3 4 5 6) "less than integers")
|
||||
(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
|
||||
(assert (> 6 5 4 3 2 1) "greater than integers")
|
||||
(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater than reals")
|
||||
(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
|
||||
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
|
||||
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
|
||||
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
|
||||
|
||||
(assert (= 7 (% 20 13)) "rem 1")
|
||||
(assert (= -7 (% -20 13)) "rem 2")
|
||||
(assert (= 7 (% 20 -13)) "rem 3")
|
||||
(assert (= -7 (% -20 -13)) "rem 4")
|
||||
(assert (nan? (% 20 0)) "rem 5")
|
||||
|
||||
(assert (= 7 (mod 20 13)) "mod 1")
|
||||
(assert (= 6 (mod -20 13)) "mod 2")
|
||||
(assert (= -6 (mod 20 -13)) "mod 3")
|
||||
(assert (= -7 (mod -20 -13)) "mod 4")
|
||||
(assert (= 20 (mod 20 0)) "mod 5")
|
||||
|
||||
(assert (= 1 (div 20 13)) "div 1")
|
||||
(assert (= -2 (div -20 13)) "div 2")
|
||||
(assert (= -2 (div 20 -13)) "div 3")
|
||||
(assert (= 1 (div -20 -13)) "div 4")
|
||||
(assert (= math/inf (div 20 0)) "div 5")
|
||||
|
||||
(assert (all = (seq [n :range [0 10]] (mod n 5 3))
|
||||
(seq [n :range [0 10]] (% n 5 3))
|
||||
[0 1 2 0 1 0 1 2 0 1]) "variadic mod")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "type ordering")
|
||||
|
||||
# b305a7c9b
|
||||
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
|
||||
# 277117165
|
||||
(assert (= (get {} 1) nil) "get nil from empty struct")
|
||||
(assert (= (get @{} 1) nil) "get nil from empty table")
|
||||
(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
|
||||
(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
|
||||
(assert (= (get @"\0" 0) 0) "get non nil from buffer")
|
||||
(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
|
||||
(assert (put @{} :boop :bap) "can add to empty table")
|
||||
(assert (put @{1 3} :boop :bap) "can add to non-empty table")
|
||||
# 7e46ead
|
||||
(assert (= 7 (bor 3 4)) "bit or")
|
||||
(assert (= 0 (band 3 4)) "bit and")
|
||||
# f41dab8
|
||||
(assert (= 0xFF (bxor 0x0F 0xF0)) "bit xor")
|
||||
(assert (= 0xF0 (bxor 0xFF 0x0F)) "bit xor 2")
|
||||
|
||||
# Some testing for not=
|
||||
# 08f6c642d
|
||||
(assert (not= 1 1 0) "not= 1")
|
||||
(assert (not= 0 1 1) "not= 2")
|
||||
|
||||
# Check if abstract test works
|
||||
# d791077e2
|
||||
(assert (abstract? stdout) "abstract? stdout")
|
||||
(assert (abstract? stdin) "abstract? stdin")
|
||||
(assert (abstract? stderr) "abstract? stderr")
|
||||
(assert (not (abstract? nil)) "not abstract? nil")
|
||||
(assert (not (abstract? 1)) "not abstract? 1")
|
||||
(assert (not (abstract? 3)) "not abstract? 3")
|
||||
(assert (not (abstract? 5)) "not abstract? 5")
|
||||
|
||||
# Module path expansion
|
||||
# ff3bb6627
|
||||
(setdyn :current-file "some-dir/some-file")
|
||||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc")
|
||||
"module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc")
|
||||
"module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt")
|
||||
"module/expand-path 3")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:")
|
||||
"some-dir/abc/sub/def.txt") "module/expand-path 4")
|
||||
# fc46030e7
|
||||
(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt")
|
||||
"module/expand-path 5")
|
||||
(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt")
|
||||
"module/expand-path 6")
|
||||
(assert (= (test-expand "../def.txt" ":all:") "../def.txt")
|
||||
"module/expand-path 7")
|
||||
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt")
|
||||
"module/expand-path 8")
|
||||
|
||||
# module/expand-path regression
|
||||
# issue #143 - e0fe8476a
|
||||
(with-dyns [:syspath ".janet/.janet"]
|
||||
(assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
|
||||
".janet/.janet/hello.janet") "module/expand-path 1"))
|
||||
|
||||
# int?
|
||||
(assert (int? 1) "int? 1")
|
||||
(assert (int? -1) "int? -1")
|
||||
(assert (not (int? true)) "int? true")
|
||||
(assert (not (int? 3.14)) "int? 3.14")
|
||||
(assert (not (int? 8589934592)) "int? 8589934592")
|
||||
|
||||
# memcmp
|
||||
(assert (= (memcmp "123helloabcd" "1234helloabc" 5 3 4) 0) "memcmp 1")
|
||||
(assert (< (memcmp "123hellaabcd" "1234helloabc" 5 3 4) 0) "memcmp 2")
|
||||
(assert (> (memcmp "123helloabcd" "1234hellaabc" 5 3 4) 0) "memcmp 3")
|
||||
(assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0))
|
||||
(assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1))
|
||||
|
||||
# Range
|
||||
# a982f351d
|
||||
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)")
|
||||
(assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)")
|
||||
(assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)")
|
||||
(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 (= (length (range 10)) 10) "(range 10)")
|
||||
(assert (= (length (range -10)) 0) "(range -10)")
|
||||
(assert (= (length (range 1 10)) 9) "(range 1 10)")
|
||||
|
||||
# iterating over generator
|
||||
(assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x)))
|
||||
(assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x)))
|
||||
(assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x)))
|
||||
|
||||
(end-suite)
|
||||
|
||||
34
test/suite-debug.janet
Normal file
34
test/suite-debug.janet
Normal file
@@ -0,0 +1,34 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Simple function break
|
||||
# a8afc5b81
|
||||
(debug/fbreak map 1)
|
||||
(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
|
||||
(resume f)
|
||||
(assert (= :debug (fiber/status f)) "debug/fbreak")
|
||||
(debug/unfbreak map 1)
|
||||
(map inc [1 2 3])
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -19,50 +19,61 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 9)
|
||||
(start-suite)
|
||||
|
||||
(def test-port (os/getenv "JANET_TEST_PORT" "8761"))
|
||||
(def test-host (os/getenv "JANET_TEST_HOST" "127.0.0.1"))
|
||||
|
||||
# Subprocess
|
||||
# 5e1a8c86f
|
||||
(def janet (dyn *executable*))
|
||||
|
||||
(def janet (dyn :executable))
|
||||
# Subprocess should inherit the "RUN" parameter for fancy testing
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
(repeat 10
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def x (:read (p :out) :all))
|
||||
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn pre close."))
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn pre close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print "hello")`] :p {:out :pipe})]
|
||||
(def x (:read (p :out) 1024))
|
||||
(os/proc-wait p)
|
||||
(assert (deep= "hello" (string/trim x)) "capture stdout from os/spawn post close."))
|
||||
(assert (deep= "hello" (string/trim x))
|
||||
"capture stdout from os/spawn post close."))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(file/read stdin :line)`] :px {:in :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(file/read stdin :line)`] :px
|
||||
{:in :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(assert-no-error "pipe stdin to process" (os/proc-wait p))))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(print (file/read stdin :line))`] :px {:in :pipe :out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" `(print (file/read stdin :line))`] :px
|
||||
{:in :pipe :out :pipe})]
|
||||
(:write (p :in) "hello!\n")
|
||||
(def x (:read (p :out) 1024))
|
||||
(assert-no-error "pipe stdin to process 2" (os/proc-wait p))
|
||||
(assert (= "hello!" (string/trim x)) "round trip pipeline in process"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
||||
(let [p (os/spawn [janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(let [p (os/spawn [;run janet "-e" `(do (ev/sleep 30) (os/exit 24)`] :p)]
|
||||
(os/proc-kill p false :term)
|
||||
(def retval (os/proc-wait p))
|
||||
(assert (not= retval 24) "Process was *not* terminated by parent"))
|
||||
|
||||
# Parallel subprocesses
|
||||
|
||||
# 5e1a8c86f
|
||||
(defn calc-1
|
||||
"Run subprocess, read from stdout, then wait on subprocess."
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(os/proc-wait p)
|
||||
(def output (:read (p :out) :all))
|
||||
(parse output)))
|
||||
@@ -76,9 +87,13 @@
|
||||
@[10 26 42]) "parallel subprocesses 1")
|
||||
|
||||
(defn calc-2
|
||||
"Run subprocess, wait on subprocess, then read from stdout. Read only up to 10 bytes instead of :all"
|
||||
``
|
||||
Run subprocess, wait on subprocess, then read from stdout. Read only up
|
||||
to 10 bytes instead of :all
|
||||
``
|
||||
[code]
|
||||
(let [p (os/spawn [janet "-e" (string `(printf "%j" ` code `)`)] :px {:out :pipe})]
|
||||
(let [p (os/spawn [;run janet "-e" (string `(printf "%j" ` code `)`)] :px
|
||||
{:out :pipe})]
|
||||
(def output (:read (p :out) 10))
|
||||
(os/proc-wait p)
|
||||
(parse output)))
|
||||
@@ -92,18 +107,28 @@
|
||||
@[10 26 42]) "parallel subprocesses 2")
|
||||
|
||||
# File piping
|
||||
|
||||
# a1cc5ca04
|
||||
(assert-no-error "file writing 1"
|
||||
(with [f (file/temp)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})))
|
||||
|
||||
(assert-no-error "file writing 2"
|
||||
(with [f (file/open "unique.txt" :w)]
|
||||
(os/execute [janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(os/execute [;run janet "-e" `(repeat 20 (print :hello))`] :p {:out f})
|
||||
(file/flush f)))
|
||||
|
||||
# each-line iterator
|
||||
# Issue #593
|
||||
# a1cc5ca04
|
||||
(assert-no-error "file writing 3"
|
||||
(def outfile (file/open "unique.txt" :w))
|
||||
(os/execute [;run janet "-e" "(pp (seq [i :range (1 10)] i))"] :p
|
||||
{:out outfile})
|
||||
(file/flush outfile)
|
||||
(file/close outfile)
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# each-line iterator
|
||||
# 70f13f1
|
||||
(assert-no-error "file/lines iterator"
|
||||
(def outstream (os/open "unique.txt" :wct))
|
||||
(def buf1 "123\n456\n")
|
||||
@@ -116,26 +141,20 @@
|
||||
(assert (= buf1 buf2) "file/lines iterator")
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# Issue #593
|
||||
(assert-no-error "file writing 3"
|
||||
(def outfile (file/open "unique.txt" :w))
|
||||
(os/execute [janet "-e" "(pp (seq [i :range (1 10)] i))"] :p {:out outfile})
|
||||
(file/flush outfile)
|
||||
(file/close outfile)
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# Ensure that the stream created by os/open works
|
||||
|
||||
# e8a86013d
|
||||
(assert-no-error "File writing 4.1"
|
||||
(def outstream (os/open "unique.txt" :wct))
|
||||
(defer (:close outstream)
|
||||
(:write outstream "123\n")
|
||||
(:write outstream "456\n"))
|
||||
# Cast to string to enable comparison
|
||||
(assert (= "123\n456\n" (string (slurp "unique.txt"))) "File writing 4.2")
|
||||
(assert (= "123\n456\n" (string (slurp "unique.txt")))
|
||||
"File writing 4.2")
|
||||
(os/rm "unique.txt"))
|
||||
|
||||
# Test that the stream created by os/open can be read from
|
||||
# 8d8a6534e
|
||||
(comment
|
||||
(assert-no-error "File reading 1.1"
|
||||
(def outstream (os/open "unique.txt" :wct))
|
||||
@@ -145,17 +164,25 @@
|
||||
|
||||
(def outstream (os/open "unique.txt" :r))
|
||||
(defer (:close outstream)
|
||||
(assert (= "123\n456\n" (string (:read outstream :all))) "File reading 1.2"))
|
||||
(assert (= "123\n456\n" (string (:read outstream :all)))
|
||||
"File reading 1.2"))
|
||||
(os/rm "unique.txt")))
|
||||
|
||||
# ev/gather
|
||||
|
||||
# ev/gather
|
||||
# 4f2d1cdc0
|
||||
(assert (deep= @[1 2 3] (ev/gather 1 2 3)) "ev/gather 1")
|
||||
(assert (deep= @[] (ev/gather)) "ev/gather 2")
|
||||
(assert-error "ev/gather 3" (ev/gather 1 2 (error 3)))
|
||||
|
||||
# Net testing
|
||||
(var cancel-counter 0)
|
||||
(assert-error "ev/gather 4.1" (ev/gather
|
||||
(defer (++ cancel-counter) (ev/take (ev/chan)))
|
||||
(defer (++ cancel-counter) (ev/take (ev/chan)))
|
||||
(error :oops)))
|
||||
(assert (= cancel-counter 2) "ev/gather 4.2")
|
||||
|
||||
# Net testing
|
||||
# 2904c19ed
|
||||
(repeat 10
|
||||
|
||||
(defn handler
|
||||
@@ -168,11 +195,11 @@
|
||||
(net/write stream b)
|
||||
(buffer/clear b)))
|
||||
|
||||
(def s (net/server "127.0.0.1" "8000" handler))
|
||||
(def s (net/server test-host test-port handler))
|
||||
(assert s "made server 1")
|
||||
|
||||
(defn test-echo [msg]
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(net/write conn msg)
|
||||
(def res (net/read conn 1024))
|
||||
(assert (= (string res) msg) (string "echo " msg))))
|
||||
@@ -181,32 +208,35 @@
|
||||
(test-echo "world")
|
||||
(test-echo (string/repeat "abcd" 200))
|
||||
|
||||
(:close s))
|
||||
(:close s)
|
||||
(gccollect))
|
||||
|
||||
# Test on both server and client
|
||||
# 504411e
|
||||
(defn names-handler
|
||||
[stream]
|
||||
(defer (:close stream)
|
||||
# prevent immediate close
|
||||
(ev/read stream 1)
|
||||
(def [host port] (net/localname stream))
|
||||
(assert (= host "127.0.0.1") "localname host server")
|
||||
(assert (= port 8000) "localname port server")))
|
||||
(assert (= host test-host) "localname host server")
|
||||
(assert (= port (scan-number test-port)) "localname port server")))
|
||||
|
||||
# Test localname and peername
|
||||
# 077bf5eba
|
||||
(repeat 10
|
||||
(with [s (net/server "127.0.0.1" "8000" names-handler)]
|
||||
(with [s (net/server test-host test-port names-handler)]
|
||||
(repeat 10
|
||||
(with [conn (net/connect "127.0.0.1" "8000")]
|
||||
(with [conn (net/connect test-host test-port)]
|
||||
(def [host port] (net/peername conn))
|
||||
(assert (= host "127.0.0.1") "peername host client ")
|
||||
(assert (= port 8000) "peername port client")
|
||||
(assert (= host test-host) "peername host client ")
|
||||
(assert (= port (scan-number test-port)) "peername port client")
|
||||
# let server close
|
||||
(ev/write conn " "))))
|
||||
(gccollect))
|
||||
|
||||
# Create pipe
|
||||
|
||||
# 12f09ad2d
|
||||
(var pipe-counter 0)
|
||||
(def chan (ev/chan 10))
|
||||
(let [[reader writer] (os/pipe)]
|
||||
@@ -222,6 +252,7 @@
|
||||
(ev/close writer)
|
||||
(ev/take chan))
|
||||
|
||||
# cff52ded5
|
||||
(var result nil)
|
||||
(var fiber nil)
|
||||
(set fiber
|
||||
@@ -231,10 +262,11 @@
|
||||
(ev/sleep 0)
|
||||
(ev/cancel fiber "boop")
|
||||
|
||||
(assert (os/execute [janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
# f0dbc2e
|
||||
(assert (os/execute [;run janet "-e" `(+ 1 2 3)`] :xp) "os/execute self")
|
||||
|
||||
# Test some channel
|
||||
|
||||
# e76b8da26
|
||||
(def c1 (ev/chan))
|
||||
(def c2 (ev/chan))
|
||||
(def arr @[])
|
||||
@@ -276,16 +308,17 @@
|
||||
(assert (= (slice arr) (slice (range 100))) "ev/chan-close 3")
|
||||
|
||||
# threaded channels
|
||||
|
||||
# 868cdb9
|
||||
(def ch (ev/thread-chan 2))
|
||||
(def att (ev/thread-chan 109))
|
||||
(assert att "`att` was nil after creation")
|
||||
(ev/give ch att)
|
||||
(ev/do-thread
|
||||
(assert (ev/take ch) "channel packing bug for threaded abstracts on threaded channels."))
|
||||
(assert (ev/take ch)
|
||||
"channel packing bug for threaded abstracts on threaded channels."))
|
||||
|
||||
# marshal channels
|
||||
|
||||
# 76be8006a
|
||||
(def ch (ev/chan 10))
|
||||
(ev/give ch "hello")
|
||||
(ev/give ch "world")
|
||||
@@ -295,4 +328,51 @@
|
||||
(assert (= item1 "hello"))
|
||||
(assert (= item2 "world"))
|
||||
|
||||
# ev/take, suspended, channel closed
|
||||
(def ch (ev/chan))
|
||||
(ev/go |(ev/chan-close ch))
|
||||
(assert (= (ev/take ch) nil))
|
||||
|
||||
# ev/give, suspended, channel closed
|
||||
(def ch (ev/chan))
|
||||
(ev/go |(ev/chan-close ch))
|
||||
(assert (= (ev/give ch 1) nil))
|
||||
|
||||
# ev/select, suspended take operation, channel closed
|
||||
(def ch (ev/chan))
|
||||
(ev/go |(ev/chan-close ch))
|
||||
(assert (= (ev/select ch) [:close ch]))
|
||||
|
||||
# ev/select, suspended give operation, channel closed
|
||||
(def ch (ev/chan))
|
||||
(ev/go |(ev/chan-close ch))
|
||||
(assert (= (ev/select [ch 1]) [:close ch]))
|
||||
|
||||
# ev/gather check
|
||||
(defn exec-slurp
|
||||
"Read stdout of subprocess and return it trimmed in a string."
|
||||
[& args]
|
||||
(def env (os/environ))
|
||||
(put env :out :pipe)
|
||||
(def proc (os/spawn args :epx env))
|
||||
(def out (get proc :out))
|
||||
(def buf @"")
|
||||
(ev/gather
|
||||
(:read out :all buf)
|
||||
(:wait proc))
|
||||
(string/trimr buf))
|
||||
(assert-no-error
|
||||
"ev/with-deadline 1"
|
||||
(assert (= "hi"
|
||||
(ev/with-deadline
|
||||
10
|
||||
(exec-slurp ;run janet "-e" "(print :hi)")))
|
||||
"exec-slurp 1"))
|
||||
|
||||
# valgrind-able check for #1337
|
||||
(def superv (ev/chan 10))
|
||||
(def f (ev/go |(ev/sleep 1e9) nil superv))
|
||||
(ev/cancel f (gensym))
|
||||
(ev/take superv)
|
||||
|
||||
(end-suite)
|
||||
@@ -19,30 +19,30 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 12)
|
||||
|
||||
(var counter 0)
|
||||
(def thunk (delay (++ counter)))
|
||||
(assert (= (thunk) 1) "delay 1")
|
||||
(assert (= counter 1) "delay 2")
|
||||
(assert (= (thunk) 1) "delay 3")
|
||||
(assert (= counter 1) "delay 4")
|
||||
(start-suite)
|
||||
|
||||
# We should get ARM support...
|
||||
(def has-ffi (and (dyn 'ffi/native) (= (os/arch) :x64)))
|
||||
(def has-ffi (dyn 'ffi/native))
|
||||
(def has-full-ffi
|
||||
(and has-ffi
|
||||
(when-let [entry (dyn 'ffi/calling-conventions)]
|
||||
(def fficc (entry :value))
|
||||
(> (length (fficc)) 1)))) # all arches support :none
|
||||
|
||||
# FFI check
|
||||
# d80356158
|
||||
(compwhen has-ffi
|
||||
(ffi/context))
|
||||
|
||||
(compwhen has-ffi
|
||||
(ffi/defbind memcpy :ptr [dest :ptr src :ptr n :size]))
|
||||
(compwhen has-ffi
|
||||
(compwhen has-full-ffi
|
||||
(def buffer1 @"aaaa")
|
||||
(def buffer2 @"bbbb")
|
||||
(memcpy buffer1 buffer2 4)
|
||||
(assert (= (string buffer1) "bbbb") "ffi 1 - memcpy"))
|
||||
|
||||
# cfaae47ce
|
||||
(compwhen has-ffi
|
||||
(assert (= 8 (ffi/size [:int :char])) "size unpacked struct 1")
|
||||
(assert (= 5 (ffi/size [:pack :int :char])) "size packed struct 1")
|
||||
@@ -50,7 +50,8 @@
|
||||
(assert (= 4 (ffi/align [:int :char])) "align 1")
|
||||
(assert (= 1 (ffi/align [:pack :int :char])) "align 2")
|
||||
(assert (= 1 (ffi/align [:int :char :pack-all])) "align 3")
|
||||
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]])) "array struct size"))
|
||||
(assert (= 26 (ffi/size [:char :pack :int @[:char 21]]))
|
||||
"array struct size"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
288
test/suite-inttypes.janet
Normal file
288
test/suite-inttypes.janet
Normal file
@@ -0,0 +1,288 @@
|
||||
# Copyright (c) 2023 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)
|
||||
|
||||
# some tests for bigint
|
||||
# 319575c
|
||||
(def i64 int/s64)
|
||||
(def u64 int/u64)
|
||||
|
||||
(assert-no-error
|
||||
"create some uint64 bigints"
|
||||
(do
|
||||
# from number
|
||||
(def a (u64 10))
|
||||
# max double we can convert to int (2^53)
|
||||
(def b (u64 0x1fffffffffffff))
|
||||
(def b (u64 (math/pow 2 53)))
|
||||
# from string
|
||||
(def c (u64 "0xffff_ffff_ffff_ffff"))
|
||||
(def c (u64 "32rvv_vv_vv_vv"))
|
||||
(def d (u64 "123456789"))))
|
||||
|
||||
# Conversion back to an int32
|
||||
# 88db9751d
|
||||
(assert (= (int/to-number (u64 0xFaFa)) 0xFaFa))
|
||||
(assert (= (int/to-number (i64 0xFaFa)) 0xFaFa))
|
||||
(assert (= (int/to-number (u64 9007199254740991)) 9007199254740991))
|
||||
(assert (= (int/to-number (i64 9007199254740991)) 9007199254740991))
|
||||
(assert (= (int/to-number (i64 -9007199254740991)) -9007199254740991))
|
||||
|
||||
(assert-error
|
||||
"u64 out of bounds for safe integer"
|
||||
(int/to-number (u64 "9007199254740993"))
|
||||
|
||||
(assert-error
|
||||
"s64 out of bounds for safe integer"
|
||||
(int/to-number (i64 "-9007199254740993"))))
|
||||
|
||||
(assert-error
|
||||
"int/to-number fails on non-abstract types"
|
||||
(int/to-number 1))
|
||||
|
||||
(assert-no-error
|
||||
"create some int64 bigints"
|
||||
(do
|
||||
# from number
|
||||
(def a (i64 -10))
|
||||
# max double we can convert to int (2^53)
|
||||
(def b (i64 0x1fffffffffffff))
|
||||
(def b (i64 (math/pow 2 53)))
|
||||
# from string
|
||||
(def c (i64 "0x7fff_ffff_ffff_ffff"))
|
||||
(def d (i64 "123456789"))))
|
||||
|
||||
(assert-error
|
||||
"bad initializers"
|
||||
(do
|
||||
# double to big to be converted to uint64 without truncation (2^53 + 1)
|
||||
(def b (u64 (+ 0xffff_ffff_ffff_ff 1)))
|
||||
(def b (u64 (+ (math/pow 2 53) 1)))
|
||||
# out of range 65 bits
|
||||
(def c (u64 "0x1ffffffffffffffff"))
|
||||
# just to big
|
||||
(def d (u64 "123456789123456789123456789"))))
|
||||
|
||||
(assert (= (:/ (u64 "0xffff_ffff_ffff_ffff") 8 2) (u64 "0xfffffffffffffff"))
|
||||
"bigint operations 1")
|
||||
(assert (let [a (u64 0xff)] (= (:+ a a a a) (:* a 2 2)))
|
||||
"bigint operations 2")
|
||||
|
||||
# 5ae520a2c
|
||||
(assert (= (string (i64 -123)) "-123") "i64 prints reasonably")
|
||||
(assert (= (string (u64 123)) "123") "u64 prints reasonably")
|
||||
|
||||
# 1db6d0e0b
|
||||
(assert-error
|
||||
"trap INT64_MIN / -1"
|
||||
(:/ (int/s64 "-0x8000_0000_0000_0000") -1))
|
||||
|
||||
# int/s64 and int/u64 serialization
|
||||
# 6aea7c7f7
|
||||
(assert (deep= (int/to-bytes (u64 0)) @"\x00\x00\x00\x00\x00\x00\x00\x00"))
|
||||
|
||||
(assert (deep= (int/to-bytes (i64 1) :le)
|
||||
@"\x01\x00\x00\x00\x00\x00\x00\x00"))
|
||||
(assert (deep= (int/to-bytes (i64 1) :be)
|
||||
@"\x00\x00\x00\x00\x00\x00\x00\x01"))
|
||||
(assert (deep= (int/to-bytes (i64 -1))
|
||||
@"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF"))
|
||||
(assert (deep= (int/to-bytes (i64 -5) :be)
|
||||
@"\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFB"))
|
||||
|
||||
(assert (deep= (int/to-bytes (u64 1) :le)
|
||||
@"\x01\x00\x00\x00\x00\x00\x00\x00"))
|
||||
(assert (deep= (int/to-bytes (u64 1) :be)
|
||||
@"\x00\x00\x00\x00\x00\x00\x00\x01"))
|
||||
(assert (deep= (int/to-bytes (u64 300) :be)
|
||||
@"\x00\x00\x00\x00\x00\x00\x01\x2C"))
|
||||
|
||||
# int/s64 int/u64 to existing buffer
|
||||
# bbb3e16fd
|
||||
(let [buf1 @""
|
||||
buf2 @"abcd"]
|
||||
(assert (deep= (int/to-bytes (i64 1) :le buf1)
|
||||
@"\x01\x00\x00\x00\x00\x00\x00\x00"))
|
||||
(assert (deep= buf1 @"\x01\x00\x00\x00\x00\x00\x00\x00"))
|
||||
(assert (deep= (int/to-bytes (u64 300) :be buf2)
|
||||
@"abcd\x00\x00\x00\x00\x00\x00\x01\x2C")))
|
||||
|
||||
# int/s64 and int/u64 parameter type checking
|
||||
# 6aea7c7f7
|
||||
(assert-error
|
||||
"bad value passed to int/to-bytes"
|
||||
(int/to-bytes 1))
|
||||
|
||||
# 6aea7c7f7
|
||||
(assert-error
|
||||
"invalid endianness passed to int/to-bytes"
|
||||
(int/to-bytes (u64 0) :little))
|
||||
|
||||
# bbb3e16fd
|
||||
(assert-error
|
||||
"invalid buffer passed to int/to-bytes"
|
||||
(int/to-bytes (u64 0) :little :buffer))
|
||||
|
||||
# Right hand operators
|
||||
# 4fe005e3c
|
||||
(assert (= (int/s64 (sum (range 10))) (sum (map int/s64 (range 10))))
|
||||
"right hand operators 1")
|
||||
(assert (= (int/s64
|
||||
(product (range 1 10))) (product (map int/s64 (range 1 10))))
|
||||
"right hand operators 2")
|
||||
(assert (= (int/s64 15) (bor 10 (int/s64 5)) (bor (int/s64 10) 5))
|
||||
"right hand operators 3")
|
||||
|
||||
# Integer type checks
|
||||
# 11067d7a5
|
||||
(assert (compare= 0 (- (int/u64 "1000") 1000)) "subtract from int/u64")
|
||||
|
||||
(assert (odd? (int/u64 "1001")) "odd? 1")
|
||||
(assert (not (odd? (int/u64 "1000"))) "odd? 2")
|
||||
(assert (odd? (int/s64 "1001")) "odd? 3")
|
||||
(assert (not (odd? (int/s64 "1000"))) "odd? 4")
|
||||
(assert (odd? (int/s64 "-1001")) "odd? 5")
|
||||
(assert (not (odd? (int/s64 "-1000"))) "odd? 6")
|
||||
|
||||
(assert (even? (int/u64 "1000")) "even? 1")
|
||||
(assert (not (even? (int/u64 "1001"))) "even? 2")
|
||||
(assert (even? (int/s64 "1000")) "even? 3")
|
||||
(assert (not (even? (int/s64 "1001"))) "even? 4")
|
||||
(assert (even? (int/s64 "-1000")) "even? 5")
|
||||
(assert (not (even? (int/s64 "-1001"))) "even? 6")
|
||||
|
||||
# integer type operations
|
||||
(defn opcheck [int x y]
|
||||
(each op [mod % div]
|
||||
(assert (compare= (op x y) (op (int x) y))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) y)))
|
||||
(assert (compare= (op x y) (op x (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op x (int y))))
|
||||
(assert (compare= (op x y) (op (int x) (int y)))
|
||||
(string int " (" op " " x " " y ") expected " (op x y)
|
||||
", got " (op (int x) (int y))))))
|
||||
|
||||
(loop [x :in [-5 -3 0 3 5]
|
||||
y :in [-4 -3 3 4]]
|
||||
(opcheck int/s64 x y)
|
||||
(if (and (>= x 0) (>= y 0))
|
||||
(opcheck int/u64 x y)))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(each op [% / div]
|
||||
(assert-error "division by zero" (op (int 7) 0))
|
||||
(assert-error "division by zero" (op 7 (int 0)))
|
||||
(assert-error "division by zero" (op (int 7) (int 0)))))
|
||||
|
||||
(each int [int/s64 int/u64]
|
||||
(loop [x :in [-5 -3 0 3 5] :when (or (pos? x) (= int int/s64))]
|
||||
# skip check when comparing negative values with unsigned integers.
|
||||
(assert (= (int x) (mod (int x) 0)) (string int " mod 0"))
|
||||
(assert (= (int x) (mod x (int 0))) (string int " mod 0"))
|
||||
(assert (= (int x) (mod (int x) (int 0))) (string int " mod 0"))))
|
||||
|
||||
(loop [x :in [-5 -3 0 3 5]]
|
||||
(assert (compare= (bnot x) (bnot (int/s64 x))) "int/s64 bnot"))
|
||||
|
||||
(loop [x :range [0 10]]
|
||||
(assert (= (int/u64 "0xFFFF_FFFF_FFFF_FFFF")
|
||||
(bxor (int/u64 x) (bnot (int/u64 x))))
|
||||
"int/u64 bnot"))
|
||||
|
||||
# Check for issue #1130
|
||||
# 7e65c2bda
|
||||
(var d (int/s64 7))
|
||||
(mod 0 d)
|
||||
|
||||
(var d (int/s64 7))
|
||||
(def result (seq [n :in (range -21 0)] (mod n d)))
|
||||
(assert (deep= result
|
||||
(map int/s64 @[0 1 2 3 4 5 6 0 1 2 3 4 5 6 0 1 2 3 4 5 6]))
|
||||
"issue #1130")
|
||||
|
||||
# issue #272 - 81d301a42
|
||||
(let [MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
compare-poly-tests
|
||||
[[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
|
||||
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
|
||||
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
|
||||
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
|
||||
[(int/s64 MAX_INT_IN_DBL_STRING)
|
||||
(scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(int/u64 MAX_INT_IN_DBL_STRING)
|
||||
(scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING))
|
||||
(scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y))
|
||||
(string/format "compare polymorphic %q %q %d" x y c))))
|
||||
|
||||
# marshal
|
||||
(def m1 (u64 3141592654))
|
||||
(def m2 (unmarshal (marshal m1)))
|
||||
(assert (= m1 m2) "marshal/unmarshal")
|
||||
|
||||
# compare u64/u64
|
||||
(assert (= (compare (u64 1) (u64 2)) -1) "compare 1")
|
||||
(assert (= (compare (u64 1) (u64 1)) 0) "compare 2")
|
||||
(assert (= (compare (u64 2) (u64 1)) +1) "compare 3")
|
||||
|
||||
# compare i64/i64
|
||||
(assert (= (compare (i64 -1) (i64 +1)) -1) "compare 4")
|
||||
(assert (= (compare (i64 +1) (i64 +1)) 0) "compare 5")
|
||||
(assert (= (compare (i64 +1) (i64 -1)) +1) "compare 6")
|
||||
|
||||
# compare u64/i64
|
||||
(assert (= (compare (u64 1) (i64 2)) -1) "compare 7")
|
||||
(assert (= (compare (u64 1) (i64 -1)) +1) "compare 8")
|
||||
(assert (= (compare (u64 0) (i64 -1)) +1) "compare 9")
|
||||
|
||||
# compare i64/u64
|
||||
(assert (= (compare (i64 1) (u64 2)) -1) "compare 10")
|
||||
(assert (= (compare (i64 -1) (u64 1)) -1) "compare 11")
|
||||
(assert (= (compare (i64 -1) (u64 0)) -1) "compare 12")
|
||||
|
||||
# off by 1 error in inttypes
|
||||
# a3e812b86
|
||||
(assert (= (int/s64 "-0x8000_0000_0000_0000")
|
||||
(+ (int/s64 "0x7FFF_FFFF_FFFF_FFFF") 1)) "int types wrap around")
|
||||
(assert (= (int/s64 "0x7FFF_FFFF_FFFF_FFFF")
|
||||
(- (int/s64 "-0x8000_0000_0000_0000") 1)) "int types wrap around")
|
||||
|
||||
# Issue #1217
|
||||
(assert (= (- (int/u64 "0xFFFFFFFF") 1) (int/u64 "0xFFFFFFFE")) "u64 subtract")
|
||||
|
||||
(end-suite)
|
||||
82
test/suite-io.janet
Normal file
82
test/suite-io.janet
Normal file
@@ -0,0 +1,82 @@
|
||||
# Copyright (c) 2023 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)
|
||||
|
||||
# Printing to buffers
|
||||
# d47804d22
|
||||
(def out-buf @"")
|
||||
(def err-buf @"")
|
||||
(with-dyns [:out out-buf :err err-buf]
|
||||
(print "Hello")
|
||||
(prin "hi")
|
||||
(eprint "Sup")
|
||||
(eprin "not much."))
|
||||
|
||||
(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
|
||||
(assert (= (string err-buf) "Sup\nnot much.")
|
||||
"eprint and eprin to buffer 1")
|
||||
|
||||
# Printing to functions
|
||||
# 4e263b8c3
|
||||
(def out-buf @"")
|
||||
(defn prepend [x]
|
||||
(with-dyns [:out out-buf]
|
||||
(prin "> " x)))
|
||||
(with-dyns [:out prepend]
|
||||
(print "Hello world"))
|
||||
|
||||
(assert (= (string out-buf) "> Hello world\n")
|
||||
"print to buffer via function")
|
||||
|
||||
# c2f844157, 3c523d66e
|
||||
(with [f (file/temp)]
|
||||
(assert (= 0 (file/tell f)) "start of file")
|
||||
(file/write f "foo\n")
|
||||
(assert (= 4 (file/tell f)) "after written string")
|
||||
(file/flush f)
|
||||
(file/seek f :set 0)
|
||||
(assert (= 0 (file/tell f)) "start of file again")
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
|
||||
|
||||
# issue #1055 - 2c927ea76
|
||||
(let [b @""]
|
||||
(defn dummy [a b c]
|
||||
(+ a b c))
|
||||
(trace dummy)
|
||||
(defn errout [arg]
|
||||
(buffer/push b arg))
|
||||
(assert (= 6 (with-dyns [*err* errout] (dummy 1 2 3)))
|
||||
"trace to custom err function")
|
||||
(assert (deep= @"trace (dummy 1 2 3)\n" b) "trace buffer correct"))
|
||||
|
||||
|
||||
# xprintf
|
||||
(def b @"")
|
||||
(defn to-b [a] (buffer/push b a))
|
||||
(xprintf to-b "123")
|
||||
(assert (deep= b @"123\n") "xprintf to buffer")
|
||||
|
||||
|
||||
(assert-error "cannot print to 3" (xprintf 3 "123"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
150
test/suite-marsh.janet
Normal file
150
test/suite-marsh.janet
Normal file
@@ -0,0 +1,150 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Marshal
|
||||
|
||||
# 98f2c6f
|
||||
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
# 0cf10946b
|
||||
(defn testmarsh [x msg]
|
||||
(def marshx (marshal x m-lookup))
|
||||
(def out (marshal (unmarshal marshx um-lookup) m-lookup))
|
||||
(assert (= (string marshx) (string out)) msg))
|
||||
|
||||
(testmarsh nil "marshal nil")
|
||||
(testmarsh false "marshal false")
|
||||
(testmarsh true "marshal true")
|
||||
(testmarsh 1 "marshal small integers")
|
||||
(testmarsh -1 "marshal integers (-1)")
|
||||
(testmarsh 199 "marshal small integers (199)")
|
||||
(testmarsh 5000 "marshal medium integers (5000)")
|
||||
(testmarsh -5000 "marshal small integers (-5000)")
|
||||
(testmarsh 10000 "marshal large integers (10000)")
|
||||
(testmarsh -10000 "marshal large integers (-10000)")
|
||||
(testmarsh 1.0 "marshal double")
|
||||
(testmarsh "doctordolittle" "marshal string")
|
||||
(testmarsh :chickenshwarma "marshal symbol")
|
||||
(testmarsh @"oldmcdonald" "marshal buffer")
|
||||
(testmarsh @[1 2 3 4 5] "marshal array")
|
||||
(testmarsh [tuple 1 2 3 4 5] "marshal tuple")
|
||||
(testmarsh @{1 2 3 4} "marshal table")
|
||||
(testmarsh {1 2 3 4} "marshal struct")
|
||||
(testmarsh (fn [x] x) "marshal function 0")
|
||||
(testmarsh (fn name [x] x) "marshal function 1")
|
||||
(testmarsh (fn [x] (+ 10 x 2)) "marshal function 2")
|
||||
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
|
||||
(testmarsh map "marshal function 4")
|
||||
(testmarsh reduce "marshal function 5")
|
||||
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
||||
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
||||
|
||||
# issue #53 - 1147482e6
|
||||
(def strct {:a @[nil]})
|
||||
(put (strct :a) 0 strct)
|
||||
(testmarsh strct "cyclic struct")
|
||||
|
||||
# More marshalling code
|
||||
# issue #53 - 1147482e6
|
||||
(defn check-image
|
||||
"Run a marshaling test using the make-image and load-image functions."
|
||||
[x msg]
|
||||
(def im (make-image x))
|
||||
# (printf "\nimage-hash: %d" (-> im string hash))
|
||||
(assert-no-error msg (load-image im)))
|
||||
|
||||
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||
(check-image (fiber/new (fn [] (fn [] 1)))
|
||||
"marshal nested functions in fiber")
|
||||
(check-image (fiber/new (fn [] (fiber/new (fn [] 1))))
|
||||
"marshal nested fibers")
|
||||
|
||||
# issue #53 - f4908ebc4
|
||||
(def issue-53-x
|
||||
(fiber/new
|
||||
(fn []
|
||||
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||
|
||||
(check-image issue-53-x "issue 53 regression")
|
||||
|
||||
# Marshal closure over non resumable fiber
|
||||
# issue #317 - 7c4ffe9b9
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ tup] (protect (f1 @[0])))
|
||||
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
|
||||
|
||||
# Marshal closure over currently alive fiber
|
||||
# issue #317 - 7c4ffe9b9
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(marshal [f1 f2] make-image-dict))
|
||||
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-live-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-live-closure 2"))
|
||||
|
||||
(do
|
||||
(var a 1)
|
||||
(defn b [x] (+ a x))
|
||||
(def c (unmarshal (marshal b)))
|
||||
(assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
|
||||
|
||||
# Issue #336 cases - don't segfault
|
||||
# b145d4786
|
||||
(assert-error "unmarshal errors 1" (unmarshal @"\xd6\xb9\xb9"))
|
||||
(assert-error "unmarshal errors 2" (unmarshal @"\xd7bc"))
|
||||
# 5bbd50785
|
||||
(assert-error "unmarshal errors 3"
|
||||
(unmarshal "\xd3\x01\xd9\x01\x62\xcf\x03\x78\x79\x7a"
|
||||
load-image-dict))
|
||||
# fcc610f53
|
||||
(assert-error "unmarshal errors 4"
|
||||
(unmarshal
|
||||
@"\xD7\xCD\0e/p\x98\0\0\x03\x01\x01\x01\x02\0\0\x04\0\xCEe/p../tools
|
||||
\0\0\0/afl\0\0\x01\0erate\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE\xDE
|
||||
\xA8\xDE\xDE\xDE\xDE\xDE\xDE\0\0\0\xDE\xDE_unmarshal_testcase3.ja
|
||||
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
|
||||
# XXX: still needed? see 72beeeea
|
||||
(gccollect)
|
||||
|
||||
# ev/chan marshalling
|
||||
(compwhen (dyn 'ev/chan)
|
||||
(def chan (ev/chan 10))
|
||||
(ev/give chan chan)
|
||||
(def newchan (unmarshal (marshal chan)))
|
||||
(def item (ev/take newchan))
|
||||
(assert (= item newchan) "ev/chan marshalling"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
69
test/suite-math.janet
Normal file
69
test/suite-math.janet
Normal file
@@ -0,0 +1,69 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# First commit removing the integer number type
|
||||
# 6b95326d7
|
||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
|
||||
# RNGs
|
||||
# aee168721
|
||||
(defn test-rng
|
||||
[rng]
|
||||
(assert (all identity (seq [i :range [0 1000]]
|
||||
(<= (math/rng-int rng i) i))) "math/rng-int test")
|
||||
(assert (all identity (seq [i :range [0 1000]]
|
||||
(def x (math/rng-uniform rng))
|
||||
(and (>= x 0) (< x 1))))
|
||||
"math/rng-uniform test"))
|
||||
|
||||
(def seedrng (math/rng 123))
|
||||
(for i 0 75
|
||||
(test-rng (math/rng (:int seedrng))))
|
||||
|
||||
# 70328437f
|
||||
(assert (deep-not= (-> 123 math/rng (:buffer 16))
|
||||
(-> 456 math/rng (:buffer 16))) "math/rng-buffer 1")
|
||||
|
||||
(assert-no-error "math/rng-buffer 2" (math/seedrandom "abcdefg"))
|
||||
|
||||
# 027b2a8
|
||||
(defn assert-many [f n e]
|
||||
(var good true)
|
||||
(loop [i :range [0 n]]
|
||||
(if (not (f))
|
||||
(set good false)))
|
||||
(assert good e))
|
||||
|
||||
(assert-many (fn [] (>= 1 (math/random) 0)) 200 "(random) between 0 and 1")
|
||||
|
||||
# 06aa0a124
|
||||
(assert (= (math/gcd 462 1071) 21) "math/gcd 1")
|
||||
(assert (= (math/lcm 462 1071) 23562) "math/lcm 1")
|
||||
|
||||
# math gamma
|
||||
# e6babd8
|
||||
(assert (< 11899423.08 (math/gamma 11.5) 11899423.085) "math/gamma")
|
||||
(assert (< 2605.1158 (math/log-gamma 500) 2605.1159) "math/log-gamma")
|
||||
|
||||
(end-suite)
|
||||
|
||||
162
test/suite-os.janet
Normal file
162
test/suite-os.janet
Normal file
@@ -0,0 +1,162 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
(def janet (dyn :executable))
|
||||
(def run (filter next (string/split " " (os/getenv "SUBRUN" ""))))
|
||||
|
||||
# OS Date test
|
||||
# 719f7ba0c
|
||||
(assert (deep= {:year-day 0
|
||||
:minutes 30
|
||||
:month 0
|
||||
:dst false
|
||||
:seconds 0
|
||||
:year 2014
|
||||
:month-day 0
|
||||
:hours 20
|
||||
:week-day 3}
|
||||
(os/date 1388608200)) "os/date")
|
||||
|
||||
# OS mktime test
|
||||
# 3ee43c3ab
|
||||
(assert (= 1388608200 (os/mktime {:year-day 0
|
||||
:minutes 30
|
||||
:month 0
|
||||
:dst false
|
||||
:seconds 0
|
||||
:year 2014
|
||||
:month-day 0
|
||||
:hours 20
|
||||
:week-day 3})) "os/mktime")
|
||||
|
||||
(def now (os/time))
|
||||
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
|
||||
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
|
||||
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
|
||||
|
||||
# OS strftime test
|
||||
# 5cd729c4c
|
||||
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 0) "1970-01-01 00:00:00")
|
||||
"strftime UTC epoch")
|
||||
(assert (= (os/strftime "%Y-%m-%d %H:%M:%S" 1388608200)
|
||||
"2014-01-01 20:30:00")
|
||||
"strftime january 2014")
|
||||
(assert (= (try (os/strftime "%%%d%t") ([err] err))
|
||||
"invalid conversion specifier '%t'")
|
||||
"invalid conversion specifier")
|
||||
|
||||
# 07db4c530
|
||||
(os/setenv "TESTENV1" "v1")
|
||||
(os/setenv "TESTENV2" "v2")
|
||||
(assert (= (os/getenv "TESTENV1") "v1") "getenv works")
|
||||
(def environ (os/environ))
|
||||
(assert (= [(environ "TESTENV1") (environ "TESTENV2")] ["v1" "v2"])
|
||||
"environ works")
|
||||
|
||||
# Ensure randomness puts n of pred into our buffer eventually
|
||||
# 0ac5b243c
|
||||
(defn cryptorand-check
|
||||
[n pred]
|
||||
(def max-attempts 10000)
|
||||
(var attempts 0)
|
||||
(while (not= attempts max-attempts)
|
||||
(def cryptobuf (os/cryptorand 10))
|
||||
(when (= n (count pred cryptobuf))
|
||||
(break))
|
||||
(++ attempts))
|
||||
(not= attempts max-attempts))
|
||||
|
||||
(def v (math/rng-int (math/rng (os/time)) 100))
|
||||
(assert (cryptorand-check 0 |(= $ v)) "cryptorand skips value sometimes")
|
||||
(assert (cryptorand-check 1 |(= $ v)) "cryptorand has value sometimes")
|
||||
|
||||
(do
|
||||
(def buf (buffer/new-filled 1))
|
||||
(os/cryptorand 1 buf)
|
||||
(assert (= (in buf 0) 0) "cryptorand doesn't overwrite buffer")
|
||||
(assert (= (length buf) 2) "cryptorand appends to buffer"))
|
||||
|
||||
(assert-no-error "realtime clock" (os/clock))
|
||||
(assert-no-error "realtime clock" (os/clock nil))
|
||||
(assert-no-error "realtime clock" (os/clock nil nil))
|
||||
|
||||
# 80db68210
|
||||
(assert-no-error "realtime clock" (os/clock :realtime))
|
||||
(assert-no-error "cputime clock" (os/clock :cputime))
|
||||
(assert-no-error "monotonic clock" (os/clock :monotonic))
|
||||
|
||||
(assert-no-error "realtime clock double output" (os/clock nil :double))
|
||||
(assert-no-error "realtime clock int output" (os/clock nil :int))
|
||||
(assert-no-error "realtime clock tuple output" (os/clock nil :tuple))
|
||||
|
||||
(assert-error "invalid clock" (os/clock :a))
|
||||
(assert-error "invalid output" (os/clock :realtime :b))
|
||||
(assert-error "invalid clock and output" (os/clock :a :b))
|
||||
|
||||
(def before (os/clock :monotonic))
|
||||
(def after (os/clock :monotonic))
|
||||
(assert (>= after before) "monotonic clock is monotonic")
|
||||
|
||||
# Perm strings
|
||||
# a0d61e45d
|
||||
(assert (= (os/perm-int "rwxrwxrwx") 8r777) "perm 1")
|
||||
(assert (= (os/perm-int "rwxr-xr-x") 8r755) "perm 2")
|
||||
(assert (= (os/perm-int "rw-r--r--") 8r644) "perm 3")
|
||||
|
||||
(assert (= (band (os/perm-int "rwxrwxrwx") 8r077) 8r077) "perm 4")
|
||||
(assert (= (band (os/perm-int "rwxr-xr-x") 8r077) 8r055) "perm 5")
|
||||
(assert (= (band (os/perm-int "rw-r--r--") 8r077) 8r044) "perm 6")
|
||||
|
||||
(assert (= (os/perm-string 8r777) "rwxrwxrwx") "perm 7")
|
||||
(assert (= (os/perm-string 8r755) "rwxr-xr-x") "perm 8")
|
||||
(assert (= (os/perm-string 8r644) "rw-r--r--") "perm 9")
|
||||
|
||||
# os/execute with environment variables
|
||||
# issue #636 - 7e2c433ab
|
||||
(assert (= 0 (os/execute [;run janet "-e" "(+ 1 2 3)"] :pe
|
||||
(merge (os/environ) {"HELLO" "WORLD"})))
|
||||
"os/execute with env")
|
||||
|
||||
# os/execute regressions
|
||||
# 427f7c362
|
||||
(for i 0 10
|
||||
(assert (= i (os/execute [;run janet "-e"
|
||||
(string/format "(os/exit %d)" i)] :p))
|
||||
(string "os/execute " i)))
|
||||
|
||||
# os/execute IO redirection
|
||||
(assert-no-error "IO redirection"
|
||||
(defn devnull []
|
||||
(def os (os/which))
|
||||
(def path (if (or (= os :mingw) (= os :windows))
|
||||
"NUL"
|
||||
"/dev/null"))
|
||||
(os/open path :w))
|
||||
(with [dn (devnull)]
|
||||
(os/execute [;run janet
|
||||
"-e"
|
||||
"(print :foo) (eprint :bar)"]
|
||||
:px
|
||||
{:out dn :err dn})))
|
||||
|
||||
(end-suite)
|
||||
192
test/suite-parse.janet
Normal file
192
test/suite-parse.janet
Normal file
@@ -0,0 +1,192 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# 7e46ead2f
|
||||
(assert (not false) "false literal")
|
||||
(assert true "true literal")
|
||||
(assert (not nil) "nil literal")
|
||||
|
||||
(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
|
||||
|
||||
# String literals
|
||||
# 45f8db0
|
||||
(assert (= "abcd" "\x61\x62\x63\x64") "hex escapes")
|
||||
(assert (= "\e" "\x1B") "escape character")
|
||||
(assert (= "\x09" "\t") "tab character")
|
||||
|
||||
# Long strings
|
||||
# 7e6342720
|
||||
(assert (= "hello, world" `hello, world`) "simple long string")
|
||||
(assert (= "hello, \"world\"" `hello, "world"`)
|
||||
"long string with embedded quotes")
|
||||
(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`)
|
||||
"long string with embedded quotes and backslashes")
|
||||
|
||||
#
|
||||
# Longstring indentation
|
||||
#
|
||||
# 7aa4241
|
||||
(defn reindent
|
||||
"Reindent the contents of a longstring as the Janet parser would.
|
||||
This include removing leading and trailing newlines."
|
||||
[text indent]
|
||||
|
||||
# Detect minimum indent
|
||||
(var rewrite true)
|
||||
(each index (string/find-all "\n" text)
|
||||
(for i (+ index 1) (+ index indent 1)
|
||||
(case (get text i)
|
||||
nil (break)
|
||||
(chr "\n") (break)
|
||||
(chr " ") nil
|
||||
(set rewrite false))))
|
||||
|
||||
# Only re-indent if no dedented characters.
|
||||
(def str
|
||||
(if rewrite
|
||||
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
|
||||
text))
|
||||
|
||||
(def first-nl (= (chr "\n") (first str)))
|
||||
(def last-nl (= (chr "\n") (last str)))
|
||||
(string/slice str (if first-nl 1 0) (if last-nl -2)))
|
||||
|
||||
(defn reindent-reference
|
||||
"Same as reindent but use parser functionality. Useful for
|
||||
validating conformance."
|
||||
[text indent]
|
||||
(if (empty? text) (break text))
|
||||
(def source-code
|
||||
(string (string/repeat " " indent) "``````"
|
||||
text
|
||||
"``````"))
|
||||
(parse source-code))
|
||||
|
||||
(var indent-counter 0)
|
||||
(defn check-indent
|
||||
[text indent]
|
||||
(++ indent-counter)
|
||||
(let [a (reindent text indent)
|
||||
b (reindent-reference text indent)]
|
||||
(assert (= a b)
|
||||
(string "indent " indent-counter " (indent=" indent ")"))))
|
||||
|
||||
(check-indent "" 0)
|
||||
(check-indent "\n" 0)
|
||||
(check-indent "\n" 1)
|
||||
(check-indent "\n\n" 0)
|
||||
(check-indent "\n\n" 1)
|
||||
(check-indent "\nHello, world!" 0)
|
||||
(check-indent "\nHello, world!" 1)
|
||||
(check-indent "Hello, world!" 0)
|
||||
(check-indent "Hello, world!" 1)
|
||||
(check-indent "\n Hello, world!" 4)
|
||||
(check-indent "\n Hello, world!\n" 4)
|
||||
(check-indent "\n Hello, world!\n " 4)
|
||||
(check-indent "\n Hello, world!\n " 4)
|
||||
(check-indent "\n Hello, world!\n dedented text\n " 4)
|
||||
(check-indent "\n Hello, world!\n indented text\n " 4)
|
||||
|
||||
# Symbols with @ character
|
||||
# d68eae9
|
||||
(def @ 1)
|
||||
(assert (= @ 1) "@ symbol")
|
||||
(def @-- 2)
|
||||
(assert (= @-- 2) "@-- symbol")
|
||||
(def @hey 3)
|
||||
(assert (= @hey 3) "@hey symbol")
|
||||
|
||||
# Parser clone
|
||||
# 43520ac67
|
||||
(def p (parser/new))
|
||||
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p))
|
||||
(parser/consume p2 ") 1 ")
|
||||
(parser/consume p ") 1 ")
|
||||
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
|
||||
|
||||
# Parser errors
|
||||
# 976dfc719
|
||||
(defn parse-error [input]
|
||||
(def p (parser/new))
|
||||
(parser/consume p input)
|
||||
(parser/error p))
|
||||
|
||||
# Invalid utf-8 sequences
|
||||
(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
|
||||
(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
|
||||
|
||||
# Parser line and column numbers
|
||||
# 77b79e989
|
||||
(defn parser-location [input &opt location]
|
||||
(def p (parser/new))
|
||||
(parser/consume p input)
|
||||
(if location
|
||||
(parser/where p ;location)
|
||||
(parser/where p)))
|
||||
|
||||
(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
|
||||
(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
|
||||
(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
|
||||
|
||||
# Issue #861 - should be valgrind clean
|
||||
# 39c6be7cb
|
||||
(def step1 "(a b c d)\n")
|
||||
(def step2 "(a b)\n")
|
||||
(def p1 (parser/new))
|
||||
(parser/state p1)
|
||||
(parser/consume p1 step1)
|
||||
(loop [v :iterate (parser/produce p1)])
|
||||
(parser/state p1)
|
||||
(def p2 (parser/clone p1))
|
||||
(parser/state p2)
|
||||
(parser/consume p2 step2)
|
||||
(loop [v :iterate (parser/produce p2)])
|
||||
(parser/state p2)
|
||||
|
||||
# parser delimiter errors
|
||||
(defn test-error [delim fmt]
|
||||
(def p (parser/new))
|
||||
(parser/consume p delim)
|
||||
(parser/eof p)
|
||||
(def msg (string/format fmt delim))
|
||||
(assert (= (parser/error p) msg) "delimiter error"))
|
||||
(each c [ "(" "{" "[" "\"" "``" ]
|
||||
(test-error c "unexpected end of source, %s opened at line 1, column 1"))
|
||||
|
||||
# parser/insert
|
||||
(def p (parser/new))
|
||||
(parser/consume p "(")
|
||||
(parser/insert p "hello")
|
||||
(parser/consume p ")")
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
|
||||
(def p (parser/new))
|
||||
(parser/consume p `("hel`)
|
||||
(parser/insert p `lo`)
|
||||
(parser/consume p `")`)
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
|
||||
(end-suite)
|
||||
|
||||
760
test/suite-peg.janet
Normal file
760
test/suite-peg.janet
Normal file
@@ -0,0 +1,760 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Peg
|
||||
|
||||
# 83f4a11bf
|
||||
(defn check-match
|
||||
[pat text should-match]
|
||||
(def result (peg/match pat text))
|
||||
(assert (= (not should-match) (not result))
|
||||
(string "check-match " text)))
|
||||
|
||||
# 798c88b4c
|
||||
(defn check-deep
|
||||
[pat text what]
|
||||
(def result (peg/match pat text))
|
||||
(assert (deep= result what) (string "check-deep " text)))
|
||||
|
||||
# Just numbers
|
||||
# 83f4a11bf
|
||||
(check-match '(* 4 -1) "abcd" true)
|
||||
(check-match '(* 4 -1) "abc" false)
|
||||
(check-match '(* 4 -1) "abcde" false)
|
||||
|
||||
# Simple pattern
|
||||
# 83f4a11bf
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "hello" true)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "hello world" false)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "1he11o" false)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "" false)
|
||||
|
||||
# Pre compile
|
||||
# ff0d3a008
|
||||
(def pegleg (peg/compile '{:item "abc" :main (* :item "," :item -1)}))
|
||||
|
||||
(peg/match pegleg "abc,abc")
|
||||
|
||||
# Bad Grammars
|
||||
# 192705113
|
||||
(assert-error "peg/compile error 1" (peg/compile nil))
|
||||
(assert-error "peg/compile error 2" (peg/compile @{}))
|
||||
(assert-error "peg/compile error 3" (peg/compile '{:a "abc" :b "def"}))
|
||||
(assert-error "peg/compile error 4" (peg/compile '(blarg "abc")))
|
||||
(assert-error "peg/compile error 5" (peg/compile '(1 2 3)))
|
||||
|
||||
# IP address
|
||||
# 40845b5c1
|
||||
(def ip-address
|
||||
'{:d (range "09")
|
||||
:0-4 (range "04")
|
||||
:0-5 (range "05")
|
||||
:byte (+
|
||||
(* "25" :0-5)
|
||||
(* "2" :0-4 :d)
|
||||
(* "1" :d :d)
|
||||
(between 1 2 :d))
|
||||
:main (* :byte "." :byte "." :byte "." :byte)})
|
||||
|
||||
(check-match ip-address "10.240.250.250" true)
|
||||
(check-match ip-address "0.0.0.0" true)
|
||||
(check-match ip-address "1.2.3.4" true)
|
||||
(check-match ip-address "256.2.3.4" false)
|
||||
(check-match ip-address "256.2.3.2514" false)
|
||||
|
||||
# Substitution test with peg
|
||||
# d7626f8c5
|
||||
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(defn try-grammar [text]
|
||||
(assert (= (string/replace-all "dog" "purple panda" text)
|
||||
(0 (peg/match grammar text))) text))
|
||||
|
||||
(try-grammar "i have a dog called doug the dog. he is good.")
|
||||
(try-grammar "i have a dog called doug the dog. he is a good boy.")
|
||||
(try-grammar "i have a dog called doug the do")
|
||||
(try-grammar "i have a dog called doug the dog")
|
||||
(try-grammar "i have a dog called doug the dogg")
|
||||
(try-grammar "i have a dog called doug the doggg")
|
||||
(try-grammar "i have a dog called doug the dogggg")
|
||||
|
||||
# Peg CSV test
|
||||
# 798c88b4c
|
||||
(def csv
|
||||
'{:field (+
|
||||
(* `"` (% (any (+ (<- (if-not `"` 1))
|
||||
(* (constant `"`) `""`)))) `"`)
|
||||
(<- (any (if-not (set ",\n") 1))))
|
||||
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
||||
|
||||
(defn check-csv
|
||||
[str res]
|
||||
(check-deep csv str res))
|
||||
|
||||
(check-csv "1,2,3" @["1" "2" "3"])
|
||||
(check-csv "1,\"2\",3" @["1" "2" "3"])
|
||||
(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
|
||||
|
||||
# Nested Captures
|
||||
# 798c88b4c
|
||||
(def grmr '(capture (* (capture "a") (capture 1) (capture "c"))))
|
||||
(check-deep grmr "abc" @["a" "b" "c" "abc"])
|
||||
(check-deep grmr "acc" @["a" "c" "c" "acc"])
|
||||
|
||||
# Functions in grammar
|
||||
# 798c88b4c
|
||||
(def grmr-triple ~(% (any (/ (<- 1) ,(fn [x] (string x x x))))))
|
||||
(check-deep grmr-triple "abc" @["aaabbbccc"])
|
||||
(check-deep grmr-triple "" @[""])
|
||||
(check-deep grmr-triple " " @[" "])
|
||||
|
||||
(def counter ~(/ (group (any (<- 1))) ,length))
|
||||
(check-deep counter "abcdefg" @[7])
|
||||
|
||||
# Capture Backtracking
|
||||
# ff0d3a008
|
||||
(check-deep '(+ (* (capture "c") "d") "ce") "ce" @[])
|
||||
|
||||
# Matchtime capture
|
||||
# 192705113
|
||||
(def scanner (peg/compile ~(cmt (capture (some 1)) ,scan-number)))
|
||||
|
||||
(check-deep scanner "123" @[123])
|
||||
(check-deep scanner "0x86" @[0x86])
|
||||
(check-deep scanner "-1.3e-7" @[-1.3e-7])
|
||||
(check-deep scanner "123A" nil)
|
||||
|
||||
# Recursive grammars
|
||||
# 170e785b7
|
||||
(def g '{:main (+ (* "a" :main "b") "c")})
|
||||
|
||||
(check-match g "c" true)
|
||||
(check-match g "acb" true)
|
||||
(check-match g "aacbb" true)
|
||||
(check-match g "aadbb" false)
|
||||
|
||||
# Back reference
|
||||
# d0ec89c7c
|
||||
(def wrapped-string
|
||||
~{:pad (any "=")
|
||||
:open (* "[" (<- :pad :n) "[")
|
||||
:close (* "]" (cmt (* (-> :n) (<- :pad)) ,=) "]")
|
||||
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||
|
||||
(check-match wrapped-string "[[]]" true)
|
||||
(check-match wrapped-string "[==[a]==]" true)
|
||||
(check-match wrapped-string "[==[]===]" false)
|
||||
(check-match wrapped-string "[[blark]]" true)
|
||||
(check-match wrapped-string "[[bl[ark]]" true)
|
||||
(check-match wrapped-string "[[bl]rk]]" true)
|
||||
(check-match wrapped-string "[[bl]rk]] " false)
|
||||
(check-match wrapped-string "[=[bl]]rk]=] " false)
|
||||
(check-match wrapped-string "[=[bl]==]rk]=] " false)
|
||||
(check-match wrapped-string "[===[]==]===]" true)
|
||||
|
||||
(def janet-longstring
|
||||
~{:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
|
||||
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||
|
||||
(check-match janet-longstring "`john" false)
|
||||
(check-match janet-longstring "abc" false)
|
||||
(check-match janet-longstring "` `" true)
|
||||
(check-match janet-longstring "` `" true)
|
||||
(check-match janet-longstring "`` ``" true)
|
||||
(check-match janet-longstring "``` `` ```" true)
|
||||
(check-match janet-longstring "`` ```" false)
|
||||
(check-match janet-longstring "`a``b`" false)
|
||||
|
||||
# Line and column capture
|
||||
# 776ce586b
|
||||
(def line-col (peg/compile '(any (* (line) (column) 1))))
|
||||
(check-deep line-col "abcd" @[1 1 1 2 1 3 1 4])
|
||||
(check-deep line-col "" @[])
|
||||
(check-deep line-col "abcd\n" @[1 1 1 2 1 3 1 4 1 5])
|
||||
(check-deep line-col "abcd\nz" @[1 1 1 2 1 3 1 4 1 5 2 1])
|
||||
|
||||
# Backmatch
|
||||
# 711fe64a5
|
||||
(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
|
||||
|
||||
(check-match backmatcher-1 "y" true)
|
||||
(check-match backmatcher-1 "xyx" true)
|
||||
(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-1 "xyxx" false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 73) "y") false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y"
|
||||
(string/repeat "x" 10000)) true)
|
||||
|
||||
(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
|
||||
|
||||
(check-match backmatcher-2 "y" true)
|
||||
(check-match backmatcher-2 "xyx" true)
|
||||
(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-2 "xyxx" false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 73) "y") false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y"
|
||||
(string/repeat "x" 10000)) true)
|
||||
|
||||
(def longstring-2 '(* '(some "`")
|
||||
(some (if-not (backmatch) 1))
|
||||
(backmatch) -1))
|
||||
|
||||
(check-match longstring-2 "`john" false)
|
||||
(check-match longstring-2 "abc" false)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "`` ``" true)
|
||||
(check-match longstring-2 "``` `` ```" true)
|
||||
(check-match longstring-2 "`` ```" false)
|
||||
|
||||
# Optional
|
||||
# 4eeadd746
|
||||
(check-match '(* (opt "hi") -1) "" true)
|
||||
(check-match '(* (opt "hi") -1) "hi" true)
|
||||
(check-match '(* (opt "hi") -1) "no" false)
|
||||
(check-match '(* (? "hi") -1) "" true)
|
||||
(check-match '(* (? "hi") -1) "hi" true)
|
||||
(check-match '(* (? "hi") -1) "no" false)
|
||||
|
||||
# Drop
|
||||
# b4934cedd
|
||||
(check-deep '(drop '"hello") "hello" @[])
|
||||
(check-deep '(drop "hello") "hello" @[])
|
||||
|
||||
# Add bytecode verification for peg unmarshaling
|
||||
# e88a9af2f
|
||||
# This should be valgrind clean.
|
||||
(var pegi 3)
|
||||
(defn marshpeg [p]
|
||||
(assert (-> p peg/compile marshal unmarshal)
|
||||
(string "peg marshal " (++ pegi))))
|
||||
(marshpeg '(* 1 2 (set "abcd") "asdasd" (+ "." 3)))
|
||||
(marshpeg '(% (* (+ 1 2 3) (* "drop" "bear") '"hi")))
|
||||
(marshpeg '(> 123 "abcd"))
|
||||
(marshpeg '{:main (* 1 "hello" :main)})
|
||||
(marshpeg '(range "AZ"))
|
||||
(marshpeg '(if-not "abcdf" 123))
|
||||
(marshpeg '(error ($)))
|
||||
(marshpeg '(* "abcd" (constant :hi)))
|
||||
(marshpeg ~(/ "abc" ,identity))
|
||||
(marshpeg '(if-not "abcdf" 123))
|
||||
(marshpeg ~(cmt "abcdf" ,identity))
|
||||
(marshpeg '(group "abc"))
|
||||
(marshpeg '(sub "abcdf" "abc"))
|
||||
(marshpeg '(* (sub 1 1)))
|
||||
(marshpeg '(split "," (+ "a" "b" "c")))
|
||||
|
||||
# Peg swallowing errors
|
||||
# 159651117
|
||||
(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
|
||||
"errors should not be swallowed")
|
||||
(assert (try ((fn [x] (nil x))) ([err] err))
|
||||
"errors should not be swallowed 2")
|
||||
|
||||
# Check for bad memoization (+ :a) should mean different things in
|
||||
# different contexts
|
||||
# 8bc8709d0
|
||||
(def redef-a
|
||||
~{:a "abc"
|
||||
:c (+ :a)
|
||||
:main (* :c {:a "def" :main (+ :a)} -1)})
|
||||
|
||||
(check-match redef-a "abcdef" true)
|
||||
(check-match redef-a "abcabc" false)
|
||||
(check-match redef-a "defdef" false)
|
||||
|
||||
# 54a04b589
|
||||
(def redef-b
|
||||
~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
|
||||
:main :pork})
|
||||
|
||||
(check-match redef-b "abeef" true)
|
||||
(check-match redef-b "aabeef" false)
|
||||
(check-match redef-b "aaaaaa" false)
|
||||
|
||||
# Integer parsing
|
||||
# 45feb5548
|
||||
(check-deep '(int 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint 1) "a" @[(chr "a")])
|
||||
(check-deep '(int-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(int 1) "\xFF" @[-1])
|
||||
(check-deep '(uint 1) "\xFF" @[255])
|
||||
(check-deep '(int-be 1) "\xFF" @[-1])
|
||||
(check-deep '(uint-be 1) "\xFF" @[255])
|
||||
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
|
||||
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(when-let [u64 int/u64
|
||||
i64 int/s64]
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(i64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(i64 0x7fff)]))
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
# to/thru bug
|
||||
# issue #640 - 742469a8b
|
||||
(check-deep '(to -1) "aaaa" @[])
|
||||
(check-deep '(thru -1) "aaaa" @[])
|
||||
(check-deep ''(to -1) "aaaa" @["aaaa"])
|
||||
(check-deep ''(thru -1) "aaaa" @["aaaa"])
|
||||
(check-deep '(to "b") "aaaa" nil)
|
||||
(check-deep '(thru "b") "aaaa" nil)
|
||||
|
||||
# unref
|
||||
# 96513665d
|
||||
(def grammar
|
||||
(peg/compile
|
||||
~{:main (* :tagged -1)
|
||||
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
|
||||
:open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
|
||||
:value (* (constant :value) (group (any (+ :tagged :untagged))))
|
||||
:close-tag (* "</" (backmatch :tag-name) ">")
|
||||
:untagged (capture (any (if-not "<" 1)))}))
|
||||
(check-deep grammar "<p><em>foobar</em></p>"
|
||||
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
|
||||
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
|
||||
# Using a large test grammar
|
||||
# cf05ff610
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
'while true
|
||||
'def true
|
||||
'splice true
|
||||
'set true
|
||||
'unquote true
|
||||
'quasiquote true
|
||||
'quote true
|
||||
'if true})
|
||||
|
||||
(defn- check-number [text] (and (scan-number text) text))
|
||||
|
||||
(defn capture-sym
|
||||
[text]
|
||||
(def sym (symbol text))
|
||||
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
:readermac (set "';~,")
|
||||
:symchars (+ (range "09" "AZ" "az" "\x80\xFF")
|
||||
(set "!$%&*+-./:<?=>@^_|"))
|
||||
:token (some :symchars)
|
||||
:hex (range "09" "af" "AF")
|
||||
:escape (* "\\" (+ (set `"'0?\abefnrtvz`)
|
||||
(* "x" :hex :hex)
|
||||
(error (constant "bad hex escape"))))
|
||||
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
|
||||
:symbol (/ ':token ,capture-sym)
|
||||
:keyword (/ '(* ":" (any :symchars)) (constant :keyword))
|
||||
:constant (/ '(+ "true" "false" "nil") (constant :constant))
|
||||
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
|
||||
:string (/ ':bytes (constant :string))
|
||||
:buffer (/ '(* "@" :bytes) (constant :string))
|
||||
:long-bytes {:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) '(backmatch :n))
|
||||
,=)
|
||||
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||
:long-string (/ ':long-bytes (constant :string))
|
||||
:long-buffer (/ '(* "@" :long-bytes) (constant :string))
|
||||
:number (/ (cmt ':token ,check-number) (constant :number))
|
||||
:raw-value (+ :comment :constant :number :keyword
|
||||
:string :buffer :long-string :long-buffer
|
||||
:parray :barray :ptuple :btuple :struct :dict :symbol)
|
||||
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
|
||||
:root (any :value)
|
||||
:root2 (any (* :value :value))
|
||||
:ptuple (* '"(" :root (+ '")" (error "")))
|
||||
:btuple (* '"[" :root (+ '"]" (error "")))
|
||||
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||
:parray (* '"@" :ptuple)
|
||||
:barray (* '"@" :btuple)
|
||||
:dict (* '"@" :struct)
|
||||
:main (+ :root (error ""))})
|
||||
|
||||
(def p (peg/compile grammar))
|
||||
|
||||
# Just make sure is valgrind clean.
|
||||
(def p (-> p make-image load-image))
|
||||
|
||||
(assert (peg/match p "abc") "complex peg grammar 1")
|
||||
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
|
||||
|
||||
###
|
||||
### Compiling brainfuck to Janet.
|
||||
###
|
||||
# 20d5d560f
|
||||
(def- bf-peg
|
||||
"Peg for compiling brainfuck into a Janet source ast."
|
||||
(peg/compile
|
||||
~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
|
||||
:- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
|
||||
:> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
|
||||
:< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
|
||||
:. (* "." (constant (prinf "%c" (get DATA POS))))
|
||||
:loop (/ (* "[" :main "]") ,(fn [& captures]
|
||||
~(while (not= (get DATA POS) 0)
|
||||
,;captures)))
|
||||
:main (any (+ :s :loop :+ :- :> :< :.))}))
|
||||
|
||||
(defn bf
|
||||
"Run brainfuck."
|
||||
[text]
|
||||
(eval
|
||||
~(let [DATA (array/new-filled 100 0)]
|
||||
(var POS 50)
|
||||
,;(peg/match bf-peg text))))
|
||||
|
||||
(defn test-bf
|
||||
"Test some bf for expected output."
|
||||
[input output]
|
||||
(def b @"")
|
||||
(with-dyns [:out b]
|
||||
(bf input))
|
||||
(assert (= (string output) (string b))
|
||||
(string "bf input '"
|
||||
input
|
||||
"' failed, expected "
|
||||
(describe output)
|
||||
", got "
|
||||
(describe (string b))
|
||||
".")))
|
||||
|
||||
(test-bf (string "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]"
|
||||
">>.>---.+++++++..+++.>>.<-.<.+++.------.--------"
|
||||
".>>+.>++.") "Hello World!\n")
|
||||
|
||||
(test-bf (string ">++++++++"
|
||||
"[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]"
|
||||
">-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------"
|
||||
".>>.+++.------.--------.>+.>+.")
|
||||
"Hello World!\n")
|
||||
|
||||
(test-bf (string "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---"
|
||||
".>>.>.+++.------.>-.>>--.")
|
||||
"Hello, World!")
|
||||
|
||||
# Regression test
|
||||
# issue #300 - 714bd61d5
|
||||
# Just don't segfault
|
||||
(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7")
|
||||
"regression #300")
|
||||
|
||||
# Lenprefix rule
|
||||
# 8b5bcaee3
|
||||
(def peg (peg/compile ~(* (lenprefix (/ (* '(any (if-not ":" 1)) ":")
|
||||
,scan-number) 1) -1)))
|
||||
|
||||
(assert (peg/match peg "5:abcde") "lenprefix 1")
|
||||
(assert (not (peg/match peg "5:abcdef")) "lenprefix 2")
|
||||
(assert (not (peg/match peg "5:abcd")) "lenprefix 3")
|
||||
|
||||
# Packet capture
|
||||
# 8b5bcaee3
|
||||
(def peg2
|
||||
(peg/compile
|
||||
~{# capture packet length in tag :header-len
|
||||
:packet-header (* (/ ':d+ ,scan-number :header-len) ":")
|
||||
|
||||
# capture n bytes from a backref :header-len
|
||||
:packet-body '(lenprefix (-> :header-len) 1)
|
||||
|
||||
# header, followed by body, and drop the :header-len capture
|
||||
:packet (/ (* :packet-header :packet-body) ,|$1)
|
||||
|
||||
# any exact seqence of packets (no extra characters)
|
||||
:main (* (any :packet) -1)}))
|
||||
|
||||
(assert (deep= @["a" "bb" "ccc"] (peg/match peg2 "1:a2:bb3:ccc"))
|
||||
"lenprefix 4")
|
||||
(assert (deep= @["a" "bb" "cccccc"] (peg/match peg2 "1:a2:bb6:cccccc"))
|
||||
"lenprefix 5")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:5:cccccc")) "lenprefix 6")
|
||||
(assert (= nil (peg/match peg2 "1:a2:bb:7:cccccc")) "lenprefix 7")
|
||||
|
||||
# Issue #412
|
||||
# 677737d34
|
||||
(assert (peg/match '(* "a" (> -1 "a") "b") "abc")
|
||||
"lookhead does not move cursor")
|
||||
|
||||
# 6d096551f
|
||||
(def peg3
|
||||
~{:main (* "(" (thru ")"))})
|
||||
|
||||
(def peg4 (peg/compile ~(* (thru "(") '(to ")"))))
|
||||
|
||||
(assert (peg/match peg3 "(12345)") "peg thru 1")
|
||||
(assert (not (peg/match peg3 " (12345)")) "peg thru 2")
|
||||
(assert (not (peg/match peg3 "(12345")) "peg thru 3")
|
||||
|
||||
(assert (= "abc" (0 (peg/match peg4 "123(abc)"))) "peg thru/to 1")
|
||||
(assert (= "abc" (0 (peg/match peg4 "(abc)"))) "peg thru/to 2")
|
||||
(assert (not (peg/match peg4 "123(abc")) "peg thru/to 3")
|
||||
|
||||
# 86e12369b
|
||||
(def peg5 (peg/compile [3 "abc"]))
|
||||
|
||||
(assert (:match peg5 "abcabcabc") "repeat alias 1")
|
||||
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
|
||||
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
|
||||
|
||||
# Peg find and find-all
|
||||
# c26f57362
|
||||
(def p "/usr/local/bin/janet")
|
||||
(assert (= (peg/find '"n/" p) 13) "peg find 1")
|
||||
(assert (not (peg/find '"t/" p)) "peg find 2")
|
||||
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
|
||||
|
||||
# Peg replace and replace-all
|
||||
# e548e1f6e
|
||||
(defn check-replacer
|
||||
[x y z]
|
||||
(assert (= (string/replace x y z) (string (peg/replace x y z)))
|
||||
"replacer test replace")
|
||||
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z)))
|
||||
"replacer test replace-all"))
|
||||
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
|
||||
(check-replacer "abc" "Z" "")
|
||||
(check-replacer "aba" "ZZZZZZ" "ababababababa")
|
||||
(check-replacer "aba" "" "ababababababa")
|
||||
|
||||
# 485099fd6
|
||||
(check-replacer "aba" string/ascii-upper "ababababababa")
|
||||
(check-replacer "aba" 123 "ababababababa")
|
||||
(assert (= (string (peg/replace-all ~(set "ab") string/ascii-upper "abcaa"))
|
||||
"ABcAA")
|
||||
"peg/replace-all cfunction")
|
||||
(assert (= (string (peg/replace-all ~(set "ab") |$ "abcaa"))
|
||||
"abcaa")
|
||||
"peg/replace-all function")
|
||||
|
||||
# 9dc7e8ed3
|
||||
(defn peg-test [name f peg subst text expected]
|
||||
(assert (= (string (f peg subst text)) expected) name))
|
||||
|
||||
(peg-test "peg/replace has access to captures"
|
||||
peg/replace
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b.c")
|
||||
|
||||
(peg-test "peg/replace-all has access to captures"
|
||||
peg/replace-all
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b -> B, .c")
|
||||
|
||||
# Peg bug
|
||||
# eab5f67c5
|
||||
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
|
||||
(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
|
||||
(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
|
||||
(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
|
||||
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test"))
|
||||
"peg empty pattern 5")
|
||||
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test")))
|
||||
"peg empty pattern 6")
|
||||
|
||||
# number pattern
|
||||
# cccbdc164
|
||||
(assert (deep= @[111] (peg/match '(number :d+) "111"))
|
||||
"simple number capture 1")
|
||||
(assert (deep= @[255] (peg/match '(number :w+) "0xff"))
|
||||
"simple number capture 2")
|
||||
|
||||
# Marshal and unmarshal pegs
|
||||
# 446ab037b
|
||||
(def p (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p "abcd") "peg marshal 1")
|
||||
(assert (peg/match p "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
|
||||
|
||||
# to/thru bug
|
||||
# issue #971 - a895219d2
|
||||
(def pattern
|
||||
(peg/compile
|
||||
'{:dd (sequence :d :d)
|
||||
:sep (set "/-")
|
||||
:date (sequence :dd :sep :dd)
|
||||
:wsep (some (set " \t"))
|
||||
:entry (group (sequence (capture :date) :wsep (capture :date)))
|
||||
:main (some (thru :entry))}))
|
||||
|
||||
(def alt-pattern
|
||||
(peg/compile
|
||||
'{:dd (sequence :d :d)
|
||||
:sep (set "/-")
|
||||
:date (sequence :dd :sep :dd)
|
||||
:wsep (some (set " \t"))
|
||||
:entry (group (sequence (capture :date) :wsep (capture :date)))
|
||||
:main (some (choice :entry 1))}))
|
||||
|
||||
(def text "1800-10-818-9-818 16/12\n17/12 19/12\n20/12 11/01")
|
||||
(assert (deep= (peg/match pattern text) (peg/match alt-pattern text))
|
||||
"to/thru bug #971")
|
||||
|
||||
# 14657a7
|
||||
(def- sym-prefix-peg
|
||||
(peg/compile
|
||||
~{:symchar (+ (range "\x80\xff" "AZ" "az" "09")
|
||||
(set "!$%&*+-./:<?=>@^_"))
|
||||
:anchor (drop (cmt ($) ,|(= $ 0)))
|
||||
:cap (* (+ (> -1 (not :symchar)) :anchor) (* ($) '(some :symchar)))
|
||||
:recur (+ :cap (> -1 :recur))
|
||||
:main (> -1 :recur)}))
|
||||
|
||||
(assert (deep= (peg/match sym-prefix-peg @"123" 3) @[0 "123"])
|
||||
"peg lookback")
|
||||
(assert (deep= (peg/match sym-prefix-peg @"1234" 4) @[0 "1234"])
|
||||
"peg lookback 2")
|
||||
|
||||
# issue #1027 - 356b39c6f
|
||||
(assert (deep= (peg/replace-all '(* (<- 1) 1 (backmatch))
|
||||
"xxx" "aba cdc efa")
|
||||
@"xxx xxx efa")
|
||||
"peg replace-all 1")
|
||||
|
||||
# issue #1026 - 9341081a4
|
||||
(assert (deep=
|
||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||
@[]) "peg not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||
@[]) "peg if-not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if-not drop")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(defn test [name peg input expected]
|
||||
(assert (deep= (peg/match peg input) expected) name))
|
||||
|
||||
(test "sub: matches the same input twice"
|
||||
~(sub "abcd" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: second pattern cannot match more than the first pattern"
|
||||
~(sub "abcd" "abcde")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if first pattern fails"
|
||||
~(sub "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if second pattern fails"
|
||||
~(sub "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: keeps captures from both patterns"
|
||||
~(sub '"abcd" '"abc")
|
||||
"abcdef"
|
||||
@["abcd" "abc"])
|
||||
|
||||
(test "sub: second pattern can reference captures from first"
|
||||
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
||||
"abcdef"
|
||||
@[5 "abc" "abc"])
|
||||
|
||||
(test "sub: second pattern can't see past what the first pattern matches"
|
||||
~(sub "abc" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: positions inside second match are still relative to the entire input"
|
||||
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
|
||||
(test "sub: advances to the end of the first pattern's match"
|
||||
~(* (sub "abc" "ab") "d")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "split: basic functionality"
|
||||
~(split "," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: drops captures from separator pattern"
|
||||
~(split '"," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: can match empty subpatterns"
|
||||
~(split "," ':w*)
|
||||
",a,,bar,,,c,,"
|
||||
@["" "a" "" "bar" "" "" "c" "" ""])
|
||||
|
||||
(test "split: subpattern is limited to only text before the separator"
|
||||
~(split "," '(to -1))
|
||||
"a,,bar,c"
|
||||
@["a" "" "bar" "c"])
|
||||
|
||||
(test "split: fails if any subpattern fails"
|
||||
~(split "," '"a")
|
||||
"a,a,b"
|
||||
nil)
|
||||
|
||||
(test "split: separator does not have to match anything"
|
||||
~(split "x" '(to -1))
|
||||
"a,a,b"
|
||||
@["a,a,b"])
|
||||
|
||||
(test "split: always consumes entire input"
|
||||
~(split 1 '"")
|
||||
"abc"
|
||||
@["" "" "" ""])
|
||||
|
||||
(test "split: separator can be an arbitrary PEG"
|
||||
~(split :s+ '(to -1))
|
||||
"a b c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: does not advance past the end of the input"
|
||||
~(* (split "," ':w+) 0)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(end-suite)
|
||||
|
||||
65
test/suite-pp.janet
Normal file
65
test/suite-pp.janet
Normal file
@@ -0,0 +1,65 @@
|
||||
# Copyright (c) 2023 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)
|
||||
|
||||
# Appending buffer to self
|
||||
# 6b76ac3d1
|
||||
(with-dyns [:out @""]
|
||||
(prin "abcd")
|
||||
(prin (dyn :out))
|
||||
(prin (dyn :out))
|
||||
(assert (deep= (dyn :out) @"abcdabcdabcdabcd") "print buffer to self"))
|
||||
|
||||
# Buffer self blitting, check for use after free
|
||||
# bbcfaf128
|
||||
(def buf1 @"1234567890")
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(assert (= (string buf1) (string/repeat "1234567890" 16))
|
||||
"buffer blit against self")
|
||||
|
||||
# Check for bugs with printing self with buffer/format
|
||||
# bbcfaf128
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp))
|
||||
`abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
|
||||
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# 5c364e0
|
||||
(defn check-jdn [x]
|
||||
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
|
||||
|
||||
(check-jdn 0)
|
||||
(check-jdn nil)
|
||||
(check-jdn [])
|
||||
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
|
||||
(check-jdn -0.123123123123)
|
||||
(check-jdn 12837192371923)
|
||||
(check-jdn "a string")
|
||||
(check-jdn @"a buffer")
|
||||
|
||||
(end-suite)
|
||||
|
||||
206
test/suite-specials.janet
Normal file
206
test/suite-specials.janet
Normal file
@@ -0,0 +1,206 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Regression Test #137
|
||||
# affcb5b45
|
||||
(def [a b c] (range 10))
|
||||
(assert (= a 0) "regression #137 (1)")
|
||||
(assert (= b 1) "regression #137 (2)")
|
||||
(assert (= c 2) "regression #137 (3)")
|
||||
|
||||
(var [x y z] (range 10))
|
||||
(assert (= x 0) "regression #137 (4)")
|
||||
(assert (= y 1) "regression #137 (5)")
|
||||
(assert (= z 2) "regression #137 (6)")
|
||||
|
||||
# Test destructuring
|
||||
# 23dcfb986
|
||||
(do
|
||||
(def test-tab @{:a 1 :b 2})
|
||||
(def {:a a :b b} test-tab)
|
||||
(assert (= a 1) "dictionary destructuring 1")
|
||||
(assert (= b 2) "dictionary destructuring 2"))
|
||||
(do
|
||||
(def test-tab @{'a 1 'b 2 3 4})
|
||||
(def {'a a 'b b (+ 1 2) c} test-tab)
|
||||
(assert (= a 1) "dictionary destructuring 3")
|
||||
(assert (= b 2) "dictionary destructuring 4")
|
||||
(assert (= c 4) "dictionary destructuring 5 - expression as key"))
|
||||
|
||||
# cb5af974a
|
||||
(let [test-tuple [:a :b 1 2]]
|
||||
(def [a b one two] test-tuple)
|
||||
(assert (= a :a) "tuple destructuring 1")
|
||||
(assert (= b :b) "tuple destructuring 2")
|
||||
(assert (= two 2) "tuple destructuring 3"))
|
||||
(let [test-tuple [:a :b 1 2]]
|
||||
(def [a & rest] test-tuple)
|
||||
(assert (= a :a) "tuple destructuring 4 - rest")
|
||||
(assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
|
||||
(do
|
||||
(def [a b & rest] [:a :b nil :d])
|
||||
(assert (= a :a) "tuple destructuring 6 - rest")
|
||||
(assert (= b :b) "tuple destructuring 7 - rest")
|
||||
(assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
|
||||
|
||||
# 71cffc973
|
||||
(do
|
||||
(def [[a b] x & rest] [[1 2] :a :c :b :a])
|
||||
(assert (= a 1) "tuple destructuring 9 - rest")
|
||||
(assert (= b 2) "tuple destructuring 10 - rest")
|
||||
(assert (= x :a) "tuple destructuring 11 - rest")
|
||||
(assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
|
||||
|
||||
# 651e12cfe
|
||||
(do
|
||||
(def [a b & rest] [:a :b])
|
||||
(assert (= a :a) "tuple destructuring 13 - rest")
|
||||
(assert (= b :b) "tuple destructuring 14 - rest")
|
||||
(assert (= rest []) "tuple destructuring 15 - rest"))
|
||||
|
||||
(do
|
||||
(def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
|
||||
(assert (= a :a) "tuple destructuring 16 - rest")
|
||||
(assert (= b :b) "tuple destructuring 17 - rest")
|
||||
(assert (= c :c) "tuple destructuring 18 - rest")
|
||||
(assert (= r1 [1 2]) "tuple destructuring 19 - rest")
|
||||
(assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
|
||||
|
||||
# Metadata
|
||||
# ec2d7bf34
|
||||
(def foo-with-tags :a-tag :bar)
|
||||
(assert (get (dyn 'foo-with-tags) :a-tag)
|
||||
"extra keywords in def are metadata tags")
|
||||
|
||||
(def foo-with-meta {:baz :quux} :bar)
|
||||
(assert (= :quux (get (dyn 'foo-with-meta) :baz))
|
||||
"extra struct in def is metadata")
|
||||
|
||||
(defn foo-fn-with-meta {:baz :quux}
|
||||
"This is a function"
|
||||
[x]
|
||||
(identity x))
|
||||
(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz))
|
||||
"extra struct in defn is metadata")
|
||||
(assert (= "(foo-fn-with-meta x)\n\nThis is a function"
|
||||
(get (dyn 'foo-fn-with-meta) :doc))
|
||||
"extra string in defn is docstring")
|
||||
|
||||
# Break
|
||||
# 4a111b38b
|
||||
(var summation 0)
|
||||
(for i 0 10
|
||||
(+= summation i)
|
||||
(if (= i 7) (break)))
|
||||
(assert (= summation 28) "break 1")
|
||||
|
||||
(assert (= nil ((fn [] (break) 4))) "break 2")
|
||||
|
||||
# Break with value
|
||||
# 8ba112116
|
||||
# Shouldn't error out
|
||||
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
||||
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
||||
|
||||
# No useless splices
|
||||
# 7d57f8700
|
||||
(check-compile-error '((splice [1 2 3]) 0))
|
||||
(check-compile-error '(if ;[1 2] 5))
|
||||
(check-compile-error '(while ;[1 2 3] (print :hi)))
|
||||
(check-compile-error '(def x ;[1 2 3]))
|
||||
(check-compile-error '(fn [x] ;[x 1 2 3]))
|
||||
|
||||
# No splice propagation
|
||||
(check-compile-error '(+ 1 (do ;[2 3 4]) 5))
|
||||
(check-compile-error '(+ 1 (upscope ;[2 3 4]) 5))
|
||||
# compiler inlines when condition is constant, ensure that optimization
|
||||
# doesn't break
|
||||
(check-compile-error '(+ 1 (if true ;[3 4])))
|
||||
(check-compile-error '(+ 1 (if false nil ;[3 4])))
|
||||
|
||||
# Keyword arguments
|
||||
# 3f137ed0b
|
||||
(defn myfn [x y z &keys {:a a :b b :c c}]
|
||||
(+ x y z a b c))
|
||||
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 3 :b 4 :c 5)) "keyword args 1")
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 1 :b 6 :c 5 :d 11))
|
||||
"keyword args 2")
|
||||
|
||||
# Named arguments
|
||||
# 87fc339
|
||||
(defn named-arguments
|
||||
[&named bob sally joe]
|
||||
(+ bob sally joe))
|
||||
|
||||
(assert (= 15 (named-arguments :bob 3 :sally 5 :joe 7)) "named arguments 1")
|
||||
|
||||
# a117252
|
||||
(defn named-opt-arguments
|
||||
[&opt x &named a b c]
|
||||
(+ x a b c))
|
||||
|
||||
(assert (= 10 (named-opt-arguments 1 :a 2 :b 3 :c 4)) "named arguments 2")
|
||||
|
||||
#
|
||||
# fn compilation special
|
||||
#
|
||||
# b8032ec61
|
||||
(defn myfn1 [[x y z] & more]
|
||||
more)
|
||||
(defn myfn2 [head & more]
|
||||
more)
|
||||
(assert (= (myfn1 [1 2 3] 4 5 6) (myfn2 [:a :b :c] 4 5 6))
|
||||
"destructuring and varargs")
|
||||
|
||||
# Nested quasiquotation
|
||||
# 4199c42fe
|
||||
(def nested ~(a ~(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f))
|
||||
(assert (deep= nested '(a ~(b ,(+ 1 2) ,(foo 4 d) e) f))
|
||||
"nested quasiquote")
|
||||
|
||||
# Regression #400
|
||||
# 7a84fc474
|
||||
(assert (= nil (while (and false false)
|
||||
(fn [])
|
||||
(error "should not happen"))) "strangeloop 1")
|
||||
(assert (= nil (while (not= nil nil)
|
||||
(fn [])
|
||||
(error "should not happen"))) "strangeloop 2")
|
||||
|
||||
# 919
|
||||
# a097537a0
|
||||
(defn test
|
||||
[]
|
||||
(var x 1)
|
||||
(set x ~(,x ()))
|
||||
x)
|
||||
|
||||
(assert (= (test) '(1 ())) "issue #919")
|
||||
|
||||
# Regression #1327
|
||||
(def x "A")
|
||||
(def x (if (= nil x) "B" x))
|
||||
(assert (= x "A"))
|
||||
|
||||
(end-suite)
|
||||
@@ -19,48 +19,20 @@
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 2)
|
||||
(start-suite)
|
||||
|
||||
# Buffer stuff
|
||||
(defn buffer=
|
||||
[a b]
|
||||
(= (string a) (string b)))
|
||||
# 8a346ec
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree")
|
||||
"string/join 1 argument")
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three")
|
||||
"string/join 2 arguments")
|
||||
(assert (= (string/join @[] ", ") "") "string/join empty array")
|
||||
|
||||
(assert (buffer= @"abcd" @"abcd") "buffer equal 1")
|
||||
(assert (buffer= @"abcd" (buffer "ab" "cd")) "buffer equal 2")
|
||||
(assert (not= @"" @"") "buffer not equal 1")
|
||||
(assert (not= @"abcd" @"abcd") "buffer not equal 2")
|
||||
|
||||
(defn buffer-factory
|
||||
[]
|
||||
@"im am a buffer")
|
||||
|
||||
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
||||
|
||||
(assert (= (length @"abcdef") 6) "buffer length")
|
||||
|
||||
# Looping idea
|
||||
(def xs
|
||||
(seq [x :in [-1 0 1] y :in [-1 0 1] :when (not= x y 0)] (tuple x y)))
|
||||
(def txs (apply tuple xs))
|
||||
|
||||
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]]) "nested seq")
|
||||
|
||||
# Generators
|
||||
(def gen (generate [x :range [0 100] :when (pos? (% x 4))] x))
|
||||
(var gencount 0)
|
||||
(loop [x :in gen]
|
||||
(++ gencount)
|
||||
(assert (pos? (% x 4)) "generate in loop"))
|
||||
(assert (= gencount 75) "generate loop count")
|
||||
|
||||
# Check x:digits: works as symbol and not a hex number
|
||||
(def x1 100)
|
||||
(assert (= x1 100) "x1 as symbol")
|
||||
(def X1 100)
|
||||
(assert (= X1 100) "X1 as symbol")
|
||||
(assert (= (string/find "123" "abc123def") 3) "string/find positive")
|
||||
(assert (= (string/find "1234" "abc123def") nil) "string/find negative")
|
||||
|
||||
# String functions
|
||||
# f41dab8f6
|
||||
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
||||
(assert (= 0 (string/find "A" "A")) "string/find 2")
|
||||
(assert (string/has-prefix? "" "foo") "string/has-prefix? 1")
|
||||
@@ -69,52 +41,100 @@
|
||||
(assert (string/has-suffix? "" "foo") "string/has-suffix? 1")
|
||||
(assert (string/has-suffix? "oo" "foo") "string/has-suffix? 2")
|
||||
(assert (not (string/has-suffix? "f" "foo")) "string/has-suffix? 3")
|
||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
||||
(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyxxxy") "string/replace function")
|
||||
(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy") "XXyxyxyXXxy") "string/replace-all function")
|
||||
(assert (= (string/replace "x" 12 "xyx") "12yx") "string/replace stringable")
|
||||
(assert (= (string/replace-all "x" 12 "xyx") "12y12") "string/replace-all stringable")
|
||||
(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.") "string/ascii-lower")
|
||||
(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.") "string/ascii-lower")
|
||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX")
|
||||
"string/replace 1")
|
||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............")
|
||||
"string/replace-all 1")
|
||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X")
|
||||
"string/replace-all 2")
|
||||
(assert (= (string/replace "xx" string/ascii-upper "xxyxyxyxxxy")
|
||||
"XXyxyxyxxxy") "string/replace function")
|
||||
(assert (= (string/replace-all "xx" string/ascii-upper "xxyxyxyxxxy")
|
||||
"XXyxyxyXXxy") "string/replace-all function")
|
||||
(assert (= (string/replace "x" 12 "xyx") "12yx")
|
||||
"string/replace stringable")
|
||||
(assert (= (string/replace-all "x" 12 "xyx") "12y12")
|
||||
"string/replace-all stringable")
|
||||
(assert (= (string/ascii-lower "ABCabc&^%!@:;.") "abcabc&^%!@:;.")
|
||||
"string/ascii-lower")
|
||||
(assert (= (string/ascii-upper "ABCabc&^%!@:;.") "ABCABC&^%!@:;.")
|
||||
"string/ascii-lower")
|
||||
(assert (= (string/reverse "") "") "string/reverse 1")
|
||||
(assert (= (string/reverse "a") "a") "string/reverse 2")
|
||||
(assert (= (string/reverse "abc") "cba") "string/reverse 3")
|
||||
(assert (= (string/reverse "abcd") "dcba") "string/reverse 4")
|
||||
(assert (= (string/join @["one" "two" "three"] ",") "one,two,three") "string/join 1")
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
|
||||
(assert (= (string/join @["one" "two" "three"] ",") "one,two,three")
|
||||
"string/join 1")
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three")
|
||||
"string/join 2")
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree")
|
||||
"string/join 3")
|
||||
(assert (= (string/join @[] "hi") "") "string/join 4")
|
||||
(assert (= (string/trim " abcd ") "abcd") "string/trim 1")
|
||||
(assert (= (string/trim "abcd \t\t\r\f") "abcd") "string/trim 2")
|
||||
(assert (= (string/trim "\n\n\t abcd") "abcd") "string/trim 3")
|
||||
(assert (= (string/trim "") "") "string/trim 4")
|
||||
(assert (= (string/triml " abcd ") "abcd ") "string/triml 1")
|
||||
(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f") "string/triml 2")
|
||||
(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f")
|
||||
"string/triml 2")
|
||||
(assert (= (string/triml "abcd ") "abcd ") "string/triml 3")
|
||||
(assert (= (string/trimr " abcd ") " abcd") "string/trimr 1")
|
||||
(assert (= (string/trimr "\tabcd \t\t\r\f") "\tabcd") "string/trimr 2")
|
||||
(assert (= (string/trimr " abcd") " abcd") "string/trimr 3")
|
||||
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
|
||||
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
|
||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||
(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
|
||||
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"])
|
||||
"string/split 1")
|
||||
(assert (deep= (string/split "," "onetwothree") @["onetwothree"])
|
||||
"string/split 2")
|
||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10])
|
||||
"string/find-all 1")
|
||||
(assert (deep= (string/find-all "," "onetwothree") @[])
|
||||
"string/find-all 2")
|
||||
|
||||
# b26a7bb22
|
||||
(assert-error "string/find error 1" (string/find "" "abcd"))
|
||||
(assert-error "string/split error 1" (string/split "" "abcd"))
|
||||
(assert-error "string/replace error 1" (string/replace "" "." "abcd"))
|
||||
(assert-error "string/replace-all error 1" (string/replace-all "" "." "abcdabcd"))
|
||||
(assert-error "string/replace-all error 1"
|
||||
(string/replace-all "" "." "abcdabcd"))
|
||||
(assert-error "string/find-all error 1" (string/find-all "" "abcd"))
|
||||
|
||||
# Check if abstract test works
|
||||
(assert (abstract? stdout) "abstract? stdout")
|
||||
(assert (abstract? stdin) "abstract? stdin")
|
||||
(assert (abstract? stderr) "abstract? stderr")
|
||||
(assert (not (abstract? nil)) "not abstract? nil")
|
||||
(assert (not (abstract? 1)) "not abstract? 1")
|
||||
(assert (not (abstract? 3)) "not abstract? 3")
|
||||
(assert (not (abstract? 5)) "not abstract? 5")
|
||||
# String bugs
|
||||
# bcba0c027
|
||||
(assert (deep= (string/find-all "qq" "qqq") @[0 1]) "string/find-all 1")
|
||||
(assert (deep= (string/find-all "q" "qqq") @[0 1 2]) "string/find-all 2")
|
||||
(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
|
||||
(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
|
||||
|
||||
# some tests for string/format
|
||||
# 0f0c415
|
||||
(assert (= (string/format "pi = %6.3f" math/pi) "pi = 3.142") "%6.3f")
|
||||
(assert (= (string/format "pi = %+6.3f" math/pi) "pi = +3.142") "%6.3f")
|
||||
(assert (= (string/format "pi = %40.20g" math/pi)
|
||||
"pi = 3.141592653589793116") "%6.3f")
|
||||
|
||||
(assert (= (string/format "🐼 = %6.3f" math/pi) "🐼 = 3.142") "UTF-8")
|
||||
(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
|
||||
(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927")
|
||||
"\xCF\x80")
|
||||
|
||||
# String check-set
|
||||
# b4e25e559
|
||||
(assert (string/check-set "abc" "a") "string/check-set 1")
|
||||
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
|
||||
(assert (string/check-set "abc" "abc") "string/check-set 3")
|
||||
(assert (string/check-set "abc" "") "string/check-set 4")
|
||||
(assert (not (string/check-set "" "aabc")) "string/check-set 5")
|
||||
(assert (not (string/check-set "abc" "abcdefg")) "string/check-set 6")
|
||||
|
||||
# Trim empty string
|
||||
# issue #174 - 9b605b27b
|
||||
(assert (= "" (string/trim " ")) "string/trim regression")
|
||||
|
||||
# Keyword and Symbol slice
|
||||
# e9911fee4
|
||||
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12))
|
||||
"keyword slice")
|
||||
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
|
||||
|
||||
(end-suite)
|
||||
|
||||
39
test/suite-strtod.janet
Normal file
39
test/suite-strtod.janet
Normal file
@@ -0,0 +1,39 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Scan number
|
||||
# 798c88b4c
|
||||
(assert (= 1 (scan-number "1")) "scan-number 1")
|
||||
(assert (= -1 (scan-number "-1")) "scan-number -1")
|
||||
(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
|
||||
|
||||
# Issue #183 - just parse it :)
|
||||
# 688d297a1
|
||||
1e-4000000000000000000000
|
||||
|
||||
# For undefined behavior sanitizer
|
||||
# c876e63
|
||||
0xf&1fffFFFF
|
||||
|
||||
(end-suite)
|
||||
|
||||
94
test/suite-struct.janet
Normal file
94
test/suite-struct.janet
Normal file
@@ -0,0 +1,94 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# 21bd960
|
||||
(assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2))
|
||||
"struct order does not matter 1")
|
||||
# 42a88de
|
||||
(assert (= (struct
|
||||
:apple 1
|
||||
6 :bork
|
||||
'(1 2 3) 5)
|
||||
(struct
|
||||
6 :bork
|
||||
'(1 2 3) 5
|
||||
:apple 1)) "struct order does not matter 2")
|
||||
|
||||
# Denormal structs
|
||||
# 38a7e4faf
|
||||
(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
|
||||
(assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
|
||||
|
||||
(assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
|
||||
(assert (= (length {1 2 (/ 0 0) 3}) 1) "nan key struct literal")
|
||||
|
||||
(assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
|
||||
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||
|
||||
# Struct duplicate elements
|
||||
# 8bc2987a7
|
||||
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
|
||||
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3))
|
||||
"struct constructor duplicate keys")
|
||||
|
||||
# Struct prototypes
|
||||
# 4d983e5
|
||||
(def x (struct/with-proto {1 2 3 4} 5 6))
|
||||
(def y (-> x marshal unmarshal))
|
||||
(def z {1 2 3 4})
|
||||
(assert (= 2 (get x 1)) "struct get proto value 1")
|
||||
(assert (= 4 (get x 3)) "struct get proto value 2")
|
||||
(assert (= 6 (get x 5)) "struct get proto value 3")
|
||||
(assert (= x y) "struct proto marshal equality 1")
|
||||
(assert (= (getproto x) (getproto y)) "struct proto marshal equality 2")
|
||||
(assert (= 0 (cmp x y)) "struct proto comparison 1")
|
||||
(assert (= 0 (cmp (getproto x) (getproto y))) "struct proto comparison 2")
|
||||
(assert (not= (cmp x z) 0) "struct proto comparison 3")
|
||||
(assert (not= (cmp y z) 0) "struct proto comparison 4")
|
||||
(assert (not= x z) "struct proto comparison 5")
|
||||
(assert (not= y z) "struct proto comparison 6")
|
||||
(assert (= (x 5) 6) "struct proto get 1")
|
||||
(assert (= (y 5) 6) "struct proto get 1")
|
||||
(assert (deep= x y) "struct proto deep= 1")
|
||||
(assert (deep-not= x z) "struct proto deep= 2")
|
||||
(assert (deep-not= y z) "struct proto deep= 3")
|
||||
|
||||
# Check missing struct proto bug
|
||||
# 868ec1a7e, e08394c8
|
||||
(assert (struct/getproto (struct/with-proto {:a 1} :b 2 :c nil))
|
||||
"missing struct proto")
|
||||
|
||||
# struct/with-proto
|
||||
(assert-error "expected odd number of arguments" (struct/with-proto {} :a))
|
||||
|
||||
# struct/to-table
|
||||
(def s (struct/with-proto {:a 1 :b 2} :name "john" ))
|
||||
(def t1 (struct/to-table s true))
|
||||
(def t2 (struct/to-table s false))
|
||||
(assert (deep= t1 @{:name "john"}) "struct/to-table 1")
|
||||
(assert (deep= t2 @{:name "john"}) "struct/to-table 2")
|
||||
(assert (deep= (getproto t1) @{:a 1 :b 2}) "struct/to-table 3")
|
||||
(assert (deep= (getproto t2) nil) "struct/to-table 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
42
test/suite-symcache.janet
Normal file
42
test/suite-symcache.janet
Normal file
@@ -0,0 +1,42 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Symbol function
|
||||
# 5460ff1
|
||||
(assert (= (symbol "abc" 1 2 3) 'abc123) "symbol function")
|
||||
|
||||
# Gensym tests
|
||||
# 3ccd68843
|
||||
(assert (not= (gensym) (gensym)) "two gensyms not equal")
|
||||
((fn []
|
||||
(def syms (table))
|
||||
(var counter 0)
|
||||
(while (< counter 128)
|
||||
(put syms (gensym) true)
|
||||
(set counter (+ 1 counter)))
|
||||
(assert (= (length syms) 128) "many symbols")))
|
||||
|
||||
# issue #753 - a78cbd91d
|
||||
(assert (pos? (length (gensym))) "gensym not empty, regression #753")
|
||||
|
||||
(end-suite)
|
||||
72
test/suite-table.janet
Normal file
72
test/suite-table.janet
Normal file
@@ -0,0 +1,72 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Denormal tables
|
||||
# 38a7e4faf
|
||||
(assert (= (length @{1 2 nil 3}) 1) "nil key table literal")
|
||||
(assert (= (length (table 1 2 nil 3)) 1) "nil key table ctor")
|
||||
|
||||
(assert (= (length (table (/ 0 0) 2 1 3)) 1) "nan key table ctor")
|
||||
(assert (= (length @{1 2 (/ 0 0) 3}) 1) "nan key table literal")
|
||||
|
||||
(assert (= (length (table 2 1 3 nil)) 1) "nil value table ctor")
|
||||
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||
|
||||
# Table duplicate elements
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3))
|
||||
"table constructor duplicate keys")
|
||||
|
||||
## Table prototypes
|
||||
# 027b2a81c
|
||||
(def roottab @{
|
||||
:parentprop 123
|
||||
})
|
||||
|
||||
(def childtab @{
|
||||
:childprop 456
|
||||
})
|
||||
|
||||
(table/setproto childtab roottab)
|
||||
|
||||
(assert (= 123 (get roottab :parentprop)) "table get 1")
|
||||
(assert (= 123 (get childtab :parentprop)) "table get proto")
|
||||
(assert (= nil (get roottab :childprop)) "table get 2")
|
||||
(assert (= 456 (get childtab :childprop)) "proto no effect")
|
||||
|
||||
# b3aed1356
|
||||
(assert-error
|
||||
"table rawget regression"
|
||||
(table/new -1))
|
||||
|
||||
# table/clone
|
||||
# 392813667
|
||||
(defn check-table-clone [x msg]
|
||||
(assert (= (table/to-struct x) (table/to-struct (table/clone x))) msg))
|
||||
|
||||
(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5}
|
||||
"table/clone 1")
|
||||
(check-table-clone @{} "table/clone 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
299
test/suite-unknown.janet
Normal file
299
test/suite-unknown.janet
Normal file
@@ -0,0 +1,299 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# Set global variables to prevent some possible compiler optimizations
|
||||
# that defeat point of the test
|
||||
# 2771171
|
||||
(var zero 0)
|
||||
(var one 1)
|
||||
(var two 2)
|
||||
(var three 3)
|
||||
(var plus +)
|
||||
(assert (= 22 (plus one (plus 1 2 two) (plus 8 (plus zero 1) 4 three)))
|
||||
"nested function calls")
|
||||
|
||||
# McCarthy's 91 function
|
||||
# 2771171
|
||||
(var f91 nil)
|
||||
(set f91 (fn [n]
|
||||
(if (> n 100)
|
||||
(- n 10)
|
||||
(f91 (f91 (+ n 11))))))
|
||||
(assert (= 91 (f91 10)) "f91(10) = 91")
|
||||
(assert (= 91 (f91 11)) "f91(11) = 91")
|
||||
(assert (= 91 (f91 20)) "f91(20) = 91")
|
||||
(assert (= 91 (f91 31)) "f91(31) = 91")
|
||||
(assert (= 91 (f91 100)) "f91(100) = 91")
|
||||
(assert (= 91 (f91 101)) "f91(101) = 91")
|
||||
(assert (= 92 (f91 102)) "f91(102) = 92")
|
||||
(assert (= 93 (f91 103)) "f91(103) = 93")
|
||||
(assert (= 94 (f91 104)) "f91(104) = 94")
|
||||
|
||||
# Fibonacci
|
||||
# 23196ff
|
||||
(def fib
|
||||
(do
|
||||
(var fib nil)
|
||||
(set fib (fn [n]
|
||||
(if (< n 2)
|
||||
n
|
||||
(+ (fib (- n 1)) (fib (- n 2))))))))
|
||||
(def fib2
|
||||
(fn fib2 [n]
|
||||
(if (< n 2)
|
||||
n
|
||||
(+ (fib2 (- n 1)) (fib2 (- n 2))))))
|
||||
|
||||
(assert (= (fib 0) (fib2 0) 0) "fib(0)")
|
||||
(assert (= (fib 1) (fib2 1) 1) "fib(1)")
|
||||
(assert (= (fib 2) (fib2 2) 1) "fib(2)")
|
||||
(assert (= (fib 3) (fib2 3) 2) "fib(3)")
|
||||
(assert (= (fib 4) (fib2 4) 3) "fib(4)")
|
||||
(assert (= (fib 5) (fib2 5) 5) "fib(5)")
|
||||
(assert (= (fib 6) (fib2 6) 8) "fib(6)")
|
||||
(assert (= (fib 7) (fib2 7) 13) "fib(7)")
|
||||
(assert (= (fib 8) (fib2 8) 21) "fib(8)")
|
||||
(assert (= (fib 9) (fib2 9) 34) "fib(9)")
|
||||
(assert (= (fib 10) (fib2 10) 55) "fib(10)")
|
||||
|
||||
# Closure in non function scope
|
||||
# 911b0b1
|
||||
(def outerfun (fn [x y]
|
||||
(def c (do
|
||||
(def someval (+ 10 y))
|
||||
(def ctemp (if x (fn [] someval) (fn [] y)))
|
||||
ctemp
|
||||
))
|
||||
(+ 1 2 3 4 5 6 7)
|
||||
c))
|
||||
|
||||
(assert (= ((outerfun 1 2)) 12) "inner closure 1")
|
||||
(assert (= ((outerfun nil 2)) 2) "inner closure 2")
|
||||
(assert (= ((outerfun false 3)) 3) "inner closure 3")
|
||||
|
||||
# d6967a5
|
||||
((fn []
|
||||
(var accum 1)
|
||||
(var counter 0)
|
||||
(while (< counter 16)
|
||||
(set accum (blshift accum 1))
|
||||
(set counter (+ 1 counter)))
|
||||
(assert (= accum 65536) "loop in closure")))
|
||||
|
||||
(var accum 1)
|
||||
(var counter 0)
|
||||
(while (< counter 16)
|
||||
(set accum (blshift accum 1))
|
||||
(set counter (+ 1 counter)))
|
||||
(assert (= accum 65536) "loop globally")
|
||||
|
||||
# Fiber tests
|
||||
# 21bd960
|
||||
(def afiber (fiber/new (fn []
|
||||
(def x (yield))
|
||||
(error (string "hello, " x))) :ye))
|
||||
|
||||
(resume afiber) # first resume to prime
|
||||
(def afiber-result (resume afiber "world!"))
|
||||
|
||||
(assert (= afiber-result "hello, world!") "fiber error result")
|
||||
(assert (= (fiber/status afiber) :error) "fiber error status")
|
||||
|
||||
# Var arg tests
|
||||
# f054586
|
||||
(def vargf (fn [more] (apply + more)))
|
||||
|
||||
(assert (= 0 (vargf @[])) "var arg no arguments")
|
||||
(assert (= 1 (vargf @[1])) "var arg no packed arguments")
|
||||
(assert (= 3 (vargf @[1 2])) "var arg tuple size 1")
|
||||
(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args")
|
||||
(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10]))
|
||||
"var arg large tuple")
|
||||
|
||||
# Higher order functions
|
||||
# d9f24ef
|
||||
(def compose (fn [f g] (fn [& xs] (f (apply g xs)))))
|
||||
|
||||
(def -+ (compose - +))
|
||||
(def +- (compose + -))
|
||||
|
||||
(assert (= (-+ 1 2 3 4) -10) "compose - +")
|
||||
(assert (= (+- 1 2 3 4) -8) "compose + -")
|
||||
(assert (= ((compose -+ +-) 1 2 3 4) 8) "compose -+ +-")
|
||||
(assert (= ((compose +- -+) 1 2 3 4) 10) "compose +- -+")
|
||||
|
||||
# UTF-8
|
||||
# d9f24ef
|
||||
#🐙🐙🐙🐙
|
||||
|
||||
(defn foo [Θa Θb Θc] 0)
|
||||
(def 🦊 :fox)
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
(assert (= "\U01F637" "😷") "unicode escape 1")
|
||||
(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
|
||||
(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
|
||||
(assert (= "\u0061" "a") "unicode escape 4")
|
||||
|
||||
# Test max triangle program
|
||||
# c0e373f
|
||||
# Find the maximum path from the top (root)
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 [;xs 0]
|
||||
xs2 [0 ;xs]
|
||||
m1 (map + xs1 ys)
|
||||
m2 (map + xs2 ys)]
|
||||
(map max m1 m2)))
|
||||
|
||||
(defn maxpath [t]
|
||||
(extreme > (reduce myfold () t)))
|
||||
|
||||
# Test it
|
||||
# Maximum path is 3 -> 10 -> 3 -> 9 for a total of 25
|
||||
(def triangle '[
|
||||
[3]
|
||||
[7 10]
|
||||
[4 3 7]
|
||||
[8 9 1 3]
|
||||
])
|
||||
|
||||
(assert (= (maxpath triangle) 25) `max triangle`)
|
||||
|
||||
# Large functions
|
||||
# 6822400
|
||||
(def manydefs (seq [i :range [0 300]]
|
||||
(tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Closure in while loop
|
||||
# abe7d59
|
||||
(def closures (seq [i :range [0 5]] (fn [] i)))
|
||||
(assert (= 0 ((get closures 0))) "closure in loop 0")
|
||||
(assert (= 1 ((get closures 1))) "closure in loop 1")
|
||||
(assert (= 2 ((get closures 2))) "closure in loop 2")
|
||||
(assert (= 3 ((get closures 3))) "closure in loop 3")
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
# Another regression test - no segfaults
|
||||
# 6b4824c
|
||||
(defn afn [x] x)
|
||||
(var afn-var afn)
|
||||
(var identity-var identity)
|
||||
(var map-var map)
|
||||
(var not-var not)
|
||||
(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
|
||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||
(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
|
||||
|
||||
# Detaching closure over non resumable fiber
|
||||
# issue #317 - 7c4ffe9b9
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ [f1 f2]] (protect (f1 @[0])))
|
||||
# At time of writing, mark phase can detach closure envs.
|
||||
(gccollect)
|
||||
(assert (= 1 (f1)) "detach-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "detach-non-resumable-closure 2"))
|
||||
|
||||
# Dynamic defs
|
||||
# ec65f03
|
||||
(def staticdef1 0)
|
||||
(defn staticdef1-inc [] (+ 1 staticdef1))
|
||||
(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
|
||||
(def staticdef1 1)
|
||||
(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
|
||||
(setdyn :redef true)
|
||||
(def dynamicdef2 0)
|
||||
(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
|
||||
(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
|
||||
(def dynamicdef2 1)
|
||||
(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
|
||||
(setdyn :redef nil)
|
||||
|
||||
# missing symbols
|
||||
# issue #914 - 1eb34989d
|
||||
(defn lookup-symbol [sym] (defglobal sym 10) (dyn sym))
|
||||
|
||||
(setdyn :missing-symbol lookup-symbol)
|
||||
|
||||
(assert (= (eval-string "(+ a 5)") 15) "lookup missing symbol")
|
||||
|
||||
(setdyn :missing-symbol nil)
|
||||
(setdyn 'a nil)
|
||||
|
||||
(assert-error "compile error" (eval-string "(+ a 5)"))
|
||||
|
||||
# 88813c4
|
||||
(assert (deep= (in (disasm (defn a [] (def x 10) x)) :symbolmap)
|
||||
@[[0 2 0 'a] [0 2 1 'x]])
|
||||
"symbolmap when *debug* is true")
|
||||
|
||||
(defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))
|
||||
(def symbolslots (in (disasm a) :symbolslots))
|
||||
(def f (asm (disasm a)))
|
||||
(assert (deep= (in (disasm f) :symbolslots)
|
||||
symbolslots)
|
||||
"symbolslots survive disasm/asm")
|
||||
|
||||
(comment
|
||||
(setdyn *debug* true)
|
||||
(setdyn :pretty-format "%.40M")
|
||||
(def f (fn [x] (fn [y] (+ x y))))
|
||||
(assert (deep= (map last (in (disasm (f 10)) :symbolmap))
|
||||
@['x 'y])
|
||||
"symbolmap upvalues"))
|
||||
|
||||
(assert (deep= (in (disasm (defn a [arg]
|
||||
(def x 10)
|
||||
(do
|
||||
(def y 20)
|
||||
(def z 30)
|
||||
(+ x y z)))) :symbolmap)
|
||||
@[[0 6 0 'arg]
|
||||
[0 6 1 'a]
|
||||
[0 6 2 'x]
|
||||
[1 6 3 'y]
|
||||
[2 6 4 'z]])
|
||||
"arg & inner symbolmap")
|
||||
|
||||
# 4782a76
|
||||
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
|
||||
|
||||
(end-suite)
|
||||
|
||||
72
test/suite-value.janet
Normal file
72
test/suite-value.janet
Normal file
@@ -0,0 +1,72 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# 3e1e25854
|
||||
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
|
||||
(assert (= (get test-struct 'def) 1) "struct get")
|
||||
(assert (= (get test-struct 'bork) 2) "struct get")
|
||||
(assert (= (get test-struct 'sam) 3) "struct get")
|
||||
(assert (= (get test-struct 'a) 'b) "struct get")
|
||||
(assert (= :array (type (get test-struct 'het))) "struct get")
|
||||
|
||||
# Buffer stuff
|
||||
# 910cfd7dd
|
||||
(defn buffer=
|
||||
[a b]
|
||||
(= (string a) (string b)))
|
||||
|
||||
(assert (buffer= @"abcd" @"abcd") "buffer equal 1")
|
||||
(assert (buffer= @"abcd" (buffer "ab" "cd")) "buffer equal 2")
|
||||
(assert (not= @"" @"") "buffer not equal 1")
|
||||
(assert (not= @"abcd" @"abcd") "buffer not equal 2")
|
||||
|
||||
(defn buffer-factory
|
||||
[]
|
||||
@"im am a buffer")
|
||||
|
||||
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
||||
|
||||
(assert (= (length @"abcdef") 6) "buffer length")
|
||||
|
||||
# Tuple comparison
|
||||
# da438a93e
|
||||
(assert (< [1 2 3] [2 2 3]) "tuple comparison 1")
|
||||
(assert (< [1 2 3] [2 2]) "tuple comparison 2")
|
||||
(assert (< [1 2 3] [2 2 3 4]) "tuple comparison 3")
|
||||
(assert (< [1 2 3] [1 2 3 4]) "tuple comparison 4")
|
||||
(assert (< [1 2 3] [1 2 3 -1]) "tuple comparison 5")
|
||||
(assert (> [1 2 3] [1 2]) "tuple comparison 6")
|
||||
|
||||
# More numerical tests
|
||||
# e05022f
|
||||
(assert (= 1 1.0) "numerical equal 1")
|
||||
(assert (= 0 0.0) "numerical equal 2")
|
||||
(assert (= 0 -0.0) "numerical equal 3")
|
||||
(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
|
||||
(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
|
||||
|
||||
# issue #928 - d7ea122cf
|
||||
(assert (= (hash 0) (hash (* -1 0))) "hash -0 same as hash 0")
|
||||
|
||||
(end-suite)
|
||||
|
||||
142
test/suite-vm.janet
Normal file
142
test/suite-vm.janet
Normal file
@@ -0,0 +1,142 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite)
|
||||
|
||||
# More fiber semantics
|
||||
# 0fd9224e4
|
||||
(var myvar 0)
|
||||
(defn fiberstuff [&]
|
||||
(++ myvar)
|
||||
(def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
|
||||
(resume f)
|
||||
(++ myvar))
|
||||
|
||||
(def myfiber (fiber/new fiberstuff :dey))
|
||||
|
||||
(assert (= myvar 0) "fiber creation does not call fiber function")
|
||||
(resume myfiber)
|
||||
(assert (= myvar 2) "fiber debug statement breaks at proper point")
|
||||
(assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
|
||||
(resume myfiber)
|
||||
(assert (= myvar 4) "fiber resumes properly from debug state")
|
||||
(assert (= (fiber/status myfiber) :dead)
|
||||
"fiber properly dies from debug state")
|
||||
|
||||
# yield tests
|
||||
# 171c0ce
|
||||
(def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
|
||||
|
||||
(assert (= 1 (resume t)) "initial transfer to new fiber")
|
||||
(assert (= 2 (resume t)) "second transfer to fiber")
|
||||
(assert (= 3 (resume t)) "return from fiber")
|
||||
(assert (= (fiber/status t) :dead) "finished fiber is dead")
|
||||
|
||||
# Fix yields inside nested fibers
|
||||
# 909c906
|
||||
(def yielder
|
||||
(coro
|
||||
(defer (yield :end)
|
||||
(repeat 5 (yield :item)))))
|
||||
(def items (seq [x :in yielder] x))
|
||||
(assert (deep= @[:item :item :item :item :item :end] items)
|
||||
"yield within nested fibers")
|
||||
|
||||
# Calling non functions
|
||||
# b9c0fc820
|
||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad)))
|
||||
"calling table too many arguments")
|
||||
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad)))
|
||||
"calling keyword too many arguments")
|
||||
(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops)))
|
||||
"calling number fails")
|
||||
|
||||
# Method test
|
||||
# d5bab7262
|
||||
(def Dog @{:bark (fn bark [self what]
|
||||
(string (self :name) " says " what "!"))})
|
||||
(defn make-dog
|
||||
[name]
|
||||
(table/setproto @{:name name} Dog))
|
||||
|
||||
(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
|
||||
(def spot (make-dog "spot"))
|
||||
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
||||
|
||||
# Negative tests
|
||||
# 67f26b7d7
|
||||
(assert-error "+ check types" (+ 1 ()))
|
||||
(assert-error "- check types" (- 1 ()))
|
||||
(assert-error "* check types" (* 1 ()))
|
||||
(assert-error "/ check types" (/ 1 ()))
|
||||
(assert-error "band check types" (band 1 ()))
|
||||
(assert-error "bor check types" (bor 1 ()))
|
||||
(assert-error "bxor check types" (bxor 1 ()))
|
||||
(assert-error "bnot check types" (bnot ()))
|
||||
|
||||
# Comparisons
|
||||
# 10dcbc639
|
||||
(assert (> 1e23 100) "less than immediate 1")
|
||||
(assert (> 1e23 1000) "less than immediate 2")
|
||||
(assert (< 100 1e23) "greater than immediate 1")
|
||||
(assert (< 1000 1e23) "greater than immediate 2")
|
||||
|
||||
# Quasiquote bracketed tuples
|
||||
# e239980da
|
||||
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3]))
|
||||
"quasiquote bracket tuples")
|
||||
|
||||
# Regression #638
|
||||
# c68264802
|
||||
(compwhen
|
||||
(dyn 'ev/go)
|
||||
(assert
|
||||
(= [true :caught]
|
||||
(protect
|
||||
(try
|
||||
(do
|
||||
(ev/sleep 0)
|
||||
(with-dyns []
|
||||
(ev/sleep 0)
|
||||
(error "oops")))
|
||||
([err] :caught))))
|
||||
"regression #638"))
|
||||
|
||||
#
|
||||
# Test propagation of signals via fibers
|
||||
#
|
||||
# b8032ec61
|
||||
(def f (fiber/new (fn [] (error :abc) 1) :ei))
|
||||
(def res (resume f))
|
||||
(assert-error :abc (propagate res f) "propagate 1")
|
||||
|
||||
# Cancel test
|
||||
# 28439d822
|
||||
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume f)) "cancel resume 1")
|
||||
(assert (= 2 (resume f)) "cancel resume 2")
|
||||
(assert (= :hi (cancel f :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status f)) "cancel resume 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,437 +0,0 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 0)
|
||||
|
||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||
(assert (= -8 (- 1 2 3 4)) "subtraction")
|
||||
(assert (= 24 (* 1 2 3 4)) "multiplication")
|
||||
(assert (= 4 (blshift 1 2)) "left shift")
|
||||
(assert (= 1 (brshift 4 2)) "right shift")
|
||||
(assert (< 1 2 3 4 5 6) "less than integers")
|
||||
(assert (< 1.0 2.0 3.0 4.0 5.0 6.0) "less than reals")
|
||||
(assert (> 6 5 4 3 2 1) "greater than integers")
|
||||
(assert (> 6.0 5.0 4.0 3.0 2.0 1.0) "greater than reals")
|
||||
(assert (<= 1 2 3 3 4 5 6) "less than or equal to integers")
|
||||
(assert (<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "less than or equal to reals")
|
||||
(assert (>= 6 5 4 4 3 2 1) "greater than or equal to integers")
|
||||
(assert (>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "greater than or equal to reals")
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "type ordering")
|
||||
|
||||
(assert (= (string (buffer "123" "456")) (string @"123456")) "buffer literal")
|
||||
(assert (= (get {} 1) nil) "get nil from empty struct")
|
||||
(assert (= (get @{} 1) nil) "get nil from empty table")
|
||||
(assert (= (get {:boop :bap} :boop) :bap) "get non nil from struct")
|
||||
(assert (= (get @{:boop :bap} :boop) :bap) "get non nil from table")
|
||||
(assert (= (get @"\0" 0) 0) "get non nil from buffer")
|
||||
(assert (= (get @"\0" 1) nil) "get nil from buffer oob")
|
||||
(assert (put @{} :boop :bap) "can add to empty table")
|
||||
(assert (put @{1 3} :boop :bap) "can add to non-empty table")
|
||||
|
||||
(assert (not false) "false literal")
|
||||
(assert true "true literal")
|
||||
(assert (not nil) "nil literal")
|
||||
(assert (= 7 (bor 3 4)) "bit or")
|
||||
(assert (= 0 (band 3 4)) "bit and")
|
||||
(assert (= 0xFF (bxor 0x0F 0xF0)) "bit xor")
|
||||
(assert (= 0xF0 (bxor 0xFF 0x0F)) "bit xor 2")
|
||||
|
||||
# Set global variables to prevent some possible compiler optimizations that defeat point of the test
|
||||
(var zero 0)
|
||||
(var one 1)
|
||||
(var two 2)
|
||||
(var three 3)
|
||||
(var plus +)
|
||||
(assert (= 22 (plus one (plus 1 2 two) (plus 8 (plus zero 1) 4 three))) "nested function calls")
|
||||
|
||||
# String literals
|
||||
(assert (= "abcd" "\x61\x62\x63\x64") "hex escapes")
|
||||
(assert (= "\e" "\x1B") "escape character")
|
||||
(assert (= "\x09" "\t") "tab character")
|
||||
|
||||
# McCarthy's 91 function
|
||||
(var f91 nil)
|
||||
(set f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11))))))
|
||||
(assert (= 91 (f91 10)) "f91(10) = 91")
|
||||
(assert (= 91 (f91 11)) "f91(11) = 91")
|
||||
(assert (= 91 (f91 20)) "f91(20) = 91")
|
||||
(assert (= 91 (f91 31)) "f91(31) = 91")
|
||||
(assert (= 91 (f91 100)) "f91(100) = 91")
|
||||
(assert (= 91 (f91 101)) "f91(101) = 91")
|
||||
(assert (= 92 (f91 102)) "f91(102) = 92")
|
||||
(assert (= 93 (f91 103)) "f91(103) = 93")
|
||||
(assert (= 94 (f91 104)) "f91(104) = 94")
|
||||
|
||||
# Fibonacci
|
||||
(def fib (do (var fib nil) (set fib (fn [n] (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))))
|
||||
(def fib2 (fn fib2 [n] (if (< n 2) n (+ (fib2 (- n 1)) (fib2 (- n 2))))))
|
||||
|
||||
(assert (= (fib 0) (fib2 0) 0) "fib(0)")
|
||||
(assert (= (fib 1) (fib2 1) 1) "fib(1)")
|
||||
(assert (= (fib 2) (fib2 2) 1) "fib(2)")
|
||||
(assert (= (fib 3) (fib2 3) 2) "fib(3)")
|
||||
(assert (= (fib 4) (fib2 4) 3) "fib(4)")
|
||||
(assert (= (fib 5) (fib2 5) 5) "fib(5)")
|
||||
(assert (= (fib 6) (fib2 6) 8) "fib(6)")
|
||||
(assert (= (fib 7) (fib2 7) 13) "fib(7)")
|
||||
(assert (= (fib 8) (fib2 8) 21) "fib(8)")
|
||||
(assert (= (fib 9) (fib2 9) 34) "fib(9)")
|
||||
(assert (= (fib 10) (fib2 10) 55) "fib(10)")
|
||||
|
||||
# Closure in non function scope
|
||||
(def outerfun (fn [x y]
|
||||
(def c (do
|
||||
(def someval (+ 10 y))
|
||||
(def ctemp (if x (fn [] someval) (fn [] y)))
|
||||
ctemp
|
||||
))
|
||||
(+ 1 2 3 4 5 6 7)
|
||||
c))
|
||||
|
||||
(assert (= ((outerfun 1 2)) 12) "inner closure 1")
|
||||
(assert (= ((outerfun nil 2)) 2) "inner closure 2")
|
||||
(assert (= ((outerfun false 3)) 3) "inner closure 3")
|
||||
|
||||
(assert (= '(1 2 3) (quote (1 2 3)) (tuple 1 2 3)) "quote shorthand")
|
||||
|
||||
((fn []
|
||||
(var accum 1)
|
||||
(var count 0)
|
||||
(while (< count 16)
|
||||
(set accum (blshift accum 1))
|
||||
(set count (+ 1 count)))
|
||||
(assert (= accum 65536) "loop in closure")))
|
||||
|
||||
(var accum 1)
|
||||
(var count 0)
|
||||
(while (< count 16)
|
||||
(set accum (blshift accum 1))
|
||||
(set count (+ 1 count)))
|
||||
(assert (= accum 65536) "loop globally")
|
||||
|
||||
(assert (= (struct 1 2 3 4 5 6 7 8) (struct 7 8 5 6 3 4 1 2)) "struct order does not matter 1")
|
||||
(assert (= (struct
|
||||
:apple 1
|
||||
6 :bork
|
||||
'(1 2 3) 5)
|
||||
(struct
|
||||
6 :bork
|
||||
'(1 2 3) 5
|
||||
:apple 1)) "struct order does not matter 2")
|
||||
|
||||
# Symbol function
|
||||
|
||||
(assert (= (symbol "abc" 1 2 3) 'abc123) "symbol function")
|
||||
|
||||
# Fiber tests
|
||||
|
||||
(def afiber (fiber/new (fn []
|
||||
(def x (yield))
|
||||
(error (string "hello, " x))) :ye))
|
||||
|
||||
(resume afiber) # first resume to prime
|
||||
(def afiber-result (resume afiber "world!"))
|
||||
|
||||
(assert (= afiber-result "hello, world!") "fiber error result")
|
||||
(assert (= (fiber/status afiber) :error) "fiber error status")
|
||||
|
||||
# yield tests
|
||||
|
||||
(def t (fiber/new (fn [&] (yield 1) (yield 2) 3)))
|
||||
|
||||
(assert (= 1 (resume t)) "initial transfer to new fiber")
|
||||
(assert (= 2 (resume t)) "second transfer to fiber")
|
||||
(assert (= 3 (resume t)) "return from fiber")
|
||||
(assert (= (fiber/status t) :dead) "finished fiber is dead")
|
||||
|
||||
# Var arg tests
|
||||
|
||||
(def vargf (fn [more] (apply + more)))
|
||||
|
||||
(assert (= 0 (vargf @[])) "var arg no arguments")
|
||||
(assert (= 1 (vargf @[1])) "var arg no packed arguments")
|
||||
(assert (= 3 (vargf @[1 2])) "var arg tuple size 1")
|
||||
(assert (= 10 (vargf @[1 2 3 4])) "var arg tuple size 2, 2 normal args")
|
||||
(assert (= 110 (vargf @[1 2 3 4 10 10 10 10 10 10 10 10 10 10])) "var arg large tuple")
|
||||
|
||||
# Higher order functions
|
||||
|
||||
(def compose (fn [f g] (fn [& xs] (f (apply g xs)))))
|
||||
|
||||
(def -+ (compose - +))
|
||||
(def +- (compose + -))
|
||||
|
||||
(assert (= (-+ 1 2 3 4) -10) "compose - +")
|
||||
(assert (= (+- 1 2 3 4) -8) "compose + -")
|
||||
(assert (= ((compose -+ +-) 1 2 3 4) 8) "compose -+ +-")
|
||||
(assert (= ((compose +- -+) 1 2 3 4) 10) "compose +- -+")
|
||||
|
||||
# UTF-8
|
||||
|
||||
#🐙🐙🐙🐙
|
||||
|
||||
(defn foo [Θa Θb Θc] 0)
|
||||
(def 🦊 :fox)
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
(assert (= "\U01F637" "😷") "unicode escape 1")
|
||||
(assert (= "\u2623" "\U002623" "☣") "unicode escape 2")
|
||||
(assert (= "\u24c2" "\U0024c2" "Ⓜ") "unicode escape 3")
|
||||
(assert (= "\u0061" "a") "unicode escape 4")
|
||||
|
||||
# Symbols with @ character
|
||||
|
||||
(def @ 1)
|
||||
(assert (= @ 1) "@ symbol")
|
||||
(def @-- 2)
|
||||
(assert (= @-- 2) "@-- symbol")
|
||||
(def @hey 3)
|
||||
(assert (= @hey 3) "@hey symbol")
|
||||
|
||||
# Merge sort
|
||||
|
||||
# Imperative (and verbose) merge sort merge
|
||||
(defn merge
|
||||
[xs ys]
|
||||
(def ret @[])
|
||||
(def xlen (length xs))
|
||||
(def ylen (length ys))
|
||||
(var i 0)
|
||||
(var j 0)
|
||||
# Main merge
|
||||
(while (if (< i xlen) (< j ylen))
|
||||
(def xi (get xs i))
|
||||
(def yj (get ys j))
|
||||
(if (< xi yj)
|
||||
(do (array/push ret xi) (set i (+ i 1)))
|
||||
(do (array/push ret yj) (set j (+ j 1)))))
|
||||
# Push rest of xs
|
||||
(while (< i xlen)
|
||||
(def xi (get xs i))
|
||||
(array/push ret xi)
|
||||
(set i (+ i 1)))
|
||||
# Push rest of ys
|
||||
(while (< j ylen)
|
||||
(def yj (get ys j))
|
||||
(array/push ret yj)
|
||||
(set j (+ j 1)))
|
||||
ret)
|
||||
|
||||
(assert (apply <= (merge @[1 3 5] @[2 4 6])) "merge sort merge 1")
|
||||
(assert (apply <= (merge @[1 2 3] @[4 5 6])) "merge sort merge 2")
|
||||
(assert (apply <= (merge @[1 3 5] @[2 4 6 6 6 9])) "merge sort merge 3")
|
||||
(assert (apply <= (merge '(1 3 5) @[2 4 6 6 6 9])) "merge sort merge 4")
|
||||
|
||||
(assert (deep= @[1 2 3 4 5] (sort @[5 3 4 1 2])) "sort 1")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sort-by |($ :a) @[{:a 4} {:a 7} {:a 1}])) "sort 2")
|
||||
(assert (deep= @[1 2 3 4 5] (sorted [5 3 4 1 2])) "sort 3")
|
||||
(assert (deep= @[{:a 1} {:a 4} {:a 7}] (sorted-by |($ :a) [{:a 4} {:a 7} {:a 1}])) "sort 4")
|
||||
|
||||
# Gensym tests
|
||||
|
||||
(assert (not= (gensym) (gensym)) "two gensyms not equal")
|
||||
((fn []
|
||||
(def syms (table))
|
||||
(var count 0)
|
||||
(while (< count 128)
|
||||
(put syms (gensym) true)
|
||||
(set count (+ 1 count)))
|
||||
(assert (= (length syms) 128) "many symbols")))
|
||||
|
||||
# Let
|
||||
|
||||
(assert (= (let [a 1 b 2] (+ a b)) 3) "simple let")
|
||||
(assert (= (let [[a b] @[1 2]] (+ a b)) 3) "destructured let")
|
||||
(assert (= (let [[a [c d] b] @[1 (tuple 4 3) 2]] (+ a b c d)) 10) "double destructured let")
|
||||
|
||||
# Macros
|
||||
|
||||
(defn dub [x] (+ x x))
|
||||
(assert (= 2 (dub 1)) "defn macro")
|
||||
(do
|
||||
(defn trip [x] (+ x x x))
|
||||
(assert (= 3 (trip 1)) "defn macro triple"))
|
||||
(do
|
||||
(var i 0)
|
||||
(when true
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i)
|
||||
(++ i))
|
||||
(assert (= i 6) "when macro"))
|
||||
|
||||
# Dynamic defs
|
||||
|
||||
(def staticdef1 0)
|
||||
(defn staticdef1-inc [] (+ 1 staticdef1))
|
||||
(assert (= 1 (staticdef1-inc)) "before redefinition without :redef")
|
||||
(def staticdef1 1)
|
||||
(assert (= 1 (staticdef1-inc)) "after redefinition without :redef")
|
||||
(setdyn :redef true)
|
||||
(def dynamicdef2 0)
|
||||
(defn dynamicdef2-inc [] (+ 1 dynamicdef2))
|
||||
(assert (= 1 (dynamicdef2-inc)) "before redefinition with dyn :redef")
|
||||
(def dynamicdef2 1)
|
||||
(assert (= 2 (dynamicdef2-inc)) "after redefinition with dyn :redef")
|
||||
(setdyn :redef nil)
|
||||
|
||||
# Denormal tables and structs
|
||||
|
||||
(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
|
||||
(assert (= (length @{1 2 nil 3}) 1) "nil key table literal")
|
||||
(assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
|
||||
(assert (= (length (table 1 2 nil 3)) 1) "nil key table ctor")
|
||||
|
||||
(assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
|
||||
(assert (= (length (table (/ 0 0) 2 1 3)) 1) "nan key table ctor")
|
||||
(assert (= (length {1 2 nil 3}) 1) "nan key struct literal")
|
||||
(assert (= (length @{1 2 nil 3}) 1) "nan key table literal")
|
||||
|
||||
(assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
|
||||
(assert (= (length (table 2 1 3 nil)) 1) "nil value table ctor")
|
||||
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||
|
||||
# Regression Test
|
||||
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||
|
||||
# Regression Test #137
|
||||
(def [a b c] (range 10))
|
||||
(assert (= a 0) "regression #137 (1)")
|
||||
(assert (= b 1) "regression #137 (2)")
|
||||
(assert (= c 2) "regression #137 (3)")
|
||||
|
||||
(var [x y z] (range 10))
|
||||
(assert (= x 0) "regression #137 (4)")
|
||||
(assert (= y 1) "regression #137 (5)")
|
||||
(assert (= z 2) "regression #137 (6)")
|
||||
|
||||
(assert (= true ;(map truthy? [0 "" true @{} {} [] '()])) "truthy values")
|
||||
(assert (= false ;(map truthy? [nil false])) "non-truthy values")
|
||||
|
||||
# Struct and Table duplicate elements
|
||||
(assert (= {:a 3 :b 2} {:a 1 :b 2 :a 3}) "struct literal duplicate keys")
|
||||
(assert (= {:a 3 :b 2} (struct :a 1 :b 2 :a 3)) "struct constructor duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} @{:a 1 :b 2 :a 3}) "table literal duplicate keys")
|
||||
(assert (deep= @{:a 3 :b 2} (table :a 1 :b 2 :a 3)) "table constructor duplicate keys")
|
||||
|
||||
## Polymorphic comparison -- Issue #272
|
||||
|
||||
# confirm polymorphic comparison delegation to primitive comparators:
|
||||
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
|
||||
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
|
||||
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
|
||||
(assert (= 0 (compare 1 1)) "compare integers (1)")
|
||||
(assert (= -1 (compare 1 2)) "compare integers (2)")
|
||||
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
|
||||
|
||||
(assert (compare< 1 2 3 4 5 6) "compare less than integers")
|
||||
(assert (not (compare> 1 2 3 4 5 6)) "compare not greater than integers")
|
||||
(assert (compare< 1.0 2.0 3.0 4.0 5.0 6.0) "compare less than reals")
|
||||
(assert (compare> 6 5 4 3 2 1) "compare greater than integers")
|
||||
(assert (compare> 6.0 5.0 4.0 3.0 2.0 1.0) "compare greater than reals")
|
||||
(assert (not (compare< 6.0 5.0 4.0 3.0 2.0 1.0)) "compare less than reals")
|
||||
(assert (compare<= 1 2 3 3 4 5 6) "compare less than or equal to integers")
|
||||
(assert (compare<= 1.0 2.0 3.0 3.0 4.0 5.0 6.0) "compare less than or equal to reals")
|
||||
(assert (compare>= 6 5 4 4 3 2 1) "compare greater than or equal to integers")
|
||||
(assert (compare>= 6.0 5.0 4.0 4.0 3.0 2.0 1.0) "compare greater than or equal to reals")
|
||||
(assert (compare< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
(struct 1 2 3 4)
|
||||
(buffer "hi")
|
||||
(fn [x] (+ x x))
|
||||
print) "compare type ordering")
|
||||
|
||||
# test polymorphic compare with 'objects' (table/setproto)
|
||||
(def mynum
|
||||
@{:type :mynum :v 0 :compare
|
||||
(fn [self other]
|
||||
(case (type other)
|
||||
:number (cmp (self :v) other)
|
||||
:table (when (= (get other :type) :mynum)
|
||||
(cmp (self :v) (other :v)))))})
|
||||
|
||||
(let [n3 (table/setproto @{:v 3} mynum)]
|
||||
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
|
||||
(assert (= -1 (compare n3 4)) "compare object to num (2)")
|
||||
(assert (= 1 (compare (table/setproto @{:v 4} mynum) n3)) "compare object to object")
|
||||
(assert (compare< 2 n3 4) "compare< poly")
|
||||
(assert (compare> 4 n3 2) "compare> poly")
|
||||
(assert (compare<= 2 3 n3 4) "compare<= poly")
|
||||
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
|
||||
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
|
||||
|
||||
(let [MAX_INT_64_STRING "9223372036854775807"
|
||||
MAX_UINT_64_STRING "18446744073709551615"
|
||||
MAX_INT_IN_DBL_STRING "9007199254740991"
|
||||
NAN (math/log -1)
|
||||
INF (/ 1 0)
|
||||
MINUS_INF (/ -1 0)
|
||||
compare-poly-tests
|
||||
[[(int/s64 3) (int/u64 3) 0]
|
||||
[(int/s64 -3) (int/u64 3) -1]
|
||||
[(int/s64 3) (int/u64 2) 1]
|
||||
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
|
||||
[(int/u64 3) 3 0] [(int/u64 3) 4 -1] [(int/u64 3) -9 1]
|
||||
[3 (int/s64 3) 0] [3 (int/s64 4) -1] [3 (int/s64 -5) 1]
|
||||
[3 (int/u64 3) 0] [3 (int/u64 4) -1] [3 (int/u64 2) 1]
|
||||
[(int/s64 MAX_INT_64_STRING) (int/u64 MAX_UINT_64_STRING) -1]
|
||||
[(int/s64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(int/u64 MAX_INT_IN_DBL_STRING) (scan-number MAX_INT_IN_DBL_STRING) 0]
|
||||
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
|
||||
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
|
||||
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
|
||||
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
|
||||
(each [x y c] compare-poly-tests
|
||||
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
|
||||
|
||||
(assert (= nil (any? [])) "any? 1")
|
||||
(assert (= nil (any? [false nil])) "any? 2")
|
||||
(assert (= nil (any? [nil false])) "any? 3")
|
||||
(assert (= 1 (any? [1])) "any? 4")
|
||||
(assert (nan? (any? [nil math/nan nil])) "any? 5")
|
||||
(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -1,384 +0,0 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 1)
|
||||
|
||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
|
||||
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
|
||||
(assert (= (get test-struct 'def) 1) "struct get")
|
||||
(assert (= (get test-struct 'bork) 2) "struct get")
|
||||
(assert (= (get test-struct 'sam) 3) "struct get")
|
||||
(assert (= (get test-struct 'a) 'b) "struct get")
|
||||
(assert (= :array (type (get test-struct 'het))) "struct get")
|
||||
|
||||
(defn myfun [x]
|
||||
(var a 10)
|
||||
(set a (do
|
||||
(def y x)
|
||||
(if x 8 9))))
|
||||
|
||||
(assert (= (myfun true) 8) "check do form regression")
|
||||
(assert (= (myfun false) 9) "check do form regression")
|
||||
|
||||
(defn assert-many [f n e]
|
||||
(var good true)
|
||||
(loop [i :range [0 n]]
|
||||
(if (not (f))
|
||||
(set good false)))
|
||||
(assert good e))
|
||||
|
||||
(assert-many (fn [] (>= 1 (math/random) 0)) 200 "(random) between 0 and 1")
|
||||
|
||||
## Table prototypes
|
||||
|
||||
(def roottab @{
|
||||
:parentprop 123
|
||||
})
|
||||
|
||||
(def childtab @{
|
||||
:childprop 456
|
||||
})
|
||||
|
||||
(table/setproto childtab roottab)
|
||||
|
||||
(assert (= 123 (get roottab :parentprop)) "table get 1")
|
||||
(assert (= 123 (get childtab :parentprop)) "table get proto")
|
||||
(assert (= nil (get roottab :childprop)) "table get 2")
|
||||
(assert (= 456 (get childtab :childprop)) "proto no effect")
|
||||
|
||||
# Long strings
|
||||
|
||||
(assert (= "hello, world" `hello, world`) "simple long string")
|
||||
(assert (= "hello, \"world\"" `hello, "world"`) "long string with embedded quotes")
|
||||
(assert (= "hello, \\\\\\ \"world\"" `hello, \\\ "world"`)
|
||||
"long string with embedded quotes and backslashes")
|
||||
|
||||
# More fiber semantics
|
||||
|
||||
(var myvar 0)
|
||||
(defn fiberstuff [&]
|
||||
(++ myvar)
|
||||
(def f (fiber/new (fn [&] (++ myvar) (debug) (++ myvar))))
|
||||
(resume f)
|
||||
(++ myvar))
|
||||
|
||||
(def myfiber (fiber/new fiberstuff :dey))
|
||||
|
||||
(assert (= myvar 0) "fiber creation does not call fiber function")
|
||||
(resume myfiber)
|
||||
(assert (= myvar 2) "fiber debug statement breaks at proper point")
|
||||
(assert (= (fiber/status myfiber) :debug) "fiber enters debug state")
|
||||
(resume myfiber)
|
||||
(assert (= myvar 4) "fiber resumes properly from debug state")
|
||||
(assert (= (fiber/status myfiber) :dead) "fiber properly dies from debug state")
|
||||
|
||||
# Test max triangle program
|
||||
|
||||
# Find the maximum path from the top (root)
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 [;xs 0]
|
||||
xs2 [0 ;xs]
|
||||
m1 (map + xs1 ys)
|
||||
m2 (map + xs2 ys)]
|
||||
(map max m1 m2)))
|
||||
|
||||
(defn maxpath [t]
|
||||
(extreme > (reduce myfold () t)))
|
||||
|
||||
# Test it
|
||||
# Maximum path is 3 -> 10 -> 3 -> 9 for a total of 25
|
||||
|
||||
(def triangle '[
|
||||
[3]
|
||||
[7 10]
|
||||
[4 3 7]
|
||||
[8 9 1 3]
|
||||
])
|
||||
|
||||
(assert (= (maxpath triangle) 25) `max triangle`)
|
||||
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 1 argument")
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2 arguments")
|
||||
(assert (= (string/join @[] ", ") "") "string/join empty array")
|
||||
|
||||
(assert (= (string/find "123" "abc123def") 3) "string/find positive")
|
||||
(assert (= (string/find "1234" "abc123def") nil) "string/find negative")
|
||||
|
||||
# Test destructuring
|
||||
(do
|
||||
(def test-tab @{:a 1 :b 2})
|
||||
(def {:a a :b b} test-tab)
|
||||
(assert (= a 1) "dictionary destructuring 1")
|
||||
(assert (= b 2) "dictionary destructuring 2"))
|
||||
(do
|
||||
(def test-tab @{'a 1 'b 2 3 4})
|
||||
(def {'a a 'b b (+ 1 2) c} test-tab)
|
||||
(assert (= a 1) "dictionary destructuring 3")
|
||||
(assert (= b 2) "dictionary destructuring 4")
|
||||
(assert (= c 4) "dictionary destructuring 5 - expression as key"))
|
||||
(let [test-tuple [:a :b 1 2]]
|
||||
(def [a b one two] test-tuple)
|
||||
(assert (= a :a) "tuple destructuring 1")
|
||||
(assert (= b :b) "tuple destructuring 2")
|
||||
(assert (= two 2) "tuple destructuring 3"))
|
||||
(let [test-tuple [:a :b 1 2]]
|
||||
(def [a & rest] test-tuple)
|
||||
(assert (= a :a) "tuple destructuring 4 - rest")
|
||||
(assert (= rest [:b 1 2]) "tuple destructuring 5 - rest"))
|
||||
(do
|
||||
(def [a b & rest] [:a :b nil :d])
|
||||
(assert (= a :a) "tuple destructuring 6 - rest")
|
||||
(assert (= b :b) "tuple destructuring 7 - rest")
|
||||
(assert (= rest [nil :d]) "tuple destructuring 8 - rest"))
|
||||
(do
|
||||
(def [[a b] x & rest] [[1 2] :a :c :b :a])
|
||||
(assert (= a 1) "tuple destructuring 9 - rest")
|
||||
(assert (= b 2) "tuple destructuring 10 - rest")
|
||||
(assert (= x :a) "tuple destructuring 11 - rest")
|
||||
(assert (= rest [:c :b :a]) "tuple destructuring 12 - rest"))
|
||||
(do
|
||||
(def [a b & rest] [:a :b])
|
||||
(assert (= a :a) "tuple destructuring 13 - rest")
|
||||
(assert (= b :b) "tuple destructuring 14 - rest")
|
||||
(assert (= rest []) "tuple destructuring 15 - rest"))
|
||||
|
||||
(do
|
||||
(def [[a b & r1] c & r2] [[:a :b 1 2] :c 3 4])
|
||||
(assert (= a :a) "tuple destructuring 16 - rest")
|
||||
(assert (= b :b) "tuple destructuring 17 - rest")
|
||||
(assert (= c :c) "tuple destructuring 18 - rest")
|
||||
(assert (= r1 [1 2]) "tuple destructuring 19 - rest")
|
||||
(assert (= r2 [3 4]) "tuple destructuring 20 - rest"))
|
||||
|
||||
# Marshal
|
||||
|
||||
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
(defn testmarsh [x msg]
|
||||
(def marshx (marshal x m-lookup))
|
||||
(def out (marshal (unmarshal marshx um-lookup) m-lookup))
|
||||
(assert (= (string marshx) (string out)) msg))
|
||||
|
||||
(testmarsh nil "marshal nil")
|
||||
(testmarsh false "marshal false")
|
||||
(testmarsh true "marshal true")
|
||||
(testmarsh 1 "marshal small integers")
|
||||
(testmarsh -1 "marshal integers (-1)")
|
||||
(testmarsh 199 "marshal small integers (199)")
|
||||
(testmarsh 5000 "marshal medium integers (5000)")
|
||||
(testmarsh -5000 "marshal small integers (-5000)")
|
||||
(testmarsh 10000 "marshal large integers (10000)")
|
||||
(testmarsh -10000 "marshal large integers (-10000)")
|
||||
(testmarsh 1.0 "marshal double")
|
||||
(testmarsh "doctordolittle" "marshal string")
|
||||
(testmarsh :chickenshwarma "marshal symbol")
|
||||
(testmarsh @"oldmcdonald" "marshal buffer")
|
||||
(testmarsh @[1 2 3 4 5] "marshal array")
|
||||
(testmarsh [tuple 1 2 3 4 5] "marshal tuple")
|
||||
(testmarsh @{1 2 3 4} "marshal table")
|
||||
(testmarsh {1 2 3 4} "marshal struct")
|
||||
(testmarsh (fn [x] x) "marshal function 0")
|
||||
(testmarsh (fn name [x] x) "marshal function 1")
|
||||
(testmarsh (fn [x] (+ 10 x 2)) "marshal function 2")
|
||||
(testmarsh (fn thing [x] (+ 11 x x 30)) "marshal function 3")
|
||||
(testmarsh map "marshal function 4")
|
||||
(testmarsh reduce "marshal function 5")
|
||||
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
||||
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
||||
|
||||
(def strct {:a @[nil]})
|
||||
(put (strct :a) 0 strct)
|
||||
(testmarsh strct "cyclic struct")
|
||||
|
||||
# Large functions
|
||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
(def my-array @[1 2 3 4 5 6])
|
||||
(def x (if-let [x (get my-array 5)] x))
|
||||
(assert (= x 6) "if-let")
|
||||
(def x (if-let [y (get @{} :key)] 10 nil))
|
||||
(assert (not x) "if-let 2")
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= [2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
(assert
|
||||
(= :six (case (+ 1 2 3)
|
||||
1 :one
|
||||
2 :two
|
||||
3 :three
|
||||
4 :four
|
||||
5 :five
|
||||
6 :six
|
||||
7 :seven
|
||||
8 :eight
|
||||
9 :nine)) "case macro")
|
||||
|
||||
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
|
||||
|
||||
# Testing the loop and seq macros
|
||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
|
||||
|
||||
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
|
||||
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
|
||||
|
||||
(def xs (catseq [x :range [0 3]] [x x]))
|
||||
(assert (deep= xs @[0 0 1 1 2 2]) "catseq")
|
||||
|
||||
# :range-to and :down-to
|
||||
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
|
||||
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
|
||||
|
||||
# Some testing for not=
|
||||
(assert (not= 1 1 0) "not= 1")
|
||||
(assert (not= 0 1 1) "not= 2")
|
||||
|
||||
# Closure in while loop
|
||||
(def closures (seq [i :range [0 5]] (fn [] i)))
|
||||
(assert (= 0 ((get closures 0))) "closure in loop 0")
|
||||
(assert (= 1 ((get closures 1))) "closure in loop 1")
|
||||
(assert (= 2 ((get closures 2))) "closure in loop 2")
|
||||
(assert (= 3 ((get closures 3))) "closure in loop 3")
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
# More numerical tests
|
||||
(assert (= 1 1.0) "numerical equal 1")
|
||||
(assert (= 0 0.0) "numerical equal 2")
|
||||
(assert (= 0 -0.0) "numerical equal 3")
|
||||
(assert (= 2_147_483_647 2_147_483_647.0) "numerical equal 4")
|
||||
(assert (= -2_147_483_648 -2_147_483_648.0) "numerical equal 5")
|
||||
|
||||
# Array tests
|
||||
|
||||
(defn array=
|
||||
"Check if two arrays are equal in an element by element comparison"
|
||||
[a b]
|
||||
(if (and (array? a) (array? b))
|
||||
(= (apply tuple a) (apply tuple b))))
|
||||
(assert (= (apply tuple @[1 2 3 4 5]) (tuple 1 2 3 4 5)) "array to tuple")
|
||||
(def arr (array))
|
||||
(array/push arr :hello)
|
||||
(array/push arr :world)
|
||||
(assert (array= arr @[:hello :world]) "array comparison")
|
||||
(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
|
||||
(assert (array= @[:one :two :three :four :five] @[:one :two :three :four :five]) "array comparison 3")
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
|
||||
|
||||
# Even and odd
|
||||
|
||||
(assert (odd? 9) "odd? 1")
|
||||
(assert (odd? -9) "odd? 2")
|
||||
(assert (not (odd? 10)) "odd? 3")
|
||||
(assert (not (odd? 0)) "odd? 4")
|
||||
(assert (not (odd? -10)) "odd? 5")
|
||||
(assert (not (odd? 1.1)) "odd? 6")
|
||||
(assert (not (odd? -0.1)) "odd? 7")
|
||||
(assert (not (odd? -1.1)) "odd? 8")
|
||||
(assert (not (odd? -1.6)) "odd? 9")
|
||||
|
||||
(assert (even? 10) "even? 1")
|
||||
(assert (even? -10) "even? 2")
|
||||
(assert (even? 0) "even? 3")
|
||||
(assert (not (even? 9)) "even? 4")
|
||||
(assert (not (even? -9)) "even? 5")
|
||||
(assert (not (even? 0.1)) "even? 6")
|
||||
(assert (not (even? -0.1)) "even? 7")
|
||||
(assert (not (even? -10.1)) "even? 8")
|
||||
(assert (not (even? -10.6)) "even? 9")
|
||||
|
||||
# Map arities
|
||||
(assert (deep= (map inc [1 2 3]) @[2 3 4]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30]) @[11 22 33]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300]) @[111 222 333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000]) @[1111 2222 3333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000]) @[11111 22222 33333]))
|
||||
(assert (deep= (map + [1 2 3] [10 20 30] [100 200 300] [1000 2000 3000] [10000 20000 30000] [100000 200000 300000]) @[111111 222222 333333]))
|
||||
|
||||
# Mapping uses the shortest sequence
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30]) @[11 22 33]))
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200]) @[111 222]))
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000]) @[1111]))
|
||||
(assert (deep= (map + [1 2 3 4] [10 20 30] [100 200] [1000] []) @[]))
|
||||
|
||||
# Variadic arguments to map-like functions
|
||||
(assert (deep= (mapcat tuple [1 2 3 4] [5 6 7 8]) @[1 5 2 6 3 7 4 8]))
|
||||
(assert (deep= (keep |(if (> $1 0) (/ $0 $1)) [1 2 3 4 5] [1 2 1 0 1]) @[1 1 3 5]))
|
||||
|
||||
(assert (= (count = [1 3 2 4 3 5 4 2 1] [1 2 3 4 5 4 3 2 1]) 4))
|
||||
|
||||
(assert (= (some not= (range 5) (range 5)) nil))
|
||||
(assert (= (some = [1 2 3 4 5] [5 4 3 2 1]) true))
|
||||
|
||||
(assert (= (all = (range 5) (range 5)) true))
|
||||
(assert (= (all not= [1 2 3 4 5] [5 4 3 2 1]) false))
|
||||
|
||||
(assert (= false (deep-not= [1] [1])) "issue #1149")
|
||||
|
||||
# Sort function
|
||||
(assert (deep=
|
||||
(range 99)
|
||||
(sort (mapcat (fn [[x y z]] [z y x]) (partition 3 (range 99))))) "sort 5")
|
||||
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
|
||||
|
||||
# And and or
|
||||
|
||||
(assert (= (and true true) true) "and true true")
|
||||
(assert (= (and true false) false) "and true false")
|
||||
(assert (= (and false true) false) "and false true")
|
||||
(assert (= (and true true true) true) "and true true true")
|
||||
(assert (= (and 0 1 2) 2) "and 0 1 2")
|
||||
(assert (= (and 0 1 nil) nil) "and 0 1 nil")
|
||||
(assert (= (and 1) 1) "and 1")
|
||||
(assert (= (and) true) "and with no arguments")
|
||||
(assert (= (and 1 true) true) "and with trailing true")
|
||||
(assert (= (and 1 true 2) 2) "and with internal true")
|
||||
|
||||
(assert (= (or true true) true) "or true true")
|
||||
(assert (= (or true false) true) "or true false")
|
||||
(assert (= (or false true) true) "or false true")
|
||||
(assert (= (or false false) false) "or false true")
|
||||
(assert (= (or true true false) true) "or true true false")
|
||||
(assert (= (or 0 1 2) 0) "or 0 1 2")
|
||||
(assert (= (or nil 1 2) 1) "or nil 1 2")
|
||||
(assert (= (or 1) 1) "or 1")
|
||||
(assert (= (or) nil) "or with no arguments")
|
||||
|
||||
(def yielder
|
||||
(coro
|
||||
(defer (yield :end)
|
||||
(repeat 5 (yield :item)))))
|
||||
(def items (seq [x :in yielder] x))
|
||||
(assert (deep= @[:item :item :item :item :item :end] items) "yield within nested fibers")
|
||||
|
||||
(end-suite)
|
||||
@@ -1,497 +0,0 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 3)
|
||||
|
||||
(assert (= (length (range 10)) 10) "(range 10)")
|
||||
(assert (= (length (range 1 10)) 9) "(range 1 10)")
|
||||
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
|
||||
|
||||
(def- a 100)
|
||||
(assert (= a 100) "def-")
|
||||
|
||||
(assert (= :first
|
||||
(match @[1 3 5]
|
||||
@[x y z] :first
|
||||
:second)) "match 1")
|
||||
|
||||
(def val1 :avalue)
|
||||
(assert (= :second
|
||||
(match val1
|
||||
@[x y z] :first
|
||||
:avalue :second
|
||||
:third)) "match 2")
|
||||
|
||||
(assert (= 100
|
||||
(match @[50 40]
|
||||
@[x x] (* x 3)
|
||||
@[x y] (+ x y 10)
|
||||
0)) "match 3")
|
||||
|
||||
# Edge case should cause old compilers to fail due to
|
||||
# if statement optimization
|
||||
(var var-a 1)
|
||||
(var var-b (if false 2 (string "hello")))
|
||||
|
||||
(assert (= var-b "hello") "regression 1")
|
||||
|
||||
# Scan number
|
||||
|
||||
(assert (= 1 (scan-number "1")) "scan-number 1")
|
||||
(assert (= -1 (scan-number "-1")) "scan-number -1")
|
||||
(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
|
||||
|
||||
# Some macros
|
||||
|
||||
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
||||
(assert (= 3 (if-not false 3)) "if-not 2")
|
||||
(assert (= 3 (if-not nil 3 2)) "if-not 3")
|
||||
(assert (= nil (if-not true 3)) "if-not 4")
|
||||
|
||||
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
|
||||
|
||||
(def res @{})
|
||||
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
||||
(put res k v))
|
||||
(assert (and
|
||||
(= (get res 1) 2)
|
||||
(= (get res 3) 4)
|
||||
(= (get res 5) 6)) "loop :pairs")
|
||||
|
||||
# Another regression test - no segfaults
|
||||
(defn afn [x] x)
|
||||
(var afn-var afn)
|
||||
(var identity-var identity)
|
||||
(var map-var map)
|
||||
(var not-var not)
|
||||
(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
|
||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||
(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
|
||||
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
:arity 1
|
||||
:bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
(assert (= 0 (fibasm 0)) "fibasm 1")
|
||||
(assert (= 1 (fibasm 1)) "fibasm 2")
|
||||
(assert (= 55 (fibasm 10)) "fibasm 3")
|
||||
(assert (= 6765 (fibasm 20)) "fibasm 4")
|
||||
|
||||
# Calling non functions
|
||||
|
||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad))) "calling table too many arguments")
|
||||
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
||||
(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops))) "calling number fails")
|
||||
|
||||
# Method test
|
||||
|
||||
(def Dog @{:bark (fn bark [self what] (string (self :name) " says " what "!"))})
|
||||
(defn make-dog
|
||||
[name]
|
||||
(table/setproto @{:name name} Dog))
|
||||
|
||||
(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
|
||||
(def spot (make-dog "spot"))
|
||||
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
||||
|
||||
# Negative tests
|
||||
|
||||
(assert-error "+ check types" (+ 1 ()))
|
||||
(assert-error "- check types" (- 1 ()))
|
||||
(assert-error "* check types" (* 1 ()))
|
||||
(assert-error "/ check types" (/ 1 ()))
|
||||
(assert-error "band check types" (band 1 ()))
|
||||
(assert-error "bor check types" (bor 1 ()))
|
||||
(assert-error "bxor check types" (bxor 1 ()))
|
||||
(assert-error "bnot check types" (bnot ()))
|
||||
|
||||
# Buffer blitting
|
||||
|
||||
(def b (buffer/new-filled 100))
|
||||
(buffer/bit-set b 100)
|
||||
(buffer/bit-clear b 100)
|
||||
(assert (zero? (sum b)) "buffer bit set and clear")
|
||||
(buffer/bit-toggle b 101)
|
||||
(assert (= 32 (sum b)) "buffer bit set and clear")
|
||||
|
||||
(def b2 @"hello world")
|
||||
|
||||
(buffer/blit b2 "joyto ")
|
||||
(assert (= (string b2) "joyto world") "buffer/blit 1")
|
||||
|
||||
(buffer/blit b2 "joyto" 6)
|
||||
(assert (= (string b2) "joyto joyto") "buffer/blit 2")
|
||||
|
||||
(buffer/blit b2 "abcdefg" 5 6)
|
||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||
|
||||
# Buffer self blitting, check for use after free
|
||||
(def buf1 @"1234567890")
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(assert (= (string buf1) (string/repeat "1234567890" 16)) "buffer blit against self")
|
||||
|
||||
# Buffer push word
|
||||
|
||||
(def b3 @"")
|
||||
(buffer/push-word b3 0xFF 0x11)
|
||||
(assert (= 8 (length b3)) "buffer/push-word 1")
|
||||
(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
|
||||
(buffer/clear b3)
|
||||
(buffer/push-word b3 0xFFFFFFFF 0x1100)
|
||||
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||
|
||||
# Buffer push string
|
||||
|
||||
(def b4 (buffer/new-filled 10 0))
|
||||
(buffer/push-string b4 b4)
|
||||
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4)) "buffer/push-buffer 1")
|
||||
(def b5 @"123")
|
||||
(buffer/push-string b5 "456" @"789")
|
||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||
|
||||
# Check for bugs with printing self with buffer/format
|
||||
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp)) `abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# Peg
|
||||
|
||||
(defn check-match
|
||||
[pat text should-match]
|
||||
(def result (peg/match pat text))
|
||||
(assert (= (not should-match) (not result)) (string "check-match " text)))
|
||||
|
||||
(defn check-deep
|
||||
[pat text what]
|
||||
(def result (peg/match pat text))
|
||||
(assert (deep= result what) (string "check-deep " text)))
|
||||
|
||||
# Just numbers
|
||||
|
||||
(check-match '(* 4 -1) "abcd" true)
|
||||
(check-match '(* 4 -1) "abc" false)
|
||||
(check-match '(* 4 -1) "abcde" false)
|
||||
|
||||
# Simple pattern
|
||||
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "hello" true)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "hello world" false)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "1he11o" false)
|
||||
(check-match '(* (some (range "az" "AZ")) -1) "" false)
|
||||
|
||||
# Pre compile
|
||||
|
||||
(def pegleg (peg/compile '{:item "abc" :main (* :item "," :item -1)}))
|
||||
|
||||
(peg/match pegleg "abc,abc")
|
||||
|
||||
# Bad Grammars
|
||||
|
||||
(assert-error "peg/compile error 1" (peg/compile nil))
|
||||
(assert-error "peg/compile error 2" (peg/compile @{}))
|
||||
(assert-error "peg/compile error 3" (peg/compile '{:a "abc" :b "def"}))
|
||||
(assert-error "peg/compile error 4" (peg/compile '(blarg "abc")))
|
||||
(assert-error "peg/compile error 5" (peg/compile '(1 2 3)))
|
||||
|
||||
# IP address
|
||||
|
||||
(def ip-address
|
||||
'{:d (range "09")
|
||||
:0-4 (range "04")
|
||||
:0-5 (range "05")
|
||||
:byte (+
|
||||
(* "25" :0-5)
|
||||
(* "2" :0-4 :d)
|
||||
(* "1" :d :d)
|
||||
(between 1 2 :d))
|
||||
:main (* :byte "." :byte "." :byte "." :byte)})
|
||||
|
||||
(check-match ip-address "10.240.250.250" true)
|
||||
(check-match ip-address "0.0.0.0" true)
|
||||
(check-match ip-address "1.2.3.4" true)
|
||||
(check-match ip-address "256.2.3.4" false)
|
||||
(check-match ip-address "256.2.3.2514" false)
|
||||
|
||||
# Substitution test with peg
|
||||
|
||||
(file/flush stderr)
|
||||
(file/flush stdout)
|
||||
|
||||
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(defn try-grammar [text]
|
||||
(assert (= (string/replace-all "dog" "purple panda" text) (0 (peg/match grammar text))) text))
|
||||
|
||||
(try-grammar "i have a dog called doug the dog. he is good.")
|
||||
(try-grammar "i have a dog called doug the dog. he is a good boy.")
|
||||
(try-grammar "i have a dog called doug the do")
|
||||
(try-grammar "i have a dog called doug the dog")
|
||||
(try-grammar "i have a dog called doug the dogg")
|
||||
(try-grammar "i have a dog called doug the doggg")
|
||||
(try-grammar "i have a dog called doug the dogggg")
|
||||
|
||||
# Peg CSV test
|
||||
|
||||
(def csv
|
||||
'{:field (+
|
||||
(* `"` (% (any (+ (<- (if-not `"` 1)) (* (constant `"`) `""`)))) `"`)
|
||||
(<- (any (if-not (set ",\n") 1))))
|
||||
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
||||
|
||||
(defn check-csv
|
||||
[str res]
|
||||
(check-deep csv str res))
|
||||
|
||||
(check-csv "1,2,3" @["1" "2" "3"])
|
||||
(check-csv "1,\"2\",3" @["1" "2" "3"])
|
||||
(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
|
||||
|
||||
# Nested Captures
|
||||
|
||||
(def grmr '(capture (* (capture "a") (capture 1) (capture "c"))))
|
||||
(check-deep grmr "abc" @["a" "b" "c" "abc"])
|
||||
(check-deep grmr "acc" @["a" "c" "c" "acc"])
|
||||
|
||||
# Functions in grammar
|
||||
|
||||
(def grmr-triple ~(% (any (/ (<- 1) ,(fn [x] (string x x x))))))
|
||||
(check-deep grmr-triple "abc" @["aaabbbccc"])
|
||||
(check-deep grmr-triple "" @[""])
|
||||
(check-deep grmr-triple " " @[" "])
|
||||
|
||||
(def counter ~(/ (group (any (<- 1))) ,length))
|
||||
(check-deep counter "abcdefg" @[7])
|
||||
|
||||
# Capture Backtracking
|
||||
|
||||
(check-deep '(+ (* (capture "c") "d") "ce") "ce" @[])
|
||||
|
||||
# Matchtime capture
|
||||
|
||||
(def scanner (peg/compile ~(cmt (capture (some 1)) ,scan-number)))
|
||||
|
||||
(check-deep scanner "123" @[123])
|
||||
(check-deep scanner "0x86" @[0x86])
|
||||
(check-deep scanner "-1.3e-7" @[-1.3e-7])
|
||||
(check-deep scanner "123A" nil)
|
||||
|
||||
# Recursive grammars
|
||||
|
||||
(def g '{:main (+ (* "a" :main "b") "c")})
|
||||
|
||||
(check-match g "c" true)
|
||||
(check-match g "acb" true)
|
||||
(check-match g "aacbb" true)
|
||||
(check-match g "aadbb" false)
|
||||
|
||||
# Back reference
|
||||
|
||||
(def wrapped-string
|
||||
~{:pad (any "=")
|
||||
:open (* "[" (<- :pad :n) "[")
|
||||
:close (* "]" (cmt (* (-> :n) (<- :pad)) ,=) "]")
|
||||
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||
|
||||
(check-match wrapped-string "[[]]" true)
|
||||
(check-match wrapped-string "[==[a]==]" true)
|
||||
(check-match wrapped-string "[==[]===]" false)
|
||||
(check-match wrapped-string "[[blark]]" true)
|
||||
(check-match wrapped-string "[[bl[ark]]" true)
|
||||
(check-match wrapped-string "[[bl]rk]]" true)
|
||||
(check-match wrapped-string "[[bl]rk]] " false)
|
||||
(check-match wrapped-string "[=[bl]]rk]=] " false)
|
||||
(check-match wrapped-string "[=[bl]==]rk]=] " false)
|
||||
(check-match wrapped-string "[===[]==]===]" true)
|
||||
|
||||
(def janet-longstring
|
||||
~{:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) (<- (backmatch :n))) ,=)
|
||||
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||
|
||||
(check-match janet-longstring "`john" false)
|
||||
(check-match janet-longstring "abc" false)
|
||||
(check-match janet-longstring "` `" true)
|
||||
(check-match janet-longstring "` `" true)
|
||||
(check-match janet-longstring "`` ``" true)
|
||||
(check-match janet-longstring "``` `` ```" true)
|
||||
(check-match janet-longstring "`` ```" false)
|
||||
(check-match janet-longstring "`a``b`" false)
|
||||
|
||||
# Line and column capture
|
||||
|
||||
(def line-col (peg/compile '(any (* (line) (column) 1))))
|
||||
(check-deep line-col "abcd" @[1 1 1 2 1 3 1 4])
|
||||
(check-deep line-col "" @[])
|
||||
(check-deep line-col "abcd\n" @[1 1 1 2 1 3 1 4 1 5])
|
||||
(check-deep line-col "abcd\nz" @[1 1 1 2 1 3 1 4 1 5 2 1])
|
||||
|
||||
# Backmatch
|
||||
|
||||
(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
|
||||
|
||||
(check-match backmatcher-1 "y" true)
|
||||
(check-match backmatcher-1 "xyx" true)
|
||||
(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-1 "xyxx" false)
|
||||
(check-match backmatcher-1 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
||||
|
||||
(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
|
||||
|
||||
(check-match backmatcher-2 "y" true)
|
||||
(check-match backmatcher-2 "xyx" true)
|
||||
(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-2 "xyxx" false)
|
||||
(check-match backmatcher-2 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
||||
|
||||
(def longstring-2 '(* '(some "`") (some (if-not (backmatch) 1)) (backmatch) -1))
|
||||
|
||||
(check-match longstring-2 "`john" false)
|
||||
(check-match longstring-2 "abc" false)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "`` ``" true)
|
||||
(check-match longstring-2 "``` `` ```" true)
|
||||
(check-match longstring-2 "`` ```" false)
|
||||
|
||||
# Optional
|
||||
|
||||
(check-match '(* (opt "hi") -1) "" true)
|
||||
(check-match '(* (opt "hi") -1) "hi" true)
|
||||
(check-match '(* (opt "hi") -1) "no" false)
|
||||
(check-match '(* (? "hi") -1) "" true)
|
||||
(check-match '(* (? "hi") -1) "hi" true)
|
||||
(check-match '(* (? "hi") -1) "no" false)
|
||||
|
||||
# Drop
|
||||
|
||||
(check-deep '(drop '"hello") "hello" @[])
|
||||
(check-deep '(drop "hello") "hello" @[])
|
||||
|
||||
# Regression #24
|
||||
|
||||
(def t (put @{} :hi 1))
|
||||
(assert (deep= t @{:hi 1}) "regression #24")
|
||||
|
||||
# Peg swallowing errors
|
||||
(assert (try (peg/match ~(/ '1 ,(fn [x] (nil x))) "x") ([err] err))
|
||||
"errors should not be swallowed")
|
||||
(assert (try ((fn [x] (nil x))) ([err] err))
|
||||
"errors should not be swallowed 2")
|
||||
|
||||
# Tuple types
|
||||
|
||||
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
||||
(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
|
||||
(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
|
||||
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
|
||||
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
|
||||
|
||||
# Check for bad memoization (+ :a) should mean different things in different contexts.
|
||||
(def redef-a
|
||||
~{:a "abc"
|
||||
:c (+ :a)
|
||||
:main (* :c {:a "def" :main (+ :a)} -1)})
|
||||
|
||||
(check-match redef-a "abcdef" true)
|
||||
(check-match redef-a "abcabc" false)
|
||||
(check-match redef-a "defdef" false)
|
||||
|
||||
(def redef-b
|
||||
~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
|
||||
:main :pork})
|
||||
|
||||
(check-match redef-b "abeef" true)
|
||||
(check-match redef-b "aabeef" false)
|
||||
(check-match redef-b "aaaaaa" false)
|
||||
|
||||
# Integer parsing
|
||||
|
||||
(check-deep '(int 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint 1) "a" @[(chr "a")])
|
||||
(check-deep '(int-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(uint-be 1) "a" @[(chr "a")])
|
||||
(check-deep '(int 1) "\xFF" @[-1])
|
||||
(check-deep '(uint 1) "\xFF" @[255])
|
||||
(check-deep '(int-be 1) "\xFF" @[-1])
|
||||
(check-deep '(uint-be 1) "\xFF" @[255])
|
||||
(check-deep '(int 2) "\xFF\x7f" @[0x7fff])
|
||||
(check-deep '(int-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 2) "\xff\x7f" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint-be 2) "\x7f\xff" @[0x7fff])
|
||||
(check-deep '(uint 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 8) "\xff\x7f\x00\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
(check-deep '(uint 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/u64 0x7fff)])
|
||||
(check-deep '(int 7) "\xff\x7f\x00\x00\x00\x00\x00" @[(int/s64 0x7fff)])
|
||||
|
||||
(check-deep '(* (int 2) -1) "123" nil)
|
||||
|
||||
# to/thru bug
|
||||
(check-deep '(to -1) "aaaa" @[])
|
||||
(check-deep '(thru -1) "aaaa" @[])
|
||||
(check-deep ''(to -1) "aaaa" @["aaaa"])
|
||||
(check-deep ''(thru -1) "aaaa" @["aaaa"])
|
||||
(check-deep '(to "b") "aaaa" nil)
|
||||
(check-deep '(thru "b") "aaaa" nil)
|
||||
|
||||
# unref
|
||||
(def grammar
|
||||
(peg/compile
|
||||
~{:main (* :tagged -1)
|
||||
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
|
||||
:open-tag (* (constant :tag) "<" (capture :w+ :tag-name) ">")
|
||||
:value (* (constant :value) (group (any (+ :tagged :untagged))))
|
||||
:close-tag (* "</" (backmatch :tag-name) ">")
|
||||
:untagged (capture (any (if-not "<" 1)))}))
|
||||
(check-deep grammar "<p><em>foobar</em></p>" @[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
|
||||
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
|
||||
(end-suite)
|
||||
@@ -1,86 +0,0 @@
|
||||
# Copyright (c) 2023 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.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 4)
|
||||
# some tests for string/format and buffer/format
|
||||
|
||||
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142") "%6.3f")
|
||||
(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142") "%6.3f")
|
||||
(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi)) "pi = 3.141592653589793116") "%6.3f")
|
||||
|
||||
(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 = 3.142") "UTF-8")
|
||||
(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927") "π")
|
||||
(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi)) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||
|
||||
(assert (= (string/format "pi = %6.3f" math/pi) "pi = 3.142") "%6.3f")
|
||||
(assert (= (string/format "pi = %+6.3f" math/pi) "pi = +3.142") "%6.3f")
|
||||
(assert (= (string/format "pi = %40.20g" math/pi) "pi = 3.141592653589793116") "%6.3f")
|
||||
|
||||
(assert (= (string/format "🐼 = %6.3f" math/pi) "🐼 = 3.142") "UTF-8")
|
||||
(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
|
||||
(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||
|
||||
# Range
|
||||
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
|
||||
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
|
||||
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
|
||||
|
||||
# More marshalling code
|
||||
|
||||
(defn check-image
|
||||
"Run a marshaling test using the make-image and load-image functions."
|
||||
[x msg]
|
||||
(def im (make-image x))
|
||||
# (printf "\nimage-hash: %d" (-> im string hash))
|
||||
(assert-no-error msg (load-image im)))
|
||||
|
||||
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||
(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
|
||||
|
||||
(def issue-53-x
|
||||
(fiber/new
|
||||
(fn []
|
||||
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||
|
||||
(check-image issue-53-x "issue 53 regression")
|
||||
|
||||
# Bracket tuple issue
|
||||
|
||||
(def do 3)
|
||||
(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms")
|
||||
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||
|
||||
# Metadata
|
||||
|
||||
(def foo-with-tags :a-tag :bar)
|
||||
(assert (get (dyn 'foo-with-tags) :a-tag) "extra keywords in def are metadata tags")
|
||||
|
||||
(def foo-with-meta {:baz :quux} :bar)
|
||||
(assert (= :quux (get (dyn 'foo-with-meta) :baz)) "extra struct in def is metadata")
|
||||
|
||||
(defn foo-fn-with-meta {:baz :quux} "This is a function" [x] (identity x))
|
||||
(assert (= :quux (get (dyn 'foo-fn-with-meta) :baz)) "extra struct in defn is metadata")
|
||||
(assert (= "(foo-fn-with-meta x)\n\nThis is a function" (get (dyn 'foo-fn-with-meta) :doc)) "extra string in defn is docstring")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user