1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-20 17:24:48 +00:00

Compare commits

...

110 Commits

Author SHA1 Message Date
Calvin Rose
2739605184 Add support for cuddled symbol shorthand. 2020-03-31 20:39:02 -05:00
Calvin Rose
5b6b9f1597 Prepare for 1.8.1 release. 2020-03-31 09:49:09 -05:00
Calvin Rose
47f246ba66 Merge pull request #329 from pepe/master
Fix typo flie
2020-03-31 09:17:39 -05:00
Josef Pospíšil
b6b70d54ef Fix typo flie 2020-03-31 15:31:27 +02:00
Calvin Rose
417d9a14cc s/yaml/yml/g in README.md 2020-03-31 08:03:38 -05:00
Calvin Rose
244566ccd4 Remove manual feature definitions in boot.
Instead, reuse features as defined in features.h
2020-03-31 07:52:20 -05:00
Calvin Rose
ca4a35c90a Update CHANGELOG.md 2020-03-30 16:59:51 -05:00
Calvin Rose
e4ea8bc867 Fix features for bsd.
Don't define XOPEN_SOURCE unless we actually need it.
2020-03-30 15:38:03 -05:00
q66
5d840b944b Fix wrong check on big endian systems
We can't randomly type pun random-sized types on big endian
systems.
2020-03-30 13:38:49 -05:00
q66
1e28876494 Fix typo in big endian unmarshalling code
This was subtly breaking everything.
2020-03-30 13:38:49 -05:00
q66
a40b2767c5 Fix endian check for little endian PowerPC and maybe others
This fixes various subtle breakage on ppc64le at very least.
2020-03-30 13:38:49 -05:00
Calvin Rose
279b536646 Prepare for 1.8.0 release. 2020-03-29 14:18:28 -05:00
Calvin Rose
ff163a5ae4 Use modulo instead of remainder for even?/odd?.
Works better for negative and fractional numbers.
2020-03-28 10:23:28 -05:00
Calvin Rose
65379741f7 Address edge case of reduce2 when ind is empty.
Same for accumulate 2.
2020-03-27 12:45:40 -05:00
Calvin Rose
3eb0927a2b Add accumulate(2) and reduce2
These functions are variations on reduce and can be quite useful.
Improve error message for jpm as well.
2020-03-26 21:35:11 -05:00
Calvin Rose
a3a45511e5 Remove lockfile.janet 2020-03-26 00:40:03 -05:00
Calvin Rose
a20ea702e2 Add infinite loop detection and complex deps.
We needed to handle dependencies that had both a url
and a tag component.
2020-03-26 00:34:34 -05:00
Calvin Rose
d2d0300c7e Remove use of cd in make-lockfile. 2020-03-26 00:12:18 -05:00
Calvin Rose
6e8aac984f Update CHANGELOG.md 2020-03-25 21:06:45 -05:00
Calvin Rose
6721c70b9e Fix typo in jpm. 2020-03-25 21:01:54 -05:00
Calvin Rose
b8c1c1c144 Get lockfile info from manifest, not cache.
Make manifest files track more information.
Use jdn to store manifest files, as well as repo url and
sha.
2020-03-25 20:58:53 -05:00
Calvin Rose
e380c01dd1 Add lockfiles to jpm.
Add make-lockfile and load-lockfile commands.
2020-03-25 19:44:30 -05:00
Calvin Rose
655633ef34 Tweak docstring. 2020-03-25 18:00:15 -05:00
Calvin Rose
3d1de237f6 Several changes to the os module.
- Add os/symlink
- Add os/realpath
2020-03-24 19:47:21 -05:00
Calvin Rose
6a63b13d69 Fix os/link docstring - Address #323 2020-03-21 16:18:58 -05:00
Calvin Rose
3aca5502dc Allow :dst to be nil to set tm_isdst to be -1. 2020-03-18 22:23:27 -05:00
Calvin Rose
665f4bf248 Remove windows MSVC warnings about _stat. 2020-03-18 21:37:55 -05:00
Calvin Rose
b76ff3bdfc Fix omission of daylight savings time in mktime
Since with daylight savings times, certain times
are ambiguous (the hours before and after the switch), mktime
needs to allow reading a dst flag.
2020-03-18 21:23:35 -05:00
Calvin Rose
00450cd9db try and remove warnings on windows, format os.c. 2020-03-18 21:15:50 -05:00
Calvin Rose
c344a543b0 Merge pull request #318 from leahneukirchen/mktime
os/date fixes and os/mktime
2020-03-18 20:59:08 -05:00
Calvin Rose
554202f6e8 Merge branch 'master' of github.com:janet-lang/janet 2020-03-18 18:37:11 -05:00
Calvin Rose
7590cfc610 Update meson build file to try and fix LGTM. 2020-03-18 18:36:41 -05:00
Calvin Rose
eee8338064 Merge pull request #319 from leahneukirchen/lstat
os/lstat and os/readlink
2020-03-18 17:58:32 -05:00
Calvin Rose
3b5183a74e Fixes #316: os/execute should return non-zero on signals
Behave more like shells, and catch segfaults.
2020-03-18 17:49:20 -05:00
Leah Neukirchen
3ee43c3abb add os/mktime, an inverse to os/date. 2020-03-18 23:45:02 +01:00
Leah Neukirchen
efdb13f0c7 os/date: allow negative timestamps.
Why not?  Even on 32-bit time_t systems this lasts until late 1901.
2020-03-18 23:45:02 +01:00
Leah Neukirchen
f013c6e48d os/date: check the second argument truthy, not the third. 2020-03-18 23:45:02 +01:00
Leah Neukirchen
6e67899401 Add os/readlink. 2020-03-18 20:05:48 +01:00
Leah Neukirchen
381dd1ce98 Add os/lstat. 2020-03-18 20:05:48 +01:00
Calvin Rose
b0d8369534 Increase reference accuracy of on-stack close envs.
Using a bitset to indicate which stack values are upvalues, we
can more accurately track when a reference to a stack value
persists after the stack frame exits.
2020-03-18 09:30:10 -05:00
Calvin Rose
4a7b18d841 Merge pull request #317 from andrewchambers/closureenvs
Add test cases for closure edge cases.
2020-03-17 22:05:35 -05:00
Andrew Chambers
7c4ffe9b9a Add test cases for closure edge cases. 2020-03-18 15:40:41 +13:00
Calvin Rose
de4f8f9aaf Marshal alive fibers in func envs as detached.
This will help with marshaling fibers.
2020-03-17 20:53:11 -05:00
Calvin Rose
6554cc4a8d Merge branch 'master' of github.com:janet-lang/janet 2020-03-17 18:58:33 -05:00
Calvin Rose
fac47e8ecb When marshalling a closure, try to detach funcenvs
If possible, this will reduce the need to marshal fibers
in many cases. Also add this logic to the GC so holding a closure
that originally came from a fiber that crashed does not cause that fiber
to hang around forever.
2020-03-17 18:55:32 -05:00
Calvin Rose
7443305039 Merge pull request #315 from andrewchambers/u64
Properly export u64_type
2020-03-16 17:15:20 -05:00
Andrew Chambers
635ae3a523 Properly export u64_type 2020-03-17 11:02:57 +13:00
Calvin Rose
4a05b4556e Fix MSVC build warning. 2020-03-14 12:02:31 -05:00
Calvin Rose
c074615550 Revert to 9 char permission strings on windows. 2020-03-14 12:00:11 -05:00
Calvin Rose
bac2b74b3d Add os/chmod. 2020-03-14 11:57:04 -05:00
Calvin Rose
a3aaa6634d Use separate registry table for abstract types.
This avoids overloading the registry table, which is intended
for names of c functions.
2020-03-14 10:25:39 -05:00
Calvin Rose
6a3a983f43 Expose abstract type definitions in janet.h
This makes certain operations easier, and allows
more access to built in APIs.
2020-03-14 10:12:47 -05:00
Calvin Rose
7996edfef9 Update README.md - Fixes #308 2020-03-13 20:00:32 -05:00
Calvin Rose
0600b32908 Fix docstring for os/cd - Fixes #307 2020-03-13 15:01:48 -05:00
Calvin Rose
77343e02e9 Fixes #304
Add chr macro.
2020-03-10 22:46:50 -05:00
Calvin Rose
a3d4ecddba Address #301
Incorrect bounds checking and offset calculation in buffer/blit.
2020-03-08 20:44:03 -05:00
Calvin Rose
3d3d314fb7 Remove warning about math.h on aarch64 ubuntu gcc. 2020-03-07 14:05:28 -06:00
Calvin Rose
3f3b756b61 Merge pull request #298 from leahneukirchen/m-del
Make alt-backspace behave like ctrl-w.
2020-03-07 10:14:14 -06:00
Calvin Rose
d3b9b8d452 For #293, correct wildcards in dictinoaries. 2020-03-07 10:13:10 -06:00
Calvin Rose
390c042027 Update README.md 2020-03-07 09:49:25 -06:00
Calvin Rose
c864828735 Address #293 - wildcard to match macro.
The _ symbol will match any value without creating a binding.
2020-03-07 09:40:02 -06:00
Calvin Rose
e0c9910d85 Add :range-to and :down-to to loop.
Fully inclusive ranges are generally useful and
do not complicate implementation much.
2020-03-07 09:34:11 -06:00
Calvin Rose
e62f12426b Update ci build files. 2020-03-06 18:11:29 -06:00
Calvin Rose
d3af50e4cc Rename: s/yaml/yml/g 2020-03-06 17:42:35 -06:00
Calvin Rose
cbdb700edf No need for doubly hidden files. 2020-03-06 17:35:03 -06:00
Calvin Rose
6010b95fca Remove spaces from build manifests for sourcehut. 2020-03-06 17:30:36 -06:00
Calvin Rose
e351dde651 Update CHANGELOG.md and docs for loop and pp. 2020-03-06 17:12:06 -06:00
Calvin Rose
714bd61d56 Address #300
Check for empty capture stack in replace rule.
2020-03-06 10:05:20 -06:00
Calvin Rose
f9e9c70b6c Update CHANGELOG.md 2020-03-06 08:40:51 -06:00
Calvin Rose
6123c41f13 Harden semantics for and and or macros.
There was perviously a bit of fuzziness on returning false/nil
from these macros that has been removed.
2020-03-06 08:37:59 -06:00
Leah Neukirchen
1aaa5618de Make alt-backspace behave like ctrl-w.
Another common binding in readline and its clones.
2020-03-06 10:55:45 +01:00
Calvin Rose
fbe8998ca8 Merge branch 'master' of github.com:janet-lang/janet 2020-03-05 09:35:04 -06:00
Calvin Rose
47e8f669f5 Fix match behavior for lone nil. 2020-03-05 09:35:00 -06:00
Calvin Rose
d804ee3c07 Merge pull request #296 from leahneukirchen/ctrl-d
Make ctrl-d behave like delete, but exit on an empty line.
2020-03-04 20:42:05 -06:00
Calvin Rose
06a78d90d9 Merge pull request #295 from leahneukirchen/meson-pkgconfig
Create janet.pc also from Meson.
2020-03-04 20:39:24 -06:00
Leah Neukirchen
bc2ebce086 Make ctrl-d behave like delete, but exit on an empty line.
This is the default readline behavior.
2020-03-04 14:56:04 +01:00
Leah Neukirchen
a07de921d0 Create janet.pc also from Meson. 2020-03-04 14:35:57 +01:00
Calvin Rose
6bc67b70a6 Address #294
Correct invalid format string, which masked a panic
with another, less useful panic.
2020-03-03 22:26:26 -06:00
Calvin Rose
f06addfe06 For #240, address case when LDCONFIG is empty 2020-03-03 18:13:25 -06:00
Calvin Rose
7c2c50ee16 For #240 - don't run ldconfig for DESTDIR installs. 2020-03-03 18:03:44 -06:00
Calvin Rose
8580d3c27e Address #240 - Support DESTDIR in Makefile. 2020-03-03 17:45:59 -06:00
Calvin Rose
951e10f272 Address #292
Faulty Makefile fallback.
2020-03-03 08:21:14 -06:00
Calvin Rose
2349ea9405 Update docs for buffer/push-word
Should be little endian, not big endian.
2020-03-01 12:05:24 -06:00
Calvin Rose
b17bf259f7 Fix typo: destory -> destroy 2020-02-28 09:04:28 -06:00
Calvin Rose
6b093bdcca Address #288 and partially #287
The %q formatter for janet_formatc now expects a Janet, not a JanetString or
JanetSymbol or JanetKeyword.

Also fix some reference counting issues with threads when destroying
threads, which should fix #287's
SIGSEGV. Still fails to send messages sometimes, though.
2020-02-27 17:58:17 -06:00
Calvin Rose
10ec319c32 Add better debug info to amalgamated source. 2020-02-27 00:16:54 -06:00
Calvin Rose
8cb63cebbe Remove 'make test-amalg' from CI. 2020-02-25 20:31:38 -06:00
Calvin Rose
7d26de6697 Update changelog. 2020-02-25 20:08:22 -06:00
Calvin Rose
8262290bff Improve C string format (janet_formatc, janet_panicf)
The supported formatters here now match up more with
the string/format, buffer/format, printf, eprintf, etc.
2020-02-25 20:05:45 -06:00
Calvin Rose
2779037f13 Clean up Makefile. 2020-02-25 20:02:03 -06:00
Calvin Rose
734c85d7ef Properly handle recursion with labels.
Use an empty buffer, which has pointer equality semantics, for
tag from a label.
2020-02-23 17:35:01 -06:00
Calvin Rose
05bd5767de Add label macro.
A lexically scoped version of prompt is often useful.
2020-02-23 17:15:04 -06:00
Calvin Rose
59d288c429 Add prompt and return.
User friendly delimited continuations. While this was doable with
signals before, this does not require C and will play nicely with
existing error handling, defers, and with statements.
2020-02-23 16:46:54 -06:00
Calvin Rose
8c41c0b6a7 Address MSVC warning. 2020-02-23 15:27:57 -06:00
Calvin Rose
f5f3858da1 Update CHANGELOG.md 2020-02-23 14:55:21 -06:00
Calvin Rose
738490e674 Allow function that takes 1 argument to fiber/new.
This allows reuse of closures when creating many fibers.
2020-02-23 14:47:29 -06:00
Calvin Rose
6a13703e32 Add signal and fiber/can-resume?.
These additions, along with the change that user signals 0-4 cannot
be resumed, allow delimited continuation semantics, while repsecting
existing forms like `defer`, `with`, `with-vars`, etc.
2020-02-23 13:31:27 -06:00
Calvin Rose
20d5d560f3 Add bf to main test suite. 2020-02-22 19:18:08 -06:00
Calvin Rose
aaabca6fc7 Make flychecker handle more kinds of defs.
This should help when redefining certain forms. Will also
not do functional arity checking against nil forms, as that
is the default value when a def doesn't evaluate.
2020-02-21 21:20:40 -06:00
Calvin Rose
4b440618d6 Correct docs for type form. 2020-02-21 20:22:43 -06:00
Calvin Rose
a360cb7922 Update marshal to take 3 arguments. 2020-02-15 10:04:44 -06:00
Calvin Rose
b9a2bb8104 Fix documentation for defer. 2020-02-12 09:34:23 -06:00
Calvin Rose
031a9894b0 Update inlining options for next and resume. 2020-02-08 13:03:03 -06:00
Calvin Rose
fcc09d7ea9 Clarify docs for some and all. 2020-02-05 21:06:39 -06:00
Calvin Rose
d8d482e433 Merge branch 'master' of github.com:janet-lang/janet 2020-02-03 18:18:29 -06:00
Calvin Rose
3fdc053d6c Add flush and eflush (#278)
These functions interact with Janet's dynamically scoped
IO functions in a manner that is more useful the file/flush.
We can still redirect to a buffer without changing our code.
2020-02-03 18:14:32 -06:00
Calvin Rose
8be3ce18aa Merge pull request #280 from pepe/fix-next-arity
Fix next function arity
2020-02-03 18:00:36 -06:00
Josef Pospíšil
00107c092c Fix next function arity 2020-02-03 15:36:42 +01:00
Calvin Rose
64e1961193 Update version strings to 1.7.1-dev. 2020-02-02 09:38:44 -06:00
Calvin Rose
f7ee8bd30d Update to version 1.7.0. 2020-02-01 23:35:17 -06:00
43 changed files with 1700 additions and 573 deletions

View File

@@ -1,13 +0,0 @@
image: freebsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
sudo gmake install
gmake test-install
gmake test-amalg

View File

@@ -1,13 +0,0 @@
image: openbsd/6.5
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install
gmake test-amalg

12
.builds/freebsd.yml Normal file
View File

@@ -0,0 +1,12 @@
image: freebsd/12.x
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
sudo gmake install
gmake test-install

12
.builds/openbsd.yml Normal file
View File

@@ -0,0 +1,12 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- gmake
tasks:
- build: |
cd janet
gmake
gmake test
doas gmake install
gmake test-install

3
.gitignore vendored
View File

@@ -13,6 +13,9 @@ janet
janet-*.tar.gz
dist
# jpm lockfile
lockfile.janet
# Kakoune (fzf via fd)
.fdignore

View File

@@ -4,7 +4,6 @@ script:
- make test
- sudo make install
- make test-install
- make test-amalg
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
compiler:
- clang

View File

@@ -1,7 +1,35 @@
# Changelog
All notable changes to this project will be documented in this file.
### Unreleased
## 1.8.1 - 2020-03-31
- Fix bugs for big endian systems
- Fix 1.8.0 regression on BSDs
## 1.8.0 - 2020-03-29
- Add `reduce2`, `accumulate`, and `accumulate2`.
- Add lockfiles to `jpm` via `jpm make-lockfile` and `jpm load-lockfile`.
- Add `os/realpath` (Not supported on windows).
- Add `os/chmod`.
- Add `chr` macro.
- Allow `_` in the `match` macro to match anything without creating a binding
or doing unification. Also change behavior of matching nil.
- Add `:range-to` and `:down-to` verbs in the `loop` macro.
- Fix `and` and `or` macros returning nil instead of false in some cases.
- Allow matching successfully against nil values in the `match` macro.
- Improve `janet_formatc` and `janet_panicf` formatters to be more like `string/format`.
This makes it easier to make nice error messages from C.
- Add `signal`
- Add `fiber/can-resume?`
- Allow fiber functions to accept arguments that are passed in via `resume`.
- Make flychecking slightly less strict but more useful
- Correct arity for `next`
- Correct arity for `marshal`
- Add `flush` and `eflush`
- Add `prompt` and `return` on top of signal for user friendly delimited continuations.
- Fix bug in buffer/blit when using the offset-src argument.
- Fix segfault with malformed pegs.
## 1.7.0 - 2020-02-01
- Remove `file/fileno` and `file/fdopen`.
- Remove `==`, `not==`, `order<`, `order>`, `order<=`, and `order>=`. Instead, use the normal
comparison and equality functions.
@@ -32,7 +60,7 @@ All notable changes to this project will be documented in this file.
- Fix thread module issue where sometimes decoding a message failed.
- Fix segfault regression when macros are called with bad arity.
### 1.6.0 - 2019-12-22
## 1.6.0 - 2019-12-22
- Add `thread/` module to the core.
- Allow seeding RNGs with any sequence of bytes. This provides
a wider key space for the RNG. Exposed in C as `janet_rng_longseed`.

View File

@@ -27,7 +27,7 @@ PREFIX?=/usr/local
INCLUDEDIR?=$(PREFIX)/include
BINDIR?=$(PREFIX)/bin
LIBDIR?=$(PREFIX)/lib
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || 'local')\""
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1 || echo local)\""
CLIBS=-lm -lpthread
JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
@@ -37,8 +37,7 @@ MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
-DJANET_BUILD=$(JANET_BUILD)
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
LDFLAGS:=$(LDFLAGS) -rdynamic
# For installation
@@ -48,13 +47,13 @@ LDCONFIG:=ldconfig "$(LIBDIR)"
UNAME:=$(shell uname -s)
ifeq ($(UNAME), Darwin)
CLIBS:=$(CLIBS) -ldl
LDCONFIG:=
LDCONFIG:=true
else ifeq ($(UNAME), Linux)
CLIBS:=$(CLIBS) -lrt -ldl
endif
# For other unix likes, add flags here!
ifeq ($(UNAME), Haiku)
LDCONFIG:=
LDCONFIG:=true
LDFLAGS=-Wl,--export-dynamic
endif
@@ -129,14 +128,15 @@ JANET_BOOT_HEADERS=src/boot/tests.h
##########################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
build/%.boot.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
$(CC) $(BOOT_CFLAGS) -o $@ -c $<
build/janet_boot: $(JANET_BOOT_OBJECTS)
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
# Now the reason we bootstrap in the first place
build/janet.c: build/janet_boot src/boot/boot.janet
@@ -230,7 +230,7 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
SONAME=libjanet.so.1
.PHONY: build/janet.pc
.INTERMEDIATE: build/janet.pc
build/janet.pc: $(JANET_TARGET)
echo 'prefix=$(PREFIX)' > $@
echo 'exec_prefix=$${prefix}' >> $@
@@ -246,33 +246,33 @@ build/janet.pc: $(JANET_TARGET)
echo 'Libs.private: $(CLIBS)' >> $@
install: $(JANET_TARGET) build/janet.pc
mkdir -p '$(BINDIR)'
cp $(JANET_TARGET) '$(BINDIR)/janet'
mkdir -p '$(INCLUDEDIR)/janet'
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
mkdir -p '$(JANET_PATH)'
mkdir -p '$(LIBDIR)'
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
cp -rf auxbin/* '$(BINDIR)'
mkdir -p '$(MANPATH)'
cp janet.1 '$(MANPATH)'
cp jpm.1 '$(MANPATH)'
mkdir -p '$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
-$(LDCONFIG)
mkdir -p '$(DESTDIR)$(BINDIR)'
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
cp -rf $(JANET_HEADERS) '$(DESTDIR)$(INCLUDEDIR)/janet'
mkdir -p '$(DESTDIR)$(JANET_PATH)'
mkdir -p '$(DESTDIR)$(LIBDIR)'
cp $(JANET_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf auxbin/* '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
uninstall:
-rm '$(BINDIR)/janet'
-rm '$(BINDIR)/jpm'
-rm -rf '$(INCLUDEDIR)/janet'
-rm -rf '$(LIBDIR)'/libjanet.*
-rm '$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(MANPATH)/janet.1'
-rm '$(MANPATH)/jpm.1'
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
-rm '$(DESTDIR)$(BINDIR)/janet'
-rm '$(DESTDIR)$(BINDIR)/jpm'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(MANPATH)/janet.1'
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
#################
##### Other #####
@@ -301,15 +301,5 @@ test-install:
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
$(CC) $(CFLAGS) -c $< -o $@
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
$(CC) $(CFLAGS) -c $< -o $@
build/embed_test: build/embed_janet.o build/embed_main.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
test-amalg: build/embed_test
./build/embed_test
.PHONY: clean install repl debug valgrind test \
valtest emscripten dist uninstall docs grammar format

View File

@@ -2,26 +2,28 @@
&nbsp;
[![Appveyor Status](https://ci.appveyor.com/api/projects/status/bjraxrxexmt3sxyv/branch/master?svg=true)](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml.svg)](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/openbsd.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
modern lisp, but lists are replaced
by other data structures with better utility and performance (arrays, tables, structs, tuples).
by other data structures (arrays, tables (hash table), struct (immutable hash table), tuples).
The language also supports bridging to native code written in C, meta-programming with macros, and bytecode assembly.
There is a repl for trying out the language, as well as the ability
to run script files. This client program is separate from the core runtime, so
janet could be embedded into other programs. Try janet in your browser at
Janet can be embedded into other programs. Try Janet in your browser at
[https://janet-lang.org](https://janet-lang.org).
<br>
## Use Cases
Janet makes a good system scripting language, or a language to embed in other programs, like Lua or Guile.
Janet makes a good system scripting language, or a language to embed in other programs.
It's like Lua and Guile in that regard. It has more built-in functionality and a richer core language than
Lua, but smaller than GNU Guile or Python.
## Features
@@ -43,7 +45,7 @@ Janet makes a good system scripting language, or a language to embed in other pr
* Imperative programming as well as functional
* REPL
* Parsing Expression Grammars built in to the core library
* 300+ functions and macros in the core library
* 400+ functions and macros in the core library
* Embedding Janet in other programs
* Interactive environment with detailed stack traces
@@ -61,7 +63,9 @@ documentation for symbols in the core library. For example,
Shows documentation for the doc macro.
To get a list of all bindings in the default
environment, use the `(all-bindings)` function.
environment, use the `(all-bindings)` function. You
can also use the `(doc)` macro with no arguments if you are in the repl
to show bound symbols.
## Source
@@ -122,7 +126,7 @@ is maybe more convenient and flexible for integrating into existing pipelines.
Meson also provides much better IDE integration than Make or batch files, as well as support
for cross compilation.
For the impatient, building with Meson is as simple as follows. The options provided to
For the impatient, building with Meson is as follows. The options provided to
`meson setup` below emulate Janet's Makefile.
```sh
@@ -152,7 +156,7 @@ Emacs, and Atom will have syntax packages for the Janet language, though.
## Installation
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
to try out the language, you don't need to install anything. You can also move the `janet` executable wherever you want on your system and run it.
## Usage
@@ -163,35 +167,38 @@ If you are looking to explore, you can print a list of all available macros, fun
by entering the command `(all-bindings)` into the repl.
```
$ ./janet
Janet 0.0.0 alpha Copyright (C) 2017-2018 Calvin Rose
$ janet
Janet 1.7.1-dev-951e10f Copyright (C) 2017-2020 Calvin Rose
janet:1:> (+ 1 2 3)
6
janet:2:> (print "Hello, World!")
Hello, World!
nil
janet:3:> (os/exit)
$ ./janet -h
usage: ./janet [options] scripts...
$ janet -h
usage: build/janet [options] script args...
Options are:
-h Show this help
-v Print the version string
-s Use raw stdin instead of getline like functionality
-e Execute a string of janet
-r Enter the repl after running all scripts
-p Keep on executing if there is a top level error (persistent)
-- Stop handling option
$
-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
-r : Enter the repl after running all scripts
-p : Keep on executing if there is a top level error (persistent)
-q : Hide prompt, logo, and repl output (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
-n : Disable ANSI color output in the repl
-l path : Execute code in a file before running the main script
-- : Stop handling options
```
If installed, you can also run `man janet` to get usage information.
If installed, you can also run `man janet` and `man jpm` to get usage information.
## Embedding
The C API for Janet is not yet documented but coming soon.
Janet can be embedded in a host program very easily. There is a make target
`make amalg` which creates the file `build/janet.c`, which is a single C file
Janet can be embedded in a host program very easily. The normal build
will create a file `build/janet.c`, which is a single C file
that contains all the source to Janet. This file, along with
`src/include/janet.h` and `src/include/janetconf.h` can dragged into any C
project and compiled into the project. Janet should be compiled with `-std=c99`
@@ -200,6 +207,8 @@ the dynamic linker, `-ldl`, if one wants to be able to load dynamic modules. If
there is no need for dynamic modules, add the define
`-DJANET_NO_DYNAMIC_MODULES` to the compiler options.
See the [Embedding Section](https://janet-lang.org/capi/embedding.html) on the website for more information.
## Examples
See the examples directory for some example janet code.

View File

@@ -30,7 +30,7 @@ install:
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
- build_win test-install
- set janet_outname=%appveyor_repo_tag_name%
- if "%janet_outname%"=="" set janet_outname=v1.6.1
- if "%janet_outname%"=="" set janet_outname=v1.8.1
build: off
artifacts:

View File

@@ -194,7 +194,8 @@
(loop [k :keys currenv :when (keyword? k)]
(put env k (currenv k)))
(dofile path :env env :exit true)
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
(when-let [rules (env :rules)] (merge-into (getrules) rules))
env)
#
# OS and shell helpers
@@ -251,11 +252,7 @@
If we can't create it, give a friendly error. Return true if created, false if
existing. Throw an error if we can't create it."
[dir]
(if (os/mkdir dir)
true
(if (os/stat dir :mode)
false
(error (string "Could not create " dir " - this could be a permission issue.")))))
(os/mkdir dir))
#
# C Compilation
@@ -554,6 +551,15 @@ int main(int argc, const char **argv) {
# Public utilities
#
(defn parse
"Read a string of Janet source and parse out the first expression."
[src]
(let [p (parser/new)]
(:consume p src)
(if (= :error (:status p))
(error (string "Could not parse: " (parser/error p))))
(:produce p)))
(defn find-manifest-dir
"Get the path to the directory containing manifests for installed
packages."
@@ -563,7 +569,7 @@ int main(int argc, const char **argv) {
(defn find-manifest
"Get the full path of a manifest file given a package name."
[name]
(string (find-manifest-dir) sep name ".txt"))
(string (find-manifest-dir) sep name ".jdn"))
(defn find-cache
"Return the path to the global cache."
@@ -575,17 +581,14 @@ int main(int argc, const char **argv) {
"Uninstall bundle named name"
[name]
(def manifest (find-manifest name))
(def f (file/open manifest :r))
(unless f (print manifest " does not exist") (break))
(loop [line :iterate (:read f :line)]
(def path ((string/split "\n" line) 0))
(def path ((string/split "\r" path) 0))
(print "removing " path)
(rm path))
(:close f)
(print "removing " manifest)
(rm manifest)
(print "Uninstalled."))
(when-with [f (file/open manifest)]
(def man (parse (:read f :all)))
(each path (get man :paths [])
(print "removing " path)
(rm path))
(print "removing " manifest)
(rm manifest)
(print "Uninstalled.")))
(defn- rimraf
"Hard delete directory tree"
@@ -607,7 +610,7 @@ int main(int argc, const char **argv) {
(defn install-git
"Install a bundle from git. If the bundle is already installed, the bundle
is reinistalled (but not rebuilt if artifacts are cached)."
[repotab &opt recurse]
[repotab &opt recurse no-deps]
(def repo (if (string? repotab) repotab (repotab :repo)))
(def tag (unless (string? repotab) (repotab :tag)))
# prevent infinite recursion (very unlikely, but consider
@@ -652,7 +655,7 @@ int main(int argc, const char **argv) {
(os/execute ["git" "reset" "--hard" tag] :p))
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
(import-rules "./project.janet")
(do-rule "install-deps")
(unless no-deps (do-rule "install-deps"))
(do-rule "build")
(do-rule "install"))
([err] (print "Error building git repository dependency: " err)))
@@ -669,6 +672,49 @@ int main(int argc, const char **argv) {
(mkdir destdir)
(copy src destdir)))
(defn- pslurp
"Like slurp, but with file/popen instead file/open. Also trims output"
[cmd]
(string/trim (with [f (file/popen cmd)] (:read f :all))))
(defn- make-lockfile
[&opt filename]
(default filename "lockfile.janet")
(def cwd (os/cwd))
(def packages @[])
# Read installed modules from manifests
(def mdir (find-manifest-dir))
(each man (os/dir mdir)
(def package (parse (slurp (string mdir sep man))))
(if (and (dictionary? package) (package :repo) (package :sha))
(array/push packages package)
(print "Cannot add local or malformed package " mdir sep man " to lockfile, skipping...")))
# Put in correct order, such that a package is preceded by all of its dependencies
(def ordered-packages @[])
(def resolved @{})
(while (< (length ordered-packages) (length packages))
(var made-progress false)
(each p packages
(def {:repo r :sha s :dependencies d} p)
(def dep-urls (map |(if (string? $) $ ($ :repo)) d))
(unless (resolved r)
(when (all resolved dep-urls)
(array/push ordered-packages p)
(set made-progress true)
(put resolved r true))))
(unless made-progress
(error (string/format "could not resolve package order for: %j"
(filter (complement resolved) (map |($ :repo) packages))))))
# Write to file
(with [f (file/open filename :w)] (with-dyns [:out f] (printf "%j" ordered-packages))))
(defn- load-lockfile
[&opt filename]
(default filename "lockfile.janet")
(def lockarray (parse (slurp filename)))
(each {:repo url :sha sha} lockarray
(install-git {:repo url :tag sha} nil true)))
#
# Declaring Artifacts - used in project.janet, targets specifically
# tailored for janet.
@@ -814,7 +860,15 @@ int main(int argc, const char **argv) {
(phony "manifest" []
(print "generating " manifest "...")
(mkdir manifests)
(spit manifest (string (string/join installed-files "\n") "\n")))
(def sha (pslurp "git rev-parse HEAD"))
(def url (pslurp "git remote get-url origin"))
(def man
{:sha (if-not (empty? sha) sha)
:repo (if-not (empty? url) url)
:dependencies (array/slice (get meta :dependencies []))
:paths installed-files})
(spit manifest (string/format "%j\n" man)))
(phony "install" ["uninstall" "build" "manifest"]
(when (dyn :test)
(do-rule "test"))
@@ -888,6 +942,12 @@ Subcommands are:
rules : list rules available with run.
update-pkgs : Update the current package listing from the remote git repository selected.
quickbin entry executable : Create an executable from a janet script with a main function.
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
lockfile will record the exact versions of dependencies used to ensure a reproducible
build. Lockfiles are best used with applications, not libraries. The default lockfile
name is lockfile.janet.
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
default lockfile name is lockfile.janet.
Keys are:
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
@@ -974,6 +1034,8 @@ Flags are:
"rules" list-rules
"update-pkgs" update-pkgs
"uninstall" uninstall-cmd
"make-lockfile" make-lockfile
"load-lockfile" load-lockfile
"quickbin" quickbin})
(def- args (tuple/slice (dyn :args) 1))

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.6.1-dev')
version : '1.8.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -160,7 +160,7 @@ janetc = custom_target('janetc',
output : 'janet.c',
capture : true,
command : [
janet_boot, '@CURRENT_SOURCE_DIR@',
janet_boot, meson.current_source_dir(),
'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path
])
@@ -216,7 +216,8 @@ test_files = [
'test/suite4.janet',
'test/suite5.janet',
'test/suite6.janet',
'test/suite7.janet'
'test/suite7.janet',
'test/suite8.janet'
]
foreach t : test_files
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
@@ -229,6 +230,11 @@ run_target('repl', command : [janet_nativeclient])
janet_dep = declare_dependency(include_directories : incdir,
link_with : libjanet)
# pkgconfig
pkg = import('pkgconfig')
pkg.generate(libjanet,
description: 'Library for the Janet programming language.')
# Installation
install_man('janet.1')
install_man('jpm.1')

View File

@@ -104,7 +104,8 @@ int main(int argc, const char **argv) {
}
fclose(boot_file);
status = janet_dobytes(env, boot_buffer, boot_size, boot_filename, NULL);
status = janet_dobytes(env, boot_buffer, (int32_t) boot_size, boot_filename, NULL);
free(boot_buffer);
/* Deinitialize vm */
janet_deinit();

View File

@@ -79,8 +79,8 @@
# Basic predicates
(defn nan? "Check if x is NaN" [x] (not= x x))
(defn even? "Check if x is even." [x] (= 0 (% x 2)))
(defn odd? "Check if x is odd." [x] (not= 0 (% x 2)))
(defn even? "Check if x is even." [x] (= 0 (mod x 2)))
(defn odd? "Check if x is odd." [x] (= 1 (mod x 2)))
(defn zero? "Check if x is zero." [x] (= x 0))
(defn pos? "Check if x is greater than 0." [x] (> x 0))
(defn neg? "Check if x is less than 0." [x] (< x 0))
@@ -244,26 +244,30 @@
[(,not= :error (,fiber/status ,f)) ,r])))
(defmacro and
"Evaluates to the last argument if all preceding elements are true, otherwise
evaluates to false."
"Evaluates to the last argument if all preceding elements are truthy, otherwise
evaluates to the first falsey argument."
[& forms]
(var ret true)
(def len (length forms))
(var i len)
(while (> i 0)
(-- i)
(def v (in forms i))
(set ret (if (= ret true)
(in forms i)
(tuple 'if (in forms i) ret))))
v
(if (idempotent? v)
['if v ret v]
(do (def s (gensym))
['if ['def s v] ret s])))))
ret)
(defmacro or
"Evaluates to the last argument if all preceding elements are false, otherwise
evaluates to true."
"Evaluates to the last argument if all preceding elements are falsey, otherwise
evaluates to the first truthy element."
[& forms]
(var ret nil)
(def len (length forms))
(var i len)
(var i (- len 1))
(var ret (in forms i))
(while (> i 0)
(-- i)
(def fi (in forms i))
@@ -287,17 +291,51 @@
~(let (,;accum) ,;body))
(defmacro defer
"Run form unconditionally after form, even if the body throws an error."
"Run form unconditionally after body, even if the body throws an error.
Will also run form if a user signal 0-4 is received."
[form & body]
(with-syms [f r]
~(do
(def ,f (,fiber/new (fn [] ,;body) :ie))
(def ,f (,fiber/new (fn [] ,;body) :ti))
(def ,r (,resume ,f))
,form
(if (= (,fiber/status ,f) :dead)
,r
(propagate ,r ,f)))))
(defmacro prompt
"Set up a checkpoint that can be returned to. Tag should be a value
that is used in a return statement, like a keyword."
[tag & body]
(with-syms [res target payload fib]
~(do
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
(def ,res (,resume ,fib))
(def [,target ,payload] ,res)
(if (,= ,tag ,target)
,payload
(propagate ,res ,fib)))))
(defmacro chr
"Convert a string of length 1 to its byte (ascii) value at compile time."
[c]
(unless (and (string? c) (= (length c) 1))
(error (string/format "expected string of length 1, got %v" c)))
(c 0))
(defmacro label
"Set a label point that is lexically scoped. Name should be a symbol
that will be bound to the label."
[name & body]
~(do
(def ,name @"")
,(apply prompt name body)))
(defn return
"Return to a prompt point."
[to &opt value]
(signal 0 [to value]))
(defmacro with
"Evaluate body with some resource, which will be automatically cleaned up
if there is an error in body. binding is bound to the expression ctor, and
@@ -335,6 +373,16 @@
,;body
(set ,i (,delta ,i ,step))))))
(defn- check-indexed [x]
(if (indexed? x)
x
(error (string "expected tuple for range, got " x))))
(defn- range-template
[binding object rest op comparison]
(let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) comparison op [rest])))
(defn- each-template
[binding inx body]
(with-syms [k]
@@ -368,11 +416,6 @@
(def ,binding ,i)
,body))))
(defn- check-indexed [x]
(if (indexed? x)
x
(error (string "expected tuple for range, got " x))))
(defn- loop1
[body head i]
@@ -402,12 +445,12 @@
(def {(+ i 2) object} head)
(let [rest (loop1 body head (+ i 3))]
(case verb
:range (let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) < + [rest]))
:range (range-template binding object rest + <)
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:keys (keys-template binding object false [rest])
:pairs (keys-template binding object true [rest])
:down (let [[start stop step] (check-indexed object)]
(for-template binding start stop (or step 1) > - [rest]))
:in (each-template binding object [rest])
:iterate (iterate-template binding object rest)
:generate (with-syms [f s]
@@ -450,11 +493,14 @@
\t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
\t:range - loop over a range. The object should be two element tuple with a start
and end value, and an optional positive step. The range is half open, [start, end).\n
\t:down - Same as range, but loops in reverse.\n
\t:keys - Iterate over the keys in a data structure.\n
\t:pairs - Iterate over the keys value pairs in a data structure.\n
\t:in - Iterate over the values in an indexed data structure or byte sequence.\n
\t:generate - Iterate over values yielded from a fiber. Can be paired with the generator
\t:range-to - same as :range, but the range is inclusive [start, end].\n
\t:down - loop over a range, stepping downwards. The object should be two element tuple
with a start and (exclusive) end value, and an optional (positive!) step size.\n
\t:down-to - same :as down, but the range is inclusive [start, end].\n
\t:keys - iterate over the keys in a data structure.\n
\t:pairs - iterate over the keys value pairs as tuples in a data structure.\n
\t:in - iterate over the values in a data structure.\n
\t:generate - iterate over values yielded from a fiber. Can be paired with the generator
function for the producer/consumer pattern.\n\n
loop also accepts conditionals to refine the looping further. Conditionals are of
the form:\n\n
@@ -478,6 +524,7 @@
(put _env 'iterate-template nil)
(put _env 'each-template nil)
(put _env 'keys-template nil)
(put _env 'range-template nil)
(defmacro seq
"Similar to loop, but accumulates the loop body into an array and returns that.
@@ -596,7 +643,7 @@
(defn first
"Get the first element from an indexed data structure."
[xs]
(in xs 0))
(get xs 0))
(defn last
"Get the last element from an indexed data structure."
@@ -652,6 +699,45 @@
(each x ind (set res (f res x)))
res)
(defn reduce2
"The 2 argument version of reduce that does not take an initialization value.
Instead the first element of the array is used for initialization."
[f ind]
(var k (next ind))
(if (= nil k) (break nil))
(var res (in ind k))
(set k (next ind k))
(while (not= nil k)
(set res (f res (in ind k)))
(set k (next ind k)))
res)
(defn accumulate
"Similar to reduce, but accumulates intermediate values into an array.
The last element in the array is what would be the return value from reduce.
The init value is not added to the array.
Returns a new array."
[f init ind]
(var res init)
(def ret (array/new (length ind)))
(each x ind (array/push ret (set res (f res x))))
ret)
(defn accumulate2
"The 2 argument version of accumulate that does not take an initialization value."
[f ind]
(var k (next ind))
(def ret (array/new (length ind)))
(if (= nil k) (break ret))
(var res (in ind k))
(array/push ret res)
(set k (next ind k))
(while (not= nil k)
(set res (f res (in ind k)))
(array/push ret res)
(set k (next ind k)))
ret)
(defn map
"Map a function over every element in an indexed data structure and
return an array of the results."
@@ -975,11 +1061,10 @@
(with-syms [ret f s]
~(do
,;saveold
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ei))
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
(def ,ret (,resume ,f))
,;restoreold
(if (= (,fiber/status ,f) :error) (,propagate ,ret ,f))
,ret)))
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
(defn partial
"Partial function application."
@@ -1250,9 +1335,10 @@
nil)
(defn pp
"Pretty print to stdout or (dyn :out)."
`Pretty print to stdout or (dyn :out). The format string used is (dyn :pretty-format "%q").`
[x]
(print (buffer/format @"" (dyn :pretty-format "%q") x)))
(printf (dyn :pretty-format "%q") x)
(flush))
###
###
@@ -1285,12 +1371,15 @@
[pattern expr onmatch seen]
(cond
(= '_ pattern)
(onmatch)
(symbol? pattern)
(if (in seen pattern)
~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
(do
(put seen pattern true)
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
~(do (def ,pattern ,expr) ,(onmatch))))
(and (tuple? pattern) (= :parens (tuple/type pattern)))
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
@@ -1307,12 +1396,14 @@
(var i -1)
(with-idemp
$arr expr
~(if (indexed? ,$arr)
,((fn aux []
(++ i)
(if (= i len)
(onmatch)
(match-1 (in pattern i) (tuple in $arr i) aux seen))))
~(if (,indexed? ,$arr)
(if (< (,length ,$arr) ,len)
,sentinel
,((fn aux []
(++ i)
(if (= i len)
(onmatch)
(match-1 (in pattern i) (tuple in $arr i) aux seen)))))
,sentinel)))
(dictionary? pattern)
@@ -1320,26 +1411,29 @@
(var key nil)
(with-idemp
$dict expr
~(if (dictionary? ,$dict)
~(if (,dictionary? ,$dict)
,((fn aux []
(set key (next pattern key))
(def $val (gensym))
(if (= key nil)
(onmatch)
(match-1 (in pattern key) (tuple in $dict key) aux seen))))
~(do (def ,$val (,get ,$dict ,key))
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
,sentinel)))
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
(defmacro match
"Pattern matching. Match an expression x against
any number of cases. Easy case is a pattern to match against, followed
any number of cases. Each case is a pattern to match against, followed
by an expression to evaluate to if that case is matched. A pattern that is
a symbol will match anything, binding x's value to that symbol. An array
will match only if all of it's elements match the corresponding elements in
x. A table or struct will match if all values match with the corresponding
values in x. A tuple pattern will match if it's first element matches, and the following
elements are treated as predicates and are true. Any other value pattern will only
match if it is equal to x."
elements are treated as predicates and are true. The last special case is
the '_ symbol, which is a wildcard that will match any value without creating a binding.
Any other value pattern will only match if it is equal to x."
[x & cases]
(with-idemp $x x
(def len (length cases))
@@ -1582,14 +1676,16 @@
ret)
(defn all
"Returns true if all xs are truthy, otherwise the first false or nil value."
"Returns true if all xs are truthy, otherwise the resulty of first
falsey predicate value, (pred x)."
[pred xs]
(var ret true)
(loop [x :in xs :while ret] (set ret (pred x)))
ret)
(defn some
"Returns nil if all xs are false or nil, otherwise returns the first true value."
"Returns nil if all xs are false or nil, otherwise returns the result of the
first truthy predicate, (pred x)."
[pred xs]
(var ret nil)
(loop [x :in xs :while (not ret)] (if-let [y (pred x)] (set ret y)))
@@ -1775,7 +1871,8 @@
(string col)
": "
(parser/error p)
(if ec "\e[0m" "")))
(if ec "\e[0m" ""))
(eflush))
(defn bad-compile
"Default handler for a compile error."
@@ -1789,7 +1886,8 @@
msg
" while compiling "
where
(if ec "\e[0m" ""))))
(if ec "\e[0m" "")))
(eflush))
(defn run-context
"Run a context. This evaluates expressions of janet in an environment,
@@ -1850,8 +1948,7 @@
(on-compile-error msg errf where))))
(or guard :a)))
(fiber/setenv f env)
(while (let [fs (fiber/status f)]
(and (not= :dead fs) (not= :error fs)))
(while (fiber/can-resume? f)
(def res (resume f resumeval))
(when good (when going (set resumeval (onstatus f res))))))
@@ -2086,7 +2183,7 @@
:on-status (fn [f x]
(when (not= (fiber/status f) :dead)
(debug/stacktrace f x)
(if exit-on-error (os/exit 1))))
(if exit-on-error (os/exit 1) (eflush))))
:evaluator evaluator
:expander expander
:source (if path-is-file "<anonymous>" spath)}))
@@ -2189,14 +2286,17 @@
(put nextenv :debug-level level)
(put nextenv :signal x)
(debug/stacktrace f x)
(eflush)
(defn debugger-chunks [buf p]
(def status (parser/state p :delimiters))
(def c ((parser/where p) 0))
(def prompt (string "debug[" level "]:" c ":" status "> "))
(getline prompt buf nextenv))
(print "entering debug[" level "] - (quit) to exit")
(flush)
(repl debugger-chunks (make-onsignal nextenv (+ 1 level)) nextenv)
(print "exiting debug[" level "]")
(flush)
(nextenv :resume-value))
(fn [f x]
@@ -2204,7 +2304,7 @@
(do (pp x) (put e '_ @{:value x}))
(if (e :debug)
(enter-debugger f x)
(do (debug/stacktrace f x) nil)))))
(do (debug/stacktrace f x) (eflush))))))
(run-context {:env env
:chunks chunks
@@ -2217,6 +2317,29 @@
###
###
(defn- no-side-effects
"Check if form may have side effects. If returns true, then the src
must not have side effects, such as calling a C function."
[src]
(cond
(tuple? src)
(if (= (tuple/type src) :brackets)
(all no-side-effects src))
(array? src)
(all no-side-effects src)
(dictionary? src)
(and (all no-side-effects (keys src))
(all no-side-effects (values src)))
true))
(defn- is-safe-def [x] (no-side-effects (last x)))
(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true
'def is-safe-def 'var is-safe-def 'def- is-safe-def 'var- is-safe-def
'defglobal is-safe-def 'varglobal is-safe-def})
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
(defn cli-main
"Entrance for the Janet CLI tool. Call this functions with the command line
arguments as an array or tuple of strings to invoke the CLI interface."
@@ -2284,15 +2407,21 @@
(def h (in handlers n))
(if h (h i) (do (print "unknown flag -" n) ((in handlers "h")))))
(def- safe-forms {'defn true 'defn- true 'defmacro true 'defmacro- true})
(def- importers {'import true 'import* true 'use true 'dofile true 'require true})
(defn- evaluator
[thunk source env where]
(if *compile-only*
(when (tuple? source)
(def head (source 0))
(def safe-check (safe-forms head))
(cond
(safe-forms (source 0)) (thunk)
(importers (source 0))
# Sometimes safe form
(function? safe-check)
(if (safe-check source) (thunk))
# Always safe form
safe-check
(thunk)
# Import-like form
(importers head)
(do
(let [[l c] (tuple/sourcemap source)
newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)]
@@ -2320,6 +2449,7 @@
(when (and (not *compile-only*) (or *should-repl* *no-file*))
(if-not *quiet*
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
(flush)
(defn noprompt [_] "")
(defn getprompt [p]
(def [line] (parser/where p))
@@ -2338,6 +2468,11 @@
(setdyn :err-color (if *colorize* true))
(repl getchunk onsig env)))
(put _env 'no-side-effects nil)
(put _env 'is-safe-def nil)
(put _env 'safe-forms nil)
(put _env 'importers nil)
###
###
@@ -2393,9 +2528,10 @@
# Create amalgamation
(def feature-header "src/core/features.h")
(def local-headers
["src/core/features.h"
"src/core/util.h"
["src/core/util.h"
"src/core/state.h"
"src/core/gc.h"
"src/core/vector.h"
@@ -2449,20 +2585,23 @@
(print "/* Generated from janet version " janet/version "-" janet/build " */")
(print "#define JANET_BUILD \"" janet/build "\"")
(print ```#define JANET_AMALG```)
(print ```#define _POSIX_C_SOURCE 200112L```)
(print ```#include "janet.h"```)
(defn do-one-flie
(defn do-one-file
[fname]
(print "\n/* " fname " */\n")
(print "\n/* " fname " */")
(print "#line 0 \"" fname "\"\n")
(def source (slurp fname))
(print (string/replace-all "\r" "" source)))
(do-one-file feature-header)
(print ```#include "janet.h"```)
(each h local-headers
(do-one-flie h))
(do-one-file h))
(each s core-sources
(do-one-flie s))
(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

View File

@@ -27,10 +27,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 6
#define JANET_VERSION_MINOR 8
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.6.1-dev"
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.8.1"
/* #define JANET_BUILD "local" */

View File

@@ -334,13 +334,15 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
} else {
length_src = src.len - offset_src;
}
int64_t last = ((int64_t) offset_dest - offset_src) + length_src;
int64_t last = (int64_t) offset_dest + length_src;
if (last > INT32_MAX)
janet_panic("buffer blit out of range");
janet_buffer_ensure(dest, (int32_t) last, 2);
if (last > dest->count) dest->count = (int32_t) last;
int32_t last32 = (int32_t) last;
janet_buffer_ensure(dest, last32, 2);
if (last32 > dest->count) dest->count = last32;
if (length_src) {
if (same_buf) {
/* janet_buffer_ensure may have invalidated src */
src.bytes = dest->data;
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
} else {
@@ -387,7 +389,7 @@ static const JanetReg buffer_cfuns[] = {
"buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer x)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will "
"throw an error if the buffer overflows.")
},
{
@@ -438,7 +440,7 @@ static const JanetReg buffer_cfuns[] = {
},
{
"buffer/blit", cfun_buffer_blit,
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
JDOC("(buffer/blit dest src &opt dest-start src-start src-end)\n\n"
"Insert the contents of src into dest. Can optionally take indices that "
"indicate which part of src to copy into which part of dest. Indices can be "
"negative to index from the end of src or dest. Returns dest.")

View File

@@ -212,6 +212,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
def->environments = NULL;
def->constants = NULL;
def->bytecode = NULL;
def->closure_bitset = NULL;
def->flags = 0;
def->slotcount = 0;
def->arity = 0;

View File

@@ -28,6 +28,11 @@
#include "vector.h"
#endif
static int arity1or2(JanetFopts opts, JanetSlot *args) {
(void) opts;
int32_t arity = janet_v_count(args);
return arity == 1 || arity == 2;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@@ -63,6 +68,28 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
return target;
}
/* Emit an insruction that implements a form by itself. */
static JanetSlot opfunction(
JanetFopts opts,
JanetSlot *args,
int op,
Janet defaultArg2) {
JanetCompiler *c = opts.compiler;
int32_t len;
len = janet_v_count(args);
JanetSlot t;
if (len == 1) {
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], janetc_cslot(defaultArg2), 1);
return t;
} else {
/* len == 2 */
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
return t;
}
/* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce(
JanetFopts opts,
@@ -113,7 +140,7 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_NEXT, janet_wrap_nil());
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
@@ -143,7 +170,7 @@ static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
}
}
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
return opfunction(opts, args, JOP_RESUME, janet_wrap_nil());
}
static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Push phase */
@@ -270,7 +297,7 @@ static const JanetFunOptimizer optimizers[] = {
{fixarity1, do_error},
{minarity2, do_apply},
{maxarity1, do_yield},
{fixarity2, do_resume},
{arity1or2, do_resume},
{fixarity2, do_in},
{fixarity3, do_put},
{fixarity1, do_length},
@@ -293,7 +320,7 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get},
{fixarity2, do_next},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
};

View File

@@ -102,6 +102,7 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
scope.bytecode_start = janet_v_count(c->buffer);
scope.flags = flags;
scope.parent = c->scope;
janetc_regalloc_init(&scope.ua);
/* Inherit slots */
if ((!(flags & JANET_SCOPE_FUNCTION)) && c->scope) {
janetc_regalloc_clone(&scope.ra, &(c->scope->ra));
@@ -149,6 +150,7 @@ void janetc_popscope(JanetCompiler *c) {
janet_v_free(oldscope->envs);
janet_v_free(oldscope->defs);
janetc_regalloc_deinit(&oldscope->ra);
janetc_regalloc_deinit(&oldscope->ua);
/* Update pointer */
if (newscope)
newscope->child = NULL;
@@ -202,7 +204,7 @@ JanetSlot janetc_resolve(
switch (btype) {
default:
case JANET_BINDING_NONE:
janetc_error(c, janet_formatc("unknown symbol %q", sym));
janetc_error(c, janet_formatc("unknown symbol %q", janet_wrap_symbol(sym)));
return janetc_cslot(janet_wrap_nil());
case JANET_BINDING_DEF:
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
@@ -236,6 +238,11 @@ found:
scope = scope->parent;
janet_assert(scope, "invalid scopes");
scope->flags |= JANET_SCOPE_ENV;
/* In the function scope, allocate the slot as an upvalue */
janetc_regalloc_touch(&scope->ua, ret.index);
/* Iterate through child scopes and make sure environment is propagated */
scope = scope->child;
/* Propagate env up to current scope */
@@ -455,6 +462,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
break;
case JANET_CFUNCTION:
case JANET_ABSTRACT:
case JANET_NIL:
break;
case JANET_KEYWORD:
if (min_arity == 0) {
@@ -736,6 +744,21 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
}
/* Copy upvalue bitset */
if (scope->ua.count) {
/* Number of u32s we need to create a bitmask for all slots */
int32_t numchunks = (def->slotcount + 31) >> 5;
uint32_t *chunks = malloc(sizeof(uint32_t) * numchunks);
if (NULL == chunks) {
JANET_OUT_OF_MEMORY;
}
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
}
/* Pop the scope */
janetc_popscope(c);

View File

@@ -127,7 +127,10 @@ struct JanetScope {
/* Regsiter allocator */
JanetcRegisterAllocator ra;
/* Referenced closure environents. The values at each index correspond
/* Upvalue allocator */
JanetcRegisterAllocator ua;
/* Referenced closure environments. The values at each index correspond
* to which index to get the environment from in the parent. The environment
* that corresponds to the direct parent's stack will always have value 0. */
int32_t *envs;

View File

@@ -489,6 +489,26 @@ ret_false:
return janet_wrap_false();
}
static Janet janet_core_signal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
int sig;
if (janet_checkint(argv[0])) {
int32_t s = janet_unwrap_integer(argv[0]);
if (s < 0 || s > 9) {
janet_panicf("expected user signal between 0 and 9, got %d", s);
}
sig = JANET_SIGNAL_USER0 + s;
} else {
JanetKeyword kw = janet_getkeyword(argv, 0);
if (!janet_cstrcmp(kw, "yield")) sig = JANET_SIGNAL_YIELD;
if (!janet_cstrcmp(kw, "error")) sig = JANET_SIGNAL_ERROR;
if (!janet_cstrcmp(kw, "debug")) sig = JANET_SIGNAL_DEBUG;
janet_panicf("unknown signal, expected :yield, :error, or :debug, got %v", argv[0]);
}
Janet payload = argc == 2 ? argv[1] : janet_wrap_nil();
janet_signalv(sig, payload);
}
static const JanetReg corelib_cfuns[] = {
{
"native", janet_core_native,
@@ -599,11 +619,10 @@ static const JanetReg corelib_cfuns[] = {
{
"type", janet_core_type,
JDOC("(type x)\n\n"
"Returns the type of x as a keyword symbol. x is one of\n"
"Returns the type of x as a keyword. x is one of\n"
"\t:nil\n"
"\t:boolean\n"
"\t:integer\n"
"\t:real\n"
"\t:number\n"
"\t:array\n"
"\t:tuple\n"
"\t:table\n"
@@ -614,7 +633,7 @@ static const JanetReg corelib_cfuns[] = {
"\t:keyword\n"
"\t:function\n"
"\t:cfunction\n\n"
"or another symbol for an abstract type.")
"or another keyword for an abstract type.")
},
{
"hash", janet_core_hash,
@@ -680,6 +699,11 @@ static const JanetReg corelib_cfuns[] = {
JDOC("(slice x &opt start end)\n\n"
"Extract a sub-range of an indexed data strutrue or byte sequence.")
},
{
"signal", janet_core_signal,
JDOC("(signal what x)\n\n"
"Raise a signal with payload x. ")
},
{NULL, NULL, NULL}
};
@@ -990,7 +1014,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 2, 2, 2, next_asm, sizeof(next_asm),
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a datastructure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "

View File

@@ -29,4 +29,9 @@
#define _POSIX_C_SOURCE 200112L
#endif
/* Needed for realpath on linux */
#if !defined(_XOPEN_SOURCE) && defined(__linux__)
#define _XOPEN_SOURCE 500
#endif
#endif

View File

@@ -65,7 +65,14 @@ JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t
if (newstacktop >= fiber->capacity) {
janet_fiber_setcapacity(fiber, 2 * newstacktop);
}
safe_memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
if (argv) {
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
} else {
/* If argv not given, fill with nil */
for (int32_t i = 0; i < argc; i++) {
fiber->data[fiber->stacktop + i] = janet_wrap_nil();
}
}
fiber->stacktop = newstacktop;
}
if (janet_fiber_funcframe(fiber, callee)) return NULL;
@@ -211,18 +218,50 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
static void janet_env_detach(JanetFuncEnv *env) {
/* Check for closure environment */
if (env) {
size_t s = sizeof(Janet) * (size_t) env->length;
int32_t len = env->length;
size_t s = sizeof(Janet) * (size_t) len;
Janet *vmem = malloc(s);
janet_vm_next_collection += (uint32_t) s;
if (NULL == vmem) {
JANET_OUT_OF_MEMORY;
}
safe_memcpy(vmem, env->as.fiber->data + env->offset, s);
Janet *values = env->as.fiber->data + env->offset;
safe_memcpy(vmem, values, s);
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
if (bitset) {
/* Clear unneeded references in closure environment */
for (int32_t i = 0; i < len; i += 32) {
uint32_t mask = ~(bitset[i >> 5]);
int32_t maxj = i + 32 > len ? len : i + 32;
for (int32_t j = i; j < maxj; j++) {
if (mask & 1) vmem[j] = janet_wrap_nil();
mask >>= 1;
}
}
}
env->offset = 0;
env->as.values = vmem;
}
}
/* Detach a fiber from the env if the target fiber has stopped mutating */
void janet_env_maybe_detach(JanetFuncEnv *env) {
/* Check for detachable closure envs */
if (env->offset) {
JanetFiberStatus s = janet_fiber_status(env->as.fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
if (isFinished) {
janet_env_detach(env);
}
}
}
/* Create a tail frame for a function */
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
int32_t i;
@@ -362,10 +401,10 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetFunction *func = janet_getfunction(argv, 0);
JanetFiber *fiber;
if (func->def->min_arity != 0) {
janet_panic("expected nullary function in fiber constructor");
if (func->def->min_arity > 1) {
janet_panicf("fiber function must accept 0 or 1 arguments");
}
fiber = janet_fiber(func, 64, 0, NULL);
fiber = janet_fiber(func, 64, func->def->min_arity, NULL);
if (argc == 2) {
int32_t i;
JanetByteView view = janet_getbytes(argv, 1);
@@ -386,6 +425,15 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
JANET_FIBER_MASK_USER |
JANET_FIBER_MASK_YIELD;
break;
case 't':
fiber->flags |=
JANET_FIBER_MASK_ERROR |
JANET_FIBER_MASK_USER0 |
JANET_FIBER_MASK_USER1 |
JANET_FIBER_MASK_USER2 |
JANET_FIBER_MASK_USER3 |
JANET_FIBER_MASK_USER4;
break;
case 'd':
fiber->flags |= JANET_FIBER_MASK_DEBUG;
break;
@@ -448,6 +496,20 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_fiber_can_resume(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetFiber *fiber = janet_getfiber(argv, 0);
JanetFiberStatus s = janet_fiber_status(fiber);
int isFinished = s == JANET_STATUS_DEAD ||
s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4;
return janet_wrap_boolean(!isFinished);
}
static const JanetReg fiber_cfuns[] = {
{
"fiber/new", cfun_fiber_new,
@@ -463,6 +525,7 @@ static const JanetReg fiber_cfuns[] = {
"\ta - block all signals\n"
"\td - block debug signals\n"
"\te - block error signals\n"
"\tt - block termination signals: error + user[0-4]\n"
"\tu - block user signals\n"
"\ty - block yield signals\n"
"\t0-9 - block a specific user signal\n\n"
@@ -513,6 +576,11 @@ static const JanetReg fiber_cfuns[] = {
"Sets the environment table for a fiber. Set to nil to remove the current "
"environment.")
},
{
"fiber/can-resume?", cfun_fiber_can_resume,
JDOC("(fiber/can-resume? fiber)\n\n"
"Check if a fiber is finished and cannot be resumed.")
},
{NULL, NULL, NULL}
};

View File

@@ -73,5 +73,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func);
int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func);
void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun);
void janet_fiber_popframe(JanetFiber *fiber);
void janet_env_maybe_detach(JanetFuncEnv *env);
#endif

View File

@@ -27,6 +27,7 @@
#include "symcache.h"
#include "gc.h"
#include "util.h"
#include "fiber.h"
#endif
struct JanetScratch {
@@ -189,6 +190,9 @@ static void janet_mark_funcenv(JanetFuncEnv *env) {
if (janet_gc_reachable(env))
return;
janet_gc_mark(env);
/* If closure env references a dead fiber, we can just copy out the stack frame we need so
* we don't need to keep around the whole dead fiber. */
janet_env_maybe_detach(env);
if (env->offset) {
/* On stack */
janet_mark_fiber(env->as.fiber);
@@ -305,6 +309,7 @@ static void janet_deinit_block(JanetGCObject *mem) {
free(def->constants);
free(def->bytecode);
free(def->sourcemap);
free(def->closure_bitset);
}
break;
}

View File

@@ -81,7 +81,7 @@ static void it_u64_tostring(void *p, JanetBuffer *buffer) {
janet_buffer_push_cstring(buffer, str);
}
static const JanetAbstractType it_s64_type = {
const JanetAbstractType janet_s64_type = {
"core/s64",
NULL,
NULL,
@@ -95,7 +95,7 @@ static const JanetAbstractType it_s64_type = {
JANET_ATEND_HASH
};
static const JanetAbstractType it_u64_type = {
const JanetAbstractType janet_u64_type = {
"core/u64",
NULL,
NULL,
@@ -128,8 +128,8 @@ int64_t janet_unwrap_s64(Janet x) {
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
if (janet_abstract_type(abst) == &janet_s64_type ||
(janet_abstract_type(abst) == &janet_u64_type))
return *(int64_t *)abst;
break;
}
@@ -157,8 +157,8 @@ uint64_t janet_unwrap_u64(Janet x) {
}
case JANET_ABSTRACT: {
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) == &it_s64_type ||
(janet_abstract_type(abst) == &it_u64_type))
if (janet_abstract_type(abst) == &janet_s64_type ||
(janet_abstract_type(abst) == &janet_u64_type))
return *(uint64_t *)abst;
break;
}
@@ -170,19 +170,19 @@ uint64_t janet_unwrap_u64(Janet x) {
JanetIntType janet_is_int(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return JANET_INT_NONE;
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
return (at == &it_s64_type) ? JANET_INT_S64 :
((at == &it_u64_type) ? JANET_INT_U64 :
return (at == &janet_s64_type) ? JANET_INT_S64 :
((at == &janet_u64_type) ? JANET_INT_U64 :
JANET_INT_NONE);
}
Janet janet_wrap_s64(int64_t x) {
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
*box = (int64_t)x;
return janet_wrap_abstract(box);
}
Janet janet_wrap_u64(uint64_t x) {
uint64_t *box = janet_abstract(&it_u64_type, sizeof(uint64_t));
uint64_t *box = janet_abstract(&janet_u64_type, sizeof(uint64_t));
*box = (uint64_t)x;
return janet_wrap_abstract(box);
}
@@ -200,7 +200,7 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
#define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) \
*box oper##= janet_unwrap_##type(argv[i]); \
@@ -210,7 +210,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
*box oper##= janet_unwrap_##type(argv[0]); \
return janet_wrap_abstract(box); \
@@ -219,7 +219,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
@@ -232,7 +232,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
@@ -243,7 +243,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \
for (int32_t i = 1; i < argc; i++) { \
T value = janet_unwrap_##type(argv[i]); \
@@ -257,7 +257,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \
T *box = janet_abstract(&it_##type##_type, sizeof(T)); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \
T value = janet_unwrap_##type(argv[0]); \
if (value == 0) janet_panic("division by zero"); \
@@ -276,7 +276,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
*box = janet_unwrap_s64(argv[0]);
for (int32_t i = 1; i < argc; i++) {
int64_t value = janet_unwrap_s64(argv[i]);
@@ -292,7 +292,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&it_s64_type, sizeof(int64_t));
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]);
int64_t op2 = janet_unwrap_s64(argv[1]);
int64_t x = op1 % op2;
@@ -441,8 +441,8 @@ static const JanetReg it_cfuns[] = {
/* Module entry point */
void janet_lib_inttypes(JanetTable *env) {
janet_core_cfuns(env, NULL, it_cfuns);
janet_register_abstract_type(&it_s64_type);
janet_register_abstract_type(&it_u64_type);
janet_register_abstract_type(&janet_s64_type);
janet_register_abstract_type(&janet_u64_type);
}
#endif

View File

@@ -33,16 +33,10 @@
#include <sys/wait.h>
#endif
typedef struct IOFile IOFile;
struct IOFile {
FILE *file;
int flags;
};
static int cfun_io_gc(void *p, size_t len);
static int io_file_get(void *p, Janet key, Janet *out);
JanetAbstractType cfun_io_filetype = {
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
NULL,
@@ -90,7 +84,7 @@ static int checkflags(const uint8_t *str) {
}
static Janet makef(FILE *f, int flags) {
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
return janet_wrap_abstract(iof);
@@ -158,7 +152,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
}
/* Read up to n bytes into buffer. */
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
static void read_chunk(JanetFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
if (!(iof->flags & (JANET_FILE_READ | JANET_FILE_UPDATE)))
janet_panic("file is not readable");
janet_buffer_extra(buffer, nBytesMax);
@@ -172,7 +166,7 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
/* Read a certain number of bytes into memory */
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED) janet_panic("file is closed");
JanetBuffer *buffer;
if (argc == 2) {
@@ -212,7 +206,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
/* Write bytes to a file */
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
janet_arity(argc, 1, -1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -235,7 +229,7 @@ static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
/* Flush the bytes in the file */
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
if (!(iof->flags & (JANET_FILE_WRITE | JANET_FILE_APPEND | JANET_FILE_UPDATE)))
@@ -248,7 +242,7 @@ static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
/* Cleanup a file */
static int cfun_io_gc(void *p, size_t len) {
(void) len;
IOFile *iof = (IOFile *)p;
JanetFile *iof = (JanetFile *)p;
if (!(iof->flags & (JANET_FILE_NOT_CLOSEABLE | JANET_FILE_CLOSED))) {
return fclose(iof->file);
}
@@ -258,7 +252,7 @@ static int cfun_io_gc(void *p, size_t len) {
/* Close a file */
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
return janet_wrap_nil();
if (iof->flags & (JANET_FILE_NOT_CLOSEABLE))
@@ -282,7 +276,7 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
/* Seek a file */
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
if (iof->flags & JANET_FILE_CLOSED)
janet_panic("file is closed");
long int offset = 0;
@@ -326,8 +320,8 @@ FILE *janet_dynfile(const char *name, FILE *def) {
Janet x = janet_dyn(name);
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
IOFile *iofile = abstract;
if (janet_abstract_type(abstract) != &janet_file_type) return def;
JanetFile *iofile = abstract;
return iofile->file;
}
@@ -354,9 +348,9 @@ static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
break;
}
@@ -421,9 +415,9 @@ static Janet cfun_io_printf_impl(int32_t argc, Janet *argv, int newline,
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
return janet_wrap_nil();
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
break;
}
@@ -460,6 +454,38 @@ static Janet cfun_io_eprinf(int32_t argc, Janet *argv) {
return cfun_io_printf_impl(argc, argv, 0, "err", stderr);
}
static void janet_flusher(const char *name, FILE *dflt_file) {
Janet x = janet_dyn(name);
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
fflush(dflt_file);
break;
case JANET_ABSTRACT: {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &janet_file_type) break;
JanetFile *iofile = abstract;
fflush(iofile->file);
break;
}
}
}
static Janet cfun_io_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("out", stdout);
return janet_wrap_nil();
}
static Janet cfun_io_eflush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
janet_flusher("err", stderr);
return janet_wrap_nil();
}
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
va_list args;
va_start(args, format);
@@ -479,9 +505,9 @@ void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...)
janet_formatb(&buffer, format, args);
if (xtype == JANET_ABSTRACT) {
void *abstract = janet_unwrap_abstract(x);
if (janet_abstract_type(abstract) != &cfun_io_filetype)
if (janet_abstract_type(abstract) != &janet_file_type)
break;
IOFile *iofile = abstract;
JanetFile *iofile = abstract;
f = iofile->file;
}
fwrite(buffer.data, buffer.count, 1, f);
@@ -541,6 +567,16 @@ static const JanetReg io_cfuns[] = {
JDOC("(eprinf fmt & xs)\n\n"
"Like eprintf but with no trailing newline.")
},
{
"flush", cfun_io_flush,
JDOC("(flush)\n\n"
"Flush (dyn :out stdout) if it is a file, otherwise do nothing.")
},
{
"eflush", cfun_io_eflush,
JDOC("(eflush)\n\n"
"Flush (dyn :err stderr) if it is a file, otherwise do nothing.")
},
{
"file/temp", cfun_io_temp,
JDOC("(file/temp)\n\n"
@@ -618,7 +654,7 @@ static const JanetReg io_cfuns[] = {
/* C API */
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
JanetFile *iof = janet_getabstract(argv, n, &janet_file_type);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}
@@ -628,11 +664,11 @@ Janet janet_makefile(FILE *f, int flags) {
}
JanetAbstract janet_checkfile(Janet j) {
return janet_checkabstract(j, &cfun_io_filetype);
return janet_checkabstract(j, &janet_file_type);
}
FILE *janet_unwrapfile(Janet j, int *flags) {
IOFile *iof = janet_unwrap_abstract(j);
JanetFile *iof = janet_unwrap_abstract(j);
if (NULL != flags) *flags = iof->flags;
return iof->file;
}

View File

@@ -184,15 +184,30 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
}
janet_v_push(st->seen_envs, env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
if (env->offset && (JANET_STATUS_ALIVE == janet_fiber_status(env->as.fiber))) {
pushint(st, 0);
pushint(st, env->length);
Janet *values = env->as.fiber->data + env->offset;
uint32_t *bitset = janet_stack_frame(values)->func->def->closure_bitset;
for (int32_t i = 0; i < env->length; i++) {
if (1 & (bitset[i >> 5] >> (i & 0x1F))) {
marshal_one(st, values[i], flags + 1);
} else {
pushbyte(st, LB_NIL);
}
}
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
marshal_one(st, env->as.values[i], flags + 1);
janet_env_maybe_detach(env);
pushint(st, env->offset);
pushint(st, env->length);
if (env->offset) {
/* On stack variant */
marshal_one(st, janet_wrap_fiber(env->as.fiber), flags + 1);
} else {
/* Off stack variant */
for (int32_t i = 0; i < env->length; i++)
marshal_one(st, env->as.values[i], flags + 1);
}
}
}
@@ -205,6 +220,16 @@ static void janet_func_addflags(JanetFuncDef *def) {
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a sequence of u32s */
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
for (int32_t i = 0; i < n; i++) {
pushbyte(st, u32s[i] & 0xFF);
pushbyte(st, (u32s[i] >> 8) & 0xFF);
pushbyte(st, (u32s[i] >> 16) & 0xFF);
pushbyte(st, (u32s[i] >> 24) & 0xFF);
}
}
/* Marshal a function def */
static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
MARSH_STACKCHECK;
@@ -239,12 +264,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
marshal_one(st, def->constants[i], flags);
/* marshal the bytecode */
for (int32_t i = 0; i < def->bytecode_length; i++) {
pushbyte(st, def->bytecode[i] & 0xFF);
pushbyte(st, (def->bytecode[i] >> 8) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 16) & 0xFF);
pushbyte(st, (def->bytecode[i] >> 24) & 0xFF);
}
janet_marshal_u32s(st, def->bytecode, def->bytecode_length);
/* marshal the environments if needed */
for (int32_t i = 0; i < def->environments_length; i++)
@@ -264,6 +284,11 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
current = map.line;
}
}
/* Marshal closure bitset, if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
janet_marshal_u32s(st, def->closure_bitset, ((def->slotcount + 31) >> 5));
}
}
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
@@ -707,6 +732,20 @@ static const uint8_t *unmarshal_one_env(
return data;
}
/* Unmarshal a series of u32s */
static const uint8_t *janet_unmarshal_u32s(UnmarshalState *st, const uint8_t *data, uint32_t *into, int32_t n) {
for (int32_t i = 0; i < n; i++) {
MARSH_EOS(st, data + 3);
into[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 24);
data += 4;
}
return data;
}
/* Unmarshal a funcdef */
static const uint8_t *unmarshal_one_def(
UnmarshalState *st,
@@ -730,6 +769,7 @@ static const uint8_t *unmarshal_one_def(
def->bytecode_length = 0;
def->name = NULL;
def->source = NULL;
def->closure_bitset = NULL;
janet_v_push(st->lookup_defs, def);
/* Set default lengths to zero */
@@ -785,15 +825,7 @@ static const uint8_t *unmarshal_one_def(
if (!def->bytecode) {
JANET_OUT_OF_MEMORY;
}
for (int32_t i = 0; i < bytecode_length; i++) {
MARSH_EOS(st, data + 3);
def->bytecode[i] =
(uint32_t)(data[0]) |
((uint32_t)(data[1]) << 8) |
((uint32_t)(data[2]) << 16) |
((uint32_t)(data[3]) << 24);
data += 4;
}
data = janet_unmarshal_u32s(st, data, def->bytecode, bytecode_length);
def->bytecode_length = bytecode_length;
/* Unmarshal environments */
@@ -840,6 +872,15 @@ static const uint8_t *unmarshal_one_def(
def->sourcemap = NULL;
}
/* Unmarshal closure bitset if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
if (NULL == def->closure_bitset) {
JANET_OUT_OF_MEMORY;
}
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
}
/* Validate */
if (janet_verify(def))
janet_panic("funcdef has invalid bytecode");
@@ -1100,7 +1141,7 @@ static const uint8_t *unmarshal_one(
u.bytes[0] = data[8];
u.bytes[1] = data[7];
u.bytes[2] = data[6];
u.bytes[5] = data[5];
u.bytes[3] = data[5];
u.bytes[4] = data[4];
u.bytes[5] = data[3];
u.bytes[6] = data[2];
@@ -1274,7 +1315,7 @@ static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
}
static Janet cfun_marshal(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
janet_arity(argc, 1, 3);
JanetBuffer *buffer;
JanetTable *rreg = NULL;
if (argc > 1) {

View File

@@ -52,7 +52,7 @@ static void *janet_rng_unmarshal(JanetMarshalContext *ctx) {
return rng;
}
static JanetAbstractType JanetRNG_type = {
const JanetAbstractType janet_rng_type = {
"core/rng",
NULL,
NULL,
@@ -115,7 +115,7 @@ double janet_rng_double(JanetRNG *rng) {
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
janet_arity(argc, 0, 1);
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
JanetRNG *rng = janet_abstract(&janet_rng_type, sizeof(JanetRNG));
if (argc == 1) {
if (janet_checkint(argv[0])) {
uint32_t seed = (uint32_t)(janet_getinteger(argv, 0));
@@ -132,13 +132,13 @@ static Janet cfun_rng_make(int32_t argc, Janet *argv) {
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
return janet_wrap_number(janet_rng_double(rng));
}
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
if (argc == 1) {
uint32_t word = janet_rng_u32(rng) >> 1;
return janet_wrap_integer(word);
@@ -166,7 +166,7 @@ static void rng_get_4bytes(JanetRNG *rng, uint8_t *buf) {
static Janet cfun_rng_buffer(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
JanetRNG *rng = janet_getabstract(argv, 0, &janet_rng_type);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, n);
@@ -459,7 +459,7 @@ static const JanetReg math_cfuns[] = {
/* Module entry point */
void janet_lib_math(JanetTable *env) {
janet_core_cfuns(env, NULL, math_cfuns);
janet_register_abstract_type(&JanetRNG_type);
janet_register_abstract_type(&janet_rng_type);
#ifdef JANET_BOOTSTRAP
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
JDOC("The value pi."));

View File

@@ -32,6 +32,7 @@
#include <time.h>
#include <fcntl.h>
#include <errno.h>
#include <limits.h>
#include <stdio.h>
#include <string.h>
#include <sys/stat.h>
@@ -69,6 +70,13 @@ extern char **environ;
void arc4random_buf(void *buf, size_t nbytes);
#endif
/* Not POSIX, but all Unixes but Solaris have this function. */
#if defined(JANET_POSIX) && !defined(__sun)
time_t timegm(struct tm *tm);
#elif defined(JANET_WINDOWS)
#define timegm _mkgmtime
#endif
/* Access to some global variables should be synchronized if not in single threaded mode, as
* setenv/getenv are not thread safe. */
#ifdef JANET_THREADS
@@ -401,7 +409,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
}
os_execute_cleanup(envp, child_argv);
return janet_wrap_integer(WEXITSTATUS(status));
/* Use POSIX shell semantics for interpreting signals */
int ret;
if (WIFEXITED(status)) {
ret = WEXITSTATUS(status);
} else if (WIFSTOPPED(status)) {
ret = WSTOPSIG(status) + 128;
} else {
ret = WTERMSIG(status) + 128;
}
return janet_wrap_integer(ret);
#endif
}
@@ -621,13 +638,11 @@ static Janet os_date(int32_t argc, Janet *argv) {
struct tm *t_info = NULL;
if (argc) {
int64_t integer = janet_getinteger64(argv, 0);
if (integer < 0)
janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]);
t = (time_t) integer;
} else {
time(&t);
}
if (argc >= 2 && janet_truthy(argv[2])) {
if (argc >= 2 && janet_truthy(argv[1])) {
/* local time */
#ifdef JANET_WINDOWS
localtime_s(&t_infos, &t);
@@ -658,6 +673,98 @@ static Janet os_date(int32_t argc, Janet *argv) {
return janet_wrap_struct(janet_struct_end(st));
}
static int entry_getdst(Janet env_entry) {
Janet v;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
v = janet_table_get(entry, janet_ckeywordv("dst"));
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
v = janet_struct_get(entry, janet_ckeywordv("dst"));
} else {
v = janet_wrap_nil();
}
if (janet_checktype(v, JANET_NIL)) {
return -1;
} else {
return janet_truthy(v);
}
}
#ifdef JANET_WINDOWS
typedef int32_t timeint_t;
#else
typedef int64_t timeint_t;
#endif
static timeint_t entry_getint(Janet env_entry, char *field) {
Janet i;
if (janet_checktype(env_entry, JANET_TABLE)) {
JanetTable *entry = janet_unwrap_table(env_entry);
i = janet_table_get(entry, janet_ckeywordv(field));
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
const JanetKV *entry = janet_unwrap_struct(env_entry);
i = janet_struct_get(entry, janet_ckeywordv(field));
} else {
return 0;
}
if (janet_checktype(i, JANET_NIL)) {
return 0;
}
#ifdef JANET_WINDOWS
if (!janet_checkint(i)) {
janet_panicf("bad slot #%s, expected 32 bit signed integer, got %v",
field, i);
}
#else
if (!janet_checkint64(i)) {
janet_panicf("bad slot #%s, expected 64 bit signed integer, got %v",
field, i);
}
#endif
return (timeint_t)janet_unwrap_number(i);
}
static Janet os_mktime(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
time_t t;
struct tm t_info = { 0 };
if (!janet_checktype(argv[0], JANET_TABLE) &&
!janet_checktype(argv[0], JANET_STRUCT))
janet_panic_type(argv[0], 0, JANET_TFLAG_DICTIONARY);
t_info.tm_sec = entry_getint(argv[0], "seconds");
t_info.tm_min = entry_getint(argv[0], "minutes");
t_info.tm_hour = entry_getint(argv[0], "hours");
t_info.tm_mday = entry_getint(argv[0], "month-day") + 1;
t_info.tm_mon = entry_getint(argv[0], "month");
t_info.tm_year = entry_getint(argv[0], "year") - 1900;
t_info.tm_isdst = entry_getdst(argv[0]);
if (argc >= 2 && janet_truthy(argv[1])) {
/* local time */
t = mktime(&t_info);
} else {
/* utc time */
#ifdef __sun
janet_panic("os/mktime UTC not supported on Solaris");
return janet_wrap_nil();
#else
t = timegm(&t_info);
#endif
}
if (t == (time_t) -1) {
janet_panicf("%s", strerror(errno));
}
return janet_wrap_number((double)t);
}
static Janet os_link(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
#ifdef JANET_WINDOWS
@@ -668,9 +775,25 @@ static Janet os_link(int32_t argc, Janet *argv) {
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = ((argc == 3 && janet_getboolean(argv, 2)) ? symlink : link)(oldpath, newpath);
int res = ((argc == 3 && janet_truthy(argv[2])) ? symlink : link)(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_integer(res);
return janet_wrap_nil();
#endif
}
static Janet os_symlink(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/symlink not supported on Windows");
return janet_wrap_nil();
#else
const char *oldpath = janet_getcstring(argv, 0);
const char *newpath = janet_getcstring(argv, 1);
int res = symlink(oldpath, newpath);
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
return janet_wrap_nil();
#endif
}
@@ -682,7 +805,9 @@ static Janet os_mkdir(int32_t argc, Janet *argv) {
#else
int res = mkdir(path, S_IRUSR | S_IWUSR | S_IXUSR | S_IRGRP | S_IWGRP | S_IXGRP | S_IROTH | S_IXOTH);
#endif
return janet_wrap_boolean(res != -1);
if (res == 0) return janet_wrap_true();
if (errno == EEXIST) return janet_wrap_false();
janet_panicf("%s: %s", strerror(errno), path);
}
static Janet os_rmdir(int32_t argc, Janet *argv) {
@@ -737,6 +862,23 @@ static Janet os_remove(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_readlink(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
(void) argc;
(void) argv;
janet_panic("os/readlink not supported on Windows");
return janet_wrap_nil();
#else
static char buffer[PATH_MAX];
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);
return janet_stringv((const uint8_t *)buffer, len);
#endif
}
#ifdef JANET_WINDOWS
static const uint8_t *janet_decode_permissions(unsigned short m) {
uint8_t flags[9] = {0};
@@ -746,6 +888,35 @@ static const uint8_t *janet_decode_permissions(unsigned short m) {
return janet_string(flags, sizeof(flags));
}
static unsigned short janet_encode_permissions(Janet *argv, int32_t n) {
if (janet_checkint(argv[n])) {
int32_t x = janet_unwrap_integer(argv[n]);
if (x < 0 || x > 0777) {
janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
}
unsigned short m = 0;
if (x & 1 || x & 010 || x & 0100) m |= S_IEXEC;
if (x & 2 || x & 020 || x & 0200) m |= S_IWRITE;
if (x & 4 || x & 040 || x & 0400) m |= S_IREAD;
return m;
}
JanetString perm = janet_getstring(argv, n);
if (janet_string_length(perm) != 9) {
janet_panicf("expected string of length 9, got %S", perm);
}
unsigned short m = 0;
if (perm[0] == 'r') m |= S_IREAD;
if (perm[1] == 'w') m |= S_IWRITE;
if (perm[2] == 'x') m |= S_IEXEC;
if (perm[3] == 'r') m |= S_IREAD;
if (perm[4] == 'w') m |= S_IWRITE;
if (perm[5] == 'x') m |= S_IEXEC;
if (perm[6] == 'r') m |= S_IREAD;
if (perm[7] == 'w') m |= S_IWRITE;
if (perm[8] == 'x') m |= S_IEXEC;
return m;
}
static const uint8_t *janet_decode_mode(unsigned short m) {
const char *str = "other";
if (m & _S_IFREG) str = "file";
@@ -768,6 +939,31 @@ static const uint8_t *janet_decode_permissions(mode_t m) {
return janet_string(flags, sizeof(flags));
}
static mode_t janet_encode_permissions(Janet *argv, int32_t n) {
if (janet_checkint(argv[n])) {
int32_t x = janet_unwrap_integer(argv[n]);
if (x < 0 || x > 0777) {
janet_panicf("expected integer in range [0, 8r777], got %v", argv[n]);
}
return (mode_t) x;
}
JanetString perm = janet_getstring(argv, n);
if (janet_string_length(perm) != 9) {
janet_panicf("expected string of length 9, got %S", perm);
}
mode_t m = 0;
if (perm[0] == 'r') m |= S_IRUSR;
if (perm[1] == 'w') m |= S_IWUSR;
if (perm[2] == 'x') m |= S_IXUSR;
if (perm[3] == 'r') m |= S_IRGRP;
if (perm[4] == 'w') m |= S_IWGRP;
if (perm[5] == 'x') m |= S_IXGRP;
if (perm[6] == 'r') m |= S_IROTH;
if (perm[7] == 'w') m |= S_IWOTH;
if (perm[8] == 'x') m |= S_IXOTH;
return m;
}
static const uint8_t *janet_decode_mode(mode_t m) {
const char *str = "other";
if (S_ISREG(m)) str = "file";
@@ -781,67 +977,68 @@ static const uint8_t *janet_decode_mode(mode_t m) {
}
#endif
/* Can we do this? */
#ifdef JANET_WINDOWS
#define stat _stat
typedef struct _stat jstat_t;
#else
typedef struct stat jstat_t;
#endif
/* Getters */
static Janet os_stat_dev(struct stat *st) {
static Janet os_stat_dev(jstat_t *st) {
return janet_wrap_number(st->st_dev);
}
static Janet os_stat_inode(struct stat *st) {
static Janet os_stat_inode(jstat_t *st) {
return janet_wrap_number(st->st_ino);
}
static Janet os_stat_mode(struct stat *st) {
static Janet os_stat_mode(jstat_t *st) {
return janet_wrap_keyword(janet_decode_mode(st->st_mode));
}
static Janet os_stat_permissions(struct stat *st) {
static Janet os_stat_permissions(jstat_t *st) {
return janet_wrap_string(janet_decode_permissions(st->st_mode));
}
static Janet os_stat_uid(struct stat *st) {
static Janet os_stat_uid(jstat_t *st) {
return janet_wrap_number(st->st_uid);
}
static Janet os_stat_gid(struct stat *st) {
static Janet os_stat_gid(jstat_t *st) {
return janet_wrap_number(st->st_gid);
}
static Janet os_stat_nlink(struct stat *st) {
static Janet os_stat_nlink(jstat_t *st) {
return janet_wrap_number(st->st_nlink);
}
static Janet os_stat_rdev(struct stat *st) {
static Janet os_stat_rdev(jstat_t *st) {
return janet_wrap_number(st->st_rdev);
}
static Janet os_stat_size(struct stat *st) {
static Janet os_stat_size(jstat_t *st) {
return janet_wrap_number(st->st_size);
}
static Janet os_stat_accessed(struct stat *st) {
static Janet os_stat_accessed(jstat_t *st) {
return janet_wrap_number((double) st->st_atime);
}
static Janet os_stat_modified(struct stat *st) {
static Janet os_stat_modified(jstat_t *st) {
return janet_wrap_number((double) st->st_mtime);
}
static Janet os_stat_changed(struct stat *st) {
static Janet os_stat_changed(jstat_t *st) {
return janet_wrap_number((double) st->st_ctime);
}
#ifdef JANET_WINDOWS
static Janet os_stat_blocks(struct stat *st) {
static Janet os_stat_blocks(jstat_t *st) {
return janet_wrap_number(0);
}
static Janet os_stat_blocksize(struct stat *st) {
static Janet os_stat_blocksize(jstat_t *st) {
return janet_wrap_number(0);
}
#else
static Janet os_stat_blocks(struct stat *st) {
static Janet os_stat_blocks(jstat_t *st) {
return janet_wrap_number(st->st_blocks);
}
static Janet os_stat_blocksize(struct stat *st) {
static Janet os_stat_blocksize(jstat_t *st) {
return janet_wrap_number(st->st_blksize);
}
#endif
struct OsStatGetter {
const char *name;
Janet(*fn)(struct stat *st);
Janet(*fn)(jstat_t *st);
};
static const struct OsStatGetter os_stat_getters[] = {
@@ -862,7 +1059,7 @@ static const struct OsStatGetter os_stat_getters[] = {
{NULL, NULL}
};
static Janet os_stat(int32_t argc, Janet *argv) {
static Janet os_stat_or_lstat(int do_lstat, int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const char *path = janet_getcstring(argv, 0);
JanetTable *tab = NULL;
@@ -880,8 +1077,18 @@ static Janet os_stat(int32_t argc, Janet *argv) {
}
/* Build result */
struct stat st;
int res = stat(path, &st);
jstat_t st;
#ifdef JANET_WINDOWS
(void) do_lstat;
int res = _stat(path, &st);
#else
int res;
if (do_lstat) {
res = lstat(path, &st);
} else {
res = stat(path, &st);
}
#endif
if (-1 == res) {
return janet_wrap_nil();
}
@@ -903,6 +1110,26 @@ static Janet os_stat(int32_t argc, Janet *argv) {
}
}
static Janet os_stat(int32_t argc, Janet *argv) {
return os_stat_or_lstat(0, argc, argv);
}
static Janet os_lstat(int32_t argc, Janet *argv) {
return os_stat_or_lstat(1, argc, argv);
}
static Janet os_chmod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
const char *path = janet_getcstring(argv, 0);
#ifdef JANET_WINDOWS
int res = _chmod(path, janet_encode_permissions(argv, 1));
#else
int res = chmod(path, janet_encode_permissions(argv, 1));
#endif
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
return janet_wrap_nil();
}
static Janet os_dir(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const char *dir = janet_getcstring(argv, 0);
@@ -949,6 +1176,21 @@ static Janet os_rename(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet os_realpath(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("os/realpath not supported on Windows");
#else
const char *src = janet_getcstring(argv, 0);
char *dest = realpath(src, NULL);
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
Janet ret = janet_cstringv(dest);
free(dest);
return ret;
#endif
}
#endif /* JANET_REDUCED_OS */
static const JanetReg os_cfuns[] = {
@@ -1007,7 +1249,7 @@ static const JanetReg os_cfuns[] = {
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
"\t:dev - the device that the file is on\n"
"\t:mode - the type of file, one of :file, :directory, :block, :character, :fifo, :socket, :link, or :other\n"
"\t:permissions - A unix permission string like \"rwx--x--x\"\n"
"\t:permissions - A unix permission string like \"rwx--x--x\". On windows, a string like \"rwx\".\n"
"\t:uid - File uid\n"
"\t:gid - File gid\n"
"\t:nlink - number of links to file\n"
@@ -1019,6 +1261,19 @@ static const JanetReg os_cfuns[] = {
"\t:changed - timestamp when file last chnaged (permissions changed)\n"
"\t:modified - timestamp when file last modified (content changed)\n")
},
{
"os/lstat", os_lstat,
JDOC("(os/lstat path &opt tab|key)\n\n"
"Like os/stat, but don't follow symlinks.\n")
},
{
"os/chmod", os_chmod,
JDOC("(os/chmod path mode)\n\n"
"Change file permissions, where mode is a permission string as returned by "
"os/stat, or an integer. "
"When mode is an integer, it is interpreted as a unix permission value, best specified in octal, like "
"8r666 or 8r400. Windows will not differentiate between user, group, and other permissions. Returns nil.")
},
{
"os/touch", os_touch,
JDOC("(os/touch path &opt actime modtime)\n\n"
@@ -1028,13 +1283,14 @@ static const JanetReg os_cfuns[] = {
{
"os/cd", os_cd,
JDOC("(os/cd path)\n\n"
"Change current directory to path. Returns true on success, false on failure.")
"Change current directory to path. Returns nil on success, errors on failure.")
},
{
"os/mkdir", os_mkdir,
JDOC("(os/mkdir path)\n\n"
"Create a new directory. The path will be relative to the current directory if relative, otherwise "
"it will be an absolute path.")
"it will be an absolute path. Returns true if the directory was create, false if the directoyr already exists, and "
"errors otherwise.")
},
{
"os/rmdir", os_rmdir,
@@ -1049,8 +1305,18 @@ static const JanetReg os_cfuns[] = {
{
"os/link", os_link,
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
"Create a symlink from oldpath to newpath. The 3 optional paramater "
"enables a hard link over a soft link. Does not work on Windows.")
"Create a symlink from oldpath to newpath, returning nil. The 3rd optional paramater "
"enables a symlink iff truthy, hard link otherwise or if not provided. Does not work on Windows.")
},
{
"os/symlink", os_symlink,
JDOC("(os/symlink oldpath newpath)\n\n"
"Create a symlink from oldpath to newpath, returning nil. Same as (os/link oldpath newpath true).")
},
{
"os/readlink", os_readlink,
JDOC("(os/readlink path)\n\n"
"Read the contents of a symbolic link. Does not work on Windows.\n")
},
{
"os/execute", os_execute,
@@ -1080,6 +1346,16 @@ static const JanetReg os_cfuns[] = {
"Get the current time expressed as the number of seconds since "
"January 1, 1970, the Unix epoch. Returns a real number.")
},
{
"os/mktime", os_mktime,
JDOC("(os/mktime date-struct &opt local)\n\n"
"Get the broken down date-struct time expressed as the number "
" of seconds since January 1, 1970, the Unix epoch. "
"Returns a real number. "
"Date is given in UTC unless local is truthy, in which case the "
"date is computed for the local timezone.\n\n"
"Inverse function to os/date.")
},
{
"os/clock", os_clock,
JDOC("(os/clock)\n\n"
@@ -1124,6 +1400,12 @@ static const JanetReg os_cfuns[] = {
JDOC("(os/rename oldname newname)\n\n"
"Rename a file on disk to a new path. Returns nil.")
},
{
"os/realpath", os_realpath,
JDOC("(os/realpath path)\n\n"
"Get the absolute path for a given path, following ../, ./, and symlinks. "
"Returns an absolute path as a string. Will raise an error on Windows.")
},
#endif
{NULL, NULL, NULL}
};

View File

@@ -112,6 +112,8 @@ struct JanetParseState {
Consumer consumer;
};
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
/* Define a stack on the main parser struct */
#define DEF_PARSER_STACK(NAME, T, STACK, STACKCOUNT, STACKCAP) \
static void NAME(JanetParser *p, T x) { \
@@ -183,8 +185,12 @@ static void popstate(JanetParser *p, Janet val) {
(c == ',') ? "unquote" :
(c == ';') ? "splice" :
(c == '|') ? "short-fn" :
(c == '~') ? "quasiquote" : "<unknown>";
t[0] = janet_csymbolv(which);
(c == '~') ? "quasiquote" : NULL;
if (!which) {
t[0] = p->args[--p->argcount];
} else {
t[0] = janet_csymbolv(which);
}
t[1] = val;
/* Quote source mapping info */
janet_tuple_sm_line(t) = (int32_t) newtop->line;
@@ -320,6 +326,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
Janet ret;
double numval;
int32_t blen;
int prefix_symbol = 0;
if (is_symbol_char(c)) {
push_buf(p, (uint8_t) c);
if (c > 127) state->argn = 1; /* Use to indicate non ascii */
@@ -357,10 +364,20 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
return 0;
}
ret = janet_symbolv(p->buf, blen);
prefix_symbol = c == '"' || c == '`' || c == '[' || c == '(' || c == '{';
}
}
p->bufcount = 0;
popstate(p, ret);
if (prefix_symbol) {
push_arg(p, ret);
/* Set current state to a different state */
JanetParseState newState = {0};
newState.flags = PFLAG_READERMAC;
newState.consumer = root;
*state = newState;
} else {
popstate(p, ret);
}
return 0;
}
@@ -455,8 +472,6 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
}
}
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
(void) state;
p->statecount--;
@@ -732,7 +747,7 @@ static int parsergc(void *p, size_t size) {
static int parserget(void *p, Janet key, Janet *out);
static JanetAbstractType janet_parse_parsertype = {
const JanetAbstractType janet_parser_type = {
"core/parser",
parsergc,
parsermark,
@@ -744,14 +759,14 @@ static JanetAbstractType janet_parse_parsertype = {
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
(void) argv;
janet_fixarity(argc, 0);
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
JanetParser *p = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_init(p);
return janet_wrap_abstract(p);
}
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetByteView view = janet_getbytes(argv, 1);
if (argc == 3) {
int32_t offset = janet_getinteger(argv, 2);
@@ -776,14 +791,14 @@ static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
static Janet cfun_parse_eof(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_eof(p);
return argv[0];
}
static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
JanetParseState *s = p->states + p->statecount - 1;
if (s->consumer == tokenchar) {
janet_parser_consume(p, ' ');
@@ -817,13 +832,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
return janet_wrap_boolean(janet_parser_has_more(p));
}
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
int32_t i = janet_getinteger(argv, 1);
janet_parser_consume(p, 0xFF & i);
return argv[0];
@@ -831,7 +846,7 @@ static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *stat = NULL;
switch (janet_parser_status(p)) {
case JANET_PARSE_PENDING:
@@ -852,7 +867,7 @@ static Janet cfun_parse_status(int32_t argc, Janet *argv) {
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
const char *err = janet_parser_error(p);
if (err) return janet_cstringv(err);
return janet_wrap_nil();
@@ -860,20 +875,20 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
return janet_parser_produce(p);
}
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
janet_parser_flush(p);
return argv[0];
}
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer(p->line);
tup[1] = janet_wrap_integer(p->column);
@@ -927,6 +942,7 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
type = (c == '\'') ? "quote" :
(c == ',') ? "unquote" :
(c == ';') ? "splice" :
(c == '|') ? "short-fn" :
(c == '~') ? "quasiquote" : "<reader>";
} else {
type = "root";
@@ -953,7 +969,7 @@ struct ParserStateGetter {
};
static Janet parser_state_delimiters(const JanetParser *_p) {
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
JanetParser *clone = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_clone(_p, clone);
size_t i;
const uint8_t *str;
@@ -1004,7 +1020,7 @@ static const struct ParserStateGetter parser_state_getters[] = {
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *key = NULL;
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc == 2) {
key = janet_getkeyword(argv, 1);
}
@@ -1031,8 +1047,8 @@ static Janet cfun_parse_state(int32_t argc, Janet *argv) {
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
JanetParser *src = janet_getabstract(argv, 0, &janet_parser_type);
JanetParser *dest = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_clone(src, dest);
return janet_wrap_abstract(dest);
}

View File

@@ -35,34 +35,6 @@
* Runtime
*/
/* opcodes for peg vm */
typedef enum {
RULE_LITERAL, /* [len, bytes...] */
RULE_NCHAR, /* [n] */
RULE_NOTNCHAR, /* [n] */
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
RULE_SET, /* [bitmap (8 words)] */
RULE_LOOK, /* [offset, rule] */
RULE_CHOICE, /* [len, rules...] */
RULE_SEQUENCE, /* [len, rules...] */
RULE_IF, /* [rule_a, rule_b (b if a)] */
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
RULE_NOT, /* [rule] */
RULE_BETWEEN, /* [lo, hi, rule] */
RULE_GETTAG, /* [searchtag, tag] */
RULE_CAPTURE, /* [rule, tag] */
RULE_POSITION, /* [tag] */
RULE_ARGUMENT, /* [argument-index, tag] */
RULE_CONSTANT, /* [constant, tag] */
RULE_ACCUMULATE, /* [rule, tag] */
RULE_GROUP, /* [rule, tag] */
RULE_REPLACE, /* [rule, constant, tag] */
RULE_MATCHTIME, /* [rule, constant, tag] */
RULE_ERROR, /* [rule] */
RULE_DROP, /* [rule] */
RULE_BACKMATCH, /* [tag] */
} Opcode;
/* Hold captured patterns and match state */
typedef struct {
const uint8_t *text_start;
@@ -369,19 +341,23 @@ tail:
s->mode = oldmode;
if (!result) return NULL;
Janet cap;
Janet cap = janet_wrap_nil();
Janet constant = s->constants[rule[2]];
switch (janet_type(constant)) {
default:
cap = constant;
break;
case JANET_STRUCT:
cap = janet_struct_get(janet_unwrap_struct(constant),
s->captures->data[s->captures->count - 1]);
if (s->captures->count) {
cap = janet_struct_get(janet_unwrap_struct(constant),
s->captures->data[s->captures->count - 1]);
}
break;
case JANET_TABLE:
cap = janet_table_get(janet_unwrap_table(constant),
s->captures->data[s->captures->count - 1]);
if (s->captures->count) {
cap = janet_table_get(janet_unwrap_table(constant),
s->captures->data[s->captures->count - 1]);
}
break;
case JANET_CFUNCTION:
cap = janet_unwrap_cfunction(constant)(s->captures->count - cs.cap,
@@ -476,7 +452,7 @@ JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
static void peg_fixarity(Builder *b, int32_t argc, int32_t arity) {
if (argc != arity) {
peg_panicf(b, "expected %d argument%s, got %d%",
peg_panicf(b, "expected %d argument%s, got %d",
arity,
arity == 1 ? "" : "s",
argc);
@@ -1012,16 +988,9 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
* Post-Compilation
*/
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
} Peg;
static int peg_mark(void *p, size_t size) {
(void) size;
Peg *peg = (Peg *)p;
JanetPeg *peg = (JanetPeg *)p;
if (NULL != peg->constants)
for (uint32_t i = 0; i < peg->num_constants; i++)
janet_mark(peg->constants[i]);
@@ -1029,7 +998,7 @@ static int peg_mark(void *p, size_t size) {
}
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
Peg *peg = (Peg *)p;
JanetPeg *peg = (JanetPeg *)p;
janet_marshal_size(ctx, peg->bytecode_len);
janet_marshal_int(ctx, (int32_t)peg->num_constants);
janet_marshal_abstract(ctx, p);
@@ -1051,7 +1020,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
uint32_t num_constants = (uint32_t) janet_unmarshal_int(ctx);
/* Calculate offsets. Should match those in make_peg */
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
size_t bytecode_size = bytecode_len * sizeof(uint32_t);
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
size_t total_size = constants_start + sizeof(Janet) * (size_t) num_constants;
@@ -1061,7 +1030,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
/* Allocate PEG */
char *mem = janet_unmarshal_abstract(ctx, total_size);
Peg *peg = (Peg *)mem;
JanetPeg *peg = (JanetPeg *)mem;
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
Janet *constants = (Janet *)(mem + constants_start);
peg->bytecode = NULL;
@@ -1204,7 +1173,7 @@ bad:
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out);
static const JanetAbstractType peg_type = {
const JanetAbstractType janet_peg_type = {
"core/peg",
NULL,
peg_mark,
@@ -1215,15 +1184,15 @@ static const JanetAbstractType peg_type = {
JANET_ATEND_UNMARSHAL
};
/* Convert Builder to Peg (Janet Abstract Value) */
static Peg *make_peg(Builder *b) {
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
/* Convert Builder to JanetPeg (Janet Abstract Value) */
static JanetPeg *make_peg(Builder *b) {
size_t bytecode_start = size_padded(sizeof(JanetPeg), sizeof(uint32_t));
size_t bytecode_size = janet_v_count(b->bytecode) * sizeof(uint32_t);
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
size_t constants_size = janet_v_count(b->constants) * sizeof(Janet);
size_t total_size = constants_start + constants_size;
char *mem = janet_abstract(&peg_type, total_size);
Peg *peg = (Peg *)mem;
char *mem = janet_abstract(&janet_peg_type, total_size);
JanetPeg *peg = (JanetPeg *)mem;
peg->bytecode = (uint32_t *)(mem + bytecode_start);
peg->constants = (Janet *)(mem + constants_start);
peg->num_constants = janet_v_count(b->constants);
@@ -1234,7 +1203,7 @@ static Peg *make_peg(Builder *b) {
}
/* Compiler entry point */
static Peg *compile_peg(Janet x) {
static JanetPeg *compile_peg(Janet x) {
Builder builder;
builder.grammar = janet_table(0);
builder.default_grammar = janet_get_core_table("default-peg-grammar");
@@ -1245,7 +1214,7 @@ static Peg *compile_peg(Janet x) {
builder.form = x;
builder.depth = JANET_RECURSION_GUARD;
peg_compile1(&builder, x);
Peg *peg = make_peg(&builder);
JanetPeg *peg = make_peg(&builder);
builder_cleanup(&builder);
return peg;
}
@@ -1256,15 +1225,15 @@ static Peg *compile_peg(Janet x) {
static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
Peg *peg = compile_peg(argv[0]);
JanetPeg *peg = compile_peg(argv[0]);
return janet_wrap_abstract(peg);
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
Peg *peg;
JanetPeg *peg;
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &peg_type) {
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
peg = janet_unwrap_abstract(argv[0]);
} else {
peg = compile_peg(argv[0]);
@@ -1323,7 +1292,7 @@ static const JanetReg peg_cfuns[] = {
/* Load the peg module */
void janet_lib_peg(JanetTable *env) {
janet_core_cfuns(env, NULL, peg_cfuns);
janet_register_abstract_type(&peg_type);
janet_register_abstract_type(&janet_peg_type);
}
#endif /* ifdef JANET_PEG */

View File

@@ -688,96 +688,6 @@ static void pushtypes(JanetBuffer *buffer, int types) {
}
}
void janet_formatb(JanetBuffer *bufp, const char *format, va_list args) {
for (const char *c = format; *c; c++) {
switch (*c) {
default:
janet_buffer_push_u8(bufp, *c);
break;
case '%': {
if (c[1] == '\0')
break;
switch (*++c) {
default:
janet_buffer_push_u8(bufp, *c);
break;
case 'f':
number_to_string_b(bufp, va_arg(args, double));
break;
case 'd':
integer_to_string_b(bufp, va_arg(args, long));
break;
case 'S': {
const uint8_t *str = va_arg(args, const uint8_t *);
janet_buffer_push_bytes(bufp, str, janet_string_length(str));
break;
}
case 's':
janet_buffer_push_cstring(bufp, va_arg(args, const char *));
break;
case 'c':
janet_buffer_push_u8(bufp, (uint8_t) va_arg(args, long));
break;
case 'q': {
const uint8_t *str = va_arg(args, const uint8_t *);
janet_escape_string_b(bufp, str);
break;
}
case 't': {
janet_buffer_push_cstring(bufp, typestr(va_arg(args, Janet)));
break;
}
case 'T': {
int types = va_arg(args, long);
pushtypes(bufp, types);
break;
}
case 'V': {
janet_to_string_b(bufp, va_arg(args, Janet));
break;
}
case 'v': {
janet_description_b(bufp, va_arg(args, Janet));
break;
}
case 'p': {
janet_pretty(bufp, 4, 0, va_arg(args, Janet));
break;
}
case 'P': {
janet_pretty(bufp, 4, JANET_PRETTY_COLOR, va_arg(args, Janet));
break;
}
}
}
}
}
}
/* Helper function for formatting strings. Useful for generating error messages and the like.
* Similar to printf, but specialized for operating with janet. */
const uint8_t *janet_formatc(const char *format, ...) {
va_list args;
const uint8_t *ret;
JanetBuffer buffer;
int32_t len = 0;
/* Calculate length, init buffer and args */
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
/* Run format */
janet_formatb(&buffer, format, args);
/* Iterate length */
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
return ret;
}
/*
* code adapted from lua/lstrlib.c http://lua.org
*/
@@ -818,6 +728,141 @@ static const char *scanformat(
return p;
}
void janet_formatb(JanetBuffer *b, const char *format, va_list args) {
const char *format_end = format + strlen(format);
const char *c = format;
int32_t startlen = b->count;
while (c < format_end) {
if (*c != '%') {
janet_buffer_push_u8(b, (uint8_t) *c++);
} else if (*++c == '%') {
janet_buffer_push_u8(b, (uint8_t) *c++);
} else {
char form[MAX_FORMAT], item[MAX_ITEM];
char width[3], precision[3];
int nb = 0; /* number of bytes in added item */
c = scanformat(c, form, width, precision);
switch (*c++) {
case 'c': {
int n = va_arg(args, long);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'd':
case 'i':
case 'o':
case 'u':
case 'x':
case 'X': {
int32_t n = va_arg(args, long);
nb = snprintf(item, MAX_ITEM, form, n);
break;
}
case 'a':
case 'A':
case 'e':
case 'E':
case 'f':
case 'g':
case 'G': {
double d = va_arg(args, double);
nb = snprintf(item, MAX_ITEM, form, d);
break;
}
case 's':
case 'S': {
const char *str = va_arg(args, const char *);
int32_t len = c[-1] == 's'
? (int32_t) strlen(str)
: janet_string_length((JanetString) str);
if (form[2] == '\0')
janet_buffer_push_bytes(b, (const uint8_t *) str, len);
else {
if (len != (int32_t) strlen((const char *) str))
janet_panic("string contains zeros");
if (!strchr(form, '.') && len >= 100) {
janet_panic("no precision and string is too long to be formatted");
} else {
nb = snprintf(item, MAX_ITEM, form, str);
}
}
break;
}
case 'V':
janet_to_string_b(b, va_arg(args, Janet));
break;
case 'v':
janet_description_b(b, va_arg(args, Janet));
break;
case 't':
janet_buffer_push_cstring(b, typestr(va_arg(args, Janet)));
break;
case 'T': {
int types = va_arg(args, long);
pushtypes(b, types);
break;
}
case 'Q':
case 'q':
case 'P':
case 'p': { /* janet pretty , precision = depth */
int depth = atoi(precision);
if (depth < 1) depth = 4;
char d = c[-1];
int has_color = (d == 'P') || (d == 'Q');
int has_oneline = (d == 'Q') || (d == 'q');
int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
break;
}
case 'j': {
int depth = atoi(precision);
if (depth < 1)
depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, va_arg(args, Janet), startlen);
break;
}
default: {
/* also treat cases 'nLlh' */
janet_panicf("invalid conversion '%s' to 'format'",
form);
}
}
if (nb >= MAX_ITEM)
janet_panicf("format buffer overflow", form);
if (nb > 0)
janet_buffer_push_bytes(b, (uint8_t *) item, nb);
}
}
}
/* Helper function for formatting strings. Useful for generating error messages and the like.
* Similar to printf, but specialized for operating with janet. */
const uint8_t *janet_formatc(const char *format, ...) {
va_list args;
const uint8_t *ret;
JanetBuffer buffer;
int32_t len = 0;
/* Calculate length, init buffer and args */
while (format[len]) len++;
janet_buffer_init(&buffer, len);
va_start(args, format);
/* Run format */
janet_formatb(&buffer, format, args);
/* Iterate length */
va_end(args);
ret = janet_string(buffer.data, buffer.count);
janet_buffer_deinit(&buffer);
return ret;
}
/* Shared implementation between string/format and
* buffer/format */
void janet_buffer_format(

View File

@@ -53,6 +53,10 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
* along with otherwise bare c function pointers. */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
/* Registry for abstract abstract types that can be marshalled.
* We need this to look up the constructors when unmarshalling. */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
/* Immutable value cache */
extern JANET_THREAD_LOCAL const uint8_t **janet_vm_cache;
extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_capacity;

View File

@@ -51,10 +51,6 @@ struct JanetMailbox {
pthread_cond_t cond;
#endif
/* Setup procedure - requires a parent mailbox
* to receive thunk from */
JanetMailbox *parent;
/* Memory management - reference counting */
int refCount;
int closed;
@@ -70,6 +66,11 @@ struct JanetMailbox {
JanetBuffer messages[];
};
typedef struct {
JanetMailbox *original;
JanetMailbox *newbox;
} JanetMailboxPair;
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
static JANET_THREAD_LOCAL JanetThread *janet_vm_thread_current = NULL;
static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
@@ -82,7 +83,7 @@ static JanetTable *janet_thread_get_decode(void) {
return janet_vm_thread_decode;
}
static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, uint16_t capacity) {
static JanetMailbox *janet_mailbox_create(int refCount, uint16_t capacity) {
JanetMailbox *mailbox = malloc(sizeof(JanetMailbox) + sizeof(JanetBuffer) * (size_t) capacity);
if (NULL == mailbox) {
JANET_OUT_OF_MEMORY;
@@ -96,7 +97,6 @@ static JanetMailbox *janet_mailbox_create(JanetMailbox *parent, int refCount, ui
#endif
mailbox->refCount = refCount;
mailbox->closed = 0;
mailbox->parent = parent;
mailbox->messageCount = 0;
mailbox->messageCapacity = capacity;
mailbox->messageFirst = 0;
@@ -175,6 +175,23 @@ static int thread_mark(void *p, size_t size) {
return 0;
}
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
if (NULL == pair) {
JANET_OUT_OF_MEMORY;
}
pair->original = original;
janet_mailbox_ref(original, 1);
pair->newbox = janet_mailbox_create(1, 16);
return pair;
}
static void destroy_mailbox_pair(JanetMailboxPair *pair) {
janet_mailbox_ref(pair->original, -1);
janet_mailbox_ref(pair->newbox, -1);
free(pair);
}
/* Abstract waiting for timeout across windows/posix */
typedef struct {
int timedwait;
@@ -392,7 +409,7 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
static int janet_thread_getter(void *p, Janet key, Janet *out);
static JanetAbstractType Thread_AT = {
const JanetAbstractType janet_thread_type = {
"core/thread",
thread_gc,
thread_mark,
@@ -401,23 +418,25 @@ static JanetAbstractType Thread_AT = {
};
static JanetThread *janet_make_thread(JanetMailbox *mailbox, JanetTable *encode) {
JanetThread *thread = janet_abstract(&Thread_AT, sizeof(JanetThread));
JanetThread *thread = janet_abstract(&janet_thread_type, sizeof(JanetThread));
janet_mailbox_ref(mailbox, 1);
thread->mailbox = mailbox;
thread->encode = encode;
return thread;
}
JanetThread *janet_getthread(const Janet *argv, int32_t n) {
return (JanetThread *) janet_getabstract(argv, n, &Thread_AT);
return (JanetThread *) janet_getabstract(argv, n, &janet_thread_type);
}
/* Runs in new thread */
static int thread_worker(JanetMailbox *mailbox) {
static int thread_worker(JanetMailboxPair *pair) {
JanetFiber *fiber = NULL;
Janet out;
/* Use the mailbox we were given */
janet_vm_mailbox = mailbox;
janet_vm_mailbox = pair->newbox;
janet_mailbox_ref(pair->newbox, 1);
/* Init VM */
janet_init();
@@ -426,9 +445,7 @@ static int thread_worker(JanetMailbox *mailbox) {
JanetTable *encode = janet_get_core_table("make-image-dict");
/* Create parent thread */
JanetThread *parent = janet_make_thread(mailbox->parent, encode);
janet_mailbox_ref(mailbox->parent, -1);
mailbox->parent = NULL; /* only used to create the thread */
JanetThread *parent = janet_make_thread(pair->original, encode);
Janet parentv = janet_wrap_abstract(parent);
/* Unmarshal the function */
@@ -449,16 +466,18 @@ static int thread_worker(JanetMailbox *mailbox) {
fiber = janet_fiber(func, 64, 1, argv);
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
if (sig != JANET_SIGNAL_OK) {
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(mailbox, encode)));
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
janet_stacktrace(fiber, out);
}
/* Normal exit */
destroy_mailbox_pair(pair);
janet_deinit();
return 0;
/* Fail to set something up */
error:
destroy_mailbox_pair(pair);
janet_eprintf("\nthread failed to start\n");
janet_deinit();
return 1;
@@ -467,12 +486,12 @@ error:
#ifdef JANET_WINDOWS
static DWORD WINAPI janet_create_thread_wrapper(LPVOID param) {
thread_worker((JanetMailbox *)param);
thread_worker((JanetMailboxPair *)param);
return 0;
}
static int janet_thread_start_child(JanetThread *thread) {
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, thread->mailbox, 0, NULL);
static int janet_thread_start_child(JanetMailboxPair *pair) {
HANDLE handle = CreateThread(NULL, 0, janet_create_thread_wrapper, pair, 0, NULL);
int ret = NULL == handle;
/* Does not kill thread, simply detatches */
if (!ret) CloseHandle(handle);
@@ -482,13 +501,13 @@ static int janet_thread_start_child(JanetThread *thread) {
#else
static void *janet_pthread_wrapper(void *param) {
thread_worker((JanetMailbox *)param);
thread_worker((JanetMailboxPair *)param);
return NULL;
}
static int janet_thread_start_child(JanetThread *thread) {
static int janet_thread_start_child(JanetMailboxPair *pair) {
pthread_t handle;
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, thread->mailbox);
int error = pthread_create(&handle, NULL, janet_pthread_wrapper, pair);
if (error) {
return 1;
} else {
@@ -505,7 +524,7 @@ static int janet_thread_start_child(JanetThread *thread) {
void janet_threads_init(void) {
if (NULL == janet_vm_mailbox) {
janet_vm_mailbox = janet_mailbox_create(NULL, 1, 10);
janet_vm_mailbox = janet_mailbox_create(1, 10);
}
janet_vm_thread_decode = NULL;
janet_vm_thread_current = NULL;
@@ -529,7 +548,6 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
if (NULL == janet_vm_thread_current) {
janet_vm_thread_current = janet_make_thread(janet_vm_mailbox, janet_get_core_table("make-image-dict"));
janet_mailbox_ref(janet_vm_mailbox, 1);
janet_gcroot(janet_wrap_abstract(janet_vm_thread_current));
}
return janet_wrap_abstract(janet_vm_thread_current);
@@ -544,15 +562,11 @@ static Janet cfun_thread_new(int32_t argc, Janet *argv) {
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
}
JanetTable *encode = janet_get_core_table("make-image-dict");
JanetMailbox *mailbox = janet_mailbox_create(janet_vm_mailbox, 2, (uint16_t) cap);
/* one for created thread, one for ->parent reference in new mailbox */
janet_mailbox_ref(janet_vm_mailbox, 2);
JanetThread *thread = janet_make_thread(mailbox, encode);
if (janet_thread_start_child(thread)) {
janet_mailbox_ref(mailbox, -1); /* mailbox reference */
janet_mailbox_ref(janet_vm_mailbox, -1); /* ->parent reference */
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
JanetThread *thread = janet_make_thread(pair->newbox, encode);
if (janet_thread_start_child(pair)) {
destroy_mailbox_pair(pair);
janet_panic("could not start thread");
}
@@ -650,7 +664,7 @@ static const JanetReg threadlib_cfuns[] = {
/* Module entry point */
void janet_lib_thread(JanetTable *env) {
janet_core_cfuns(env, NULL, threadlib_cfuns);
janet_register_abstract_type(&Thread_AT);
janet_register_abstract_type(&janet_thread_type);
}
#endif

View File

@@ -111,7 +111,7 @@ static void *ta_buffer_unmarshal(JanetMarshalContext *ctx) {
return buf;
}
static const JanetAbstractType ta_buffer_type = {
const JanetAbstractType janet_ta_buffer_type = {
"ta/buffer",
ta_buffer_gc,
NULL,
@@ -154,7 +154,7 @@ static void *ta_view_unmarshal(JanetMarshalContext *ctx) {
offset = janet_unmarshal_size(ctx);
buffer = janet_unmarshal_janet(ctx);
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &janet_ta_buffer_type)) {
janet_panicf("expected typed array buffer");
}
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
@@ -275,7 +275,7 @@ static void ta_setter(void *p, Janet key, Janet value) {
}
}
static const JanetAbstractType ta_view_type = {
const JanetAbstractType janet_ta_view_type = {
"ta/view",
NULL,
ta_mark,
@@ -287,7 +287,7 @@ static const JanetAbstractType ta_view_type = {
};
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
JanetTArrayBuffer *buf = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
JanetTArrayBuffer *buf = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buf, size);
return buf;
}
@@ -299,13 +299,13 @@ JanetTArrayView *janet_tarray_view(
size_t offset,
JanetTArrayBuffer *buffer) {
JanetTArrayView *view = janet_abstract(&ta_view_type, sizeof(JanetTArrayView));
JanetTArrayView *view = janet_abstract(&janet_ta_view_type, sizeof(JanetTArrayView));
if ((stride < 1) || (size < 1)) janet_panic("stride and size should be > 0");
size_t buf_size = offset + ta_type_sizes[type] * ((size - 1) * stride + 1);
if (NULL == buffer) {
buffer = janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
buffer = janet_abstract(&janet_ta_buffer_type, sizeof(JanetTArrayBuffer));
ta_buffer_init(buffer, buf_size);
}
@@ -325,15 +325,15 @@ JanetTArrayView *janet_tarray_view(
}
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &ta_buffer_type);
return janet_getabstract(argv, n, &janet_ta_buffer_type);
}
JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n) {
return janet_getabstract(argv, n, &ta_view_type);
return janet_getabstract(argv, n, &janet_ta_view_type);
}
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
JanetTArrayView *view = janet_getabstract(argv, n, &ta_view_type);
JanetTArrayView *view = janet_getabstract(argv, n, &janet_ta_view_type);
if (view->type != type) {
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
n, ta_type_names[type], argv[n]);
@@ -359,7 +359,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
4, argv[4]);
}
void *p = janet_unwrap_abstract(argv[4]);
if (janet_abstract_type(p) == &ta_view_type) {
if (janet_abstract_type(p) == &janet_ta_view_type) {
JanetTArrayView *view = (JanetTArrayView *)p;
offset = (view->buffer->data - view->as.u8) + offset * ta_type_sizes[view->type];
stride *= view->stride;
@@ -375,7 +375,7 @@ static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
static JanetTArrayView *ta_is_view(Janet x) {
if (!janet_checktype(x, JANET_ABSTRACT)) return NULL;
void *abst = janet_unwrap_abstract(x);
if (janet_abstract_type(abst) != &ta_view_type) return NULL;
if (janet_abstract_type(abst) != &janet_ta_view_type) return NULL;
return (JanetTArrayView *)abst;
}
@@ -396,7 +396,7 @@ static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
if ((view = ta_is_view(argv[0]))) {
return janet_wrap_number((double) view->size);
}
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &janet_ta_buffer_type);
return janet_wrap_number((double) buf->size);
}
@@ -433,7 +433,7 @@ static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
JanetRange range;
int32_t length = (int32_t)src->size;
if (argc == 1) {
@@ -461,9 +461,9 @@ static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
@@ -488,9 +488,9 @@ static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
janet_arity(argc, 4, 5);
JanetTArrayView *src = janet_getabstract(argv, 0, &ta_view_type);
JanetTArrayView *src = janet_getabstract(argv, 0, &janet_ta_view_type);
size_t index_src = janet_getsize(argv, 1);
JanetTArrayView *dst = janet_getabstract(argv, 2, &ta_view_type);
JanetTArrayView *dst = janet_getabstract(argv, 2, &janet_ta_view_type);
size_t index_dst = janet_getsize(argv, 3);
size_t count = (argc == 5) ? janet_getsize(argv, 4) : 1;
size_t src_atom_size = ta_type_sizes[src->type];
@@ -574,8 +574,8 @@ static JanetMethod tarray_view_methods[] = {
/* Module entry point */
void janet_lib_typed_array(JanetTable *env) {
janet_core_cfuns(env, NULL, ta_cfuns);
janet_register_abstract_type(&ta_buffer_type);
janet_register_abstract_type(&ta_view_type);
janet_register_abstract_type(&janet_ta_buffer_type);
janet_register_abstract_type(&janet_ta_view_type);
}
#endif

View File

@@ -423,38 +423,21 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
/* Abstract type introspection */
static const JanetAbstractType type_wrap = {
"core/type-info",
JANET_ATEND_NAME
};
typedef struct {
const JanetAbstractType *at;
} JanetAbstractTypeWrap;
void janet_register_abstract_type(const JanetAbstractType *at) {
JanetAbstractTypeWrap *abstract = (JanetAbstractTypeWrap *)
janet_abstract(&type_wrap, sizeof(JanetAbstractTypeWrap));
abstract->at = at;
Janet sym = janet_csymbolv(at->name);
if (!(janet_checktype(janet_table_get(janet_vm_registry, sym), JANET_NIL))) {
if (!(janet_checktype(janet_table_get(janet_vm_abstract_registry, sym), JANET_NIL))) {
janet_panicf("cannot register abstract type %s, "
"a type with the same name exists", at->name);
}
janet_table_put(janet_vm_registry, sym, janet_wrap_abstract(abstract));
janet_table_put(janet_vm_abstract_registry, sym, janet_wrap_pointer((void *) at));
}
const JanetAbstractType *janet_get_abstract_type(Janet key) {
Janet twrap = janet_table_get(janet_vm_registry, key);
if (janet_checktype(twrap, JANET_NIL)) {
Janet wrapped = janet_table_get(janet_vm_abstract_registry, key);
if (janet_checktype(wrapped, JANET_NIL)) {
return NULL;
}
if (!janet_checktype(twrap, JANET_ABSTRACT) ||
(janet_abstract_type(janet_unwrap_abstract(twrap)) != &type_wrap)) {
janet_panic("expected abstract type");
}
JanetAbstractTypeWrap *w = (JanetAbstractTypeWrap *)janet_unwrap_abstract(twrap);
return w->at;
return (JanetAbstractType *)(janet_unwrap_pointer(wrapped));
}
#ifndef JANET_BOOTSTRAP

View File

@@ -30,9 +30,12 @@
#include "util.h"
#endif
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
@@ -1249,6 +1252,7 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
}
if (old_status == JANET_STATUS_ALIVE ||
old_status == JANET_STATUS_DEAD ||
(old_status >= JANET_STATUS_USER0 && old_status <= JANET_STATUS_USER4) ||
old_status == JANET_STATUS_ERROR) {
const uint8_t *str = janet_formatc("cannot resume fiber with status :%s",
janet_status_names[old_status]);
@@ -1269,6 +1273,19 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
fiber->child = NULL;
}
/* Handle new fibers being resumed with a non-nil value */
if (old_status == JANET_STATUS_NEW && !janet_checktype(in, JANET_NIL)) {
Janet *stack = fiber->data + fiber->frame;
JanetFunction *func = janet_stack_frame(stack)->func;
if (func) {
if (func->def->arity > 0) {
stack[0] = in;
} else if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
stack[0] = janet_wrap_tuple(janet_tuple_n(&in, 1));
}
}
}
/* Save global state */
int32_t oldn = janet_vm_stackn++;
int handle = janet_vm_gc_suspend;
@@ -1364,7 +1381,9 @@ int janet_init(void) {
janet_scratch_cap = 0;
/* Initialize registry */
janet_vm_registry = janet_table(0);
janet_vm_abstract_registry = janet_table(0);
janet_gcroot(janet_wrap_table(janet_vm_registry));
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
/* Core env */
janet_vm_core_env = NULL;
/* Seed RNG */
@@ -1385,6 +1404,7 @@ void janet_deinit(void) {
janet_vm_root_count = 0;
janet_vm_root_capacity = 0;
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
#ifdef JANET_THREADS
janet_threads_deinit();

View File

@@ -97,7 +97,14 @@ extern "C" {
#endif
/* Check big endian */
#if defined(__MIPSEB__) /* MIPS 32-bit */ \
#if defined(__LITTLE_ENDIAN__) || \
(defined(__BYTE_ORDER__) && (__BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__))
/* If we know the target is LE, always use that - e.g. ppc64 little endian
* defines the __LITTLE_ENDIAN__ macro in the ABI spec, so we can rely
* on that and if that's not defined, fall back to big endian assumption
*/
#define JANET_LITTLE_ENDIAN 1
#elif defined(__MIPSEB__) /* MIPS 32-bit */ \
|| defined(__ppc__) || defined(__PPC__) /* CPU(PPC) - PowerPC 32-bit */ \
|| defined(__powerpc__) || defined(__powerpc) || defined(__POWERPC__) \
|| defined(_M_PPC) || defined(__PPC) \
@@ -656,7 +663,7 @@ struct Janet {
#define janet_type(x) ((x).type)
#define janet_checktype(x, t) ((x).type == (t))
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
@@ -681,8 +688,8 @@ JANET_API int janet_checkint(Janet x);
JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) == (int64_t)(x))
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -805,6 +812,7 @@ struct JanetAbstractHead {
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
/* Source mapping structure for a bytecode instruction */
@@ -820,6 +828,7 @@ struct JanetFuncDef {
Janet *constants;
JanetFuncDef **defs;
uint32_t *bytecode;
uint32_t *closure_bitset; /* Bit set indicating which slots can be referenced by closures. */
/* Various debug information */
JanetSourceMapping *sourcemap;
@@ -887,8 +896,9 @@ struct JanetParser {
int flag;
};
/* A context for marshaling and unmarshaling abstract types */
typedef struct {
void *m_state; /* void* to not expose MarshalState ?*/
void *m_state;
void *u_state;
int flags;
const uint8_t *data;
@@ -965,6 +975,12 @@ struct JanetRNG {
uint32_t counter;
};
typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int flags;
};
/* Thread types */
#ifdef JANET_THREADS
typedef struct JanetThread JanetThread;
@@ -1095,6 +1111,7 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** START SECTION MAIN *****/
/* Parsing */
extern JANET_API const JanetAbstractType janet_parser_type;
JANET_API void janet_parser_init(JanetParser *parser);
JANET_API void janet_parser_deinit(JanetParser *parser);
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
@@ -1156,6 +1173,7 @@ JANET_API void janet_debug_find(
JanetString source, int32_t line, int32_t column);
/* RNG */
extern JANET_API const JanetAbstractType janet_rng_type;
JANET_API JanetRNG *janet_default_rng(void);
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
JANET_API void janet_rng_longseed(JanetRNG *rng, const uint8_t *bytes, int32_t len);
@@ -1468,6 +1486,8 @@ JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n,
JANET_API Janet janet_dyn(const char *name);
JANET_API void janet_setdyn(const char *name, Janet value);
extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_WRITE 1
#define JANET_FILE_READ 2
#define JANET_FILE_APPEND 4
@@ -1505,8 +1525,52 @@ JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
#ifdef JANET_PEG
extern JANET_API const JanetAbstractType janet_peg_type;
/* opcodes for peg vm */
typedef enum {
RULE_LITERAL, /* [len, bytes...] */
RULE_NCHAR, /* [n] */
RULE_NOTNCHAR, /* [n] */
RULE_RANGE, /* [lo | hi << 16 (1 word)] */
RULE_SET, /* [bitmap (8 words)] */
RULE_LOOK, /* [offset, rule] */
RULE_CHOICE, /* [len, rules...] */
RULE_SEQUENCE, /* [len, rules...] */
RULE_IF, /* [rule_a, rule_b (b if a)] */
RULE_IFNOT, /* [rule_a, rule_b (b if not a)] */
RULE_NOT, /* [rule] */
RULE_BETWEEN, /* [lo, hi, rule] */
RULE_GETTAG, /* [searchtag, tag] */
RULE_CAPTURE, /* [rule, tag] */
RULE_POSITION, /* [tag] */
RULE_ARGUMENT, /* [argument-index, tag] */
RULE_CONSTANT, /* [constant, tag] */
RULE_ACCUMULATE, /* [rule, tag] */
RULE_GROUP, /* [rule, tag] */
RULE_REPLACE, /* [rule, constant, tag] */
RULE_MATCHTIME, /* [rule, constant, tag] */
RULE_ERROR, /* [rule] */
RULE_DROP, /* [rule] */
RULE_BACKMATCH, /* [tag] */
} JanetPegOpcode;
typedef struct {
uint32_t *bytecode;
Janet *constants;
size_t bytecode_len;
uint32_t num_constants;
} JanetPeg;
#endif
#ifdef JANET_TYPED_ARRAY
extern JANET_API const JanetAbstractType janet_ta_view_type;
extern JANET_API const JanetAbstractType janet_ta_buffer_type;
typedef enum {
JANET_TARRAY_TYPE_U8,
JANET_TARRAY_TYPE_S8,
@@ -1557,6 +1621,9 @@ JanetTArrayView *janet_gettarray_any(const Janet *argv, int32_t n);
#ifdef JANET_INT_TYPES
extern JANET_API const JanetAbstractType janet_s64_type;
extern JANET_API const JanetAbstractType janet_u64_type;
typedef enum {
JANET_INT_NONE,
JANET_INT_S64,
@@ -1573,6 +1640,15 @@ JANET_API int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out);
#endif
#ifdef JANET_THREADS
extern JANET_API const JanetAbstractType janet_thread_type;
JANET_API int janet_thread_receive(Janet *msg_out, double timeout);
JANET_API int janet_thread_send(JanetThread *thread, Janet msg, double timeout);
#endif
/***** END SECTION MAIN *****/
#ifdef __cplusplus

View File

@@ -620,8 +620,12 @@ static int line() {
clearlines();
return -1;
case 4: /* ctrl-d, eof */
clearlines();
return -1;
if (gbl_len == 0) { /* quit on empty line */
clearlines();
return -1;
}
kdelete(1);
break;
case 5: /* ctrl-e */
gbl_pos = gbl_len;
refresh();
@@ -761,6 +765,9 @@ static int line() {
case '.': /* Alt-. */
historymove(-JANET_HISTORY_MAX);
break;
case 127: /* Alt-backspace */
kbackspacew();
break;
}
}
break;

View File

@@ -212,13 +212,17 @@
(assert (= 7 (case :a :b 5 :c 6 :u 10 7)) "case with default")
# Testing the loop and for macros
# Testing the loop and seq macros
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((0 0) (1 2) (2 4) (3 6) (4 8))) "seq macro 1")
(def xs (apply tuple (seq [x :down [8 -2] :when (even? x)] (tuple (/ x 2) x))))
(assert (= xs '((4 8) (3 6) (2 4) (1 2) (0 0))) "seq macro 2")
# :range-to and :down-to
(assert (deep= (seq [x :range-to [0 10]] x) (seq [x :range [0 11]] x)) "loop :range-to")
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x)) "loop :down-to")
# Some testing for not=
(assert (not= 1 1 0) "not= 1")
(assert (not= 0 1 1) "not= 2")
@@ -255,4 +259,26 @@
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
# Even and odd
(assert (odd? 9) "odd? 1")
(assert (odd? -9) "odd? 2")
(assert (not (odd? 10)) "odd? 3")
(assert (not (odd? 0)) "odd? 4")
(assert (not (odd? -10)) "odd? 5")
(assert (not (odd? 1.1)) "odd? 6")
(assert (not (odd? -0.1)) "odd? 7")
(assert (not (odd? -1.1)) "odd? 8")
(assert (not (odd? -1.6)) "odd? 9")
(assert (even? 10) "even? 1")
(assert (even? -10) "even? 2")
(assert (even? 0) "even? 3")
(assert (not (even? 9)) "even? 4")
(assert (not (even? -9)) "even? 5")
(assert (not (even? 0.1)) "even? 6")
(assert (not (even? -0.1)) "even? 7")
(assert (not (even? -10.1)) "even? 8")
(assert (not (even? -10.6)) "even? 9")
(end-suite)

View File

@@ -226,6 +226,23 @@
:week-day 3}
(os/date 1388608200)) "os/date")
# OS mktime test
(assert (= 1388608200 (os/mktime {:year-day 0
:minutes 30
:month 0
:dst false
:seconds 0
:year 2014
:month-day 0
:hours 20
:week-day 3})) "os/mktime")
(def now (os/time))
(assert (= (os/mktime (os/date now)) now) "UTC os/mktime")
(assert (= (os/mktime (os/date now true) true) now) "local os/mktime")
(assert (= (os/mktime {:year 1970}) 0) "os/mktime default values")
# Appending buffer to self
(with-dyns [:out @""]

197
test/suite8.janet Normal file
View File

@@ -0,0 +1,197 @@
# Copyright (c) 2020 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
# deal in the Software without restriction, including without limitation the
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
# sell copies of the Software, and to permit persons to whom the Software is
# furnished to do so, subject to the following conditions:
#
# The above copyright notice and this permission notice shall be included in
# all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
# IN THE SOFTWARE.
(import ./helper :prefix "" :exit true)
(start-suite 8)
###
### Compiling brainfuck to Janet.
###
(def- bf-peg
"Peg for compiling brainfuck into a Janet source ast."
(peg/compile
~{:+ (/ '(some "+") ,(fn [x] ~(+= (DATA POS) ,(length x))))
:- (/ '(some "-") ,(fn [x] ~(-= (DATA POS) ,(length x))))
:> (/ '(some ">") ,(fn [x] ~(+= POS ,(length x))))
:< (/ '(some "<") ,(fn [x] ~(-= POS ,(length x))))
:. (* "." (constant (prinf "%c" (get DATA POS))))
:loop (/ (* "[" :main "]") ,(fn [& captures]
~(while (not= (get DATA POS) 0)
,;captures)))
:main (any (+ :s :loop :+ :- :> :< :.)) }))
(defn bf
"Run brainfuck."
[text]
(eval
~(let [DATA (array/new-filled 100 0)]
(var POS 50)
,;(peg/match bf-peg text))))
(defn test-bf
"Test some bf for expected output."
[input output]
(def b @"")
(with-dyns [:out b]
(bf input))
(assert (= (string output) (string b))
(string "bf input '"
input
"' failed, expected "
(describe output)
", got "
(describe (string b))
".")))
(test-bf "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." "Hello World!\n")
(test-bf ">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->
+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+."
"Hello World!\n")
(test-bf "+[+[<<<+>>>>]+<-<-<<<+<++]<<.<++.<++..+++.<<++.<---.>>.>.+++.------.>-.>>--."
"Hello, World!")
# Prompts and Labels
(assert (= 10 (label a (for i 0 10 (if (= i 5) (return a 10))))) "label 1")
(defn recur
[lab x y]
(when (= x y) (return lab :done))
(def res (label newlab (recur (or lab newlab) (+ x 1) y)))
(if lab :oops res))
(assert (= :done (recur nil 0 10)) "label 2")
(assert (= 10 (prompt :a (for i 0 10 (if (= i 5) (return :a 10))))) "prompt 1")
(defn- inner-loop
[i]
(if (= i 5)
(return :a 10)))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop i)))) "prompt 2")
(defn- inner-loop2
[i]
(try
(if (= i 5)
(error 10))
([err] (return :a err))))
(assert (= 10 (prompt :a (for i 0 10 (inner-loop2 i)))) "prompt 3")
# Match checks
(assert (= :hi (match nil nil :hi)) "match 1")
(assert (= :hi (match {:a :hi} {:a a} a)) "match 2")
(assert (= nil (match {:a :hi} {:a a :b b} a)) "match 3")
(assert (= nil (match [1 2] [a b c] a)) "match 4")
(assert (= 2 (match [1 2] [a b] b)) "match 5")
# And/or checks
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# #300 Regression test
# Just don't segfault
(assert (peg/match '{:main (replace "S" {"S" :spade})} "S7") "regression #300")
# Test cases for #293
(assert (= :yes (match [1 2 3] [_ a _] :yes :no)) "match wildcard 1")
(assert (= :no (match [1 2 3] [__ a __] :yes :no)) "match wildcard 2")
(assert (= :yes (match [1 2 [1 2 3]] [_ a [_ _ _]] :yes :no)) "match wildcard 3")
(assert (= :yes (match [1 2 3] (_ (even? 2)) :yes :no)) "match wildcard 4")
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
# Regression #301
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
# chr
(assert (= (chr "a") 97) "chr 1")
# Detaching closure over non resumable fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ [f1 f2]] (protect (f1 @[0])))
# At time of writing, mark phase can detach closure envs.
(gccollect)
(assert (= 1 (f1)) "detach-non-resumable-closure 1")
(assert (= 2 (f2)) "detach-non-resumable-closure 2"))
# Marshal closure over non resumable fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ tup] (protect (f1 @[0])))
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
# Marshal closure over currently alive fiber.
(do
(defn f1
[a]
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(marshal [f1 f2] make-image-dict))
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
(assert (= 1 (f1)) "marshal-live-closure 1")
(assert (= 2 (f2)) "marshal-live-closure 2"))
(do
(var a 1)
(defn b [x] (+ a x))
(def c (unmarshal (marshal b)))
(assert (= 2 (c 1)) "marshal-on-stack-closure 1"))
# Reduce2
(assert (= (reduce + 0 (range 1 10)) (reduce2 + (range 10))) "reduce2 1")
(assert (= (reduce * 1 (range 2 10)) (reduce2 * (range 1 10))) "reduce2 2")
(assert (= nil (reduce2 * [])) "reduce2 3")
# Accumulate
(assert (deep= (accumulate + 0 (range 5)) @[0 1 3 6 10]) "accumulate 1")
(assert (deep= (accumulate2 + (range 5)) @[0 1 3 6 10]) "accumulate2 1")
(assert (deep= @[] (accumulate2 + [])) "accumulate2 2")
(assert (deep= @[] (accumulate 0 + [])) "accumulate 2")
(end-suite)