1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-28 22:27:41 +00:00

Compare commits

..

122 Commits

Author SHA1 Message Date
Calvin Rose
0d9e999113 Prepare for 1.35.0 release. 2024-06-15 07:11:48 -05:00
Calvin Rose
75710ccabd Error on buffer/push-uint16 with non 16 bit unsigned integer. 2024-06-15 06:47:47 -05:00
Calvin Rose
0f60115f27 Merge pull request #1457 from pnelson/buffer-push-uint
Fix buffer push uint max
2024-06-15 06:31:46 -05:00
Philip Nelson
16a3c85baa Fix buffer push uint max 2024-06-14 18:15:31 -07:00
Calvin Rose
92ff1d3be4 Add only option to merge-module and import.
This allows importing only selected bindings.

For example,

    (import foo :only [bar baz])

    (foo/bar) # works
    (foo/buzz) # doesn't work, even if the foo module has a buzz
    function.
2024-06-14 17:01:27 -05:00
Calvin Rose
58441dc49f Update gitignore. 2024-06-12 19:22:08 -05:00
Calvin Rose
dbc5d688e2 Merge branch 'master' into bundle-tools 2024-06-12 18:28:23 -05:00
Calvin Rose
e2a8951f68 Address #1452 - Partial revert some changes from #1391
This doesn't seem to reintroduce the original issue. There was
definitely some interplay with #1431

Doing git bisect landed me at commit
2f0c789ea1 as the first bad commit for
issue #1452.
2024-06-07 10:32:20 -05:00
Calvin Rose
f0f03ad519 Delete dead code. 2024-06-04 21:11:08 -05:00
Calvin Rose
e37575e763 Allow passing configs to bundle reinstall. 2024-05-31 19:20:34 -05:00
Calvin Rose
f4fd481415 copyfile should copy permission bits 2024-05-29 19:37:14 -05:00
Calvin Rose
8fca6b7af4 Don't expose bundle/pack, do expose bundle/add
Bundle/pack is a strange interface that is mostly just
to implement a safe reinistall process when the original source
is lost.
2024-05-29 07:20:37 -05:00
Calvin Rose
600e822933 Change interface for bundle/install
Name argument should be inferred in most cases. Also use :name
instead of :bundle-name in most places to be terser and simpler.
2024-05-26 16:26:08 -05:00
Calvin Rose
2028ac8a20 Merge branch 'master' into bundle-tools 2024-05-26 14:34:05 -05:00
Calvin Rose
7bae7d9efd Merge changes from bundle-tools branch:
- Update file IO to explicitly use 64bit ftell/fseek
- Add env argument to eval
- Allow naming function literals with keywords.
2024-05-26 12:04:35 -05:00
Calvin Rose
cb54fb02c1 Whitespace. 2024-05-26 12:01:27 -05:00
Calvin Rose
7529abb542 Move functions in boot.janet around. 2024-05-26 11:54:21 -05:00
Calvin Rose
16ac681ed9 Remove redundant stuff from stacktrace.
Rather than try and make ascii art, focus on whether information
is present in the stack trace that peoplpe actually need, and be terse.

Tools can better handler simpler and more stable interfaces.
2024-05-26 11:39:08 -05:00
Calvin Rose
74560ff805 Turn off cluttered traces. 2024-05-26 11:30:59 -05:00
Calvin Rose
fe348187cc Be explicit about 64 bit offset on windows. 2024-05-26 11:26:12 -05:00
Calvin Rose
fd5315793c Test feature flag 2024-05-26 11:16:31 -05:00
Calvin Rose
87db463f4e Shouldn't make a difference... 2024-05-26 11:07:23 -05:00
Calvin Rose
1225cd31c8 Assert that prime-bunlde-paths is working. 2024-05-26 10:54:00 -05:00
Calvin Rose
6998865d7b Mingw is a sepate os/which target than windows. 2024-05-26 10:41:12 -05:00
Calvin Rose
b8aec50763 Something is up with code. 2024-05-26 10:35:53 -05:00
Calvin Rose
7efb39d608 Check bundle listing before reinstall. 2024-05-26 10:28:19 -05:00
Calvin Rose
f7c90bc1ff Add testing for making and removing directory. 2024-05-26 10:21:52 -05:00
Calvin Rose
aee077c1bd Is qemu-arm buggy? 2024-05-26 09:53:04 -05:00
Calvin Rose
6968275ddf Update rmrf again to be more strict and failure early 2024-05-26 09:40:18 -05:00
Calvin Rose
074ae4fc0d When directory isn't empty, print what is in it. 2024-05-26 09:31:26 -05:00
Calvin Rose
6cd35ed9c8 Try and be OS sensitive when using path separators. 2024-05-26 09:28:56 -05:00
Calvin Rose
7911e74222 Use lstat instead of stat 2024-05-26 09:11:24 -05:00
Calvin Rose
2fafe2b5d1 Make rmrf stronger. 2024-05-26 09:09:04 -05:00
Calvin Rose
de977819ce Add some tracing. 2024-05-26 09:03:01 -05:00
Calvin Rose
1844beecc3 More work on improving stacktraces slightly.
Add extra information about when we change fibers. The janet
stack is really a spaghetti stack, where each fiber represents
a group of stack frames as well as a place where we can longjmp to. It
is therefor useful information for the programmer to know where each
stack frame is.

However, an argument could be made that this clutters the stackframe
and is more of a hindrance than a help.
2024-05-26 08:45:38 -05:00
Calvin Rose
cb529bbd63 Pass on linux. 2024-05-25 16:48:27 -05:00
Calvin Rose
25990867e2 Missing ) 2024-05-25 16:46:04 -05:00
Calvin Rose
4fbc71c70d Just don't do backslashes. 2024-05-25 16:43:51 -05:00
Calvin Rose
eb21d4fff4 Allow using keywords as names for anonymous functions.
This allows for better stack traces in macros and generally
easier debugging.
2024-05-25 16:36:08 -05:00
Calvin Rose
6d5fc1d743 Even more verbose 2024-05-25 16:15:58 -05:00
Calvin Rose
e88042b2fa Pick default bundle name better. 2024-05-25 16:09:49 -05:00
Calvin Rose
750b448f75 typo doing previous CI trigger. 2024-05-25 16:02:23 -05:00
Calvin Rose
14d1dc8749 Pathing is not quite working... 2024-05-25 16:00:43 -05:00
Calvin Rose
8e0340252b Add verbose errors to ci 2024-05-25 15:50:51 -05:00
Calvin Rose
641a16c133 Add suite-bundle to meson test list. 2024-05-25 15:42:28 -05:00
Calvin Rose
533d78bffe Merge branch 'master' into bundle-tools 2024-05-25 13:24:42 -05:00
Calvin Rose
ae2c5820a1 Fix janet_strerror when _GNU_SOURCE defined. 2024-05-25 13:24:01 -05:00
Calvin Rose
8334504f4e More work on fixing bunlde tools install. 2024-05-25 13:23:11 -05:00
Calvin Rose
2260a593bd Add some test usage for the sample bundle. 2024-05-25 12:57:09 -05:00
Calvin Rose
7d8af2f99a Add some testing to the bundle/ module. 2024-05-25 12:44:49 -05:00
Calvin Rose
46bdcece4d Add some better logging when pruning bundles. 2024-05-25 10:56:40 -05:00
Calvin Rose
7387a1d91e Add bundle/prune and support for :auto-remove.
This allows dependencies to be marked such that they are not
primary dependencies installed by the users - rather, they are
dependencies of dependencies. This distinction is important when
a user installs a package that itself has dependencies.

This also interacts with new features to prevent a user from breaking
their installation by installing needed packages or
installing/uninstalling bundles out of order.
2024-05-25 10:48:26 -05:00
Calvin Rose
ae4b8078df Merge branch 'master' into bundle-tools 2024-05-25 09:26:25 -05:00
Calvin Rose
60e0c8ea92 Ignore gcov 2024-05-25 09:25:27 -05:00
Calvin Rose
7d3acc0ed6 Get rid of "extended locale" support.
While useful on some platforms, behavior seems to be different across
the board, making use difficult.
2024-05-19 18:01:20 -05:00
Calvin Rose
2637b33957 Include locale.h and xlocale.h on some platforms. 2024-05-19 17:40:39 -05:00
Calvin Rose
58ccb66659 Move janet_buffer_dtostr 2024-05-19 17:14:21 -05:00
Calvin Rose
634429cf61 Merge branch 'locales' 2024-05-19 17:05:49 -05:00
Calvin Rose
6ac65e603d Merge branch 'master' into bundle-tools 2024-05-19 15:52:25 -05:00
Calvin Rose
03166a745a Disallow nan and inf in jdn. 2024-05-19 13:25:25 -05:00
Calvin Rose
4d61ba20ce Fix -Werror=calloc-transposed-args 2024-05-19 09:55:39 -05:00
Calvin Rose
751ff677fe Merge branch 'master' into bundle-tools 2024-05-19 09:53:14 -05:00
Calvin Rose
ace60e1898 Add ev/with-*lock macros. 2024-05-18 17:55:47 -05:00
Calvin Rose
876b7f106f OpenBSD does not work with LC_*_MASK stuff. 2024-05-18 17:22:10 -05:00
Calvin Rose
809b6589a1 Put limits.h back. 2024-05-18 15:31:23 -05:00
Calvin Rose
02f53ca014 Formatting. 2024-05-18 15:21:37 -05:00
Calvin Rose
0b03ddb21b More work on setting locale for extended locale support. 2024-05-18 15:20:22 -05:00
Calvin Rose
ea5d4fd3af JANET_BSD not defined on apple. 2024-05-18 14:24:51 -05:00
Calvin Rose
e6b73f8cd1 BSD, use xlocale for thread safe functionality 2024-05-18 14:11:05 -05:00
Calvin Rose
af232ef729 windows needs a distinct implementation from posix for thread safety.
I must say, the windows solution is a lot simpler.
2024-05-18 14:02:20 -05:00
Calvin Rose
2e2f8abfc0 Work on add locales.
Need to be careful not to mess with %j formatter, or
in some other places.
2024-05-18 13:23:33 -05:00
Calvin Rose
91a583db27 Merge pull request #1448 from znley/master
Add LoongArch64 support
2024-05-18 06:33:07 -05:00
Calvin Rose
dc5cc630ff Keep track of hooks and simple dependency tracking.
Refuse to install bundle unless dependencies are present.
Dependencies can be found for a bundle pre-install
by looking in ./bundle/info.jdn
2024-05-18 06:24:39 -05:00
znley
c1647a74c5 Add LoongArch64 support 2024-05-18 07:18:59 +00:00
Calvin Rose
721f280966 Add with-env. 2024-05-16 21:52:49 -05:00
Calvin Rose
258ebb9145 Merge branch 'master' into bundle-tools 2024-05-16 21:39:41 -05:00
Calvin Rose
e914eaf055 Update CHANGELOG.md 2024-05-16 21:37:08 -05:00
Calvin Rose
fe54013679 Update naming *module-make-env* for #1447 2024-05-16 19:11:25 -05:00
Calvin Rose
fdaf2e1594 Add *module/make-env* 2024-05-16 19:10:30 -05:00
Calvin Rose
f0092ef69b Add module/*make-env* 2024-05-16 19:06:07 -05:00
Calvin Rose
a88ae7e1d9 Merge branch 'master' into bundle-tools 2024-05-15 20:41:58 -05:00
Calvin Rose
9946f3bdf4 Add buffer/format-at
Move changes over from bundle-tools branch and add testing.
2024-05-15 20:16:42 -05:00
Calvin Rose
c747e8d16c Address some compiler linter messages on openbsd 2024-05-15 18:20:20 -05:00
Calvin Rose
3e402d397e Use older openbsd build for CI. 2024-05-15 18:16:19 -05:00
Calvin Rose
0350834cd3 By default, require and import extend current env. 2024-05-15 07:40:21 -05:00
Calvin Rose
980981c9ee Print message if no hook found, but looked for 2024-05-15 07:30:29 -05:00
Calvin Rose
3c8346f24e Install to bundle/ instead of _bundles/ 2024-05-14 20:51:29 -05:00
Calvin Rose
42bd27c24b Use a single janet file for hooks.. 2024-05-14 16:45:27 -05:00
Calvin Rose
4a0f67f3bd Update copyright. 2024-05-13 21:35:55 -05:00
Calvin Rose
09b6fc4670 Change storage locations for bundles.
Organize metadata a bit more cleanly under .bundles/<bundle-name>/
2024-05-13 20:59:06 -05:00
Calvin Rose
4d9bcd6bcc Add is-backup option to bundle/pack.
We don't always to keep the old manifest and hooks.
2024-05-13 19:42:44 -05:00
Calvin Rose
cd34b89977 Rename bundle/backup to bundle/pack. 2024-05-13 19:38:14 -05:00
Calvin Rose
3151fa3988 Don't expose bundle/do-hook.
This is really an internal detail - rather than users writing
custom hooks, custom functionality should just be normal janet scripts.
2024-05-13 18:45:43 -05:00
Calvin Rose
5e58110e19 Add copyfile for copying large files. 2024-05-13 18:39:45 -05:00
Calvin Rose
e1cdd0f8cc Update CHANGELOG.md 2024-05-13 12:47:46 -05:00
Calvin Rose
1f39a0f180 Add bundle/backup and buffer/format-at
bundle/backup is needed to make failed reinstalls able to rollback. It
also allows python wheel like functionality, where bundles can be build
on one machine, packaged, and then distributed and installed on other
compatible machines without compilers.

buffer/format-at is to buffer/format as buffer/push-at is to
buffer/push. It allows us to format in the middle of an existing
buffer. Prior, to do this operation and extra buffer creating was
required.
2024-05-13 12:06:17 -05:00
Calvin Rose
367c4b14f5 Sync manifest on error so that we uninstall the correct files.
If we cannot create files during install, we want to be able
to do a correct rollback.
2024-05-12 15:08:27 -05:00
Calvin Rose
9c437796d3 Add first versions of bundle/* module
The bundle module contains tools for modifying the contents of
(dyn *syspath*) and providing a common interface for installing
packages (called "bundles").

The functions are:

* bundle/install
* bundle/uninstall
* bundle/manifest
* bundle/do-hook
* bundle/list
* bundle/add-file
* bundle/add-directory

A bundle is a directory that contains any number of source files and
other extra files, as well as a directory "hooks/", which contains a
flat listing of janet scripts. This version of the bundle module is not
responsible for building C source modules or for downloading files over
the network.
2024-05-12 14:42:05 -05:00
Calvin Rose
60e22d9703 Merge pull request #1445 from wishdev/defbind-alias
Add ffi/defbind-alias
2024-05-11 14:25:03 -05:00
John W Higgins
ee7362e847 Add ffi/defbind-alias 2024-05-09 21:31:22 -07:00
Calvin Rose
369f96b80e Update README to prefer Zulip. 2024-05-03 07:51:35 -05:00
Calvin Rose
7c5ed04ab1 A few minor improvements.
- Add long-form CLI options
- Update changelog.
- Use snprintf instead of sprintf for linters.
2024-05-02 09:13:29 -05:00
Calvin Rose
4779a445e0 Fix BSD/Macos issue for #1431 2024-04-26 19:32:47 -05:00
Calvin Rose
f0f1b7ce9e Address #1431 - level-trigger mode for net/accept-loop
In the edge-trigger mode before this change, if a socket
receives 2 connections before one can be handled, then only a single
connection is handle and 1 connection will never be handled in some
cases. Reverting to level-trigger mode makes this impossible.
2024-04-26 19:28:20 -05:00
Calvin Rose
7c9157a0ed Remove unneeded string functions. 2024-04-26 18:11:10 -05:00
Calvin Rose
522a6cb435 Merge pull request #1440 from ahgamut/cosmo-build
Build janet with Cosmopolitan Libc
2024-04-21 08:06:51 -05:00
Gautham
d0d551d739 remove superconfigure recipe 2024-04-21 01:16:54 -05:00
Gautham
71a123fef7 apelink 2024-04-21 01:14:58 -05:00
Gautham
3f40c8d7fb fix typo 2024-04-21 01:12:59 -05:00
Gautham
983c2e5499 simplify build to use only cosmocc 2024-04-21 01:10:06 -05:00
Gautham
eebb4c3ade remove logging 2024-04-20 22:35:04 -05:00
Gautham
50425eac72 typo 2024-04-20 22:23:29 -05:00
Gautham
382ff77bbe typo 2024-04-20 22:16:23 -05:00
Gautham
bf680fb5d3 simplify janet APE build 2024-04-20 22:09:10 -05:00
Gautham
4ed7db4f91 simplify naming 2024-04-19 10:56:46 -05:00
Calvin Rose
bf19920d65 Improve casting. 2024-04-18 03:29:45 -05:00
Gautham
174b5f6686 missing folder 2024-04-16 22:24:31 -05:00
Gautham
4173645b81 missing folder 2024-04-16 22:23:12 -05:00
Gautham
af511f1f55 patch folder location 2024-04-16 22:15:54 -05:00
Gautham
83c6080380 yml config for building with Cosmopolitan Libc 2024-04-16 22:02:31 -05:00
Calvin Rose
2f0c789ea1 More work to address #1391
Properly set read_fiber and write_fiber to NULL when unused.
This was causing extra listening in the poll implemenation leading to
busy loops where a read was accidentally listening for POLLOUT.
2024-04-15 21:32:17 -05:00
Calvin Rose
a9b8f8e8a9 Address #1391 - set fd to negative value if not used.
See https://groups.google.com/g/comp.unix.programmer/c/bNNadBIEpTo/m/G5gs1mqNhbIJ?pli=1 for a conversation and workaround.
2024-04-15 18:12:42 -05:00
48 changed files with 1238 additions and 292 deletions

View File

@@ -1,4 +1,4 @@
image: openbsd/latest
image: openbsd/7.4
sources:
- https://git.sr.ht/~bakpakin/janet
packages:

38
.github/cosmo/build vendored Normal file
View File

@@ -0,0 +1,38 @@
#!/bin/sh
set -eux
COSMO_DIR="/sc/cosmocc"
# build x86_64
X86_64_CC="/sc/cosmocc/bin/x86_64-unknown-cosmo-cc"
X86_64_AR="/sc/cosmocc/bin/x86_64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/x86_64
make -j CC="$X86_64_CC" AR="$X86_64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/x86_64/janet
make clean
# build aarch64
AARCH64_CC="/sc/cosmocc/bin/aarch64-unknown-cosmo-cc"
AARCH64_AR="/sc/cosmocc/bin/aarch64-unknown-cosmo-ar"
mkdir -p /sc/cosmocc/aarch64
make -j CC="$AARCH64_CC" AR="$AARCH64_AR" HAS_SHARED=0 JANET_NO_AMALG=1
cp build/janet /sc/cosmocc/aarch64/janet
make clean
# fat binary
apefat () {
OUTPUT="$1"
OLDNAME_X86_64="$(basename -- "$2")"
OLDNAME_AARCH64="$(basename -- "$3")"
TARG_FOLD="$(dirname "$OUTPUT")"
"$COSMO_DIR/bin/apelink" -l "$COSMO_DIR/bin/ape-x86_64.elf" \
-l "$COSMO_DIR/bin/ape-aarch64.elf" \
-M "$COSMO_DIR/bin/ape-m1.c" \
-o "$OUTPUT" \
"$2" \
"$3"
cp "$2" "$TARG_FOLD/$OLDNAME_X86_64.x86_64"
cp "$3" "$TARG_FOLD/$OLDNAME_AARCH64.aarch64"
}
apefat /sc/cosmocc/janet.com /sc/cosmocc/x86_64/janet /sc/cosmocc/aarch64/janet

21
.github/cosmo/setup vendored Normal file
View File

@@ -0,0 +1,21 @@
#!/bin/sh
set -e
sudo apt update
sudo apt-get install -y ca-certificates libssl-dev\
qemu qemu-utils qemu-user-static\
texinfo groff\
cmake ninja-build bison zip\
pkg-config build-essential autoconf re2c
# download cosmocc
cd /sc
wget https://github.com/jart/cosmopolitan/releases/download/3.3.3/cosmocc-3.3.3.zip
mkdir -p cosmocc
cd cosmocc
unzip ../cosmocc-3.3.3.zip
# register
cd /sc/cosmocc
sudo cp ./bin/ape-x86_64.elf /usr/bin/ape
sudo sh -c "echo ':APE:M::MZqFpD::/usr/bin/ape:' >/proc/sys/fs/binfmt_misc/register"

View File

@@ -60,3 +60,30 @@ jobs:
./dist/*.zip
./*.zip
./*.msi
release-cosmo:
permissions:
contents: write # for softprops/action-gh-release to create GitHub release
name: Build release binaries for Cosmo
runs-on: ubuntu-latest
steps:
- name: Checkout the repository
uses: actions/checkout@master
- name: create build folder
run: |
sudo mkdir -p /sc
sudo chmod -R 0777 /sc
- name: setup Cosmopolitan Libc
run: bash ./.github/cosmo/setup
- name: Set the version
run: echo "version=${GITHUB_REF/refs\/tags\//}" >> $GITHUB_ENV
- name: Set the platform
run: echo "platform=cosmo" >> $GITHUB_ENV
- name: build Janet APE binary
run: bash ./.github/cosmo/build
- name: push binary to github
uses: softprops/action-gh-release@v1
with:
draft: true
files: |
/sc/cosmocc/janet.com

View File

@@ -73,7 +73,7 @@ jobs:
- name: Compile the project
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
run: make test UNAME=MINGW RUN=wine VERBOSE=1
test-arm-linux:
name: Build and test ARM32 cross compilation
@@ -88,4 +88,4 @@ jobs:
- 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
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1

8
.gitignore vendored
View File

@@ -48,6 +48,8 @@ janet.wasm
# Generated files
*.gen.h
*.gen.c
*.tmp
temp.*
# Generate test files
*.out
@@ -126,6 +128,9 @@ vgcore.*
*.idb
*.pdb
# GGov
*.gcov
# Kernel Module Compile Results
*.mod*
*.cmd
@@ -134,6 +139,9 @@ Module.symvers
Mkfile.old
dkms.conf
# Coverage files
*.cov
# End of https://www.gitignore.io/api/c
# Created by https://www.gitignore.io/api/cmake

View File

@@ -1,6 +1,20 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.35.0 - 2024-06-15
- Add `:only` argument to `import` to allow for easier control over imported bindings.
- Add extra optional `env` argument to `eval` and `eval-string`.
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
accidentally adding new bindings.
- Add `bundle/` module for managing packages within Janet. This should replace the jpm packaging
format eventually and is much simpler and amenable to more complicated builds.
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
- Add `with-env`
- Add *module-make-env* dynamic binding
- Add buffer/format-at
- Add long form command line options for readable CLI usage
- Fix bug with `net/accept-loop` that would sometimes miss connections.
## 1.34.0 - 2024-03-22
- Add a new (split) PEG special by @ianthehenry
- Add buffer/push-* sized int and float by @pnelson

View File

@@ -204,9 +204,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.34.dylib
SONAME=libjanet.1.35.dylib
else
SONAME=libjanet.so.1.34
SONAME=libjanet.so.1.35
endif
build/c/shell.c: src/mainclient/shell.c

View File

@@ -315,8 +315,7 @@ See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the w
## Discussion
Feel free to ask questions and join the discussion on the [Janet Gitter channel](https://gitter.im/janet-language/community).
Gitter provides Matrix and IRC bridges as well.
Feel free to ask questions and join the discussion on the [Janet Zulip Instance](https://janet.zulipchat.com/)
## FAQ

View File

@@ -55,6 +55,7 @@
(ffi/defbind sixints-fn six-ints [])
(ffi/defbind sixints-fn-2 :int [x :int s six-ints])
(ffi/defbind sixints-fn-3 :int [s six-ints x :int])
(ffi/defbind-alias int-fn int-fn-aliased :int [a :int b :int])
#
# Struct reading and writing
@@ -119,6 +120,7 @@
(tracev (return-struct 42))
(tracev (double-lots 1 2 3 4 5 6 700 800 9 10))
(tracev (struct-big 11 99.5))
(tracev (int-fn-aliased 10 20))
(assert (= [10 10 12 12] (split-ret-fn 10 12)))
(assert (= [12 12 10 10] (split-flip-ret-fn 10 12)))

View File

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

View File

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

View File

@@ -0,0 +1,7 @@
(import dep1)
(import dep2)
(defn myfn
[x]
(def y (dep2/function x))
(dep1/function y))

View File

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

View File

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

View File

@@ -0,0 +1,3 @@
(defn function
[x]
(+ x x))

View File

@@ -0,0 +1,3 @@
@{
:name "sample-dep2"
}

View File

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

View File

@@ -0,0 +1,3 @@
(defn function
[x]
(* x x))

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.34.0')
version : '1.35.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -249,6 +249,7 @@ test_files = [
'test/suite-asm.janet',
'test/suite-boot.janet',
'test/suite-buffer.janet',
'test/suite-bundle.janet',
'test/suite-capi.janet',
'test/suite-cfuns.janet',
'test/suite-compile.janet',

View File

@@ -1,5 +1,5 @@
# The core janet library
# Copyright 2023 © Calvin Rose
# Copyright 2024 © Calvin Rose
###
###
@@ -244,7 +244,7 @@
(let [[[err fib]] catch
f (gensym)
r (gensym)]
~(let [,f (,fiber/new (fn [] ,body) :ie)
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
,r (,resume ,f)]
(if (,= (,fiber/status ,f) :error)
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
@@ -256,7 +256,7 @@
error, and the second is the return value or error.`
[& body]
(let [f (gensym) r (gensym)]
~(let [,f (,fiber/new (fn [] ,;body) :ie)
~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
,r (,resume ,f)]
[(,not= :error (,fiber/status ,f)) ,r])))
@@ -313,7 +313,7 @@
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ti))
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
(def ,r (,resume ,f))
,form
(if (= (,fiber/status ,f) :dead)
@@ -326,7 +326,7 @@
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ti))
(def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
(def ,r (,resume ,f))
(if (= (,fiber/status ,f) :dead)
,r
@@ -338,7 +338,7 @@
[tag & body]
(with-syms [res target payload fib]
~(do
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
(def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0))
(def ,res (,resume ,fib))
(def [,target ,payload] ,res)
(if (,= ,tag ,target)
@@ -629,17 +629,17 @@
``Create a generator expression using the `loop` syntax. Returns a fiber
that yields all values inside the loop in order. See `loop` for details.``
[head & body]
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
(defmacro coro
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
[& body]
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
(tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
(defmacro fiber-fn
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
[flags & body]
(tuple fiber/new (tuple 'fn '[] ;body) flags))
(tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
(defn sum
"Returns the sum of xs. If xs is empty, returns 0."
@@ -688,7 +688,7 @@
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(aux 0))
(defmacro when-let
"Same as `(if-let bindings (do ;body))`."
@@ -702,11 +702,11 @@
(case (length functions)
0 nil
1 (in functions 0)
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
(let [[f g h i] functions]
(comp (fn [x] (f (g (h (i x)))))
(comp (fn :comp [x] (f (g (h (i x)))))
;(tuple/slice functions 4 -1)))))
(defn identity
@@ -717,7 +717,7 @@
(defn complement
"Returns a function that is the complement to the argument."
[f]
(fn [x] (not (f x))))
(fn :complement [x] (not (f x))))
(defmacro- do-extreme
[order args]
@@ -880,7 +880,7 @@
``Sorts `ind` in-place by calling a function `f` on each element and
comparing the result with `<`.``
[f ind]
(sort ind (fn [x y] (< (f x) (f y)))))
(sort ind (fn :sort-by-comp [x y] (< (f x) (f y)))))
(defn sorted
``Returns a new sorted array without modifying the old one.
@@ -893,7 +893,7 @@
``Returns a new sorted array that compares elements by invoking
a function `f` on each element and comparing the result with `<`.``
[f ind]
(sorted ind (fn [x y] (< (f x) (f y)))))
(sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y)))))
(defn reduce
``Reduce, also know as fold-left in many languages, transforms
@@ -1192,7 +1192,7 @@
``Returns the juxtaposition of functions. In other words,
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
[& funs]
(fn [& args]
(fn :juxt* [& args]
(def ret @[])
(each f funs
(array/push ret (f ;args)))
@@ -1205,7 +1205,7 @@
(def $args (gensym))
(each f funs
(array/push parts (tuple apply f $args)))
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
(defmacro defdyn
``Define an alias for a keyword that is used as a dynamic binding. The
@@ -1421,7 +1421,12 @@
(def dyn-forms
(seq [i :range [0 (length bindings) 2]]
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p)))
(defmacro with-env
`Run a block of code with a given environment table`
[env & body]
~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
(defmacro with-vars
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
@@ -1436,7 +1441,7 @@
(with-syms [ret f s]
~(do
,;saveold
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
(def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
(def ,ret (,resume ,f))
,;restoreold
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
@@ -1445,7 +1450,7 @@
"Partial function application."
[f & more]
(if (zero? (length more)) f
(fn [& r] (f ;more ;r))))
(fn :partial [& r] (f ;more ;r))))
(defn every?
``Evaluates to the last element of `ind` if all preceding elements are truthy,
@@ -1802,7 +1807,6 @@
(printf (dyn *pretty-format* "%q") x)
(flush))
(defn file/lines
"Return an iterator over the lines of a file."
[file]
@@ -2143,8 +2147,8 @@
(def ret
(case (type x)
:tuple (if (= (tuple/type x) :brackets)
(tuple/brackets ;(map recur x))
(dotup x))
(tuple/brackets ;(map recur x))
(dotup x))
:array (map recur x)
:struct (table/to-struct (dotable x recur))
:table (dotable x recur)
@@ -2325,7 +2329,7 @@
x)))
x))
(def expanded (macex arg on-binding))
(def name-splice (if name [name] []))
(def name-splice (if name [name] [:short-fn]))
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
@@ -2415,29 +2419,9 @@
col
": parse error: "
(:error p)
(if ec "\e[0m" ""))
(if ec "\e[0m"))
(eflush))
(defn- print-line-col
``Print the source code at a line, column in a source file. If unable to open
the file, prints nothing.``
[where line col]
(if-not line (break))
(unless (string? where) (break))
(when-with [f (file/open where :r)]
(def source-code (file/read f :all))
(var index 0)
(repeat (dec line)
(if-not index (break))
(set index (string/find "\n" source-code index))
(if index (++ index)))
(when index
(def line-end (string/find "\n" source-code index))
(eprint " " (string/slice source-code index line-end))
(when col
(+= index col)
(eprint (string/repeat " " (inc col)) "^")))))
(defn warn-compile
"Default handler for a compile warning."
[msg level where &opt line col]
@@ -2450,10 +2434,7 @@
":"
col
": compile warning (" level "): ")
(eprint msg)
(when ec
(print-line-col where line col)
(eprin "\e[0m"))
(eprint msg (if ec "\e[0m"))
(eflush))
(defn bad-compile
@@ -2470,10 +2451,7 @@
": compile error: ")
(if macrof
(debug/stacktrace macrof msg "")
(eprint msg))
(when ec
(print-line-col where line col)
(eprin "\e[0m"))
(eprint msg (if ec "\e[0m")))
(eflush))
(defn curenv
@@ -2542,7 +2520,7 @@
:read read
:expander expand} opts)
(default env (or (fiber/getenv (fiber/current)) @{}))
(default chunks (fn [buf p] (getline "" buf env)))
(default chunks (fn chunks [buf p] (getline "" buf env)))
(default onstatus debug/stacktrace)
(default on-compile-error bad-compile)
(default on-compile-warning warn-compile)
@@ -2677,8 +2655,8 @@
(defn eval
``Evaluates a form in the current environment. If more control over the
environment is needed, use `run-context`.``
[form]
(def res (compile form nil :eval))
[form &opt env]
(def res (compile form env :eval))
(if (= (type res) :function)
(res)
(error (get res :error))))
@@ -2717,9 +2695,9 @@
(defn eval-string
``Evaluates a string in the current environment. If more control over the
environment is needed, use `run-context`.``
[str]
[str &opt env]
(var ret nil)
(each x (parse-all str) (set ret (eval x)))
(each x (parse-all str) (set ret (eval x env)))
ret)
(def load-image-dict
@@ -2767,10 +2745,11 @@
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(defdyn *module/cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module/paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
(def module/cache
"A table, mapping loaded module identifiers to their environments."
@@ -2800,7 +2779,7 @@
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
```
[ext loader]
(def mp (dyn *module/paths* module/paths))
(def mp (dyn *module-paths* module/paths))
(defn- find-prefix
[pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
@@ -2818,7 +2797,7 @@
(module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module/cache* module/cache) path) path)) :preload check-not-relative])
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
# Version of fexists that works even with a reduced OS
(defn- fexists
@@ -2848,7 +2827,7 @@
```
[path]
(var ret nil)
(def mp (dyn *module/paths* module/paths))
(def mp (dyn *module-paths* module/paths))
(each [p mod-kind checker] mp
(when (mod-filter checker path)
(if (function? p)
@@ -2861,7 +2840,7 @@
(set ret [fullpath mod-kind])
(break))))))
(if ret ret
(let [expander (fn [[t _ chk]]
(let [expander (fn :expander [[t _ chk]]
(when (string? t)
(when (mod-filter chk path)
(module/expand-path path t))))
@@ -2928,7 +2907,7 @@
set to a truthy value."
[env &opt level is-repl]
(default level 1)
(fn [f x]
(fn :debugger [f x]
(def fs (fiber/status f))
(if (= :dead fs)
(when is-repl
@@ -2958,7 +2937,7 @@
:core/stream path
(file/open path :rb)))
(def path-is-file (= f path))
(default env (make-env))
(default env ((dyn *module-make-env* make-env)))
(def spath (string path))
(put env :source (or source (if-not path-is-file spath path)))
(var exit-error nil)
@@ -3018,14 +2997,14 @@
``A table of loading method names to loading functions.
This table lets `require` and `import` load many different kinds
of files as modules.``
@{:native (fn native-loader [path &] (native path (make-env)))
@{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env))))
:source (fn source-loader [path args]
(def ml (dyn *module/loading* module/loading))
(def ml (dyn *module-loading* module/loading))
(put ml path true)
(defer (put ml path nil)
(dofile path ;args)))
:preload (fn preload-loader [path & args]
(def mc (dyn *module/cache* module/cache))
(def mc (dyn *module-cache* module/cache))
(when-let [m (in mc path)]
(if (function? m)
(set (mc path) (m path ;args))
@@ -3036,9 +3015,9 @@
[path args kargs]
(def [fullpath mod-kind] (module/find path))
(unless fullpath (error mod-kind))
(def mc (dyn *module/cache* module/cache))
(def ml (dyn *module/loading* module/loading))
(def mls (dyn *module/loaders* module/loaders))
(def mc (dyn *module-cache* module/cache))
(def ml (dyn *module-loading* module/loading))
(def mls (dyn *module-loaders* module/loaders))
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
check
(if (ml fullpath)
@@ -3061,9 +3040,10 @@
``Merge a module source into the `target` environment with a `prefix`, as with the `import` macro.
This lets users emulate the behavior of `import` with a custom module table.
If `export` is truthy, then merged functions are not marked as private. Returns
the modified target environment.``
[target source &opt prefix export]
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private))]
the modified target environment. If an array `only` is passed, only merge keys in `only`.``
[target source &opt prefix export only]
(def only-set (if only (invert only)))
(loop [[k v] :pairs source :when (symbol? k) :when (not (v :private)) :when (or (not only) (in only-set k))]
(def newv (table/setproto @{:private (not export)} v))
(put target (symbol prefix k) newv))
target)
@@ -3076,13 +3056,14 @@
(def kargs (table ;args))
(def {:as as
:prefix prefix
:export ep} kargs)
:export ep
:only only} kargs)
(def newenv (require-1 path args kargs))
(def prefix (or
(and as (string as "/"))
prefix
(string (last (string/split "/" path)) "/")))
(merge-module env newenv prefix ep))
(merge-module env newenv prefix ep only))
(defmacro import
``Import a module. First requires the module, and then merges its
@@ -3136,6 +3117,7 @@
[&opt env local]
(env-walk keyword? env local))
(defdyn *doc-width*
"Width in columns to print documentation printed with `doc-format`.")
@@ -3444,9 +3426,9 @@
(defn- print-special-form-entry
[x]
(print "\n\n"
(string " special form\n\n")
(string " (" x " ...)\n\n")
(string " See https://janet-lang.org/docs/specials.html\n\n")))
" special form\n\n"
" (" x " ...)\n\n"
" See https://janet-lang.org/docs/specials.html\n\n"))
(defn doc*
"Get the documentation for a symbol in a given environment. Function form of `doc`."
@@ -3698,7 +3680,7 @@
[&opt chunks onsignal env parser read]
(default env (make-env))
(default chunks
(fn [buf p]
(fn :chunks [buf p]
(getline
(string
"repl:"
@@ -3729,23 +3711,47 @@
Returns a fiber that is scheduled to run the function.
```
[f & args]
(ev/go (fn _call [&] (f ;args))))
(ev/go (fn :call [&] (f ;args))))
(defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
[& body]
~(,ev/go (fn _spawn [&] ,;body)))
~(,ev/go (fn :spawn [&] ,;body)))
(defmacro ev/do-thread
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
evaluates to nil.``
[& body]
~(,ev/thread (fn _do-thread [&] ,;body)))
~(,ev/thread (fn :do-thread [&] ,;body)))
(defn- acquire-release
[acq rel lock body]
(def l (gensym))
~(do
(def ,l ,lock)
(,acq ,l)
(defer (,rel ,l)
,;body)))
(defmacro ev/with-lock
``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-lock ev/release-lock lock body))
(defmacro ev/with-rlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
(defmacro ev/with-wlock
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
[lock & body]
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
(defmacro ev/spawn-thread
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
[& body]
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
(defmacro ev/with-deadline
``
@@ -3794,7 +3800,7 @@
(def ,res @[])
,;(seq [[i body] :pairs bodies]
~(do
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
(,put ,fset ,ftemp ,ftemp)))
(,wait-for-fibers ,chan ,fset)
,res))))
@@ -3853,9 +3859,11 @@
:lazy lazy
:map-symbols map-symbols}))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
(defmacro ffi/defbind-alias
"Generate bindings for native functions in a convenient manner.
Similar to defbind but allows for the janet function name to be
different than the FFI function."
[name alias ret-type & body]
(def real-ret-type (eval ret-type))
(def meta (slice body 0 -2))
(def arg-pairs (partition 2 (last body)))
@@ -3872,10 +3880,15 @@
(defn make-ptr []
(assert (ffi/lookup (if lazy (llib) lib) raw-symbol) (string "failed to find ffi symbol " raw-symbol)))
(if lazy
~(defn ,name ,;meta [,;formal-args]
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,name ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
~(defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
###
###
@@ -3952,6 +3965,382 @@
(merge-into module/cache old-modcache)
nil)
###
###
### Bundle tools
###
###
(compwhen (dyn 'os/stat)
(def- seps {:windows "\\" :mingw "\\" :cygwin "\\"})
(defn- sep [] (get seps (os/which) "/"))
(defn- bundle-rpath
[path]
(os/realpath path))
(defn- bundle-dir
[&opt bundle-name]
(def s (sep))
(string (bundle-rpath (dyn *syspath*)) s "bundle" (if bundle-name s) bundle-name))
(defn- bundle-file
[bundle-name filename]
(def s (sep))
(string (bundle-rpath (dyn *syspath*)) s "bundle" s bundle-name s filename))
(defn- get-manifest-filename
[bundle-name]
(bundle-file bundle-name "manifest.jdn"))
(defn- prime-bundle-paths
[]
(def s (sep))
(def path (bundle-dir))
(os/mkdir path)
(assert (os/stat path :mode)))
(defn- get-files [manifest]
(def files (get manifest :files @[]))
(put manifest :files files)
files)
(defn- rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(def s (sep))
(each y (os/dir x)
(rmrf (string x s y)))
(os/rmdir x))
(os/rm x))
nil)
(defn- copyfile
[from to]
(def mode (os/stat from :permissions))
(def b (buffer/new 0x10000))
(with [ffrom (file/open from :rb)]
(with [fto (file/open to :wb)]
(forever
(file/read ffrom 0x10000 b)
(when (empty? b) (buffer/trim b) (os/chmod to mode) (break))
(file/write fto b)
(buffer/clear b)))))
(defn- copyrf
[from to]
(case (os/stat from :mode)
:file (copyfile from to)
:directory (do
(def s (sep))
(os/mkdir to)
(each y (os/dir from)
(copyrf (string from s y) (string to s y)))))
nil)
(defn- sync-manifest
[manifest]
(def bn (get manifest :name))
(def manifest-name (get-manifest-filename bn))
(spit manifest-name (string/format "%j\n" manifest)))
(defn bundle/manifest
"Get the manifest for a give installed bundle"
[bundle-name]
(def name (get-manifest-filename bundle-name))
(assert (fexists name) (string "no bundle " bundle-name " found"))
(parse (slurp name)))
(defn- get-bundle-module
[bundle-name]
(def manifest (bundle/manifest bundle-name))
(def dir (os/cwd))
(def workdir (get manifest :local-source "."))
(def fixed-syspath (bundle-rpath (dyn *syspath*)))
(try
(os/cd workdir)
([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
(defer (os/cd dir)
(def new-env (make-env (curenv)))
(put new-env *module-cache* @{})
(put new-env *module-loading* @{})
(put new-env *module-make-env* (fn make-bundle-env [&] (make-env new-env)))
(put new-env :workdir workdir)
(put new-env :name bundle-name)
(put new-env *syspath* fixed-syspath)
(with-env new-env
(put new-env :bundle-dir (bundle-dir bundle-name)) # get the syspath right
(require (string "@syspath/bundle/" bundle-name)))))
(defn- do-hook
[module bundle-name hook & args]
(def hookf (module/value module (symbol hook)))
(unless hookf (break))
(def manifest (bundle/manifest bundle-name))
(def dir (os/cwd))
(os/cd (get module :workdir "."))
(defer (os/cd dir)
(print "running hook " hook " for bundle " bundle-name)
(hookf ;args)))
(defn bundle/list
"Get a list of all installed bundles in lexical order."
[]
(def d (bundle-dir))
(if (os/stat d :mode)
(sort (os/dir d))
@[]))
(defn- bundle-uninstall-unchecked
[bundle-name]
(def man (bundle/manifest bundle-name))
(def all-hooks (get man :hooks @[]))
(when (index-of :uninstall all-hooks)
(def module (get-bundle-module bundle-name))
(do-hook module bundle-name :uninstall man))
(def files (get man :files []))
(each file (reverse files)
(print "remove " file)
(case (os/stat file :mode)
:file (os/rm file)
:directory (os/rmdir file)))
(rmrf (bundle-dir bundle-name))
nil)
(defn bundle/uninstall
"Remove a bundle from the current syspath"
[bundle-name]
(def breakage @{})
(each b (bundle/list)
(unless (= b bundle-name)
(def m (bundle/manifest b))
(def deps (get m :dependencies []))
(each d deps
(if (= d bundle-name) (put breakage b true)))))
(when (next breakage)
(def breakage-list (sorted (keys breakage)))
(errorf "cannot uninstall %s, breaks dependent bundles %n" bundle-name breakage-list))
(bundle-uninstall-unchecked bundle-name))
(defn bundle/topolist
"Get topological order of all bundles, such that each bundle is listed after its dependencies."
[]
(def visited @{})
(def cycle-detect @{})
(def order @[])
(def stack @[])
(defn visit
[b]
(array/push stack b)
(if (get visited b) (break))
(if (get cycle-detect b) (errorf "cycle detected in bundle dependencies: %s" (string/join stack " -> ")))
(put cycle-detect b true)
(each d (get (bundle/manifest b) :dependencies []) (visit d))
(put cycle-detect b nil)
(put visited b true)
(array/pop stack)
(array/push order b))
(each b (bundle/list) (visit b))
order)
(defn bundle/prune
"Remove all orphaned bundles from the syspath. An orphaned bundle is a bundle that is
marked for :auto-remove and is not depended on by any other bundle."
[]
(def topo (bundle/topolist))
(def rtopo (reverse topo))
# Check which auto-remove packages can be dropped
# Iterate in (reverse) topological order, and if we see an auto-remove package and have not already seen
# something that depends on it, then it is a root package and can be pruned.
(def exempt @{})
(def to-drop @[])
(each b rtopo
(def m (bundle/manifest b))
(if (or (get exempt b) (not (get m :auto-remove)))
(do
(put exempt b true)
(each d (get m :dependencies []) (put exempt d true)))
(array/push to-drop b)))
(print "pruning " (length to-drop) " bundles")
(each b to-drop
(print "uninstall " b))
(each b to-drop
(print "uninstalling " b)
(bundle-uninstall-unchecked b)))
(defn bundle/installed?
"Check if a bundle is installed."
[bundle-name]
(not (not (os/stat (bundle-dir bundle-name) :mode))))
(defn bundle/install
"Install a bundle from the local filesystem with a name `bundle-name`."
[path &keys config]
(def path (bundle-rpath path))
(def clean (get config :clean))
(def check (get config :check))
(def s (sep))
# Check meta file for dependencies and default name
(def infofile-pre (string path s "bundle" s "info.jdn"))
(var default-bundle-name nil)
(when (os/stat infofile-pre :mode)
(def info (-> infofile-pre slurp parse))
(def deps (get info :dependencies @[]))
(set default-bundle-name (get info :name))
(def missing (seq [d :in deps :when (not (bundle/installed? d))] (string d)))
(when (next missing) (errorf "missing dependencies %s" (string/join missing ", "))))
(def bundle-name (get config :name default-bundle-name))
(assert bundle-name (errorf "unable to infer bundle name for %v, use :name argument" path))
(assert (not (string/check-set "\\/" bundle-name))
(string "bundle name "
bundle-name
" cannot contain path separators"))
(assert (next bundle-name) "cannot use empty bundle-name")
(assert (not (fexists (get-manifest-filename bundle-name)))
"bundle is already installed")
# Setup installed paths
(prime-bundle-paths)
(os/mkdir (bundle-dir bundle-name))
# Copy some files into the new location unconditionally
(def implicit-sources (string path s "bundle"))
(when (= :directory (os/stat implicit-sources :mode))
(copyrf implicit-sources (bundle-dir bundle-name)))
(def man @{:name bundle-name :local-source path :files @[]})
(merge-into man config)
(def infofile (bundle-file bundle-name "info.jdn"))
(put man :auto-remove (get config :auto-remove))
(sync-manifest man)
(edefer (do (print "installation error, uninstalling") (bundle/uninstall bundle-name))
(when (os/stat infofile :mode)
(def info (-> infofile slurp parse))
(def deps (get info :dependencies @[]))
(def missing (filter (complement bundle/installed?) deps))
(when (next missing)
(error (string "missing dependencies " (string/join missing ", "))))
(put man :dependencies deps)
(put man :info info))
(def module (get-bundle-module bundle-name))
(def all-hooks (seq [[k v] :pairs module :when (symbol? k) :unless (get v :private)] (keyword k)))
(put man :hooks all-hooks)
(do-hook module bundle-name :dependencies man)
(when clean
(do-hook module bundle-name :clean man))
(do-hook module bundle-name :build man)
(do-hook module bundle-name :install man)
(when check
(do-hook module bundle-name :check man))
(if (empty? (get man :files)) (print "no files installed, is this a valid bundle?"))
(sync-manifest man))
(print "installed " bundle-name)
bundle-name)
(defn- bundle/pack
"Take an installed bundle and create a bundle source directory that can be used to
reinstall the bundle on a compatible system. This is used to create backups for installed
bundles without rebuilding, or make a prebuilt bundle for other systems."
[bundle-name dest-dir &opt is-backup]
(var i 0)
(def man (bundle/manifest bundle-name))
(def files (get man :files @[]))
(assert (os/mkdir dest-dir) (string "could not create directory " dest-dir " (or it already exists)"))
(def s (sep))
(os/mkdir (string dest-dir s "bundle"))
(def install-hook (string dest-dir s "bundle" s "init.janet"))
(edefer (rmrf dest-dir) # don't leave garbage on failure
(def install-source @[])
(def syspath (bundle-rpath (dyn *syspath*)))
(when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir s "old-bundle")))
(each file files
(def {:mode mode :permissions perm} (os/stat file))
(def relpath (string/triml (slice file (length syspath) -1) s))
(case mode
:directory (array/push install-source ~(bundle/add-directory manifest ,relpath ,perm))
:file (do
(def filename (string/format "file_%06d" (++ i)))
(copyfile file (string dest-dir s filename))
(array/push install-source ~(bundle/add-file manifest ,filename ,relpath ,perm)))
(errorf "unexpected file %v" file)))
(def b @"(defn install [manifest]")
(each form install-source (buffer/format b "\n %j" form))
(buffer/push b ")\n")
(spit install-hook b))
dest-dir)
(defn bundle/reinstall
"Reinstall an existing bundle from the local source code."
[bundle-name &keys new-config]
(def manifest (bundle/manifest bundle-name))
(def path (get manifest :local-source))
(def config (get manifest :config @{}))
(def s (sep))
(assert (= :directory (os/stat path :mode)) "local source not available")
(def backup-dir (string (dyn *syspath*) s bundle-name ".backup"))
(rmrf backup-dir)
(def backup-bundle-source (bundle/pack bundle-name backup-dir true))
(edefer (do
(bundle/install backup-bundle-source :name bundle-name)
(copyrf (string backup-bundle-source s "old-bundle") (bundle-dir bundle-name))
(rmrf backup-bundle-source))
(bundle-uninstall-unchecked bundle-name)
(bundle/install path :name bundle-name ;(kvs config) ;(kvs new-config)))
(rmrf backup-bundle-source)
bundle-name)
(defn bundle/add-directory
"Add a directory during the install process relative to `(dyn *syspath*)`"
[manifest dest &opt chmod-mode]
(def files (get-files manifest))
(def s (sep))
(def absdest (string (dyn *syspath*) s dest))
(unless (os/mkdir absdest)
(errorf "collision at %s, directory already exists" absdest))
(def absdest (os/realpath absdest))
(array/push files absdest)
(when chmod-mode
(os/chmod absdest chmod-mode))
(print "add " absdest)
absdest)
(defn bundle/add-file
"Add files during an install relative to `(dyn *syspath*)`"
[manifest src &opt dest chmod-mode]
(default dest src)
(def files (get-files manifest))
(def s (sep))
(def absdest (string (dyn *syspath*) s dest))
(when (os/stat absdest :mode)
(errorf "collision at %s, file already exists" absdest))
(copyfile src absdest)
(def absdest (os/realpath absdest))
(array/push files absdest)
(when chmod-mode
(os/chmod absdest chmod-mode))
(print "add " absdest)
absdest)
(defn bundle/add
"Add files and directories during a bundle install relative to `(dyn *syspath*)`.
Added paths will be recorded in the bundle manifest such that they are properly tracked
and removed during an upgrade or uninstall."
[manifest src &opt dest chmod-mode]
(default dest src)
(def s (sep))
(case (os/stat src :mode)
:directory
(let [absdest (bundle/add-directory manifest dest chmod-mode)]
(each d (os/dir src) (bundle/add manifest (string src s d) (string dest s d) chmod-mode))
absdest)
:file (bundle/add-file manifest src dest chmod-mode)))
(defn bundle/update-all
"Reinstall all bundles"
[&keys configs]
(each bundle (bundle/topolist)
(bundle/reinstall bundle ;(kvs configs)))))
###
###
@@ -3989,6 +4378,28 @@
(compwhen (not (dyn 'os/isatty))
(defmacro os/isatty [&] true))
(def- long-to-short
"map long options to short options"
{"-help" "h"
"-version" "v"
"-stdin" "s"
"-eval" "e"
"-expression" "E"
"-debug" "d"
"-repl" "r"
"-noprofile" "R"
"-persistent" "p"
"-quiet" "q"
"-flycheck" "k"
"-syspath" "m"
"-compile" "c"
"-image" "i"
"-nocolor" "n"
"-color" "N"
"-library" "l"
"-lint-warn" "w"
"-lint-error" "x"})
(defn cli-main
`Entrance for the Janet CLI tool. Call this function with the command line
arguments as an array or tuple of strings to invoke the CLI interface.`
@@ -4027,26 +4438,26 @@
(print
```
Options are:
-h : Show this help
-v : Print the version string
-s : Use raw stdin instead of getline like functionality
-e code : Execute a string of janet
-E code arguments... : Evaluate an expression as a short-fn with arguments
-d : Set the debug flag in the REPL
-r : Enter the REPL after running all scripts
-R : Disables loading profile.janet when JANET_PROFILE is present
-p : Keep on executing if there is a top-level error (persistent)
-q : Hide logo (quiet)
-k : Compile scripts but do not execute (flycheck)
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-i : Load the script argument as an image file instead of source code
-n : Disable ANSI color output in the REPL
-N : Enable ANSI color output in the REPL
-l lib : Use a module before processing more arguments
-w level : Set the lint warning level - default is "normal"
-x level : Set the lint error level - default is "none"
-- : Stop handling options
--help (-h) : Show this help
--version (-v) : Print the version string
--stdin (-s) : Use raw stdin instead of getline like functionality
--eval (-e) code : Execute a string of janet
--expression (-E) code arguments... : Evaluate an expression as a short-fn with arguments
--debug (-d) : Set the debug flag in the REPL
--repl (-r) : Enter the REPL after running all scripts
--noprofile (-R) : Disables loading profile.janet when JANET_PROFILE is present
--persistent (-p) : Keep on executing if there is a top-level error (persistent)
--quiet (-q) : Hide logo (quiet)
--flycheck (-k) : Compile scripts but do not execute (flycheck)
--syspath (-m) syspath : Set system path for loading global modules
--compile (-c) source output : Compile janet source code into an image
--image (-i) : Load the script argument as an image file instead of source code
--nocolor (-n) : Disable ANSI color output in the REPL
--color (-N) : Enable ANSI color output in the REPL
--library (-l) lib : Use a module before processing more arguments
--lint-warn (-w) level : Set the lint warning level - default is "normal"
--lint-error (-x) level : Set the lint error level - default is "none"
-- : Stop handling options
```)
(os/exit 0)
1)
@@ -4090,8 +4501,8 @@
"R" (fn [&] (setdyn *profilepath* nil) 1)})
(defn- dohandler [n i &]
(def h (in handlers n))
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
(def h (in handlers (get long-to-short n n)))
(if h (h i handlers) (do (print "unknown flag -" n) ((in handlers "h")))))
# Process arguments
(var i 0)
@@ -4291,9 +4702,8 @@
(each s core-sources
(do-one-file s))
# Create C source file that contains images a uint8_t buffer. This
# can be compiled and linked statically into the main janet library
# and example client.
# Create C source file that contains the boot image in a uint8_t buffer. This
# can be compiled and linked statically into the main janet library and client
(print "static const unsigned char janet_core_image_bytes[] = {")
(loop [line :in (partition 16 image)]
(prin " ")

View File

@@ -7,7 +7,7 @@
#define JANET_VERSION_MINOR 34
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.34.0"
#define JANET_VERSION "1.35.0"
/* #define JANET_BUILD "local" */

View File

@@ -30,7 +30,7 @@
#include <string.h>
static void janet_array_impl(JanetArray *array, size_t capacity) {
static void janet_array_impl(JanetArray *array, int32_t capacity) {
Janet *data = NULL;
if (capacity > 0) {
janet_vm.next_collection += capacity * sizeof(Janet);
@@ -45,23 +45,21 @@ static void janet_array_impl(JanetArray *array, size_t capacity) {
}
/* Creates a new array */
JanetArray *janet_array(size_t capacity) {
if (capacity > JANET_SIZEMAX) capacity = JANET_SIZEMAX;
JanetArray *janet_array(int32_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) {
if (capacity > JANET_SIZEMAX) capacity = JANET_SIZEMAX;
JanetArray *janet_array_weak(int32_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, size_t n) {
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
array->capacity = n;
array->count = n;
@@ -74,13 +72,13 @@ JanetArray *janet_array_n(const Janet *elements, size_t n) {
}
/* Ensure the array has enough capacity for elements */
void janet_array_ensure(JanetArray *array, size_t capacity, int32_t growth) {
void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
Janet *newData;
Janet *old = array->data;
if (capacity <= array->capacity) return;
int64_t new_capacity = ((int64_t) capacity) * growth;
if (new_capacity > JANET_SIZEMAX) new_capacity = JANET_SIZEMAX;
capacity = (size_t) new_capacity;
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
capacity = (int32_t) new_capacity;
newData = janet_realloc(old, capacity * sizeof(Janet));
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
@@ -91,10 +89,11 @@ void janet_array_ensure(JanetArray *array, size_t capacity, int32_t growth) {
}
/* Set the count of an array. Extend with nil if needed. */
void janet_array_setcount(JanetArray *array, size_t count) {
if (count > JANET_SIZEMAX) count = JANET_SIZEMAX;
void janet_array_setcount(JanetArray *array, int32_t count) {
if (count < 0)
return;
if (count > array->count) {
size_t i;
int32_t i;
janet_array_ensure(array, count, 1);
for (i = array->count; i < count; i++) {
array->data[i] = janet_wrap_nil();
@@ -105,10 +104,10 @@ void janet_array_setcount(JanetArray *array, size_t count) {
/* Push a value to the top of the array */
void janet_array_push(JanetArray *array, Janet x) {
if (array->count == JANET_SIZEMAX) {
if (array->count == INT32_MAX) {
janet_panic("array overflow");
}
size_t newcount = array->count + 1;
int32_t newcount = array->count + 1;
janet_array_ensure(array, newcount, 2);
array->data[array->count] = x;
array->count = newcount;
@@ -139,7 +138,7 @@ 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);
size_t cap = janet_getsize(argv, 0);
int32_t cap = janet_getinteger(argv, 0);
JanetArray *array = janet_array(cap);
return janet_wrap_array(array);
}
@@ -148,7 +147,7 @@ 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);
int32_t cap = janet_getinteger(argv, 0);
JanetArray *array = janet_array_weak(cap);
return janet_wrap_array(array);
}
@@ -157,7 +156,7 @@ 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);
size_t count = janet_getsize(argv, 0);
int32_t count = janet_getnat(argv, 0);
Janet x = (argc == 2) ? argv[1] : janet_wrap_nil();
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
@@ -202,10 +201,10 @@ JANET_CORE_FN(cfun_array_push,
"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 ((size_t)(INT32_MAX - argc + 1) <= array->count) {
if (INT32_MAX - argc + 1 <= array->count) {
janet_panic("array overflow");
}
size_t newcount = array->count - 1 + (size_t) argc;
int32_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;
@@ -220,7 +219,7 @@ 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);
size_t newcount = janet_getsize(argv, 1);
int32_t newcount = janet_getinteger(argv, 1);
int32_t growth = janet_getinteger(argv, 2);
if (newcount < 1) janet_panic("expected positive integer");
janet_array_ensure(array, newcount, growth);
@@ -259,7 +258,7 @@ JANET_CORE_FN(cfun_array_concat,
break;
case JANET_ARRAY:
case JANET_TUPLE: {
size_t j, len = 0;
int32_t j, len = 0;
const Janet *vals = NULL;
janet_indexed_view(argv[i], &vals, &len);
if (array->data == vals) {

View File

@@ -375,7 +375,7 @@ JANET_CORE_FN(cfun_buffer_push_uint16,
uint16_t data;
uint8_t bytes[2];
} u;
u.data = (uint16_t) janet_getinteger(argv, 2);
u.data = janet_getuinteger16(argv, 2);
if (reverse) {
uint8_t temp = u.bytes[1];
u.bytes[1] = u.bytes[0];
@@ -396,7 +396,7 @@ JANET_CORE_FN(cfun_buffer_push_uint32,
uint32_t data;
uint8_t bytes[4];
} u;
u.data = (uint32_t) janet_getinteger(argv, 2);
u.data = janet_getuinteger(argv, 2);
if (reverse)
reverse_u32(u.bytes);
janet_buffer_push_u32(buffer, *(uint32_t *) u.bytes);
@@ -414,7 +414,7 @@ JANET_CORE_FN(cfun_buffer_push_uint64,
uint64_t data;
uint8_t bytes[8];
} u;
u.data = (uint64_t) janet_getuinteger64(argv, 2);
u.data = janet_getuinteger64(argv, 2);
if (reverse)
reverse_u64(u.bytes);
janet_buffer_push_u64(buffer, *(uint64_t *) u.bytes);
@@ -655,6 +655,27 @@ JANET_CORE_FN(cfun_buffer_format,
return argv[0];
}
JANET_CORE_FN(cfun_buffer_format_at,
"(buffer/format-at buffer at format & args)",
"Snprintf like functionality for printing values into a buffer. Returns "
"the modified buffer.") {
janet_arity(argc, 2, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
int32_t at = janet_getinteger(argv, 1);
if (at < 0) {
at += buffer->count + 1;
}
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
int32_t oldcount = buffer->count;
buffer->count = at;
const char *strfrmt = (const char *) janet_getstring(argv, 2);
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
if (buffer->count < oldcount) {
buffer->count = oldcount;
}
return argv[0];
}
void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
@@ -681,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
JANET_CORE_REG("buffer/format", cfun_buffer_format),
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, buffer_cfuns);

View File

@@ -303,11 +303,28 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
uint32_t janet_getuinteger(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint(x)) {
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
janet_panicf("bad slot #%d, expected 32 bit unsigned integer, got %v", n, x);
}
return janet_unwrap_integer(x);
return (uint32_t) janet_unwrap_number(x);
}
int16_t janet_getinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit signed integer, got %v", n, x);
}
return (int16_t) janet_unwrap_number(x);
}
uint16_t janet_getuinteger16(const Janet *argv, int32_t n) {
Janet x = argv[n];
if (!janet_checkuint16(x)) {
janet_panicf("bad slot #%d, expected 16 bit unsigned integer, got %v", n, x);
}
return (uint16_t) janet_unwrap_number(x);
}
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
#ifdef JANET_INT_TYPES
return janet_unwrap_s64(argv[n]);

View File

@@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
int32_t slotchunks = (def->slotcount + 31) >> 5;
/* numchunks is min of slotchunks and scope->ua.count */
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
@@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
def->name = janet_cstring("thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {

View File

@@ -69,15 +69,15 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
host.minor < modconf.minor ||
host.bits != modconf.bits) {
char errbuf[128];
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,
host.bits,
modconf.major,
modconf.minor,
modconf.patch,
modconf.bits);
*error = janet_cstring(errbuf);
return NULL;
}

View File

@@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
if (frame->flags & JANET_STACKFRAME_TAILCALL)
janet_eprintf(" (tailcall)");
janet_eprintf(" (tail call)");
if (frame->func && frame->pc) {
int32_t off = (int32_t)(frame->pc - def->bytecode);
if (def->sourcemap) {
@@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
}
}
janet_eprintf("\n");
/* Print fiber points optionally. Clutters traces but provides info
if (i <= 0 && fi > 0) {
janet_eprintf(" in parent fiber\n");
}
*/
}
}

View File

@@ -279,8 +279,12 @@ void janet_async_in_flight(JanetFiber *fiber) {
void janet_async_start(JanetStream *stream, JanetAsyncMode mode, JanetEVCallback callback, void *state) {
JanetFiber *fiber = janet_vm.root_fiber;
janet_assert(!fiber->ev_callback, "double async on fiber");
if (mode & JANET_ASYNC_LISTEN_READ) stream->read_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_WRITE) stream->write_fiber = fiber;
if (mode & JANET_ASYNC_LISTEN_READ) {
stream->read_fiber = fiber;
}
if (mode & JANET_ASYNC_LISTEN_WRITE) {
stream->write_fiber = fiber;
}
fiber->ev_callback = callback;
fiber->ev_stream = stream;
janet_ev_inc_refcount();
@@ -462,6 +466,12 @@ static Janet janet_stream_next(void *p, Janet key) {
return janet_nextmethod(stream->methods, key);
}
static void janet_stream_tostring(void *p, JanetBuffer *buffer) {
JanetStream *stream = p;
/* Let user print the file descriptor for debugging */
janet_formatb(buffer, "<core/stream handle=%d>", stream->handle);
}
const JanetAbstractType janet_stream_type = {
"core/stream",
janet_stream_gc,
@@ -470,7 +480,7 @@ const JanetAbstractType janet_stream_type = {
NULL,
janet_stream_marshal,
janet_stream_unmarshal,
NULL,
janet_stream_tostring,
NULL,
NULL,
janet_stream_next,
@@ -1516,6 +1526,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
}
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
#elif defined(JANET_EV_EPOLL)
static JanetTimestamp ts_now(void) {
@@ -1527,15 +1545,15 @@ static JanetTimestamp ts_now(void) {
}
/* Wait for the next event */
static void janet_register_stream(JanetStream *stream) {
static void janet_register_stream_impl(JanetStream *stream, int mod, int edge_trigger) {
struct epoll_event ev;
ev.events = EPOLLET;
ev.events = edge_trigger ? EPOLLET : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) ev.events |= EPOLLIN;
if (stream->flags & JANET_STREAM_WRITABLE) ev.events |= EPOLLOUT;
ev.data.ptr = stream;
int status;
do {
status = epoll_ctl(janet_vm.epoll, EPOLL_CTL_ADD, stream->handle, &ev);
status = epoll_ctl(janet_vm.epoll, mod ? EPOLL_CTL_MOD : EPOLL_CTL_ADD, stream->handle, &ev);
} while (status == -1 && errno == EINTR);
if (status == -1) {
if (errno == EPERM) {
@@ -1549,6 +1567,18 @@ static void janet_register_stream(JanetStream *stream) {
}
}
static void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 0, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1, 0);
}
#define JANET_EPOLL_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
struct itimerspec its;
@@ -1678,14 +1708,15 @@ static void timestamp2timespec(struct timespec *t, JanetTimestamp ts) {
t->tv_nsec = ts == 0 ? 0 : (ts % 1000) * 1000000;
}
void janet_register_stream(JanetStream *stream) {
void janet_register_stream_impl(JanetStream *stream, int edge_trigger) {
struct kevent kevs[2];
int length = 0;
int clear = edge_trigger ? EV_CLEAR : 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | EV_CLEAR, 0, 0, stream);
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_ADD | EV_ENABLE | clear, 0, 0, stream);
}
int status;
do {
@@ -1696,6 +1727,18 @@ void janet_register_stream(JanetStream *stream) {
}
}
void janet_register_stream(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_edge_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 1);
}
void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 0);
}
#define JANET_KQUEUE_MAX_EVENTS 64
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
@@ -1818,15 +1861,30 @@ void janet_register_stream(JanetStream *stream) {
janet_vm.stream_count = new_count;
}
void janet_stream_edge_triggered(JanetStream *stream) {
(void) stream;
}
void janet_stream_level_triggered(JanetStream *stream) {
(void) stream;
}
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* set event flags */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
JanetStream *stream = janet_vm.streams[i];
janet_vm.fds[i + 1].events = 0;
janet_vm.fds[i + 1].revents = 0;
if (stream->read_fiber && stream->read_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLIN;
if (stream->write_fiber && stream->write_fiber->ev_callback) janet_vm.fds[i + 1].events |= POLLOUT;
struct pollfd *pfd = janet_vm.fds + i + 1;
pfd->events = 0;
pfd->revents = 0;
JanetFiber *rf = stream->read_fiber;
JanetFiber *wf = stream->write_fiber;
if (rf && rf->ev_callback) pfd->events |= POLLIN;
if (wf && wf->ev_callback) pfd->events |= POLLOUT;
/* Hack to ignore a file descriptor - make file descriptor negative if we want to ignore */
if (!pfd->events) {
pfd->fd = -pfd->fd;
}
}
/* Poll for events */
@@ -1843,6 +1901,14 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
JANET_EXIT("failed to poll events");
}
/* Undo negative hack */
for (size_t i = 0; i < janet_vm.stream_count; i++) {
struct pollfd *pfd = janet_vm.fds + i + 1;
if (pfd->fd < 0) {
pfd->fd = -pfd->fd;
}
}
/* Check selfpipe */
if (janet_vm.fds[0].revents & POLLIN) {
janet_vm.fds[0].revents = 0;
@@ -2025,7 +2091,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
if (err) {
janet_free(init);
janet_panicf("%s", strerror(err));
janet_panicf("%s", janet_strerror(err));
}
#endif
@@ -2134,7 +2200,7 @@ Janet janet_ev_lasterr(void) {
}
#else
Janet janet_ev_lasterr(void) {
return janet_cstringv(strerror(errno));
return janet_cstringv(janet_strerror(errno));
}
#endif

View File

@@ -76,4 +76,6 @@
#define __BSD_VISIBLE 1
#endif
#define _FILE_OFFSET_BITS 64
#endif

View File

@@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRId64, *((int64_t *)p));
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
janet_buffer_push_cstring(buffer, str);
}
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
char str[32];
sprintf(str, "%" PRIu64, *((uint64_t *)p));
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
janet_buffer_push_cstring(buffer, str);
}

View File

@@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
static Janet io_file_next(void *p, Janet key);
#ifdef JANET_WINDOWS
#define ftell _ftelli64
#define fseek _fseeki64
#endif
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
@@ -126,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
// XXX use mkostemp when we can to avoid CLOEXEC race.
FILE *tmp = tmpfile();
if (!tmp)
janet_panicf("unable to create temporary file - %s", strerror(errno));
janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
}
@@ -168,7 +173,7 @@ JANET_CORE_FN(cfun_io_fopen,
}
}
return f ? janet_makefile(f, flags)
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
: janet_wrap_nil();
}
@@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long int offset = 0;
int64_t offset = 0;
int whence = SEEK_CUR;
if (argc >= 2) {
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
@@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek,
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
}
if (argc == 3) {
offset = (long) janet_getinteger64(argv, 2);
offset = (int64_t) janet_getinteger64(argv, 2);
}
}
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
@@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long pos = ftell(iof->file);
int64_t pos = ftell(iof->file);
if (pos == -1) janet_panic("error getting position in file");
return janet_wrap_number((double)pos);
}

View File

@@ -349,6 +349,26 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
return janet_wrap_number(janet_lcm(x, y));
}
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
"Returns a tuple of (mantissa, exponent) from number.") {
janet_fixarity(argc, 1);
double x = janet_getnumber(argv, 0);
int exp;
x = frexp(x, &exp);
Janet *result = janet_tuple_begin(2);
result[0] = janet_wrap_number(x);
result[1] = janet_wrap_number((double) exp);
return janet_wrap_tuple(janet_tuple_end(result));
}
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
"Creates a new number from a mantissa and an exponent.") {
janet_fixarity(argc, 2);
double x = janet_getnumber(argv, 0);
int32_t y = janet_getinteger(argv, 1);
return janet_wrap_number(ldexp(x, y));
}
/* Module entry point */
void janet_lib_math(JanetTable *env) {
JanetRegExt math_cfuns[] = {
@@ -395,6 +415,8 @@ void janet_lib_math(JanetTable *env) {
JANET_CORE_REG("math/next", janet_nextafter),
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, math_cfuns);

View File

@@ -152,7 +152,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
if (res == 0) {
janet_schedule(fiber, janet_wrap_abstract(stream));
} else {
janet_cancel(fiber, janet_cstringv(strerror(res)));
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
stream->flags |= JANET_STREAM_TOCLOSE;
}
} else {
@@ -319,6 +319,7 @@ JANET_NO_RETURN static void janet_sched_accept(JanetStream *stream, JanetFunctio
NetStateAccept *state = janet_malloc(sizeof(NetStateAccept));
memset(state, 0, sizeof(NetStateAccept));
state->function = fun;
if (fun) janet_stream_level_triggered(stream);
janet_async_start(stream, JANET_ASYNC_LISTEN_READ, net_callback_accept, state);
}
@@ -1034,7 +1035,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
if (r == -1) {
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
}
return janet_wrap_nil();

View File

@@ -38,6 +38,7 @@
#include <string.h>
#include <sys/stat.h>
#include <signal.h>
#include <locale.h>
#ifdef JANET_BSD
#include <sys/sysctl.h>
@@ -761,7 +762,7 @@ JANET_CORE_FN(os_proc_kill,
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
#endif
/* After killing process we wait on it. */
@@ -1274,7 +1275,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
status = execv(cargv[0], cargv);
}
} while (status == -1 && errno == EINTR);
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
#endif
}
@@ -1331,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
os_execute_cleanup(envp, child_argv);
if (status) {
/* correct for macos bug where errno is not set */
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
}
#endif
@@ -1432,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
result = fork();
} while (result == -1 && errno == EINTR);
if (result == -1) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
if (result) {
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
@@ -1597,13 +1598,13 @@ JANET_CORE_FN(os_clock,
JanetKeyword formatstr = janet_optkeyword(argv, argc, 1, (const uint8_t *) "double");
if (janet_cstrcmp(formatstr, "double") == 0) {
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
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(tv.tv_sec);
return janet_wrap_number((double)(tv.tv_sec));
} else if (janet_cstrcmp(formatstr, "tuple") == 0) {
Janet tup[2] = {janet_wrap_integer(tv.tv_sec),
janet_wrap_integer(tv.tv_nsec)
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 {
@@ -1644,7 +1645,7 @@ JANET_CORE_FN(os_isatty,
return janet_wrap_boolean(_isatty(fd));
#else
int fd = fileno(f);
if (fd == -1) janet_panic(strerror(errno));
if (fd == -1) janet_panic(janet_strerror(errno));
return janet_wrap_boolean(isatty(fd));
#endif
}
@@ -1879,7 +1880,7 @@ JANET_CORE_FN(os_mktime,
}
if (t == (time_t) -1) {
janet_panicf("%s", strerror(errno));
janet_panicf("%s", janet_strerror(errno));
}
return janet_wrap_number((double)t);
@@ -1891,6 +1892,43 @@ JANET_CORE_FN(os_mktime,
#define j_symlink symlink
#endif
JANET_CORE_FN(os_setlocale,
"(os/setlocale &opt locale category)",
"Set the system locale, which affects how dates and numbers are formatted. "
"Passing nil to locale will return the current locale. Category can be one of:\n\n"
" * :all (default)\n"
" * :collate\n"
" * :ctype\n"
" * :monetary\n"
" * :numeric\n"
" * :time\n\n"
"Returns the new locale if set successfully, otherwise nil. Note that this will affect "
"other functions such as `os/strftime` and even `printf`.") {
janet_arity(argc, 0, 2);
const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
int category_int = LC_ALL;
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
if (janet_keyeq(argv[1], "all")) {
category_int = LC_ALL;
} else if (janet_keyeq(argv[1], "collate")) {
category_int = LC_COLLATE;
} else if (janet_keyeq(argv[1], "ctype")) {
category_int = LC_CTYPE;
} else if (janet_keyeq(argv[1], "monetary")) {
category_int = LC_MONETARY;
} else if (janet_keyeq(argv[1], "numeric")) {
category_int = LC_NUMERIC;
} else if (janet_keyeq(argv[1], "time")) {
category_int = LC_TIME;
} else {
janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
}
}
const char *old = setlocale(category_int, locale_name);
if (old == NULL) return janet_wrap_nil();
return janet_cstringv(old);
}
JANET_CORE_FN(os_link,
"(os/link oldpath newpath &opt symlink)",
"Create a link at newpath that points to oldpath and returns nil. "
@@ -1908,7 +1946,7 @@ JANET_CORE_FN(os_link,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -1927,7 +1965,7 @@ JANET_CORE_FN(os_symlink,
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = j_symlink(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -1949,7 +1987,7 @@ JANET_CORE_FN(os_mkdir,
#endif
if (res == 0) return janet_wrap_true();
if (errno == EEXIST) return janet_wrap_false();
janet_panicf("%s: %s", strerror(errno), path);
janet_panicf("%s: %s", janet_strerror(errno), path);
}
JANET_CORE_FN(os_rmdir,
@@ -1963,7 +2001,7 @@ JANET_CORE_FN(os_rmdir,
#else
int res = rmdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@@ -1978,7 +2016,7 @@ JANET_CORE_FN(os_cd,
#else
int res = chdir(path);
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@@ -2002,7 +2040,7 @@ JANET_CORE_FN(os_touch,
bufp = NULL;
}
int res = utime(path, bufp);
if (-1 == res) janet_panic(strerror(errno));
if (-1 == res) janet_panic(janet_strerror(errno));
return janet_wrap_nil();
}
@@ -2012,7 +2050,7 @@ JANET_CORE_FN(os_remove,
janet_fixarity(argc, 1);
const char *path = janet_getcstring(argv, 0);
int status = remove(path);
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@@ -2031,7 +2069,7 @@ JANET_CORE_FN(os_readlink,
const char *path = janet_getcstring(argv, 0);
ssize_t len = readlink(path, buffer, sizeof buffer);
if (len < 0 || (size_t)len >= sizeof buffer)
janet_panicf("%s: %s", strerror(errno), path);
janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_stringv((const uint8_t *)buffer, len);
#endif
}
@@ -2326,7 +2364,7 @@ JANET_CORE_FN(os_chmod,
#else
int res = chmod(path, os_getmode(argv, 1));
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
return janet_wrap_nil();
}
@@ -2362,7 +2400,7 @@ JANET_CORE_FN(os_dir,
janet_panicf("path too long: %s", dir);
sprintf(pattern, "%s/*", dir);
intptr_t res = _findfirst(pattern, &afile);
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
do {
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
janet_array_push(paths, janet_cstringv(afile.name));
@@ -2373,8 +2411,18 @@ JANET_CORE_FN(os_dir,
/* Read directory items with opendir / readdir / closedir */
struct dirent *dp;
DIR *dfd = opendir(dir);
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
while ((dp = readdir(dfd)) != NULL) {
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
for (;;) {
errno = 0;
dp = readdir(dfd);
if (dp == NULL) {
if (errno) {
int olderr = errno;
closedir(dfd);
janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
}
break;
}
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
continue;
}
@@ -2394,7 +2442,7 @@ JANET_CORE_FN(os_rename,
const char *dest = janet_getcstring(argv, 1);
int status = rename(src, dest);
if (status) {
janet_panic(strerror(errno));
janet_panic(janet_strerror(errno));
}
return janet_wrap_nil();
}
@@ -2414,7 +2462,7 @@ JANET_CORE_FN(os_realpath,
#else
char *dest = realpath(src, NULL);
#endif
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
Janet ret = janet_cstringv(dest);
janet_free(dest);
return ret;
@@ -2688,6 +2736,7 @@ void janet_lib_os(JanetTable *env) {
JANET_CORE_REG("os/strftime", os_strftime),
JANET_CORE_REG("os/sleep", os_sleep),
JANET_CORE_REG("os/isatty", os_isatty),
JANET_CORE_REG("os/setlocale", os_setlocale),
/* env functions */
JANET_CORE_REG("os/environ", os_environ),

View File

@@ -379,8 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
break;
case JANET_NUMBER:
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
S->buffer->count += count;
double num = janet_unwrap_number(x);
if (isnan(num)) return 1;
if (isinf(num)) return 1;
janet_buffer_dtostr(S->buffer, num);
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
@@ -830,7 +832,7 @@ static const char *scanformat(
if (loc != NULL && *loc != '\0') {
const char *mapping = get_fmt_mapping(*p2++);
size_t len = strlen(mapping);
strcpy(form, mapping);
memcpy(form, mapping, len);
form += len;
} else {
*(form++) = *(p2++);

View File

@@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
int structarg = 0;
int allow_extra = 0;
int selfref = 0;
int hasname = 0;
int seenamp = 0;
int seenopt = 0;
int namedargs = 0;
@@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
head = argv[0];
if (janet_checktype(head, JANET_SYMBOL)) {
selfref = 1;
hasname = 1;
parami = 1;
} else if (janet_checktype(head, JANET_KEYWORD)) {
hasname = 1;
parami = 1;
}
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
@@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (selfref) def->name = janet_unwrap_symbol(head);
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);

View File

@@ -149,6 +149,11 @@ struct JanetVM {
JanetTraversalNode *traversal_top;
JanetTraversalNode *traversal_base;
/* Thread safe strerror error buffer - for janet_strerror */
#ifndef JANET_WINDOWS
char strerror_buf[256];
#endif
/* Event loop and scheduler globals */
#ifdef JANET_EV
size_t tq_count;

View File

@@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
}
#endif
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
#define BUFSIZE 32
janet_buffer_extra(buffer, BUFSIZE);
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
#undef BUFSIZE
/* fix locale issues with commas */
for (int i = 0; i < count; i++) {
char c = buffer->data[buffer->count + i];
if (c == ',') {
buffer->data[buffer->count + i] = '.';
}
}
buffer->count += count;
}

View File

@@ -319,13 +319,6 @@ JANET_CORE_FN(cfun_table_new,
int32_t cap = janet_getnat(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)",

View File

@@ -826,6 +826,20 @@ int janet_checkuint64(Janet x) {
return janet_checkuint64range(dval);
}
int janet_checkint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkint16range(dval);
}
int janet_checkuint16(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return janet_checkuint16range(dval);
}
int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
@@ -953,6 +967,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
#endif
#endif
/* Better strerror (thread-safe if available) */
const char *janet_strerror(int e) {
#ifdef JANET_WINDOWS
/* Microsoft strerror seems sane here and is thread safe by default */
return strerror(e);
#elif defined(_GNU_SOURCE)
/* See https://linux.die.net/man/3/strerror_r */
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
#else
strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
return janet_vm.strerror_buf;
#endif
}
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)

View File

@@ -80,6 +80,8 @@ void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
const char *janet_strerror(int e);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,

View File

@@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
Janet lr = janet_method_lookup(rhs, rmethod);
Janet argv[2] = { rhs, lhs };
if (janet_checktype(lr, JANET_NIL)) {
janet_panicf("could not find method :%s for %v, or :%s for %v",
janet_panicf("could not find method :%s for %v or :%s for %v",
lmethod, lhs,
rmethod, rhs);
}

View File

@@ -112,7 +112,8 @@ extern "C" {
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|| (defined(__ppc64__) || defined(__PPC64__)) \
|| defined(__aarch64__) /* ARM 64-bit */ \
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|| defined(__loongarch64) /* LoongArch64 64-bit */
#define JANET_64 1
#else
#define JANET_32 1
@@ -148,12 +149,6 @@ extern "C" {
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
#define JANET_INTMAX_INT64 9007199254740992
#define JANET_INTMIN_INT64 (-9007199254740992)
#ifdef JANET_64
#define JANET_SIZEMAX JANET_INTMAX_INT64
#else
/* Avoid loop bounds issues */
#define JANET_SIZEMAX (SIZE_MAX - 1)
#endif
/* Check emscripten */
#ifdef __EMSCRIPTEN__
@@ -642,6 +637,12 @@ 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);
/* On some platforms, it is important to be able to control if a stream is edge-trigger or level triggered.
* For example, a server that is accepting connections might want to be level triggered or edge-triggered
* depending on expected service. */
JANET_API void janet_stream_edge_triggered(JanetStream *stream);
JANET_API void janet_stream_level_triggered(JanetStream *stream);
#endif
/* Janet uses atomic integers in several places for synchronization between threads and
@@ -896,12 +897,16 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
/* End of tagged union implementation */
#endif
JANET_API int janet_checkint16(Janet x);
JANET_API int janet_checkuint16(Janet x);
JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkuint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checkuint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkint16range(x) ((x) >= INT16_MIN && (x) <= INT16_MAX && (x) == (int16_t)(x))
#define janet_checkuint16range(x) ((x) >= 0 && (x) <= UINT16_MAX && (x) == (uint16_t)(x))
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkuintrange(x) ((x) >= 0 && (x) <= UINT32_MAX && (x) == (uint32_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
@@ -971,25 +976,25 @@ struct JanetStackFrame {
/* A dynamic array type. */
struct JanetArray {
JanetGCObject gc;
size_t count;
size_t capacity;
int32_t count;
int32_t capacity;
Janet *data;
};
/* A byte buffer type. Used as a mutable string or string builder. */
struct JanetBuffer {
JanetGCObject gc;
size_t count;
size_t capacity;
int32_t count;
int32_t capacity;
uint8_t *data;
};
/* A mutable associative data type. Backed by a hashtable. */
struct JanetTable {
JanetGCObject gc;
size_t count;
size_t capacity;
size_t deleted;
int32_t count;
int32_t capacity;
int32_t deleted;
JanetKV *data;
JanetTable *proto;
};
@@ -1003,7 +1008,7 @@ struct JanetKV {
/* Prefix for a tuple */
struct JanetTupleHead {
JanetGCObject gc;
size_t length;
int32_t length;
int32_t hash;
int32_t sm_line;
int32_t sm_column;
@@ -1013,9 +1018,9 @@ struct JanetTupleHead {
/* Prefix for a struct */
struct JanetStructHead {
JanetGCObject gc;
size_t length;
size_t capacity;
int32_t length;
int32_t hash;
int32_t capacity;
const JanetKV *proto;
const JanetKV data[];
};
@@ -1023,7 +1028,7 @@ struct JanetStructHead {
/* Prefix for a string */
struct JanetStringHead {
JanetGCObject gc;
size_t length;
int32_t length;
int32_t hash;
const uint8_t data[];
};
@@ -1207,18 +1212,18 @@ struct JanetMethod {
struct JanetView {
const Janet *items;
size_t len;
int32_t len;
};
struct JanetByteView {
const uint8_t *bytes;
size_t len;
int32_t len;
};
struct JanetDictView {
const JanetKV *kvs;
size_t len;
size_t cap;
int32_t len;
int32_t cap;
};
struct JanetRange {
@@ -1582,17 +1587,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, size_t len, const char *sourcePath, Janet *out);
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_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, 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);
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);
/* Debugging */
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
@@ -1605,30 +1610,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, size_t len);
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_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(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, int32_t growth);
JANET_API void janet_array_setcount(JanetArray *array, size_t count);
JANET_API JanetArray *janet_array(int32_t capacity);
JANET_API JanetArray *janet_array_weak(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 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(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 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 void janet_buffer_deinit(JanetBuffer *buffer);
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_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_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);
@@ -1647,9 +1652,9 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#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(size_t length);
JANET_API Janet *janet_tuple_begin(int32_t length);
JANET_API JanetTuple janet_tuple_end(Janet *tuple);
JANET_API JanetTuple janet_tuple_n(const Janet *values, size_t n);
JANET_API JanetTuple janet_tuple_n(const Janet *values, int32_t n);
/* String/Symbol functions */
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
@@ -1692,7 +1697,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
#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(size_t count);
JANET_API JanetKV *janet_struct_begin(int32_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);
@@ -1702,9 +1707,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(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 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 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);
@@ -1719,7 +1724,7 @@ JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, size_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
JANET_API int janet_fiber_can_resume(JanetFiber *fiber);
@@ -1727,11 +1732,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, 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);
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);
/* Abstract */
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
@@ -1807,17 +1812,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, size_t index);
JANET_API size_t janet_length(Janet x);
JANET_API Janet janet_getindex(Janet ds, int32_t index);
JANET_API int32_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, size_t index, Janet value);
JANET_API void janet_putindex(Janet ds, int32_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, size_t cap, size_t *index_buffer);
JANET_API int32_t janet_sorted_keys(const JanetKV *dict, int32_t cap, int32_t *index_buffer);
/* VM functions */
JANET_API int janet_init(void);
@@ -2019,7 +2024,10 @@ JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
JANET_API int32_t janet_getnat(const Janet *argv, int32_t n);
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
JANET_API int16_t janet_getinteger16(const Janet *argv, int32_t n);
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
JANET_API uint32_t janet_getuinteger(const Janet *argv, int32_t n);
JANET_API uint16_t janet_getuinteger16(const Janet *argv, int32_t n);
JANET_API uint64_t janet_getuinteger64(const Janet *argv, int32_t n);
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
@@ -2177,6 +2185,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);
#endif

View File

@@ -976,4 +976,7 @@
(assert (= () '() (macex '())) "macex ()")
(assert (= '[] (macex '[])) "macex []")
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
(end-suite)

View File

@@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose
# Copyright (c) 2024 Calvin Rose
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@@ -85,9 +85,11 @@
(buffer/push-uint16 buffer-uint16-le :le 0x0102)
(assert (= "\x02\x01" (string buffer-uint16-le)) "buffer/push-uint16 little endian")
(def buffer-uint16-negative @"")
(buffer/push-uint16 buffer-uint16-negative :be -1)
(assert (= "\xff\xff" (string buffer-uint16-negative)) "buffer/push-uint16 negative")
(def buffer-uint16-max @"")
(buffer/push-uint16 buffer-uint16-max :be 0xFFFF)
(assert (= "\xff\xff" (string buffer-uint16-max)) "buffer/push-uint16 max")
(assert-error "too large" (buffer/push-uint16 @"" 0x1FFFF))
(assert-error "too small" (buffer/push-uint16 @"" -0x1))
(def buffer-uint32-be @"")
(buffer/push-uint32 buffer-uint32-be :be 0x01020304)
@@ -97,9 +99,9 @@
(buffer/push-uint32 buffer-uint32-le :le 0x01020304)
(assert (= "\x04\x03\x02\x01" (string buffer-uint32-le)) "buffer/push-uint32 little endian")
(def buffer-uint32-negative @"")
(buffer/push-uint32 buffer-uint32-negative :be -1)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-negative)) "buffer/push-uint32 negative")
(def buffer-uint32-max @"")
(buffer/push-uint32 buffer-uint32-max :be 0xFFFFFFFF)
(assert (= "\xff\xff\xff\xff" (string buffer-uint32-max)) "buffer/push-uint32 max")
(def buffer-float32-be @"")
(buffer/push-float32 buffer-float32-be :be 1.234)
@@ -162,5 +164,20 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# buffer/format-at
(def start-buf (buffer/new-filled 100 (chr "x")))
(buffer/format-at start-buf 50 "aa%dbb" 32)
(assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb" (string/repeat "x" 44)))
"buffer/format-at 1")
(assert
(deep=
(buffer/format @"" "%j" [1 2 3 :a :b :c])
(buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c]))
"buffer/format-at empty buffer")
(def buf @"xxxyyy")
(buffer/format-at buf -4 "xxx")
(assert (= (string buf) "xxxxxx") "buffer/format-at negative index")
(assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc"))
(end-suite)

125
test/suite-bundle.janet Normal file
View File

@@ -0,0 +1,125 @@
# Copyright (c) 2024 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)
(assert true) # smoke test
# Copy since not exposed in boot.janet
(defn- bundle-rpath
[path]
(string/replace-all "\\" "/" (os/realpath path)))
(defn- rmrf
"rm -rf in janet"
[x]
(case (os/lstat x :mode)
nil nil
:directory (do
(each y (os/dir x)
(rmrf (string x "/" y)))
(os/rmdir x))
(os/rm x))
nil)
# Test mkdir -> rmdir
(assert (os/mkdir "tempdir123"))
(rmrf "tempdir123")
# Setup a temporary syspath for manipultation
(math/seedrandom (os/cryptorand 16))
(def syspath (string (math/random) "_jpm_tree.tmp"))
(rmrf syspath)
(assert (os/mkdir syspath))
(put root-env *syspath* (bundle-rpath syspath))
(unless (os/getenv "VERBOSE")
(setdyn *out* @""))
(assert (empty? (bundle/list)) "initial bundle/list")
(assert (empty? (bundle/topolist)) "initial bundle/topolist")
# Try (and fail) to install sample-bundle (missing deps)
(assert-error "missing dependencies sample-dep1, sample-dep2"
(bundle/install "./examples/sample-bundle"))
(assert (empty? (bundle/list)))
# Install deps (dep1 as :auto-remove)
(assert-no-error "sample-dep2"
(bundle/install "./examples/sample-dep2"))
(assert (= 1 (length (bundle/list))))
(assert-no-error "sample-dep1" (bundle/install "./examples/sample-dep1"))
(assert (= 2 (length (bundle/list))))
(assert-no-error "sample-dep2 reinstall" (bundle/reinstall "sample-dep2"))
(assert-no-error "sample-dep1 reinstall" (bundle/reinstall "sample-dep1" :auto-remove true))
(assert (= 2 (length (bundle/list))) "bundles are listed correctly 1")
(assert (= 2 (length (bundle/topolist))) "bundles are listed correctly 2")
# Now install sample-bundle
(assert-no-error "sample-bundle install" (bundle/install "./examples/sample-bundle"))
(assert-error "" (bundle/install "./examples/sample-dep11111"))
(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
# Check topolist has not bad order
(def tlist (bundle/topolist))
(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep2" tlist)) "topolist 1")
(assert (> (index-of "sample-bundle" tlist) (index-of "sample-dep1" tlist)) "topolist 2")
(assert (> (index-of "sample-dep1" tlist) (index-of "sample-dep2" tlist)) "topolist 3")
# Prune should do nothing
(assert-no-error "first prune" (bundle/prune))
(assert (= 3 (length (bundle/list))) "bundles are listed correctly 3")
(assert (= 3 (length (bundle/topolist))) "bundles are listed correctly 4")
# Check that we can import the main dependency
(import mymod)
(assert (= 288 (mymod/myfn 12)) "using sample-bundle")
# Manual uninstall of dep1 and dep2 shouldn't work either since that would break dependencies
(assert-error "cannot uninstall sample-dep1, breaks dependent bundles @[\"sample-bundle\"]"
(bundle/uninstall "sample-dep1"))
# Now re-install sample-bundle as auto-remove
(assert-no-error "sample-bundle install" (bundle/reinstall "sample-bundle" :auto-remove true))
# Reinstallation should also work without being concerned about breaking dependencies
(assert-no-error "reinstall dep" (bundle/reinstall "sample-dep2"))
# Now prune should get rid of everything except sample-dep2
(assert-no-error "second prune" (bundle/prune))
# Now check that we exactly one package left, which is dep2
(assert (= 1 (length (bundle/list))) "bundles are listed correctly 5")
(assert (= 1 (length (bundle/topolist))) "bundles are listed correctly 6")
# Which we can uninstall manually
(assert-no-error "uninstall dep2" (bundle/uninstall "sample-dep2"))
# Now check bundle listing is again empty
(assert (= 0 (length (bundle/list))) "bundles are listed correctly 7")
(assert (= 0 (length (bundle/topolist))) "bundles are listed correctly 8")
(rmrf syspath)
(end-suite)

View File

@@ -42,7 +42,7 @@
(defn buffer-factory
[]
@"im am a buffer")
@"i am a buffer")
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")