mirror of
https://github.com/janet-lang/janet
synced 2026-04-07 15:31:27 +00:00
Compare commits
274 Commits
keyword-oo
...
pointer
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
41bb6a9833 | ||
|
|
95e54c66b6 | ||
|
|
31e2415bbb | ||
|
|
2a5234b390 | ||
|
|
ad5b0a371e | ||
|
|
ba4dd9b5bb | ||
|
|
d42bdf2443 | ||
|
|
a246877c1e | ||
|
|
98e68a5cb4 | ||
|
|
e12aace02c | ||
|
|
51a9c7104d | ||
|
|
75dc08ff21 | ||
|
|
6fa60820a3 | ||
|
|
609a9621af | ||
|
|
8ba1121161 | ||
|
|
9a080197e7 | ||
|
|
e65375277a | ||
|
|
4a111b38b1 | ||
|
|
a363dce943 | ||
|
|
687a3c91f5 | ||
|
|
951aa0d8cd | ||
|
|
a61b59be87 | ||
|
|
91f3c17a5b | ||
|
|
0382dc976b | ||
|
|
69dcab2b55 | ||
|
|
c4f6f1d256 | ||
|
|
b57e530553 | ||
|
|
021b71ad62 | ||
|
|
0ee2ff1b05 | ||
|
|
adaa014d7c | ||
|
|
dc9dc98e80 | ||
|
|
4a2d4f52b5 | ||
|
|
8d37e544ab | ||
|
|
b07adce2b9 | ||
|
|
624be87c97 | ||
|
|
1b9591b5e3 | ||
|
|
a4cc23971f | ||
|
|
9ed1c35d30 | ||
|
|
6158ec0ce5 | ||
|
|
009bed158b | ||
|
|
402dc2a767 | ||
|
|
b5eb888af6 | ||
|
|
172261b89f | ||
|
|
8cc2c964c1 | ||
|
|
efbb704247 | ||
|
|
7fef5be3af | ||
|
|
1753f8bc18 | ||
|
|
235019ec39 | ||
|
|
7d17159ae4 | ||
|
|
56d7d4ef39 | ||
|
|
77c379faa8 | ||
|
|
3014a59c3e | ||
|
|
d70049dbb1 | ||
|
|
4713219317 | ||
|
|
36f92db61e | ||
|
|
59393fc73b | ||
|
|
3eb44f1f79 | ||
|
|
fb5119bf43 | ||
|
|
febfefa4b2 | ||
|
|
632b920e97 | ||
|
|
c81bf42f6b | ||
|
|
4147c0ce1f | ||
|
|
602e30a421 | ||
|
|
92a5567b4a | ||
|
|
9495be328c | ||
|
|
0eae75a5c2 | ||
|
|
8e0d7f2539 | ||
|
|
9c1c7fb384 | ||
|
|
af48912f11 | ||
|
|
327d2ed849 | ||
|
|
db64a682be | ||
|
|
4d3c655058 | ||
|
|
2becebce92 | ||
|
|
0cc6c6ff33 | ||
|
|
115bc6140b | ||
|
|
b14fcb068b | ||
|
|
2ea28f29b0 | ||
|
|
7cb1c7cef2 | ||
|
|
9d60e8b343 | ||
|
|
340a6c4d8d | ||
|
|
e5a4c6fc2b | ||
|
|
db9ac6dba5 | ||
|
|
d570aae817 | ||
|
|
59e4b15fad | ||
|
|
b3401381fa | ||
|
|
beed839d12 | ||
|
|
f4908ebc41 | ||
|
|
1147482e62 | ||
|
|
4d07176f1c | ||
|
|
8c67bf82f6 | ||
|
|
0823eb7327 | ||
|
|
8cff3dd2c3 | ||
|
|
df550efb6b | ||
|
|
00a47dc0cb | ||
|
|
811b1825cb | ||
|
|
2ca252bc0e | ||
|
|
6054858359 | ||
|
|
1d50fd9485 | ||
|
|
a982f351d7 | ||
|
|
27a274b686 | ||
|
|
cb002e7b84 | ||
|
|
c022a1cf1a | ||
|
|
9d4effc02e | ||
|
|
7c19ed8a48 | ||
|
|
ef5f80ad38 | ||
|
|
dbcbb4466d | ||
|
|
7927078b49 | ||
|
|
b61c9eb991 | ||
|
|
ed72dcf82d | ||
|
|
9480ad24cc | ||
|
|
a9574b692f | ||
|
|
8d9a88e759 | ||
|
|
732de8f88d | ||
|
|
6af5800d21 | ||
|
|
540b326c54 | ||
|
|
660a2b41ae | ||
|
|
d2d502b9ae | ||
|
|
3aae524964 | ||
|
|
07912f5ab2 | ||
|
|
ffc14f6019 | ||
|
|
1e70c97ef0 | ||
|
|
54227ebff1 | ||
|
|
33087fe9de | ||
|
|
6d5ff43de7 | ||
|
|
c715912ea3 | ||
|
|
3b6ff3c09a | ||
|
|
efab484fff | ||
|
|
4ba7fbb8bb | ||
|
|
53cc7ebd29 | ||
|
|
c6f032340a | ||
|
|
0ce5acec89 | ||
|
|
44e31cac5d | ||
|
|
029394db31 | ||
|
|
00020ba8ab | ||
|
|
1f91ee30fe | ||
|
|
0f0c415bcf | ||
|
|
a6f022a73d | ||
|
|
ec02d55145 | ||
|
|
cb1a773ca8 | ||
|
|
0dc1217d69 | ||
|
|
06f38d3380 | ||
|
|
2e1ec3700d | ||
|
|
9e6b1d1b16 | ||
|
|
bdf03b4706 | ||
|
|
4d96ba3ba9 | ||
|
|
f161002390 | ||
|
|
eb576d6caf | ||
|
|
e0d26629e0 | ||
|
|
17783c3c3e | ||
|
|
c64e92a5de | ||
|
|
291c13bafc | ||
|
|
c6672e62ac | ||
|
|
eb9bd38256 | ||
|
|
3ac6b2335a | ||
|
|
c6edf03ae8 | ||
|
|
5020a1bae9 | ||
|
|
86ba69c16b | ||
|
|
5f70024f87 | ||
|
|
9ff819a4a1 | ||
|
|
1244e2e93b | ||
|
|
b61d1a0a0e | ||
|
|
89ef4eb634 | ||
|
|
114a45306d | ||
|
|
fe27df528c | ||
|
|
8ab60e475a | ||
|
|
6321c30cb1 | ||
|
|
8343c9edd1 | ||
|
|
74e1a3273f | ||
|
|
1394dbbd57 | ||
|
|
f6a3853131 | ||
|
|
49465f71f3 | ||
|
|
960cf76eb5 | ||
|
|
1b735564fa | ||
|
|
7ae01d25dd | ||
|
|
cb5263d2d8 | ||
|
|
602092f6d5 | ||
|
|
d3a067a665 | ||
|
|
98a26f5ce3 | ||
|
|
09d9dca5f5 | ||
|
|
8a3f512746 | ||
|
|
19e59705b9 | ||
|
|
367c9da856 | ||
|
|
4bcf6565cd | ||
|
|
0c950d0846 | ||
|
|
7ba925c50a | ||
|
|
cb3b9dd76f | ||
|
|
f4fa55027b | ||
|
|
0fe11adb9c | ||
|
|
b138ee6e8e | ||
|
|
a66f19f636 | ||
|
|
c76f4e89d8 | ||
|
|
85a211b26b | ||
|
|
fe3620529f | ||
|
|
a7551e9b4e | ||
|
|
46c540b93e | ||
|
|
32c209ede9 | ||
|
|
0d293cd3f5 | ||
|
|
f284776490 | ||
|
|
38a7e4faf1 | ||
|
|
c333cbfa55 | ||
|
|
f72aa64f41 | ||
|
|
d85892edc8 | ||
|
|
56383b2ecc | ||
|
|
0d729eaab1 | ||
|
|
17ab654ccb | ||
|
|
872d03ae1d | ||
|
|
ee5fa54134 | ||
|
|
68e00cdb7a | ||
|
|
5bf9e4fc89 | ||
|
|
7350bf5dd9 | ||
|
|
e755f98300 | ||
|
|
8ee2f0a1d6 | ||
|
|
0726de34ff | ||
|
|
00301ad26b | ||
|
|
611543c48b | ||
|
|
4d81fbc238 | ||
|
|
c5012ca4c1 | ||
|
|
e68a889fa9 | ||
|
|
795e7a9de8 | ||
|
|
090a6a8c5c | ||
|
|
2bbf9fdcc5 | ||
|
|
0025f6ac87 | ||
|
|
737b2449f0 | ||
|
|
f7a0133eb1 | ||
|
|
48b179d67e | ||
|
|
d1a075b2a6 | ||
|
|
2bad24371d | ||
|
|
bf8d5da3dc | ||
|
|
4a6fcb5e23 | ||
|
|
5ba969f91d | ||
|
|
26818a5e5c | ||
|
|
b84b0e4828 | ||
|
|
b4934ceddc | ||
|
|
c4114fbcdb | ||
|
|
95f2bbe0a0 | ||
|
|
63137b8107 | ||
|
|
2c1b506213 | ||
|
|
612a245961 | ||
|
|
4b8edef58c | ||
|
|
82cddef5bb | ||
|
|
d0fc29338c | ||
|
|
4eeadd7463 | ||
|
|
f0fcdf6bc5 | ||
|
|
2a333f8359 | ||
|
|
0dd867d508 | ||
|
|
e3f902cb8a | ||
|
|
c651b6f67c | ||
|
|
3a9b50ea4a | ||
|
|
1304f9263b | ||
|
|
90313afd40 | ||
|
|
99f176f37b | ||
|
|
d0ec89c7c1 | ||
|
|
170e785b72 | ||
|
|
e53778d5d8 | ||
|
|
192705113e | ||
|
|
97a42ea17b | ||
|
|
2cd489b9d4 | ||
|
|
ff0d3a0081 | ||
|
|
282c02c475 | ||
|
|
798c88b4c8 | ||
|
|
83f4a11bf3 | ||
|
|
d7626f8c57 | ||
|
|
1efca2ebe7 | ||
|
|
40845b5c1b | ||
|
|
84fb07dd5a | ||
|
|
62cb3f81fe | ||
|
|
16ebb11181 | ||
|
|
115ed9cbb9 | ||
|
|
3ae6f64de5 | ||
|
|
ff3f7487a4 | ||
|
|
f0afb3c311 | ||
|
|
5b1a3b8208 | ||
|
|
b1e0849a2f | ||
|
|
67f26b7d72 |
@@ -1,11 +1,13 @@
|
|||||||
image: freebsd
|
image: freebsd/latest
|
||||||
packages:
|
packages:
|
||||||
- gmake
|
- gmake
|
||||||
- gcc
|
- gcc
|
||||||
sources:
|
sources:
|
||||||
- https://github.com/bakpakin/janet.git
|
- https://github.com/janet-lang/janet.git
|
||||||
tasks:
|
tasks:
|
||||||
- build: |
|
- build: |
|
||||||
cd janet
|
cd janet
|
||||||
gmake CC=gcc
|
gmake CC=gcc
|
||||||
gmake test CC=gcc
|
gmake test CC=gcc
|
||||||
|
sudo gmake install CC=gcc
|
||||||
|
gmake test-install CC=gcc
|
||||||
|
|||||||
2
.gitattributes
vendored
Normal file
2
.gitattributes
vendored
Normal file
@@ -0,0 +1,2 @@
|
|||||||
|
# Use an approximate language for syntax highlighting (clojure is pretty close)
|
||||||
|
*.janet linguist-language=clojure
|
||||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -12,6 +12,9 @@ janet
|
|||||||
janet-*.tar.gz
|
janet-*.tar.gz
|
||||||
dist
|
dist
|
||||||
|
|
||||||
|
# Local directory for testing
|
||||||
|
local
|
||||||
|
|
||||||
# Emscripten
|
# Emscripten
|
||||||
*.bc
|
*.bc
|
||||||
janet.js
|
janet.js
|
||||||
|
|||||||
@@ -2,6 +2,8 @@ language: c
|
|||||||
script:
|
script:
|
||||||
- make
|
- make
|
||||||
- make test
|
- make test
|
||||||
|
- sudo make install
|
||||||
|
- make test-install
|
||||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||||
compiler:
|
compiler:
|
||||||
- clang
|
- clang
|
||||||
@@ -19,5 +21,5 @@ deploy:
|
|||||||
skip_cleanup: true
|
skip_cleanup: true
|
||||||
on:
|
on:
|
||||||
tags: true
|
tags: true
|
||||||
repo: bakpakin/janet
|
repo: janet-lang/janet
|
||||||
condition: "$CC = clang"
|
condition: "$CC = clang"
|
||||||
|
|||||||
43
CHANGELOG.md
Normal file
43
CHANGELOG.md
Normal file
@@ -0,0 +1,43 @@
|
|||||||
|
# Changelog
|
||||||
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
|
## 0.4.1 latest - ??
|
||||||
|
- Add array/remove function
|
||||||
|
|
||||||
|
## 0.4.0 - 2019-03-08
|
||||||
|
- Fix a number of smaller bugs
|
||||||
|
- Added :export option to import and require
|
||||||
|
- Added typed arrays
|
||||||
|
- Remove `callable?`.
|
||||||
|
- Remove `tuple/append` and `tuple/prepend`, which may have seemed like `O(1)`
|
||||||
|
operations. Instead, use the `splice` special to extend tuples.
|
||||||
|
- Add `-m` flag to main client to allow specifying where to load
|
||||||
|
system modules from.
|
||||||
|
- Add `-c` flag to main client to allow compiling Janet modules to images.
|
||||||
|
- Add `string/format` and `buffer/format`.
|
||||||
|
- Remove `string/pretty` and `string/number`.
|
||||||
|
- `make-image` function creates pre compiled images for janet. These images
|
||||||
|
link to the core library. They can be loaded via require or manually via
|
||||||
|
`load-image`.
|
||||||
|
- Add bracketed tuples as tuple constructor.
|
||||||
|
- Add partition function to core library.
|
||||||
|
- Pre-compile core library into an image for faster startup.
|
||||||
|
- Add methods to parser values that mirror the api.
|
||||||
|
- Add janet\_getmethod to CAPI for easier use of method like syntax.
|
||||||
|
- Add get/set to abstract types to allow them to behave more
|
||||||
|
like objects with methods.
|
||||||
|
- Add parser/insert to modify parser state programmatically
|
||||||
|
- Add debug/stacktrace for easy, pretty stacktraces
|
||||||
|
- Remove the status-pp function
|
||||||
|
- Update API to run-context to be much more sane
|
||||||
|
- Add :lflags option to cook/make-native
|
||||||
|
- Disallow NaNs as table or struct keys
|
||||||
|
- Update module resolution paths and format
|
||||||
|
|
||||||
|
## 0.3.0 - 2019-26-01
|
||||||
|
- Add amalgamated build to janet for easier embedding.
|
||||||
|
- Add os/date function
|
||||||
|
- Add slurp and spit to core library.
|
||||||
|
- Added this changelog.
|
||||||
|
- Added peg module (Parsing Expression Grammars)
|
||||||
|
- Move hand written documentation into website repository.
|
||||||
@@ -29,7 +29,12 @@ may require changes before being merged.
|
|||||||
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
run tests with `make test`. If you want to add a new test suite, simply add a file to
|
||||||
the test folder and make sure it is run when`make test` is invoked.
|
the test folder and make sure it is run when`make test` is invoked.
|
||||||
* Be consistent with the style. For C this means follow the indentation and style in
|
* Be consistent with the style. For C this means follow the indentation and style in
|
||||||
other files (files have MIT license at top, 4 spaces indentation, no trailing whitespace, cuddled brackets, etc.)
|
other files (files have MIT license at top, 4 spaces indentation, no trailing
|
||||||
|
whitespace, cuddled brackets, etc.) Use `make format` to
|
||||||
|
automatically format your C code with
|
||||||
|
[astyle](http://astyle.sourceforge.net/astyle.html). You will probably need
|
||||||
|
to install this, but it can be installed with most package managers.
|
||||||
|
|
||||||
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
For janet code, the use lisp indentation with 2 spaces. One can use janet.vim to
|
||||||
do this indentation, or approximate as close as possible.
|
do this indentation, or approximate as close as possible.
|
||||||
|
|
||||||
@@ -39,7 +44,6 @@ For changes to the VM and Core code, you will probably need to know C. Janet is
|
|||||||
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||||
omissions.
|
omissions.
|
||||||
|
|
||||||
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
|
|
||||||
* No `restrict`
|
* No `restrict`
|
||||||
* Certain functions in the standard library are not always available
|
* Certain functions in the standard library are not always available
|
||||||
|
|
||||||
@@ -51,6 +55,11 @@ Code should compile warning free and run valgrind clean. I find that these two c
|
|||||||
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
of the easiest ways to protect against a large number of bugs in an unsafe language like C. To check for
|
||||||
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
valgrind errors, run `make valtest` and check the output for undefined or flagged behavior.
|
||||||
|
|
||||||
|
### Formatting
|
||||||
|
|
||||||
|
Use [astyle](http://astyle.sourceforge.net/astyle.html) via `make format` to
|
||||||
|
ensure a consistent code style for C.
|
||||||
|
|
||||||
## Janet style
|
## Janet style
|
||||||
|
|
||||||
All janet code in the project should be formatted similar to the code in core.janet.
|
All janet code in the project should be formatted similar to the code in core.janet.
|
||||||
|
|||||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
|||||||
Copyright (c) 2019 Calvin Rose
|
Copyright (c) 2019 Calvin Rose and contributors
|
||||||
|
|
||||||
Permission is hereby granted, free of charge, to any person obtaining a copy of
|
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
|
this software and associated documentation files (the "Software"), to deal in
|
||||||
|
|||||||
132
Makefile
132
Makefile
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2018 Calvin Rose
|
# Copyright (c) 2019 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
@@ -24,33 +24,33 @@
|
|||||||
|
|
||||||
PREFIX?=/usr/local
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
INCLUDEDIR=$(PREFIX)/include/janet
|
INCLUDEDIR=$(PREFIX)/include
|
||||||
LIBDIR=$(PREFIX)/lib
|
|
||||||
BINDIR=$(PREFIX)/bin
|
BINDIR=$(PREFIX)/bin
|
||||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||||
|
CLIBS=-lm
|
||||||
|
JANET_TARGET=build/janet
|
||||||
|
JANET_LIBRARY=build/libjanet.so
|
||||||
|
JANET_PATH?=$(PREFIX)/lib/janet
|
||||||
|
MANPATH?=$(PREFIX)/share/man/man1/
|
||||||
|
DEBUGGER=gdb
|
||||||
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||||
-DJANET_BUILD=$(JANET_BUILD)
|
-DJANET_BUILD=$(JANET_BUILD)
|
||||||
CLIBS=-lm -ldl
|
LDFLAGS=-rdynamic
|
||||||
JANET_TARGET=build/janet
|
|
||||||
JANET_LIBRARY=build/libjanet.so
|
|
||||||
JANET_PATH?=/usr/local/lib/janet
|
|
||||||
DEBUGGER=gdb
|
|
||||||
|
|
||||||
|
# Check OS
|
||||||
UNAME:=$(shell uname -s)
|
UNAME:=$(shell uname -s)
|
||||||
LDCONFIG:=ldconfig
|
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
# Add other macos/clang flags
|
CLIBS:=$(CLIBS) -ldl
|
||||||
LDCONFIG:=
|
else ifeq ($(UNAME), Linux)
|
||||||
else
|
CLIBS:=$(CLIBS) -lrt -ldl
|
||||||
CFLAGS:=$(CFLAGS) -rdynamic
|
|
||||||
CLIBS:=$(CLIBS) -lrt
|
|
||||||
endif
|
endif
|
||||||
|
# For other unix likes, add flags here!
|
||||||
|
|
||||||
$(shell mkdir -p build/core build/mainclient build/webclient)
|
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||||
|
|
||||||
# Source headers
|
# Source headers
|
||||||
JANET_HEADERS=$(sort $(wildcard src/include/janet/*.h))
|
JANET_HEADERS=$(sort $(wildcard src/include/*.h))
|
||||||
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
|
JANET_LOCAL_HEADERS=$(sort $(wildcard src/*/*.h))
|
||||||
|
|
||||||
# Source files
|
# Source files
|
||||||
@@ -60,24 +60,44 @@ JANET_WEBCLIENT_SOURCES=$(sort $(wildcard src/webclient/*.c))
|
|||||||
|
|
||||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
||||||
|
|
||||||
|
##################################################################
|
||||||
|
##### The bootstrap interpreter that compiles the core image #####
|
||||||
|
##################################################################
|
||||||
|
|
||||||
|
JANET_BOOT_SOURCES=$(sort $(wildcard src/boot/*.c))
|
||||||
|
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES)) \
|
||||||
|
build/core.gen.o \
|
||||||
|
build/boot.gen.o
|
||||||
|
|
||||||
|
build/%.boot.o: src/%.c
|
||||||
|
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ -c $<
|
||||||
|
|
||||||
|
build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||||
|
$(CC) $(CFLAGS) -DJANET_BOOTSTRAP -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
|
# Now the reason we bootstrap in the first place
|
||||||
|
build/core_image.c: build/janet_boot
|
||||||
|
JANET_PATH=$(JANET_PATH) build/janet_boot
|
||||||
|
|
||||||
##########################################################
|
##########################################################
|
||||||
##### The main interpreter program and shared object #####
|
##### The main interpreter program and shared object #####
|
||||||
##########################################################
|
##########################################################
|
||||||
|
|
||||||
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core.gen.o
|
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES)) build/init.gen.o
|
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES)) build/init.gen.o
|
||||||
|
|
||||||
%.gen.o: %.gen.c
|
# Compile the core image generated by the bootstrap build
|
||||||
|
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
$(CC) $(CFLAGS) -o $@ -c $<
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
$(CC) $(CFLAGS) -o $@ -c $<
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
$(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||||
$(CC) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||||
|
|
||||||
######################
|
######################
|
||||||
##### Emscripten #####
|
##### Emscripten #####
|
||||||
@@ -92,11 +112,14 @@ EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
|||||||
JANET_EMTARGET=build/janet.js
|
JANET_EMTARGET=build/janet.js
|
||||||
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
|
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_SOURCES)
|
||||||
JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \
|
JANET_EMOBJECTS=$(patsubst src/%.c,build/%.bc,$(JANET_WEB_SOURCES)) \
|
||||||
build/webinit.gen.bc build/core.gen.bc
|
build/webinit.gen.bc build/core_image.bc
|
||||||
|
|
||||||
%.gen.bc: %.gen.c
|
%.gen.bc: %.gen.c
|
||||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
|
build/core_image.bc: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
build/%.bc: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
@@ -109,6 +132,9 @@ emscripten: $(JANET_EMTARGET)
|
|||||||
##### Generated C files #####
|
##### Generated C files #####
|
||||||
#############################
|
#############################
|
||||||
|
|
||||||
|
%.gen.o: %.gen.c
|
||||||
|
$(CC) $(CFLAGS) -o $@ -c $<
|
||||||
|
|
||||||
build/xxd: tools/xxd.c
|
build/xxd: tools/xxd.c
|
||||||
$(CC) $< -o $@
|
$(CC) $< -o $@
|
||||||
|
|
||||||
@@ -118,18 +144,27 @@ build/init.gen.c: src/mainclient/init.janet build/xxd
|
|||||||
build/xxd $< $@ janet_gen_init
|
build/xxd $< $@ janet_gen_init
|
||||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||||
build/xxd $< $@ janet_gen_webinit
|
build/xxd $< $@ janet_gen_webinit
|
||||||
|
build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||||
|
build/xxd $< $@ janet_gen_boot
|
||||||
|
|
||||||
|
########################
|
||||||
|
##### Amalgamation #####
|
||||||
|
########################
|
||||||
|
|
||||||
|
amalg: build/janet.c build/janet.h build/core_image.c
|
||||||
|
|
||||||
|
build/janet.c: $(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) tools/amalg.janet $(JANET_TARGET)
|
||||||
|
$(JANET_TARGET) tools/amalg.janet > $@
|
||||||
|
|
||||||
|
build/janet.h: src/include/janet.h
|
||||||
|
cp $< $@
|
||||||
|
|
||||||
###################
|
###################
|
||||||
##### Testing #####
|
##### Testing #####
|
||||||
###################
|
###################
|
||||||
|
|
||||||
TEST_SOURCES=$(wildcard ctest/*.c)
|
|
||||||
TEST_PROGRAMS=$(patsubst ctest/%.c,build/%.out,$(TEST_SOURCES))
|
|
||||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||||
|
|
||||||
build/%.out: ctest/%.c $(JANET_CORE_OBJECTS)
|
|
||||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
|
||||||
|
|
||||||
repl: $(JANET_TARGET)
|
repl: $(JANET_TARGET)
|
||||||
./$(JANET_TARGET)
|
./$(JANET_TARGET)
|
||||||
|
|
||||||
@@ -142,15 +177,13 @@ valgrind: $(JANET_TARGET)
|
|||||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||||
|
|
||||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in build/*.out; do "$$f" || exit; done
|
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
|
||||||
|
|
||||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||||
for f in build/*.out; do $(VALGRIND_COMMAND) "$$f" || exit; done
|
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
|
||||||
|
|
||||||
callgrind: $(JANET_TARGET)
|
callgrind: $(JANET_TARGET)
|
||||||
for f in test/*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||||
|
|
||||||
########################
|
########################
|
||||||
##### Distribution #####
|
##### Distribution #####
|
||||||
@@ -158,9 +191,9 @@ callgrind: $(JANET_TARGET)
|
|||||||
|
|
||||||
dist: build/janet-dist.tar.gz
|
dist: build/janet-dist.tar.gz
|
||||||
|
|
||||||
build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet/janet.h \
|
build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet.h \
|
||||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) \
|
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) \
|
||||||
build/doc.html README.md $(wildcard doc/*.md)
|
build/doc.html README.md build/janet.c
|
||||||
tar -czvf $@ $^
|
tar -czvf $@ $^
|
||||||
|
|
||||||
#########################
|
#########################
|
||||||
@@ -176,6 +209,17 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
|||||||
##### Other #####
|
##### Other #####
|
||||||
#################
|
#################
|
||||||
|
|
||||||
|
STYLEOPTS=--style=attach --indent-switches --convert-tabs \
|
||||||
|
--align-pointer=name --pad-header --pad-oper --unpad-paren --indent-labels
|
||||||
|
format:
|
||||||
|
astyle $(STYLEOPTS) */*.c
|
||||||
|
astyle $(STYLEOPTS) */*/*.c
|
||||||
|
astyle $(STYLEOPTS) */*/*.h
|
||||||
|
|
||||||
|
grammar: build/janet.tmLanguage
|
||||||
|
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||||
|
$(JANET_TARGET) $< > $@
|
||||||
|
|
||||||
clean:
|
clean:
|
||||||
-rm -rf build vgcore.* callgrind.*
|
-rm -rf build vgcore.* callgrind.*
|
||||||
|
|
||||||
@@ -184,20 +228,22 @@ install: $(JANET_TARGET)
|
|||||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||||
mkdir -p $(INCLUDEDIR)
|
mkdir -p $(INCLUDEDIR)
|
||||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
||||||
mkdir -p $(LIBDIR)
|
mkdir -p $(INCLUDEDIR)/janet
|
||||||
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so
|
|
||||||
mkdir -p $(JANET_PATH)
|
mkdir -p $(JANET_PATH)
|
||||||
|
ln -sf $(INCLUDEDIR)/janet.h $(INCLUDEDIR)/janet/janet.h
|
||||||
|
ln -sf $(INCLUDEDIR)/janet.h $(JANET_PATH)/janet.h
|
||||||
cp tools/cook.janet $(JANET_PATH)
|
cp tools/cook.janet $(JANET_PATH)
|
||||||
cp janet.1 /usr/local/share/man/man1/
|
cp tools/highlight.janet $(JANET_PATH)
|
||||||
mandb
|
cp tools/bars.janet $(JANET_PATH)
|
||||||
$(LDCONFIG)
|
mkdir -p $(MANPATH)
|
||||||
|
cp janet.1 $(MANPATH)
|
||||||
|
|
||||||
|
test-install:
|
||||||
|
cd test/install && rm -rf build && janet test
|
||||||
|
|
||||||
uninstall:
|
uninstall:
|
||||||
-rm $(BINDIR)/../$(JANET_TARGET)
|
-rm $(BINDIR)/../$(JANET_TARGET)
|
||||||
-rm $(LIBDIR)/../$(JANET_LIBRARY)
|
|
||||||
-rm -rf $(INCLUDEDIR)
|
-rm -rf $(INCLUDEDIR)
|
||||||
$(LDCONFIG)
|
|
||||||
|
|
||||||
.PHONY: clean install repl debug valgrind test \
|
.PHONY: clean install repl debug valgrind test amalg \
|
||||||
valtest emscripten dist uninstall docs \
|
valtest emscripten dist uninstall docs grammar format
|
||||||
$(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES)
|
|
||||||
|
|||||||
40
README.md
40
README.md
@@ -1,12 +1,15 @@
|
|||||||
|
[](https://gitter.im/janet-language/community)
|
||||||
|
|
||||||
|
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||||
[](https://travis-ci.org/janet-lang/janet)
|
[](https://travis-ci.org/janet-lang/janet)
|
||||||
[](https://ci.appveyor.com/project/janet-lang/janet)
|
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
<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
|
**Janet** is a functional and imperative programming language and bytecode interpreter. It is a
|
||||||
modern lisp, but lists are replaced
|
modern lisp, but lists are replaced
|
||||||
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
by other data structures with better utility and performance (arrays, tables, structs, tuples).
|
||||||
The language also bridging bridging to native code written in C, meta-programming with macros, and bytecode assembly.
|
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
|
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
|
to run script files. This client program is separate from the core runtime, so
|
||||||
@@ -20,8 +23,8 @@ The few features that are not standard C (dynamic library loading, compiler spec
|
|||||||
are fairly straight forward. Janet can be easily ported to new platforms.
|
are fairly straight forward. Janet can be easily ported to new platforms.
|
||||||
|
|
||||||
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/janet-lang/janet.vim).
|
For syntax highlighting, there is some preliminary vim syntax highlighting in [janet.vim](https://github.com/janet-lang/janet.vim).
|
||||||
Generic lisp syntax highlighting should, however, provide good results. There is also a janet.tmLanguage file
|
Generic lisp syntax highlighting should, however, provide good results. One can also generate a janet.tmLanguage
|
||||||
that should provide good syntax highlighting for many editors.
|
file for other programs with `make grammar`.
|
||||||
|
|
||||||
## Use Cases
|
## Use Cases
|
||||||
|
|
||||||
@@ -46,7 +49,9 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
|||||||
* Lexical scoping
|
* Lexical scoping
|
||||||
* Imperative programming as well as functional
|
* Imperative programming as well as functional
|
||||||
* REPL
|
* REPL
|
||||||
|
* Parsing Expression Grammars built in to the core library
|
||||||
* 300+ functions and macros in the core library
|
* 300+ functions and macros in the core library
|
||||||
|
* Embedding Janet in other programs
|
||||||
* Interactive environment with detailed stack traces
|
* Interactive environment with detailed stack traces
|
||||||
|
|
||||||
## Documentation
|
## Documentation
|
||||||
@@ -74,7 +79,8 @@ environment, use the `(all-symbols)` function.
|
|||||||
|
|
||||||
Install a stable version of janet from the [releases page](https://github.com/janet-lang/janet/releases).
|
Install a stable version of janet from the [releases page](https://github.com/janet-lang/janet/releases).
|
||||||
Janet is prebuilt for a few systems, but if you want to develop janet, run janet on a non-x86 system, or
|
Janet is prebuilt for a few systems, but if you want to develop janet, run janet on a non-x86 system, or
|
||||||
get the latest, you must build janet from source.
|
get the latest, you must build janet from source. Janet is in alpha and may change
|
||||||
|
in backwards incompatible ways.
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
@@ -82,7 +88,7 @@ A repl is launched when the binary is invoked with no arguments. Pass the -h fla
|
|||||||
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
to display the usage information. Individual scripts can be run with `./janet myscript.janet`
|
||||||
|
|
||||||
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
If you are looking to explore, you can print a list of all available macros, functions, and constants
|
||||||
by entering the command `(all-symbols)` into the repl.
|
by entering the command `(all-bindings)` into the repl.
|
||||||
|
|
||||||
```
|
```
|
||||||
$ ./janet
|
$ ./janet
|
||||||
@@ -92,7 +98,7 @@ janet:1:> (+ 1 2 3)
|
|||||||
janet:2:> (print "Hello, World!")
|
janet:2:> (print "Hello, World!")
|
||||||
Hello, World!
|
Hello, World!
|
||||||
nil
|
nil
|
||||||
janet:3:> (os.exit)
|
janet:3:> (os/exit)
|
||||||
$ ./janet -h
|
$ ./janet -h
|
||||||
usage: ./janet [options] scripts...
|
usage: ./janet [options] scripts...
|
||||||
Options are:
|
Options are:
|
||||||
@@ -106,13 +112,25 @@ Options are:
|
|||||||
$
|
$
|
||||||
```
|
```
|
||||||
|
|
||||||
|
## 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 that contains all the source
|
||||||
|
to Janet. This file, along with `src/include/janet/janet.h` can dragged into any C project
|
||||||
|
and compiled into the project. Janet should be compiled with `-std=c99` on most compilers, and
|
||||||
|
will need to be linked to the math library, `-lm`, and 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.
|
||||||
|
|
||||||
## Compiling and Running
|
## Compiling and Running
|
||||||
|
|
||||||
Janet only uses Make and batch files to compile on Posix and windows
|
Janet only uses Make and batch files to compile on Posix and windows
|
||||||
respectively. To configure janet, edit the header file src/include/janet/janet.h
|
respectively. To configure janet, edit the header file src/include/janet/janet.h
|
||||||
before compilation.
|
before compilation.
|
||||||
|
|
||||||
### Unix-like
|
### macos and Unix-like
|
||||||
|
|
||||||
On most platforms, use Make to build janet. The resulting binary will be in `build/janet`.
|
On most platforms, use Make to build janet. The resulting binary will be in `build/janet`.
|
||||||
|
|
||||||
@@ -160,8 +178,14 @@ Building with emscripten on windows is currently unsupported.
|
|||||||
|
|
||||||
See the examples directory for some example janet code.
|
See the examples directory for some example janet code.
|
||||||
|
|
||||||
|
## Discussion
|
||||||
|
|
||||||
|
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||||
|
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||||
|
|
||||||
## Why Janet
|
## Why Janet
|
||||||
|
|
||||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||||
|
|
||||||
|
|||||||
@@ -45,4 +45,4 @@ deploy:
|
|||||||
artifact: janet-windows
|
artifact: janet-windows
|
||||||
draft: true
|
draft: true
|
||||||
on:
|
on:
|
||||||
APPVEYOR_REPO_TAG: true
|
APPVEYOR_REPO_TAG: true
|
||||||
|
|||||||
@@ -22,6 +22,7 @@
|
|||||||
mkdir build
|
mkdir build
|
||||||
mkdir build\core
|
mkdir build\core
|
||||||
mkdir build\mainclient
|
mkdir build\mainclient
|
||||||
|
mkdir build\boot
|
||||||
|
|
||||||
@rem Build the xxd tool for generating sources
|
@rem Build the xxd tool for generating sources
|
||||||
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||||
@@ -30,15 +31,38 @@ mkdir build\mainclient
|
|||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Generate the embedded sources
|
@rem Generate the embedded sources
|
||||||
@build\xxd.exe src\core\core.janet build\core\core.gen.c janet_gen_core
|
@build\xxd.exe src\core\core.janet build\core.gen.c janet_gen_core
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@build\xxd.exe src\mainclient\init.janet build\mainclient\init.gen.c janet_gen_init
|
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the generated sources
|
@rem Build the generated sources
|
||||||
@%JANET_COMPILE% /Fobuild\core\core.gen.obj build\core\core.gen.c
|
@%JANET_COMPILE% /Fobuild\boot\core.gen.obj build\core.gen.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\mainclient\init.gen.c
|
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
|
@rem Build the bootstrap interpretter
|
||||||
|
for %%f in (src\core\*.c) do (
|
||||||
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
)
|
||||||
|
for %%f in (src\boot\*.c) do (
|
||||||
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
)
|
||||||
|
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||||
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
set JANET_PATH="C:/Janet/Library"
|
||||||
|
set JANET_INCLUDEDIR="C:/Janet/Include"
|
||||||
|
build\janet_boot
|
||||||
|
|
||||||
|
@rem Build the core image
|
||||||
|
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the sources
|
@rem Build the sources
|
||||||
@@ -54,7 +78,7 @@ for %%f in (src\mainclient\*.c) do (
|
|||||||
)
|
)
|
||||||
|
|
||||||
@rem Link everything to main client
|
@rem Link everything to main client
|
||||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj
|
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
echo === Successfully built janet.exe for Windows ===
|
echo === Successfully built janet.exe for Windows ===
|
||||||
@@ -94,12 +118,15 @@ exit /b 0
|
|||||||
:DIST
|
:DIST
|
||||||
mkdir dist
|
mkdir dist
|
||||||
janet.exe tools\gendoc.janet > dist\doc.html
|
janet.exe tools\gendoc.janet > dist\doc.html
|
||||||
|
janet.exe tools\amalg.janet > dist\janet.c
|
||||||
copy janet.exe dist\janet.exe
|
copy janet.exe dist\janet.exe
|
||||||
copy LICENSE dist\LICENSE
|
copy LICENSE dist\LICENSE
|
||||||
copy README.md dist\README.md
|
copy README.md dist\README.md
|
||||||
copy janet.lib dist\janet.lib
|
copy janet.lib dist\janet.lib
|
||||||
copy janet.exp dist\janet.exp
|
copy janet.exp dist\janet.exp
|
||||||
copy src\include\janet\janet.h dist\janet.h
|
copy src\include\janet.h dist\janet.h
|
||||||
|
copy tools\cook.janet dist\cook.janet
|
||||||
|
copy tools\highlight.janet dist\highlight.janet
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
:TESTFAIL
|
:TESTFAIL
|
||||||
|
|||||||
@@ -1,6 +0,0 @@
|
|||||||
Janet is a dynamic, lightweight programming language with strong functional
|
|
||||||
capabilities as well as support for imperative programming. It to be used
|
|
||||||
for short lived scripts as well as for building real programs. It can also
|
|
||||||
be extended with native code (C modules) for better performance and interfacing with
|
|
||||||
existing software. Janet takes ideas from Lua, Scheme, Racket, Clojure, Smalltalk, Erlang, Arc, and
|
|
||||||
a whole bunch of other dynamic languages.
|
|
||||||
@@ -1,739 +0,0 @@
|
|||||||
# Hello, world!
|
|
||||||
|
|
||||||
Following tradition, a simple Janet program will print "Hello, world!".
|
|
||||||
|
|
||||||
```
|
|
||||||
(print "Hello, world!")
|
|
||||||
```
|
|
||||||
|
|
||||||
Put the following code in a file named `hello.janet`, and run `./janet hello.janet`.
|
|
||||||
The words "Hello, world!" should be printed to the console, and then the program
|
|
||||||
should immediately exit. You now have a working janet program!
|
|
||||||
|
|
||||||
Alternatively, run the program `./janet` without any arguments to enter a REPL,
|
|
||||||
or read eval print loop. This is a mode where Janet functions like a calculator,
|
|
||||||
reading some input from the user, evaluating it, and printing out the result, all
|
|
||||||
in an infinite loop. This is a useful mode for exploring or prototyping in Janet.
|
|
||||||
|
|
||||||
This hello world program is about the simplest program one can write, and consists of only
|
|
||||||
a few pieces of syntax. This first element is the `print` symbol. This is a function
|
|
||||||
that simply prints its arguments to the console. The second argument is the
|
|
||||||
string literal "Hello, world!", which is the one and only argument to the
|
|
||||||
print function. Lastly, the print symbol and the string literal are wrapped
|
|
||||||
in parentheses, forming a tuple. In Janet, parentheses and brackets are interchangeable,
|
|
||||||
brackets are used mostly when the resulting tuple is not a function call. The tuple
|
|
||||||
above indicates that the function `print` is to be called with one argument, `"Hello, world"`.
|
|
||||||
|
|
||||||
Like all lisps, all operations in Janet are in prefix notation; the name of the
|
|
||||||
operator is the first value in the tuple, and the arguments passed to it are
|
|
||||||
in the rest of the tuple.
|
|
||||||
|
|
||||||
# A bit more - Arithmetic
|
|
||||||
|
|
||||||
Any programming language will have some way to do arithmetic. Janet is no exception,
|
|
||||||
and supports the basic arithmetic operators
|
|
||||||
|
|
||||||
```
|
|
||||||
# Prints 13
|
|
||||||
# (1 + (2*2) + (10/5) + 3 + 4 + (5 - 6))
|
|
||||||
(print (+ 1 (* 2 2) (/ 10 5) 3 4 (- 5 6)))
|
|
||||||
```
|
|
||||||
|
|
||||||
Just like the print function, all arithmetic operators are entered in
|
|
||||||
prefix notation. Janet also supports the remainder operator, or `%`, which returns
|
|
||||||
the remainder of division. For example, `(% 10 3)` is 1, and `(% 10.5 3)` is
|
|
||||||
1.5. The lines that begin with `#` are comments.
|
|
||||||
|
|
||||||
All janet numbers are IEEE 754 floating point numbers. They can be used to represent
|
|
||||||
both integers and real numbers to a finite precision.
|
|
||||||
|
|
||||||
## Numeric literals
|
|
||||||
|
|
||||||
Numeric literals can be written in many ways. Numbers can be written in base 10, with
|
|
||||||
underscores used to separate digits into groups. A decimal point can be used for floating
|
|
||||||
point numbers. Numbers can also be written in other bases by prefixing the number with the desired
|
|
||||||
base and the character 'r'. For example, 16 can be written as `16`, `1_6`, `16r10`, `4r100`, or `0x10`. The
|
|
||||||
`0x` prefix can be used for hexadecimal as it is so common. The radix must be themselves written in base 10, and
|
|
||||||
can be any integer from 2 to 36. For any radix above 10, use the letters as digits (not case sensitive).
|
|
||||||
|
|
||||||
Numbers can also be in scientific notation such as `3e10`. A custom radix can be used as well
|
|
||||||
as for scientific notation numbers, (the exponent will share the radix). For numbers in scientific
|
|
||||||
notation with a radix besides 10, use the `&` symbol to indicate the exponent rather then `e`.
|
|
||||||
|
|
||||||
## Arithmetic Functions
|
|
||||||
|
|
||||||
Besides the 5 main arithmetic functions, janet also supports a number of math functions
|
|
||||||
taken from the C library `<math.h>`, as well as bit-wise operators that behave like they
|
|
||||||
do in C or Java. Functions like `math/sin`, `math/cos`, `math/log`, and `math/exp` will
|
|
||||||
behave as expected to a C programmer. They all take either 1 or 2 numeric arguments and
|
|
||||||
return a real number (never an integer!) Bit-wise functions are all prefixed with b.
|
|
||||||
They are `bnot`, `bor`, `bxor`, `band`, `blshift`, `brshift`, and `brushift`. Bit-wise
|
|
||||||
functions only work on integers.
|
|
||||||
|
|
||||||
# Strings, Keywords and Symbols
|
|
||||||
|
|
||||||
Janet supports several varieties of types that can be used as labels for things in
|
|
||||||
your program. The most useful type for this purpose is the keyword type. A keyword
|
|
||||||
begins with a semicolon, and then contains 0 or more alphanumeric or a few other common
|
|
||||||
characters. For example, `:hello`, `:my-name`, `::`, and `:ABC123_-*&^%$` are all keywords.
|
|
||||||
|
|
||||||
Keywords, symbols, and strings all behave similarly and can be used as keys for tables and structs.
|
|
||||||
Symbols and keywords are optimized for fast equality checks, so are preferred for table keys.
|
|
||||||
|
|
||||||
The difference between symbols and keywords is that keywords evaluate to themselves, while
|
|
||||||
symbols evaluate to whatever they are bound to. To have a symbol evaluate to itself, it must be
|
|
||||||
quoted.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Evaluates to :monday
|
|
||||||
:monday
|
|
||||||
|
|
||||||
# Will throw a compile error as monday is not defined
|
|
||||||
monday
|
|
||||||
|
|
||||||
# Quote it - evaluates to the symbol monday
|
|
||||||
'monday
|
|
||||||
|
|
||||||
# Or first define monday
|
|
||||||
(def monday "It is monday")
|
|
||||||
|
|
||||||
# Now the evaluation should work - monday evaluates to "It is monday"
|
|
||||||
monday
|
|
||||||
```
|
|
||||||
|
|
||||||
The most common thing to do with a keyword is to check it for equality or use it as a key into
|
|
||||||
a table or struct. Note that symbols, keywords and strings are all immutable. Besides making your
|
|
||||||
code easier to reason about, it allows for many optimizations involving these types.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Evaluates to true
|
|
||||||
(= :hello :hello)
|
|
||||||
|
|
||||||
# Evaluates to false, everything in janet is case sensitive
|
|
||||||
(= :hello :HeLlO)
|
|
||||||
|
|
||||||
# Look up into a table - evaluates to 25
|
|
||||||
(get {
|
|
||||||
:name "John"
|
|
||||||
:age 25
|
|
||||||
:occupation "plumber"
|
|
||||||
} :age)
|
|
||||||
```
|
|
||||||
|
|
||||||
Strings can be used similarly to keywords, but there primary usage is for defining either text
|
|
||||||
or arbitrary sequences of bytes. Strings (and symbols) in janet are what is sometimes known as
|
|
||||||
"8-bit clean"; they can hold any number of bytes, and are completely unaware of things like character
|
|
||||||
encodings. This is completely compatible with ASCII and UTF-8, two of the most common character
|
|
||||||
encodings. By being encoding agnostic, janet strings can be very simple, fast, and useful for
|
|
||||||
for other uses besides holding text.
|
|
||||||
|
|
||||||
Literal text can be entered inside quotes, as we have seen above.
|
|
||||||
|
|
||||||
```
|
|
||||||
"Hello, this is a string."
|
|
||||||
|
|
||||||
# We can also add escape characters for newlines, double quotes, backslash, tabs, etc.
|
|
||||||
"Hello\nThis is on line two\n\tThis is indented\n"
|
|
||||||
|
|
||||||
# For long strings where you don't want to type a lot of escape characters,
|
|
||||||
# you can use 1 or more backticks (`\``) to delimit a string.
|
|
||||||
# To close this string, simply repeat the opening sequence of backticks
|
|
||||||
``
|
|
||||||
This is a string.
|
|
||||||
Line 2
|
|
||||||
Indented
|
|
||||||
"We can just type quotes here", and backslashes \ no problem.
|
|
||||||
``
|
|
||||||
```
|
|
||||||
|
|
||||||
# Functions
|
|
||||||
|
|
||||||
Janet is a functional language - that means that one of the basic building blocks of your
|
|
||||||
program will be defining functions (the other is using data structures). Because janet
|
|
||||||
is a Lisp, functions are values just like numbers or strings - they can be passed around and
|
|
||||||
created as needed.
|
|
||||||
|
|
||||||
Functions can be defined with the `defn` macro, like so:
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defn triangle-area
|
|
||||||
"Calculates the area of a triangle."
|
|
||||||
[base height]
|
|
||||||
(print "calculating area of a triangle...")
|
|
||||||
(* base height 0.5))
|
|
||||||
```
|
|
||||||
|
|
||||||
A function defined with `defn` consists of a name, a number of optional flags for def, and
|
|
||||||
finally a function body. The example above is named triangle-area and takes two parameters named base and height. The body of the function will print a message and then evaluate to the area of the triangle.
|
|
||||||
|
|
||||||
Once a function like the above one is defined, the programmer can use the `triangle-area`
|
|
||||||
function just like any other, say `print` or `+`.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Prints "calculating area of a triangle..." and then "25"
|
|
||||||
(print (triangle-area 5 10))
|
|
||||||
```
|
|
||||||
|
|
||||||
Note that when nesting function calls in other function calls like above (a call to triangle-area is
|
|
||||||
nested inside a call to print), the inner function calls are evaluated first. Also, arguments to
|
|
||||||
a function call are evaluated in order, from first argument to last argument).
|
|
||||||
|
|
||||||
Because functions are first-class values like numbers or strings, they can be passed
|
|
||||||
as arguments to other functions as well.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(print triangle-area)
|
|
||||||
```
|
|
||||||
|
|
||||||
This prints the location in memory of the function triangle area.
|
|
||||||
|
|
||||||
Functions don't need to have names. The `fn` keyword can be used to introduce function
|
|
||||||
literals without binding them to a symbol.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Evaluates to 40
|
|
||||||
((fn [x y] (+ x x y)) 10 20)
|
|
||||||
# Also evaluates to 40
|
|
||||||
((fn [x y &] (+ x x y)) 10 20)
|
|
||||||
|
|
||||||
# Will throw an error about the wrong arity
|
|
||||||
((fn [x] x) 1 2)
|
|
||||||
# Will not throw an error about the wrong arity
|
|
||||||
((fn [x &] x) 1 2)
|
|
||||||
```
|
|
||||||
|
|
||||||
The first expression creates an anonymous function that adds twice
|
|
||||||
the first argument to the second, and then calls that function with arguments 10 and 20.
|
|
||||||
This will return (10 + 10 + 20) = 40.
|
|
||||||
|
|
||||||
There is a common macro `defn` that can be used for creating functions and immediately binding
|
|
||||||
them to a name. `defn` works as expected at both the top level and inside another form. There is also
|
|
||||||
the corresponding
|
|
||||||
|
|
||||||
Note that putting an ampersand at the end of the argument list inhibits strict arity checking.
|
|
||||||
This means that such a function will accept fewer or more arguments than specified.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defn myfun [x y]
|
|
||||||
(+ x x y))
|
|
||||||
|
|
||||||
# You can think of defn as a shorthand for def and fn together
|
|
||||||
(def myfun-same (fn [x y]
|
|
||||||
(+ x x Y)))
|
|
||||||
|
|
||||||
(myfun 3 4) # -> 10
|
|
||||||
```
|
|
||||||
|
|
||||||
Janet has many macros provided for you (and you can write your own).
|
|
||||||
Macros are just functions that take your source code
|
|
||||||
and transform it into some other source code, usually automating some repetitive pattern for you.
|
|
||||||
|
|
||||||
# Defs and Vars
|
|
||||||
|
|
||||||
Values can be bound to symbols for later use using the keyword `def`. Using undefined
|
|
||||||
symbols will raise an error.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def a 100)
|
|
||||||
(def b (+ 1 a))
|
|
||||||
(def c (+ b b))
|
|
||||||
(def d (- c 100))
|
|
||||||
```
|
|
||||||
|
|
||||||
Bindings created with def have lexical scoping. Also, bindings created with def are immutable; they
|
|
||||||
cannot be changed after definition. For mutable bindings, like variables in other programming
|
|
||||||
languages, use the `var` keyword. The assignment special form `set` can then be used to update
|
|
||||||
a var.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(var myvar 1)
|
|
||||||
(print myvar)
|
|
||||||
(set myvar 10)
|
|
||||||
(print myvar)
|
|
||||||
```
|
|
||||||
|
|
||||||
In the global scope, you can use the `:private` option on a def or var to prevent it from
|
|
||||||
being exported to code that imports your current module. You can also add documentation to
|
|
||||||
a function by passing a string the def or var command.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def mydef :private "This will have priavte scope. My doc here." 123)
|
|
||||||
(var myvar "docstring here" 321)
|
|
||||||
```
|
|
||||||
|
|
||||||
## Scopes
|
|
||||||
|
|
||||||
Defs and vars (collectively known as bindings) live inside what is called a scope. A scope is
|
|
||||||
simply where the bindings are valid. If a binding is referenced outside of its scope, the compiler
|
|
||||||
will throw an error. Scopes are useful for organizing your bindings and my extension your programs.
|
|
||||||
There are two main ways to create a scope in Janet.
|
|
||||||
|
|
||||||
The first is to use the `do` special form. `do` executes a series of statements in a scope
|
|
||||||
and evaluates to the last statement. Bindings create inside the form do not escape outside
|
|
||||||
of its scope.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def a :outera)
|
|
||||||
|
|
||||||
(do
|
|
||||||
(def a 1)
|
|
||||||
(def b 2)
|
|
||||||
(def c 3)
|
|
||||||
(+ a b c)) # -> 6
|
|
||||||
|
|
||||||
a # -> :outera
|
|
||||||
b # -> compile error: "unknown symbol \"b\""
|
|
||||||
c # -> compile error: "unknown symbol \"c\""
|
|
||||||
```
|
|
||||||
|
|
||||||
Any attempt to reference the bindings from the do form after it has finished
|
|
||||||
executing will fail. Also notice who defining `a` inside the do form did not
|
|
||||||
overwrite the original definition of `a` for the global scope.
|
|
||||||
|
|
||||||
The second way to create a scope is to create a closure.
|
|
||||||
The `fn` special form also introduces a scope just like
|
|
||||||
the `do` special form.
|
|
||||||
|
|
||||||
There is another built in macro, `let`, that does multiple defs at once, and then introduces a scope.
|
|
||||||
`let` is a wrapper around a combination of defs and dos, and is the most "functional" way of
|
|
||||||
creating bindings.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(let [a 1
|
|
||||||
b 2
|
|
||||||
c 3]
|
|
||||||
(+ a b c)) # -> 6
|
|
||||||
```
|
|
||||||
|
|
||||||
The above is equivalent to the example using `do` and `def`.
|
|
||||||
This is the preferable form in most cases,
|
|
||||||
but using do with multiple defs is fine as well.
|
|
||||||
|
|
||||||
# Data Structures
|
|
||||||
|
|
||||||
Once you have a handle on functions and the primitive value types, you may be wondering how
|
|
||||||
to work with collections of things. Janet has a small number of core data structure types
|
|
||||||
that are very versatile. Tables, Structs, Arrays, Tuples, Strings, and Buffers, are the 6 main
|
|
||||||
built in data structure types. These data structures can be arranged in a useful table describing
|
|
||||||
there relationship to each other.
|
|
||||||
|
|
||||||
| | Mutable | Immutable |
|
|
||||||
| ---------- | ------- | --------------- |
|
|
||||||
| Indexed | Array | Tuple |
|
|
||||||
| Dictionary | Table | Struct |
|
|
||||||
| Bytes | Buffer | String |
|
|
||||||
|
|
||||||
Indexed types are linear lists of elements than can be accessed in constant time with an integer index.
|
|
||||||
Indexed types are backed by a single chunk of memory for fast access, and are indexed from 0 as in C.
|
|
||||||
Dictionary types associate keys with values. The difference between dictionaries and indexed types
|
|
||||||
is that dictionaries are not limited to integer keys. They are backed by a hashtable and also offer
|
|
||||||
constant time lookup (and insertion for the mutable case).
|
|
||||||
Finally, the 'bytes' abstraction is any type that contains a sequence of bytes. A 'bytes' value or byteseq associates
|
|
||||||
integer keys (the indices) with integer values between 0 and 255 (the byte values). In this way,
|
|
||||||
they behave much like Arrays and Tuples. However, one cannot put non integer values into a byteseq
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def mytuple (tuple 1 2 3))
|
|
||||||
|
|
||||||
(def myarray @(1 2 3))
|
|
||||||
(def myarray (array 1 2 3))
|
|
||||||
|
|
||||||
(def mystruct {
|
|
||||||
:key "value"
|
|
||||||
:key2 "another"
|
|
||||||
1 2
|
|
||||||
4 3})
|
|
||||||
|
|
||||||
(def another-struct
|
|
||||||
(struct :a 1 :b 2))
|
|
||||||
|
|
||||||
(def my-table @{
|
|
||||||
:a :b
|
|
||||||
:c :d
|
|
||||||
:A :qwerty})
|
|
||||||
(def another-table
|
|
||||||
(table 1 2 3 4))
|
|
||||||
|
|
||||||
(def my-buffer @"thisismutable")
|
|
||||||
(def my-buffer2 @```
|
|
||||||
This is also mutable ":)"
|
|
||||||
```)
|
|
||||||
```
|
|
||||||
|
|
||||||
To read the values in a data structure, use the get function. The first parameter is the data structure
|
|
||||||
itself, and the second parameter is the key.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(get @{:a 1} :a) # -> 1
|
|
||||||
(get {:a 1} :a) # -> 1
|
|
||||||
(get @[:a :b :c] 2) # -> :c
|
|
||||||
(get (tuple "a" "b" "c") 1) # -> "b"
|
|
||||||
(get @"hello, world" 1) # -> 101
|
|
||||||
(get "hello, world" 0) # -> 104
|
|
||||||
```
|
|
||||||
|
|
||||||
### Destructuring
|
|
||||||
|
|
||||||
In many cases, however, you do not need the `get` function at all. Janet supports destructuring, which
|
|
||||||
means both the `def` and `var` special forms can extract values from inside structures themselves.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Before, we might do
|
|
||||||
(def my-array @[:mary :had :a :little :lamb])
|
|
||||||
(def lamb (get my-array 4))
|
|
||||||
(print lamb) # Prints :lamb
|
|
||||||
|
|
||||||
# Now, with destructuring,
|
|
||||||
(def [_ _ _ _ lamb] my-array)
|
|
||||||
(print lamb) # Again, prints :lamb
|
|
||||||
|
|
||||||
# Destructuring works with tables as well
|
|
||||||
(def person @{:name "Bob Dylan" :age 77}
|
|
||||||
(def
|
|
||||||
{:name person-name
|
|
||||||
:age person-age} person)
|
|
||||||
```
|
|
||||||
To update a mutable data structure, use the `put` function. It takes 3 arguments, the data structure,
|
|
||||||
the key, and the value, and returns the data structure. The allowed types keys and values
|
|
||||||
depend on what data structure is passed in.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(put @[] 100 :a)
|
|
||||||
(put @{} :key "value")
|
|
||||||
(put @"" 100 92)
|
|
||||||
```
|
|
||||||
|
|
||||||
Note that for Arrays and Buffers, putting an index that is outside the length of the data structure
|
|
||||||
will extend the data structure and fill it with nils in the case of the Array,
|
|
||||||
or 0s in the case of the Buffer.
|
|
||||||
|
|
||||||
The last generic function for all data structures is the `length` function. This returns the number of
|
|
||||||
values in a data structure (the number of keys in a dictionary type).
|
|
||||||
|
|
||||||
# Flow Control
|
|
||||||
|
|
||||||
Janet has only two built in primitives to change flow while inside a function. The first is the
|
|
||||||
`if` special form, which behaves as expected in most functional languages. It takes two or three parameters:
|
|
||||||
a condition, an expression to evaluate to if the condition is true (not nil or false),
|
|
||||||
and an optional condition to evaluate to when the condition is nil or false. If the optional parameter
|
|
||||||
is omitted, the if form evaluates to nil.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(if (> 4 3)
|
|
||||||
"4 is greater than 3"
|
|
||||||
"4 is not greater then three") # Evaluates to the first statement
|
|
||||||
|
|
||||||
(if true
|
|
||||||
(print "Hey")) # Will print
|
|
||||||
|
|
||||||
(if false
|
|
||||||
(print "Oy!")) # Will not print
|
|
||||||
```
|
|
||||||
|
|
||||||
The second primitive control flow construct is the while loop. The while behaves much the same
|
|
||||||
as in many other programming languages, including C, Java, and Python. The while loop takes
|
|
||||||
two or more parameters: the first is a condition (like in the `if` statement), that is checked before
|
|
||||||
every iteration of the loop. If it is nil or false, the while loop ends and evaluates to nil. Otherwise,
|
|
||||||
the rest of the parameters will be evaluated sequentially and then the program will return to the beginning
|
|
||||||
of the loop.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# Loop from 100 down to 1 and print each time
|
|
||||||
(var i 100)
|
|
||||||
(while (pos? i)
|
|
||||||
(print "the number is " i)
|
|
||||||
(-- i))
|
|
||||||
|
|
||||||
# Print ... until a random number in range [0, 1) is >= 0.9
|
|
||||||
# (math/random evaluates to a value between 0 and 1)
|
|
||||||
(while (> 0.9 (math/random))
|
|
||||||
(print "..."))
|
|
||||||
```
|
|
||||||
|
|
||||||
Besides these special forms, Janet has many macros for both conditional testing and looping
|
|
||||||
that are much better for the majority of cases. For conditional testing, the `cond`, `switch`, and
|
|
||||||
`when` macros can be used to great effect. `cond` can be used for making an if-else chain, where using
|
|
||||||
just raw if forms would result in many parentheses. `case` For looping, the `loop`, `seq`, and `generate`
|
|
||||||
implement janet's form of list comprehension, as in Python or Clojure.
|
|
||||||
|
|
||||||
# The Core Library
|
|
||||||
|
|
||||||
Janet has a built in core library of over 300 functions and macros at the time of writing.
|
|
||||||
While some of these functions may be refactored into separate modules, it is useful to get to know
|
|
||||||
the core to avoid rewriting provided functions.
|
|
||||||
|
|
||||||
For any given function, use the `doc` macro to view the documentation for it in the repl.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(doc defn) -> Prints the documentation for "defn"
|
|
||||||
```
|
|
||||||
To see a list of all global functions in the repl, type the command
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(table/getproto *env*)
|
|
||||||
# Or
|
|
||||||
(all-symbols)
|
|
||||||
```
|
|
||||||
Which will print out every built-in global binding
|
|
||||||
(it will not show your global bindings). To print all
|
|
||||||
of your global bindings, just use \*env\*, which is a var
|
|
||||||
that is bound to the current environment.
|
|
||||||
|
|
||||||
The convention of surrounding a symbol in stars is taken from lisp
|
|
||||||
and Clojure, and indicates a global dynamic variable rather than a normal
|
|
||||||
definition. To get the static environment at the time of compilation, use the
|
|
||||||
`_env` symbol.
|
|
||||||
|
|
||||||
# Prototypes
|
|
||||||
|
|
||||||
To support basic generic programming, Janet tables support a prototype
|
|
||||||
table. A prototype table contains default values for a table if certain keys
|
|
||||||
are not found in the original table. This allows many similar tables to share
|
|
||||||
contents without duplicating memory.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
# One of many Object Oriented schemes that can
|
|
||||||
# be implented in janet.
|
|
||||||
(def proto1 @{:type :custom1
|
|
||||||
:behave (fn [self x] (print "behaving " x))})
|
|
||||||
(def proto2 @{:type :custom2
|
|
||||||
:behave (fn [self x] (print "behaving 2 " x))})
|
|
||||||
|
|
||||||
(def thing1 (table/setproto @{} proto1))
|
|
||||||
(def thing2 (table/setproto @{} proto2))
|
|
||||||
|
|
||||||
(print thing1:type) # prints :custom1
|
|
||||||
(print thing2:type) # prints :custom2
|
|
||||||
|
|
||||||
(thing1:behave thing1 :a) # prints "behaving :a"
|
|
||||||
(thing2:behave thing2 :b) # prints "behaving 2 :b"
|
|
||||||
```
|
|
||||||
|
|
||||||
Looking up in a table with a prototype can be summed up with the following algorithm.
|
|
||||||
|
|
||||||
1. `(get my-table my-key)` is called.
|
|
||||||
2. my-table is checked for the key if my-key. If there is a value for the key, it is returned.
|
|
||||||
3. if there is a prototype table for my-table, set `my-table = my-table's prototype` and got to 2.
|
|
||||||
4. Return nil as the key was not found.
|
|
||||||
|
|
||||||
Janet will check up to about a 1000 prototypes recursively by default before giving up and returning nil. This
|
|
||||||
is to prevent an infinite loop. This value can be changed by adjusting the `JANET_RECURSION_GUARD` value
|
|
||||||
in janet.h.
|
|
||||||
|
|
||||||
Note that Janet prototypes are not as expressive as metatables in Lua and many other languages.
|
|
||||||
This is by design, as adding Lua or Python like capabilities would not be technically difficult.
|
|
||||||
Users should prefer plain data and functions that operate on them rather than mutable objects
|
|
||||||
with methods.
|
|
||||||
|
|
||||||
# Fibers
|
|
||||||
|
|
||||||
Janet has support for single-core asynchronous programming via coroutines, or fibers.
|
|
||||||
Fibers allow a process to stop and resume execution later, essentially enabling
|
|
||||||
multiple returns from a function. This allows many patterns such a schedules, generators,
|
|
||||||
iterators, live debugging, and robust error handling. Janet's error handling is actually built on
|
|
||||||
top of fibers (when an error is thrown, the parent fiber will handle the error).
|
|
||||||
|
|
||||||
A temporary return from a fiber is called a yield, and can be invoked with the `yield` function.
|
|
||||||
To resume a fiber that has been yielded, use the `resume` function. When resume is called on a fiber,
|
|
||||||
it will only return when that fiber either returns, yields, throws an error, or otherwise emits
|
|
||||||
a signal.
|
|
||||||
|
|
||||||
Different from traditional coroutines, Janet's fibers implement a signaling mechanism, which
|
|
||||||
is used to differentiate different kinds of returns. When a fiber yields or throws an error,
|
|
||||||
control is returned to the calling fiber. The parent fiber must then check what kind of state the
|
|
||||||
fiber is in to differentiate errors from return values from user defined signals.
|
|
||||||
|
|
||||||
To create a fiber, user the `fiber/new` function. The fiber constructor take one or two arguments.
|
|
||||||
The first, necessary argument is the function that the fiber will execute. This function must accept
|
|
||||||
an arity of zero. The next optional argument is a collection of flags checking what kinds of
|
|
||||||
signals to trap and return via `resume`. This is useful so
|
|
||||||
the programmer does not need to handle all different kinds of signals from a fiber. Any un-trapped signals
|
|
||||||
are simply propagated to the next fiber.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def f (fiber/new (fn []
|
|
||||||
(yield 1)
|
|
||||||
(yield 2)
|
|
||||||
(yield 3)
|
|
||||||
(yield 4)
|
|
||||||
5)))
|
|
||||||
|
|
||||||
# Get the status of the fiber (:alive, :dead, :debug, :new, :pending, or :user0-:user9)
|
|
||||||
(print (fiber/status f)) # -> :new
|
|
||||||
|
|
||||||
(print (resume f)) # -> prints 1
|
|
||||||
(print (resume f)) # -> prints 2
|
|
||||||
(print (resume f)) # -> prints 3
|
|
||||||
(print (resume f)) # -> prints 4
|
|
||||||
(print (fiber/status f)) # -> print :pending
|
|
||||||
(print (resume f)) # -> prints 5
|
|
||||||
(print (fiber/status f)) # -> print :dead
|
|
||||||
(print (resume f)) # -> throws an error because the fiber is dead
|
|
||||||
```
|
|
||||||
|
|
||||||
## Using Fibers to Capture Errors
|
|
||||||
|
|
||||||
Besides being used as coroutines, fibers can be used to implement error handling (exceptions).
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defn my-function-that-errors [x]
|
|
||||||
(print "start function with " x)
|
|
||||||
(error "oops!")
|
|
||||||
(print "never gets here"))
|
|
||||||
|
|
||||||
# Use the :e flag to only trap errors.
|
|
||||||
(def f (fiber/new my-function-that-errors :e))
|
|
||||||
(def result (resume f))
|
|
||||||
(if (= (fiber/status f) :error)
|
|
||||||
(print "result contains the error")
|
|
||||||
(print "result contains the good result"))
|
|
||||||
```
|
|
||||||
|
|
||||||
# Macros
|
|
||||||
|
|
||||||
Janet supports macros like most lisps. A macro is like a function, but transforms
|
|
||||||
the code itself rather than data. They let you extend the syntax of the language itself.
|
|
||||||
|
|
||||||
You have seen some macros already. The `let`, `loop`, and `defn` forms are macros. When the compiler
|
|
||||||
sees a macro, it evaluates the macro and then compiles the result. We say the macro has been
|
|
||||||
*expanded* after the compiler evaluates it. A simple version of the `defn` macro can
|
|
||||||
be thought of as transforming code of the form
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defn1 myfun [x] body)
|
|
||||||
```
|
|
||||||
into
|
|
||||||
```lisp
|
|
||||||
(def myfun (fn myfun [x] body))
|
|
||||||
```
|
|
||||||
|
|
||||||
We could write such a macro like so:
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro defn1 [name args body]
|
|
||||||
(tuple 'def name (tuple 'fn name args body)))
|
|
||||||
```
|
|
||||||
|
|
||||||
There are a couple of issues with this macro, but it will work for simple functions
|
|
||||||
quite well.
|
|
||||||
|
|
||||||
The first issue is that our defn2 macro can't define functions with multiple expressions
|
|
||||||
in the body. We can make the macro variadic, just like a function. Here is a second version
|
|
||||||
of this macro.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro defn2 [name args & body]
|
|
||||||
(tuple 'def name (apply tuple 'fn name args body)))
|
|
||||||
```
|
|
||||||
|
|
||||||
Great! Now we can define functions with multiple elements in the body. We can still improve this
|
|
||||||
macro even more though. First, we can add a docstring to it. If someone is using the function later,
|
|
||||||
they can use `(doc defn3)` to get a description of the function. Next, we can rewrite the macro
|
|
||||||
using janet's builtin quasiquoting facilities.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro defn3
|
|
||||||
"Defines a new function."
|
|
||||||
[name args & body]
|
|
||||||
~(def ,name (fn ,name ,args ,;body)))
|
|
||||||
```
|
|
||||||
|
|
||||||
This is functionally identical to our previous version `defn2`, but written in such
|
|
||||||
a way that the macro output is more clear. The leading tilde `~` is shorthand for the
|
|
||||||
`(quasiquote x)` special form, which is like `(quote x)` except we can unquote
|
|
||||||
expressions inside it. The comma in front of `name` and `args` is an unquote, which
|
|
||||||
allows us to put a value in the quasiquote. Without the unquote, the symbol \'name\'
|
|
||||||
would be put in the returned tuple. Without the unquote, every function we defined
|
|
||||||
would be called \'name\'!.
|
|
||||||
|
|
||||||
Similar to name, we must also unquote body. However, a normal unquote doesn't work.
|
|
||||||
See what happens if we use a normal unquote for body as well.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def name 'myfunction)
|
|
||||||
(def args '[x y z])
|
|
||||||
(defn body '[(print x) (print y) (print z)])
|
|
||||||
|
|
||||||
~(def ,name (fn ,name ,args ,body))
|
|
||||||
# -> (def myfunction (fn myfunction (x y z) ((print x) (print y) (print z))))
|
|
||||||
```
|
|
||||||
|
|
||||||
There is an extra set of parentheses around the body of our function! We don't
|
|
||||||
want to put the body *inside* the form `(fn args ...)`, we want to *splice* it
|
|
||||||
into the form. Luckily, janet has the `(splice x)` special form for this purpose,
|
|
||||||
and a shorthand for it, the ; character.
|
|
||||||
When combined with the unquote special, we get the desired output.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
~(def ,name (fn ,name ,args ,;body))
|
|
||||||
# -> (def myfunction (fn myfunction (x y z) (print x) (print y) (print z)))
|
|
||||||
```
|
|
||||||
|
|
||||||
## Hygiene
|
|
||||||
|
|
||||||
Sometime when we write macros, we must generate symbols for local bindings. Ignoring that
|
|
||||||
it could be written as a function, consider
|
|
||||||
the following macro
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro max1
|
|
||||||
"Get the max of two values."
|
|
||||||
[x y]
|
|
||||||
~(if (> ,x ,y) ,x ,y))
|
|
||||||
```
|
|
||||||
|
|
||||||
This almost works, but will evaluate both x and y twice. This is because both show up
|
|
||||||
in the macro twice. For example, `(max1 (do (print 1) 1) (do (print 2) 2))` will
|
|
||||||
print both 1 and 2 twice, which is surprising to a user of this macro.
|
|
||||||
|
|
||||||
We can do better:
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro max2
|
|
||||||
"Get the max of two values."
|
|
||||||
[x y]
|
|
||||||
~(let [x ,x
|
|
||||||
y ,y]
|
|
||||||
(if (> x y) x y)))
|
|
||||||
```
|
|
||||||
|
|
||||||
Now we have no double evaluation problem! But we now have an even more subtle problem.
|
|
||||||
What happens in the following code?
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def x 10)
|
|
||||||
(max2 8 (+ x 4))
|
|
||||||
```
|
|
||||||
|
|
||||||
We want the max to be 14, but this will actually evaluate to 12! This can be understood
|
|
||||||
if we expand the macro. You can expand macro once in janet using the `(macex1 x)` function.
|
|
||||||
(To expand macros until there are no macros left to expand, use `(macex x)`. Be careful,
|
|
||||||
janet has many macros, so the full expansion may be almost unreadable).
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(macex1 '(max2 8 (+ x 4)))
|
|
||||||
# -> (let (x 8 y (+ x 4)) (if (> x y) x y))
|
|
||||||
```
|
|
||||||
|
|
||||||
After expansion, y wrongly refers to the x inside the macro (which is bound to 8) rather than the x defined
|
|
||||||
to be 10. The problem is the reuse of the symbol x inside the macro, which overshadowed the original
|
|
||||||
binding.
|
|
||||||
|
|
||||||
Janet provides a general solution to this problem in terms of the `(gensym)` function, which returns
|
|
||||||
a symbol which is guaranteed to be unique and not collide with any symbols defined previously. We can define
|
|
||||||
our macro once more for a fully correct macro.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(defmacro max3
|
|
||||||
"Get the max of two values."
|
|
||||||
[x y]
|
|
||||||
(def $x (gensym))
|
|
||||||
(def $y (gensym))
|
|
||||||
~(let [,$x ,x
|
|
||||||
,$y ,y]
|
|
||||||
(if (> ,$x ,$y) ,$x ,$y)))
|
|
||||||
```
|
|
||||||
|
|
||||||
As you can see, macros are very powerful but also are prone to subtle bugs. You must remember that
|
|
||||||
at their core, macros are just functions that output code, and the code that they return must
|
|
||||||
work in many contexts!
|
|
||||||
174
doc/Loop.md
174
doc/Loop.md
@@ -1,174 +0,0 @@
|
|||||||
# Loops in Janet
|
|
||||||
|
|
||||||
A very common and essential operation in all programming is looping. Most
|
|
||||||
languages support looping of some kind, either with explicit loops or recursion.
|
|
||||||
Janet supports both recursion and a primitive `while` loop. While recursion is
|
|
||||||
useful in many cases, sometimes is more convenient to use a explicit loop to
|
|
||||||
iterate over a collection like an array.
|
|
||||||
|
|
||||||
## An Example - Iterating a Range
|
|
||||||
|
|
||||||
Suppose you want to calculate the sum of the first 10 natural numbers
|
|
||||||
0 through 9. There are many ways to carry out this explicit calculation
|
|
||||||
even with taking shortcuts. A succinct way in janet is
|
|
||||||
|
|
||||||
```
|
|
||||||
(+ ;(range 10))
|
|
||||||
```
|
|
||||||
|
|
||||||
We will limit ourselves however to using explicit looping and no functions
|
|
||||||
like `(range n)` which generate a list of natural numbers for us.
|
|
||||||
|
|
||||||
For our first version, we will use only the while macro to iterate, similar
|
|
||||||
to how one might sum natural numbers in a language such as C.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var sum 0)
|
|
||||||
(var i 0)
|
|
||||||
(while (< i 10)
|
|
||||||
(+= sum i)
|
|
||||||
(++ i))
|
|
||||||
(print sum) # prints 45
|
|
||||||
```
|
|
||||||
This is a very imperative style program which can grow very large very quickly.
|
|
||||||
We are manually updating a counter `i` in a loop. Using the macros `+=` and `++`, this
|
|
||||||
style code is similar in density to C code.
|
|
||||||
It is recommended to use either macros (such as the loop macro) or a functional
|
|
||||||
style in janet.
|
|
||||||
|
|
||||||
Since this is such a common pattern, Janet has a macro for this exact purpose. The
|
|
||||||
`(for x start end body)` captures exactly this behavior of incrementing a counter
|
|
||||||
in a loop.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var sum 0)
|
|
||||||
(for i 0 10 (+= sum i))
|
|
||||||
(print sum) # prints 45
|
|
||||||
```
|
|
||||||
|
|
||||||
We have completely wrapped the imperative counter in a macro. The for macro, while not
|
|
||||||
very flexible, is very terse and covers a common case of iteration, iterating over an integer range. The for macro will be expanded to something very similar to our original
|
|
||||||
version with a while loop.
|
|
||||||
|
|
||||||
We can do something similar with the more flexible `loop` macro.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var sum 0)
|
|
||||||
(loop [i :range [0 10]] (+= sum i))
|
|
||||||
(print sum) # prints 45
|
|
||||||
```
|
|
||||||
|
|
||||||
This is slightly more verbose than the for macro, but can be more easily extended.
|
|
||||||
Let's say that we wanted to only count even numbers towards the sum. We can do this
|
|
||||||
easily with the loop macro.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var sum 0)
|
|
||||||
(loop [i :range [0 10] :when (even? i)] (+= sum i))
|
|
||||||
(print sum) # prints 20
|
|
||||||
```
|
|
||||||
|
|
||||||
The loop macro has several verbs (:range) and modifiers (:when) that let
|
|
||||||
the programmer more easily generate common looping idioms. The loop macro
|
|
||||||
is similar to the Common Lips loop macro, but smaller in scope and with a much
|
|
||||||
simpler syntax. As with the `for` macro, the loop macro expands to similar
|
|
||||||
code as our original while expression.
|
|
||||||
|
|
||||||
## Another Example - Iterating an Indexed Data Structure
|
|
||||||
|
|
||||||
Another common usage for iteration in any language is iterating over the items in
|
|
||||||
some data structure, like items in an array, characters in a string, or key value
|
|
||||||
pairs in a table.
|
|
||||||
|
|
||||||
Say we have an array of names that we want to print out. We will
|
|
||||||
again start with a simple while loop which we will refine into
|
|
||||||
more idiomatic expressions.
|
|
||||||
|
|
||||||
First, we will define our array of names
|
|
||||||
```
|
|
||||||
(def names @["Jean-Paul Sartre" "Bob Dylan" "Augusta Ada King" "Frida Kahlo" "Harriet Tubman")
|
|
||||||
```
|
|
||||||
|
|
||||||
With our array of names, we can use a while loop to iterate through the indices of names, get the
|
|
||||||
values, and the print them.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var i 0)
|
|
||||||
(def len (length names))
|
|
||||||
(while (< i len)
|
|
||||||
(print (get names i))
|
|
||||||
(++ i))
|
|
||||||
```
|
|
||||||
|
|
||||||
This is rather verbose. janet provides the `each` macro for iterating through the items in a tuple or
|
|
||||||
array, or the bytes in a buffer, symbol, or string.
|
|
||||||
|
|
||||||
```
|
|
||||||
(each name names (print name))
|
|
||||||
```
|
|
||||||
|
|
||||||
We can also use the `loop` macro for this case as well using the `:in` verb.
|
|
||||||
|
|
||||||
```
|
|
||||||
(loop [name :in names] (print name))
|
|
||||||
```
|
|
||||||
|
|
||||||
## Iterating a Dictionary
|
|
||||||
|
|
||||||
In the previous example, we iterated over the values in an array. Another common
|
|
||||||
use of looping in a Janet program is iterating over the keys or values in a table.
|
|
||||||
We cannot use the same method as iterating over an array because a table or struct does
|
|
||||||
not contain a known integer range of keys. Instead we rely on a function `next`, which allows
|
|
||||||
us to visit each of the keys in a struct or table. Note that iterating over a table will not
|
|
||||||
visit the prototype table.
|
|
||||||
|
|
||||||
As an example, lets iterate over a table of letters to a word that starts with that letter. We
|
|
||||||
will print out the words to our simple children's book.
|
|
||||||
|
|
||||||
```
|
|
||||||
(def alphabook
|
|
||||||
@{"A" "Apple"
|
|
||||||
"B" "Banana"
|
|
||||||
"C" "Cat"
|
|
||||||
"D" "Dog"
|
|
||||||
"E" "Elephant" })
|
|
||||||
```
|
|
||||||
|
|
||||||
As before, we can evaluate this loop using only a while loop and the `next` function.
|
|
||||||
|
|
||||||
```
|
|
||||||
(var key (next alphabook nil))
|
|
||||||
(while (not= nil key)
|
|
||||||
(print key " is for " (get alphabook key))
|
|
||||||
(set key (next alphabook key))
|
|
||||||
```
|
|
||||||
|
|
||||||
However, we can do better than this with the loop macro using the `:pairs` or `:keys` verbs.
|
|
||||||
|
|
||||||
```
|
|
||||||
(loop [[letter word] :pairs alphabook]
|
|
||||||
(print letter " is for " word))
|
|
||||||
```
|
|
||||||
|
|
||||||
Using the `:keys` verb and the dot syntax for indexing
|
|
||||||
|
|
||||||
```
|
|
||||||
(loop [letter :keys alphabook]
|
|
||||||
(print letter " is for " alphabook.letter))
|
|
||||||
```
|
|
||||||
|
|
||||||
The symbol `alphabook.letter` is shorthand for `(get alphabook letter)`.
|
|
||||||
Note that the dot syntax of `alphabook.letter` is different than in many languages. In C or
|
|
||||||
ALGOL like languages, it is more akin to the indexing operator, and would be written `alphabook[letter]`.
|
|
||||||
The `.` character is part of the symbol and is recognized by the compiler.
|
|
||||||
|
|
||||||
We can also use the core library functions `keys` and `pairs` to get arrays of the keys and
|
|
||||||
pairs respectively of the alphabook.
|
|
||||||
|
|
||||||
```
|
|
||||||
(loop [[letter word] :in (pairs alphabook)]
|
|
||||||
(print letter " is for " word))
|
|
||||||
|
|
||||||
(loop [letter :in (keys alphabook)]
|
|
||||||
(print letter " is for " alphabook.letter))
|
|
||||||
```
|
|
||||||
244
doc/Parser.md
244
doc/Parser.md
@@ -1,244 +0,0 @@
|
|||||||
# The Parser
|
|
||||||
|
|
||||||
A Janet program begins life as a text file, just a sequence of byte like
|
|
||||||
any other on your system. Janet source files should be UTF-8 or ASCII
|
|
||||||
encoded. Before Janet can compile or run your program, it must transform
|
|
||||||
your source code into a data structure. Janet is a lisp, which means it is
|
|
||||||
homoiconic - code is data, so all of the facilities in the language for
|
|
||||||
manipulating arrays, tuples, strings, and tables can be used for manipulating
|
|
||||||
your source code as well.
|
|
||||||
|
|
||||||
But before janet code is represented as a data structure, it must be read, or parsed,
|
|
||||||
by the janet parser. Called the reader in many other lisps, the parser is a machine
|
|
||||||
that takes in plain text and outputs data structures which can be used by both
|
|
||||||
the compiler and macros. In janet, it is a parser rather than a reader because
|
|
||||||
there is no code execution at read time. This is safer and simpler, and also
|
|
||||||
lets janet syntax serve as a robust data interchange format. While a parser
|
|
||||||
is not extensible, in janet the philosophy is to extend the language via macros
|
|
||||||
rather than reader macros.
|
|
||||||
|
|
||||||
## Nil, True and False
|
|
||||||
|
|
||||||
Nil, true and false are all literals than can be entered as such
|
|
||||||
in the parser.
|
|
||||||
|
|
||||||
```
|
|
||||||
nil
|
|
||||||
true
|
|
||||||
false
|
|
||||||
```
|
|
||||||
|
|
||||||
## Symbols
|
|
||||||
|
|
||||||
Janet symbols are represented a sequence of alphanumeric characters
|
|
||||||
not starting with a digit or a colon. They can also contain the characters
|
|
||||||
\!, @, $, \%, \^, \&, \*, -, \_, +, =, \|, \~, :, \<, \>, ., \?, \\, /, as
|
|
||||||
well as any Unicode codepoint not in the ASCII range.
|
|
||||||
|
|
||||||
By convention, most symbols should be all lower case and use dashes to connect words
|
|
||||||
(sometimes called kebab case).
|
|
||||||
|
|
||||||
Symbols that come from another module often contain a forward slash that separates
|
|
||||||
the name of the module from the name of the definition in the module
|
|
||||||
|
|
||||||
```
|
|
||||||
symbol
|
|
||||||
kebab-case-symbol
|
|
||||||
snake_case_symbol
|
|
||||||
my-module/my-fuction
|
|
||||||
*****
|
|
||||||
!%$^*__--__._+++===~-crazy-symbol
|
|
||||||
*global-var*
|
|
||||||
你好
|
|
||||||
```
|
|
||||||
|
|
||||||
## Keywords
|
|
||||||
|
|
||||||
Janet keywords are like symbols that begin with the character :. However, they
|
|
||||||
are used differently and treated by the compiler as a constant rather than a name for
|
|
||||||
something. Keywords are used mostly for keys in tables and structs, or pieces of syntax
|
|
||||||
in macros.
|
|
||||||
|
|
||||||
```
|
|
||||||
:keyword
|
|
||||||
:range
|
|
||||||
:0x0x0x0
|
|
||||||
:a-keyword
|
|
||||||
::
|
|
||||||
:
|
|
||||||
```
|
|
||||||
|
|
||||||
## Numbers
|
|
||||||
|
|
||||||
Janet numbers are represented by IEEE-754 floating point numbers.
|
|
||||||
The syntax is similar to that of many other languages
|
|
||||||
as well. Numbers can be written in base 10, with
|
|
||||||
underscores used to separate digits into groups. A decimal point can be used for floating
|
|
||||||
point numbers. Numbers can also be written in other bases by prefixing the number with the desired
|
|
||||||
base and the character 'r'. For example, 16 can be written as `16`, `1_6`, `16r10`, `4r100`, or `0x10`. The
|
|
||||||
`0x` prefix can be used for hexadecimal as it is so common. The radix must be themselves written in base 10, and
|
|
||||||
can be any integer from 2 to 36. For any radix above 10, use the letters as digits (not case sensitive).
|
|
||||||
|
|
||||||
```
|
|
||||||
0
|
|
||||||
12
|
|
||||||
-65912
|
|
||||||
4.98
|
|
||||||
1.3e18
|
|
||||||
1.3E18
|
|
||||||
18r123C
|
|
||||||
11raaa&a
|
|
||||||
1_000_000
|
|
||||||
0xbeef
|
|
||||||
```
|
|
||||||
|
|
||||||
## Strings
|
|
||||||
|
|
||||||
Strings in janet are surrounded by double quotes. Strings are 8bit clean, meaning
|
|
||||||
meaning they can contain any arbitrary sequence of bytes, including embedded
|
|
||||||
0s. To insert a double quote into a string itself, escape
|
|
||||||
the double quote with a backslash. For unprintable characters, you can either use
|
|
||||||
one of a few common escapes, use the `\xHH` escape to escape a single byte in
|
|
||||||
hexidecimal. The supported escapes are:
|
|
||||||
|
|
||||||
- \\xHH Escape a single arbitrary byte in hexidecimal.
|
|
||||||
- \\n Newline (ASCII 10)
|
|
||||||
- \\t Tab character (ASCII 9)
|
|
||||||
- \\r Carriage Return (ASCII 13)
|
|
||||||
- \\0 Null (ASCII 0)
|
|
||||||
- \\z Null (ASCII 0)
|
|
||||||
- \\f Form Feed (ASCII 12)
|
|
||||||
- \\e Escape (ASCII 27)
|
|
||||||
- \\" Double Quote (ASCII 34)
|
|
||||||
- \\\\ Backslash (ASCII 92)
|
|
||||||
|
|
||||||
Strings can also contain literal newline characters that will be ignore.
|
|
||||||
This lets one define a multiline string that does not contain newline characters.
|
|
||||||
|
|
||||||
An alternative way of representing strings in janet is the long string, or the backquote
|
|
||||||
delimited string. A string can also be define to start with a certain number of
|
|
||||||
backquotes, and will end the same number of backquotes. Long strings
|
|
||||||
do not contain escape sequences; all bytes will be parsed literally until
|
|
||||||
ending delimiter is found. This is useful
|
|
||||||
for defining multi-line strings with literal newline characters, unprintable
|
|
||||||
characters, or strings that would otherwise require many escape sequences.
|
|
||||||
|
|
||||||
```
|
|
||||||
"This is a string."
|
|
||||||
"This\nis\na\nstring."
|
|
||||||
"This
|
|
||||||
is
|
|
||||||
a
|
|
||||||
string."
|
|
||||||
``
|
|
||||||
This
|
|
||||||
is
|
|
||||||
a
|
|
||||||
string
|
|
||||||
``
|
|
||||||
```
|
|
||||||
|
|
||||||
## Buffers
|
|
||||||
|
|
||||||
Buffers are similar strings except they are mutable data structures. Strings in janet
|
|
||||||
cannot be mutated after created, where a buffer can be changed after creation.
|
|
||||||
The syntax for a buffer is the same as that for a string or long string, but
|
|
||||||
the buffer must be prefixed with the '@' character.
|
|
||||||
|
|
||||||
```
|
|
||||||
@""
|
|
||||||
@"Buffer."
|
|
||||||
@``Another buffer``
|
|
||||||
```
|
|
||||||
|
|
||||||
## Tuples
|
|
||||||
|
|
||||||
Tuples are a sequence of white space separated values surrounded by either parentheses
|
|
||||||
or brackets. The parser considers any of the characters ASCII 32, \\0, \\f, \\n, \\r or \\t
|
|
||||||
to be white-space.
|
|
||||||
|
|
||||||
```
|
|
||||||
(do 1 2 3)
|
|
||||||
[do 1 2 3]
|
|
||||||
```
|
|
||||||
|
|
||||||
## Arrays
|
|
||||||
|
|
||||||
Arrays are the same as tuples, but have a leading @ to indicate mutability.
|
|
||||||
|
|
||||||
```
|
|
||||||
@(:one :two :three)
|
|
||||||
@[:one :two :three]
|
|
||||||
```
|
|
||||||
|
|
||||||
## Structs
|
|
||||||
|
|
||||||
Structs are represented by a sequence of white-space delimited key value pairs
|
|
||||||
surrounded by curly braces. The sequence is defined as key1, value1, key2, value2, etc.
|
|
||||||
There must be an even number of items between curly braces or the parser will
|
|
||||||
signal a parse error. Any value can be a key or value. Using nil as a key or
|
|
||||||
value, however, will drop that pair from the parsed struct.
|
|
||||||
|
|
||||||
```
|
|
||||||
{}
|
|
||||||
{:key1 "value1" :key2 :value2 :key3 3}
|
|
||||||
{(1 2 3) (4 5 6)}
|
|
||||||
{@[] @[]}
|
|
||||||
{1 2 3 4 5 6}
|
|
||||||
```
|
|
||||||
## Tables
|
|
||||||
|
|
||||||
Table have the same syntax as structs, except they have the @ prefix to indicate
|
|
||||||
that they are mutable.
|
|
||||||
|
|
||||||
```
|
|
||||||
@{}
|
|
||||||
@{:key1 "value1" :key2 :value2 :key3 3}
|
|
||||||
@{(1 2 3) (4 5 6)}
|
|
||||||
@{@[] @[]}
|
|
||||||
@{1 2 3 4 5 6}
|
|
||||||
```
|
|
||||||
|
|
||||||
## Comments
|
|
||||||
|
|
||||||
Comments begin with a \# character and continue until the end of the line.
|
|
||||||
There are no multi-line comments.
|
|
||||||
|
|
||||||
## Shorthand
|
|
||||||
|
|
||||||
Often called reader macros in other lisps, Janet provides several shorthand
|
|
||||||
notations for some forms.
|
|
||||||
|
|
||||||
### 'x
|
|
||||||
|
|
||||||
Shorthand for `(quote x)`
|
|
||||||
|
|
||||||
### ;x
|
|
||||||
|
|
||||||
Shorthand for `(splice x)`
|
|
||||||
|
|
||||||
### ~x
|
|
||||||
|
|
||||||
Shorthand for `(quasiquote x)`
|
|
||||||
|
|
||||||
### ,x
|
|
||||||
|
|
||||||
Shorthand for `(unquote x)`
|
|
||||||
|
|
||||||
These shorthand notations can be combined in any order, allowing
|
|
||||||
forms like `''x` (`(quote (quote x))`), or `,;x` (`(unquote (splice x))`).
|
|
||||||
|
|
||||||
## API
|
|
||||||
|
|
||||||
The parser contains the following functions which exposes
|
|
||||||
the parser state machine as a janet abstract object.
|
|
||||||
|
|
||||||
- `parser/byte`
|
|
||||||
- `parser/consume`
|
|
||||||
- `parser/error`
|
|
||||||
- `parser/flush`
|
|
||||||
- `parser/new`
|
|
||||||
- `parser/produce`
|
|
||||||
- `parser/state`
|
|
||||||
- `parser/status`
|
|
||||||
- `parser/where`
|
|
||||||
206
doc/Specials.md
206
doc/Specials.md
@@ -1,206 +0,0 @@
|
|||||||
# Special Forms
|
|
||||||
|
|
||||||
Janet is a lisp and so is defined in terms of mostly S-expressions, or
|
|
||||||
in terms of Janet, tuples. Tuples are used to represent function calls, macros,
|
|
||||||
and special forms. Most functionality is exposed through functions, some
|
|
||||||
through macros, and a minimal amount through special forms. Special forms
|
|
||||||
are neither functions nor macros -- they are used by the compiler to directly
|
|
||||||
express a low level construct that can not be expressed through macros or functions.
|
|
||||||
Special forms can be thought of as forming the real 'core' language of janet.
|
|
||||||
|
|
||||||
Below is a reference for all of the special forms in Janet.
|
|
||||||
|
|
||||||
## (def name meta... value)
|
|
||||||
|
|
||||||
This special form binds a value to a symbol. The symbol can the be substituted
|
|
||||||
for the value in subsequent expression for the same result. A binding made by def
|
|
||||||
is a constant and cannot be updated. A symbol can be redefined to a new value, but previous
|
|
||||||
uses of the binding will refer to the previous value of the binding.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def anumber (+ 1 2 3 4 5))
|
|
||||||
|
|
||||||
(print anumber) # prints 15
|
|
||||||
```
|
|
||||||
|
|
||||||
Def can also take a tuple, array, table or struct to perform destructuring
|
|
||||||
on the value. This allows us to do multiple assignments in one def.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def [a b c] (range 10))
|
|
||||||
(print a " " b " " c) # prints 0 1 2
|
|
||||||
|
|
||||||
(def {:x x} @{:x (+ 1 2)})
|
|
||||||
(print x) # prints 3
|
|
||||||
|
|
||||||
(def [y {:x x}] @[:hi @{:x (+ 1 2)}])
|
|
||||||
(print y x) # prints hi3
|
|
||||||
```
|
|
||||||
|
|
||||||
Def can also append metadata and a docstring to the symbol when in the global scope.
|
|
||||||
If not in the global scope, the extra metadata will be ignored.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(def mydef :private 3) # Adds the :private key to the metadata table.
|
|
||||||
(def mydef2 :private "A docstring" 4) # Add a docstring
|
|
||||||
|
|
||||||
# The metadata will be ignored here because mydef is
|
|
||||||
# accessible outside of the do form.
|
|
||||||
(do
|
|
||||||
(def mydef :private 3)
|
|
||||||
(+ mydef 1))
|
|
||||||
```
|
|
||||||
|
|
||||||
## (var name meta... value)
|
|
||||||
|
|
||||||
Similar to def, but bindings set in this manner can be updated using set. In all other respects is the
|
|
||||||
same as def.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(var a 1)
|
|
||||||
(defn printa [] (print a))
|
|
||||||
|
|
||||||
(printa) # prints 1
|
|
||||||
(++ a)
|
|
||||||
(printa) # prints 2
|
|
||||||
(set a :hi)
|
|
||||||
(printa) # prints hi
|
|
||||||
```
|
|
||||||
|
|
||||||
## (fn name? args body...)
|
|
||||||
|
|
||||||
Compile a function literal (closure). A function literal consists of an optional name, an
|
|
||||||
argument list, and a function body. The optional name is allowed so that functions can
|
|
||||||
more easily be recursive. The argument list is a tuple of named parameters, and the body
|
|
||||||
is 0 or more forms. The function will evaluate to the last form in the body. The other forms
|
|
||||||
will only be evaluated for side effects.
|
|
||||||
|
|
||||||
Functions also introduced a new lexical scope, meaning the defs and vars inside a function
|
|
||||||
body will not escape outside the body.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(fn []) # The simplest function literal. Takes no arguments and returns nil.
|
|
||||||
(fn [x] x) # The identity function
|
|
||||||
(fn identity [x] x) # The identity function - the name will also make stacktraces nicer.
|
|
||||||
(fn [] 1 2 3 4 5) # A function that returns 5
|
|
||||||
(fn [x y] (+ x y)) # A function that adds its two arguments.
|
|
||||||
|
|
||||||
(fn [& args] (length args)) # A variadic function that counts its arguments.
|
|
||||||
|
|
||||||
# A function that doesn't strictly check the number of arguments.
|
|
||||||
# Extra arguments are ignored, and arguments not passed are nil.
|
|
||||||
(fn [w x y z &] (tuple w w x x y y z z))
|
|
||||||
```
|
|
||||||
|
|
||||||
## (do body...)
|
|
||||||
|
|
||||||
Execute a series of forms for side effects and evaluates to the final form. Also
|
|
||||||
introduces a new lexical scope without creating or calling a function.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(do 1 2 3 4) # Evaluates to 4
|
|
||||||
|
|
||||||
# Prints 1, 2 and 3, then evaluates to (print 3), which is nil
|
|
||||||
(do (print 1) (print 2) (print 3))
|
|
||||||
|
|
||||||
# Prints 1
|
|
||||||
(do
|
|
||||||
(def a 1)
|
|
||||||
(print a))
|
|
||||||
|
|
||||||
# a is not defined here, so fails
|
|
||||||
a
|
|
||||||
```
|
|
||||||
|
|
||||||
## (quote x)
|
|
||||||
|
|
||||||
Evaluates to the literal value of the first argument. The argument is not compiled
|
|
||||||
and is simply used as a constant value in the compiled code. Preceding a form with a
|
|
||||||
single quote is shorthand for `(quote expression)`.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(quote 1) # evaluates to 1
|
|
||||||
(quote hi) # evaluates to the symbol hi
|
|
||||||
(quote quote) # evaluates to the symbol quote
|
|
||||||
|
|
||||||
`(1 2 3) # Evaluates to a tuple (1 2 3)
|
|
||||||
`(print 1 2 3) # Evaluates to a tuple (print 1 2 3)
|
|
||||||
```
|
|
||||||
|
|
||||||
## (if condition when-true when-false?)
|
|
||||||
|
|
||||||
Introduce a branching construct. The first form is the condition, the second
|
|
||||||
form is the form to evaluate when the condition is true, and the optional
|
|
||||||
third form is the form to evaluate when the condition is false. If no third
|
|
||||||
form is provided it defaults to nil.
|
|
||||||
|
|
||||||
The if special form will not evaluate the when-true or when-false forms unless
|
|
||||||
it needs to - it is a lazy form, which is why it cannot be a function or macro.
|
|
||||||
|
|
||||||
The condition is considered false only if it evaluates to nil or false - all other values
|
|
||||||
are considered true.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(if true 10) # evaluates to 10
|
|
||||||
(if false 10) # evaluates to nil
|
|
||||||
(if true (print 1) (print 2)) # prints 1 but not 2
|
|
||||||
```
|
|
||||||
|
|
||||||
## (splice x)
|
|
||||||
|
|
||||||
The splice special form is an interesting form that doesn't have an analog in most lisps.
|
|
||||||
It only has an effect in two places - as an argument in a function call, or as the argument
|
|
||||||
to the unquote form. Outside of these two settings, the splice special form simply evaluates
|
|
||||||
directly to it's argument x. The shorthand for splice is prefixing a form with a semicolon.
|
|
||||||
|
|
||||||
In the context of a function call, splice will insert *the contents* of x in the parameter list.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(+ 1 2 3) # evaluates to 6
|
|
||||||
|
|
||||||
(+ @[1 2 3]) # bad
|
|
||||||
|
|
||||||
(+ (splice @[1 2 3])) # also evaluates to 6
|
|
||||||
|
|
||||||
(+ ;@[1 2 3]) # Same as above
|
|
||||||
|
|
||||||
(+ ;(range 100)) # Sum the first 100 natural numbers
|
|
||||||
|
|
||||||
(+ ;(range 100) 1000) # Sum the first 100 natural numbers and 1000
|
|
||||||
```
|
|
||||||
|
|
||||||
Notice that this means we rarely will need the `apply` function, as the splice operator is more flexible.
|
|
||||||
|
|
||||||
The splice operator can also be used inside an unquote form, where it will behave like
|
|
||||||
an `unquote-splicing` special in other lisps.
|
|
||||||
|
|
||||||
## (while condition body...)
|
|
||||||
|
|
||||||
The while special form compiles to a C-like while loop. The body of the form will be continuously evaluated
|
|
||||||
until the condition is false or nil. Therefor, it is expected that the body will contain some side effects
|
|
||||||
of the loop will go on for ever. The while loop always evaluates to nil.
|
|
||||||
|
|
||||||
```lisp
|
|
||||||
(var i 0)
|
|
||||||
(while (< i 10)
|
|
||||||
(print i)
|
|
||||||
(++ i))
|
|
||||||
```
|
|
||||||
|
|
||||||
## (set l-value r-value)
|
|
||||||
|
|
||||||
Update the value of a var l-value to a new value r-value. The set special form will then evaluate to r-value.
|
|
||||||
|
|
||||||
The r-value can be any expression, and the l-value should be a bound var.
|
|
||||||
|
|
||||||
## (quasiquote x)
|
|
||||||
|
|
||||||
Similar to `(quote x)`, but allows for unquoting within x. This makes quasiquote useful for
|
|
||||||
writing macros, as a macro definition often generates a lot of templated code with a
|
|
||||||
few custom values. The shorthand for quasiquote is a leading tilde `~` before a form. With
|
|
||||||
that form, `(unquote x)` will evaluate and insert x into the unquote form. The shorthand for
|
|
||||||
`(unquote x)` is `,x`.
|
|
||||||
|
|
||||||
## (unquote x)
|
|
||||||
|
|
||||||
Unquote a form within a quasiquote. Outside of a quasiquote, unquote is invalid.
|
|
||||||
@@ -1,224 +0,0 @@
|
|||||||
The Janet language is implemented on top of an abstract machine (AM). The compiler
|
|
||||||
converts Janet data structures to this bytecode, which can then be efficiently executed
|
|
||||||
from inside a C program. To understand the janet bytecode, it is useful to understand
|
|
||||||
the abstractions used inside the Janet AM, as well as the C types used to implement these
|
|
||||||
features.
|
|
||||||
|
|
||||||
## The Stack = The Fiber
|
|
||||||
|
|
||||||
A Janet Fiber is the type used to represent multiple concurrent processes
|
|
||||||
in janet. It is basically a wrapper around the idea of a stack. The stack is
|
|
||||||
divided into a number of stack frames (`JanetStackFrame *` in C), each of which
|
|
||||||
contains information such as the function that created the stack frame,
|
|
||||||
the program counter for the stack frame, a pointer to the previous frame,
|
|
||||||
and the size of the frame. Each stack frame also is paired with a number
|
|
||||||
registers.
|
|
||||||
|
|
||||||
```
|
|
||||||
X: Slot
|
|
||||||
|
|
||||||
X
|
|
||||||
X - Stack Top, for next function call.
|
|
||||||
-----
|
|
||||||
Frame next
|
|
||||||
-----
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X - Stack 0
|
|
||||||
-----
|
|
||||||
Frame 0
|
|
||||||
-----
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X - Stack -1
|
|
||||||
-----
|
|
||||||
Frame -1
|
|
||||||
-----
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X
|
|
||||||
X - Stack -2
|
|
||||||
-----
|
|
||||||
Frame -2
|
|
||||||
-----
|
|
||||||
...
|
|
||||||
...
|
|
||||||
...
|
|
||||||
-----
|
|
||||||
Bottom of stack
|
|
||||||
```
|
|
||||||
|
|
||||||
Fibers also have an incomplete stack frame for the next function call on top
|
|
||||||
of their stacks. Making a function call involves pushing arguments to this
|
|
||||||
temporary stack, and then invoking either the CALL or TCALL instructions.
|
|
||||||
Arguments for the next function call are pushed via the PUSH, PUSH2, PUSH3, and
|
|
||||||
PUSHA instructions. The stack of a fiber will grow as large as needed, although by
|
|
||||||
default janet will limit the maximum size of a fiber's stack.
|
|
||||||
The maximum stack size can be modified on a per fiber basis.
|
|
||||||
|
|
||||||
The slots in the stack are exposed as virtual registers to instructions. They
|
|
||||||
can hold any Janet value.
|
|
||||||
|
|
||||||
## Closures
|
|
||||||
|
|
||||||
All functions in janet are closures; they combine some bytecode instructions
|
|
||||||
with 0 or more environments. In the C source, a closure (hereby the same as
|
|
||||||
a function) is represented by the type `JanetFunction *`. The bytecode instruction
|
|
||||||
part of the function is represented by `JanetFuncDef *`, and a function environment
|
|
||||||
is represented with `JanetFuncEnv *`.
|
|
||||||
|
|
||||||
The function definition part of a function (the 'bytecode' part, `JanetFuncDef *`),
|
|
||||||
we also store various metadata about the function which is useful for debugging,
|
|
||||||
as well as constants referenced by the function.
|
|
||||||
|
|
||||||
## C Functions
|
|
||||||
|
|
||||||
Janet uses C functions to bridge to native code. A C function
|
|
||||||
(`JanetCFunction *` in C) is a C function pointer that can be called like
|
|
||||||
a normal janet closure. From the perspective of the bytecode instruction set, there is no difference
|
|
||||||
in invoking a C function and invoking a normal janet function.
|
|
||||||
|
|
||||||
## Bytecode Format
|
|
||||||
|
|
||||||
Janet bytecode presents an interface to a virtual machine with a large number
|
|
||||||
of identical registers that can hold any Janet value (`Janet *` in C). Most instructions
|
|
||||||
have a destination register, and 1 or 2 source register. Registers are simply
|
|
||||||
named with positive integers.
|
|
||||||
|
|
||||||
Each instruction is a 32 bit integer, meaning that the instruction set is a constant
|
|
||||||
width RISC instruction set like MIPS. The opcode of each instruction is the least significant
|
|
||||||
byte of the instruction. The highest bit of
|
|
||||||
this leading byte is reserved for debugging purpose, so there are 128 possible opcodes encodable
|
|
||||||
with this scheme. Not all of these possible opcode are defined, and will trap the interpreter
|
|
||||||
and emit a debug signal. Note that this mean an unknown opcode is still valid bytecode, it will
|
|
||||||
just put the interpreter into a debug state when executed.
|
|
||||||
|
|
||||||
```
|
|
||||||
X - Payload bits
|
|
||||||
O - Opcode bits
|
|
||||||
|
|
||||||
4 3 2 1
|
|
||||||
+----+----+----+----+
|
|
||||||
| XX | XX | XX | OO |
|
|
||||||
+----+----+----+----+
|
|
||||||
```
|
|
||||||
|
|
||||||
8 bits for the opcode leaves 24 bits for the payload, which may or may not be utilized.
|
|
||||||
There are a few instruction variants that divide these payload bits.
|
|
||||||
|
|
||||||
* 0 arg - Used for noops, returning nil, or other instructions that take no
|
|
||||||
arguments. The payload is essentially ignored.
|
|
||||||
* 1 arg - All payload bits correspond to a single value, usually a signed or unsigned integer.
|
|
||||||
Used for instructions of 1 argument, like returning a value, yielding a value to the parent fiber,
|
|
||||||
or doing a (relative) jump.
|
|
||||||
* 2 arg - Payload is split into byte 2 and bytes 3 and 4.
|
|
||||||
The first argument is the 8 bit value from byte 2, and the second argument is the 16 bit value
|
|
||||||
from bytes 3 and 4 (`instruction >> 16`). Used for instructions of two arguments, like move, normal
|
|
||||||
function calls, conditionals, etc.
|
|
||||||
* 3 arg - Bytes 2, 3, and 4 each correspond to an 8 bit argument.
|
|
||||||
Used for arithmetic operations, emitting a signal, etc.
|
|
||||||
|
|
||||||
These instruction variants can be further refined based on the semantics of the arguments.
|
|
||||||
Some instructions may treat an argument as a slot index, while other instructions
|
|
||||||
will treat the argument as a signed integer literal, and index for a constant, an index
|
|
||||||
for an environment, or an unsigned integer.
|
|
||||||
|
|
||||||
## Instruction Reference
|
|
||||||
|
|
||||||
A listing of all opcode values can be found in src/include/janet/janetopcodes.h. The janet assembly
|
|
||||||
short names can be found src/assembler/asm.c. In this document, we will refer to the instructions
|
|
||||||
by their short names as presented to the assembler rather than their numerical values.
|
|
||||||
|
|
||||||
Each instruction is also listed with a signature, which are the arguments the instruction
|
|
||||||
expects. There are a handful of instruction signatures, which combine the arity and type
|
|
||||||
of the instruction. The assembler does not
|
|
||||||
do any type-checking per closure, but does prevent jumping to invalid instructions and
|
|
||||||
failure to return or error.
|
|
||||||
|
|
||||||
### Notation
|
|
||||||
|
|
||||||
* The $ prefix indicates that a instruction parameter is acting as a virtual register (slot).
|
|
||||||
If a parameter does not have the $ suffix in the description, it is acting as some kind
|
|
||||||
of literal (usually an unsigned integer for indexes, and a signed integer for literal integers).
|
|
||||||
|
|
||||||
* Some operators in the description have the suffix 'i' or 'r'. These indicate
|
|
||||||
that these operators correspond to integers or real numbers only, respectively. All
|
|
||||||
bit-wise operators and bit shifts only work with integers.
|
|
||||||
|
|
||||||
* The `>>>` indicates unsigned right shift, as in Java. Because all integers in janet are
|
|
||||||
signed, we differentiate the two kinds of right bit shift.
|
|
||||||
|
|
||||||
* The 'im' suffix in the instruction name is short for immediate.
|
|
||||||
|
|
||||||
### Reference Table
|
|
||||||
|
|
||||||
| Instruction | Signature | Description |
|
|
||||||
| ----------- | --------------------------- | --------------------------------- |
|
|
||||||
| `add` | `(add dest lhs rhs)` | $dest = $lhs + $rhs |
|
|
||||||
| `addim` | `(addim dest lhs im)` | $dest = $lhs + im |
|
|
||||||
| `band` | `(band dest lhs rhs)` | $dest = $lhs & $rhs |
|
|
||||||
| `bnot` | `(bnot dest operand)` | $dest = ~$operand |
|
|
||||||
| `bor` | `(bor dest lhs rhs)` | $dest = $lhs | $rhs |
|
|
||||||
| `bxor` | `(bxor dest lhs rhs)` | $dest = $lhs ^ $rhs |
|
|
||||||
| `call` | `(call dest callee)` | $dest = call($callee, args) |
|
|
||||||
| `clo` | `(clo dest index)` | $dest = closure(defs[$index]) |
|
|
||||||
| `cmp` | `(cmp dest lhs rhs)` | $dest = janet\_compare($lhs, $rhs)|
|
|
||||||
| `div` | `(div dest lhs rhs)` | $dest = $lhs / $rhs |
|
|
||||||
| `divim` | `(divim dest lhs im)` | $dest = $lhs / im |
|
|
||||||
| `eq` | `(eq dest lhs rhs)` | $dest = $lhs == $rhs |
|
|
||||||
| `eqim` | `(eqim dest lhs im)` | $dest = $lhs == im |
|
|
||||||
| `err` | `(err message)` | Throw error $message. |
|
|
||||||
| `get` | `(get dest ds key)` | $dest = $ds[$key] |
|
|
||||||
| `geti` | `(geti dest ds index)` | $dest = $ds[index] |
|
|
||||||
| `gt` | `(gt dest lhs rhs)` | $dest = $lhs \> $rhs |
|
|
||||||
| `gtim` | `(gtim dest lhs im)` | $dest = $lhs \> im |
|
|
||||||
| `jmp` | `(jmp label)` | pc = label, pc += offset |
|
|
||||||
| `jmpif` | `(jmpif cond label)` | if $cond pc = label else pc++ |
|
|
||||||
| `jmpno` | `(jmpno cond label)` | if $cond pc++ else pc = label |
|
|
||||||
| `ldc` | `(ldc dest index)` | $dest = constants[index] |
|
|
||||||
| `ldf` | `(ldf dest)` | $dest = false |
|
|
||||||
| `ldi` | `(ldi dest integer)` | $dest = integer |
|
|
||||||
| `ldn` | `(ldn dest)` | $dest = nil |
|
|
||||||
| `lds` | `(lds dest)` | $dest = current closure (self) |
|
|
||||||
| `ldt` | `(ldt dest)` | $dest = true |
|
|
||||||
| `ldu` | `(ldu dest env index)` | $dest = envs[env][index] |
|
|
||||||
| `len` | `(len dest ds)` | $dest = length(ds) |
|
|
||||||
| `lt` | `(lt dest lhs rhs)` | $dest = $lhs \< $rhs |
|
|
||||||
| `ltim` | `(ltim dest lhs im)` | $dest = $lhs \< im |
|
|
||||||
| `mkarr` | `(mkarr dest)` | $dest = call(array, args) |
|
|
||||||
| `mkbuf` | `(mkbuf dest)` | $dest = call(buffer, args) |
|
|
||||||
| `mktab` | `(mktab dest)` | $dest = call(table, args) |
|
|
||||||
| `mkstr` | `(mkstr dest)` | $dest = call(string, args) |
|
|
||||||
| `mkstu` | `(mkstu dest)` | $dest = call(struct, args) |
|
|
||||||
| `mktup` | `(mktup dest)` | $dest = call(tuple, args) |
|
|
||||||
| `movf` | `(movf src dest)` | $dest = $src |
|
|
||||||
| `movn` | `(movn dest src)` | $dest = $src |
|
|
||||||
| `mul` | `(mul dest lhs rhs)` | $dest = $lhs \* $rhs |
|
|
||||||
| `mulim` | `(mulim dest lhs im)` | $dest = $lhs \* im |
|
|
||||||
| `noop` | `(noop)` | Does nothing. |
|
|
||||||
| `push` | `(push val)` | Push $val on arg |
|
|
||||||
| `push2` | `(push2 val1 val3)` | Push $val1, $val2 on args |
|
|
||||||
| `push3` | `(push3 val1 val2 val3)` | Push $val1, $val2, $val3, on args |
|
|
||||||
| `pusha` | `(pusha array)` | Push values in $array on args |
|
|
||||||
| `put` | `(put ds key val)` | $ds[$key] = $val |
|
|
||||||
| `puti` | `(puti ds index val)` | $ds[index] = $val |
|
|
||||||
| `res` | `(res dest fiber val)` | $dest = resume $fiber with $val |
|
|
||||||
| `ret` | `(ret val)` | Return $val |
|
|
||||||
| `retn` | `(retn)` | Return nil |
|
|
||||||
| `setu` | `(setu env index val)` | envs[env][index] = $val |
|
|
||||||
| `sig` | `(sig dest value sigtype)` | $dest = emit $value as sigtype |
|
|
||||||
| `sl` | `(sl dest lhs rhs)` | $dest = $lhs << $rhs |
|
|
||||||
| `slim` | `(slim dest lhs shamt)` | $dest = $lhs << shamt |
|
|
||||||
| `sr` | `(sr dest lhs rhs)` | $dest = $lhs >> $rhs |
|
|
||||||
| `srim` | `(srim dest lhs shamt)` | $dest = $lhs >> shamt |
|
|
||||||
| `sru` | `(sru dest lhs rhs)` | $dest = $lhs >>> $rhs |
|
|
||||||
| `sruim` | `(sruim dest lhs shamt)` | $dest = $lhs >>> shamt |
|
|
||||||
| `sub` | `(sub dest lhs rhs)` | $dest = $lhs - $rhs |
|
|
||||||
| `tcall` | `(tcall callee)` | Return call($callee, args) |
|
|
||||||
| `tchck` | `(tcheck slot types)` | Assert $slot does matches types |
|
|
||||||
|
|
||||||
@@ -4,11 +4,11 @@
|
|||||||
(seq [x :range [-1 2]
|
(seq [x :range [-1 2]
|
||||||
y :range [-1 2]
|
y :range [-1 2]
|
||||||
:when (not (and (zero? x) (zero? y)))]
|
:when (not (and (zero? x) (zero? y)))]
|
||||||
(tuple x y)))
|
[x y]))
|
||||||
|
|
||||||
(defn- neighbors
|
(defn- neighbors
|
||||||
[[x y]]
|
[[x y]]
|
||||||
(map (fn [[x1 y1]] (tuple (+ x x1) (+ y y1))) window))
|
(map (fn [[x1 y1]] [(+ x x1) (+ y y1)]) window))
|
||||||
|
|
||||||
(defn tick
|
(defn tick
|
||||||
"Get the next state in the Game Of Life."
|
"Get the next state in the Game Of Life."
|
||||||
@@ -28,7 +28,7 @@
|
|||||||
(loop [x :range [x1 (+ 1 x2)]
|
(loop [x :range [x1 (+ 1 x2)]
|
||||||
:after (print)
|
:after (print)
|
||||||
y :range [y1 (+ 1 y2)]]
|
y :range [y1 (+ 1 y2)]]
|
||||||
(file/write stdout (if (get cellset (tuple x y)) "X " ". ")))
|
(file/write stdout (if (get cellset [x y]) "X " ". ")))
|
||||||
(print))
|
(print))
|
||||||
|
|
||||||
#
|
#
|
||||||
|
|||||||
1
examples/numarray/.gitignore
vendored
Normal file
1
examples/numarray/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
/build
|
||||||
23
examples/numarray/build.janet
Normal file
23
examples/numarray/build.janet
Normal file
@@ -0,0 +1,23 @@
|
|||||||
|
(import cook)
|
||||||
|
|
||||||
|
(cook/make-native
|
||||||
|
:name "numarray"
|
||||||
|
:source @["numarray.c"])
|
||||||
|
|
||||||
|
(import build/numarray :prefix "")
|
||||||
|
|
||||||
|
(def a (numarray/new 30))
|
||||||
|
(print (get a 20))
|
||||||
|
(print (a 20))
|
||||||
|
|
||||||
|
(put a 5 3.14)
|
||||||
|
(print (a 5))
|
||||||
|
(set (a 5) 100)
|
||||||
|
(print (a 5))
|
||||||
|
|
||||||
|
# (numarray/scale a 5))
|
||||||
|
# ((a :scale) a 5)
|
||||||
|
(:scale a 5)
|
||||||
|
(for i 0 10 (print (a i)))
|
||||||
|
|
||||||
|
(print "sum=" (:sum a))
|
||||||
117
examples/numarray/numarray.c
Normal file
117
examples/numarray/numarray.c
Normal file
@@ -0,0 +1,117 @@
|
|||||||
|
#include <stdlib.h>
|
||||||
|
#include <janet.h>
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
double *data;
|
||||||
|
size_t size;
|
||||||
|
} num_array;
|
||||||
|
|
||||||
|
static num_array *num_array_init(num_array *array, size_t size) {
|
||||||
|
array->data = (double *)calloc(size, sizeof(double));
|
||||||
|
array->size = size;
|
||||||
|
return array;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void num_array_deinit(num_array *array) {
|
||||||
|
free(array->data);
|
||||||
|
}
|
||||||
|
|
||||||
|
static int num_array_gc(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
num_array *array = (num_array *)p;
|
||||||
|
num_array_deinit(array);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
Janet num_array_get(void *p, Janet key);
|
||||||
|
void num_array_put(void *p, Janet key, Janet value);
|
||||||
|
|
||||||
|
static const JanetAbstractType num_array_type = {
|
||||||
|
"numarray",
|
||||||
|
num_array_gc,
|
||||||
|
NULL,
|
||||||
|
num_array_get,
|
||||||
|
num_array_put
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet num_array_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
int32_t size = janet_getinteger(argv, 0);
|
||||||
|
num_array *array = (num_array *)janet_abstract(&num_array_type, sizeof(num_array));
|
||||||
|
num_array_init(array, size);
|
||||||
|
return janet_wrap_abstract(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet num_array_scale(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
||||||
|
double factor = janet_getnumber(argv, 1);
|
||||||
|
size_t i;
|
||||||
|
for (i = 0; i < array->size; i++) {
|
||||||
|
array->data[i] *= factor;
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet num_array_sum(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
num_array *array = (num_array *)janet_getabstract(argv, 0, &num_array_type);
|
||||||
|
double sum = 0;
|
||||||
|
for (size_t i = 0; i < array->size; i++) sum += array->data[i];
|
||||||
|
return janet_wrap_number(sum);
|
||||||
|
}
|
||||||
|
|
||||||
|
void num_array_put(void *p, Janet key, Janet value) {
|
||||||
|
size_t index;
|
||||||
|
num_array *array = (num_array *)p;
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
if (!janet_checktype(value, JANET_NUMBER))
|
||||||
|
janet_panic("expected number value");
|
||||||
|
|
||||||
|
index = (size_t)janet_unwrap_integer(key);
|
||||||
|
if (index < array->size) {
|
||||||
|
array->data[index] = janet_unwrap_number(value);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetMethod methods[] = {
|
||||||
|
{"scale", num_array_scale},
|
||||||
|
{"sum", num_array_sum},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
Janet num_array_get(void *p, Janet key) {
|
||||||
|
size_t index;
|
||||||
|
Janet value;
|
||||||
|
num_array *array = (num_array *)p;
|
||||||
|
if (janet_checktype(key, JANET_KEYWORD))
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), methods);
|
||||||
|
if (!janet_checkint(key))
|
||||||
|
janet_panic("expected integer key");
|
||||||
|
index = (size_t)janet_unwrap_integer(key);
|
||||||
|
if (index >= array->size) {
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
} else {
|
||||||
|
value = janet_wrap_number(array->data[index]);
|
||||||
|
}
|
||||||
|
return value;
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg cfuns[] = {
|
||||||
|
{
|
||||||
|
"numarray/new", num_array_new,
|
||||||
|
"(numarray/new size)\n\n"
|
||||||
|
"Create new numarray"
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"numarray/scale", num_array_scale,
|
||||||
|
"(numarray/scale numarray factor)\n\n"
|
||||||
|
"scale numarray by factor"
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||||
|
janet_cfuns(env, "numarray", cfuns);
|
||||||
|
}
|
||||||
83
examples/tarray.janet
Normal file
83
examples/tarray.janet
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
# naive matrix implementation for testing typed array
|
||||||
|
|
||||||
|
(defmacro printf [& xs] ['print ['string/format (splice xs)]])
|
||||||
|
|
||||||
|
(defn matrix [nrow ncol] {:nrow nrow :ncol ncol :array (tarray/new :float64 (* nrow ncol))})
|
||||||
|
|
||||||
|
(defn matrix/row [mat i]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 ncol 1 (* i ncol) array))
|
||||||
|
|
||||||
|
(defn matrix/column [mat j]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(tarray/new :float64 nrow ncol j array))
|
||||||
|
|
||||||
|
(defn matrix/set [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(set (array (+ (* i ncol) j)) value))
|
||||||
|
|
||||||
|
(defn matrix/get [mat i j value]
|
||||||
|
(def {:nrow nrow :ncol ncol :array array} mat)
|
||||||
|
(array (+ (* i ncol) j)))
|
||||||
|
|
||||||
|
|
||||||
|
# other variants to test rows and cols views
|
||||||
|
|
||||||
|
(defn matrix/set* [mat i j value]
|
||||||
|
(set ((matrix/row mat i) j) value))
|
||||||
|
|
||||||
|
(defn matrix/set** [mat i j value]
|
||||||
|
(set ((matrix/column mat j) i) value))
|
||||||
|
|
||||||
|
|
||||||
|
(defn matrix/get* [mat i j value]
|
||||||
|
((matrix/row mat i) j))
|
||||||
|
|
||||||
|
(defn matrix/get** [mat i j value]
|
||||||
|
((matrix/column j) i))
|
||||||
|
|
||||||
|
|
||||||
|
(defn tarray/print [array]
|
||||||
|
(def size (tarray/length array))
|
||||||
|
(def buf @"")
|
||||||
|
(buffer/format buf "[%2i]" size)
|
||||||
|
(for i 0 size
|
||||||
|
(buffer/format buf " %+6.3f " (array i)))
|
||||||
|
(print buf))
|
||||||
|
|
||||||
|
(defn matrix/print [mat]
|
||||||
|
(def {:nrow nrow :ncol ncol :array tarray} mat)
|
||||||
|
(printf "matrix %iX%i %p" nrow ncol tarray)
|
||||||
|
(for i 0 nrow
|
||||||
|
(tarray/print (matrix/row mat i))))
|
||||||
|
|
||||||
|
|
||||||
|
(def nr 5)
|
||||||
|
(def nc 4)
|
||||||
|
(def A (matrix nr nc))
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set* A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
(loop (i :range (0 nr) j :range (0 nc))
|
||||||
|
(matrix/set** A i j i))
|
||||||
|
(matrix/print A)
|
||||||
|
|
||||||
|
|
||||||
|
(printf "properties:\n%p" (tarray/properties (A :array)))
|
||||||
|
(for i 0 nr
|
||||||
|
(printf "row properties:[%i]\n%p" i (tarray/properties (matrix/row A i))))
|
||||||
|
(for i 0 nc
|
||||||
|
(printf "col properties:[%i]\n%p" i (tarray/properties (matrix/column A i))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@@ -1,335 +0,0 @@
|
|||||||
<?xml version="1.0" encoding="UTF-8"?>
|
|
||||||
<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
|
|
||||||
<plist version="1.0">
|
|
||||||
<dict>
|
|
||||||
<key>fileTypes</key>
|
|
||||||
<array>
|
|
||||||
<string>janet</string>
|
|
||||||
</array>
|
|
||||||
<key>foldingStartMarker</key>
|
|
||||||
<string>\{</string>
|
|
||||||
<key>foldingStopMarker</key>
|
|
||||||
<string>\}</string>
|
|
||||||
<key>foldingStartMarker</key>
|
|
||||||
<string>\[</string>
|
|
||||||
<key>foldingStopMarker</key>
|
|
||||||
<string>\]</string>
|
|
||||||
<key>foldingStartMarker</key>
|
|
||||||
<string>\(</string>
|
|
||||||
<key>foldingStopMarker</key>
|
|
||||||
<string>\)</string>
|
|
||||||
<key>keyEquivalent</key>
|
|
||||||
<string>^~L</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>Janet</string>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#all</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
<key>repository</key>
|
|
||||||
<dict>
|
|
||||||
<key>all</key>
|
|
||||||
<dict>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#comment</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#parens</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#brackets</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#braces</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#readermac</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#string</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#longstring</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#literal</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#corelib</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#r-number</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#dec-number</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#hex-number</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#keysym</string>
|
|
||||||
</dict>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#symbol</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
</dict>
|
|
||||||
<key>comment</key>
|
|
||||||
<dict>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.comment.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(#).*$</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>comment.line.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>braces</key>
|
|
||||||
<dict>
|
|
||||||
<key>begin</key>
|
|
||||||
<string>(@?{)</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.braces.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>end</key>
|
|
||||||
<string>(})</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.braces.end.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#all</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
</dict>
|
|
||||||
<key>brackets</key>
|
|
||||||
<dict>
|
|
||||||
<key>begin</key>
|
|
||||||
<string>(@?\[)</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.brackets.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>end</key>
|
|
||||||
<string>(\])</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.brackets.end.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#all</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
</dict>
|
|
||||||
<key>parens</key>
|
|
||||||
<dict>
|
|
||||||
<key>begin</key>
|
|
||||||
<string>(@?\()</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.parens.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>end</key>
|
|
||||||
<string>(\))</string>
|
|
||||||
<key>captures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.parens.end.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>include</key>
|
|
||||||
<string>#all</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
</dict>
|
|
||||||
<key>readermac</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>[\'\~\;\,]</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.other.janet</string>
|
|
||||||
</dict>
|
|
||||||
<!-- string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*]) token match here (?![\.:\w_\-=!@\$%^&?|\\/<>*])</string -->
|
|
||||||
<key>literal</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(true|false|nil)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.language.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>corelib</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])(%|%=|\*|\*=|\*doc\-width\*|\*env\*|\+|\+\+|\+=|\-|\-\-|\-=|\->|\->>|\-\?>|\-\?>>|/|/=|<|<=|=|==|>|>=|_env|abstract\?|all|all\-symbols|allsyms|and|apply|array|array/concat|array/ensure|array/insert|array/new|array/peek|array/pop|array/push|array/slice|array\?|as\->|as\?\->|asm|band|blshift|bnot|boolean\?|bor|brshift|brushift|buffer|buffer/clear|buffer/new|buffer/popn|buffer/push\-byte|buffer/push\-string|buffer/push\-word|buffer/slice|buffer\?|bxor|bytes\?|callable\?|case|cfunction\?|comment|comp|compile|complement|cond|coro|count|debug|debug/arg\-stack|debug/break|debug/fbreak|debug/lineage|debug/stack|debug/unbreak|debug/unfbreak|dec|deep\-not=|deep=|def\-|default|defglobal|defmacro|defmacro\-|defn|defn\-|describe|dictionary\?|disasm|distinct|doc|doc\*|doc\-format|drop\-until|drop\-while|each|empty\?|env\-lookup|error|eval|eval\-string|even\?|every\?|extreme|false\?|fiber/current|fiber/maxstack|fiber/new|fiber/setmaxstack|fiber/status|fiber\?|file/close|file/flush|file/open|file/popen|file/read|file/seek|file/write|filter|find|find\-index|first|flatten|flatten\-into|for|frequencies|function\?|gccollect|gcinterval|gcsetinterval|generate|gensym|get|getline|hash|idempotent\?|identity|if\-let|if\-not|import|import\*|inc|indexed\?|interleave|interpose|invert|janet/build|janet/version|juxt|juxt\*|keep|keys|keyword|keyword\?|kvs|last|length|let|loop|macex|macex1|make\-env|map|mapcat|marshal|match|match\-1|math/acos|math/asin|math/atan|math/ceil|math/cos|math/e|math/exp|math/floor|math/inf|math/log|math/log10|math/pi|math/pow|math/random|math/seedrandom|math/sin|math/sqrt|math/tan|max|max\-order|merge|merge\-into|min|min\-order|module/find|module/native\-paths|module/paths|native|neg\?|next|nil\?|not|not=|not==|number\?|odd\?|one\?|or|order<|order<=|order>|order>=|os/clock|os/cwd|os/execute|os/exit|os/getenv|os/setenv|os/shell|os/sleep|os/time|os/which|pairs|parser/byte|parser/consume|parser/error|parser/flush|parser/has\-more|parser/new|parser/produce|parser/state|parser/status|parser/where|partial|pos\?|postwalk|prewalk|print|process/args|product|put|range|reduce|repl|require|resume|reverse|run\-context|scan\-number|sentinel|seq|some|sort|sorted|status\-pp|stderr|stdin|stdout|string|string/ascii\-lower|string/ascii\-upper|string/bytes|string/check\-set|string/find|string/find\-all|string/from\-bytes|string/join|string/number|string/pretty|string/repeat|string/replace|string/replace\-all|string/reverse|string/slice|string/split|string\?|struct|struct\?|sum|symbol|symbol\?|table|table/getproto|table/new|table/rawget|table/setproto|table/to\-struct|table\?|take\-until|take\-while|true\?|try|tuple|tuple/append|tuple/prepend|tuple/slice|tuple\?|type|unless|unmarshal|update|values|varglobal|walk|when|when\-let|with\-idemp|yield|zero\?|zipcoll)(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>keyword.control.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>keysym</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*]):[\.:\w_\-=!@\$%^&?|\\/<>*]*</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.keyword.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>symbol</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[\.a-zA-Z_\-=!@\$%^&?|\\/<>*][\.:\w_\-=!@\$%^&?|\\/<>*]*</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>variable.other.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>hex-number</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?0x([_\da-fA-F]+|[_\da-fA-F]+\.[_\da-fA-F]*|\.[_\da-fA-F]+)(&[+-]?[\da-fA-F]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.numeric.hex.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>dec-number</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?([_\d]+|[_\d]+\.[_\d]*|\.[_\d]+)([eE&][+-]?[\d]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.numeric.decimal.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>r-number</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(?<![\.:\w_\-=!@\$%^&?|\\/<>*])[-+]?\d\d?r([_\w]+|[_\w]+\.[_\w]*|\.[_\w]+)(&[+-]?[\w]+)?(?![\.:\w_\-=!@\$%^&?|\\/<>*])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.numeric.decimal.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>string</key>
|
|
||||||
<dict>
|
|
||||||
<key>begin</key>
|
|
||||||
<string>(@?")</string>
|
|
||||||
<key>beginCaptures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.string.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>end</key>
|
|
||||||
<string>(")</string>
|
|
||||||
<key>endCaptures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.string.end.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>string.quoted.double.janet</string>
|
|
||||||
<key>patterns</key>
|
|
||||||
<array>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>(\\[ne0zft"\\']|\\x[0-9a-fA-F][0-9a-fA-f])</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>constant.character.escape.janet</string>
|
|
||||||
</dict>
|
|
||||||
</array>
|
|
||||||
</dict>
|
|
||||||
<key>longstring</key>
|
|
||||||
<dict>
|
|
||||||
<key>begin</key>
|
|
||||||
<string>(@?)(`+)</string>
|
|
||||||
<key>beginCaptures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.string.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>2</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.string.begin.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>end</key>
|
|
||||||
<string>\2</string>
|
|
||||||
<key>endCaptures</key>
|
|
||||||
<dict>
|
|
||||||
<key>1</key>
|
|
||||||
<dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>punctuation.definition.string.end.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>name</key>
|
|
||||||
<string>string.quoted.triple.janet</string>
|
|
||||||
</dict>
|
|
||||||
<key>nomatch</key>
|
|
||||||
<dict>
|
|
||||||
<key>match</key>
|
|
||||||
<string>\S+</string>
|
|
||||||
<key>name</key>
|
|
||||||
<string>invalid.illegal.janet</string>
|
|
||||||
</dict>
|
|
||||||
</dict>
|
|
||||||
<key>scopeName</key>
|
|
||||||
<string>source.janet</string>
|
|
||||||
<key>uuid</key>
|
|
||||||
<string>3743190f-20c4-44d0-8640-6611a983296b</string>
|
|
||||||
</dict>
|
|
||||||
</plist>
|
|
||||||
65
janet.1
65
janet.1
@@ -1,12 +1,16 @@
|
|||||||
.TH JANET 1
|
.TH JANET 1
|
||||||
.SH NAME
|
.SH NAME
|
||||||
janet \- run the janet language abstract machine
|
janet \- run the Janet language abstract machine
|
||||||
.SH SYNOPSIS
|
.SH SYNOPSIS
|
||||||
.B janet
|
.B janet
|
||||||
[\fB\-hvsrp\fR]
|
[\fB\-hvsrpq\fR]
|
||||||
[\fB\-e\fR \fIJANET SOURCE\fR]
|
[\fB\-e\fR \fISOURCE\fR]
|
||||||
|
[\fB\-l\fR \fIMODULE\fR]
|
||||||
|
[\fB\-m\fR \fIPATH\fR]
|
||||||
|
[\fB\-c\fR \fIMODULE JIMAGE\fR]
|
||||||
[\fB\-\-\fR]
|
[\fB\-\-\fR]
|
||||||
.IR files ...
|
.IR script
|
||||||
|
.IR args ...
|
||||||
.SH DESCRIPTION
|
.SH DESCRIPTION
|
||||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
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
|
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||||
@@ -14,10 +18,10 @@ and performance (arrays, tables, structs, tuples). The language also bridging br
|
|||||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
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.
|
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
|
This client program is separate from the core runtime, so Janet could be embedded
|
||||||
into other programs. Try janet in your browser at https://janet-lang.org.
|
into other programs. Try Janet in your browser at https://janet-lang.org.
|
||||||
|
|
||||||
Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
Implemented in mostly standard C99, Janet runs on Windows, Linux and macOS.
|
||||||
The few features that are not standard C99 (dynamic library loading, compiler
|
The few features that are not standard C99 (dynamic library loading, compiler
|
||||||
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
specific optimizations), are fairly straight forward. Janet can be easily ported to
|
||||||
most new platforms.
|
most new platforms.
|
||||||
@@ -37,37 +41,58 @@ Shows the version text and exits immediately.
|
|||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-s
|
.BR \-s
|
||||||
Read raw input from stdin, such as from a pipe without printing a prompt.
|
Read raw input from stdin and forgo prompt history and other readline-like features.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-e\ code
|
||||||
|
Execute a string of Janet source. Source code is executed in the order it is encountered, so earlier
|
||||||
|
arguments are executed before later ones.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-r
|
.BR \-r
|
||||||
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if janet is called with no
|
Open a REPL (Read Eval Print Loop) after executing all sources. By default, if Janet is called with no
|
||||||
arguments, a REPL is opened.
|
arguments, a REPL is opened.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-p
|
.BR \-p
|
||||||
Turn on the persistent flag. By default, when janet is executing commands from a file and encounters an error,
|
Turn on the persistent flag. By default, when Janet is executing commands from a file and encounters an error,
|
||||||
it will immediately exit after printing the error message. In persistent mode, janet will keep executing commands
|
it will immediately exit after printing the error message. In persistent mode, Janet will keep executing commands
|
||||||
after an error. Persistent mode can be good for debugging and testing.
|
after an error. Persistent mode can be good for debugging and testing.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-e
|
.BR \-q
|
||||||
Execute a string of janet source. Source code is executed in the order it is encountered, so earlier
|
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||||
arguments are executed before later ones.
|
|
||||||
|
.TP
|
||||||
|
.BR \-m\ syspath
|
||||||
|
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
|
||||||
|
from a directory different than the default. The default is set when Janet is built, and defaults to
|
||||||
|
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-c\ source\ output
|
||||||
|
Precompiles Janet source code into an image, a binary dump that can be efficiently loaded later.
|
||||||
|
Source should be a path to the Janet module to compile, and output should be the file path of
|
||||||
|
resulting image. Output should usually end with the .jimage extension.
|
||||||
|
|
||||||
|
.TP
|
||||||
|
.BR \-l\ path
|
||||||
|
Load a Janet file before running a script or repl. Multiple files can be loaded
|
||||||
|
in this manner, and exports from each file will be made available to the script
|
||||||
|
or repl.
|
||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-\-
|
.BR \-\-
|
||||||
Stop parsing command line arguments. All arguments after this one will be considered file names.
|
Stop parsing command line arguments. All arguments after this one will be considered file names
|
||||||
|
and then arguments to the script.
|
||||||
|
|
||||||
.SH ENVIRONMENT
|
.SH ENVIRONMENT
|
||||||
|
|
||||||
.B JANET_PATH
|
.B JANET_PATH
|
||||||
.RS
|
.RS
|
||||||
The location to look for janet libraries. This is the only environment variable janet needs to
|
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
||||||
find native and source code modules. If no JANET_PATH is set, janet will look in
|
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
||||||
/usr/local/lib/janet for modules.
|
the default location set at compile time.
|
||||||
To make janet search multiple locations, modify the module.paths
|
|
||||||
array in janet.
|
|
||||||
.RE
|
.RE
|
||||||
|
|
||||||
.SH AUTHOR
|
.SH AUTHOR
|
||||||
|
|||||||
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int array_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetArray *array1, *array2;
|
JanetArray *array1, *array2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
array1 = janet_array(10);
|
array1 = janet_array(10);
|
||||||
array2 = janet_array(0);
|
array2 = janet_array(0);
|
||||||
|
|
||||||
@@ -62,7 +62,5 @@ int main() {
|
|||||||
|
|
||||||
assert(array1->count == 5);
|
assert(array1->count == 5);
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
56
src/boot/boot.c
Normal file
56
src/boot/boot.c
Normal file
@@ -0,0 +1,56 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
|
extern const unsigned char *janet_gen_boot;
|
||||||
|
extern int32_t janet_gen_boot_size;
|
||||||
|
|
||||||
|
int main() {
|
||||||
|
|
||||||
|
/* Init janet */
|
||||||
|
janet_init();
|
||||||
|
|
||||||
|
/* Run tests */
|
||||||
|
array_test();
|
||||||
|
buffer_test();
|
||||||
|
number_test();
|
||||||
|
system_test();
|
||||||
|
table_test();
|
||||||
|
|
||||||
|
/* C tests passed */
|
||||||
|
|
||||||
|
/* Set up VM */
|
||||||
|
int status;
|
||||||
|
JanetTable *env;
|
||||||
|
|
||||||
|
env = janet_core_env(NULL);
|
||||||
|
|
||||||
|
/* Run bootstrap script to generate core image */
|
||||||
|
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||||
|
|
||||||
|
/* Deinitialize vm */
|
||||||
|
janet_deinit();
|
||||||
|
|
||||||
|
return status;
|
||||||
|
}
|
||||||
42
src/boot/boot.janet
Normal file
42
src/boot/boot.janet
Normal file
@@ -0,0 +1,42 @@
|
|||||||
|
# Copyright (C) Calvin Rose 2019
|
||||||
|
|
||||||
|
# The bootstrap script is used to produce the source file for
|
||||||
|
# embedding the core image.
|
||||||
|
|
||||||
|
# Tool to dump a marshalled version of the janet core to stdout. The
|
||||||
|
# image should eventually allow janet to be started from a pre-compiled
|
||||||
|
# image rather than recompiled every time from the embedded source. More
|
||||||
|
# work will go into shrinking the image (it isn't currently that large but
|
||||||
|
# could be smaller), creating the mechanism to load the image, and modifying
|
||||||
|
# the build process to compile janet with a built image rather than
|
||||||
|
# embedded source.
|
||||||
|
|
||||||
|
# Get image. This image contains as much of the core library and documentation that
|
||||||
|
# can be written to an image (no cfunctions, no abstracts (stdout, stdin, stderr)),
|
||||||
|
# everything else goes. Cfunctions and abstracts will be referenced from a registry
|
||||||
|
# table which will be generated on janet startup.
|
||||||
|
(do
|
||||||
|
(def image (let [env-pairs (pairs (env-lookup *env*))
|
||||||
|
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||||
|
lookup (table ;(mapcat identity essential-pairs))
|
||||||
|
reverse-lookup (invert lookup)]
|
||||||
|
(marshal *env* reverse-lookup)))
|
||||||
|
|
||||||
|
# Create C source file that contains images a uint8_t buffer. This
|
||||||
|
# can be compiled and linked statically into the main janet library
|
||||||
|
# and example client.
|
||||||
|
(def chunks (string/bytes image))
|
||||||
|
(def image-file (file/open "build/core_image.c" :w))
|
||||||
|
(file/write image-file
|
||||||
|
"#ifndef JANET_AMALG\n"
|
||||||
|
"#include <janet.h>\n"
|
||||||
|
"#endif\n"
|
||||||
|
"static const unsigned char janet_core_image_bytes[] = {\n")
|
||||||
|
(loop [line :in (partition 10 chunks)]
|
||||||
|
(def str (string ;(interpose ", " (map (partial string/format "0x%.2X") line))))
|
||||||
|
(file/write image-file " " str ",\n"))
|
||||||
|
(file/write image-file
|
||||||
|
" 0\n};\n\n"
|
||||||
|
"const unsigned char *janet_core_image = janet_core_image_bytes;\n"
|
||||||
|
"size_t janet_core_image_size = sizeof(janet_core_image_bytes);\n")
|
||||||
|
(file/close image-file))
|
||||||
@@ -20,16 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int buffer_test() {
|
||||||
|
|
||||||
int i;
|
int i;
|
||||||
JanetBuffer *buffer1, *buffer2;
|
JanetBuffer *buffer1, *buffer2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
buffer1 = janet_buffer(100);
|
buffer1 = janet_buffer(100);
|
||||||
buffer2 = janet_buffer(0);
|
buffer2 = janet_buffer(0);
|
||||||
|
|
||||||
@@ -58,7 +58,5 @@ int main() {
|
|||||||
assert(buffer1->data[i] == buffer2->data[i]);
|
assert(buffer1->data[i] == buffer2->data[i]);
|
||||||
}
|
}
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
|
#include "tests.h"
|
||||||
|
|
||||||
/* Check a subset of numbers against system implementation.
|
/* Check a subset of numbers against system implementation.
|
||||||
* Note that this depends on the system implementation being correct,
|
* Note that this depends on the system implementation being correct,
|
||||||
* which may not be the case for old or non compliant systems. Also,
|
* which may not be the case for old or non compliant systems. Also,
|
||||||
@@ -36,14 +38,12 @@ static void test_valid_str(const char *str) {
|
|||||||
double cnum, jnum;
|
double cnum, jnum;
|
||||||
jnum = 0.0;
|
jnum = 0.0;
|
||||||
cnum = atof(str);
|
cnum = atof(str);
|
||||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
err = janet_scan_number((const uint8_t *) str, (int32_t) strlen(str), &jnum);
|
||||||
assert(!err);
|
assert(!err);
|
||||||
assert(cnum == jnum);
|
assert(cnum == jnum);
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int number_test() {
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
test_valid_str("1.0");
|
test_valid_str("1.0");
|
||||||
test_valid_str("1");
|
test_valid_str("1");
|
||||||
@@ -63,7 +63,5 @@ int main() {
|
|||||||
test_valid_str("0000000011111111111111111111111111");
|
test_valid_str("0000000011111111111111111111111111");
|
||||||
test_valid_str(".112312333333323123123123123123123");
|
test_valid_str(".112312333333323123123123123123123");
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -1,5 +1,5 @@
|
|||||||
/*
|
/*
|
||||||
* Copyright (c) 2018 Calvin Rose
|
* Copyright (c) 2019 Calvin Rose
|
||||||
*
|
*
|
||||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
* of this software and associated documentation files (the "Software"), to
|
* of this software and associated documentation files (the "Software"), to
|
||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int system_test() {
|
||||||
|
|
||||||
#ifdef JANET_32
|
#ifdef JANET_32
|
||||||
assert(sizeof(void *) == 4);
|
assert(sizeof(void *) == 4);
|
||||||
@@ -32,8 +34,6 @@ int main() {
|
|||||||
assert(sizeof(void *) == 8);
|
assert(sizeof(void *) == 8);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
/* Reflexive testing and nanbox testing */
|
/* Reflexive testing and nanbox testing */
|
||||||
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
assert(janet_equals(janet_wrap_nil(), janet_wrap_nil()));
|
||||||
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
assert(janet_equals(janet_wrap_false(), janet_wrap_false()));
|
||||||
@@ -48,7 +48,5 @@ int main() {
|
|||||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -20,15 +20,15 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <assert.h>
|
#include <assert.h>
|
||||||
|
|
||||||
int main() {
|
#include "tests.h"
|
||||||
|
|
||||||
|
int table_test() {
|
||||||
|
|
||||||
JanetTable *t1, *t2;
|
JanetTable *t1, *t2;
|
||||||
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
t1 = janet_table(10);
|
t1 = janet_table(10);
|
||||||
t2 = janet_table(0);
|
t2 = janet_table(0);
|
||||||
|
|
||||||
@@ -61,7 +61,5 @@ int main() {
|
|||||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
|
||||||
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
|
||||||
|
|
||||||
janet_deinit();
|
|
||||||
|
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
11
src/boot/tests.h
Normal file
11
src/boot/tests.h
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
#ifndef TESTS_H_DNMBUYYL
|
||||||
|
#define TESTS_H_DNMBUYYL
|
||||||
|
|
||||||
|
/* Tests */
|
||||||
|
extern int array_test();
|
||||||
|
extern int buffer_test();
|
||||||
|
extern int number_test();
|
||||||
|
extern int system_test();
|
||||||
|
extern int table_test();
|
||||||
|
|
||||||
|
#endif /* end of include guard: TESTS_H_DNMBUYYL */
|
||||||
@@ -20,15 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_ABSTRACT, sizeof(JanetAbstractHeader) + size);
|
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
|
||||||
JanetAbstractHeader *header = (JanetAbstractHeader *)data;
|
sizeof(JanetAbstractHead) + size);
|
||||||
void *a = data + sizeof(JanetAbstractHeader);
|
|
||||||
header->size = size;
|
header->size = size;
|
||||||
header->type = atype;
|
header->type = atype;
|
||||||
return a;
|
return (void *) & (header->data);
|
||||||
}
|
}
|
||||||
|
|||||||
147
src/core/array.c
147
src/core/array.c
@@ -20,9 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
/* Initializes an array */
|
/* Initializes an array */
|
||||||
@@ -119,26 +122,26 @@ Janet janet_array_peek(JanetArray *array) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JanetArray *array = janet_array(cap);
|
JanetArray *array = janet_array(cap);
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_pop(int32_t argc, Janet *argv) {
|
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
return janet_array_pop(array);
|
return janet_array_pop(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_peek(int32_t argc, Janet *argv) {
|
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
return janet_array_peek(array);
|
return janet_array_peek(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_push(int32_t argc, Janet *argv) {
|
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
int32_t newcount = array->count - 1 + argc;
|
int32_t newcount = array->count - 1 + argc;
|
||||||
@@ -148,7 +151,7 @@ static Janet cfun_push(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_ensure(int32_t argc, Janet *argv) {
|
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 3);
|
janet_fixarity(argc, 3);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
int32_t newcount = janet_getinteger(argv, 1);
|
int32_t newcount = janet_getinteger(argv, 1);
|
||||||
@@ -158,16 +161,17 @@ static Janet cfun_ensure(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
JanetArray *array = janet_array(range.end - range.start);
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
if (array->data)
|
||||||
|
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||||
array->count = range.end - range.start;
|
array->count = range.end - range.start;
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_concat(int32_t argc, Janet *argv) {
|
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
@@ -177,21 +181,20 @@ static Janet cfun_concat(int32_t argc, Janet *argv) {
|
|||||||
janet_array_push(array, argv[i]);
|
janet_array_push(array, argv[i]);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
int32_t j, len;
|
||||||
int32_t j, len;
|
const Janet *vals;
|
||||||
const Janet *vals;
|
janet_indexed_view(argv[i], &vals, &len);
|
||||||
janet_indexed_view(argv[i], &vals, &len);
|
for (j = 0; j < len; j++)
|
||||||
for (j = 0; j < len; j++)
|
janet_array_push(array, vals[j]);
|
||||||
janet_array_push(array, vals[j]);
|
}
|
||||||
}
|
break;
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_insert(int32_t argc, Janet *argv) {
|
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||||
size_t chunksize, restsize;
|
size_t chunksize, restsize;
|
||||||
janet_arity(argc, 2, -1);
|
janet_arity(argc, 2, -1);
|
||||||
JanetArray *array = janet_getarray(argv, 0);
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
@@ -209,60 +212,100 @@ static Janet cfun_insert(int32_t argc, Janet *argv) {
|
|||||||
restsize);
|
restsize);
|
||||||
memcpy(array->data + at, argv + 2, chunksize);
|
memcpy(array->data + at, argv + 2, chunksize);
|
||||||
array->count += (argc - 2);
|
array->count += (argc - 2);
|
||||||
return janet_wrap_array(array);
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet cfun_array_remove(int32_t argc, Janet *argv) {
|
||||||
{"array/new", cfun_new,
|
janet_arity(argc, 2, 3);
|
||||||
|
JanetArray *array = janet_getarray(argv, 0);
|
||||||
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
|
int32_t n = 1;
|
||||||
|
if (at < 0) {
|
||||||
|
at = array->count + at + 1;
|
||||||
|
}
|
||||||
|
if (at < 0 || at > array->count)
|
||||||
|
janet_panicf("removal index %d out of range [0,%d]", at, array->count);
|
||||||
|
if (argc == 3) {
|
||||||
|
n = janet_getinteger(argv, 2);
|
||||||
|
if (n < 0)
|
||||||
|
janet_panicf("expected non-negative integer for argument n, got %v", argv[2]);
|
||||||
|
}
|
||||||
|
if (at + n > array->count) {
|
||||||
|
n = array->count - at;
|
||||||
|
}
|
||||||
|
memmove(array->data + at,
|
||||||
|
array->data + at + n,
|
||||||
|
(array->count - at - n) * sizeof(Janet));
|
||||||
|
array->count -= n;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg array_cfuns[] = {
|
||||||
|
{
|
||||||
|
"array/new", cfun_array_new,
|
||||||
JDOC("(array/new capacity)\n\n"
|
JDOC("(array/new capacity)\n\n"
|
||||||
"Creates a new empty array with a pre-allocated capacity. The same as "
|
"Creates a new empty array with a pre-allocated capacity. The same as "
|
||||||
"(array) but can be more efficient if the maximum size of an array is known.")
|
"(array) but can be more efficient if the maximum size of an array is known.")
|
||||||
},
|
},
|
||||||
{"array/pop", cfun_pop,
|
{
|
||||||
|
"array/pop", cfun_array_pop,
|
||||||
JDOC("(array/pop arr)\n\n"
|
JDOC("(array/pop arr)\n\n"
|
||||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||||
"the input array.")
|
"the input array.")
|
||||||
},
|
},
|
||||||
{"array/peek", cfun_peek,
|
{
|
||||||
|
"array/peek", cfun_array_peek,
|
||||||
JDOC("(array/peek arr)\n\n"
|
JDOC("(array/peek arr)\n\n"
|
||||||
"Returns the last element of the array. Does not modify the array.")
|
"Returns the last element of the array. Does not modify the array.")
|
||||||
},
|
},
|
||||||
{"array/push", cfun_push,
|
{
|
||||||
|
"array/push", cfun_array_push,
|
||||||
JDOC("(array/push arr x)\n\n"
|
JDOC("(array/push arr x)\n\n"
|
||||||
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||||
},
|
},
|
||||||
{"array/ensure", cfun_ensure,
|
{
|
||||||
|
"array/ensure", cfun_array_ensure,
|
||||||
JDOC("(array/ensure arr capacity)\n\n"
|
JDOC("(array/ensure arr capacity)\n\n"
|
||||||
"Ensures that the memory backing the array has enough memory for capacity "
|
"Ensures that the memory backing the array has enough memory for capacity "
|
||||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||||
"so that there is enough space.")
|
"so that there is enough space.")
|
||||||
},
|
},
|
||||||
{"array/slice", cfun_slice,
|
{
|
||||||
|
"array/slice", cfun_array_slice,
|
||||||
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||||
"Returns a new array.")
|
"Returns a new array.")
|
||||||
},
|
},
|
||||||
{"array/concat", cfun_concat,
|
{
|
||||||
|
"array/concat", cfun_array_concat,
|
||||||
JDOC("(array/concat arr & parts)\n\n"
|
JDOC("(array/concat arr & parts)\n\n"
|
||||||
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
"Concatenates a variadic number of arrays (and tuples) into the first argument "
|
||||||
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
"which must an array. If any of the parts are arrays or tuples, their elements will "
|
||||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||||
"Return the modified array arr.")
|
"Return the modified array arr.")
|
||||||
},
|
},
|
||||||
{"array/insert", cfun_insert,
|
{
|
||||||
|
"array/insert", cfun_array_insert,
|
||||||
JDOC("(array/insert arr at & xs)\n\n"
|
JDOC("(array/insert arr at & xs)\n\n"
|
||||||
"Insert all of xs into array arr at index at. at should be an integer "
|
"Insert all of xs into array arr at index at. at should be an integer "
|
||||||
"0 and the length of the array. A negative value for at will index from "
|
"0 and the length of the array. A negative value for at will index from "
|
||||||
"the end of the array, such that inserting at -1 appends to the array. "
|
"the end of the array, such that inserting at -1 appends to the array. "
|
||||||
"Returns the array.")
|
"Returns the array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"array/remove", cfun_array_remove,
|
||||||
|
JDOC("(array/remove arr at [, n=1])\n\n"
|
||||||
|
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||||
|
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||||
|
"Returns the array.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the array module */
|
/* Load the array module */
|
||||||
void janet_lib_array(JanetTable *env) {
|
void janet_lib_array(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, array_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
192
src/core/asm.c
192
src/core/asm.c
@@ -20,9 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <setjmp.h>
|
#ifndef JANET_AMALG
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
#include <setjmp.h>
|
||||||
|
|
||||||
/* Conditionally compile this file */
|
/* Conditionally compile this file */
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
@@ -79,9 +82,9 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"get", JOP_GET},
|
{"get", JOP_GET},
|
||||||
{"geti", JOP_GET_INDEX},
|
{"geti", JOP_GET_INDEX},
|
||||||
{"gt", JOP_GREATER_THAN},
|
{"gt", JOP_GREATER_THAN},
|
||||||
|
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||||
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
||||||
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
||||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
|
||||||
{"jmp", JOP_JUMP},
|
{"jmp", JOP_JUMP},
|
||||||
{"jmpif", JOP_JUMP_IF},
|
{"jmpif", JOP_JUMP_IF},
|
||||||
{"jmpno", JOP_JUMP_IF_NOT},
|
{"jmpno", JOP_JUMP_IF_NOT},
|
||||||
@@ -144,19 +147,18 @@ static const TypeAlias type_aliases[] = {
|
|||||||
{"callable", JANET_TFLAG_CALLABLE},
|
{"callable", JANET_TFLAG_CALLABLE},
|
||||||
{"cfunction", JANET_TFLAG_CFUNCTION},
|
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||||
{"dictionary", JANET_TFLAG_DICTIONARY},
|
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||||
{"false", JANET_TFLAG_FALSE},
|
|
||||||
{"fiber", JANET_TFLAG_FIBER},
|
{"fiber", JANET_TFLAG_FIBER},
|
||||||
{"function", JANET_TFLAG_FUNCTION},
|
{"function", JANET_TFLAG_FUNCTION},
|
||||||
{"indexed", JANET_TFLAG_INDEXED},
|
{"indexed", JANET_TFLAG_INDEXED},
|
||||||
|
{"keyword", JANET_TFLAG_KEYWORD},
|
||||||
{"nil", JANET_TFLAG_NIL},
|
{"nil", JANET_TFLAG_NIL},
|
||||||
{"number", JANET_TFLAG_NUMBER},
|
{"number", JANET_TFLAG_NUMBER},
|
||||||
|
{"pointer", JANET_TFLAG_POINTER},
|
||||||
{"string", JANET_TFLAG_STRING},
|
{"string", JANET_TFLAG_STRING},
|
||||||
{"struct", JANET_TFLAG_STRUCT},
|
{"struct", JANET_TFLAG_STRUCT},
|
||||||
{"symbol", JANET_TFLAG_SYMBOL},
|
{"symbol", JANET_TFLAG_SYMBOL},
|
||||||
{"keyword", JANET_TFLAG_KEYWORD},
|
{"table", JANET_TFLAG_TABLE},
|
||||||
{"table", JANET_TFLAG_BOOLEAN},
|
{"tuple", JANET_TFLAG_TUPLE}
|
||||||
{"true", JANET_TFLAG_TRUE},
|
|
||||||
{"tuple", JANET_TFLAG_BOOLEAN}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||||
@@ -221,9 +223,9 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
|||||||
/* Parse an argument to an assembly instruction, and return the result as an
|
/* Parse an argument to an assembly instruction, and return the result as an
|
||||||
* integer. This integer will need to be bounds checked. */
|
* integer. This integer will need to be bounds checked. */
|
||||||
static int32_t doarg_1(
|
static int32_t doarg_1(
|
||||||
JanetAssembler *a,
|
JanetAssembler *a,
|
||||||
enum JanetOpArgType argtype,
|
enum JanetOpArgType argtype,
|
||||||
Janet x) {
|
Janet x) {
|
||||||
int32_t ret = -1;
|
int32_t ret = -1;
|
||||||
JanetTable *c;
|
JanetTable *c;
|
||||||
switch (argtype) {
|
switch (argtype) {
|
||||||
@@ -250,8 +252,7 @@ static int32_t doarg_1(
|
|||||||
default:
|
default:
|
||||||
goto error;
|
goto error;
|
||||||
break;
|
break;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER: {
|
||||||
{
|
|
||||||
double y = janet_unwrap_number(x);
|
double y = janet_unwrap_number(x);
|
||||||
if (janet_checkintrange(y)) {
|
if (janet_checkintrange(y)) {
|
||||||
ret = (int32_t) y;
|
ret = (int32_t) y;
|
||||||
@@ -260,8 +261,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
|
||||||
const Janet *t = janet_unwrap_tuple(x);
|
const Janet *t = janet_unwrap_tuple(x);
|
||||||
if (argtype == JANET_OAT_TYPE) {
|
if (argtype == JANET_OAT_TYPE) {
|
||||||
int32_t i = 0;
|
int32_t i = 0;
|
||||||
@@ -274,8 +274,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD: {
|
||||||
{
|
|
||||||
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
||||||
Janet result = janet_table_get(c, x);
|
Janet result = janet_table_get(c, x);
|
||||||
if (janet_checktype(result, JANET_NUMBER)) {
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
@@ -285,10 +284,10 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
||||||
const TypeAlias *alias = janet_strbinsearch(
|
const TypeAlias *alias = janet_strbinsearch(
|
||||||
&type_aliases,
|
&type_aliases,
|
||||||
sizeof(type_aliases)/sizeof(TypeAlias),
|
sizeof(type_aliases) / sizeof(TypeAlias),
|
||||||
sizeof(TypeAlias),
|
sizeof(TypeAlias),
|
||||||
janet_unwrap_keyword(x));
|
janet_unwrap_keyword(x));
|
||||||
if (alias) {
|
if (alias) {
|
||||||
ret = alias->mask;
|
ret = alias->mask;
|
||||||
} else {
|
} else {
|
||||||
@@ -299,8 +298,7 @@ static int32_t doarg_1(
|
|||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL: {
|
||||||
{
|
|
||||||
if (NULL != c) {
|
if (NULL != c) {
|
||||||
Janet result = janet_table_get(c, x);
|
Janet result = janet_table_get(c, x);
|
||||||
if (janet_checktype(result, JANET_NUMBER)) {
|
if (janet_checktype(result, JANET_NUMBER)) {
|
||||||
@@ -325,7 +323,7 @@ static int32_t doarg_1(
|
|||||||
a->def->slotcount = (int32_t) ret + 1;
|
a->def->slotcount = (int32_t) ret + 1;
|
||||||
return ret;
|
return ret;
|
||||||
|
|
||||||
error:
|
error:
|
||||||
janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x));
|
janet_asm_errorv(a, janet_formatc("error parsing instruction argument %v", x));
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
@@ -333,12 +331,12 @@ static int32_t doarg_1(
|
|||||||
/* Parse a single argument to an instruction. Trims it as well as
|
/* Parse a single argument to an instruction. Trims it as well as
|
||||||
* try to convert arguments to bit patterns */
|
* try to convert arguments to bit patterns */
|
||||||
static uint32_t doarg(
|
static uint32_t doarg(
|
||||||
JanetAssembler *a,
|
JanetAssembler *a,
|
||||||
enum JanetOpArgType argtype,
|
enum JanetOpArgType argtype,
|
||||||
int nth,
|
int nth,
|
||||||
int nbytes,
|
int nbytes,
|
||||||
int hassign,
|
int hassign,
|
||||||
Janet x) {
|
Janet x) {
|
||||||
int32_t arg = doarg_1(a, argtype, x);
|
int32_t arg = doarg_1(a, argtype, x);
|
||||||
/* Calculate the min and max values that can be stored given
|
/* Calculate the min and max values that can be stored given
|
||||||
* nbytes, and whether or not the storage is signed */
|
* nbytes, and whether or not the storage is signed */
|
||||||
@@ -346,59 +344,53 @@ static uint32_t doarg(
|
|||||||
int32_t min = hassign ? -max - 1 : 0;
|
int32_t min = hassign ? -max - 1 : 0;
|
||||||
if (arg < min)
|
if (arg < min)
|
||||||
janet_asm_errorv(a, janet_formatc("instruction argument %v is too small, must be %d byte%s",
|
janet_asm_errorv(a, janet_formatc("instruction argument %v is too small, must be %d byte%s",
|
||||||
x, nbytes, nbytes > 1 ? "s" : ""));
|
x, nbytes, nbytes > 1 ? "s" : ""));
|
||||||
if (arg > max)
|
if (arg > max)
|
||||||
janet_asm_errorv(a, janet_formatc("instruction argument %v is too large, must be %d byte%s",
|
janet_asm_errorv(a, janet_formatc("instruction argument %v is too large, must be %d byte%s",
|
||||||
x, nbytes, nbytes > 1 ? "s" : ""));
|
x, nbytes, nbytes > 1 ? "s" : ""));
|
||||||
return ((uint32_t) arg) << (nth << 3);
|
return ((uint32_t) arg) << (nth << 3);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Provide parsing methods for the different kinds of arguments */
|
/* Provide parsing methods for the different kinds of arguments */
|
||||||
static uint32_t read_instruction(
|
static uint32_t read_instruction(
|
||||||
JanetAssembler *a,
|
JanetAssembler *a,
|
||||||
const JanetInstructionDef *idef,
|
const JanetInstructionDef *idef,
|
||||||
const Janet *argt) {
|
const Janet *argt) {
|
||||||
uint32_t instr = idef->opcode;
|
uint32_t instr = idef->opcode;
|
||||||
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
enum JanetInstructionType type = janet_instructions[idef->opcode];
|
||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 1)
|
if (janet_tuple_length(argt) != 1)
|
||||||
janet_asm_error(a, "expected 0 arguments: (op)");
|
janet_asm_error(a, "expected 0 arguments: (op)");
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
janet_asm_error(a, "expected 1 argument: (op, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 2, 0, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_L:
|
case JINT_L: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 2)
|
if (janet_tuple_length(argt) != 2)
|
||||||
janet_asm_error(a, "expected 1 argument: (op, label)");
|
janet_asm_error(a, "expected 1 argument: (op, label)");
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
instr |= doarg(a, JANET_OAT_LABEL, 1, 3, 1, argt[1]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SS:
|
case JINT_SS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_SLOT, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, label)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
instr |= doarg(a, JANET_OAT_LABEL, 2, 2, 1, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, type)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -406,24 +398,21 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 2, 2, type == JINT_SI, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, funcdef)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
instr |= doarg(a, JANET_OAT_FUNCDEF, 2, 2, 0, argt[2]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSS:
|
case JINT_SSS: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, slot)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -432,8 +421,7 @@ static uint32_t read_instruction(
|
|||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
janet_asm_error(a, "expected 3 arguments: (op, slot, slot, integer)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -441,8 +429,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
instr |= doarg(a, JANET_OAT_INTEGER, 3, 1, type == JINT_SSI, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SES:
|
case JINT_SES: {
|
||||||
{
|
|
||||||
JanetAssembler *b = a;
|
JanetAssembler *b = a;
|
||||||
uint32_t env;
|
uint32_t env;
|
||||||
if (janet_tuple_length(argt) != 4)
|
if (janet_tuple_length(argt) != 4)
|
||||||
@@ -458,8 +445,7 @@ static uint32_t read_instruction(
|
|||||||
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
instr |= doarg(b, JANET_OAT_SLOT, 3, 1, 0, argt[3]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JINT_SC:
|
case JINT_SC: {
|
||||||
{
|
|
||||||
if (janet_tuple_length(argt) != 3)
|
if (janet_tuple_length(argt) != 3)
|
||||||
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
janet_asm_error(a, "expected 2 arguments: (op, slot, constant)");
|
||||||
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
instr |= doarg(a, JANET_OAT_SLOT, 1, 1, 0, argt[1]);
|
||||||
@@ -525,9 +511,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
|
|
||||||
janet_asm_assert(&a,
|
janet_asm_assert(&a,
|
||||||
janet_checktype(s, JANET_STRUCT) ||
|
janet_checktype(s, JANET_STRUCT) ||
|
||||||
janet_checktype(s, JANET_TABLE),
|
janet_checktype(s, JANET_TABLE),
|
||||||
"expected struct or table for assembly source");
|
"expected struct or table for assembly source");
|
||||||
|
|
||||||
/* Check for function name */
|
/* Check for function name */
|
||||||
a.name = janet_get1(s, janet_csymbolv("name"));
|
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||||
@@ -538,15 +524,20 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
/* Set function arity */
|
/* Set function arity */
|
||||||
x = janet_get1(s, janet_csymbolv("arity"));
|
x = janet_get1(s, janet_csymbolv("arity"));
|
||||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||||
|
janet_asm_assert(&a, def->arity >= 0, "arity must be non-negative");
|
||||||
|
|
||||||
|
x = janet_get1(s, janet_csymbolv("max-arity"));
|
||||||
|
def->max_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||||
|
janet_asm_assert(&a, def->max_arity >= def->arity, "max-arity must be greater than or equal to arity");
|
||||||
|
|
||||||
|
x = janet_get1(s, janet_csymbolv("min-arity"));
|
||||||
|
def->min_arity = janet_checkint(x) ? janet_unwrap_integer(x) : def->arity;
|
||||||
|
janet_asm_assert(&a, def->min_arity <= def->arity, "min-arity must be less than or equal to arity");
|
||||||
|
|
||||||
/* Check vararg */
|
/* Check vararg */
|
||||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
|
||||||
/* Check strict arity */
|
|
||||||
x = janet_get1(s, janet_csymbolv("fix-arity"));
|
|
||||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
|
||||||
|
|
||||||
/* Check source */
|
/* Check source */
|
||||||
x = janet_get1(s, janet_csymbolv("source"));
|
x = janet_get1(s, janet_csymbolv("source"));
|
||||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||||
@@ -583,16 +574,16 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
for (i = 0; i < count; i++) {
|
for (i = 0; i < count; i++) {
|
||||||
Janet ct = arr[i];
|
Janet ct = arr[i];
|
||||||
if (janet_checktype(ct, JANET_TUPLE) &&
|
if (janet_checktype(ct, JANET_TUPLE) &&
|
||||||
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
|
janet_tuple_length(janet_unwrap_tuple(ct)) > 1 &&
|
||||||
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
|
janet_checktype(janet_unwrap_tuple(ct)[0], JANET_SYMBOL)) {
|
||||||
const Janet *t = janet_unwrap_tuple(ct);
|
const Janet *t = janet_unwrap_tuple(ct);
|
||||||
int32_t tcount = janet_tuple_length(t);
|
int32_t tcount = janet_tuple_length(t);
|
||||||
const uint8_t *macro = janet_unwrap_symbol(t[0]);
|
const uint8_t *macro = janet_unwrap_symbol(t[0]);
|
||||||
if (0 == janet_cstrcmp(macro, "quote")) {
|
if (0 == janet_cstrcmp(macro, "quote")) {
|
||||||
def->constants[i] = t[1];
|
def->constants[i] = t[1];
|
||||||
} else if (tcount == 3 &&
|
} else if (tcount == 3 &&
|
||||||
janet_checktype(t[1], JANET_SYMBOL) &&
|
janet_checktype(t[1], JANET_SYMBOL) &&
|
||||||
0 == janet_cstrcmp(macro, "def")) {
|
0 == janet_cstrcmp(macro, "def")) {
|
||||||
def->constants[i] = t[2];
|
def->constants[i] = t[2];
|
||||||
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
|
janet_table_put(&a.constants, t[1], janet_wrap_integer(i));
|
||||||
} else {
|
} else {
|
||||||
@@ -655,7 +646,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
}
|
}
|
||||||
/* Allocate bytecode array */
|
/* Allocate bytecode array */
|
||||||
def->bytecode_length = blength;
|
def->bytecode_length = blength;
|
||||||
def->bytecode = malloc(sizeof(int32_t) * blength);
|
def->bytecode = malloc(sizeof(uint32_t) * blength);
|
||||||
if (NULL == def->bytecode) {
|
if (NULL == def->bytecode) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -675,12 +666,12 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
op = 0;
|
op = 0;
|
||||||
} else {
|
} else {
|
||||||
janet_asm_assert(&a, janet_checktype(t[0], JANET_SYMBOL),
|
janet_asm_assert(&a, janet_checktype(t[0], JANET_SYMBOL),
|
||||||
"expected symbol in assembly instruction");
|
"expected symbol in assembly instruction");
|
||||||
idef = janet_strbinsearch(
|
idef = janet_strbinsearch(
|
||||||
&janet_ops,
|
&janet_ops,
|
||||||
sizeof(janet_ops)/sizeof(JanetInstructionDef),
|
sizeof(janet_ops) / sizeof(JanetInstructionDef),
|
||||||
sizeof(JanetInstructionDef),
|
sizeof(JanetInstructionDef),
|
||||||
janet_unwrap_symbol(t[0]));
|
janet_unwrap_symbol(t[0]));
|
||||||
if (NULL == idef)
|
if (NULL == idef)
|
||||||
janet_asm_errorv(&a, janet_formatc("unknown instruction %v", t[0]));
|
janet_asm_errorv(&a, janet_formatc("unknown instruction %v", t[0]));
|
||||||
op = read_instruction(&a, idef, t);
|
op = read_instruction(&a, idef, t);
|
||||||
@@ -747,7 +738,7 @@ JanetAssembleResult janet_asm(Janet source, int flags) {
|
|||||||
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
||||||
size_t i;
|
size_t i;
|
||||||
uint32_t opcode = instr & 0x7F;
|
uint32_t opcode = instr & 0x7F;
|
||||||
for (i = 0; i < sizeof(janet_ops)/sizeof(JanetInstructionDef); i++) {
|
for (i = 0; i < sizeof(janet_ops) / sizeof(JanetInstructionDef); i++) {
|
||||||
const JanetInstructionDef *def = janet_ops + i;
|
const JanetInstructionDef *def = janet_ops + i;
|
||||||
if (def->opcode == opcode)
|
if (def->opcode == opcode)
|
||||||
return def;
|
return def;
|
||||||
@@ -805,25 +796,25 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
|||||||
case JINT_SU:
|
case JINT_SU:
|
||||||
case JINT_SD:
|
case JINT_SD:
|
||||||
return tup3(name,
|
return tup3(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFFFF)));
|
janet_wrap_integer(oparg(2, 0xFFFF)));
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SL:
|
case JINT_SL:
|
||||||
return tup3(name,
|
return tup3(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer((int32_t)instr >> 16));
|
janet_wrap_integer((int32_t)instr >> 16));
|
||||||
case JINT_SSS:
|
case JINT_SSS:
|
||||||
case JINT_SES:
|
case JINT_SES:
|
||||||
case JINT_SSU:
|
case JINT_SSU:
|
||||||
return tup4(name,
|
return tup4(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFF)),
|
janet_wrap_integer(oparg(2, 0xFF)),
|
||||||
janet_wrap_integer(oparg(3, 0xFF)));
|
janet_wrap_integer(oparg(3, 0xFF)));
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
return tup4(name,
|
return tup4(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFF)),
|
janet_wrap_integer(oparg(2, 0xFF)),
|
||||||
janet_wrap_integer((int32_t)instr >> 24));
|
janet_wrap_integer((int32_t)instr >> 24));
|
||||||
}
|
}
|
||||||
#undef oparg
|
#undef oparg
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
@@ -835,6 +826,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
JanetArray *constants;
|
JanetArray *constants;
|
||||||
JanetTable *ret = janet_table(10);
|
JanetTable *ret = janet_table(10);
|
||||||
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
janet_table_put(ret, janet_csymbolv("arity"), janet_wrap_integer(def->arity));
|
||||||
|
janet_table_put(ret, janet_csymbolv("min-arity"), janet_wrap_integer(def->min_arity));
|
||||||
|
janet_table_put(ret, janet_csymbolv("max-arity"), janet_wrap_integer(def->max_arity));
|
||||||
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
janet_table_put(ret, janet_csymbolv("bytecode"), janet_wrap_array(bcode));
|
||||||
if (NULL != def->source) {
|
if (NULL != def->source) {
|
||||||
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
janet_table_put(ret, janet_csymbolv("source"), janet_wrap_string(def->source));
|
||||||
@@ -842,9 +835,6 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
if (def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||||
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
janet_table_put(ret, janet_csymbolv("vararg"), janet_wrap_true());
|
||||||
}
|
}
|
||||||
if (def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
|
||||||
janet_table_put(ret, janet_csymbolv("fix-arity"), janet_wrap_true());
|
|
||||||
}
|
|
||||||
if (NULL != def->name) {
|
if (NULL != def->name) {
|
||||||
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
janet_table_put(ret, janet_csymbolv("name"), janet_wrap_string(def->name));
|
||||||
}
|
}
|
||||||
@@ -930,25 +920,27 @@ static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
|||||||
return janet_disasm(f->def);
|
return janet_disasm(f->def);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg asm_cfuns[] = {
|
||||||
{"asm", cfun_asm,
|
{
|
||||||
|
"asm", cfun_asm,
|
||||||
JDOC("(asm assembly)\n\n"
|
JDOC("(asm assembly)\n\n"
|
||||||
"Returns a new function that is the compiled result of the assembly.\n"
|
"Returns a new function that is the compiled result of the assembly.\n"
|
||||||
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
"The syntax for the assembly can be found on the janet wiki. Will throw an\n"
|
||||||
"error on invalid assembly.")
|
"error on invalid assembly.")
|
||||||
},
|
},
|
||||||
{"disasm", cfun_disasm,
|
{
|
||||||
|
"disasm", cfun_disasm,
|
||||||
JDOC("(disasm func)\n\n"
|
JDOC("(disasm func)\n\n"
|
||||||
"Returns assembly that could be used be compile the given function.\n"
|
"Returns assembly that could be used be compile the given function.\n"
|
||||||
"func must be a function, not a c function. Will throw on error on a badly\n"
|
"func must be a function, not a c function. Will throw on error on a badly\n"
|
||||||
"typed argument.")
|
"typed argument.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
void janet_lib_asm(JanetTable *env) {
|
void janet_lib_asm(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -20,9 +20,11 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize a buffer */
|
/* Initialize a buffer */
|
||||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||||
@@ -55,7 +57,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
|||||||
uint8_t *new_data;
|
uint8_t *new_data;
|
||||||
uint8_t *old = buffer->data;
|
uint8_t *old = buffer->data;
|
||||||
if (capacity <= buffer->capacity) return;
|
if (capacity <= buffer->capacity) return;
|
||||||
capacity *= growth;
|
int64_t big_capacity = capacity * growth;
|
||||||
|
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||||
new_data = realloc(old, capacity * sizeof(uint8_t));
|
new_data = realloc(old, capacity * sizeof(uint8_t));
|
||||||
if (NULL == new_data) {
|
if (NULL == new_data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -154,38 +157,52 @@ void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
|||||||
|
|
||||||
/* C functions */
|
/* C functions */
|
||||||
|
|
||||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
JanetBuffer *buffer = janet_buffer(cap);
|
JanetBuffer *buffer = janet_buffer(cap);
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_u8(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_new_filled(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 2);
|
||||||
|
int32_t count = janet_getinteger(argv, 0);
|
||||||
|
int32_t byte = 0;
|
||||||
|
if (argc == 2) {
|
||||||
|
byte = janet_getinteger(argv, 1) & 0xFF;
|
||||||
|
}
|
||||||
|
JanetBuffer *buffer = janet_buffer(count);
|
||||||
|
if (buffer->data)
|
||||||
|
memset(buffer->data, byte, count);
|
||||||
|
buffer->count = count;
|
||||||
|
return janet_wrap_buffer(buffer);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
for (i = 1; i < argc; i++) {
|
for (i = 1; i < argc; i++) {
|
||||||
janet_buffer_push_u8(buffer, (uint8_t) (janet_getinteger(argv, i) & 0xFF));
|
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
|
||||||
}
|
}
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_word(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
for (i = 1; i < argc; i++) {
|
for (i = 1; i < argc; i++) {
|
||||||
double number = janet_getnumber(argv, 0);
|
double number = janet_getnumber(argv, i);
|
||||||
uint32_t word = (uint32_t) number;
|
uint32_t word = (uint32_t) number;
|
||||||
if (word != number)
|
if (word != number)
|
||||||
janet_panicf("cannot convert %v to machine word", argv[0]);
|
janet_panicf("cannot convert %v to machine word", argv[i]);
|
||||||
janet_buffer_push_u32(buffer, word);
|
janet_buffer_push_u32(buffer, word);
|
||||||
}
|
}
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_chars(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
@@ -196,14 +213,14 @@ static Janet cfun_chars(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_clear(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_popn(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
int32_t n = janet_getinteger(argv, 1);
|
int32_t n = janet_getinteger(argv, 1);
|
||||||
@@ -216,57 +233,188 @@ static Janet cfun_popn(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetByteView view = janet_getbytes(argv, 0);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||||
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
if (buffer->data)
|
||||||
|
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||||
buffer->count = range.end - range.start;
|
buffer->count = range.end - range.start;
|
||||||
return janet_wrap_buffer(buffer);
|
return janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, int *bit) {
|
||||||
{"buffer/new", cfun_new,
|
janet_fixarity(argc, 2);
|
||||||
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
double x = janet_getnumber(argv, 1);
|
||||||
|
int64_t bitindex = (int64_t) x;
|
||||||
|
int64_t byteindex = bitindex >> 3;
|
||||||
|
int which_bit = bitindex & 7;
|
||||||
|
if (bitindex != x || bitindex < 0 || byteindex >= buffer->count)
|
||||||
|
janet_panicf("invalid bit index %v", argv[1]);
|
||||||
|
*b = buffer;
|
||||||
|
*index = (int32_t) byteindex;
|
||||||
|
*bit = which_bit;
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitset(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] |= 1 << bit;
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitclear(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] &= ~(1 << bit);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bitget(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
return janet_wrap_boolean(buffer->data[index] & (1 << bit));
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_bittoggle(int32_t argc, Janet *argv) {
|
||||||
|
int bit;
|
||||||
|
int32_t index;
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
bitloc(argc, argv, &buffer, &index, &bit);
|
||||||
|
buffer->data[index] ^= (1 << bit);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 5);
|
||||||
|
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||||
|
JanetByteView src = janet_getbytes(argv, 1);
|
||||||
|
int32_t offset_dest = 0;
|
||||||
|
int32_t offset_src = 0;
|
||||||
|
if (argc > 2)
|
||||||
|
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
|
||||||
|
if (argc > 3)
|
||||||
|
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
|
||||||
|
int32_t length_src;
|
||||||
|
if (argc > 4) {
|
||||||
|
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
|
||||||
|
length_src = src_end - offset_src;
|
||||||
|
if (length_src < 0) length_src = 0;
|
||||||
|
} else {
|
||||||
|
length_src = src.len - offset_src;
|
||||||
|
}
|
||||||
|
int64_t last = ((int64_t) offset_dest - offset_src) + 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;
|
||||||
|
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_buffer_format(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, -1);
|
||||||
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
const char *strfrmt = (const char *) janet_getstring(argv, 1);
|
||||||
|
janet_buffer_format(buffer, strfrmt, 1, argc, argv);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg buffer_cfuns[] = {
|
||||||
|
{
|
||||||
|
"buffer/new", cfun_buffer_new,
|
||||||
JDOC("(buffer/new capacity)\n\n"
|
JDOC("(buffer/new capacity)\n\n"
|
||||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||||
"Returns a new buffer.")
|
"Returns a new buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/push-byte", cfun_u8,
|
{
|
||||||
|
"buffer/new-filled", cfun_buffer_new_filled,
|
||||||
|
JDOC("(buffer/new-filled count [, byte=0])\n\n"
|
||||||
|
"Creates a new buffer of length count filled with byte. "
|
||||||
|
"Returns the new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/push-byte", cfun_buffer_u8,
|
||||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||||
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-word", cfun_word,
|
{
|
||||||
|
"buffer/push-word", cfun_buffer_word,
|
||||||
JDOC("(buffer/push-word buffer x)\n\n"
|
JDOC("(buffer/push-word buffer x)\n\n"
|
||||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
"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, big endian order, unsigned. Returns the modified buffer. Will "
|
||||||
"throw an error if the buffer overflows.")
|
"throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/push-string", cfun_chars,
|
{
|
||||||
|
"buffer/push-string", cfun_buffer_chars,
|
||||||
JDOC("(buffer/push-string buffer str)\n\n"
|
JDOC("(buffer/push-string buffer str)\n\n"
|
||||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||||
"to strings before being pushed. Returns the modified buffer. "
|
"to strings before being pushed. Returns the modified buffer. "
|
||||||
"Will throw an error if the buffer overflows.")
|
"Will throw an error if the buffer overflows.")
|
||||||
},
|
},
|
||||||
{"buffer/popn", cfun_popn,
|
{
|
||||||
|
"buffer/popn", cfun_buffer_popn,
|
||||||
JDOC("(buffer/popn buffer n)\n\n"
|
JDOC("(buffer/popn buffer n)\n\n"
|
||||||
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/clear", cfun_clear,
|
{
|
||||||
|
"buffer/clear", cfun_buffer_clear,
|
||||||
JDOC("(buffer/clear buffer)\n\n"
|
JDOC("(buffer/clear buffer)\n\n"
|
||||||
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
"Sets the size of a buffer to 0 and empties it. The buffer retains "
|
||||||
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
"its memory so it can be efficiently refilled. Returns the modified buffer.")
|
||||||
},
|
},
|
||||||
{"buffer/slice", cfun_slice,
|
{
|
||||||
|
"buffer/slice", cfun_buffer_slice,
|
||||||
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||||
"Returns a new buffer.")
|
"Returns a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-set", cfun_buffer_bitset,
|
||||||
|
JDOC("(buffer/bit-set buffer index)\n\n"
|
||||||
|
"Sets the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-clear", cfun_buffer_bitclear,
|
||||||
|
JDOC("(buffer/bit-clear buffer index)\n\n"
|
||||||
|
"Clears the bit at the given bit-index. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit", cfun_buffer_bitget,
|
||||||
|
JDOC("(buffer/bit buffer index)\n\n"
|
||||||
|
"Gets the bit at the given bit-index. Returns true if the bit is set, false if not.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/bit-toggle", cfun_buffer_bittoggle,
|
||||||
|
JDOC("(buffer/bit-toggle buffer index)\n\n"
|
||||||
|
"Toggles the bit at the given bit index in buffer. Returns the buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/blit", cfun_buffer_blit,
|
||||||
|
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\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.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"buffer/format", cfun_buffer_format,
|
||||||
|
JDOC("(buffer/format buffer format & args)\n\n"
|
||||||
|
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||||
|
" the modified buffer.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
void janet_lib_buffer(JanetTable *env) {
|
void janet_lib_buffer(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,8 +20,10 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Look up table for instructions */
|
/* Look up table for instructions */
|
||||||
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||||
@@ -116,72 +118,62 @@ int32_t janet_verify(JanetFuncDef *def) {
|
|||||||
switch (type) {
|
switch (type) {
|
||||||
case JINT_0:
|
case JINT_0:
|
||||||
continue;
|
continue;
|
||||||
case JINT_S:
|
case JINT_S: {
|
||||||
{
|
if ((int32_t)(instr >> 8) >= sc) return 4;
|
||||||
if ((int32_t)(instr >> 8) >= sc) return 4;
|
continue;
|
||||||
continue;
|
}
|
||||||
}
|
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SU:
|
case JINT_SU:
|
||||||
case JINT_ST:
|
case JINT_ST: {
|
||||||
{
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
continue;
|
||||||
continue;
|
}
|
||||||
}
|
case JINT_L: {
|
||||||
case JINT_L:
|
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
||||||
{
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 8);
|
continue;
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
}
|
||||||
continue;
|
case JINT_SS: {
|
||||||
}
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
case JINT_SS:
|
|
||||||
{
|
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
|
||||||
(int32_t)(instr >> 16) >= sc) return 4;
|
(int32_t)(instr >> 16) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
case JINT_SSU:
|
case JINT_SSU: {
|
||||||
{
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc ||
|
|
||||||
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
(int32_t)((instr >> 16) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SL:
|
case JINT_SL: {
|
||||||
{
|
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
||||||
int32_t jumpdest = i + (((int32_t)instr) >> 16);
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
||||||
if (jumpdest < 0 || jumpdest >= def->bytecode_length) return 5;
|
continue;
|
||||||
continue;
|
}
|
||||||
}
|
case JINT_SSS: {
|
||||||
case JINT_SSS:
|
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
||||||
{
|
|
||||||
if (((int32_t)(instr >> 8) & 0xFF) >= sc ||
|
|
||||||
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
((int32_t)(instr >> 16) & 0xFF) >= sc ||
|
||||||
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
((int32_t)(instr >> 24) & 0xFF) >= sc) return 4;
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
case JINT_SD:
|
case JINT_SD: {
|
||||||
{
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
||||||
if ((int32_t)(instr >> 16) >= def->defs_length) return 6;
|
continue;
|
||||||
continue;
|
}
|
||||||
}
|
case JINT_SC: {
|
||||||
case JINT_SC:
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
{
|
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
continue;
|
||||||
if ((int32_t)(instr >> 16) >= def->constants_length) return 7;
|
}
|
||||||
continue;
|
case JINT_SES: {
|
||||||
}
|
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
||||||
case JINT_SES:
|
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
||||||
{
|
* to nil? (don't commit to this in the long term, though) */
|
||||||
/* How can we check the last slot index? We need info parent funcdefs. Resort
|
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
||||||
* to runtime checks for now. Maybe invalid upvalue references could be defaulted
|
if ((int32_t)((instr >> 16) & 0xFF) >= def->environments_length) return 8;
|
||||||
* to nil? (don't commit to this in the long term, though) */
|
continue;
|
||||||
if ((int32_t)((instr >> 8) & 0xFF) >= sc) return 4;
|
}
|
||||||
if ((int32_t)((instr >> 16) & 0xFF) >= def->environments_length) return 8;
|
|
||||||
continue;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -216,6 +208,8 @@ JanetFuncDef *janet_funcdef_alloc() {
|
|||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
def->slotcount = 0;
|
def->slotcount = 0;
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
|
def->max_arity = INT32_MAX;
|
||||||
def->source = NULL;
|
def->source = NULL;
|
||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
def->name = NULL;
|
def->name = NULL;
|
||||||
|
|||||||
@@ -20,14 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
void janet_panicv(Janet message) {
|
void janet_panicv(Janet message) {
|
||||||
if (janet_vm_fiber != NULL) {
|
if (janet_vm_return_reg != NULL) {
|
||||||
janet_fiber_push(janet_vm_fiber, message);
|
*janet_vm_return_reg = message;
|
||||||
longjmp(janet_vm_fiber->buf, 1);
|
longjmp(*janet_vm_jmp_buf, 1);
|
||||||
} else {
|
} else {
|
||||||
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||||
exit(1);
|
exit(1);
|
||||||
@@ -71,6 +73,16 @@ type janet_get##name(const Janet *argv, int32_t n) { \
|
|||||||
return janet_unwrap_##name(x); \
|
return janet_unwrap_##name(x); \
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
||||||
|
while (methods->name) {
|
||||||
|
if (!janet_cstrcmp(method, methods->name))
|
||||||
|
return janet_wrap_cfunction(methods->cfun);
|
||||||
|
methods++;
|
||||||
|
}
|
||||||
|
janet_panicf("unknown method %S invoked", method);
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
DEFINE_GETTER(number, NUMBER, double)
|
DEFINE_GETTER(number, NUMBER, double)
|
||||||
DEFINE_GETTER(array, ARRAY, JanetArray *)
|
DEFINE_GETTER(array, ARRAY, JanetArray *)
|
||||||
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
||||||
@@ -83,16 +95,8 @@ DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
|||||||
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||||
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||||
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||||
|
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||||
int janet_getboolean(const Janet *argv, int32_t n) {
|
DEFINE_GETTER(pointer, POINTER, void *)
|
||||||
Janet x = argv[n];
|
|
||||||
if (janet_checktype(x, JANET_TRUE)) {
|
|
||||||
return 1;
|
|
||||||
} else if (!janet_checktype(x, JANET_FALSE)) {
|
|
||||||
janet_panicf("bad slot #%d, expected boolean, got %v", n, x);
|
|
||||||
}
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||||
Janet x = argv[n];
|
Janet x = argv[n];
|
||||||
@@ -110,6 +114,30 @@ int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
|||||||
return (int64_t) janet_unwrap_number(x);
|
return (int64_t) janet_unwrap_number(x);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
size_t janet_getsize(const Janet *argv, int32_t n) {
|
||||||
|
Janet x = argv[n];
|
||||||
|
if (!janet_checksize(x)) {
|
||||||
|
janet_panicf("bad slot #%d, expected size, got %v", n, x);
|
||||||
|
}
|
||||||
|
return (size_t) janet_unwrap_number(x);
|
||||||
|
}
|
||||||
|
|
||||||
|
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||||
|
int32_t raw = janet_getinteger(argv, n);
|
||||||
|
if (raw < 0) raw += length + 1;
|
||||||
|
if (raw < 0 || raw > length)
|
||||||
|
janet_panicf("%s index %d out of range [0,%d]", which, raw, length);
|
||||||
|
return raw;
|
||||||
|
}
|
||||||
|
|
||||||
|
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
|
||||||
|
int32_t raw = janet_getinteger(argv, n);
|
||||||
|
if (raw < 0) raw += length;
|
||||||
|
if (raw < 0 || raw > length)
|
||||||
|
janet_panicf("%s index %d out of range [0,%d)", which, raw, length);
|
||||||
|
return raw;
|
||||||
|
}
|
||||||
|
|
||||||
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
JanetView janet_getindexed(const Janet *argv, int32_t n) {
|
||||||
Janet x = argv[n];
|
Janet x = argv[n];
|
||||||
JanetView view;
|
JanetView view;
|
||||||
@@ -157,32 +185,13 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
|||||||
range.start = 0;
|
range.start = 0;
|
||||||
range.end = length;
|
range.end = length;
|
||||||
} else if (argc == 2) {
|
} else if (argc == 2) {
|
||||||
range.start = janet_getinteger(argv, 1);
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
range.end = length;
|
range.end = length;
|
||||||
if (range.start < 0) {
|
|
||||||
range.start += length + 1;
|
|
||||||
}
|
|
||||||
if (range.start < 0 || range.start > length) {
|
|
||||||
janet_panicf("slice start: index %d out of range [0,%d]", range.start, length);
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
range.start = janet_getinteger(argv, 1);
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
range.end = janet_getinteger(argv, 2);
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
if (range.start < 0) {
|
if (range.end < range.start)
|
||||||
range.start += length + 1;
|
|
||||||
}
|
|
||||||
if (range.end < 0) {
|
|
||||||
range.end += length + 1;
|
|
||||||
}
|
|
||||||
if (range.start < 0 || range.start > length) {
|
|
||||||
janet_panicf("slice start: index %d out of range [0,%d]", range.start, length);
|
|
||||||
}
|
|
||||||
if (range.end < 0 || range.end > length) {
|
|
||||||
janet_panicf("slice end: index %d out of range [0,%d]", range.end, length);
|
|
||||||
}
|
|
||||||
if (range.end < range.start) {
|
|
||||||
range.end = range.start;
|
range.end = range.start;
|
||||||
}
|
|
||||||
}
|
}
|
||||||
return range;
|
return range;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,10 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
@@ -62,10 +64,10 @@ static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
|||||||
|
|
||||||
/* Emit a series of instructions instead of a function call to a math op */
|
/* Emit a series of instructions instead of a function call to a math op */
|
||||||
static JanetSlot opreduce(
|
static JanetSlot opreduce(
|
||||||
JanetFopts opts,
|
JanetFopts opts,
|
||||||
JanetSlot *args,
|
JanetSlot *args,
|
||||||
int op,
|
int op,
|
||||||
Janet nullary) {
|
Janet nullary) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
len = janet_v_count(args);
|
len = janet_v_count(args);
|
||||||
@@ -99,8 +101,15 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
|||||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||||
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
if (opts.flags & JANET_FOPTS_DROP) {
|
||||||
return args[0];
|
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
} else {
|
||||||
|
JanetSlot t = janetc_gettarget(opts);
|
||||||
|
janetc_copy(opts.compiler, t, args[0]);
|
||||||
|
janetc_emit_sss(opts.compiler, JOP_PUT, t, args[1], args[2], 0);
|
||||||
|
return t;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
||||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||||
@@ -116,9 +125,9 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
|||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 1; i < janet_v_count(args) - 3; i += 3)
|
for (i = 1; i < janet_v_count(args) - 3; i += 3)
|
||||||
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i+1], args[i+2], 0);
|
janetc_emit_sss(c, JOP_PUSH_3, args[i], args[i + 1], args[i + 2], 0);
|
||||||
if (i == janet_v_count(args) - 3)
|
if (i == janet_v_count(args) - 3)
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, args[i], args[i + 1], 0);
|
||||||
else if (i == janet_v_count(args) - 2)
|
else if (i == janet_v_count(args) - 2)
|
||||||
janetc_emit_s(c, JOP_PUSH, args[i], 0);
|
janetc_emit_s(c, JOP_PUSH, args[i], 0);
|
||||||
/* Push array phase */
|
/* Push array phase */
|
||||||
@@ -174,10 +183,10 @@ static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
|
|||||||
|
|
||||||
/* Specialization for comparators */
|
/* Specialization for comparators */
|
||||||
static JanetSlot compreduce(
|
static JanetSlot compreduce(
|
||||||
JanetFopts opts,
|
JanetFopts opts,
|
||||||
JanetSlot *args,
|
JanetSlot *args,
|
||||||
int op,
|
int op,
|
||||||
int invert) {
|
int invert) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
int32_t i, len;
|
int32_t i, len;
|
||||||
len = janet_v_count(args);
|
len = janet_v_count(args);
|
||||||
@@ -185,8 +194,8 @@ static JanetSlot compreduce(
|
|||||||
JanetSlot t;
|
JanetSlot t;
|
||||||
if (len < 2) {
|
if (len < 2) {
|
||||||
return invert
|
return invert
|
||||||
? janetc_cslot(janet_wrap_false())
|
? janetc_cslot(janet_wrap_false())
|
||||||
: janetc_cslot(janet_wrap_true());
|
: janetc_cslot(janet_wrap_true());
|
||||||
}
|
}
|
||||||
t = janetc_gettarget(opts);
|
t = janetc_gettarget(opts);
|
||||||
for (i = 1; i < len; i++) {
|
for (i = 1; i < len; i++) {
|
||||||
@@ -288,7 +297,7 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
|||||||
if (tag == 0)
|
if (tag == 0)
|
||||||
return NULL;
|
return NULL;
|
||||||
uint32_t index = tag - 1;
|
uint32_t index = tag - 1;
|
||||||
if (index >= (sizeof(optimizers)/sizeof(optimizers[0])))
|
if (index >= (sizeof(optimizers) / sizeof(optimizers[0])))
|
||||||
return NULL;
|
return NULL;
|
||||||
return optimizers + index;
|
return optimizers + index;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||||
JanetFopts ret;
|
JanetFopts ret;
|
||||||
@@ -95,7 +97,6 @@ void janetc_scope(JanetScope *s, JanetCompiler *c, int flags, const char *name)
|
|||||||
scope.syms = NULL;
|
scope.syms = NULL;
|
||||||
scope.envs = NULL;
|
scope.envs = NULL;
|
||||||
scope.defs = NULL;
|
scope.defs = NULL;
|
||||||
scope.selfconst = -1;
|
|
||||||
scope.bytecode_start = janet_v_count(c->buffer);
|
scope.bytecode_start = janet_v_count(c->buffer);
|
||||||
scope.flags = flags;
|
scope.flags = flags;
|
||||||
scope.parent = c->scope;
|
scope.parent = c->scope;
|
||||||
@@ -164,8 +165,8 @@ void janetc_popscope_keepslot(JanetCompiler *c, JanetSlot retslot) {
|
|||||||
|
|
||||||
/* Allow searching for symbols. Return information about the symbol */
|
/* Allow searching for symbols. Return information about the symbol */
|
||||||
JanetSlot janetc_resolve(
|
JanetSlot janetc_resolve(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym) {
|
const uint8_t *sym) {
|
||||||
|
|
||||||
JanetSlot ret = janetc_cslot(janet_wrap_nil());
|
JanetSlot ret = janetc_cslot(janet_wrap_nil());
|
||||||
JanetScope *scope = c->scope;
|
JanetScope *scope = c->scope;
|
||||||
@@ -204,8 +205,7 @@ JanetSlot janetc_resolve(
|
|||||||
case JANET_BINDING_DEF:
|
case JANET_BINDING_DEF:
|
||||||
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
case JANET_BINDING_MACRO: /* Macro should function like defs when not in calling pos */
|
||||||
return janetc_cslot(check);
|
return janetc_cslot(check);
|
||||||
case JANET_BINDING_VAR:
|
case JANET_BINDING_VAR: {
|
||||||
{
|
|
||||||
JanetSlot ret = janetc_cslot(check);
|
JanetSlot ret = janetc_cslot(check);
|
||||||
/* TODO save type info */
|
/* TODO save type info */
|
||||||
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
ret.flags |= JANET_SLOT_REF | JANET_SLOT_NAMED | JANET_SLOT_MUTABLE | JANET_SLOTTYPE_ANY;
|
||||||
@@ -216,7 +216,7 @@ JanetSlot janetc_resolve(
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Symbol was found */
|
/* Symbol was found */
|
||||||
found:
|
found:
|
||||||
|
|
||||||
/* Constants can be returned immediately (they are stateless) */
|
/* Constants can be returned immediately (they are stateless) */
|
||||||
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
|
if (ret.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF))
|
||||||
@@ -281,8 +281,8 @@ JanetSlot janetc_return(JanetCompiler *c, JanetSlot s) {
|
|||||||
JanetSlot janetc_gettarget(JanetFopts opts) {
|
JanetSlot janetc_gettarget(JanetFopts opts) {
|
||||||
JanetSlot slot;
|
JanetSlot slot;
|
||||||
if ((opts.flags & JANET_FOPTS_HINT) &&
|
if ((opts.flags & JANET_FOPTS_HINT) &&
|
||||||
(opts.hint.envindex < 0) &&
|
(opts.hint.envindex < 0) &&
|
||||||
(opts.hint.index >= 0 && opts.hint.index <= 0xFF)) {
|
(opts.hint.index >= 0 && opts.hint.index <= 0xFF)) {
|
||||||
slot = opts.hint;
|
slot = opts.hint;
|
||||||
} else {
|
} else {
|
||||||
slot.envindex = -1;
|
slot.envindex = -1;
|
||||||
@@ -332,17 +332,17 @@ void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
|||||||
i++;
|
i++;
|
||||||
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+1], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
} else if (i + 2 == count) {
|
} else if (i + 2 == count) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i+1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i+2], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i+1], slots[i+2], 0);
|
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -403,7 +403,9 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
|||||||
}
|
}
|
||||||
if (!specialized) {
|
if (!specialized) {
|
||||||
janetc_pushslots(c, slots);
|
janetc_pushslots(c, slots);
|
||||||
if (opts.flags & JANET_FOPTS_TAIL) {
|
if ((opts.flags & JANET_FOPTS_TAIL) &&
|
||||||
|
/* Prevent top level tail calls for better errors */
|
||||||
|
!(c->scope->flags & JANET_SCOPE_TOP)) {
|
||||||
janetc_emit_s(c, JOP_TAILCALL, fun, 0);
|
janetc_emit_s(c, JOP_TAILCALL, fun, 0);
|
||||||
retslot = janetc_cslot(janet_wrap_nil());
|
retslot = janetc_cslot(janet_wrap_nil());
|
||||||
retslot.flags = JANET_SLOT_RETURNED;
|
retslot.flags = JANET_SLOT_RETURNED;
|
||||||
@@ -430,15 +432,23 @@ static JanetSlot janetc_array(JanetFopts opts, Janet x) {
|
|||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
JanetArray *a = janet_unwrap_array(x);
|
JanetArray *a = janet_unwrap_array(x);
|
||||||
return janetc_maker(opts,
|
return janetc_maker(opts,
|
||||||
janetc_toslots(c, a->data, a->count),
|
janetc_toslots(c, a->data, a->count),
|
||||||
JOP_MAKE_ARRAY);
|
JOP_MAKE_ARRAY);
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetSlot janetc_tuple(JanetFopts opts, Janet x) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
const Janet *t = janet_unwrap_tuple(x);
|
||||||
|
return janetc_maker(opts,
|
||||||
|
janetc_toslots(c, t, janet_tuple_length(t)),
|
||||||
|
JOP_MAKE_TUPLE);
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
|
static JanetSlot janetc_tablector(JanetFopts opts, Janet x, int op) {
|
||||||
JanetCompiler *c = opts.compiler;
|
JanetCompiler *c = opts.compiler;
|
||||||
return janetc_maker(opts,
|
return janetc_maker(opts,
|
||||||
janetc_toslotskv(c, x),
|
janetc_toslotskv(c, x),
|
||||||
op);
|
op);
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
|
static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
|
||||||
@@ -446,17 +456,17 @@ static JanetSlot janetc_bufferctor(JanetFopts opts, Janet x) {
|
|||||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||||
Janet onearg = janet_stringv(b->data, b->count);
|
Janet onearg = janet_stringv(b->data, b->count);
|
||||||
return janetc_maker(opts,
|
return janetc_maker(opts,
|
||||||
janetc_toslots(c, &onearg, 1),
|
janetc_toslots(c, &onearg, 1),
|
||||||
JOP_MAKE_BUFFER);
|
JOP_MAKE_BUFFER);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Expand a macro one time. Also get the special form compiler if we
|
/* Expand a macro one time. Also get the special form compiler if we
|
||||||
* find that instead. */
|
* find that instead. */
|
||||||
static int macroexpand1(
|
static int macroexpand1(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
Janet x,
|
Janet x,
|
||||||
Janet *out,
|
Janet *out,
|
||||||
const JanetSpecial **spec) {
|
const JanetSpecial **spec) {
|
||||||
if (!janet_checktype(x, JANET_TUPLE))
|
if (!janet_checktype(x, JANET_TUPLE))
|
||||||
return 0;
|
return 0;
|
||||||
const Janet *form = janet_unwrap_tuple(x);
|
const Janet *form = janet_unwrap_tuple(x);
|
||||||
@@ -467,6 +477,9 @@ static int macroexpand1(
|
|||||||
c->current_mapping.start = janet_tuple_sm_start(form);
|
c->current_mapping.start = janet_tuple_sm_start(form);
|
||||||
c->current_mapping.end = janet_tuple_sm_end(form);
|
c->current_mapping.end = janet_tuple_sm_end(form);
|
||||||
}
|
}
|
||||||
|
/* Bracketed tuples are not specials or macros! */
|
||||||
|
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
|
return 0;
|
||||||
if (!janet_checktype(form[0], JANET_SYMBOL))
|
if (!janet_checktype(form[0], JANET_SYMBOL))
|
||||||
return 0;
|
return 0;
|
||||||
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
const uint8_t *name = janet_unwrap_symbol(form[0]);
|
||||||
@@ -482,15 +495,15 @@ static int macroexpand1(
|
|||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
/* Evaluate macro */
|
/* Evaluate macro */
|
||||||
JanetFiber *fiberp;
|
JanetFiber *fiberp = NULL;
|
||||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||||
int lock = janet_gclock();
|
int lock = janet_gclock();
|
||||||
JanetSignal status = janet_call(
|
JanetSignal status = janet_pcall(
|
||||||
macro,
|
macro,
|
||||||
janet_tuple_length(form) - 1,
|
janet_tuple_length(form) - 1,
|
||||||
form + 1,
|
form + 1,
|
||||||
&x,
|
&x,
|
||||||
&fiberp);
|
&fiberp);
|
||||||
janet_gcunlock(lock);
|
janet_gcunlock(lock);
|
||||||
if (status != JANET_SIGNAL_OK) {
|
if (status != JANET_SIGNAL_OK) {
|
||||||
const uint8_t *es = janet_formatc("(macro) %V", x);
|
const uint8_t *es = janet_formatc("(macro) %V", x);
|
||||||
@@ -536,24 +549,25 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
ret = spec->compile(opts, janet_tuple_length(tup) - 1, tup + 1);
|
||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
/* Empty tuple is tuple literal */
|
||||||
/* Empty tuple is tuple literal */
|
if (janet_tuple_length(tup) == 0) {
|
||||||
if (janet_tuple_length(tup) == 0) {
|
ret = janetc_cslot(x);
|
||||||
ret = janetc_cslot(x);
|
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||||
} else {
|
ret = janetc_tuple(opts, x);
|
||||||
JanetSlot head = janetc_value(subopts, tup[0]);
|
} else {
|
||||||
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
JanetSlot head = janetc_value(subopts, tup[0]);
|
||||||
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
|
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
||||||
janetc_freeslot(c, head);
|
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
|
||||||
}
|
janetc_freeslot(c, head);
|
||||||
ret.flags &= ~JANET_SLOT_SPLICED;
|
|
||||||
}
|
}
|
||||||
break;
|
ret.flags &= ~JANET_SLOT_SPLICED;
|
||||||
|
}
|
||||||
|
break;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
ret = janetc_resolve(opts.compiler, janet_unwrap_symbol(x));
|
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY:
|
||||||
ret = janetc_array(opts, x);
|
ret = janetc_array(opts, x);
|
||||||
@@ -576,13 +590,13 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
|||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
if (opts.flags & JANET_FOPTS_TAIL)
|
if (opts.flags & JANET_FOPTS_TAIL)
|
||||||
ret = janetc_return(opts.compiler, ret);
|
ret = janetc_return(c, ret);
|
||||||
if (opts.flags & JANET_FOPTS_HINT) {
|
if (opts.flags & JANET_FOPTS_HINT) {
|
||||||
janetc_copy(opts.compiler, opts.hint, ret);
|
janetc_copy(c, opts.hint, ret);
|
||||||
ret = opts.hint;
|
ret = opts.hint;
|
||||||
}
|
}
|
||||||
c->current_mapping = last_mapping;
|
c->current_mapping = last_mapping;
|
||||||
opts.compiler->recursion_guard++;
|
c->recursion_guard++;
|
||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -629,6 +643,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
def->source = c->source;
|
def->source = c->source;
|
||||||
|
|
||||||
def->arity = 0;
|
def->arity = 0;
|
||||||
|
def->min_arity = 0;
|
||||||
def->flags = 0;
|
def->flags = 0;
|
||||||
if (scope->flags & JANET_SCOPE_ENV) {
|
if (scope->flags & JANET_SCOPE_ENV) {
|
||||||
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
def->flags |= JANET_FUNCDEF_FLAG_NEEDSENV;
|
||||||
@@ -722,17 +737,18 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg compile_cfuns[] = {
|
||||||
{"compile", cfun,
|
{
|
||||||
|
"compile", cfun,
|
||||||
JDOC("(compile ast env [, source])\n\n"
|
JDOC("(compile ast env [, source])\n\n"
|
||||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||||
"Pair the compile function with parsing functionality to implement "
|
"Pair the compile function with parsing functionality to implement "
|
||||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||||
"error if the ast cannot be compiled.")
|
"error if the ast cannot be compiled.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
void janet_lib_compile(JanetTable *env) {
|
void janet_lib_compile(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -23,8 +23,10 @@
|
|||||||
#ifndef JANET_COMPILE_H
|
#ifndef JANET_COMPILE_H
|
||||||
#define JANET_COMPILE_H
|
#define JANET_COMPILE_H
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Tags for some functions for the prepared inliner */
|
/* Tags for some functions for the prepared inliner */
|
||||||
#define JANET_FUN_DEBUG 1
|
#define JANET_FUN_DEBUG 1
|
||||||
@@ -94,6 +96,7 @@ struct JanetSlot {
|
|||||||
#define JANET_SCOPE_TOP 4
|
#define JANET_SCOPE_TOP 4
|
||||||
#define JANET_SCOPE_UNUSED 8
|
#define JANET_SCOPE_UNUSED 8
|
||||||
#define JANET_SCOPE_CLOSURE 16
|
#define JANET_SCOPE_CLOSURE 16
|
||||||
|
#define JANET_SCOPE_WHILE 32
|
||||||
|
|
||||||
/* A symbol and slot pair */
|
/* A symbol and slot pair */
|
||||||
typedef struct SymPair {
|
typedef struct SymPair {
|
||||||
@@ -129,9 +132,6 @@ struct JanetScope {
|
|||||||
* that corresponds to the direct parent's stack will always have value 0. */
|
* that corresponds to the direct parent's stack will always have value 0. */
|
||||||
int32_t *envs;
|
int32_t *envs;
|
||||||
|
|
||||||
/* Where to add reference to self in constants */
|
|
||||||
int32_t selfconst;
|
|
||||||
|
|
||||||
int32_t bytecode_start;
|
int32_t bytecode_start;
|
||||||
int flags;
|
int flags;
|
||||||
};
|
};
|
||||||
@@ -178,13 +178,13 @@ JanetFopts janetc_fopts_default(JanetCompiler *c);
|
|||||||
/* For optimizing builtin normal functions. */
|
/* For optimizing builtin normal functions. */
|
||||||
struct JanetFunOptimizer {
|
struct JanetFunOptimizer {
|
||||||
int (*can_optimize)(JanetFopts opts, JanetSlot *args);
|
int (*can_optimize)(JanetFopts opts, JanetSlot *args);
|
||||||
JanetSlot (*optimize)(JanetFopts opts, JanetSlot *args);
|
JanetSlot(*optimize)(JanetFopts opts, JanetSlot *args);
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A grouping of a named special and the corresponding compiler fragment */
|
/* A grouping of a named special and the corresponding compiler fragment */
|
||||||
struct JanetSpecial {
|
struct JanetSpecial {
|
||||||
const char *name;
|
const char *name;
|
||||||
JanetSlot (*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
|
JanetSlot(*compile)(JanetFopts opts, int32_t argn, const Janet *argv);
|
||||||
};
|
};
|
||||||
|
|
||||||
/****************************************************/
|
/****************************************************/
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -20,14 +20,21 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Generated bytes */
|
/* Generated bytes */
|
||||||
|
#ifdef JANET_BOOTSTRAP
|
||||||
extern const unsigned char *janet_gen_core;
|
extern const unsigned char *janet_gen_core;
|
||||||
extern int32_t janet_gen_core_size;
|
extern int32_t janet_gen_core_size;
|
||||||
|
#else
|
||||||
|
extern const unsigned char *janet_core_image;
|
||||||
|
extern size_t janet_core_image_size;
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
/* Use LoadLibrary on windows or dlopen on posix to load dynamic libaries
|
||||||
* with native code. */
|
* with native code. */
|
||||||
@@ -98,43 +105,31 @@ static Janet janet_core_print(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer b;
|
JanetBuffer *b = janet_buffer(0);
|
||||||
janet_buffer_init(&b, 0);
|
|
||||||
for (int32_t i = 0; i < argc; ++i)
|
for (int32_t i = 0; i < argc; ++i)
|
||||||
janet_description_b(&b, argv[i]);
|
janet_description_b(b, argv[i]);
|
||||||
Janet ret = janet_stringv(b.data, b.count);
|
return janet_stringv(b->data, b->count);
|
||||||
janet_buffer_deinit(&b);
|
|
||||||
return ret;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_string(int32_t argc, Janet *argv) {
|
static Janet janet_core_string(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer b;
|
JanetBuffer *b = janet_buffer(0);
|
||||||
janet_buffer_init(&b, 0);
|
|
||||||
for (int32_t i = 0; i < argc; ++i)
|
for (int32_t i = 0; i < argc; ++i)
|
||||||
janet_to_string_b(&b, argv[i]);
|
janet_to_string_b(b, argv[i]);
|
||||||
Janet ret = janet_stringv(b.data, b.count);
|
return janet_stringv(b->data, b->count);
|
||||||
janet_buffer_deinit(&b);
|
|
||||||
return ret;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
|
static Janet janet_core_symbol(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer b;
|
JanetBuffer *b = janet_buffer(0);
|
||||||
janet_buffer_init(&b, 0);
|
|
||||||
for (int32_t i = 0; i < argc; ++i)
|
for (int32_t i = 0; i < argc; ++i)
|
||||||
janet_to_string_b(&b, argv[i]);
|
janet_to_string_b(b, argv[i]);
|
||||||
Janet ret = janet_symbolv(b.data, b.count);
|
return janet_symbolv(b->data, b->count);
|
||||||
janet_buffer_deinit(&b);
|
|
||||||
return ret;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
|
static Janet janet_core_keyword(int32_t argc, Janet *argv) {
|
||||||
JanetBuffer b;
|
JanetBuffer *b = janet_buffer(0);
|
||||||
janet_buffer_init(&b, 0);
|
|
||||||
for (int32_t i = 0; i < argc; ++i)
|
for (int32_t i = 0; i < argc; ++i)
|
||||||
janet_to_string_b(&b, argv[i]);
|
janet_to_string_b(b, argv[i]);
|
||||||
Janet ret = janet_keywordv(b.data, b.count);
|
return janet_keywordv(b->data, b->count);
|
||||||
janet_buffer_deinit(&b);
|
|
||||||
return ret;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
|
static Janet janet_core_buffer(int32_t argc, Janet *argv) {
|
||||||
@@ -152,7 +147,7 @@ static Janet janet_core_is_abstract(int32_t argc, Janet *argv) {
|
|||||||
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
|
static Janet janet_core_scannumber(int32_t argc, Janet *argv) {
|
||||||
double number;
|
double number;
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetByteView view = janet_getbytes(argv, 1);
|
JanetByteView view = janet_getbytes(argv, 0);
|
||||||
if (janet_scan_number(view.bytes, view.len, &number))
|
if (janet_scan_number(view.bytes, view.len, &number))
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
return janet_wrap_number(number);
|
return janet_wrap_number(number);
|
||||||
@@ -234,8 +229,8 @@ static Janet janet_core_next(int32_t argc, Janet *argv) {
|
|||||||
JanetDictView view = janet_getdictionary(argv, 0);
|
JanetDictView view = janet_getdictionary(argv, 0);
|
||||||
const JanetKV *end = view.kvs + view.cap;
|
const JanetKV *end = view.kvs + view.cap;
|
||||||
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
const JanetKV *kv = janet_checktype(argv[1], JANET_NIL)
|
||||||
? view.kvs
|
? view.kvs
|
||||||
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
: janet_dict_find(view.kvs, view.cap, argv[1]) + 1;
|
||||||
while (kv < end) {
|
while (kv < end) {
|
||||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
if (!janet_checktype(kv->key, JANET_NIL)) return kv->key;
|
||||||
kv++;
|
kv++;
|
||||||
@@ -248,153 +243,206 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_number(janet_hash(argv[0]));
|
return janet_wrap_number(janet_hash(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||||
{"native", janet_core_native,
|
janet_arity(argc, 0, 2);
|
||||||
|
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||||
|
if (argc >= 1) {
|
||||||
|
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||||
|
printf("%s", prompt);
|
||||||
|
fflush(stdout);
|
||||||
|
}
|
||||||
|
{
|
||||||
|
buf->count = 0;
|
||||||
|
int c;
|
||||||
|
for (;;) {
|
||||||
|
c = fgetc(stdin);
|
||||||
|
if (feof(stdin) || c < 0) {
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(buf, (uint8_t) c);
|
||||||
|
if (c == '\n') break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return janet_wrap_buffer(buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg corelib_cfuns[] = {
|
||||||
|
{
|
||||||
|
"native", janet_core_native,
|
||||||
JDOC("(native path [,env])\n\n"
|
JDOC("(native path [,env])\n\n"
|
||||||
"Load a native module from the given path. The path "
|
"Load a native module from the given path. The path "
|
||||||
"must be an absolute or relative path on the file system, and is "
|
"must be an absolute or relative path on the file system, and is "
|
||||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||||
"Returns an environment table that contains functions and other values "
|
"Returns an environment table that contains functions and other values "
|
||||||
"from the native module.")
|
"from the native module.")
|
||||||
},
|
},
|
||||||
{"print", janet_core_print,
|
{
|
||||||
|
"print", janet_core_print,
|
||||||
JDOC("(print & xs)\n\n"
|
JDOC("(print & xs)\n\n"
|
||||||
"Print values to the console (standard out). Value are converted "
|
"Print values to the console (standard out). Value are converted "
|
||||||
"to strings if they are not already. After printing all values, a "
|
"to strings if they are not already. After printing all values, a "
|
||||||
"newline character is printed. Returns nil.")
|
"newline character is printed. Returns nil.")
|
||||||
},
|
},
|
||||||
{"describe", janet_core_describe,
|
{
|
||||||
|
"describe", janet_core_describe,
|
||||||
JDOC("(describe x)\n\n"
|
JDOC("(describe x)\n\n"
|
||||||
"Returns a string that is a human readable description of a value x.")
|
"Returns a string that is a human readable description of a value x.")
|
||||||
},
|
},
|
||||||
{"string", janet_core_string,
|
{
|
||||||
|
"string", janet_core_string,
|
||||||
JDOC("(string & parts)\n\n"
|
JDOC("(string & parts)\n\n"
|
||||||
"Creates a string by concatenating values together. Values are "
|
"Creates a string by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. "
|
"converted to bytes via describe if they are not byte sequences. "
|
||||||
"Returns the new string.")
|
"Returns the new string.")
|
||||||
},
|
},
|
||||||
{"symbol", janet_core_symbol,
|
{
|
||||||
|
"symbol", janet_core_symbol,
|
||||||
JDOC("(symbol & xs)\n\n"
|
JDOC("(symbol & xs)\n\n"
|
||||||
"Creates a symbol by concatenating values together. Values are "
|
"Creates a symbol by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new symbol.")
|
"the new symbol.")
|
||||||
},
|
},
|
||||||
{"keyword", janet_core_keyword,
|
{
|
||||||
|
"keyword", janet_core_keyword,
|
||||||
JDOC("(keyword & xs)\n\n"
|
JDOC("(keyword & xs)\n\n"
|
||||||
"Creates a keyword by concatenating values together. Values are "
|
"Creates a keyword by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new keyword.")
|
"the new keyword.")
|
||||||
},
|
},
|
||||||
{"buffer", janet_core_buffer,
|
{
|
||||||
|
"buffer", janet_core_buffer,
|
||||||
JDOC("(buffer & xs)\n\n"
|
JDOC("(buffer & xs)\n\n"
|
||||||
"Creates a new buffer by concatenating values together. Values are "
|
"Creates a new buffer by concatenating values together. Values are "
|
||||||
"converted to bytes via describe if they are not byte sequences. Returns "
|
"converted to bytes via describe if they are not byte sequences. Returns "
|
||||||
"the new buffer.")
|
"the new buffer.")
|
||||||
},
|
},
|
||||||
{"abstract?", janet_core_is_abstract,
|
{
|
||||||
|
"abstract?", janet_core_is_abstract,
|
||||||
JDOC("(abstract? x)\n\n"
|
JDOC("(abstract? x)\n\n"
|
||||||
"Check if x is an abstract type.")
|
"Check if x is an abstract type.")
|
||||||
},
|
},
|
||||||
{"table", janet_core_table,
|
{
|
||||||
|
"table", janet_core_table,
|
||||||
JDOC("(table & kvs)\n\n"
|
JDOC("(table & kvs)\n\n"
|
||||||
"Creates a new table from a variadic number of keys and values. "
|
"Creates a new table from a variadic number of keys and values. "
|
||||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||||
"an odd number of elements, an error will be thrown. Returns the "
|
"an odd number of elements, an error will be thrown. Returns the "
|
||||||
"new table.")
|
"new table.")
|
||||||
},
|
},
|
||||||
{"array", janet_core_array,
|
{
|
||||||
|
"array", janet_core_array,
|
||||||
JDOC("(array & items)\n\n"
|
JDOC("(array & items)\n\n"
|
||||||
"Create a new array that contains items. Returns the new array.")
|
"Create a new array that contains items. Returns the new array.")
|
||||||
},
|
},
|
||||||
{"scan-number", janet_core_scannumber,
|
{
|
||||||
|
"scan-number", janet_core_scannumber,
|
||||||
JDOC("(scan-number str)\n\n"
|
JDOC("(scan-number str)\n\n"
|
||||||
"Parse a number from a byte sequence an return that number, either and integer "
|
"Parse a number from a byte sequence an return that number, either and integer "
|
||||||
"or a real. The number "
|
"or a real. The number "
|
||||||
"must be in the same format as numbers in janet source code. Will return nil "
|
"must be in the same format as numbers in janet source code. Will return nil "
|
||||||
"on an invalid number.")
|
"on an invalid number.")
|
||||||
},
|
},
|
||||||
{"tuple", janet_core_tuple,
|
{
|
||||||
|
"tuple", janet_core_tuple,
|
||||||
JDOC("(tuple & items)\n\n"
|
JDOC("(tuple & items)\n\n"
|
||||||
"Creates a new tuple that contains items. Returns the new tuple.")
|
"Creates a new tuple that contains items. Returns the new tuple.")
|
||||||
},
|
},
|
||||||
{"struct", janet_core_struct,
|
{
|
||||||
|
"struct", janet_core_struct,
|
||||||
JDOC("(struct & kvs)\n\n"
|
JDOC("(struct & kvs)\n\n"
|
||||||
"Create a new struct from a sequence of key value pairs. "
|
"Create a new struct from a sequence of key value pairs. "
|
||||||
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
"kvs is a sequence k1, v1, k2, v2, k3, v3, ... If kvs has "
|
||||||
"an odd number of elements, an error will be thrown. Returns the "
|
"an odd number of elements, an error will be thrown. Returns the "
|
||||||
"new struct.")
|
"new struct.")
|
||||||
},
|
},
|
||||||
{"gensym", janet_core_gensym,
|
{
|
||||||
|
"gensym", janet_core_gensym,
|
||||||
JDOC("(gensym)\n\n"
|
JDOC("(gensym)\n\n"
|
||||||
"Returns a new symbol that is unique across the runtime. This means it "
|
"Returns a new symbol that is unique across the runtime. This means it "
|
||||||
"will not collide with any already created symbols during compilation, so "
|
"will not collide with any already created symbols during compilation, so "
|
||||||
"it can be used in macros to generate automatic bindings.")
|
"it can be used in macros to generate automatic bindings.")
|
||||||
},
|
},
|
||||||
{"gccollect", janet_core_gccollect,
|
{
|
||||||
|
"gccollect", janet_core_gccollect,
|
||||||
JDOC("(gccollect)\n\n"
|
JDOC("(gccollect)\n\n"
|
||||||
"Run garbage collection. You should probably not call this manually.")
|
"Run garbage collection. You should probably not call this manually.")
|
||||||
},
|
},
|
||||||
{"gcsetinterval", janet_core_gcsetinterval,
|
{
|
||||||
|
"gcsetinterval", janet_core_gcsetinterval,
|
||||||
JDOC("(gcsetinterval interval)\n\n"
|
JDOC("(gcsetinterval interval)\n\n"
|
||||||
"Set an integer number of bytes to allocate before running garbage collection. "
|
"Set an integer number of bytes to allocate before running garbage collection. "
|
||||||
"Low valuesi for interval will be slower but use less memory. "
|
"Low valuesi for interval will be slower but use less memory. "
|
||||||
"High values will be faster but use more memory.")
|
"High values will be faster but use more memory.")
|
||||||
},
|
},
|
||||||
{"gcinterval", janet_core_gcinterval,
|
{
|
||||||
|
"gcinterval", janet_core_gcinterval,
|
||||||
JDOC("(gcinterval)\n\n"
|
JDOC("(gcinterval)\n\n"
|
||||||
"Returns the integer number of bytes to allocate before running an iteration "
|
"Returns the integer number of bytes to allocate before running an iteration "
|
||||||
"of garbage collection.")
|
"of garbage collection.")
|
||||||
},
|
},
|
||||||
{"type", janet_core_type,
|
{
|
||||||
|
"type", janet_core_type,
|
||||||
JDOC("(type x)\n\n"
|
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 symbol. x is one of\n"
|
||||||
"\t:nil\n"
|
"\t:nil\n"
|
||||||
"\t:boolean\n"
|
"\t:boolean\n"
|
||||||
"\t:integer\n"
|
"\t:integer\n"
|
||||||
"\t:real\n"
|
"\t:real\n"
|
||||||
"\t:array\n"
|
"\t:array\n"
|
||||||
"\t:tuple\n"
|
"\t:tuple\n"
|
||||||
"\t:table\n"
|
"\t:table\n"
|
||||||
"\t:struct\n"
|
"\t:struct\n"
|
||||||
"\t:string\n"
|
"\t:string\n"
|
||||||
"\t:buffer\n"
|
"\t:buffer\n"
|
||||||
"\t:symbol\n"
|
"\t:symbol\n"
|
||||||
"\t:keyword\n"
|
"\t:keyword\n"
|
||||||
"\t:function\n"
|
"\t:function\n"
|
||||||
"\t:cfunction\n\n"
|
"\t:cfunction\n\n"
|
||||||
"or another symbol for an abstract type.")
|
"or another symbol for an abstract type.")
|
||||||
},
|
},
|
||||||
{"next", janet_core_next,
|
{
|
||||||
|
"next", janet_core_next,
|
||||||
JDOC("(next dict key)\n\n"
|
JDOC("(next dict key)\n\n"
|
||||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||||
"to be seen only once per iteration if they data structure is not mutated "
|
"to be seen only once per iteration if they data structure is not mutated "
|
||||||
"during iteration. If key is nil, next returns the first key. If next "
|
"during iteration. If key is nil, next returns the first key. If next "
|
||||||
"returns nil, there are no more keys to iterate through. ")
|
"returns nil, there are no more keys to iterate through. ")
|
||||||
},
|
},
|
||||||
{"hash", janet_core_hash,
|
{
|
||||||
|
"hash", janet_core_hash,
|
||||||
JDOC("(hash value)\n\n"
|
JDOC("(hash value)\n\n"
|
||||||
"Gets a hash value for any janet value. The hash is an integer can be used "
|
"Gets a hash value for any janet value. The hash is an integer can be used "
|
||||||
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
"as a cheap hash function for all janet objects. If two values are strictly equal, "
|
||||||
"then they will have the same hash value.")
|
"then they will have the same hash value.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"getline", janet_core_getline,
|
||||||
|
JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n"
|
||||||
|
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||||
|
"Use this function to implement a simple interface for a terminal program.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
#ifndef JANET_NO_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
|
|
||||||
/* Utility for inline assembly */
|
/* Utility for inline assembly */
|
||||||
static void janet_quick_asm(
|
static void janet_quick_asm(
|
||||||
JanetTable *env,
|
JanetTable *env,
|
||||||
int32_t flags,
|
int32_t flags,
|
||||||
const char *name,
|
const char *name,
|
||||||
int32_t arity,
|
int32_t arity,
|
||||||
int32_t slots,
|
int32_t min_arity,
|
||||||
const uint32_t *bytecode,
|
int32_t max_arity,
|
||||||
size_t bytecode_size,
|
int32_t slots,
|
||||||
const char *doc) {
|
const uint32_t *bytecode,
|
||||||
|
size_t bytecode_size,
|
||||||
|
const char *doc) {
|
||||||
JanetFuncDef *def = janet_funcdef_alloc();
|
JanetFuncDef *def = janet_funcdef_alloc();
|
||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
|
def->min_arity = min_arity;
|
||||||
|
def->max_arity = max_arity;
|
||||||
def->flags = flags;
|
def->flags = flags;
|
||||||
def->slotcount = slots;
|
def->slotcount = slots;
|
||||||
def->bytecode = malloc(bytecode_size);
|
def->bytecode = malloc(bytecode_size);
|
||||||
@@ -416,13 +464,13 @@ static void janet_quick_asm(
|
|||||||
|
|
||||||
/* Templatize a varop */
|
/* Templatize a varop */
|
||||||
static void templatize_varop(
|
static void templatize_varop(
|
||||||
JanetTable *env,
|
JanetTable *env,
|
||||||
int32_t flags,
|
int32_t flags,
|
||||||
const char *name,
|
const char *name,
|
||||||
int32_t nullary,
|
int32_t nullary,
|
||||||
int32_t unary,
|
int32_t unary,
|
||||||
uint32_t op,
|
uint32_t op,
|
||||||
const char *doc) {
|
const char *doc) {
|
||||||
|
|
||||||
/* Variadic operator assembly. Must be templatized for each different opcode. */
|
/* Variadic operator assembly. Must be templatized for each different opcode. */
|
||||||
/* Reg 0: Argument tuple (args) */
|
/* Reg 0: Argument tuple (args) */
|
||||||
@@ -466,24 +514,26 @@ static void templatize_varop(
|
|||||||
};
|
};
|
||||||
|
|
||||||
janet_quick_asm(
|
janet_quick_asm(
|
||||||
env,
|
env,
|
||||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
name,
|
name,
|
||||||
0,
|
0,
|
||||||
6,
|
0,
|
||||||
varop_asm,
|
INT32_MAX,
|
||||||
sizeof(varop_asm),
|
6,
|
||||||
doc);
|
varop_asm,
|
||||||
|
sizeof(varop_asm),
|
||||||
|
doc);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Templatize variadic comparators */
|
/* Templatize variadic comparators */
|
||||||
static void templatize_comparator(
|
static void templatize_comparator(
|
||||||
JanetTable *env,
|
JanetTable *env,
|
||||||
int32_t flags,
|
int32_t flags,
|
||||||
const char *name,
|
const char *name,
|
||||||
int invert,
|
int invert,
|
||||||
uint32_t op,
|
uint32_t op,
|
||||||
const char *doc) {
|
const char *doc) {
|
||||||
|
|
||||||
/* Reg 0: Argument tuple (args) */
|
/* Reg 0: Argument tuple (args) */
|
||||||
/* Reg 1: Argument count (argn) */
|
/* Reg 1: Argument count (argn) */
|
||||||
@@ -519,14 +569,16 @@ static void templatize_comparator(
|
|||||||
};
|
};
|
||||||
|
|
||||||
janet_quick_asm(
|
janet_quick_asm(
|
||||||
env,
|
env,
|
||||||
flags | JANET_FUNCDEF_FLAG_VARARG,
|
flags | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
name,
|
name,
|
||||||
0,
|
0,
|
||||||
6,
|
0,
|
||||||
comparator_asm,
|
INT32_MAX,
|
||||||
sizeof(comparator_asm),
|
6,
|
||||||
doc);
|
comparator_asm,
|
||||||
|
sizeof(comparator_asm),
|
||||||
|
doc);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Make the apply function */
|
/* Make the apply function */
|
||||||
@@ -560,22 +612,22 @@ static void make_apply(JanetTable *env) {
|
|||||||
S(JOP_TAILCALL, 0)
|
S(JOP_TAILCALL, 0)
|
||||||
};
|
};
|
||||||
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
|
||||||
"apply", 1, 6, apply_asm, sizeof(apply_asm),
|
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
|
||||||
JDOC("(apply f & args)\n\n"
|
JDOC("(apply f & args)\n\n"
|
||||||
"Applies a function to a variable number of arguments. Each element in args "
|
"Applies a function to a variable number of arguments. Each element in args "
|
||||||
"is used as an argument to f, except the last element in args, which is expected to "
|
"is used as an argument to f, except the last element in args, which is expected to "
|
||||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||||
"f. For example:\n\n"
|
"f. For example:\n\n"
|
||||||
"\t(apply + 1000 (range 10))\n\n"
|
"\t(apply + 1000 (range 10))\n\n"
|
||||||
"sums the first 10 integers and 1000.)"));
|
"sums the first 10 integers and 1000.)"));
|
||||||
}
|
}
|
||||||
|
|
||||||
static const uint32_t error_asm[] = {
|
static const uint32_t error_asm[] = {
|
||||||
JOP_ERROR
|
JOP_ERROR
|
||||||
};
|
};
|
||||||
static const uint32_t debug_asm[] = {
|
static const uint32_t debug_asm[] = {
|
||||||
JOP_SIGNAL | (2 << 24),
|
JOP_SIGNAL | (2 << 24),
|
||||||
JOP_RETURN_NIL
|
JOP_RETURN_NIL
|
||||||
};
|
};
|
||||||
static const uint32_t yield_asm[] = {
|
static const uint32_t yield_asm[] = {
|
||||||
JOP_SIGNAL | (3 << 24),
|
JOP_SIGNAL | (3 << 24),
|
||||||
@@ -603,149 +655,154 @@ static const uint32_t bnot_asm[] = {
|
|||||||
};
|
};
|
||||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||||
|
|
||||||
JanetTable *janet_core_env(void) {
|
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||||
JanetTable *env = janet_table(0);
|
JanetTable *env = (NULL != replacements) ? replacements : janet_table(0);
|
||||||
Janet ret = janet_wrap_table(env);
|
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||||
|
|
||||||
/* Load main functions */
|
#ifdef JANET_BOOTSTRAP
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||||
|
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
||||||
#ifndef JANET_NO_BOOTSTRAP
|
JDOC("(debug)\n\n"
|
||||||
janet_quick_asm(env, JANET_FUN_YIELD, "debug", 0, 1, debug_asm, sizeof(debug_asm),
|
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
||||||
JDOC("(debug)\n\n"
|
"the running state of the current fiber. Returns nil."));
|
||||||
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
|
janet_quick_asm(env, JANET_FUN_ERROR,
|
||||||
"the running state of the current fiber. Returns nil."));
|
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
|
||||||
janet_quick_asm(env, JANET_FUN_ERROR, "error", 1, 1, error_asm, sizeof(error_asm),
|
JDOC("(error e)\n\n"
|
||||||
JDOC("(error e)\n\n"
|
"Throws an error e that can be caught and handled by a parent fiber."));
|
||||||
"Throws an error e that can be caught and handled by a parent fiber."));
|
janet_quick_asm(env, JANET_FUN_YIELD,
|
||||||
janet_quick_asm(env, JANET_FUN_YIELD, "yield", 1, 2, yield_asm, sizeof(yield_asm),
|
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
|
||||||
JDOC("(yield x)\n\n"
|
JDOC("(yield x)\n\n"
|
||||||
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
|
||||||
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
"another thread resumes it. The fiber will then resume, and the last yield call will "
|
||||||
"return the value that was passed to resume."));
|
"return the value that was passed to resume."));
|
||||||
janet_quick_asm(env, JANET_FUN_RESUME, "resume", 2, 2, resume_asm, sizeof(resume_asm),
|
janet_quick_asm(env, JANET_FUN_RESUME,
|
||||||
JDOC("(resume fiber [,x])\n\n"
|
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
|
||||||
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
JDOC("(resume fiber &opt x)\n\n"
|
||||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
|
||||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||||
janet_quick_asm(env, JANET_FUN_GET, "get", 2, 2, get_asm, sizeof(get_asm),
|
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||||
JDOC("(get ds key)\n\n"
|
janet_quick_asm(env, JANET_FUN_GET,
|
||||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
|
||||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
JDOC("(get ds key)\n\n"
|
||||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||||
"integer representations of bytes as result of a get call."));
|
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||||
janet_quick_asm(env, JANET_FUN_PUT, "put", 3, 3, put_asm, sizeof(put_asm),
|
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||||
JDOC("(put ds key value)\n\n"
|
"integer representations of bytes as result of a get call."));
|
||||||
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
janet_quick_asm(env, JANET_FUN_PUT,
|
||||||
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||||
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
JDOC("(put ds key value)\n\n"
|
||||||
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
|
||||||
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
|
||||||
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
|
||||||
janet_quick_asm(env, JANET_FUN_LENGTH, "length", 1, 1, length_asm, sizeof(length_asm),
|
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
|
||||||
JDOC("(length ds)\n\n"
|
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
|
||||||
"Returns the length or count of a data structure in constant time as an integer. For "
|
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
|
||||||
"structs and tables, returns the number of key-value pairs in the data structure."));
|
janet_quick_asm(env, JANET_FUN_LENGTH,
|
||||||
janet_quick_asm(env, JANET_FUN_BNOT, "bnot", 1, 1, bnot_asm, sizeof(bnot_asm),
|
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
|
||||||
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
JDOC("(length ds)\n\n"
|
||||||
|
"Returns the length or count of a data structure in constant time as an integer. For "
|
||||||
|
"structs and tables, returns the number of key-value pairs in the data structure."));
|
||||||
|
janet_quick_asm(env, JANET_FUN_BNOT,
|
||||||
|
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
|
||||||
|
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
|
||||||
make_apply(env);
|
make_apply(env);
|
||||||
|
|
||||||
/* Variadic ops */
|
/* Variadic ops */
|
||||||
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
|
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
|
||||||
JDOC("(+ & xs)\n\n"
|
JDOC("(+ & xs)\n\n"
|
||||||
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
|
||||||
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
|
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
|
||||||
JDOC("(- & xs)\n\n"
|
JDOC("(- & xs)\n\n"
|
||||||
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
|
||||||
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
|
||||||
"the rest of the elements."));
|
"the rest of the elements."));
|
||||||
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
|
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
|
||||||
JDOC("(* & xs)\n\n"
|
JDOC("(* & xs)\n\n"
|
||||||
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
"Returns the product of all elements in xs. If xs is empty, returns 1."));
|
||||||
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
|
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
|
||||||
JDOC("(/ & xs)\n\n"
|
JDOC("(/ & xs)\n\n"
|
||||||
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
|
||||||
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
|
||||||
"values. Division by two integers uses truncating division."));
|
"values. Division by two integers uses truncating division."));
|
||||||
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
|
||||||
JDOC("(band & xs)\n\n"
|
JDOC("(band & xs)\n\n"
|
||||||
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
|
||||||
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
|
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
|
||||||
JDOC("(bor & xs)\n\n"
|
JDOC("(bor & xs)\n\n"
|
||||||
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
|
||||||
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
|
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
|
||||||
JDOC("(bxor & xs)\n\n"
|
JDOC("(bxor & xs)\n\n"
|
||||||
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
|
||||||
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
|
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
|
||||||
JDOC("(blshift x & shifts)\n\n"
|
JDOC("(blshift x & shifts)\n\n"
|
||||||
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
|
||||||
"and each element in shift must be an integer."));
|
"and each element in shift must be an integer."));
|
||||||
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
|
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
|
||||||
JDOC("(brshift x & shifts)\n\n"
|
JDOC("(brshift x & shifts)\n\n"
|
||||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||||
"and each element in shift must be an integer."));
|
"and each element in shift must be an integer."));
|
||||||
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
|
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
|
||||||
JDOC("(brushift x & shifts)\n\n"
|
JDOC("(brushift x & shifts)\n\n"
|
||||||
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
|
||||||
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
"and each element in shift must be an integer. The sign of x is not preserved, so "
|
||||||
"for positive shifts the return value will always be positive."));
|
"for positive shifts the return value will always be positive."));
|
||||||
|
|
||||||
/* Variadic comparators */
|
/* Variadic comparators */
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
|
templatize_comparator(env, JANET_FUN_ORDER_GT, "order>", 0, JOP_GREATER_THAN,
|
||||||
JDOC("(order> & xs)\n\n"
|
JDOC("(order> & xs)\n\n"
|
||||||
"Check if xs is strictly descending according to a total order "
|
"Check if xs is strictly descending according to a total order "
|
||||||
"over all values. Returns a boolean."));
|
"over all values. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
|
templatize_comparator(env, JANET_FUN_ORDER_LT, "order<", 0, JOP_LESS_THAN,
|
||||||
JDOC("(order< & xs)\n\n"
|
JDOC("(order< & xs)\n\n"
|
||||||
"Check if xs is strictly increasing according to a total order "
|
"Check if xs is strictly increasing according to a total order "
|
||||||
"over all values. Returns a boolean."));
|
"over all values. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
|
templatize_comparator(env, JANET_FUN_ORDER_GTE, "order>=", 1, JOP_LESS_THAN,
|
||||||
JDOC("(order>= & xs)\n\n"
|
JDOC("(order>= & xs)\n\n"
|
||||||
"Check if xs is not increasing according to a total order "
|
"Check if xs is not increasing according to a total order "
|
||||||
"over all values. Returns a boolean."));
|
"over all values. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
|
templatize_comparator(env, JANET_FUN_ORDER_LTE, "order<=", 1, JOP_GREATER_THAN,
|
||||||
JDOC("(order<= & xs)\n\n"
|
JDOC("(order<= & xs)\n\n"
|
||||||
"Check if xs is not decreasing according to a total order "
|
"Check if xs is not decreasing according to a total order "
|
||||||
"over all values. Returns a boolean."));
|
"over all values. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
|
templatize_comparator(env, JANET_FUN_ORDER_EQ, "=", 0, JOP_EQUALS,
|
||||||
JDOC("(= & xs)\n\n"
|
JDOC("(= & xs)\n\n"
|
||||||
"Returns true if all values in xs are the same, false otherwise."));
|
"Returns true if all values in xs are the same, false otherwise."));
|
||||||
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
|
templatize_comparator(env, JANET_FUN_ORDER_NEQ, "not=", 1, JOP_EQUALS,
|
||||||
JDOC("(not= & xs)\n\n"
|
JDOC("(not= & xs)\n\n"
|
||||||
"Return true if any values in xs are not equal, otherwise false."));
|
"Return true if any values in xs are not equal, otherwise false."));
|
||||||
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
|
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_NUMERIC_GREATER_THAN,
|
||||||
JDOC("(> & xs)\n\n"
|
JDOC("(> & xs)\n\n"
|
||||||
"Check if xs is in numerically descending order. Returns a boolean."));
|
"Check if xs is in numerically descending order. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
|
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_NUMERIC_LESS_THAN,
|
||||||
JDOC("(< & xs)\n\n"
|
JDOC("(< & xs)\n\n"
|
||||||
"Check if xs is in numerically ascending order. Returns a boolean."));
|
"Check if xs is in numerically ascending order. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
|
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||||
JDOC("(>= & xs)\n\n"
|
JDOC("(>= & xs)\n\n"
|
||||||
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
"Check if xs is in numerically non-ascending order. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
|
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||||
JDOC("(<= & xs)\n\n"
|
JDOC("(<= & xs)\n\n"
|
||||||
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
"Check if xs is in numerically non-descending order. Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
|
templatize_comparator(env, JANET_FUN_EQ, "==", 0, JOP_NUMERIC_EQUAL,
|
||||||
JDOC("(== & xs)\n\n"
|
JDOC("(== & xs)\n\n"
|
||||||
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
"Check if all values in xs are numerically equal (4.0 == 4). Returns a boolean."));
|
||||||
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
|
templatize_comparator(env, JANET_FUN_NEQ, "not==", 1, JOP_NUMERIC_EQUAL,
|
||||||
JDOC("(not== & xs)\n\n"
|
JDOC("(not== & xs)\n\n"
|
||||||
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
"Check if any values in xs are not numerically equal (3.0 not== 4). Returns a boolean."));
|
||||||
|
|
||||||
/* Platform detection */
|
/* Platform detection */
|
||||||
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
|
||||||
JDOC("The version number of the running janet program."));
|
JDOC("The version number of the running janet program."));
|
||||||
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
||||||
JDOC("The build identifier of the running janet program."));
|
JDOC("The build identifier of the running janet program."));
|
||||||
|
|
||||||
/* Allow references to the environment */
|
/* Allow references to the environment */
|
||||||
janet_def(env, "_env", ret, JDOC("The environment table for the current scope."));
|
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Set as gc root */
|
/* Set as gc root */
|
||||||
janet_gcroot(janet_wrap_table(env));
|
janet_gcroot(janet_wrap_table(env));
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Load auxiliary envs */
|
/* Load auxiliary envs */
|
||||||
janet_lib_io(env);
|
janet_lib_io(env);
|
||||||
@@ -761,13 +818,30 @@ JanetTable *janet_core_env(void) {
|
|||||||
janet_lib_debug(env);
|
janet_lib_debug(env);
|
||||||
janet_lib_string(env);
|
janet_lib_string(env);
|
||||||
janet_lib_marsh(env);
|
janet_lib_marsh(env);
|
||||||
|
#ifdef JANET_PEG
|
||||||
|
janet_lib_peg(env);
|
||||||
|
#endif
|
||||||
#ifdef JANET_ASSEMBLER
|
#ifdef JANET_ASSEMBLER
|
||||||
janet_lib_asm(env);
|
janet_lib_asm(env);
|
||||||
#endif
|
#endif
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
janet_lib_typed_array(env);
|
||||||
|
#endif
|
||||||
|
|
||||||
#ifndef JANET_NO_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
/* Run bootstrap source */
|
/* Run bootstrap source */
|
||||||
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
janet_dobytes(env, janet_gen_core, janet_gen_core_size, "core.janet", NULL);
|
||||||
|
#else
|
||||||
|
|
||||||
|
/* Unmarshal from core image */
|
||||||
|
Janet marsh_out = janet_unmarshal(
|
||||||
|
janet_core_image,
|
||||||
|
janet_core_image_size,
|
||||||
|
0,
|
||||||
|
env,
|
||||||
|
NULL);
|
||||||
|
janet_gcroot(marsh_out);
|
||||||
|
env = janet_unwrap_table(marsh_out);
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
return env;
|
return env;
|
||||||
|
|||||||
195
src/core/debug.c
195
src/core/debug.c
@@ -20,10 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "vector.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Implements functionality to build a debugger from within janet.
|
/* Implements functionality to build a debugger from within janet.
|
||||||
* The repl should also be able to serve as pretty featured debugger
|
* The repl should also be able to serve as pretty featured debugger
|
||||||
@@ -48,10 +51,10 @@ void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
|||||||
* location.
|
* location.
|
||||||
*/
|
*/
|
||||||
void janet_debug_find(
|
void janet_debug_find(
|
||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t offset) {
|
const uint8_t *source, int32_t offset) {
|
||||||
/* Scan the heap for right func def */
|
/* Scan the heap for right func def */
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
/* Keep track of the best source mapping we have seen so far */
|
/* Keep track of the best source mapping we have seen so far */
|
||||||
int32_t besti = -1;
|
int32_t besti = -1;
|
||||||
int32_t best_range = INT32_MAX;
|
int32_t best_range = INT32_MAX;
|
||||||
@@ -88,6 +91,74 @@ void janet_debug_find(
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Error reporting. This can be emulated from within Janet, but for
|
||||||
|
* consitency with the top level code it is defined once. */
|
||||||
|
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||||
|
int32_t fi;
|
||||||
|
const char *errstr = (const char *)janet_to_string(err);
|
||||||
|
JanetFiber **fibers = NULL;
|
||||||
|
int wrote_error = 0;
|
||||||
|
|
||||||
|
while (fiber) {
|
||||||
|
janet_v_push(fibers, fiber);
|
||||||
|
fiber = fiber->child;
|
||||||
|
}
|
||||||
|
|
||||||
|
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
|
||||||
|
fiber = fibers[fi];
|
||||||
|
int32_t i = fiber->frame;
|
||||||
|
while (i > 0) {
|
||||||
|
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
||||||
|
JanetFuncDef *def = NULL;
|
||||||
|
i = frame->prevframe;
|
||||||
|
|
||||||
|
/* Print prelude to stack frame */
|
||||||
|
if (!wrote_error) {
|
||||||
|
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||||
|
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||||
|
fprintf(stderr, "%s%s: %s\n",
|
||||||
|
prefix,
|
||||||
|
janet_status_names[status],
|
||||||
|
errstr);
|
||||||
|
wrote_error = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
fprintf(stderr, " in");
|
||||||
|
|
||||||
|
if (frame->func) {
|
||||||
|
def = frame->func->def;
|
||||||
|
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||||
|
if (def->source) {
|
||||||
|
fprintf(stderr, " [%s]", (const char *)def->source);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||||
|
if (cfun) {
|
||||||
|
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||||
|
if (!janet_checktype(name, JANET_NIL))
|
||||||
|
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
||||||
|
else
|
||||||
|
fprintf(stderr, " <cfunction>");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
|
fprintf(stderr, " (tailcall)");
|
||||||
|
if (frame->func && frame->pc) {
|
||||||
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
|
if (def->sourcemap) {
|
||||||
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
|
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
|
||||||
|
} else {
|
||||||
|
fprintf(stderr, " pc=%d", off);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
fprintf(stderr, "\n");
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
janet_v_free(fibers);
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* CFuns
|
* CFuns
|
||||||
*/
|
*/
|
||||||
@@ -111,7 +182,7 @@ static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32
|
|||||||
*bytecode_offset = offset;
|
*bytecode_offset = offset;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_break(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset;
|
||||||
helper_find(argc, argv, &def, &offset);
|
helper_find(argc, argv, &def, &offset);
|
||||||
@@ -119,23 +190,23 @@ static Janet cfun_break(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_unbreak(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset = 0;
|
||||||
helper_find(argc, argv, &def, &offset);
|
helper_find(argc, argv, &def, &offset);
|
||||||
janet_debug_unbreak(def, offset);
|
janet_debug_unbreak(def, offset);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_fbreak(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset = 0;
|
||||||
helper_find_fun(argc, argv, &def, &offset);
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
janet_debug_break(def, offset);
|
janet_debug_break(def, offset);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_unfbreak(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
int32_t offset;
|
int32_t offset;
|
||||||
helper_find_fun(argc, argv, &def, &offset);
|
helper_find_fun(argc, argv, &def, &offset);
|
||||||
@@ -143,7 +214,7 @@ static Janet cfun_unfbreak(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_lineage(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(0);
|
JanetArray *array = janet_array(0);
|
||||||
@@ -181,7 +252,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
if (frame->func && frame->pc) {
|
if (frame->func && frame->pc) {
|
||||||
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||||
JanetArray *slots;
|
JanetArray *slots;
|
||||||
off = (int32_t) (frame->pc - def->bytecode);
|
off = (int32_t)(frame->pc - def->bytecode);
|
||||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
@@ -200,7 +271,7 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
return janet_wrap_table(t);
|
return janet_wrap_table(t);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_stack(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(0);
|
JanetArray *array = janet_array(0);
|
||||||
@@ -216,7 +287,14 @@ static Janet cfun_stack(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_argstack(int32_t argc, Janet *argv) {
|
static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
|
janet_stacktrace(fiber, argv[1]);
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_debug_argstack(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||||
@@ -225,71 +303,78 @@ static Janet cfun_argstack(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg debug_cfuns[] = {
|
||||||
{
|
{
|
||||||
"debug/break", cfun_break,
|
"debug/break", cfun_debug_break,
|
||||||
JDOC("(debug/break source byte-offset)\n\n"
|
JDOC("(debug/break source byte-offset)\n\n"
|
||||||
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
||||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
||||||
"cannot be found. For example\n\n"
|
"cannot be found. For example\n\n"
|
||||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||||
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/unbreak", cfun_unbreak,
|
"debug/unbreak", cfun_debug_unbreak,
|
||||||
JDOC("(debug/unbreak source byte-offset)\n\n"
|
JDOC("(debug/unbreak source byte-offset)\n\n"
|
||||||
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
||||||
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
||||||
"cannot be found.")
|
"cannot be found.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/fbreak", cfun_fbreak,
|
"debug/fbreak", cfun_debug_fbreak,
|
||||||
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||||
"if the offset is too large or negative.")
|
"if the offset is too large or negative.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/unfbreak", cfun_unfbreak,
|
"debug/unfbreak", cfun_debug_unfbreak,
|
||||||
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||||
"Unset a breakpoint set with debug/fbreak.")
|
"Unset a breakpoint set with debug/fbreak.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/arg-stack", cfun_argstack,
|
"debug/arg-stack", cfun_debug_argstack,
|
||||||
JDOC("(debug/arg-stack fiber)\n\n"
|
JDOC("(debug/arg-stack fiber)\n\n"
|
||||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||||
"this should be empty unless the fiber signals while pushing arguments "
|
"this should be empty unless the fiber signals while pushing arguments "
|
||||||
"to make a function call. Returns a new array.")
|
"to make a function call. Returns a new array.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/stack", cfun_stack,
|
"debug/stack", cfun_debug_stack,
|
||||||
JDOC("(debug/stack fib)\n\n"
|
JDOC("(debug/stack fib)\n\n"
|
||||||
"Gets information about the stack as an array of tables. Each table "
|
"Gets information about the stack as an array of tables. Each table "
|
||||||
"in the array contains information about a stack frame. The top most, current "
|
"in the array contains information about a stack frame. The top most, current "
|
||||||
"stack frame is the first table in the array, and the bottom most stack frame "
|
"stack frame is the first table in the array, and the bottom most stack frame "
|
||||||
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
"is the last value. Each stack frame contains some of the following attributes:\n\n"
|
||||||
"\t:c - true if the stack frame is a c function invocation\n"
|
"\t:c - true if the stack frame is a c function invocation\n"
|
||||||
"\t:column - the current source column of the stack frame\n"
|
"\t:column - the current source column of the stack frame\n"
|
||||||
"\t:function - the function that the stack frame represents\n"
|
"\t:function - the function that the stack frame represents\n"
|
||||||
"\t:line - the current source line of the stack frame\n"
|
"\t:line - the current source line of the stack frame\n"
|
||||||
"\t:name - the human friendly name of the function\n"
|
"\t:name - the human friendly name of the function\n"
|
||||||
"\t:pc - integer indicating the location of the program counter\n"
|
"\t:pc - integer indicating the location of the program counter\n"
|
||||||
"\t:source - string with the file path or other identifier for the source code\n"
|
"\t:source - string with the file path or other identifier for the source code\n"
|
||||||
"\t:slots - array of all values in each slot\n"
|
"\t:slots - array of all values in each slot\n"
|
||||||
"\t:tail - boolean indicating a tail call")
|
"\t:tail - boolean indicating a tail call")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/lineage", cfun_lineage,
|
"debug/stacktrace", cfun_debug_stacktrace,
|
||||||
|
JDOC("(debug/stacktrace fiber err)\n\n"
|
||||||
|
"Prints a nice looking stacktrace for a fiber. The error message "
|
||||||
|
"err must be passed to the function as fiber's do not keep track of "
|
||||||
|
"the last error they have thrown. Returns the fiber.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"debug/lineage", cfun_debug_lineage,
|
||||||
JDOC("(debug/lineage fib)\n\n"
|
JDOC("(debug/lineage fib)\n\n"
|
||||||
"Returns an array of all child fibers from a root fiber. This function "
|
"Returns an array of all child fibers from a root fiber. This function "
|
||||||
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
"is useful when a fiber signals or errors to an ancestor fiber. Using this function, "
|
||||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||||
"be used mostly for debugging purposes.")
|
"be used mostly for debugging purposes.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_debug(JanetTable *env) {
|
void janet_lib_debug(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,10 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Get a register */
|
/* Get a register */
|
||||||
int32_t janetc_allocfar(JanetCompiler *c) {
|
int32_t janetc_allocfar(JanetCompiler *c) {
|
||||||
@@ -76,32 +78,31 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
|||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
janetc_emit(c, (reg << 8) | JOP_LOAD_NIL);
|
||||||
break;
|
break;
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_TRUE);
|
janetc_emit(c, (reg << 8) |
|
||||||
|
(janet_unwrap_boolean(k) ? JOP_LOAD_TRUE : JOP_LOAD_FALSE));
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_NUMBER: {
|
||||||
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
|
double dval = janet_unwrap_number(k);
|
||||||
break;
|
if (dval < INT16_MIN || dval > INT16_MAX)
|
||||||
case JANET_NUMBER:
|
goto do_constant;
|
||||||
{
|
int32_t i = (int32_t) dval;
|
||||||
double dval = janet_unwrap_number(k);
|
if (dval != i)
|
||||||
int32_t i = (int32_t) dval;
|
goto do_constant;
|
||||||
if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX))
|
uint32_t iu = (uint32_t)i;
|
||||||
goto do_constant;
|
janetc_emit(c,
|
||||||
janetc_emit(c,
|
(iu << 16) |
|
||||||
(i << 16) |
|
|
||||||
(reg << 8) |
|
(reg << 8) |
|
||||||
JOP_LOAD_INTEGER);
|
JOP_LOAD_INTEGER);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
default:
|
default:
|
||||||
do_constant:
|
do_constant: {
|
||||||
{
|
|
||||||
int32_t cindex = janetc_const(c, k);
|
int32_t cindex = janetc_const(c, k);
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(cindex << 16) |
|
(cindex << 16) |
|
||||||
(reg << 8) |
|
(reg << 8) |
|
||||||
JOP_LOAD_CONSTANT);
|
JOP_LOAD_CONSTANT);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -109,53 +110,53 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
|||||||
|
|
||||||
/* Move a slot to a near register */
|
/* Move a slot to a near register */
|
||||||
static void janetc_movenear(JanetCompiler *c,
|
static void janetc_movenear(JanetCompiler *c,
|
||||||
int32_t dest,
|
int32_t dest,
|
||||||
JanetSlot src) {
|
JanetSlot src) {
|
||||||
if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
|
if (src.flags & (JANET_SLOT_CONSTANT | JANET_SLOT_REF)) {
|
||||||
janetc_loadconst(c, src.constant, dest);
|
janetc_loadconst(c, src.constant, dest);
|
||||||
/* If we also are a reference, deref the one element array */
|
/* If we also are a reference, deref the one element array */
|
||||||
if (src.flags & JANET_SLOT_REF) {
|
if (src.flags & JANET_SLOT_REF) {
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(dest << 16) |
|
(dest << 16) |
|
||||||
(dest << 8) |
|
(dest << 8) |
|
||||||
JOP_GET_INDEX);
|
JOP_GET_INDEX);
|
||||||
}
|
}
|
||||||
} else if (src.envindex >= 0) {
|
} else if (src.envindex >= 0) {
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(src.index) << 24) |
|
((uint32_t)(src.index) << 24) |
|
||||||
((uint32_t)(src.envindex) << 16) |
|
((uint32_t)(src.envindex) << 16) |
|
||||||
((uint32_t)(dest) << 8) |
|
((uint32_t)(dest) << 8) |
|
||||||
JOP_LOAD_UPVALUE);
|
JOP_LOAD_UPVALUE);
|
||||||
} else if (src.index > 0xFF || src.index != dest) {
|
} else if (src.index > 0xFF || src.index != dest) {
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(src.index) << 16) |
|
((uint32_t)(src.index) << 16) |
|
||||||
((uint32_t)(dest) << 8) |
|
((uint32_t)(dest) << 8) |
|
||||||
JOP_MOVE_NEAR);
|
JOP_MOVE_NEAR);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Move a near register to a Slot. */
|
/* Move a near register to a Slot. */
|
||||||
static void janetc_moveback(JanetCompiler *c,
|
static void janetc_moveback(JanetCompiler *c,
|
||||||
JanetSlot dest,
|
JanetSlot dest,
|
||||||
int32_t src) {
|
int32_t src) {
|
||||||
if (dest.flags & JANET_SLOT_REF) {
|
if (dest.flags & JANET_SLOT_REF) {
|
||||||
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
|
int32_t refreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_5);
|
||||||
janetc_loadconst(c, dest.constant, refreg);
|
janetc_loadconst(c, dest.constant, refreg);
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
(src << 16) |
|
(src << 16) |
|
||||||
(refreg << 8) |
|
(refreg << 8) |
|
||||||
JOP_PUT_INDEX);
|
JOP_PUT_INDEX);
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
|
janetc_regalloc_freetemp(&c->scope->ra, refreg, JANETC_REGTEMP_5);
|
||||||
} else if (dest.envindex >= 0) {
|
} else if (dest.envindex >= 0) {
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(dest.index) << 24) |
|
((uint32_t)(dest.index) << 24) |
|
||||||
((uint32_t)(dest.envindex) << 16) |
|
((uint32_t)(dest.envindex) << 16) |
|
||||||
((uint32_t)(src) << 8) |
|
((uint32_t)(src) << 8) |
|
||||||
JOP_SET_UPVALUE);
|
JOP_SET_UPVALUE);
|
||||||
} else if (dest.index != src) {
|
} else if (dest.index != src) {
|
||||||
janetc_emit(c,
|
janetc_emit(c,
|
||||||
((uint32_t)(dest.index) << 16) |
|
((uint32_t)(dest.index) << 16) |
|
||||||
((uint32_t)(src) << 8) |
|
((uint32_t)(src) << 8) |
|
||||||
JOP_MOVE_FAR);
|
JOP_MOVE_FAR);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -219,9 +220,9 @@ static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
|
|||||||
/* Move values from one slot to another. The destination must
|
/* Move values from one slot to another. The destination must
|
||||||
* be writeable (not a literal). */
|
* be writeable (not a literal). */
|
||||||
void janetc_copy(
|
void janetc_copy(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
JanetSlot dest,
|
JanetSlot dest,
|
||||||
JanetSlot src) {
|
JanetSlot src) {
|
||||||
if (dest.flags & JANET_SLOT_CONSTANT) {
|
if (dest.flags & JANET_SLOT_CONSTANT) {
|
||||||
janetc_cerror(c, "cannot write to constant");
|
janetc_cerror(c, "cannot write to constant");
|
||||||
return;
|
return;
|
||||||
@@ -250,7 +251,7 @@ void janetc_copy(
|
|||||||
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {
|
||||||
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
int32_t reg = janetc_regnear(c, s, JANETC_REGTEMP_0);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg << 8) | (rest << 16));
|
janetc_emit(c, op | (reg << 8) | ((uint32_t)rest << 16));
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s, reg);
|
janetc_moveback(c, s, reg);
|
||||||
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
janetc_free_regnear(c, s, reg, JANETC_REGTEMP_0);
|
||||||
@@ -292,7 +293,7 @@ static int32_t emit2s(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2,
|
|||||||
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
int32_t reg1 = janetc_regnear(c, s1, JANETC_REGTEMP_0);
|
||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (rest << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)rest << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
if (wr)
|
if (wr)
|
||||||
janetc_moveback(c, s1, reg1);
|
janetc_moveback(c, s1, reg1);
|
||||||
@@ -325,7 +326,7 @@ int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
|
|||||||
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
int32_t reg2 = janetc_regnear(c, s2, JANETC_REGTEMP_1);
|
||||||
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
int32_t reg3 = janetc_regnear(c, s3, JANETC_REGTEMP_2);
|
||||||
int32_t label = janet_v_count(c->buffer);
|
int32_t label = janet_v_count(c->buffer);
|
||||||
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | (reg3 << 24));
|
janetc_emit(c, op | (reg1 << 8) | (reg2 << 16) | ((uint32_t)reg3 << 24));
|
||||||
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
janetc_free_regnear(c, s2, reg2, JANETC_REGTEMP_1);
|
||||||
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
janetc_free_regnear(c, s3, reg3, JANETC_REGTEMP_2);
|
||||||
if (wr)
|
if (wr)
|
||||||
|
|||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_EMIT_H
|
#ifndef JANET_EMIT_H
|
||||||
#define JANET_EMIT_H
|
#define JANET_EMIT_H
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
void janetc_emit(JanetCompiler *c, uint32_t instr);
|
void janetc_emit(JanetCompiler *c, uint32_t instr);
|
||||||
|
|
||||||
|
|||||||
166
src/core/fiber.c
166
src/core/fiber.c
@@ -20,13 +20,25 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static JanetFiber *make_fiber(int32_t capacity) {
|
static void fiber_reset(JanetFiber *fiber) {
|
||||||
|
fiber->maxstack = JANET_STACK_MAX;
|
||||||
|
fiber->frame = 0;
|
||||||
|
fiber->stackstart = JANET_FRAME_SIZE;
|
||||||
|
fiber->stacktop = JANET_FRAME_SIZE;
|
||||||
|
fiber->child = NULL;
|
||||||
|
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||||
|
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||||
Janet *data;
|
Janet *data;
|
||||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||||
if (capacity < 32) {
|
if (capacity < 32) {
|
||||||
@@ -38,37 +50,31 @@ static JanetFiber *make_fiber(int32_t capacity) {
|
|||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
fiber->data = data;
|
fiber->data = data;
|
||||||
fiber->maxstack = JANET_STACK_MAX;
|
|
||||||
fiber->frame = 0;
|
|
||||||
fiber->stackstart = JANET_FRAME_SIZE;
|
|
||||||
fiber->stacktop = JANET_FRAME_SIZE;
|
|
||||||
fiber->child = NULL;
|
|
||||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Initialize a new fiber */
|
/* Create a new fiber with argn values on the stack by reusing a fiber. */
|
||||||
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
|
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv) {
|
||||||
JanetFiber *fiber = make_fiber(capacity);
|
|
||||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
|
||||||
return fiber;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Clear a fiber (reset it) with argn values on the stack. */
|
|
||||||
JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn) {
|
|
||||||
int32_t newstacktop;
|
int32_t newstacktop;
|
||||||
JanetFiber *fiber = make_fiber(capacity);
|
fiber_reset(fiber);
|
||||||
newstacktop = fiber->stacktop + argn;
|
if (argc) {
|
||||||
if (newstacktop >= fiber->capacity) {
|
newstacktop = fiber->stacktop + argc;
|
||||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
if (newstacktop >= fiber->capacity) {
|
||||||
|
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||||
|
}
|
||||||
|
memcpy(fiber->data + fiber->stacktop, argv, argc * sizeof(Janet));
|
||||||
|
fiber->stacktop = newstacktop;
|
||||||
}
|
}
|
||||||
memcpy(fiber->data + fiber->stacktop, argv, argn * sizeof(Janet));
|
|
||||||
fiber->stacktop = newstacktop;
|
|
||||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||||
|
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Create a new fiber with argn values on the stack. */
|
||||||
|
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv) {
|
||||||
|
return janet_fiber_reset(fiber_alloc(capacity), callee, argc, argv);
|
||||||
|
}
|
||||||
|
|
||||||
/* Ensure that the fiber has enough extra capacity */
|
/* Ensure that the fiber has enough extra capacity */
|
||||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||||
@@ -132,11 +138,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||||
|
|
||||||
/* Check strict arity before messing with state */
|
/* Check strict arity before messing with state */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
if (func->def->arity != next_arity) {
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
@@ -164,8 +167,8 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
oldtop - tuplehead));
|
oldtop - tuplehead));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -198,11 +201,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
int32_t stacksize;
|
int32_t stacksize;
|
||||||
|
|
||||||
/* Check strict arity before messing with state */
|
/* Check strict arity before messing with state */
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (next_arity < func->def->min_arity) return 1;
|
||||||
if (func->def->arity != next_arity) {
|
if (next_arity > func->def->max_arity) return 1;
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if (fiber->capacity < nextstacktop) {
|
if (fiber->capacity < nextstacktop) {
|
||||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||||
@@ -225,8 +225,8 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
|||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||||
} else {
|
} else {
|
||||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||||
fiber->data + tuplehead,
|
fiber->data + tuplehead,
|
||||||
fiber->stacktop - tuplehead));
|
fiber->stacktop - tuplehead));
|
||||||
}
|
}
|
||||||
stacksize = tuplehead - fiber->stackstart + 1;
|
stacksize = tuplehead - fiber->stackstart + 1;
|
||||||
} else {
|
} else {
|
||||||
@@ -293,16 +293,14 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
|||||||
|
|
||||||
/* CFuns */
|
/* CFuns */
|
||||||
|
|
||||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
JanetFunction *func = janet_getfunction(argv, 0);
|
JanetFunction *func = janet_getfunction(argv, 0);
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
if (func->def->min_arity != 0) {
|
||||||
if (func->def->arity != 0) {
|
janet_panic("expected nullary function in fiber constructor");
|
||||||
janet_panic("expected nullary function in fiber constructor");
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
fiber = janet_fiber(func, 64);
|
fiber = janet_fiber(func, 64, 0, NULL);
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
JanetByteView view = janet_getbytes(argv, 1);
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
@@ -342,27 +340,27 @@ static Janet cfun_new(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_fiber(fiber);
|
return janet_wrap_fiber(fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_status(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
||||||
JANET_FIBER_STATUS_OFFSET;
|
JANET_FIBER_STATUS_OFFSET;
|
||||||
return janet_ckeywordv(janet_status_names[s]);
|
return janet_ckeywordv(janet_status_names[s]);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_current(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
return janet_wrap_fiber(janet_vm_fiber);
|
return janet_wrap_fiber(janet_vm_fiber);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_maxstack(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
return janet_wrap_integer(fiber->maxstack);
|
return janet_wrap_integer(fiber->maxstack);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_setmaxstack(int32_t argc, Janet *argv) {
|
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||||
int32_t maxs = janet_getinteger(argv, 1);
|
int32_t maxs = janet_getinteger(argv, 1);
|
||||||
@@ -373,59 +371,59 @@ static Janet cfun_setmaxstack(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg fiber_cfuns[] = {
|
||||||
{
|
{
|
||||||
"fiber/new", cfun_new,
|
"fiber/new", cfun_fiber_new,
|
||||||
JDOC("(fiber/new func [,sigmask])\n\n"
|
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||||
"Create a new fiber with function body func. Can optionally "
|
"Create a new fiber with function body func. Can optionally "
|
||||||
"take a set of signals to block from the current parent fiber "
|
"take a set of signals to block from the current parent fiber "
|
||||||
"when called. The mask is specified as a keyword where each character "
|
"when called. The mask is specified as a keyword where each character "
|
||||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||||
"For example, \n\n"
|
"For example, \n\n"
|
||||||
"\t(fiber/new myfun :e123)\n\n"
|
"\t(fiber/new myfun :e123)\n\n"
|
||||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||||
"as follows: \n\n"
|
"as follows: \n\n"
|
||||||
"\ta - block all signals\n"
|
"\ta - block all signals\n"
|
||||||
"\td - block debug signals\n"
|
"\td - block debug signals\n"
|
||||||
"\te - block error signals\n"
|
"\te - block error signals\n"
|
||||||
"\tu - block user signals\n"
|
"\tu - block user signals\n"
|
||||||
"\ty - block yield signals\n"
|
"\ty - block yield signals\n"
|
||||||
"\t0-9 - block a specific user signal")
|
"\t0-9 - block a specific user signal")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"fiber/status", cfun_status,
|
"fiber/status", cfun_fiber_status,
|
||||||
JDOC("(fiber/status fib)\n\n"
|
JDOC("(fiber/status fib)\n\n"
|
||||||
"Get the status of a fiber. The status will be one of:\n\n"
|
"Get the status of a fiber. The status will be one of:\n\n"
|
||||||
"\t:dead - the fiber has finished\n"
|
"\t:dead - the fiber has finished\n"
|
||||||
"\t:error - the fiber has errored out\n"
|
"\t:error - the fiber has errored out\n"
|
||||||
"\t:debug - the fiber is suspended in debug mode\n"
|
"\t:debug - the fiber is suspended in debug mode\n"
|
||||||
"\t:pending - the fiber has been yielded\n"
|
"\t:pending - the fiber has been yielded\n"
|
||||||
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
"\t:user(0-9) - the fiber is suspended by a user signal\n"
|
||||||
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
"\t:alive - the fiber is currently running and cannot be resumed\n"
|
||||||
"\t:new - the fiber has just been created and not yet run")
|
"\t:new - the fiber has just been created and not yet run")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"fiber/current", cfun_current,
|
"fiber/current", cfun_fiber_current,
|
||||||
JDOC("(fiber/current)\n\n"
|
JDOC("(fiber/current)\n\n"
|
||||||
"Returns the currently running fiber.")
|
"Returns the currently running fiber.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"fiber/maxstack", cfun_maxstack,
|
"fiber/maxstack", cfun_fiber_maxstack,
|
||||||
JDOC("(fiber/maxstack fib)\n\n"
|
JDOC("(fiber/maxstack fib)\n\n"
|
||||||
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
"Gets the maximum stack size in janet values allowed for a fiber. While memory for "
|
||||||
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
"the fiber's stack is not allocated up front, the fiber will not allocated more "
|
||||||
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"fiber/setmaxstack", cfun_setmaxstack,
|
"fiber/setmaxstack", cfun_fiber_setmaxstack,
|
||||||
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||||
"maximum stack size is usually 8192.")
|
"maximum stack size is usually 8192.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_fiber(JanetTable *env) {
|
void janet_lib_fiber(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_FIBER_H_defined
|
#ifndef JANET_FIBER_H_defined
|
||||||
#define JANET_FIBER_H_defined
|
#define JANET_FIBER_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
|
|
||||||
|
|||||||
155
src/core/gc.c
155
src/core/gc.c
@@ -20,10 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* GC State */
|
/* GC State */
|
||||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||||
@@ -58,18 +60,37 @@ void janet_mark(Janet x) {
|
|||||||
if (depth) {
|
if (depth) {
|
||||||
depth--;
|
depth--;
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default: break;
|
default:
|
||||||
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
|
case JANET_SYMBOL:
|
||||||
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
|
janet_mark_string(janet_unwrap_string(x));
|
||||||
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
|
break;
|
||||||
case JANET_TABLE: janet_mark_table(janet_unwrap_table(x)); break;
|
case JANET_FUNCTION:
|
||||||
case JANET_STRUCT: janet_mark_struct(janet_unwrap_struct(x)); break;
|
janet_mark_function(janet_unwrap_function(x));
|
||||||
case JANET_TUPLE: janet_mark_tuple(janet_unwrap_tuple(x)); break;
|
break;
|
||||||
case JANET_BUFFER: janet_mark_buffer(janet_unwrap_buffer(x)); break;
|
case JANET_ARRAY:
|
||||||
case JANET_FIBER: janet_mark_fiber(janet_unwrap_fiber(x)); break;
|
janet_mark_array(janet_unwrap_array(x));
|
||||||
case JANET_ABSTRACT: janet_mark_abstract(janet_unwrap_abstract(x)); break;
|
break;
|
||||||
|
case JANET_TABLE:
|
||||||
|
janet_mark_table(janet_unwrap_table(x));
|
||||||
|
break;
|
||||||
|
case JANET_STRUCT:
|
||||||
|
janet_mark_struct(janet_unwrap_struct(x));
|
||||||
|
break;
|
||||||
|
case JANET_TUPLE:
|
||||||
|
janet_mark_tuple(janet_unwrap_tuple(x));
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_mark_buffer(janet_unwrap_buffer(x));
|
||||||
|
break;
|
||||||
|
case JANET_FIBER:
|
||||||
|
janet_mark_fiber(janet_unwrap_fiber(x));
|
||||||
|
break;
|
||||||
|
case JANET_ABSTRACT:
|
||||||
|
janet_mark_abstract(janet_unwrap_abstract(x));
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
depth++;
|
depth++;
|
||||||
} else {
|
} else {
|
||||||
@@ -78,7 +99,7 @@ void janet_mark(Janet x) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_string(const uint8_t *str) {
|
static void janet_mark_string(const uint8_t *str) {
|
||||||
janet_gc_mark(janet_string_raw(str));
|
janet_gc_mark(janet_string_head(str));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_buffer(JanetBuffer *buffer) {
|
static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||||
@@ -121,7 +142,7 @@ static void janet_mark_array(JanetArray *array) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_table(JanetTable *table) {
|
static void janet_mark_table(JanetTable *table) {
|
||||||
recur: /* Manual tail recursion */
|
recur: /* Manual tail recursion */
|
||||||
if (janet_gc_reachable(table))
|
if (janet_gc_reachable(table))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(table);
|
janet_gc_mark(table);
|
||||||
@@ -133,16 +154,16 @@ static void janet_mark_table(JanetTable *table) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_struct(const JanetKV *st) {
|
static void janet_mark_struct(const JanetKV *st) {
|
||||||
if (janet_gc_reachable(janet_struct_raw(st)))
|
if (janet_gc_reachable(janet_struct_head(st)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_struct_raw(st));
|
janet_gc_mark(janet_struct_head(st));
|
||||||
janet_mark_kvs(st, janet_struct_capacity(st));
|
janet_mark_kvs(st, janet_struct_capacity(st));
|
||||||
}
|
}
|
||||||
|
|
||||||
static void janet_mark_tuple(const Janet *tuple) {
|
static void janet_mark_tuple(const Janet *tuple) {
|
||||||
if (janet_gc_reachable(janet_tuple_raw(tuple)))
|
if (janet_gc_reachable(janet_tuple_head(tuple)))
|
||||||
return;
|
return;
|
||||||
janet_gc_mark(janet_tuple_raw(tuple));
|
janet_gc_mark(janet_tuple_head(tuple));
|
||||||
janet_mark_many(tuple, janet_tuple_length(tuple));
|
janet_mark_many(tuple, janet_tuple_length(tuple));
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -199,7 +220,7 @@ recur:
|
|||||||
|
|
||||||
/* Mark values on the argument stack */
|
/* Mark values on the argument stack */
|
||||||
janet_mark_many(fiber->data + fiber->stackstart,
|
janet_mark_many(fiber->data + fiber->stackstart,
|
||||||
fiber->stacktop - fiber->stackstart);
|
fiber->stacktop - fiber->stackstart);
|
||||||
|
|
||||||
i = fiber->frame;
|
i = fiber->frame;
|
||||||
j = fiber->stackstart - JANET_FRAME_SIZE;
|
j = fiber->stackstart - JANET_FRAME_SIZE;
|
||||||
@@ -223,21 +244,19 @@ recur:
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Deinitialize a block of memory */
|
/* Deinitialize a block of memory */
|
||||||
static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
static void janet_deinit_block(JanetGCObject *mem) {
|
||||||
void *mem = ((char *)(block + 1));
|
switch (mem->flags & JANET_MEM_TYPEBITS) {
|
||||||
JanetAbstractHeader *h = (JanetAbstractHeader *)mem;
|
|
||||||
switch (block->flags & JANET_MEM_TYPEBITS) {
|
|
||||||
default:
|
default:
|
||||||
case JANET_MEMORY_FUNCTION:
|
case JANET_MEMORY_FUNCTION:
|
||||||
break; /* Do nothing for non gc types */
|
break; /* Do nothing for non gc types */
|
||||||
case JANET_MEMORY_SYMBOL:
|
case JANET_MEMORY_SYMBOL:
|
||||||
janet_symbol_deinit((const uint8_t *)mem + 2 * sizeof(int32_t));
|
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ARRAY:
|
case JANET_MEMORY_ARRAY:
|
||||||
janet_array_deinit((JanetArray*) mem);
|
janet_array_deinit((JanetArray *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_TABLE:
|
case JANET_MEMORY_TABLE:
|
||||||
janet_table_deinit((JanetTable*) mem);
|
janet_table_deinit((JanetTable *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FIBER:
|
case JANET_MEMORY_FIBER:
|
||||||
free(((JanetFiber *)mem)->data);
|
free(((JanetFiber *)mem)->data);
|
||||||
@@ -245,38 +264,38 @@ static void janet_deinit_block(JanetGCMemoryHeader *block) {
|
|||||||
case JANET_MEMORY_BUFFER:
|
case JANET_MEMORY_BUFFER:
|
||||||
janet_buffer_deinit((JanetBuffer *) mem);
|
janet_buffer_deinit((JanetBuffer *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ABSTRACT:
|
case JANET_MEMORY_ABSTRACT: {
|
||||||
if (h->type->gc) {
|
JanetAbstractHead *head = (JanetAbstractHead *)mem;
|
||||||
janet_assert(!h->type->gc((void *)(h + 1), h->size), "finalizer failed");
|
if (head->type->gc) {
|
||||||
|
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||||
}
|
}
|
||||||
break;
|
}
|
||||||
case JANET_MEMORY_FUNCENV:
|
break;
|
||||||
{
|
case JANET_MEMORY_FUNCENV: {
|
||||||
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
JanetFuncEnv *env = (JanetFuncEnv *)mem;
|
||||||
if (0 == env->offset)
|
if (0 == env->offset)
|
||||||
free(env->as.values);
|
free(env->as.values);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FUNCDEF:
|
case JANET_MEMORY_FUNCDEF: {
|
||||||
{
|
JanetFuncDef *def = (JanetFuncDef *)mem;
|
||||||
JanetFuncDef *def = (JanetFuncDef *)mem;
|
/* TODO - get this all with one alloc and one free */
|
||||||
/* TODO - get this all with one alloc and one free */
|
free(def->defs);
|
||||||
free(def->defs);
|
free(def->environments);
|
||||||
free(def->environments);
|
free(def->constants);
|
||||||
free(def->constants);
|
free(def->bytecode);
|
||||||
free(def->bytecode);
|
free(def->sourcemap);
|
||||||
free(def->sourcemap);
|
}
|
||||||
}
|
break;
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Iterate over all allocated memory, and free memory that is not
|
/* Iterate over all allocated memory, and free memory that is not
|
||||||
* marked as reachable. Flip the gc color flag for next sweep. */
|
* marked as reachable. Flip the gc color flag for next sweep. */
|
||||||
void janet_sweep() {
|
void janet_sweep() {
|
||||||
JanetGCMemoryHeader *previous = NULL;
|
JanetGCObject *previous = NULL;
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
JanetGCMemoryHeader *next;
|
JanetGCObject *next;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
next = current->next;
|
next = current->next;
|
||||||
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
if (current->flags & (JANET_MEM_REACHABLE | JANET_MEM_DISABLED)) {
|
||||||
@@ -297,29 +316,26 @@ void janet_sweep() {
|
|||||||
|
|
||||||
/* Allocate some memory that is tracked for garbage collection */
|
/* Allocate some memory that is tracked for garbage collection */
|
||||||
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||||
JanetGCMemoryHeader *mdata;
|
JanetGCObject *mem;
|
||||||
size_t total = size + sizeof(JanetGCMemoryHeader);
|
|
||||||
|
|
||||||
/* Make sure everything is inited */
|
/* Make sure everything is inited */
|
||||||
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
janet_assert(NULL != janet_vm_cache, "please initialize janet before use");
|
||||||
void *mem = malloc(total);
|
mem = malloc(size);
|
||||||
|
|
||||||
/* Check for bad malloc */
|
/* Check for bad malloc */
|
||||||
if (NULL == mem) {
|
if (NULL == mem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
|
|
||||||
mdata = (JanetGCMemoryHeader *)mem;
|
|
||||||
|
|
||||||
/* Configure block */
|
/* Configure block */
|
||||||
mdata->flags = type;
|
mem->flags = type;
|
||||||
|
|
||||||
/* Prepend block to heap list */
|
/* Prepend block to heap list */
|
||||||
janet_vm_next_collection += (int32_t) size;
|
janet_vm_next_collection += (int32_t) size;
|
||||||
mdata->next = janet_vm_blocks;
|
mem->next = janet_vm_blocks;
|
||||||
janet_vm_blocks = mdata;
|
janet_vm_blocks = mem;
|
||||||
|
|
||||||
return (char *) mem + sizeof(JanetGCMemoryHeader);
|
return (void *)mem;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Run garbage collection */
|
/* Run garbage collection */
|
||||||
@@ -360,8 +376,7 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
if (janet_type(lhs) != janet_type(rhs))
|
if (janet_type(lhs) != janet_type(rhs))
|
||||||
return 0;
|
return 0;
|
||||||
switch (janet_type(lhs)) {
|
switch (janet_type(lhs)) {
|
||||||
case JANET_TRUE:
|
case JANET_BOOLEAN:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||||
@@ -375,9 +390,8 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
|||||||
* a value and all its children. */
|
* a value and all its children. */
|
||||||
int janet_gcunroot(Janet root) {
|
int janet_gcunroot(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
return 1;
|
return 1;
|
||||||
@@ -389,10 +403,9 @@ int janet_gcunroot(Janet root) {
|
|||||||
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
/* Remove a root value from the GC. This sets the effective reference count to 0. */
|
||||||
int janet_gcunrootall(Janet root) {
|
int janet_gcunrootall(Janet root) {
|
||||||
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
Janet *vtop = janet_vm_roots + janet_vm_root_count;
|
||||||
Janet *v = janet_vm_roots;
|
|
||||||
int ret = 0;
|
int ret = 0;
|
||||||
/* Search from top to bottom as access is most likely LIFO */
|
/* Search from top to bottom as access is most likely LIFO */
|
||||||
for (v = janet_vm_roots; v < vtop; v++) {
|
for (Janet *v = janet_vm_roots; v < vtop; v++) {
|
||||||
if (janet_gc_idequals(root, *v)) {
|
if (janet_gc_idequals(root, *v)) {
|
||||||
*v = janet_vm_roots[--janet_vm_root_count];
|
*v = janet_vm_roots[--janet_vm_root_count];
|
||||||
vtop--;
|
vtop--;
|
||||||
@@ -404,10 +417,10 @@ int janet_gcunrootall(Janet root) {
|
|||||||
|
|
||||||
/* Free all allocated memory */
|
/* Free all allocated memory */
|
||||||
void janet_clear_memory(void) {
|
void janet_clear_memory(void) {
|
||||||
JanetGCMemoryHeader *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
janet_deinit_block(current);
|
janet_deinit_block(current);
|
||||||
JanetGCMemoryHeader *next = current->next;
|
JanetGCObject *next = current->next;
|
||||||
free(current);
|
free(current);
|
||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
@@ -415,5 +428,9 @@ void janet_clear_memory(void) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Primitives for suspending GC. */
|
/* Primitives for suspending GC. */
|
||||||
int janet_gclock(void) { return janet_vm_gc_suspend++; }
|
int janet_gclock(void) {
|
||||||
void janet_gcunlock(int handle) { janet_vm_gc_suspend = handle; }
|
return janet_vm_gc_suspend++;
|
||||||
|
}
|
||||||
|
void janet_gcunlock(int handle) {
|
||||||
|
janet_vm_gc_suspend = handle;
|
||||||
|
}
|
||||||
|
|||||||
@@ -23,10 +23,12 @@
|
|||||||
#ifndef JANET_GC_H
|
#ifndef JANET_GC_H
|
||||||
#define JANET_GC_H
|
#define JANET_GC_H
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* The metadata header associated with an allocated block of memory */
|
/* The metadata header associated with an allocated block of memory */
|
||||||
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
|
#define janet_gc_header(mem) ((JanetGCObject *)(mem))
|
||||||
|
|
||||||
#define JANET_MEM_TYPEBITS 0xFF
|
#define JANET_MEM_TYPEBITS 0xFF
|
||||||
#define JANET_MEM_REACHABLE 0x100
|
#define JANET_MEM_REACHABLE 0x100
|
||||||
@@ -36,16 +38,8 @@
|
|||||||
#define janet_gc_type(m) (janet_gc_header(m)->flags & 0xFF)
|
#define janet_gc_type(m) (janet_gc_header(m)->flags & 0xFF)
|
||||||
|
|
||||||
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
#define janet_gc_mark(m) (janet_gc_header(m)->flags |= JANET_MEM_REACHABLE)
|
||||||
#define janet_gc_unmark(m) (janet_gc_header(m)->flags &= ~JANET_MEM_COLOR)
|
|
||||||
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
||||||
|
|
||||||
/* Memory header struct. Node of a linked list of memory blocks. */
|
|
||||||
typedef struct JanetGCMemoryHeader JanetGCMemoryHeader;
|
|
||||||
struct JanetGCMemoryHeader {
|
|
||||||
JanetGCMemoryHeader *next;
|
|
||||||
uint32_t flags;
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
/* Memory types for the GC. Different from JanetType to include funcenv and funcdef. */
|
||||||
enum JanetMemoryType {
|
enum JanetMemoryType {
|
||||||
JANET_MEMORY_NONE,
|
JANET_MEMORY_NONE,
|
||||||
|
|||||||
196
src/core/io.c
196
src/core/io.c
@@ -25,9 +25,12 @@
|
|||||||
#define _BSD_SOURCE
|
#define _BSD_SOURCE
|
||||||
|
|
||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <errno.h>
|
#include <errno.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#define IO_WRITE 1
|
#define IO_WRITE 1
|
||||||
#define IO_READ 2
|
#define IO_READ 2
|
||||||
@@ -45,11 +48,16 @@ struct IOFile {
|
|||||||
int flags;
|
int flags;
|
||||||
};
|
};
|
||||||
|
|
||||||
static int janet_io_gc(void *p, size_t len);
|
static int cfun_io_gc(void *p, size_t len);
|
||||||
|
static Janet io_file_get(void *p, Janet);
|
||||||
|
|
||||||
JanetAbstractType janet_io_filetype = {
|
JanetAbstractType cfun_io_filetype = {
|
||||||
"core/file",
|
"core/file",
|
||||||
janet_io_gc,
|
cfun_io_gc,
|
||||||
|
NULL,
|
||||||
|
io_file_get,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
NULL
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -93,7 +101,7 @@ static int checkflags(const uint8_t *str) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Janet makef(FILE *f, int flags) {
|
static Janet makef(FILE *f, int flags) {
|
||||||
IOFile *iof = (IOFile *) janet_abstract(&janet_io_filetype, sizeof(IOFile));
|
IOFile *iof = (IOFile *) janet_abstract(&cfun_io_filetype, sizeof(IOFile));
|
||||||
iof->file = f;
|
iof->file = f;
|
||||||
iof->flags = flags;
|
iof->flags = flags;
|
||||||
return janet_wrap_abstract(iof);
|
return janet_wrap_abstract(iof);
|
||||||
@@ -101,27 +109,29 @@ static Janet makef(FILE *f, int flags) {
|
|||||||
|
|
||||||
/* Open a process */
|
/* Open a process */
|
||||||
#ifdef __EMSCRIPTEN__
|
#ifdef __EMSCRIPTEN__
|
||||||
static Janet janet_io_popen(int32_t argc, Janet *argv) {
|
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||||
(void) argc;
|
(void) argc;
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_panic("not implemented on this platform");
|
janet_panic("not implemented on this platform");
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
static Janet janet_io_popen(int32_t argc, Janet *argv) {
|
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
const uint8_t *fname = janet_getstring(argv, 0);
|
const uint8_t *fname = janet_getstring(argv, 0);
|
||||||
const uint8_t *fmode = NULL;
|
const uint8_t *fmode = NULL;
|
||||||
|
int flags;
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
fmode = janet_getkeyword(argv, 1);
|
fmode = janet_getkeyword(argv, 1);
|
||||||
if (janet_string_length(fmode) != 1 ||
|
if (janet_string_length(fmode) != 1 ||
|
||||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||||
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
janet_panicf("invalid file mode :%S, expected :r or :w", fmode);
|
||||||
}
|
}
|
||||||
|
flags = IO_PIPED | (fmode[0] == 'r' ? IO_READ : IO_WRITE);
|
||||||
|
} else {
|
||||||
|
fmode = (const uint8_t *)"r";
|
||||||
|
flags = IO_PIPED | IO_READ;
|
||||||
}
|
}
|
||||||
int flags = (fmode && fmode[0] == '2')
|
|
||||||
? IO_PIPED | IO_WRITE
|
|
||||||
: IO_PIPED | IO_READ;
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define popen _popen
|
#define popen _popen
|
||||||
#endif
|
#endif
|
||||||
@@ -133,7 +143,7 @@ static Janet janet_io_popen(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
static Janet janet_io_fopen(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
const uint8_t *fname = janet_getstring(argv, 0);
|
const uint8_t *fname = janet_getstring(argv, 0);
|
||||||
const uint8_t *fmode;
|
const uint8_t *fmode;
|
||||||
@@ -162,9 +172,9 @@ static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Read a certain number of bytes into memory */
|
/* Read a certain number of bytes into memory */
|
||||||
static Janet janet_io_fread(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||||
JanetBuffer *buffer;
|
JanetBuffer *buffer;
|
||||||
if (argc == 2) {
|
if (argc == 2) {
|
||||||
@@ -187,6 +197,12 @@ static Janet janet_io_fread(int32_t argc, Janet *argv) {
|
|||||||
} else {
|
} else {
|
||||||
fseek(iof->file, 0, SEEK_END);
|
fseek(iof->file, 0, SEEK_END);
|
||||||
long fsize = ftell(iof->file);
|
long fsize = ftell(iof->file);
|
||||||
|
if (fsize < 0) {
|
||||||
|
janet_panicf("could not get file size of %v", argv[0]);
|
||||||
|
}
|
||||||
|
if (fsize > (INT32_MAX)) {
|
||||||
|
janet_panic("file to large to read into buffer");
|
||||||
|
}
|
||||||
fseek(iof->file, 0, SEEK_SET);
|
fseek(iof->file, 0, SEEK_SET);
|
||||||
read_chunk(iof, buffer, (int32_t) fsize);
|
read_chunk(iof, buffer, (int32_t) fsize);
|
||||||
}
|
}
|
||||||
@@ -208,9 +224,9 @@ static Janet janet_io_fread(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Write bytes to a file */
|
/* Write bytes to a file */
|
||||||
static Janet janet_io_fwrite(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||||
@@ -231,9 +247,9 @@ static Janet janet_io_fwrite(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Flush the bytes in the file */
|
/* Flush the bytes in the file */
|
||||||
static Janet janet_io_fflush(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||||
@@ -244,7 +260,7 @@ static Janet janet_io_fflush(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Cleanup a file */
|
/* Cleanup a file */
|
||||||
static int janet_io_gc(void *p, size_t len) {
|
static int cfun_io_gc(void *p, size_t len) {
|
||||||
(void) len;
|
(void) len;
|
||||||
IOFile *iof = (IOFile *)p;
|
IOFile *iof = (IOFile *)p;
|
||||||
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
||||||
@@ -254,9 +270,9 @@ static int janet_io_gc(void *p, size_t len) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Close a file */
|
/* Close a file */
|
||||||
static Janet janet_io_fclose(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||||
@@ -274,9 +290,9 @@ static Janet janet_io_fclose(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Seek a file */
|
/* Seek a file */
|
||||||
static Janet janet_io_fseek(int32_t argc, Janet *argv) {
|
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
IOFile *iof = janet_getabstract(argv, 0, &janet_io_filetype);
|
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||||
if (iof->flags & IO_CLOSED)
|
if (iof->flags & IO_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
long int offset = 0;
|
long int offset = 0;
|
||||||
@@ -300,87 +316,113 @@ static Janet janet_io_fseek(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static JanetMethod io_file_methods[] = {
|
||||||
|
{"close", cfun_io_fclose},
|
||||||
|
{"read", cfun_io_fread},
|
||||||
|
{"write", cfun_io_fwrite},
|
||||||
|
{"flush", cfun_io_fflush},
|
||||||
|
{"seek", cfun_io_fseek},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet io_file_get(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD))
|
||||||
|
janet_panicf("expected keyword, got %v", key);
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg io_cfuns[] = {
|
||||||
{
|
{
|
||||||
"file/open", janet_io_fopen,
|
"file/open", cfun_io_fopen,
|
||||||
JDOC("(file/open path [,mode])\n\n"
|
JDOC("(file/open path [,mode])\n\n"
|
||||||
"Open a file. path is an absolute or relative path, and "
|
"Open a file. path is an absolute or relative path, and "
|
||||||
"mode is a set of flags indicating the mode to open the file in. "
|
"mode is a set of flags indicating the mode to open the file in. "
|
||||||
"mode is a keyword where each character represents a flag. If the file "
|
"mode is a keyword where each character represents a flag. If the file "
|
||||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||||
"Mode flags:\n\n"
|
"Mode flags:\n\n"
|
||||||
"\tr - allow reading from the file\n"
|
"\tr - allow reading from the file\n"
|
||||||
"\tw - allow writing to the file\n"
|
"\tw - allow writing to the file\n"
|
||||||
"\ta - append to the file\n"
|
"\ta - append to the file\n"
|
||||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||||
"\t+ - append to the file instead of overwriting it")
|
"\t+ - append to the file instead of overwriting it")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/close", janet_io_fclose,
|
"file/close", cfun_io_fclose,
|
||||||
JDOC("(file/close f)\n\n"
|
JDOC("(file/close f)\n\n"
|
||||||
"Close a file and release all related resources. When you are "
|
"Close a file and release all related resources. When you are "
|
||||||
"done reading a file, close it to prevent a resource leak and let "
|
"done reading a file, close it to prevent a resource leak and let "
|
||||||
"other processes read the file.")
|
"other processes read the file.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/read", janet_io_fread,
|
"file/read", cfun_io_fread,
|
||||||
JDOC("(file/read f what [,buf])\n\n"
|
JDOC("(file/read f what [,buf])\n\n"
|
||||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||||
"be provided as an optional fourth argument, otherwise a new buffer "
|
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||||
"buffer with file contents. "
|
"buffer with file contents. "
|
||||||
"Values for 'what':\n\n"
|
"Values for 'what':\n\n"
|
||||||
"\t:all - read the whole file\n"
|
"\t:all - read the whole file\n"
|
||||||
"\t:line - read up to and including the next newline character\n"
|
"\t:line - read up to and including the next newline character\n"
|
||||||
"\tn (integer) - read up to n bytes from the file")
|
"\tn (integer) - read up to n bytes from the file")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/write", janet_io_fwrite,
|
"file/write", cfun_io_fwrite,
|
||||||
JDOC("(file/write f bytes)\n\n"
|
JDOC("(file/write f bytes)\n\n"
|
||||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||||
"file.")
|
"file.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/flush", janet_io_fflush,
|
"file/flush", cfun_io_fflush,
|
||||||
JDOC("(file/flush f)\n\n"
|
JDOC("(file/flush f)\n\n"
|
||||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||||
"buffered for efficiency reasons. Returns the file handle.")
|
"buffered for efficiency reasons. Returns the file handle.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/seek", janet_io_fseek,
|
"file/seek", cfun_io_fseek,
|
||||||
JDOC("(file/seek f [,whence [,n]])\n\n"
|
JDOC("(file/seek f [,whence [,n]])\n\n"
|
||||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||||
"\t:cur - jump relative to the current file location\n"
|
"\t:cur - jump relative to the current file location\n"
|
||||||
"\t:set - jump relative to the beginning of the file\n"
|
"\t:set - jump relative to the beginning of the file\n"
|
||||||
"\t:end - jump relative to the end of the file\n\n"
|
"\t:end - jump relative to the end of the file\n\n"
|
||||||
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
"By default, 'whence' is :cur. Optionally a value n may be passed "
|
||||||
"for the relative number of bytes to seek in the file. n may be a real "
|
"for the relative number of bytes to seek in the file. n may be a real "
|
||||||
"number to handle large files of more the 4GB. Returns the file handle.")
|
"number to handle large files of more the 4GB. Returns the file handle.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/popen", janet_io_popen,
|
"file/popen", cfun_io_popen,
|
||||||
JDOC("(file/popen path [,mode])\n\n"
|
JDOC("(file/popen path [,mode])\n\n"
|
||||||
"Open a file that is backed by a process. The file must be opened in either "
|
"Open a file that is backed by a process. The file must be opened in either "
|
||||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||||
"process can be read from the file. In :w mode, the stdin of the process "
|
"process can be read from the file. In :w mode, the stdin of the process "
|
||||||
"can be written to. Returns the new file.")
|
"can be written to. Returns the new file.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* C API */
|
||||||
|
|
||||||
|
FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
|
||||||
|
IOFile *iof = janet_getabstract(argv, n, &cfun_io_filetype);
|
||||||
|
if (NULL != flags) *flags = iof->flags;
|
||||||
|
return iof->file;
|
||||||
|
}
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_io(JanetTable *env) {
|
void janet_lib_io(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, io_cfuns);
|
||||||
|
|
||||||
/* stdout */
|
/* stdout */
|
||||||
janet_def(env, "stdout",
|
janet_core_def(env, "stdout",
|
||||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
JDOC("The standard output file."));
|
JDOC("The standard output file."));
|
||||||
/* stderr */
|
/* stderr */
|
||||||
janet_def(env, "stderr",
|
janet_core_def(env, "stderr",
|
||||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
JDOC("The standard error file."));
|
JDOC("The standard error file."));
|
||||||
/* stdin */
|
/* stdin */
|
||||||
janet_def(env, "stdin",
|
janet_core_def(env, "stdin",
|
||||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||||
JDOC("The standard input file."));
|
JDOC("The standard input file."));
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|||||||
1057
src/core/marsh.c
1057
src/core/marsh.c
File diff suppressed because it is too large
Load Diff
@@ -20,12 +20,15 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Get a random number */
|
/* Get a random number */
|
||||||
Janet janet_rand(int32_t argc, Janet *argv) {
|
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
||||||
@@ -33,14 +36,14 @@ Janet janet_rand(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Seed the random number generator */
|
/* Seed the random number generator */
|
||||||
Janet janet_srand(int32_t argc, Janet *argv) {
|
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t x = janet_getinteger(argv, 0);
|
int32_t x = janet_getinteger(argv, 0);
|
||||||
srand((unsigned) x);
|
srand((unsigned) x);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_remainder(int32_t argc, Janet *argv) {
|
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
double x = janet_getnumber(argv, 0);
|
double x = janet_getnumber(argv, 0);
|
||||||
double y = janet_getnumber(argv, 1);
|
double y = janet_getnumber(argv, 1);
|
||||||
@@ -48,7 +51,7 @@ Janet janet_remainder(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||||
Janet janet_##name(int32_t argc, Janet *argv) {\
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
janet_fixarity(argc, 1); \
|
janet_fixarity(argc, 1); \
|
||||||
double x = janet_getnumber(argv, 0); \
|
double x = janet_getnumber(argv, 0); \
|
||||||
return janet_wrap_number(fop(x)); \
|
return janet_wrap_number(fop(x)); \
|
||||||
@@ -72,7 +75,7 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
|||||||
JANET_DEFINE_MATHOP(floor, floor)
|
JANET_DEFINE_MATHOP(floor, floor)
|
||||||
|
|
||||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||||
Janet janet_##name(int32_t argc, Janet *argv) {\
|
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||||
janet_fixarity(argc, 2); \
|
janet_fixarity(argc, 2); \
|
||||||
double lhs = janet_getnumber(argv, 0); \
|
double lhs = janet_getnumber(argv, 0); \
|
||||||
double rhs = janet_getnumber(argv, 1); \
|
double rhs = janet_getnumber(argv, 1); \
|
||||||
@@ -87,11 +90,11 @@ static Janet janet_not(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg math_cfuns[] = {
|
||||||
{
|
{
|
||||||
"%", janet_remainder,
|
"%", janet_remainder,
|
||||||
JDOC("(% dividend divisor)\n\n"
|
JDOC("(% dividend divisor)\n\n"
|
||||||
"Returns the remainder of dividend / divisor.")
|
"Returns the remainder of dividend / divisor.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"not", janet_not,
|
"not", janet_not,
|
||||||
@@ -100,91 +103,116 @@ static const JanetReg cfuns[] = {
|
|||||||
{
|
{
|
||||||
"math/random", janet_rand,
|
"math/random", janet_rand,
|
||||||
JDOC("(math/random)\n\n"
|
JDOC("(math/random)\n\n"
|
||||||
"Returns a uniformly distributed random number between 0 and 1.")
|
"Returns a uniformly distributed random number between 0 and 1.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/seedrandom", janet_srand,
|
"math/seedrandom", janet_srand,
|
||||||
JDOC("(math/seedrandom seed)\n\n"
|
JDOC("(math/seedrandom seed)\n\n"
|
||||||
"Set the seed for the random number generator. 'seed' should be an "
|
"Set the seed for the random number generator. 'seed' should be an "
|
||||||
"an integer.")
|
"an integer.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/cos", janet_cos,
|
"math/cos", janet_cos,
|
||||||
JDOC("(math/cos x)\n\n"
|
JDOC("(math/cos x)\n\n"
|
||||||
"Returns the cosine of x.")
|
"Returns the cosine of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/sin", janet_sin,
|
"math/sin", janet_sin,
|
||||||
JDOC("(math/sin x)\n\n"
|
JDOC("(math/sin x)\n\n"
|
||||||
"Returns the sine of x.")
|
"Returns the sine of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/tan", janet_tan,
|
"math/tan", janet_tan,
|
||||||
JDOC("(math/tan x)\n\n"
|
JDOC("(math/tan x)\n\n"
|
||||||
"Returns the tangent of x.")
|
"Returns the tangent of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/acos", janet_acos,
|
"math/acos", janet_acos,
|
||||||
JDOC("(math/acos x)\n\n"
|
JDOC("(math/acos x)\n\n"
|
||||||
"Returns the arccosine of x.")
|
"Returns the arccosine of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/asin", janet_asin,
|
"math/asin", janet_asin,
|
||||||
JDOC("(math/asin x)\n\n"
|
JDOC("(math/asin x)\n\n"
|
||||||
"Returns the arcsine of x.")
|
"Returns the arcsine of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/atan", janet_atan,
|
"math/atan", janet_atan,
|
||||||
JDOC("(math/atan x)\n\n"
|
JDOC("(math/atan x)\n\n"
|
||||||
"Returns the arctangent of x.")
|
"Returns the arctangent of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/exp", janet_exp,
|
"math/exp", janet_exp,
|
||||||
JDOC("(math/exp x)\n\n"
|
JDOC("(math/exp x)\n\n"
|
||||||
"Returns e to the power of x.")
|
"Returns e to the power of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/log", janet_log,
|
"math/log", janet_log,
|
||||||
JDOC("(math/log x)\n\n"
|
JDOC("(math/log x)\n\n"
|
||||||
"Returns log base 2 of x.")
|
"Returns log base 2 of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/log10", janet_log10,
|
"math/log10", janet_log10,
|
||||||
JDOC("(math/log10 x)\n\n"
|
JDOC("(math/log10 x)\n\n"
|
||||||
"Returns log base 10 of x.")
|
"Returns log base 10 of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/sqrt", janet_sqrt,
|
"math/sqrt", janet_sqrt,
|
||||||
JDOC("(math/sqrt x)\n\n"
|
JDOC("(math/sqrt x)\n\n"
|
||||||
"Returns the square root of x.")
|
"Returns the square root of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/floor", janet_floor,
|
"math/floor", janet_floor,
|
||||||
JDOC("(math/floor x)\n\n"
|
JDOC("(math/floor x)\n\n"
|
||||||
"Returns the largest integer value number that is not greater than x.")
|
"Returns the largest integer value number that is not greater than x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/ceil", janet_ceil,
|
"math/ceil", janet_ceil,
|
||||||
JDOC("(math/ceil x)\n\n"
|
JDOC("(math/ceil x)\n\n"
|
||||||
"Returns the smallest integer value number that is not less than x.")
|
"Returns the smallest integer value number that is not less than x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/pow", janet_pow,
|
"math/pow", janet_pow,
|
||||||
JDOC("(math/pow a x)\n\n"
|
JDOC("(math/pow a x)\n\n"
|
||||||
"Return a to the power of x.")
|
"Return a to the power of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/abs", janet_fabs,
|
||||||
|
JDOC("(math/abs x)\n\n"
|
||||||
|
"Return the absolute value of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/sinh", janet_sinh,
|
||||||
|
JDOC("(math/sinh x)\n\n"
|
||||||
|
"Return the hyperbolic sine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/cosh", janet_cosh,
|
||||||
|
JDOC("(math/cosh x)\n\n"
|
||||||
|
"Return the hyperbolic cosine of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/tanh", janet_tanh,
|
||||||
|
JDOC("(math/tanh x)\n\n"
|
||||||
|
"Return the hyperbolic tangent of x.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"math/atan2", janet_atan2,
|
||||||
|
JDOC("(math/atan2 y x)\n\n"
|
||||||
|
"Return the arctangent of y/x. Works even when x is 0.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_math(JanetTable *env) {
|
void janet_lib_math(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, math_cfuns);
|
||||||
#ifndef JANET_NO_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||||
JDOC("The value pi."));
|
JDOC("The value pi."));
|
||||||
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||||
JDOC("The base of the natural log."));
|
JDOC("The base of the natural log."));
|
||||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||||
JDOC("The number representing positive infinity"));
|
JDOC("The number representing positive infinity"));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|||||||
162
src/core/os.c
162
src/core/os.c
@@ -20,10 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <time.h>
|
#include <time.h>
|
||||||
#include "util.h"
|
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#include <Windows.h>
|
#include <Windows.h>
|
||||||
@@ -44,15 +47,15 @@
|
|||||||
static Janet os_which(int32_t argc, Janet *argv) {
|
static Janet os_which(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
return janet_ckeywordv("windows");
|
return janet_ckeywordv("windows");
|
||||||
#elif __APPLE__
|
#elif __APPLE__
|
||||||
return janet_ckeywordv("macos");
|
return janet_ckeywordv("macos");
|
||||||
#elif defined(__EMSCRIPTEN__)
|
#elif defined(__EMSCRIPTEN__)
|
||||||
return janet_ckeywordv("web");
|
return janet_ckeywordv("web");
|
||||||
#else
|
#else
|
||||||
return janet_ckeywordv("posix");
|
return janet_ckeywordv("posix");
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
@@ -74,12 +77,12 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
|||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
int nwritten = MultiByteToWideChar(
|
int nwritten = MultiByteToWideChar(
|
||||||
CP_UTF8,
|
CP_UTF8,
|
||||||
MB_PRECOMPOSED,
|
MB_PRECOMPOSED,
|
||||||
buffer->data,
|
buffer->data,
|
||||||
buffer->count,
|
buffer->count,
|
||||||
sys_str,
|
sys_str,
|
||||||
buffer->count);
|
buffer->count);
|
||||||
if (nwritten == 0) {
|
if (nwritten == 0) {
|
||||||
free(sys_str);
|
free(sys_str);
|
||||||
janet_panic("could not create process");
|
janet_panic("could not create process");
|
||||||
@@ -93,16 +96,16 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
|||||||
ZeroMemory(&pi, sizeof(pi));
|
ZeroMemory(&pi, sizeof(pi));
|
||||||
|
|
||||||
// Start the child process.
|
// Start the child process.
|
||||||
if(!CreateProcess(NULL,
|
if (!CreateProcess(NULL,
|
||||||
(LPSTR) sys_str,
|
(LPSTR) sys_str,
|
||||||
NULL,
|
NULL,
|
||||||
NULL,
|
NULL,
|
||||||
FALSE,
|
FALSE,
|
||||||
0,
|
0,
|
||||||
NULL,
|
NULL,
|
||||||
NULL,
|
NULL,
|
||||||
&si,
|
&si,
|
||||||
&pi)) {
|
&pi)) {
|
||||||
free(sys_str);
|
free(sys_str);
|
||||||
janet_panic("could not create process");
|
janet_panic("could not create process");
|
||||||
}
|
}
|
||||||
@@ -122,6 +125,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
|||||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, -1);
|
janet_arity(argc, 1, -1);
|
||||||
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
||||||
|
int status = 0;
|
||||||
if (NULL == child_argv) {
|
if (NULL == child_argv) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -138,9 +142,10 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
|||||||
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
||||||
exit(1);
|
exit(1);
|
||||||
}
|
}
|
||||||
|
} else {
|
||||||
|
waitpid(pid, &status, 0);
|
||||||
}
|
}
|
||||||
int status;
|
free(child_argv);
|
||||||
waitpid(pid, &status, 0);
|
|
||||||
return janet_wrap_integer(status);
|
return janet_wrap_integer(status);
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
@@ -148,12 +153,12 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
|||||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
const char *cmd = argc
|
const char *cmd = argc
|
||||||
? (const char *)janet_getstring(argv, 0)
|
? (const char *)janet_getstring(argv, 0)
|
||||||
: NULL;
|
: NULL;
|
||||||
int stat = system(cmd);
|
int stat = system(cmd);
|
||||||
return argc
|
return argc
|
||||||
? janet_wrap_integer(stat)
|
? janet_wrap_integer(stat)
|
||||||
: janet_wrap_boolean(stat);
|
: janet_wrap_boolean(stat);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
@@ -162,8 +167,8 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
|
|||||||
const char *cstr = (const char *) k;
|
const char *cstr = (const char *) k;
|
||||||
const char *res = getenv(cstr);
|
const char *res = getenv(cstr);
|
||||||
return (res && cstr)
|
return (res && cstr)
|
||||||
? janet_cstringv(res)
|
? janet_cstringv(res)
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet os_setenv(int32_t argc, Janet *argv) {
|
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||||
@@ -209,7 +214,7 @@ static Janet os_time(int32_t argc, Janet *argv) {
|
|||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
static int gettime(struct timespec *spec) {
|
static int gettime(struct timespec *spec) {
|
||||||
int64_t wintime = 0LL;
|
int64_t wintime = 0LL;
|
||||||
GetSystemTimeAsFileTime((FILETIME*)&wintime);
|
GetSystemTimeAsFileTime((FILETIME *)&wintime);
|
||||||
/* Windows epoch is January 1, 1601 apparently*/
|
/* Windows epoch is January 1, 1601 apparently*/
|
||||||
wintime -= 116444736000000000LL;
|
wintime -= 116444736000000000LL;
|
||||||
spec->tv_sec = wintime / 10000000LL;
|
spec->tv_sec = wintime / 10000000LL;
|
||||||
@@ -246,13 +251,13 @@ static Janet os_sleep(int32_t argc, Janet *argv) {
|
|||||||
double delay = janet_getnumber(argv, 0);
|
double delay = janet_getnumber(argv, 0);
|
||||||
if (delay < 0) janet_panic("invalid argument to sleep");
|
if (delay < 0) janet_panic("invalid argument to sleep");
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
Sleep((DWORD) (delay * 1000));
|
Sleep((DWORD)(delay * 1000));
|
||||||
#else
|
#else
|
||||||
struct timespec ts;
|
struct timespec ts;
|
||||||
ts.tv_sec = (time_t) delay;
|
ts.tv_sec = (time_t) delay;
|
||||||
ts.tv_nsec = (delay <= UINT32_MAX)
|
ts.tv_nsec = (delay <= UINT32_MAX)
|
||||||
? (long)((delay - ((uint32_t)delay)) * 1000000000)
|
? (long)((delay - ((uint32_t)delay)) * 1000000000)
|
||||||
: 0;
|
: 0;
|
||||||
nanosleep(&ts, NULL);
|
nanosleep(&ts, NULL);
|
||||||
#endif
|
#endif
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
@@ -272,69 +277,108 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
|
|||||||
return janet_cstringv(ptr);
|
return janet_cstringv(ptr);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static Janet os_date(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 0, 1);
|
||||||
|
(void) argv;
|
||||||
|
time_t t;
|
||||||
|
struct tm *t_info;
|
||||||
|
if (argc) {
|
||||||
|
t = (time_t) janet_getinteger64(argv, 0);
|
||||||
|
} else {
|
||||||
|
time(&t);
|
||||||
|
}
|
||||||
|
t_info = localtime(&t);
|
||||||
|
JanetKV *st = janet_struct_begin(9);
|
||||||
|
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("hours"), janet_wrap_number(t_info->tm_hour));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("month-day"), janet_wrap_number(t_info->tm_mday - 1));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("month"), janet_wrap_number(t_info->tm_mon));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("year"), janet_wrap_number(t_info->tm_year + 1900));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("week-day"), janet_wrap_number(t_info->tm_wday));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("year-day"), janet_wrap_number(t_info->tm_yday));
|
||||||
|
janet_struct_put(st, janet_ckeywordv("dst"), janet_wrap_boolean(t_info->tm_isdst));
|
||||||
|
return janet_wrap_struct(janet_struct_end(st));
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg os_cfuns[] = {
|
||||||
{
|
{
|
||||||
"os/which", os_which,
|
"os/which", os_which,
|
||||||
JDOC("(os/which)\n\n"
|
JDOC("(os/which)\n\n"
|
||||||
"Check the current operating system. Returns one of:\n\n"
|
"Check the current operating system. Returns one of:\n\n"
|
||||||
"\t:windows - Microsoft Windows\n"
|
"\t:windows - Microsoft Windows\n"
|
||||||
"\t:macos - Apple macos\n"
|
"\t:macos - Apple macos\n"
|
||||||
"\t:posix - A POSIX compatible system (default)")
|
"\t:posix - A POSIX compatible system (default)")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/execute", os_execute,
|
"os/execute", os_execute,
|
||||||
JDOC("(os/execute program & args)\n\n"
|
JDOC("(os/execute program & args)\n\n"
|
||||||
"Execute a program on the system and pass it string arguments. Returns "
|
"Execute a program on the system and pass it string arguments. Returns "
|
||||||
"the exit status of the program.")
|
"the exit status of the program.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/shell", os_shell,
|
"os/shell", os_shell,
|
||||||
JDOC("(os/shell str)\n\n"
|
JDOC("(os/shell str)\n\n"
|
||||||
"Pass a command string str directly to the system shell.")
|
"Pass a command string str directly to the system shell.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/exit", os_exit,
|
"os/exit", os_exit,
|
||||||
JDOC("(os/exit x)\n\n"
|
JDOC("(os/exit x)\n\n"
|
||||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||||
"the exit with status equal the hash of x.")
|
"the exit with status equal the hash of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/getenv", os_getenv,
|
"os/getenv", os_getenv,
|
||||||
JDOC("(os/getenv variable)\n\n"
|
JDOC("(os/getenv variable)\n\n"
|
||||||
"Get the string value of an environment variable.")
|
"Get the string value of an environment variable.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/setenv", os_setenv,
|
"os/setenv", os_setenv,
|
||||||
JDOC("(os/setenv variable value)\n\n"
|
JDOC("(os/setenv variable value)\n\n"
|
||||||
"Set an environment variable.")
|
"Set an environment variable.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/time", os_time,
|
"os/time", os_time,
|
||||||
JDOC("(os/time)\n\n"
|
JDOC("(os/time)\n\n"
|
||||||
"Get the current time expressed as the number of seconds since "
|
"Get the current time expressed as the number of seconds since "
|
||||||
"January 1, 1970, the Unix epoch. Returns a real number.")
|
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/clock", os_clock,
|
"os/clock", os_clock,
|
||||||
JDOC("(os/clock)\n\n"
|
JDOC("(os/clock)\n\n"
|
||||||
"Return the number of seconds since some fixed point in time. The clock "
|
"Return the number of seconds since some fixed point in time. The clock "
|
||||||
"is guaranteed to be non decreased in real time.")
|
"is guaranteed to be non decreasing in real time.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/sleep", os_sleep,
|
"os/sleep", os_sleep,
|
||||||
JDOC("(os/sleep nsec)\n\n"
|
JDOC("(os/sleep nsec)\n\n"
|
||||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||||
"nil.")
|
"nil.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/cwd", os_cwd,
|
"os/cwd", os_cwd,
|
||||||
JDOC("(os/cwd)\n\n"
|
JDOC("(os/cwd)\n\n"
|
||||||
"Returns the current working directory.")
|
"Returns the current working directory.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"os/date", os_date,
|
||||||
|
JDOC("(os/date [,time])\n\n"
|
||||||
|
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||||
|
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||||
|
"\t:seconds - number of seconds [0-61]\n"
|
||||||
|
"\t:minutes - number of minutes [0-59]\n"
|
||||||
|
"\t:seconds - number of hours [0-23]\n"
|
||||||
|
"\t:month-day - day of month [0-30]\n"
|
||||||
|
"\t:month - month of year [0, 11]\n"
|
||||||
|
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||||
|
"\t:week-day - day of the week [0-6]\n"
|
||||||
|
"\t:year-day - day of the year [0-365]\n"
|
||||||
|
"\t:dst - If Day Light Savings is in effect")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_os(JanetTable *env) {
|
void janet_lib_os(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, os_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
364
src/core/parse.c
364
src/core/parse.c
@@ -20,17 +20,20 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Check if a character is whitespace */
|
/* Check if a character is whitespace */
|
||||||
static int is_whitespace(uint8_t c) {
|
static int is_whitespace(uint8_t c) {
|
||||||
return c == ' '
|
return c == ' '
|
||||||
|| c == '\t'
|
|| c == '\t'
|
||||||
|| c == '\n'
|
|| c == '\n'
|
||||||
|| c == '\r'
|
|| c == '\r'
|
||||||
|| c == '\0'
|
|| c == '\0'
|
||||||
|| c == '\f';
|
|| c == '\v'
|
||||||
|
|| c == '\f';
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Code generated by tools/symcharsgen.c.
|
/* Code generated by tools/symcharsgen.c.
|
||||||
@@ -46,7 +49,7 @@ static const uint32_t symchars[8] = {
|
|||||||
/* Check if a character is a valid symbol character
|
/* Check if a character is a valid symbol character
|
||||||
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
* symbol chars are A-Z, a-z, 0-9, or one of !$&*+-./:<=>@\^_~| */
|
||||||
static int is_symbol_char(uint8_t c) {
|
static int is_symbol_char(uint8_t c) {
|
||||||
return symchars[c >> 5] & (1 << (c & 0x1F));
|
return symchars[c >> 5] & ((uint32_t)1 << (c & 0x1F));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Validate some utf8. Useful for identifiers. Only validates
|
/* Validate some utf8. Useful for identifiers. Only validates
|
||||||
@@ -189,17 +192,30 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
|
|
||||||
static int checkescape(uint8_t c) {
|
static int checkescape(uint8_t c) {
|
||||||
switch (c) {
|
switch (c) {
|
||||||
default: return -1;
|
default:
|
||||||
case 'x': return 1;
|
return -1;
|
||||||
case 'n': return '\n';
|
case 'x':
|
||||||
case 't': return '\t';
|
return 1;
|
||||||
case 'r': return '\r';
|
case 'n':
|
||||||
case '0': return '\0';
|
return '\n';
|
||||||
case 'z': return '\0';
|
case 't':
|
||||||
case 'f': return '\f';
|
return '\t';
|
||||||
case 'e': return 27;
|
case 'r':
|
||||||
case '"': return '"';
|
return '\r';
|
||||||
case '\\': return '\\';
|
case '0':
|
||||||
|
return '\0';
|
||||||
|
case 'z':
|
||||||
|
return '\0';
|
||||||
|
case 'f':
|
||||||
|
return '\f';
|
||||||
|
case 'v':
|
||||||
|
return '\v';
|
||||||
|
case 'e':
|
||||||
|
return 27;
|
||||||
|
case '"':
|
||||||
|
return '"';
|
||||||
|
case '\\':
|
||||||
|
return '\\';
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -293,9 +309,11 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
}
|
}
|
||||||
/* Token finished */
|
/* Token finished */
|
||||||
blen = (int32_t) p->bufcount;
|
blen = (int32_t) p->bufcount;
|
||||||
|
int start_dig = p->buf[0] >= '0' && p->buf[0] <= '9';
|
||||||
|
int start_num = start_dig || p->buf[0] == '-' || p->buf[0] == '+' || p->buf[0] == '.';
|
||||||
if (p->buf[0] == ':') {
|
if (p->buf[0] == ':') {
|
||||||
ret = janet_keywordv(p->buf + 1, blen - 1);
|
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||||
} else if (!janet_scan_number(p->buf, blen, &numval)) {
|
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
||||||
ret = janet_wrap_number(numval);
|
ret = janet_wrap_number(numval);
|
||||||
} else if (!check_str_const("nil", p->buf, blen)) {
|
} else if (!check_str_const("nil", p->buf, blen)) {
|
||||||
ret = janet_wrap_nil();
|
ret = janet_wrap_nil();
|
||||||
@@ -304,7 +322,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
} else if (!check_str_const("true", p->buf, blen)) {
|
} else if (!check_str_const("true", p->buf, blen)) {
|
||||||
ret = janet_wrap_true();
|
ret = janet_wrap_true();
|
||||||
} else if (p->buf) {
|
} else if (p->buf) {
|
||||||
if (p->buf[0] >= '0' && p->buf[0] <= '9') {
|
if (start_dig) {
|
||||||
p->error = "symbol literal cannot start with a digit";
|
p->error = "symbol literal cannot start with a digit";
|
||||||
return 0;
|
return 0;
|
||||||
} else {
|
} else {
|
||||||
@@ -331,8 +349,9 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet close_tuple(JanetParser *p, JanetParseState *state) {
|
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
||||||
Janet *ret = janet_tuple_begin(state->argn);
|
Janet *ret = janet_tuple_begin(state->argn);
|
||||||
|
janet_tuple_flag(ret) |= flag;
|
||||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||||
ret[i] = p->args[--p->argcount];
|
ret[i] = p->args[--p->argcount];
|
||||||
return janet_wrap_tuple(janet_tuple_end(ret));
|
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||||
@@ -416,23 +435,23 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
(void) state;
|
(void) state;
|
||||||
p->statecount--;
|
p->statecount--;
|
||||||
switch (c) {
|
switch (c) {
|
||||||
case '{':
|
case '{':
|
||||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
case '"':
|
case '"':
|
||||||
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
||||||
return 1;
|
return 1;
|
||||||
case '`':
|
case '`':
|
||||||
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
||||||
return 1;
|
return 1;
|
||||||
case '[':
|
case '[':
|
||||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
case '(':
|
case '(':
|
||||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
|
||||||
return 1;
|
return 1;
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
pushstate(p, tokenchar, 0);
|
pushstate(p, tokenchar, 0);
|
||||||
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
|
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
|
||||||
@@ -470,37 +489,36 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return 1;
|
return 1;
|
||||||
case ')':
|
case ')':
|
||||||
case ']':
|
case ']':
|
||||||
case '}':
|
case '}': {
|
||||||
{
|
Janet ds;
|
||||||
Janet ds;
|
if (p->statecount == 1) {
|
||||||
if (p->statecount == 1) {
|
p->error = "unexpected delimiter";
|
||||||
p->error = "mismatched delimiter";
|
return 1;
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
|
||||||
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
|
|
||||||
if (state->flags & PFLAG_ATSYM) {
|
|
||||||
ds = close_array(p, state);
|
|
||||||
} else {
|
|
||||||
ds = close_tuple(p, state);
|
|
||||||
}
|
|
||||||
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
|
|
||||||
if (state->argn & 1) {
|
|
||||||
p->error = "struct and table literals expect even number of arguments";
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
if (state->flags & PFLAG_ATSYM) {
|
|
||||||
ds = close_table(p, state);
|
|
||||||
} else {
|
|
||||||
ds = close_struct(p, state);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
p->error = "mismatched delimiter";
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
popstate(p, ds);
|
|
||||||
}
|
}
|
||||||
return 1;
|
if ((c == ')' && (state->flags & PFLAG_PARENS)) ||
|
||||||
|
(c == ']' && (state->flags & PFLAG_SQRBRACKETS))) {
|
||||||
|
if (state->flags & PFLAG_ATSYM) {
|
||||||
|
ds = close_array(p, state);
|
||||||
|
} else {
|
||||||
|
ds = close_tuple(p, state, c == ']' ? JANET_TUPLE_FLAG_BRACKETCTOR : 0);
|
||||||
|
}
|
||||||
|
} else if (c == '}' && (state->flags & PFLAG_CURLYBRACKETS)) {
|
||||||
|
if (state->argn & 1) {
|
||||||
|
p->error = "struct and table literals expect even number of arguments";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
if (state->flags & PFLAG_ATSYM) {
|
||||||
|
ds = close_table(p, state);
|
||||||
|
} else {
|
||||||
|
ds = close_struct(p, state);
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
p->error = "mismatched delimiter";
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
popstate(p, ds);
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
case '(':
|
case '(':
|
||||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
|
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||||
return 1;
|
return 1;
|
||||||
@@ -513,20 +531,37 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int janet_parser_consume(JanetParser *parser, uint8_t c) {
|
static void janet_parser_checkdead(JanetParser *parser) {
|
||||||
|
if (parser->flag) janet_panic("parser is dead, cannot consume");
|
||||||
|
if (parser->error) janet_panic("parser has unchecked error, cannot consume");
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Public API */
|
||||||
|
|
||||||
|
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||||
int consumed = 0;
|
int consumed = 0;
|
||||||
if (parser->error) return 0;
|
janet_parser_checkdead(parser);
|
||||||
parser->offset++;
|
parser->offset++;
|
||||||
while (!consumed && !parser->error) {
|
while (!consumed && !parser->error) {
|
||||||
JanetParseState *state = parser->states + parser->statecount - 1;
|
JanetParseState *state = parser->states + parser->statecount - 1;
|
||||||
consumed = state->consumer(parser, state, c);
|
consumed = state->consumer(parser, state, c);
|
||||||
}
|
}
|
||||||
parser->lookback = c;
|
parser->lookback = c;
|
||||||
return 1;
|
}
|
||||||
|
|
||||||
|
void janet_parser_eof(JanetParser *parser) {
|
||||||
|
janet_parser_checkdead(parser);
|
||||||
|
janet_parser_consume(parser, '\n');
|
||||||
|
if (parser->statecount > 1) {
|
||||||
|
parser->error = "unexpected end of source";
|
||||||
|
}
|
||||||
|
parser->offset--;
|
||||||
|
parser->flag = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||||
if (parser->error) return JANET_PARSE_ERROR;
|
if (parser->error) return JANET_PARSE_ERROR;
|
||||||
|
if (parser->flag) return JANET_PARSE_DEAD;
|
||||||
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
||||||
return JANET_PARSE_ROOT;
|
return JANET_PARSE_ROOT;
|
||||||
}
|
}
|
||||||
@@ -576,6 +611,7 @@ void janet_parser_init(JanetParser *parser) {
|
|||||||
parser->lookback = -1;
|
parser->lookback = -1;
|
||||||
parser->offset = 0;
|
parser->offset = 0;
|
||||||
parser->pending = 0;
|
parser->pending = 0;
|
||||||
|
parser->flag = 0;
|
||||||
|
|
||||||
pushstate(parser, root, PFLAG_CONTAINER);
|
pushstate(parser, root, PFLAG_CONTAINER);
|
||||||
}
|
}
|
||||||
@@ -605,14 +641,20 @@ static int parsergc(void *p, size_t size) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
static Janet parserget(void *p, Janet key);
|
||||||
|
|
||||||
static JanetAbstractType janet_parse_parsertype = {
|
static JanetAbstractType janet_parse_parsertype = {
|
||||||
"core/parser",
|
"core/parser",
|
||||||
parsergc,
|
parsergc,
|
||||||
parsermark
|
parsermark,
|
||||||
|
parserget,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL
|
||||||
};
|
};
|
||||||
|
|
||||||
/* C Function parser */
|
/* C Function parser */
|
||||||
static Janet cfun_parser(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||||
(void) argv;
|
(void) argv;
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||||
@@ -620,7 +662,7 @@ static Janet cfun_parser(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_abstract(p);
|
return janet_wrap_abstract(p);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_consume(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 2, 3);
|
janet_arity(argc, 2, 3);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JanetByteView view = janet_getbytes(argv, 1);
|
JanetByteView view = janet_getbytes(argv, 1);
|
||||||
@@ -645,13 +687,53 @@ static Janet cfun_consume(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_integer(i);
|
return janet_wrap_integer(i);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_has_more(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);
|
||||||
|
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);
|
||||||
|
JanetParseState *s = p->states + p->statecount - 1;
|
||||||
|
if (s->consumer == tokenchar) {
|
||||||
|
janet_parser_consume(p, ' ');
|
||||||
|
p->offset--;
|
||||||
|
s = p->states + p->statecount - 1;
|
||||||
|
}
|
||||||
|
if (s->flags & PFLAG_CONTAINER) {
|
||||||
|
s->argn++;
|
||||||
|
if (p->statecount == 1) p->pending++;
|
||||||
|
push_arg(p, argv[1]);
|
||||||
|
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
|
||||||
|
const uint8_t *str = janet_to_string(argv[1]);
|
||||||
|
int32_t slen = janet_string_length(str);
|
||||||
|
size_t newcount = p->bufcount + slen;
|
||||||
|
if (p->bufcap > p->bufcount + slen) {
|
||||||
|
size_t newcap = 2 * newcount;
|
||||||
|
p->buf = realloc(p->buf, newcap);
|
||||||
|
if (p->buf == NULL) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
p->bufcap = newcap;
|
||||||
|
}
|
||||||
|
memcpy(p->buf + p->bufcount, str, slen);
|
||||||
|
p->bufcount = newcount;
|
||||||
|
} else {
|
||||||
|
janet_panic("cannot insert value into parser");
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_parse_has_more(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_byte(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
int32_t i = janet_getinteger(argv, 1);
|
int32_t i = janet_getinteger(argv, 1);
|
||||||
@@ -659,7 +741,7 @@ static Janet cfun_byte(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_status(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
const char *stat = NULL;
|
const char *stat = NULL;
|
||||||
@@ -673,11 +755,14 @@ static Janet cfun_status(int32_t argc, Janet *argv) {
|
|||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
stat = "root";
|
stat = "root";
|
||||||
break;
|
break;
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
stat = "dead";
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
return janet_ckeywordv(stat);
|
return janet_ckeywordv(stat);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_error(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
const char *err = janet_parser_error(p);
|
const char *err = janet_parser_error(p);
|
||||||
@@ -685,26 +770,26 @@ static Janet cfun_error(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_produce(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
return janet_parser_produce(p);
|
return janet_parser_produce(p);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_flush(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
janet_parser_flush(p);
|
janet_parser_flush(p);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_where(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
return janet_wrap_integer(p->offset);
|
return janet_wrap_integer(p->offset);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_state(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||||
size_t i;
|
size_t i;
|
||||||
const uint8_t *str;
|
const uint8_t *str;
|
||||||
size_t oldcount;
|
size_t oldcount;
|
||||||
@@ -733,80 +818,113 @@ static Janet cfun_state(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_string(str);
|
return janet_wrap_string(str);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetMethod parser_methods[] = {
|
||||||
|
{"byte", cfun_parse_byte},
|
||||||
|
{"consume", cfun_parse_consume},
|
||||||
|
{"error", cfun_parse_error},
|
||||||
|
{"flush", cfun_parse_flush},
|
||||||
|
{"has-more", cfun_parse_has_more},
|
||||||
|
{"insert", cfun_parse_insert},
|
||||||
|
{"produce", cfun_parse_produce},
|
||||||
|
{"state", cfun_parse_state},
|
||||||
|
{"status", cfun_parse_status},
|
||||||
|
{"where", cfun_parse_where},
|
||||||
|
{"eof", cfun_parse_eof},
|
||||||
|
{NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
static Janet parserget(void *p, Janet key) {
|
||||||
|
(void) p;
|
||||||
|
if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method");
|
||||||
|
return janet_getmethod(janet_unwrap_keyword(key), parser_methods);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg parse_cfuns[] = {
|
||||||
{
|
{
|
||||||
"parser/new", cfun_parser,
|
"parser/new", cfun_parse_parser,
|
||||||
JDOC("(parser/new)\n\n"
|
JDOC("(parser/new)\n\n"
|
||||||
"Creates and returns a new parser object. Parsers are state machines "
|
"Creates and returns a new parser object. Parsers are state machines "
|
||||||
"that can receive bytes, and generate a stream of janet values. ")
|
"that can receive bytes, and generate a stream of janet values. ")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/has-more", cfun_has_more,
|
"parser/has-more", cfun_parse_has_more,
|
||||||
JDOC("(parser/has-more parser)\n\n"
|
JDOC("(parser/has-more parser)\n\n"
|
||||||
"Check if the parser has more values in the value queue.")
|
"Check if the parser has more values in the value queue.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/produce", cfun_produce,
|
"parser/produce", cfun_parse_produce,
|
||||||
JDOC("(parser/produce parser)\n\n"
|
JDOC("(parser/produce parser)\n\n"
|
||||||
"Dequeue the next value in the parse queue. Will return nil if "
|
"Dequeue the next value in the parse queue. Will return nil if "
|
||||||
"no parsed values are in the queue, otherwise will dequeue the "
|
"no parsed values are in the queue, otherwise will dequeue the "
|
||||||
"next value.")
|
"next value.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/consume", cfun_consume,
|
"parser/consume", cfun_parse_consume,
|
||||||
JDOC("(parser/consume parser bytes [, index])\n\n"
|
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||||
"Input bytes into the parser and parse them. Will not throw errors "
|
"Input bytes into the parser and parse them. Will not throw errors "
|
||||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||||
"the number of bytes read.")
|
"the number of bytes read.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/byte", cfun_byte,
|
"parser/byte", cfun_parse_byte,
|
||||||
JDOC("(parser/byte parser b)\n\n"
|
JDOC("(parser/byte parser b)\n\n"
|
||||||
"Input a single byte into the parser byte stream. Returns the parser.")
|
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/error", cfun_error,
|
"parser/error", cfun_parse_error,
|
||||||
JDOC("(parser/error parser)\n\n"
|
JDOC("(parser/error parser)\n\n"
|
||||||
"If the parser is in the error state, returns the message associated with "
|
"If the parser is in the error state, returns the message associated with "
|
||||||
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
"that error. Otherwise, returns nil. Also flushes the parser state and parser "
|
||||||
"queue, so be sure to handle everything in the queue before calling "
|
"queue, so be sure to handle everything in the queue before calling "
|
||||||
"parser/error.")
|
"parser/error.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/status", cfun_status,
|
"parser/status", cfun_parse_status,
|
||||||
JDOC("(parser/status parser)\n\n"
|
JDOC("(parser/status parser)\n\n"
|
||||||
"Gets the current status of the parser state machine. The status will "
|
"Gets the current status of the parser state machine. The status will "
|
||||||
"be one of:\n\n"
|
"be one of:\n\n"
|
||||||
"\t:pending - a value is being parsed.\n"
|
"\t:pending - a value is being parsed.\n"
|
||||||
"\t:error - a parsing error was encountered.\n"
|
"\t:error - a parsing error was encountered.\n"
|
||||||
"\t:root - the parser can either read more values or safely terminate.")
|
"\t:root - the parser can either read more values or safely terminate.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/flush", cfun_flush,
|
"parser/flush", cfun_parse_flush,
|
||||||
JDOC("(parser/flush parser)\n\n"
|
JDOC("(parser/flush parser)\n\n"
|
||||||
"Clears the parser state and parse queue. Can be used to reset the parser "
|
"Clears the parser state and parse queue. Can be used to reset the parser "
|
||||||
"if an error was encountered. Does not reset the line and column counter, so "
|
"if an error was encountered. Does not reset the line and column counter, so "
|
||||||
"to begin parsing in a new context, create a new parser.")
|
"to begin parsing in a new context, create a new parser.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/state", cfun_state,
|
"parser/state", cfun_parse_state,
|
||||||
JDOC("(parser/state parser)\n\n"
|
JDOC("(parser/state parser)\n\n"
|
||||||
"Returns a string representation of the internal state of the parser. "
|
"Returns a string representation of the internal state of the parser. "
|
||||||
"Each byte in the string represents a nested data structure. For example, "
|
"Each byte in the string represents a nested data structure. For example, "
|
||||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/where", cfun_where,
|
"parser/where", cfun_parse_where,
|
||||||
JDOC("(parser/where parser)\n\n"
|
JDOC("(parser/where parser)\n\n"
|
||||||
"Returns the current line number and column number of the parser's location "
|
"Returns the current line number and column number of the parser's location "
|
||||||
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
||||||
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/eof", cfun_parse_eof,
|
||||||
|
JDOC("(parser/insert parser)\n\n"
|
||||||
|
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"parser/insert", cfun_parse_insert,
|
||||||
|
JDOC("(parser/insert parser value)\n\n"
|
||||||
|
"Insert a value into the parser. This means that the parser state can be manipulated "
|
||||||
|
"in between chunks of bytes. This would allow a user to add extra elements to arrays "
|
||||||
|
"and tuples, for example. Returns the parser.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the library */
|
/* Load the library */
|
||||||
void janet_lib_parse(JanetTable *env) {
|
void janet_lib_parse(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
1099
src/core/peg.c
Normal file
1099
src/core/peg.c
Normal file
File diff suppressed because it is too large
Load Diff
680
src/core/pp.c
Normal file
680
src/core/pp.c
Normal file
@@ -0,0 +1,680 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in the Software without restriction, including without limitation the
|
||||||
|
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
* sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
* furnished to do so, subject to the following conditions:
|
||||||
|
*
|
||||||
|
* The above copyright notice and this permission notice shall be included in
|
||||||
|
* all copies or substantial portions of the Software.
|
||||||
|
*
|
||||||
|
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
* IN THE SOFTWARE.
|
||||||
|
*/
|
||||||
|
|
||||||
|
#include <string.h>
|
||||||
|
#include <ctype.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#include "state.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Implements a pretty printer for Janet. The pretty printer
|
||||||
|
* is farily simple and not that flexible, but fast. */
|
||||||
|
|
||||||
|
/* Temporary buffer size */
|
||||||
|
#define BUFSIZE 64
|
||||||
|
|
||||||
|
static void number_to_string_b(JanetBuffer *buffer, double x) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||||
|
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%g", x);
|
||||||
|
buffer->count += count;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* expects non positive x */
|
||||||
|
static int count_dig10(int32_t x) {
|
||||||
|
int result = 1;
|
||||||
|
for (;;) {
|
||||||
|
if (x > -10) return result;
|
||||||
|
if (x > -100) return result + 1;
|
||||||
|
if (x > -1000) return result + 2;
|
||||||
|
if (x > -10000) return result + 3;
|
||||||
|
x /= 10000;
|
||||||
|
result += 4;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||||
|
janet_buffer_extra(buffer, BUFSIZE);
|
||||||
|
uint8_t *buf = buffer->data + buffer->count;
|
||||||
|
int32_t neg = 0;
|
||||||
|
int32_t len = 0;
|
||||||
|
if (x == 0) {
|
||||||
|
buf[0] = '0';
|
||||||
|
buffer->count++;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (x > 0) {
|
||||||
|
x = -x;
|
||||||
|
} else {
|
||||||
|
neg = 1;
|
||||||
|
*buf++ = '-';
|
||||||
|
}
|
||||||
|
len = count_dig10(x);
|
||||||
|
buf += len;
|
||||||
|
while (x) {
|
||||||
|
uint8_t digit = (uint8_t) - (x % 10);
|
||||||
|
*(--buf) = '0' + digit;
|
||||||
|
x /= 10;
|
||||||
|
}
|
||||||
|
buffer->count += len + neg;
|
||||||
|
}
|
||||||
|
|
||||||
|
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
|
||||||
|
|
||||||
|
/* Returns a string description for a pointer. Truncates
|
||||||
|
* title to 32 characters */
|
||||||
|
static void string_description_b(JanetBuffer *buffer, const char *title, void *pointer) {
|
||||||
|
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
|
||||||
|
uint8_t *c = buffer->data + buffer->count;
|
||||||
|
int32_t i;
|
||||||
|
union {
|
||||||
|
uint8_t bytes[sizeof(void *)];
|
||||||
|
void *p;
|
||||||
|
} pbuf;
|
||||||
|
|
||||||
|
pbuf.p = pointer;
|
||||||
|
*c++ = '<';
|
||||||
|
/* Maximum of 32 bytes for abstract type name */
|
||||||
|
for (i = 0; title[i] && i < 32; ++i)
|
||||||
|
*c++ = ((uint8_t *)title) [i];
|
||||||
|
*c++ = ' ';
|
||||||
|
*c++ = '0';
|
||||||
|
*c++ = 'x';
|
||||||
|
#if defined(JANET_64)
|
||||||
|
#define POINTSIZE 6
|
||||||
|
#else
|
||||||
|
#define POINTSIZE (sizeof(void *))
|
||||||
|
#endif
|
||||||
|
for (i = POINTSIZE; i > 0; --i) {
|
||||||
|
uint8_t byte = pbuf.bytes[i - 1];
|
||||||
|
*c++ = HEX(byte >> 4);
|
||||||
|
*c++ = HEX(byte & 0xF);
|
||||||
|
}
|
||||||
|
*c++ = '>';
|
||||||
|
buffer->count = (int32_t)(c - buffer->data);
|
||||||
|
#undef POINTSIZE
|
||||||
|
}
|
||||||
|
|
||||||
|
#undef HEX
|
||||||
|
#undef BUFSIZE
|
||||||
|
|
||||||
|
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||||
|
janet_buffer_push_u8(buffer, '"');
|
||||||
|
for (int32_t i = 0; i < len; ++i) {
|
||||||
|
uint8_t c = str[i];
|
||||||
|
switch (c) {
|
||||||
|
case '"':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
|
||||||
|
break;
|
||||||
|
case '\n':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
|
||||||
|
break;
|
||||||
|
case '\r':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
|
||||||
|
break;
|
||||||
|
case '\0':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
|
||||||
|
break;
|
||||||
|
case '\f':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
|
||||||
|
break;
|
||||||
|
case '\v':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||||
|
break;
|
||||||
|
case 27:
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||||
|
break;
|
||||||
|
case '\\':
|
||||||
|
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||||
|
break;
|
||||||
|
default:
|
||||||
|
if (c < 32 || c > 127) {
|
||||||
|
uint8_t buf[4];
|
||||||
|
buf[0] = '\\';
|
||||||
|
buf[1] = 'x';
|
||||||
|
buf[2] = janet_base64[(c >> 4) & 0xF];
|
||||||
|
buf[3] = janet_base64[c & 0xF];
|
||||||
|
janet_buffer_push_bytes(buffer, buf, 4);
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(buffer, c);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(buffer, '"');
|
||||||
|
}
|
||||||
|
|
||||||
|
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||||
|
janet_escape_string_impl(buffer, str, janet_string_length(str));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
|
||||||
|
janet_buffer_push_u8(buffer, '@');
|
||||||
|
janet_escape_string_impl(buffer, bx->data, bx->count);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
case JANET_NIL:
|
||||||
|
janet_buffer_push_cstring(buffer, "nil");
|
||||||
|
return;
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
janet_buffer_push_cstring(buffer,
|
||||||
|
janet_unwrap_boolean(x) ? "true" : "false");
|
||||||
|
return;
|
||||||
|
case JANET_NUMBER:
|
||||||
|
number_to_string_b(buffer, janet_unwrap_number(x));
|
||||||
|
return;
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
janet_buffer_push_u8(buffer, ':');
|
||||||
|
/* fallthrough */
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_string(x),
|
||||||
|
janet_string_length(janet_unwrap_string(x)));
|
||||||
|
return;
|
||||||
|
case JANET_STRING:
|
||||||
|
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||||
|
return;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_escape_buffer_b(buffer, janet_unwrap_buffer(x));
|
||||||
|
return;
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
const char *n = janet_abstract_type(janet_unwrap_abstract(x))->name;
|
||||||
|
string_description_b(buffer, n, janet_unwrap_abstract(x));
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
case JANET_CFUNCTION: {
|
||||||
|
Janet check = janet_table_get(janet_vm_registry, x);
|
||||||
|
if (janet_checktype(check, JANET_SYMBOL)) {
|
||||||
|
janet_buffer_push_cstring(buffer, "<cfunction ");
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_symbol(check),
|
||||||
|
janet_string_length(janet_unwrap_symbol(check)));
|
||||||
|
janet_buffer_push_u8(buffer, '>');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
goto fallthrough;
|
||||||
|
}
|
||||||
|
case JANET_FUNCTION: {
|
||||||
|
JanetFunction *fun = janet_unwrap_function(x);
|
||||||
|
JanetFuncDef *def = fun->def;
|
||||||
|
if (def->name) {
|
||||||
|
const uint8_t *n = def->name;
|
||||||
|
janet_buffer_push_cstring(buffer, "<function ");
|
||||||
|
janet_buffer_push_bytes(buffer, n, janet_string_length(n));
|
||||||
|
janet_buffer_push_u8(buffer, '>');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
goto fallthrough;
|
||||||
|
}
|
||||||
|
fallthrough:
|
||||||
|
default:
|
||||||
|
string_description_b(buffer, janet_type_names[janet_type(x)], janet_unwrap_pointer(x));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
janet_description_b(buffer, x);
|
||||||
|
break;
|
||||||
|
case JANET_BUFFER:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_buffer(x)->data,
|
||||||
|
janet_unwrap_buffer(x)->count);
|
||||||
|
break;
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
janet_buffer_push_bytes(buffer,
|
||||||
|
janet_unwrap_string(x),
|
||||||
|
janet_string_length(janet_unwrap_string(x)));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
const uint8_t *janet_description(Janet x) {
|
||||||
|
JanetBuffer b;
|
||||||
|
janet_buffer_init(&b, 10);
|
||||||
|
janet_description_b(&b, x);
|
||||||
|
const uint8_t *ret = janet_string(b.data, b.count);
|
||||||
|
janet_buffer_deinit(&b);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Convert any value to a janet string. Similar to description, but
|
||||||
|
* strings, symbols, and buffers will return their content. */
|
||||||
|
const uint8_t *janet_to_string(Janet x) {
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default: {
|
||||||
|
JanetBuffer b;
|
||||||
|
janet_buffer_init(&b, 10);
|
||||||
|
janet_to_string_b(&b, x);
|
||||||
|
const uint8_t *ret = janet_string(b.data, b.count);
|
||||||
|
janet_buffer_deinit(&b);
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
case JANET_BUFFER:
|
||||||
|
return janet_string(janet_unwrap_buffer(x)->data, janet_unwrap_buffer(x)->count);
|
||||||
|
case JANET_STRING:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_KEYWORD:
|
||||||
|
return janet_unwrap_string(x);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Hold state for pretty printer. */
|
||||||
|
struct pretty {
|
||||||
|
JanetBuffer *buffer;
|
||||||
|
int depth;
|
||||||
|
int indent;
|
||||||
|
JanetTable seen;
|
||||||
|
};
|
||||||
|
|
||||||
|
static void print_newline(struct pretty *S, int just_a_space) {
|
||||||
|
int i;
|
||||||
|
if (just_a_space) {
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
janet_buffer_push_u8(S->buffer, '\n');
|
||||||
|
for (i = 0; i < S->indent; i++) {
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Helper for pretty printing */
|
||||||
|
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||||
|
/* Add to seen */
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
case JANET_NIL:
|
||||||
|
case JANET_NUMBER:
|
||||||
|
case JANET_SYMBOL:
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
break;
|
||||||
|
default: {
|
||||||
|
Janet seenid = janet_table_get(&S->seen, x);
|
||||||
|
if (janet_checktype(seenid, JANET_NUMBER)) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||||
|
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||||
|
janet_buffer_push_u8(S->buffer, '>');
|
||||||
|
return;
|
||||||
|
} else {
|
||||||
|
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
switch (janet_type(x)) {
|
||||||
|
default:
|
||||||
|
janet_description_b(S->buffer, x);
|
||||||
|
break;
|
||||||
|
case JANET_ARRAY:
|
||||||
|
case JANET_TUPLE: {
|
||||||
|
int32_t i, len;
|
||||||
|
const Janet *arr;
|
||||||
|
int isarray = janet_checktype(x, JANET_ARRAY);
|
||||||
|
janet_indexed_view(x, &arr, &len);
|
||||||
|
int hasbrackets = !isarray && (janet_tuple_flag(arr) & JANET_TUPLE_FLAG_BRACKETCTOR);
|
||||||
|
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
|
||||||
|
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
|
||||||
|
janet_buffer_push_cstring(S->buffer, startstr);
|
||||||
|
S->depth--;
|
||||||
|
S->indent += 2;
|
||||||
|
if (S->depth == 0) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
} else {
|
||||||
|
if (!isarray && len >= 5)
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
if (is_dict_value && len >= 5) print_newline(S, 0);
|
||||||
|
for (i = 0; i < len; i++) {
|
||||||
|
if (i) print_newline(S, len < 5);
|
||||||
|
janet_pretty_one(S, arr[i], 0);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S->indent -= 2;
|
||||||
|
S->depth++;
|
||||||
|
janet_buffer_push_u8(S->buffer, endchar);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_STRUCT:
|
||||||
|
case JANET_TABLE: {
|
||||||
|
int istable = janet_checktype(x, JANET_TABLE);
|
||||||
|
janet_buffer_push_cstring(S->buffer, istable ? "@" : "{");
|
||||||
|
|
||||||
|
/* For object-like tables, print class name */
|
||||||
|
if (istable) {
|
||||||
|
JanetTable *t = janet_unwrap_table(x);
|
||||||
|
JanetTable *proto = t->proto;
|
||||||
|
if (NULL != proto) {
|
||||||
|
Janet name = janet_table_get(proto, janet_csymbolv(":name"));
|
||||||
|
if (janet_checktype(name, JANET_SYMBOL)) {
|
||||||
|
const uint8_t *sym = janet_unwrap_symbol(name);
|
||||||
|
janet_buffer_push_bytes(S->buffer, sym, janet_string_length(sym));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_buffer_push_cstring(S->buffer, "{");
|
||||||
|
}
|
||||||
|
|
||||||
|
S->depth--;
|
||||||
|
S->indent += 2;
|
||||||
|
if (S->depth == 0) {
|
||||||
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
|
} else {
|
||||||
|
int32_t i, len, cap;
|
||||||
|
int first_kv_pair = 1;
|
||||||
|
const JanetKV *kvs;
|
||||||
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
|
if (!istable && len >= 4)
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
if (is_dict_value && len >= 5) print_newline(S, 0);
|
||||||
|
for (i = 0; i < cap; i++) {
|
||||||
|
if (!janet_checktype(kvs[i].key, JANET_NIL)) {
|
||||||
|
if (first_kv_pair) {
|
||||||
|
first_kv_pair = 0;
|
||||||
|
} else {
|
||||||
|
print_newline(S, len < 4);
|
||||||
|
}
|
||||||
|
janet_pretty_one(S, kvs[i].key, 0);
|
||||||
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
|
janet_pretty_one(S, kvs[i].value, 1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
S->indent -= 2;
|
||||||
|
S->depth++;
|
||||||
|
janet_buffer_push_u8(S->buffer, '}');
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
/* Remove from seen */
|
||||||
|
janet_table_remove(&S->seen, x);
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||||
|
* for serialization or anything like that. */
|
||||||
|
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x) {
|
||||||
|
struct pretty S;
|
||||||
|
if (NULL == buffer) {
|
||||||
|
buffer = janet_buffer(0);
|
||||||
|
}
|
||||||
|
S.buffer = buffer;
|
||||||
|
S.depth = depth;
|
||||||
|
S.indent = 0;
|
||||||
|
janet_table_init(&S.seen, 10);
|
||||||
|
janet_pretty_one(&S, x, 0);
|
||||||
|
janet_table_deinit(&S.seen);
|
||||||
|
return S.buffer;
|
||||||
|
}
|
||||||
|
|
||||||
|
static const char *typestr(Janet x) {
|
||||||
|
JanetType t = janet_type(x);
|
||||||
|
return (t == JANET_ABSTRACT)
|
||||||
|
? janet_abstract_type(janet_unwrap_abstract(x))->name
|
||||||
|
: janet_type_names[t];
|
||||||
|
}
|
||||||
|
|
||||||
|
static void pushtypes(JanetBuffer *buffer, int types) {
|
||||||
|
int first = 1;
|
||||||
|
int i = 0;
|
||||||
|
while (types) {
|
||||||
|
if (1 & types) {
|
||||||
|
if (first) {
|
||||||
|
first = 0;
|
||||||
|
} else {
|
||||||
|
janet_buffer_push_u8(buffer, '|');
|
||||||
|
}
|
||||||
|
janet_buffer_push_cstring(buffer, janet_type_names[i]);
|
||||||
|
}
|
||||||
|
i++;
|
||||||
|
types >>= 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
/* 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;
|
||||||
|
int32_t len = 0;
|
||||||
|
int32_t i;
|
||||||
|
const uint8_t *ret;
|
||||||
|
JanetBuffer buffer;
|
||||||
|
JanetBuffer *bufp = &buffer;
|
||||||
|
|
||||||
|
/* Calculate length */
|
||||||
|
while (format[len]) len++;
|
||||||
|
|
||||||
|
/* Initialize buffer */
|
||||||
|
janet_buffer_init(bufp, len);
|
||||||
|
|
||||||
|
/* Start args */
|
||||||
|
va_start(args, format);
|
||||||
|
|
||||||
|
/* Iterate length */
|
||||||
|
for (i = 0; i < len; i++) {
|
||||||
|
uint8_t c = format[i];
|
||||||
|
switch (c) {
|
||||||
|
default:
|
||||||
|
janet_buffer_push_u8(bufp, c);
|
||||||
|
break;
|
||||||
|
case '%': {
|
||||||
|
if (i + 1 >= len)
|
||||||
|
break;
|
||||||
|
switch (format[++i]) {
|
||||||
|
default:
|
||||||
|
janet_buffer_push_u8(bufp, format[i]);
|
||||||
|
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, va_arg(args, Janet));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
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
|
||||||
|
*/
|
||||||
|
|
||||||
|
#define MAX_ITEM 256
|
||||||
|
#define FMT_FLAGS "-+ #0"
|
||||||
|
#define MAX_FORMAT 32
|
||||||
|
|
||||||
|
static const char *scanformat(
|
||||||
|
const char *strfrmt,
|
||||||
|
char *form,
|
||||||
|
char width[3],
|
||||||
|
char precision[3]) {
|
||||||
|
const char *p = strfrmt;
|
||||||
|
memset(width, '\0', 3);
|
||||||
|
memset(precision, '\0', 3);
|
||||||
|
while (*p != '\0' && strchr(FMT_FLAGS, *p) != NULL)
|
||||||
|
p++; /* skip flags */
|
||||||
|
if ((size_t)(p - strfrmt) >= sizeof(FMT_FLAGS) / sizeof(char))
|
||||||
|
janet_panic("invalid format (repeated flags)");
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
width[0] = *p++; /* skip width */
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
width[1] = *p++; /* (2 digits at most) */
|
||||||
|
if (*p == '.') {
|
||||||
|
p++;
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
precision[0] = *p++; /* skip precision */
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
precision[1] = *p++; /* (2 digits at most) */
|
||||||
|
}
|
||||||
|
if (isdigit((int)(*p)))
|
||||||
|
janet_panic("invalid format (width or precision too long)");
|
||||||
|
*(form++) = '%';
|
||||||
|
memcpy(form, strfrmt, ((p - strfrmt) + 1) * sizeof(char));
|
||||||
|
form += (p - strfrmt) + 1;
|
||||||
|
*form = '\0';
|
||||||
|
return p;
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Shared implementation between string/format and
|
||||||
|
* buffer/format */
|
||||||
|
void janet_buffer_format(
|
||||||
|
JanetBuffer *b,
|
||||||
|
const char *strfrmt,
|
||||||
|
int32_t argstart,
|
||||||
|
int32_t argc,
|
||||||
|
Janet *argv) {
|
||||||
|
size_t sfl = strlen(strfrmt);
|
||||||
|
const char *strfrmt_end = strfrmt + sfl;
|
||||||
|
int32_t arg = argstart;
|
||||||
|
while (strfrmt < strfrmt_end) {
|
||||||
|
if (*strfrmt != '%')
|
||||||
|
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
||||||
|
else if (*++strfrmt == '%')
|
||||||
|
janet_buffer_push_u8(b, (uint8_t) * strfrmt++); /* %% */
|
||||||
|
else { /* format item */
|
||||||
|
char form[MAX_FORMAT], item[MAX_ITEM];
|
||||||
|
char width[3], precision[3];
|
||||||
|
int nb = 0; /* number of bytes in added item */
|
||||||
|
if (++arg >= argc)
|
||||||
|
janet_panic("not enough values for format");
|
||||||
|
strfrmt = scanformat(strfrmt, form, width, precision);
|
||||||
|
switch (*strfrmt++) {
|
||||||
|
case 'c': {
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, (int)
|
||||||
|
janet_getinteger(argv, arg));
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'd':
|
||||||
|
case 'i':
|
||||||
|
case 'o':
|
||||||
|
case 'u':
|
||||||
|
case 'x':
|
||||||
|
case 'X': {
|
||||||
|
int32_t n = janet_getinteger(argv, arg);
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, n);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'a':
|
||||||
|
case 'A':
|
||||||
|
case 'e':
|
||||||
|
case 'E':
|
||||||
|
case 'f':
|
||||||
|
case 'g':
|
||||||
|
case 'G': {
|
||||||
|
double d = janet_getnumber(argv, arg);
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, d);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 's': {
|
||||||
|
const uint8_t *s = janet_getstring(argv, arg);
|
||||||
|
int32_t l = janet_string_length(s);
|
||||||
|
if (form[2] == '\0')
|
||||||
|
janet_buffer_push_bytes(b, s, l);
|
||||||
|
else {
|
||||||
|
if (l != (int32_t) strlen((const char *) s))
|
||||||
|
janet_panic("string contains zeros");
|
||||||
|
if (!strchr(form, '.') && l >= 100) {
|
||||||
|
janet_panic
|
||||||
|
("no precision and string is too long to be formatted");
|
||||||
|
} else {
|
||||||
|
nb = snprintf(item, MAX_ITEM, form, s);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'V': {
|
||||||
|
janet_to_string_b(b, argv[arg]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'v': {
|
||||||
|
janet_description_b(b, argv[arg]);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case 'p': { /* janet pretty , precision = depth */
|
||||||
|
int depth = atoi(precision);
|
||||||
|
if (depth < 1)
|
||||||
|
depth = 4;
|
||||||
|
janet_pretty(b, depth, argv[arg]);
|
||||||
|
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);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
@@ -20,8 +20,10 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "regalloc.h"
|
#include "regalloc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||||
ra->chunks = NULL;
|
ra->chunks = NULL;
|
||||||
@@ -64,12 +66,16 @@ void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocato
|
|||||||
dest->capacity = src->capacity;
|
dest->capacity = src->capacity;
|
||||||
dest->max = src->max;
|
dest->max = src->max;
|
||||||
size = sizeof(uint32_t) * dest->capacity;
|
size = sizeof(uint32_t) * dest->capacity;
|
||||||
dest->chunks = malloc(size);
|
|
||||||
dest->regtemps = 0;
|
dest->regtemps = 0;
|
||||||
if (!dest->chunks) {
|
if (size) {
|
||||||
JANET_OUT_OF_MEMORY;
|
dest->chunks = malloc(size);
|
||||||
|
if (!dest->chunks) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
memcpy(dest->chunks, src->chunks, size);
|
||||||
|
} else {
|
||||||
|
dest->chunks = NULL;
|
||||||
}
|
}
|
||||||
memcpy(dest->chunks, src->chunks, size);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Allocate one more chunk in chunks */
|
/* Allocate one more chunk in chunks */
|
||||||
|
|||||||
101
src/core/run.c
101
src/core/run.c
@@ -20,78 +20,25 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "vector.h"
|
#endif
|
||||||
|
|
||||||
/* Error reporting */
|
|
||||||
void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err) {
|
|
||||||
int32_t fi;
|
|
||||||
const char *errstr = (const char *)janet_to_string(err);
|
|
||||||
JanetFiber **fibers = NULL;
|
|
||||||
fprintf(stderr, "%s error: %s\n", errtype, errstr);
|
|
||||||
|
|
||||||
while (fiber) {
|
|
||||||
janet_v_push(fibers, fiber);
|
|
||||||
fiber = fiber->child;
|
|
||||||
}
|
|
||||||
|
|
||||||
for (fi = janet_v_count(fibers) - 1; fi >= 0; fi--) {
|
|
||||||
fiber = fibers[fi];
|
|
||||||
int32_t i = fiber->frame;
|
|
||||||
if (i > 0) fprintf(stderr, " (fiber)\n");
|
|
||||||
while (i > 0) {
|
|
||||||
JanetStackFrame *frame = (JanetStackFrame *)(fiber->data + i - JANET_FRAME_SIZE);
|
|
||||||
JanetFuncDef *def = NULL;
|
|
||||||
i = frame->prevframe;
|
|
||||||
fprintf(stderr, " in");
|
|
||||||
if (frame->func) {
|
|
||||||
def = frame->func->def;
|
|
||||||
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
|
||||||
if (def->source) {
|
|
||||||
fprintf(stderr, " [%s]", (const char *)def->source);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
|
||||||
if (cfun) {
|
|
||||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
|
||||||
if (!janet_checktype(name, JANET_NIL))
|
|
||||||
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
|
||||||
else
|
|
||||||
fprintf(stderr, " <cfunction>");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
|
||||||
fprintf(stderr, " (tailcall)");
|
|
||||||
if (frame->func && frame->pc) {
|
|
||||||
int32_t off = (int32_t) (frame->pc - def->bytecode);
|
|
||||||
if (def->sourcemap) {
|
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
|
||||||
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
|
|
||||||
} else {
|
|
||||||
fprintf(stderr, " pc=%d", off);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
fprintf(stderr, "\n");
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
janet_v_free(fibers);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Run a string */
|
/* Run a string */
|
||||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||||
JanetParser parser;
|
JanetParser parser;
|
||||||
int errflags = 0;
|
int errflags = 0, done = 0;
|
||||||
int32_t index = 0;
|
int32_t index = 0;
|
||||||
int dudeol = 0;
|
|
||||||
int done = 0;
|
|
||||||
Janet ret = janet_wrap_nil();
|
Janet ret = janet_wrap_nil();
|
||||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||||
|
|
||||||
if (where) janet_gcroot(janet_wrap_string(where));
|
if (where) janet_gcroot(janet_wrap_string(where));
|
||||||
|
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||||
janet_parser_init(&parser);
|
janet_parser_init(&parser);
|
||||||
|
|
||||||
while (!errflags && !done) {
|
/* While we haven't seen an error */
|
||||||
|
while (!done) {
|
||||||
|
|
||||||
/* Evaluate parsed values */
|
/* Evaluate parsed values */
|
||||||
while (janet_parser_has_more(&parser)) {
|
while (janet_parser_has_more(&parser)) {
|
||||||
@@ -99,42 +46,42 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
JanetCompileResult cres = janet_compile(form, env, where);
|
JanetCompileResult cres = janet_compile(form, env, where);
|
||||||
if (cres.status == JANET_COMPILE_OK) {
|
if (cres.status == JANET_COMPILE_OK) {
|
||||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||||
JanetFiber *fiber = janet_fiber(f, 64);
|
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||||
if (status != JANET_SIGNAL_OK) {
|
if (status != JANET_SIGNAL_OK) {
|
||||||
janet_stacktrace(fiber, "runtime", ret);
|
janet_stacktrace(fiber, ret);
|
||||||
errflags |= 0x01;
|
errflags |= 0x01;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
fprintf(stderr, "source path: %s\n", sourcePath);
|
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
||||||
janet_stacktrace(cres.macrofiber, "compile",
|
(const char *)cres.error);
|
||||||
janet_wrap_string(cres.error));
|
|
||||||
errflags |= 0x02;
|
errflags |= 0x02;
|
||||||
|
done = 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Dispatch based on parse state */
|
/* Dispatch based on parse state */
|
||||||
switch (janet_parser_status(&parser)) {
|
switch (janet_parser_status(&parser)) {
|
||||||
|
case JANET_PARSE_DEAD:
|
||||||
|
done = 1;
|
||||||
|
break;
|
||||||
case JANET_PARSE_ERROR:
|
case JANET_PARSE_ERROR:
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
fprintf(stderr, "parse error: %s\n", janet_parser_error(&parser));
|
fprintf(stderr, "parse error in %s: %s\n",
|
||||||
|
sourcePath, janet_parser_error(&parser));
|
||||||
|
done = 1;
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_PENDING:
|
case JANET_PARSE_PENDING:
|
||||||
if (index >= len) {
|
if (index == len) {
|
||||||
if (dudeol) {
|
janet_parser_eof(&parser);
|
||||||
errflags |= 0x04;
|
|
||||||
fprintf(stderr, "internal parse error: unexpected end of source\n");
|
|
||||||
} else {
|
|
||||||
dudeol = 1;
|
|
||||||
janet_parser_consume(&parser, '\n');
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
case JANET_PARSE_ROOT:
|
case JANET_PARSE_ROOT:
|
||||||
if (index >= len) {
|
if (index >= len) {
|
||||||
done = 1;
|
janet_parser_eof(&parser);
|
||||||
} else {
|
} else {
|
||||||
janet_parser_consume(&parser, bytes[index++]);
|
janet_parser_consume(&parser, bytes[index++]);
|
||||||
}
|
}
|
||||||
@@ -142,6 +89,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
}
|
}
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Clean up and return errors */
|
||||||
janet_parser_deinit(&parser);
|
janet_parser_deinit(&parser);
|
||||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||||
if (out) *out = ret;
|
if (out) *out = ret;
|
||||||
|
|||||||
@@ -20,11 +20,13 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
#include "emit.h"
|
#include "emit.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
if (argn != 1) {
|
if (argn != 1) {
|
||||||
@@ -58,45 +60,42 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
return janetc_cslot(x);
|
return janetc_cslot(x);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE: {
|
||||||
{
|
int32_t i, len;
|
||||||
int32_t i, len;
|
const Janet *tup = janet_unwrap_tuple(x);
|
||||||
const Janet *tup = janet_unwrap_tuple(x);
|
len = janet_tuple_length(tup);
|
||||||
len = janet_tuple_length(tup);
|
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
|
||||||
if (len > 1 && janet_checktype(tup[0], JANET_SYMBOL)) {
|
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
||||||
const uint8_t *head = janet_unwrap_symbol(tup[0]);
|
if (!janet_cstrcmp(head, "unquote"))
|
||||||
if (!janet_cstrcmp(head, "unquote"))
|
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
||||||
return janetc_value(janetc_fopts_default(opts.compiler), tup[1]);
|
|
||||||
}
|
|
||||||
for (i = 0; i < len; i++)
|
|
||||||
janet_v_push(slots, quasiquote(opts, tup[i]));
|
|
||||||
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
|
|
||||||
}
|
|
||||||
case JANET_ARRAY:
|
|
||||||
{
|
|
||||||
int32_t i;
|
|
||||||
JanetArray *array = janet_unwrap_array(x);
|
|
||||||
for (i = 0; i < array->count; i++)
|
|
||||||
janet_v_push(slots, quasiquote(opts, array->data[i]));
|
|
||||||
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
|
||||||
}
|
}
|
||||||
|
for (i = 0; i < len; i++)
|
||||||
|
janet_v_push(slots, quasiquote(opts, tup[i]));
|
||||||
|
return qq_slots(opts, slots, JOP_MAKE_TUPLE);
|
||||||
|
}
|
||||||
|
case JANET_ARRAY: {
|
||||||
|
int32_t i;
|
||||||
|
JanetArray *array = janet_unwrap_array(x);
|
||||||
|
for (i = 0; i < array->count; i++)
|
||||||
|
janet_v_push(slots, quasiquote(opts, array->data[i]));
|
||||||
|
return qq_slots(opts, slots, JOP_MAKE_ARRAY);
|
||||||
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT: {
|
||||||
{
|
const JanetKV *kv = NULL, *kvs = NULL;
|
||||||
const JanetKV *kv = NULL, *kvs = NULL;
|
int32_t len, cap;
|
||||||
int32_t len, cap;
|
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
||||||
while ((kv = janet_dictionary_next(kvs, cap, kv))) {
|
JanetSlot key = quasiquote(opts, kv->key);
|
||||||
JanetSlot key = quasiquote(opts, kv->key);
|
JanetSlot value = quasiquote(opts, kv->value);
|
||||||
JanetSlot value = quasiquote(opts, kv->value);
|
key.flags &= ~JANET_SLOT_SPLICED;
|
||||||
key.flags &= ~JANET_SLOT_SPLICED;
|
value.flags &= ~JANET_SLOT_SPLICED;
|
||||||
value.flags &= ~JANET_SLOT_SPLICED;
|
janet_v_push(slots, key);
|
||||||
janet_v_push(slots, key);
|
janet_v_push(slots, value);
|
||||||
janet_v_push(slots, value);
|
|
||||||
}
|
|
||||||
return qq_slots(opts, slots,
|
|
||||||
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
|
|
||||||
}
|
}
|
||||||
|
return qq_slots(opts, slots,
|
||||||
|
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -119,13 +118,13 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
|
|||||||
* keep the order registers are freed.
|
* keep the order registers are freed.
|
||||||
* Returns if the slot 'right' can be freed. */
|
* Returns if the slot 'right' can be freed. */
|
||||||
static int destructure(JanetCompiler *c,
|
static int destructure(JanetCompiler *c,
|
||||||
Janet left,
|
Janet left,
|
||||||
JanetSlot right,
|
JanetSlot right,
|
||||||
int (*leaf)(JanetCompiler *c,
|
int (*leaf)(JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *attr),
|
JanetTable *attr),
|
||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
switch (janet_type(left)) {
|
switch (janet_type(left)) {
|
||||||
default:
|
default:
|
||||||
janetc_cerror(c, "unexpected type in destructuring");
|
janetc_cerror(c, "unexpected type in destructuring");
|
||||||
@@ -134,41 +133,39 @@ static int destructure(JanetCompiler *c,
|
|||||||
/* Leaf, assign right to left */
|
/* Leaf, assign right to left */
|
||||||
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
return leaf(c, janet_unwrap_symbol(left), right, attr);
|
||||||
case JANET_TUPLE:
|
case JANET_TUPLE:
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
int32_t i, len;
|
||||||
int32_t i, len;
|
const Janet *values;
|
||||||
const Janet *values;
|
janet_indexed_view(left, &values, &len);
|
||||||
janet_indexed_view(left, &values, &len);
|
for (i = 0; i < len; i++) {
|
||||||
for (i = 0; i < len; i++) {
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
Janet subval = values[i];
|
||||||
Janet subval = values[i];
|
if (i < 0x100) {
|
||||||
if (i < 0x100) {
|
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
||||||
janetc_emit_ssu(c, JOP_GET_INDEX, nextright, right, (uint8_t) i, 1);
|
} else {
|
||||||
} else {
|
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
|
||||||
JanetSlot k = janetc_cslot(janet_wrap_integer(i));
|
|
||||||
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
|
||||||
}
|
|
||||||
if (destructure(c, subval, nextright, leaf, attr))
|
|
||||||
janetc_freeslot(c, nextright);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return 1;
|
|
||||||
case JANET_TABLE:
|
|
||||||
case JANET_STRUCT:
|
|
||||||
{
|
|
||||||
const JanetKV *kvs = NULL;
|
|
||||||
int32_t i, cap, len;
|
|
||||||
janet_dictionary_view(left, &kvs, &len, &cap);
|
|
||||||
for (i = 0; i < cap; i++) {
|
|
||||||
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
|
||||||
JanetSlot nextright = janetc_farslot(c);
|
|
||||||
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
|
||||||
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
||||||
if (destructure(c, kvs[i].value, nextright, leaf, attr))
|
|
||||||
janetc_freeslot(c, nextright);
|
|
||||||
}
|
}
|
||||||
|
if (destructure(c, subval, nextright, leaf, attr))
|
||||||
|
janetc_freeslot(c, nextright);
|
||||||
}
|
}
|
||||||
return 1;
|
}
|
||||||
|
return 1;
|
||||||
|
case JANET_TABLE:
|
||||||
|
case JANET_STRUCT: {
|
||||||
|
const JanetKV *kvs = NULL;
|
||||||
|
int32_t i, cap, len;
|
||||||
|
janet_dictionary_view(left, &kvs, &len, &cap);
|
||||||
|
for (i = 0; i < cap; i++) {
|
||||||
|
if (janet_checktype(kvs[i].key, JANET_NIL)) continue;
|
||||||
|
JanetSlot nextright = janetc_farslot(c);
|
||||||
|
JanetSlot k = janetc_value(janetc_fopts_default(c), kvs[i].key);
|
||||||
|
janetc_emit_sss(c, JOP_GET, nextright, right, k, 1);
|
||||||
|
if (destructure(c, kvs[i].value, nextright, leaf, attr))
|
||||||
|
janetc_freeslot(c, nextright);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -219,7 +216,6 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
return rvalue;
|
return rvalue;
|
||||||
} else {
|
} else {
|
||||||
/* Error */
|
/* Error */
|
||||||
janet_inspect(argv[0]);
|
|
||||||
janetc_cerror(opts.compiler, "expected symbol or tuple for l-value to set");
|
janetc_cerror(opts.compiler, "expected symbol or tuple for l-value to set");
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
@@ -263,8 +259,8 @@ static JanetSlot dohead(JanetCompiler *c, JanetFopts opts, Janet *head, int32_t
|
|||||||
/* Def or var a symbol in a local scope */
|
/* Def or var a symbol in a local scope */
|
||||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
|
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret) {
|
||||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||||
ret.index > 0 &&
|
ret.index > 0 &&
|
||||||
ret.envindex >= 0;
|
ret.envindex >= 0;
|
||||||
if (!isUnnamedRegister) {
|
if (!isUnnamedRegister) {
|
||||||
/* Slot is not able to be named */
|
/* Slot is not able to be named */
|
||||||
JanetSlot localslot = janetc_farslot(c);
|
JanetSlot localslot = janetc_farslot(c);
|
||||||
@@ -277,10 +273,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int varleaf(
|
static int varleaf(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
/* Global var, generate var */
|
/* Global var, generate var */
|
||||||
JanetSlot refslot;
|
JanetSlot refslot;
|
||||||
@@ -290,7 +286,7 @@ static int varleaf(
|
|||||||
janet_array_push(ref, janet_wrap_nil());
|
janet_array_push(ref, janet_wrap_nil());
|
||||||
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||||
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
||||||
refslot = janetc_cslot(janet_wrap_array(ref));
|
refslot = janetc_cslot(janet_wrap_array(ref));
|
||||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
||||||
@@ -311,14 +307,14 @@ static JanetSlot janetc_var(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static int defleaf(
|
static int defleaf(
|
||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *attr) {
|
JanetTable *attr) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
JanetTable *tab = janet_table(2);
|
JanetTable *tab = janet_table(2);
|
||||||
janet_table_put(tab, janet_ckeywordv("source-map"),
|
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
tab->proto = attr;
|
tab->proto = attr;
|
||||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||||
@@ -381,8 +377,8 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
|
|
||||||
/* Set target for compilation */
|
/* Set target for compilation */
|
||||||
target = (drop || tail)
|
target = (drop || tail)
|
||||||
? janetc_cslot(janet_wrap_nil())
|
? janetc_cslot(janet_wrap_nil())
|
||||||
: janetc_gettarget(opts);
|
: janetc_gettarget(opts);
|
||||||
|
|
||||||
/* Compile condition */
|
/* Compile condition */
|
||||||
janetc_scope(&condscope, c, 0, "if");
|
janetc_scope(&condscope, c, 0, "if");
|
||||||
@@ -475,6 +471,61 @@ static int32_t janetc_addfuncdef(JanetCompiler *c, JanetFuncDef *def) {
|
|||||||
return janet_v_count(scope->defs) - 1;
|
return janet_v_count(scope->defs) - 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/*
|
||||||
|
* break
|
||||||
|
*
|
||||||
|
* jump :end or retn if in function
|
||||||
|
*/
|
||||||
|
static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||||
|
JanetCompiler *c = opts.compiler;
|
||||||
|
JanetScope *scope = c->scope;
|
||||||
|
if (argn > 1) {
|
||||||
|
janetc_cerror(c, "expected at most 1 argument");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Find scope to break from */
|
||||||
|
while (scope) {
|
||||||
|
if (scope->flags & (JANET_SCOPE_FUNCTION | JANET_SCOPE_WHILE))
|
||||||
|
break;
|
||||||
|
scope = scope->parent;
|
||||||
|
}
|
||||||
|
if (NULL == scope) {
|
||||||
|
janetc_cerror(c, "break must occur in while loop or closure");
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
|
||||||
|
/* Emit code to break from that scope */
|
||||||
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
|
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||||
|
if (!(scope->flags & JANET_SCOPE_WHILE) && argn) {
|
||||||
|
/* Closure body with return argument */
|
||||||
|
subopts.flags |= JANET_FOPTS_TAIL;
|
||||||
|
JanetSlot ret = janetc_value(subopts, argv[0]);
|
||||||
|
ret.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return ret;
|
||||||
|
} else {
|
||||||
|
/* while loop IIFE or no argument */
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
|
JanetSlot s = janetc_cslot(janet_wrap_nil());
|
||||||
|
s.flags |= JANET_SLOT_RETURNED;
|
||||||
|
return s;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
if (argn) {
|
||||||
|
subopts.flags |= JANET_FOPTS_DROP;
|
||||||
|
janetc_value(subopts, argv[0]);
|
||||||
|
}
|
||||||
|
/* Tag the instruction so the while special can turn it into a proper jump */
|
||||||
|
janetc_emit(c, 0x80 | JOP_JUMP);
|
||||||
|
return janetc_cslot(janet_wrap_nil());
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* :whiletop
|
* :whiletop
|
||||||
* ...
|
* ...
|
||||||
@@ -499,7 +550,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
labelwt = janet_v_count(c->buffer);
|
labelwt = janet_v_count(c->buffer);
|
||||||
|
|
||||||
janetc_scope(&tempscope, c, 0, "while");
|
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
|
||||||
|
|
||||||
/* Compile condition */
|
/* Compile condition */
|
||||||
cond = janetc_value(subopts, argv[0]);
|
cond = janetc_value(subopts, argv[0]);
|
||||||
@@ -517,8 +568,8 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
/* Infinite loop does not need to check condition */
|
/* Infinite loop does not need to check condition */
|
||||||
labelc = infinite
|
labelc = infinite
|
||||||
? 0
|
? 0
|
||||||
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
: janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
|
||||||
|
|
||||||
/* Compile body */
|
/* Compile body */
|
||||||
for (i = 1; i < argn; i++) {
|
for (i = 1; i < argn; i++) {
|
||||||
@@ -570,8 +621,15 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
|
|
||||||
/* Calculate jumps */
|
/* Calculate jumps */
|
||||||
labeld = janet_v_count(c->buffer);
|
labeld = janet_v_count(c->buffer);
|
||||||
if (!infinite) c->buffer[labelc] |= (labeld - labelc) << 16;
|
if (!infinite) c->buffer[labelc] |= (uint32_t)(labeld - labelc) << 16;
|
||||||
c->buffer[labeljt] |= (labelwt - labeljt) << 8;
|
c->buffer[labeljt] |= (uint32_t)(labelwt - labeljt) << 8;
|
||||||
|
|
||||||
|
/* Calculate breaks */
|
||||||
|
for (int32_t i = labelwt; i < labeld; i++) {
|
||||||
|
if (c->buffer[i] == (0x80 | JOP_JUMP)) {
|
||||||
|
c->buffer[i] = JOP_JUMP | ((labeld - i) << 8);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
/* Pop scope and return nil slot */
|
/* Pop scope and return nil slot */
|
||||||
janetc_popscope(c);
|
janetc_popscope(c);
|
||||||
@@ -585,16 +643,17 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
JanetSlot ret;
|
JanetSlot ret;
|
||||||
Janet head;
|
Janet head;
|
||||||
JanetScope fnscope;
|
JanetScope fnscope;
|
||||||
int32_t paramcount, argi, parami, arity, defindex, i;
|
int32_t paramcount, argi, parami, arity, min_arity, max_arity, defindex, i;
|
||||||
JanetFopts subopts = janetc_fopts_default(c);
|
JanetFopts subopts = janetc_fopts_default(c);
|
||||||
const Janet *params;
|
const Janet *params;
|
||||||
const char *errmsg = NULL;
|
const char *errmsg = NULL;
|
||||||
|
|
||||||
/* Function flags */
|
/* Function flags */
|
||||||
int vararg = 0;
|
int vararg = 0;
|
||||||
int fixarity = 1;
|
int allow_extra = 0;
|
||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
|
int seenopt = 0;
|
||||||
|
|
||||||
/* Begin function */
|
/* Begin function */
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
@@ -625,19 +684,32 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
Janet param = params[i];
|
Janet param = params[i];
|
||||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||||
/* Check for varargs and unfixed arity */
|
/* Check for varargs and unfixed arity */
|
||||||
if ((!seenamp) &&
|
if (!janet_cstrcmp(janet_unwrap_symbol(param), "&")) {
|
||||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
if (seenamp) {
|
||||||
seenamp = 1;
|
errmsg = "& in unexpected location";
|
||||||
fixarity = 0;
|
goto error;
|
||||||
if (i == paramcount - 1) {
|
} else if (i == paramcount - 1) {
|
||||||
|
allow_extra = 1;
|
||||||
arity--;
|
arity--;
|
||||||
} else if (i == paramcount - 2) {
|
} else if (i == paramcount - 2) {
|
||||||
vararg = 1;
|
vararg = 1;
|
||||||
arity -= 2;
|
arity -= 2;
|
||||||
} else {
|
} else {
|
||||||
errmsg = "variable argument symbol in unexpected location";
|
errmsg = "& in unexpected location";
|
||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
seenamp = 1;
|
||||||
|
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&opt")) {
|
||||||
|
if (seenopt) {
|
||||||
|
errmsg = "only one &opt allowed";
|
||||||
|
goto error;
|
||||||
|
} else if (i == paramcount - 1) {
|
||||||
|
errmsg = "&opt cannot be last item in parameter list";
|
||||||
|
goto error;
|
||||||
|
}
|
||||||
|
min_arity = i;
|
||||||
|
arity--;
|
||||||
|
seenopt = 1;
|
||||||
} else {
|
} else {
|
||||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||||
}
|
}
|
||||||
@@ -646,6 +718,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
/* Check for self ref */
|
/* Check for self ref */
|
||||||
if (selfref) {
|
if (selfref) {
|
||||||
JanetSlot slot = janetc_farslot(c);
|
JanetSlot slot = janetc_farslot(c);
|
||||||
@@ -657,17 +732,20 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
/* Compile function body */
|
/* Compile function body */
|
||||||
if (parami + 1 == argn) {
|
if (parami + 1 == argn) {
|
||||||
janetc_emit(c, JOP_RETURN_NIL);
|
janetc_emit(c, JOP_RETURN_NIL);
|
||||||
} else for (argi = parami + 1; argi < argn; argi++) {
|
} else {
|
||||||
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
for (argi = parami + 1; argi < argn; argi++) {
|
||||||
janetc_value(subopts, argv[argi]);
|
subopts.flags = (argi == (argn - 1)) ? JANET_FOPTS_TAIL : JANET_FOPTS_DROP;
|
||||||
if (c->result.status == JANET_COMPILE_ERROR)
|
janetc_value(subopts, argv[argi]);
|
||||||
goto error2;
|
if (c->result.status == JANET_COMPILE_ERROR)
|
||||||
|
goto error2;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Build function */
|
/* Build function */
|
||||||
def = janetc_pop_funcdef(c);
|
def = janetc_pop_funcdef(c);
|
||||||
def->arity = arity;
|
def->arity = arity;
|
||||||
if (fixarity) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
def->min_arity = min_arity;
|
||||||
|
def->max_arity = max_arity;
|
||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
|
|
||||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||||
@@ -690,6 +768,7 @@ error2:
|
|||||||
|
|
||||||
/* Keep in lexicographic order */
|
/* Keep in lexicographic order */
|
||||||
static const JanetSpecial janetc_specials[] = {
|
static const JanetSpecial janetc_specials[] = {
|
||||||
|
{"break", janetc_break},
|
||||||
{"def", janetc_def},
|
{"def", janetc_def},
|
||||||
{"do", janetc_do},
|
{"do", janetc_do},
|
||||||
{"fn", janetc_fn},
|
{"fn", janetc_fn},
|
||||||
@@ -706,9 +785,9 @@ static const JanetSpecial janetc_specials[] = {
|
|||||||
/* Find a special */
|
/* Find a special */
|
||||||
const JanetSpecial *janetc_special(const uint8_t *name) {
|
const JanetSpecial *janetc_special(const uint8_t *name) {
|
||||||
return janet_strbinsearch(
|
return janet_strbinsearch(
|
||||||
&janetc_specials,
|
&janetc_specials,
|
||||||
sizeof(janetc_specials)/sizeof(JanetSpecial),
|
sizeof(janetc_specials) / sizeof(JanetSpecial),
|
||||||
sizeof(JanetSpecial),
|
sizeof(JanetSpecial),
|
||||||
name);
|
name);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -39,6 +39,11 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
|||||||
* Set and unset by janet_run. */
|
* Set and unset by janet_run. */
|
||||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||||
|
|
||||||
|
/* The current pointer to the inner most jmp_buf. The current
|
||||||
|
* return point for panics. */
|
||||||
|
extern JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf;
|
||||||
|
extern JANET_THREAD_LOCAL Janet *janet_vm_return_reg;
|
||||||
|
|
||||||
/* The global registry for c functions. Used to store meta-data
|
/* The global registry for c functions. Used to store meta-data
|
||||||
* along with otherwise bare c function pointers. */
|
* along with otherwise bare c function pointers. */
|
||||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@@ -26,39 +26,38 @@
|
|||||||
* This version has been modified for much greater flexibility in parsing, such
|
* This version has been modified for much greater flexibility in parsing, such
|
||||||
* as choosing the radix and supporting scientific notation with any radix.
|
* as choosing the radix and supporting scientific notation with any radix.
|
||||||
*
|
*
|
||||||
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X where R is the radix, I is
|
* Numbers are of the form [-+]R[rR]I.F[eE&][-+]X in pseudo-regex form, where R
|
||||||
* the integer part, F is the fractional part, and X is the exponent. All
|
* is the radix, I is the integer part, F is the fractional part, and X is the
|
||||||
* signs, radix, decimal point, fractional part, and exponent can be omitted.
|
* exponent. All signs, radix, decimal point, fractional part, and exponent can
|
||||||
* The number will be considered and integer if the there is no decimal point
|
* be omitted. The radix is assumed to be 10 if omitted, and the E or e
|
||||||
* and no exponent. Any number greater the 2^32-1 or less than -(2^32) will be
|
|
||||||
* coerced to a double. If there is an error, the function janet_scan_number will
|
|
||||||
* return a janet nil. The radix is assumed to be 10 if omitted, and the E
|
|
||||||
* separator for the exponent can only be used when the radix is 10. This is
|
* separator for the exponent can only be used when the radix is 10. This is
|
||||||
* because E is a valid digit in bases 15 or greater. For bases greater than 10,
|
* because E is a valid digit in bases 15 or greater. For bases greater than
|
||||||
* the letters are used as digits. A through Z correspond to the digits 10
|
* 10, the letters are used as digits. A through Z correspond to the digits 10
|
||||||
* through 35, and the lowercase letters have the same values. The radix number
|
* through 35, and the lowercase letters have the same values. The radix number
|
||||||
* is always in base 10. For example, a hexidecimal number could be written
|
* is always in base 10. For example, a hexidecimal number could be written
|
||||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||||
* hexidecimal literals. The previous number could also be written
|
* hexidecimal literals. The previous number could also be written
|
||||||
* '0xdeadbeef'. Note that in this case, the number will actually be a double
|
* '0xdeadbeef'.
|
||||||
* as it will not fit in the range for a signed 32 bit integer. The string
|
*/
|
||||||
* '0xbeef' would parse to an integer as it is in the range of an int32_t. */
|
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <math.h>
|
#include <math.h>
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||||
static uint8_t digit_lookup[128] = {
|
static uint8_t digit_lookup[128] = {
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
|
0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0,1,2,3,4,5,6,7,8,9,0xff,0xff,0xff,0xff,0xff,0xff,
|
0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 0xff, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
|
0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
|
||||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff,
|
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff,
|
||||||
0xff,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,
|
0xff, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24,
|
||||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff
|
25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 0xff, 0xff, 0xff, 0xff, 0xff
|
||||||
};
|
};
|
||||||
|
|
||||||
#define BIGNAT_NBIT 31
|
#define BIGNAT_NBIT 31
|
||||||
@@ -72,6 +71,7 @@ struct BigNat {
|
|||||||
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Initialize a bignat to 0 */
|
||||||
static void bignat_zero(struct BigNat *x) {
|
static void bignat_zero(struct BigNat *x) {
|
||||||
x->first_digit = 0;
|
x->first_digit = 0;
|
||||||
x->n = 0;
|
x->n = 0;
|
||||||
@@ -122,7 +122,7 @@ static void bignat_div(struct BigNat *mant, uint32_t divisor) {
|
|||||||
int32_t i;
|
int32_t i;
|
||||||
uint32_t quotient, remainder;
|
uint32_t quotient, remainder;
|
||||||
uint64_t dividend;
|
uint64_t dividend;
|
||||||
remainder = 0;
|
remainder = 0, quotient = 0;
|
||||||
for (i = mant->n - 1; i >= 0; i--) {
|
for (i = mant->n - 1; i >= 0; i--) {
|
||||||
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->digits[i];
|
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->digits[i];
|
||||||
if (i < mant->n - 1) mant->digits[i + 1] = quotient;
|
if (i < mant->n - 1) mant->digits[i + 1] = quotient;
|
||||||
@@ -194,13 +194,13 @@ static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Read in a mantissa and exponent of a certain base, and give
|
/* Read in a mantissa and exponent of a certain base, and give
|
||||||
* back the double value. Should properly handle 0s, Infinities, and
|
* back the double value. Should properly handle 0s, infinities, and
|
||||||
* denormalized numbers. (When the exponent values are too large) */
|
* denormalized numbers. (When the exponent values are too large) */
|
||||||
static double convert(
|
static double convert(
|
||||||
int negative,
|
int negative,
|
||||||
struct BigNat *mant,
|
struct BigNat *mant,
|
||||||
int32_t base,
|
int32_t base,
|
||||||
int32_t exponent) {
|
int32_t exponent) {
|
||||||
|
|
||||||
int32_t exponent2 = 0;
|
int32_t exponent2 = 0;
|
||||||
|
|
||||||
@@ -214,9 +214,9 @@ static double convert(
|
|||||||
* Get exponent to zero while holding X constant. */
|
* Get exponent to zero while holding X constant. */
|
||||||
|
|
||||||
/* Positive exponents are simple */
|
/* Positive exponents are simple */
|
||||||
for (;exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0);
|
for (; exponent > 3; exponent -= 4) bignat_muladd(mant, base * base * base * base, 0);
|
||||||
for (;exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0);
|
for (; exponent > 1; exponent -= 2) bignat_muladd(mant, base * base, 0);
|
||||||
for (;exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0);
|
for (; exponent > 0; exponent -= 1) bignat_muladd(mant, base, 0);
|
||||||
|
|
||||||
/* Negative exponents are tricky - we don't want to loose bits
|
/* Negative exponents are tricky - we don't want to loose bits
|
||||||
* from integer division, so we need to premultiply. */
|
* from integer division, so we need to premultiply. */
|
||||||
@@ -224,22 +224,22 @@ static double convert(
|
|||||||
int32_t shamt = 5 - exponent / 4;
|
int32_t shamt = 5 - exponent / 4;
|
||||||
bignat_lshift_n(mant, shamt);
|
bignat_lshift_n(mant, shamt);
|
||||||
exponent2 -= shamt * BIGNAT_NBIT;
|
exponent2 -= shamt * BIGNAT_NBIT;
|
||||||
for (;exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
|
for (; exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
|
||||||
for (;exponent < -2; exponent += 2) bignat_div(mant, base * base);
|
for (; exponent < -1; exponent += 2) bignat_div(mant, base * base);
|
||||||
for (;exponent < 0; exponent += 1) bignat_div(mant, base);
|
for (; exponent < 0; exponent += 1) bignat_div(mant, base);
|
||||||
}
|
}
|
||||||
|
|
||||||
return negative
|
return negative
|
||||||
? -bignat_extract(mant, exponent2)
|
? -bignat_extract(mant, exponent2)
|
||||||
: bignat_extract(mant, exponent2);
|
: bignat_extract(mant, exponent2);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||||
* and integer, set *err to 1 and return 0. */
|
* and integer, set *err to 1 and return 0. */
|
||||||
int janet_scan_number(
|
int janet_scan_number(
|
||||||
const uint8_t *str,
|
const uint8_t *str,
|
||||||
int32_t len,
|
int32_t len,
|
||||||
double *out) {
|
double *out) {
|
||||||
const uint8_t *end = str + len;
|
const uint8_t *end = str + len;
|
||||||
int seenadigit = 0;
|
int seenadigit = 0;
|
||||||
int ex = 0;
|
int ex = 0;
|
||||||
@@ -271,14 +271,14 @@ int janet_scan_number(
|
|||||||
base = 16;
|
base = 16;
|
||||||
str += 2;
|
str += 2;
|
||||||
} else if (str + 1 < end &&
|
} else if (str + 1 < end &&
|
||||||
str[0] >= '0' && str[0] <= '9' &&
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
str[1] == 'r') {
|
str[1] == 'r') {
|
||||||
base = str[0] - '0';
|
base = str[0] - '0';
|
||||||
str += 2;
|
str += 2;
|
||||||
} else if (str + 2 < end &&
|
} else if (str + 2 < end &&
|
||||||
str[0] >= '0' && str[0] <= '9' &&
|
str[0] >= '0' && str[0] <= '9' &&
|
||||||
str[1] >= '0' && str[1] <= '9' &&
|
str[1] >= '0' && str[1] <= '9' &&
|
||||||
str[2] == 'r') {
|
str[2] == 'r') {
|
||||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||||
if (base < 2 || base > 36) goto error;
|
if (base < 2 || base > 36) goto error;
|
||||||
str += 3;
|
str += 3;
|
||||||
@@ -346,7 +346,8 @@ int janet_scan_number(
|
|||||||
str++;
|
str++;
|
||||||
seenadigit = 1;
|
seenadigit = 1;
|
||||||
}
|
}
|
||||||
if (eneg) ex -= ee; else ex += ee;
|
if (eneg) ex -= ee;
|
||||||
|
else ex += ee;
|
||||||
}
|
}
|
||||||
|
|
||||||
if (!seenadigit)
|
if (!seenadigit)
|
||||||
@@ -356,7 +357,7 @@ int janet_scan_number(
|
|||||||
free(mant.digits);
|
free(mant.digits);
|
||||||
return 0;
|
return 0;
|
||||||
|
|
||||||
error:
|
error:
|
||||||
free(mant.digits);
|
free(mant.digits);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,24 +20,27 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include <math.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Begin creation of a struct */
|
/* Begin creation of a struct */
|
||||||
JanetKV *janet_struct_begin(int32_t count) {
|
JanetKV *janet_struct_begin(int32_t count) {
|
||||||
|
|
||||||
/* Calculate capacity as power of 2 after 2 * count. */
|
/* Calculate capacity as power of 2 after 2 * count. */
|
||||||
int32_t capacity = janet_tablen(2 * count);
|
int32_t capacity = janet_tablen(2 * count);
|
||||||
if (capacity < 0) capacity = janet_tablen(count + 1);
|
if (capacity < 0) capacity = janet_tablen(count + 1);
|
||||||
|
|
||||||
size_t s = sizeof(int32_t) * 4 + (capacity * sizeof(JanetKV));
|
size_t size = sizeof(JanetStructHead) + capacity * sizeof(JanetKV);
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_STRUCT, s);
|
JanetStructHead *head = janet_gcalloc(JANET_MEMORY_STRUCT, size);
|
||||||
JanetKV *st = (JanetKV *) (data + 4 * sizeof(int32_t));
|
head->length = count;
|
||||||
|
head->capacity = capacity;
|
||||||
|
head->hash = 0;
|
||||||
|
|
||||||
|
JanetKV *st = (JanetKV *)(head->data);
|
||||||
janet_memempty(st, capacity);
|
janet_memempty(st, capacity);
|
||||||
janet_struct_length(st) = count;
|
|
||||||
janet_struct_capacity(st) = capacity;
|
|
||||||
janet_struct_hash(st) = 0;
|
|
||||||
return st;
|
return st;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -71,59 +74,58 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
|||||||
int32_t i, j, dist;
|
int32_t i, j, dist;
|
||||||
int32_t bounds[4] = {index, cap, 0, index};
|
int32_t bounds[4] = {index, cap, 0, index};
|
||||||
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
|
if (janet_checktype(key, JANET_NIL) || janet_checktype(value, JANET_NIL)) return;
|
||||||
|
if (janet_checktype(key, JANET_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||||
/* Avoid extra items */
|
/* Avoid extra items */
|
||||||
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
||||||
for (dist = 0, j = 0; j < 4; j += 2)
|
for (dist = 0, j = 0; j < 4; j += 2)
|
||||||
for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) {
|
for (i = bounds[j]; i < bounds[j + 1]; i++, dist++) {
|
||||||
int status;
|
int status;
|
||||||
int32_t otherhash;
|
int32_t otherhash;
|
||||||
int32_t otherindex, otherdist;
|
int32_t otherindex, otherdist;
|
||||||
JanetKV *kv = st + i;
|
JanetKV *kv = st + i;
|
||||||
/* We found an empty slot, so just add key and value */
|
/* We found an empty slot, so just add key and value */
|
||||||
if (janet_checktype(kv->key, JANET_NIL)) {
|
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||||
kv->key = key;
|
kv->key = key;
|
||||||
kv->value = value;
|
kv->value = value;
|
||||||
/* Update the temporary count */
|
/* Update the temporary count */
|
||||||
janet_struct_hash(st)++;
|
janet_struct_hash(st)++;
|
||||||
return;
|
return;
|
||||||
|
}
|
||||||
|
/* Robinhood hashing - check if colliding kv pair
|
||||||
|
* is closer to their source than current. We use robinhood
|
||||||
|
* hashing to ensure that equivalent structs that are constructed
|
||||||
|
* with different order have the same internal layout, and therefor
|
||||||
|
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
||||||
|
* Collisions are resolved via an insertion sort insertion. */
|
||||||
|
otherhash = janet_hash(kv->key);
|
||||||
|
otherindex = janet_maphash(cap, otherhash);
|
||||||
|
otherdist = (i + cap - otherindex) & (cap - 1);
|
||||||
|
if (dist < otherdist)
|
||||||
|
status = -1;
|
||||||
|
else if (otherdist < dist)
|
||||||
|
status = 1;
|
||||||
|
else if (hash < otherhash)
|
||||||
|
status = -1;
|
||||||
|
else if (otherhash < hash)
|
||||||
|
status = 1;
|
||||||
|
else
|
||||||
|
status = janet_compare(key, kv->key);
|
||||||
|
/* If other is closer to their ideal slot */
|
||||||
|
if (status == 1) {
|
||||||
|
/* Swap current kv pair with pair in slot */
|
||||||
|
JanetKV temp = *kv;
|
||||||
|
kv->key = key;
|
||||||
|
kv->value = value;
|
||||||
|
key = temp.key;
|
||||||
|
value = temp.value;
|
||||||
|
/* Save dist and hash of new kv pair */
|
||||||
|
dist = otherdist;
|
||||||
|
hash = otherhash;
|
||||||
|
} else if (status == 0) {
|
||||||
|
/* A key was added to the struct more than once */
|
||||||
|
return;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
/* Robinhood hashing - check if colliding kv pair
|
|
||||||
* is closer to their source than current. We use robinhood
|
|
||||||
* hashing to ensure that equivalent structs that are constructed
|
|
||||||
* with different order have the same internal layout, and therefor
|
|
||||||
* will compare properly - i.e., {1 2 3 4} should equal {3 4 1 2}.
|
|
||||||
* Collisions are resolved via an insertion sort insertion. */
|
|
||||||
otherhash = janet_hash(kv->key);
|
|
||||||
otherindex = janet_maphash(cap, otherhash);
|
|
||||||
otherdist = (i + cap - otherindex) & (cap - 1);
|
|
||||||
if (dist < otherdist)
|
|
||||||
status = -1;
|
|
||||||
else if (otherdist < dist)
|
|
||||||
status = 1;
|
|
||||||
else if (hash < otherhash)
|
|
||||||
status = -1;
|
|
||||||
else if (otherhash < hash)
|
|
||||||
status = 1;
|
|
||||||
else
|
|
||||||
status = janet_compare(key, kv->key);
|
|
||||||
/* If other is closer to their ideal slot */
|
|
||||||
if (status == 1) {
|
|
||||||
/* Swap current kv pair with pair in slot */
|
|
||||||
JanetKV temp = *kv;
|
|
||||||
kv->key = key;
|
|
||||||
kv->value = value;
|
|
||||||
key = temp.key;
|
|
||||||
value = temp.value;
|
|
||||||
/* Save dist and hash of new kv pair */
|
|
||||||
dist = otherdist;
|
|
||||||
hash = otherhash;
|
|
||||||
} else if (status == 0) {
|
|
||||||
/* This should not happen - it means
|
|
||||||
* than a key was added to the struct more than once */
|
|
||||||
janet_exit("struct double put fail");
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Finish building a struct */
|
/* Finish building a struct */
|
||||||
@@ -132,15 +134,8 @@ const JanetKV *janet_struct_end(JanetKV *st) {
|
|||||||
/* Error building struct, probably duplicate values. We need to rebuild
|
/* Error building struct, probably duplicate values. We need to rebuild
|
||||||
* the struct using only the values that went in. The second creation should always
|
* the struct using only the values that went in. The second creation should always
|
||||||
* succeed. */
|
* succeed. */
|
||||||
int32_t i, realCount;
|
JanetKV *newst = janet_struct_begin(janet_struct_hash(st));
|
||||||
JanetKV *newst;
|
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||||
realCount = 0;
|
|
||||||
for (i = 0; i < janet_struct_capacity(st); i++) {
|
|
||||||
JanetKV *kv = st + i;
|
|
||||||
realCount += janet_checktype(kv->key, JANET_NIL) ? 1 : 0;
|
|
||||||
}
|
|
||||||
newst = janet_struct_begin(realCount);
|
|
||||||
for (i = 0; i < janet_struct_capacity(st); i++) {
|
|
||||||
JanetKV *kv = st + i;
|
JanetKV *kv = st + i;
|
||||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||||
janet_struct_put(newst, kv->key, kv->value);
|
janet_struct_put(newst, kv->key, kv->value);
|
||||||
@@ -218,5 +213,3 @@ int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
|||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
#undef janet_maphash
|
|
||||||
|
|||||||
@@ -25,10 +25,15 @@
|
|||||||
* checks, all symbols are interned so that there is a single copy of it in the
|
* checks, all symbols are interned so that there is a single copy of it in the
|
||||||
* whole program. Equality is then just a pointer check. */
|
* whole program. Equality is then just a pointer check. */
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <string.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include "symcache.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Cache state */
|
/* Cache state */
|
||||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||||
@@ -39,7 +44,7 @@ JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted = 0;
|
|||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
void janet_symcache_init() {
|
void janet_symcache_init() {
|
||||||
janet_vm_cache_capacity = 1024;
|
janet_vm_cache_capacity = 1024;
|
||||||
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t **));
|
janet_vm_cache = calloc(1, janet_vm_cache_capacity * sizeof(const uint8_t *));
|
||||||
if (NULL == janet_vm_cache) {
|
if (NULL == janet_vm_cache) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -63,10 +68,10 @@ static const uint8_t JANET_SYMCACHE_DELETED[1] = {0};
|
|||||||
* If the item is not found, return the location
|
* If the item is not found, return the location
|
||||||
* where one would put it. */
|
* where one would put it. */
|
||||||
static const uint8_t **janet_symcache_findmem(
|
static const uint8_t **janet_symcache_findmem(
|
||||||
const uint8_t *str,
|
const uint8_t *str,
|
||||||
int32_t len,
|
int32_t len,
|
||||||
int32_t hash,
|
int32_t hash,
|
||||||
int *success) {
|
int *success) {
|
||||||
uint32_t bounds[4];
|
uint32_t bounds[4];
|
||||||
uint32_t i, j, index;
|
uint32_t i, j, index;
|
||||||
const uint8_t **firstEmpty = NULL;
|
const uint8_t **firstEmpty = NULL;
|
||||||
@@ -79,7 +84,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
bounds[2] = 0;
|
bounds[2] = 0;
|
||||||
bounds[3] = index;
|
bounds[3] = index;
|
||||||
for (j = 0; j < 4; j += 2)
|
for (j = 0; j < 4; j += 2)
|
||||||
for (i = bounds[j]; i < bounds[j+1]; ++i) {
|
for (i = bounds[j]; i < bounds[j + 1]; ++i) {
|
||||||
const uint8_t *test = janet_vm_cache[i];
|
const uint8_t *test = janet_vm_cache[i];
|
||||||
/* Check empty spots */
|
/* Check empty spots */
|
||||||
if (NULL == test) {
|
if (NULL == test) {
|
||||||
@@ -104,7 +109,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
return janet_vm_cache + i;
|
return janet_vm_cache + i;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
notfound:
|
notfound:
|
||||||
*success = 0;
|
*success = 0;
|
||||||
return firstEmpty;
|
return firstEmpty;
|
||||||
}
|
}
|
||||||
@@ -116,7 +121,7 @@ static const uint8_t **janet_symcache_findmem(
|
|||||||
static void janet_cache_resize(uint32_t newCapacity) {
|
static void janet_cache_resize(uint32_t newCapacity) {
|
||||||
uint32_t i, oldCapacity;
|
uint32_t i, oldCapacity;
|
||||||
const uint8_t **oldCache = janet_vm_cache;
|
const uint8_t **oldCache = janet_vm_cache;
|
||||||
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t **));
|
const uint8_t **newCache = calloc(1, newCapacity * sizeof(const uint8_t *));
|
||||||
if (newCache == NULL) {
|
if (newCache == NULL) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -173,10 +178,10 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
const uint8_t **bucket = janet_symcache_findmem(str, len, hash, &success);
|
||||||
if (success)
|
if (success)
|
||||||
return *bucket;
|
return *bucket;
|
||||||
newstr = (uint8_t *) janet_gcalloc(JANET_MEMORY_SYMBOL, 2 * sizeof(int32_t) + len + 1)
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + len + 1);
|
||||||
+ (2 * sizeof(int32_t));
|
head->hash = hash;
|
||||||
janet_string_hash(newstr) = hash;
|
head->length = len;
|
||||||
janet_string_length(newstr) = len;
|
newstr = (uint8_t *)(head->data);
|
||||||
memcpy(newstr, str, len);
|
memcpy(newstr, str, len);
|
||||||
newstr[len] = 0;
|
newstr[len] = 0;
|
||||||
janet_symcache_put((const uint8_t *)newstr, bucket);
|
janet_symcache_put((const uint8_t *)newstr, bucket);
|
||||||
@@ -185,9 +190,7 @@ const uint8_t *janet_symbol(const uint8_t *str, int32_t len) {
|
|||||||
|
|
||||||
/* Get a symbol from a cstring */
|
/* Get a symbol from a cstring */
|
||||||
const uint8_t *janet_csymbol(const char *cstr) {
|
const uint8_t *janet_csymbol(const char *cstr) {
|
||||||
int32_t len = 0;
|
return janet_symbol((const uint8_t *)cstr, (int32_t) strlen(cstr));
|
||||||
while (cstr[len]) len++;
|
|
||||||
return janet_symbol((const uint8_t *)cstr, len);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Store counter for genysm to avoid quadratic behavior */
|
/* Store counter for genysm to avoid quadratic behavior */
|
||||||
@@ -223,21 +226,19 @@ const uint8_t *janet_symbol_gen(void) {
|
|||||||
* is enough for resolving collisions. */
|
* is enough for resolving collisions. */
|
||||||
do {
|
do {
|
||||||
hash = janet_string_calchash(
|
hash = janet_string_calchash(
|
||||||
gensym_counter,
|
gensym_counter,
|
||||||
sizeof(gensym_counter) - 1);
|
sizeof(gensym_counter) - 1);
|
||||||
bucket = janet_symcache_findmem(
|
bucket = janet_symcache_findmem(
|
||||||
gensym_counter,
|
gensym_counter,
|
||||||
sizeof(gensym_counter) - 1,
|
sizeof(gensym_counter) - 1,
|
||||||
hash,
|
hash,
|
||||||
&status);
|
&status);
|
||||||
} while (status && (inc_gensym(), 1));
|
} while (status && (inc_gensym(), 1));
|
||||||
sym = (uint8_t *) janet_gcalloc(
|
JanetStringHead *head = janet_gcalloc(JANET_MEMORY_SYMBOL, sizeof(JanetStringHead) + sizeof(gensym_counter));
|
||||||
JANET_MEMORY_SYMBOL,
|
head->length = sizeof(gensym_counter) - 1;
|
||||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
head->hash = hash;
|
||||||
(2 * sizeof(int32_t));
|
sym = (uint8_t *)(head->data);
|
||||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||||
janet_string_length(sym) = sizeof(gensym_counter) - 1;
|
|
||||||
janet_string_hash(sym) = hash;
|
|
||||||
janet_symcache_put((const uint8_t *)sym, bucket);
|
janet_symcache_put((const uint8_t *)sym, bucket);
|
||||||
return (const uint8_t *)sym;
|
return (const uint8_t *)sym;
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_SYMCACHE_H_defined
|
#ifndef JANET_SYMCACHE_H_defined
|
||||||
#define JANET_SYMCACHE_H_defined
|
#define JANET_SYMCACHE_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize the cache (allocate cache memory) */
|
/* Initialize the cache (allocate cache memory) */
|
||||||
void janet_symcache_init(void);
|
void janet_symcache_init(void);
|
||||||
|
|||||||
@@ -20,9 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#include <math.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize a table */
|
/* Initialize a table */
|
||||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||||
@@ -129,6 +132,7 @@ Janet janet_table_remove(JanetTable *t, Janet key) {
|
|||||||
/* Put a value into the object */
|
/* Put a value into the object */
|
||||||
void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
||||||
if (janet_checktype(key, JANET_NIL)) return;
|
if (janet_checktype(key, JANET_NIL)) return;
|
||||||
|
if (janet_checktype(key, JANET_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||||
if (janet_checktype(value, JANET_NIL)) {
|
if (janet_checktype(value, JANET_NIL)) {
|
||||||
janet_table_remove(t, key);
|
janet_table_remove(t, key);
|
||||||
} else {
|
} else {
|
||||||
@@ -140,7 +144,7 @@ void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
|||||||
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
janet_table_rehash(t, janet_tablen(2 * t->count + 2));
|
||||||
}
|
}
|
||||||
bucket = janet_table_find(t, key);
|
bucket = janet_table_find(t, key);
|
||||||
if (janet_checktype(bucket->value, JANET_FALSE))
|
if (janet_checktype(bucket->value, JANET_BOOLEAN))
|
||||||
--t->deleted;
|
--t->deleted;
|
||||||
bucket->key = key;
|
bucket->key = key;
|
||||||
bucket->value = value;
|
bucket->value = value;
|
||||||
@@ -194,21 +198,21 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static Janet cfun_new(int32_t argc, Janet *argv) {
|
static Janet cfun_table_new(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
int32_t cap = janet_getinteger(argv, 0);
|
int32_t cap = janet_getinteger(argv, 0);
|
||||||
return janet_wrap_table(janet_table(cap));
|
return janet_wrap_table(janet_table(cap));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_getproto(int32_t argc, Janet *argv) {
|
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetTable *t = janet_gettable(argv, 0);
|
JanetTable *t = janet_gettable(argv, 0);
|
||||||
return t->proto
|
return t->proto
|
||||||
? janet_wrap_table(t->proto)
|
? janet_wrap_table(t->proto)
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_setproto(int32_t argc, Janet *argv) {
|
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetTable *table = janet_gettable(argv, 0);
|
JanetTable *table = janet_gettable(argv, 0);
|
||||||
JanetTable *proto = NULL;
|
JanetTable *proto = NULL;
|
||||||
@@ -219,55 +223,55 @@ static Janet cfun_setproto(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_tostruct(int32_t argc, Janet *argv) {
|
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetTable *t = janet_gettable(argv, 0);
|
JanetTable *t = janet_gettable(argv, 0);
|
||||||
return janet_wrap_struct(janet_table_to_struct(t));
|
return janet_wrap_struct(janet_table_to_struct(t));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_rawget(int32_t argc, Janet *argv) {
|
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_fixarity(argc, 2);
|
||||||
JanetTable *table = janet_gettable(argv, 0);
|
JanetTable *table = janet_gettable(argv, 0);
|
||||||
return janet_table_rawget(table, argv[1]);
|
return janet_table_rawget(table, argv[1]);
|
||||||
}
|
}
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
static const JanetReg table_cfuns[] = {
|
||||||
{
|
{
|
||||||
"table/new", cfun_new,
|
"table/new", cfun_table_new,
|
||||||
JDOC("(table/new capacity)\n\n"
|
JDOC("(table/new capacity)\n\n"
|
||||||
"Creates a new empty table with pre-allocated memory "
|
"Creates a new empty table with pre-allocated memory "
|
||||||
"for capacity entries. This means that if one knows the number of "
|
"for capacity entries. This means that if one knows the number of "
|
||||||
"entries going to go in a table on creation, extra memory allocation "
|
"entries going to go in a table on creation, extra memory allocation "
|
||||||
"can be avoided. Returns the new table.")
|
"can be avoided. Returns the new table.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"table/to-struct", cfun_tostruct,
|
"table/to-struct", cfun_table_tostruct,
|
||||||
JDOC("(table/to-struct tab)\n\n"
|
JDOC("(table/to-struct tab)\n\n"
|
||||||
"Convert a table to a struct. Returns a new struct. This function "
|
"Convert a table to a struct. Returns a new struct. This function "
|
||||||
"does not take into account prototype tables.")
|
"does not take into account prototype tables.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"table/getproto", cfun_getproto,
|
"table/getproto", cfun_table_getproto,
|
||||||
JDOC("(table/getproto tab)\n\n"
|
JDOC("(table/getproto tab)\n\n"
|
||||||
"Get the prototype table of a table. Returns nil if a table "
|
"Get the prototype table of a table. Returns nil if a table "
|
||||||
"has no prototype, otherwise returns the prototype.")
|
"has no prototype, otherwise returns the prototype.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"table/setproto", cfun_setproto,
|
"table/setproto", cfun_table_setproto,
|
||||||
JDOC("(table/setproto tab proto)\n\n"
|
JDOC("(table/setproto tab proto)\n\n"
|
||||||
"Set the prototype of a table. Returns the original table tab.")
|
"Set the prototype of a table. Returns the original table tab.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"table/rawget", cfun_rawget,
|
"table/rawget", cfun_table_rawget,
|
||||||
JDOC("(table/rawget tab key)\n\n"
|
JDOC("(table/rawget tab key)\n\n"
|
||||||
"Gets a value from a table without looking at the prototype table. "
|
"Gets a value from a table without looking at the prototype table. "
|
||||||
"If a table tab does not contain t directly, the function will return "
|
"If a table tab does not contain t directly, the function will return "
|
||||||
"nil without checking the prototype. Returns the value in the table.")
|
"nil without checking the prototype. Returns the value in the table.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the table module */
|
/* Load the table module */
|
||||||
void janet_lib_table(JanetTable *env) {
|
void janet_lib_table(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, table_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,21 +20,23 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Create a new empty tuple of the given size. This will return memory
|
/* Create a new empty tuple of the given size. This will return memory
|
||||||
* which should be filled with Janets. The memory will not be collected until
|
* which should be filled with Janets. The memory will not be collected until
|
||||||
* janet_tuple_end is called. */
|
* janet_tuple_end is called. */
|
||||||
Janet *janet_tuple_begin(int32_t length) {
|
Janet *janet_tuple_begin(int32_t length) {
|
||||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 4 * sizeof(int32_t) + length * sizeof(Janet));
|
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||||
Janet *tuple = (Janet *)(data + (4 * sizeof(int32_t)));
|
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||||
janet_tuple_length(tuple) = length;
|
head->sm_start = -1;
|
||||||
janet_tuple_sm_start(tuple) = -1;
|
head->sm_end = -1;
|
||||||
janet_tuple_sm_end(tuple) = -1;
|
head->length = length;
|
||||||
return tuple;
|
return (Janet *)(head->data);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Finish building a tuple */
|
/* Finish building a tuple */
|
||||||
@@ -91,58 +93,55 @@ int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
|||||||
|
|
||||||
/* C Functions */
|
/* C Functions */
|
||||||
|
|
||||||
static Janet cfun_slice(int32_t argc, Janet *argv) {
|
static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||||
|
const Janet *tup = janet_tuple_n(argv, argc);
|
||||||
|
janet_tuple_flag(tup) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||||
|
return janet_wrap_tuple(tup);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||||
JanetRange range = janet_getslice(argc, argv);
|
JanetRange range = janet_getslice(argc, argv);
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
JanetView view = janet_getindexed(argv, 0);
|
||||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_prepend(int32_t argc, Janet *argv) {
|
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, -1);
|
janet_fixarity(argc, 1);
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
|
||||||
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
|
return janet_ckeywordv("brackets");
|
||||||
for (int32_t i = 1; i < argc; i++) {
|
} else {
|
||||||
n[argc - i - 1] = argv[i];
|
return janet_ckeywordv("parens");
|
||||||
}
|
}
|
||||||
return janet_wrap_tuple(janet_tuple_end(n));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_append(int32_t argc, Janet *argv) {
|
static const JanetReg tuple_cfuns[] = {
|
||||||
janet_arity(argc, 1, -1);
|
|
||||||
JanetView view = janet_getindexed(argv, 0);
|
|
||||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
|
||||||
memcpy(n, view.items, sizeof(Janet) * view.len);
|
|
||||||
memcpy(n + view.len, argv + 1, sizeof(Janet) * (argc - 1));
|
|
||||||
return janet_wrap_tuple(janet_tuple_end(n));
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetReg cfuns[] = {
|
|
||||||
{
|
{
|
||||||
"tuple/slice", cfun_slice,
|
"tuple/brackets", cfun_tuple_brackets,
|
||||||
|
JDOC("(tuple/brackets & xs)\n\n"
|
||||||
|
"Creates a new bracketed tuple containing the elements xs.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tuple/slice", cfun_tuple_slice,
|
||||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||||
"Take a sub sequence of an array or tuple from index start "
|
"Take a sub sequence of an array or tuple from index start "
|
||||||
"inclusive to index end exclusive. If start or end are not provided, "
|
"inclusive to index end exclusive. If start or end are not provided, "
|
||||||
"they default to 0 and the length of arrtup respectively."
|
"they default to 0 and the length of arrtup respectively."
|
||||||
"Returns the new tuple.")
|
"Returns the new tuple.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tuple/append", cfun_append,
|
"tuple/type", cfun_tuple_type,
|
||||||
JDOC("(tuple/append tup & items)\n\n"
|
JDOC("(tuple/type tup)\n\n"
|
||||||
"Returns a new tuple that is the result of appending "
|
"Checks how the tuple was constructed. Will return the keyword "
|
||||||
"each element in items to tup.")
|
":brackets if the tuple was parsed with brackets, and :parens "
|
||||||
},
|
"otherwise. The two types of tuples will behave the same most of "
|
||||||
{
|
"the time, but will print differently and be treated differently by "
|
||||||
"tuple/prepend", cfun_prepend,
|
"the compiler.")
|
||||||
JDOC("(tuple/prepend tup & items)\n\n"
|
|
||||||
"Prepends each element in items to tuple and "
|
|
||||||
"returns a new tuple. Items are prepended such that the "
|
|
||||||
"last element in items is the first element in the new tuple.")
|
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Load the tuple module */
|
/* Load the tuple module */
|
||||||
void janet_lib_tuple(JanetTable *env) {
|
void janet_lib_tuple(JanetTable *env) {
|
||||||
janet_cfuns(env, NULL, cfuns);
|
janet_core_cfuns(env, NULL, tuple_cfuns);
|
||||||
}
|
}
|
||||||
|
|||||||
558
src/core/typedarray.c
Normal file
558
src/core/typedarray.c
Normal file
@@ -0,0 +1,558 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* Compiler feature test macros for things */
|
||||||
|
#define _DEFAULT_SOURCE
|
||||||
|
#define _BSD_SOURCE
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
|
typedef uint8_t ta_uint8_t;
|
||||||
|
typedef int8_t ta_int8_t;
|
||||||
|
typedef uint16_t ta_uint16_t;
|
||||||
|
typedef int16_t ta_int16_t;
|
||||||
|
typedef uint32_t ta_uint32_t;
|
||||||
|
typedef int32_t ta_int32_t;
|
||||||
|
typedef float ta_float32_t;
|
||||||
|
typedef double ta_float64_t;
|
||||||
|
|
||||||
|
static char *ta_type_names[] = {
|
||||||
|
"uint8",
|
||||||
|
"int8",
|
||||||
|
"uint16",
|
||||||
|
"int16",
|
||||||
|
"uint32",
|
||||||
|
"int32",
|
||||||
|
"float32",
|
||||||
|
"float64",
|
||||||
|
"any"
|
||||||
|
};
|
||||||
|
|
||||||
|
static size_t ta_type_sizes[] = {
|
||||||
|
sizeof(ta_uint8_t),
|
||||||
|
sizeof(ta_int8_t),
|
||||||
|
sizeof(ta_uint16_t),
|
||||||
|
sizeof(ta_int16_t),
|
||||||
|
sizeof(ta_uint32_t),
|
||||||
|
sizeof(ta_int32_t),
|
||||||
|
sizeof(ta_float32_t),
|
||||||
|
sizeof(ta_float64_t),
|
||||||
|
0
|
||||||
|
};
|
||||||
|
|
||||||
|
#define TA_COUNT_TYPES (JANET_TARRAY_TYPE_float64 + 1)
|
||||||
|
#define TA_ATOM_MAXSIZE 8
|
||||||
|
#define TA_FLAG_BIG_ENDIAN 1
|
||||||
|
|
||||||
|
static JanetTArrayType get_ta_type_by_name(const uint8_t *name) {
|
||||||
|
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||||
|
if (!janet_cstrcmp(name, ta_type_names[i]))
|
||||||
|
return i;
|
||||||
|
}
|
||||||
|
janet_panicf("invalid typed array type %S", name);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static JanetTArrayBuffer *ta_buffer_init(JanetTArrayBuffer *buf, size_t size) {
|
||||||
|
buf->data = NULL;
|
||||||
|
if (size > 0) {
|
||||||
|
buf->data = (uint8_t *)calloc(size, sizeof(uint8_t));
|
||||||
|
if (buf->data == NULL) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
buf->size = size;
|
||||||
|
#ifdef JANET_BIG_ENDIAN
|
||||||
|
buf->flags = TA_FLAG_BIG_ENDIAN;
|
||||||
|
#else
|
||||||
|
buf->flags = 0;
|
||||||
|
#endif
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int ta_buffer_gc(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
free(buf->data);
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
janet_marshal_size(ctx, buf->size);
|
||||||
|
janet_marshal_int(ctx, buf->flags);
|
||||||
|
janet_marshal_bytes(ctx, buf->data, buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_buffer_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)p;
|
||||||
|
size_t size;
|
||||||
|
janet_unmarshal_size(ctx, &size);
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
janet_unmarshal_int(ctx, &(buf->flags));
|
||||||
|
janet_unmarshal_bytes(ctx, buf->data, size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_buffer_type = {
|
||||||
|
"ta/buffer",
|
||||||
|
ta_buffer_gc,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
ta_buffer_marshal,
|
||||||
|
ta_buffer_unmarshal,
|
||||||
|
};
|
||||||
|
|
||||||
|
static int ta_mark(void *p, size_t s) {
|
||||||
|
(void) s;
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
janet_mark(janet_wrap_abstract(view->buffer));
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_marshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset = (view->buffer->data - (uint8_t *)(view->data));
|
||||||
|
janet_marshal_size(ctx, view->size);
|
||||||
|
janet_marshal_size(ctx, view->stride);
|
||||||
|
janet_marshal_int(ctx, view->type);
|
||||||
|
janet_marshal_size(ctx, offset);
|
||||||
|
janet_marshal_janet(ctx, janet_wrap_abstract(view->buffer));
|
||||||
|
}
|
||||||
|
|
||||||
|
static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)p;
|
||||||
|
size_t offset;
|
||||||
|
int32_t atype;
|
||||||
|
Janet buffer;
|
||||||
|
janet_unmarshal_size(ctx, &(view->size));
|
||||||
|
janet_unmarshal_size(ctx, &(view->stride));
|
||||||
|
janet_unmarshal_int(ctx, &atype);
|
||||||
|
if (atype < 0 || atype >= TA_COUNT_TYPES)
|
||||||
|
janet_panic("bad typed array type");
|
||||||
|
view->type = atype;
|
||||||
|
janet_unmarshal_size(ctx, &offset);
|
||||||
|
janet_unmarshal_janet(ctx, &buffer);
|
||||||
|
if (!janet_checktype(buffer, JANET_ABSTRACT) ||
|
||||||
|
(janet_abstract_type(janet_unwrap_abstract(buffer)) != &ta_buffer_type)) {
|
||||||
|
janet_panicf("expected typed array buffer");
|
||||||
|
}
|
||||||
|
view->buffer = (JanetTArrayBuffer *)janet_unwrap_abstract(buffer);
|
||||||
|
size_t buf_need_size = offset + (janet_tarray_type_size(view->type)) * ((view->size - 1) * view->stride + 1);
|
||||||
|
if (view->buffer->size < buf_need_size)
|
||||||
|
janet_panic("bad typed array offset in marshalled data");
|
||||||
|
view->data = view->buffer->data + offset;
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DEFINE_VIEW_TYPE(thetype) \
|
||||||
|
typedef struct { \
|
||||||
|
JanetTArrayBuffer *buffer; \
|
||||||
|
ta_##thetype##_t *data; \
|
||||||
|
size_t size; \
|
||||||
|
size_t stride; \
|
||||||
|
JanetTArrayType type; \
|
||||||
|
} TA_View_##thetype ;
|
||||||
|
|
||||||
|
#define DEFINE_VIEW_GETTER(type) \
|
||||||
|
static Janet ta_get_##type(void *p, Janet key) { \
|
||||||
|
Janet value; \
|
||||||
|
size_t index; \
|
||||||
|
if (!janet_checksize(key)) \
|
||||||
|
janet_panic("expected size as key"); \
|
||||||
|
index = (size_t)janet_unwrap_number(key);\
|
||||||
|
TA_View_##type *array=(TA_View_##type *)p; \
|
||||||
|
if (index >= array->size) { \
|
||||||
|
value = janet_wrap_nil(); \
|
||||||
|
} else { \
|
||||||
|
value = janet_wrap_number(array->data[index*array->stride]); \
|
||||||
|
} \
|
||||||
|
return value; \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DEFINE_VIEW_SETTER(type) \
|
||||||
|
void ta_put_##type(void *p, Janet key,Janet value) { \
|
||||||
|
size_t index;\
|
||||||
|
if (!janet_checksize(key))\
|
||||||
|
janet_panic("expected size as key"); \
|
||||||
|
if (!janet_checktype(value,JANET_NUMBER)) \
|
||||||
|
janet_panic("expected number value"); \
|
||||||
|
index = (size_t)janet_unwrap_number(key); \
|
||||||
|
TA_View_##type *array=(TA_View_##type *)p; \
|
||||||
|
if (index >= array->size) { \
|
||||||
|
janet_panic("index out of bounds"); \
|
||||||
|
} \
|
||||||
|
array->data[index*array->stride]=(ta_##type##_t)janet_unwrap_number(value); \
|
||||||
|
}
|
||||||
|
|
||||||
|
#define DEFINE_VIEW_INITIALIZER(thetype) \
|
||||||
|
static JanetTArrayView *ta_init_##thetype(JanetTArrayView *view, \
|
||||||
|
JanetTArrayBuffer *buf, size_t size, \
|
||||||
|
size_t offset, size_t stride) { \
|
||||||
|
if ((stride<1) || (size <1)) { \
|
||||||
|
janet_panic("stride and size should be > 0"); \
|
||||||
|
}; \
|
||||||
|
TA_View_##thetype * tview=(TA_View_##thetype *) view; \
|
||||||
|
size_t buf_size=offset+(sizeof(ta_##thetype##_t))*((size-1)*stride+1); \
|
||||||
|
if (buf==NULL) { \
|
||||||
|
buf=(JanetTArrayBuffer *)janet_abstract(&ta_buffer_type,sizeof(JanetTArrayBuffer)); \
|
||||||
|
ta_buffer_init(buf,buf_size); \
|
||||||
|
} \
|
||||||
|
if (buf->size<buf_size) { \
|
||||||
|
janet_panicf("bad buffer size, %i bytes allocated < %i required",buf->size,buf_size); \
|
||||||
|
} \
|
||||||
|
tview->buffer=buf; \
|
||||||
|
tview->stride=stride; \
|
||||||
|
tview->size=size; \
|
||||||
|
tview->data=(ta_##thetype##_t *)(buf->data+offset); \
|
||||||
|
tview->type=JANET_TARRAY_TYPE_##thetype; \
|
||||||
|
return view; \
|
||||||
|
};
|
||||||
|
|
||||||
|
#define BUILD_TYPE(type) \
|
||||||
|
DEFINE_VIEW_TYPE(type) \
|
||||||
|
DEFINE_VIEW_GETTER(type) \
|
||||||
|
DEFINE_VIEW_SETTER(type) \
|
||||||
|
DEFINE_VIEW_INITIALIZER(type)
|
||||||
|
|
||||||
|
BUILD_TYPE(uint8)
|
||||||
|
BUILD_TYPE(int8)
|
||||||
|
BUILD_TYPE(uint16)
|
||||||
|
BUILD_TYPE(int16)
|
||||||
|
BUILD_TYPE(uint32)
|
||||||
|
BUILD_TYPE(int32)
|
||||||
|
BUILD_TYPE(float32)
|
||||||
|
BUILD_TYPE(float64)
|
||||||
|
|
||||||
|
#undef DEFINE_VIEW_TYPE
|
||||||
|
#undef DEFINE_VIEW_GETTER
|
||||||
|
#undef DEFINE_VIEW_SETTER
|
||||||
|
#undef DEFINE_VIEW_INITIALIZER
|
||||||
|
|
||||||
|
#define DEFINE_VIEW_ABSTRACT_TYPE(type) \
|
||||||
|
{ \
|
||||||
|
"ta/"#type, \
|
||||||
|
NULL, \
|
||||||
|
ta_mark, \
|
||||||
|
ta_get_##type, \
|
||||||
|
ta_put_##type, \
|
||||||
|
ta_view_marshal, \
|
||||||
|
ta_view_unmarshal \
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetAbstractType ta_array_types[] = {
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(uint8),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(int8),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(uint16),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(int16),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(uint32),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(int32),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(float32),
|
||||||
|
DEFINE_VIEW_ABSTRACT_TYPE(float64)
|
||||||
|
};
|
||||||
|
|
||||||
|
#undef DEFINE_VIEW_ABSTRACT_TYPE
|
||||||
|
|
||||||
|
static int is_ta_anytype(Janet x) {
|
||||||
|
if (janet_checktype(x, JANET_ABSTRACT)) {
|
||||||
|
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(x));
|
||||||
|
for (size_t i = 0; i < TA_COUNT_TYPES; i++) {
|
||||||
|
if (at == ta_array_types + i) return 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
return 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
static int is_ta_type(Janet x, JanetTArrayType type) {
|
||||||
|
return janet_checktype(x, JANET_ABSTRACT) &&
|
||||||
|
(type < TA_COUNT_TYPES) &&
|
||||||
|
(janet_abstract_type(janet_unwrap_abstract(x)) == &ta_array_types[type]);
|
||||||
|
}
|
||||||
|
|
||||||
|
#define CASE_TYPE_INITIALIZE(type) case JANET_TARRAY_TYPE_##type: \
|
||||||
|
ta_init_##type(view,buffer,size,offset,stride); break
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_tarray_buffer(size_t size) {
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_abstract(&ta_buffer_type, sizeof(JanetTArrayBuffer));
|
||||||
|
ta_buffer_init(buf, size);
|
||||||
|
return buf;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer) {
|
||||||
|
JanetTArrayView *view = janet_abstract(&ta_array_types[type], sizeof(JanetTArrayView));
|
||||||
|
switch (type) {
|
||||||
|
CASE_TYPE_INITIALIZE(uint8);
|
||||||
|
CASE_TYPE_INITIALIZE(int8);
|
||||||
|
CASE_TYPE_INITIALIZE(uint16);
|
||||||
|
CASE_TYPE_INITIALIZE(int16);
|
||||||
|
CASE_TYPE_INITIALIZE(uint32);
|
||||||
|
CASE_TYPE_INITIALIZE(int32);
|
||||||
|
CASE_TYPE_INITIALIZE(float32);
|
||||||
|
CASE_TYPE_INITIALIZE(float64);
|
||||||
|
default :
|
||||||
|
janet_panic("bad typed array type");
|
||||||
|
}
|
||||||
|
return view;
|
||||||
|
}
|
||||||
|
|
||||||
|
#undef CASE_TYPE_INITIALIZE
|
||||||
|
|
||||||
|
JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n) {
|
||||||
|
return (JanetTArrayBuffer *)janet_getabstract(argv, n, &ta_buffer_type);
|
||||||
|
}
|
||||||
|
|
||||||
|
int janet_is_tarray_view(Janet x, JanetTArrayType type) {
|
||||||
|
return (type == JANET_TARRAY_TYPE_any) ? is_ta_anytype(x) : is_ta_type(x, type);
|
||||||
|
}
|
||||||
|
|
||||||
|
size_t janet_tarray_type_size(JanetTArrayType type) {
|
||||||
|
return (type < TA_COUNT_TYPES) ? ta_type_sizes[type] : 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type) {
|
||||||
|
if (janet_is_tarray_view(argv[n], type)) {
|
||||||
|
return (JanetTArrayView *)janet_unwrap_abstract(argv[n]);
|
||||||
|
} else {
|
||||||
|
janet_panicf("bad slot #%d, expected typed array of type %s, got %v",
|
||||||
|
n, (type <= JANET_TARRAY_TYPE_any) ? ta_type_names[type] : "?", argv[n]);
|
||||||
|
return NULL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_new(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 2, 5);
|
||||||
|
size_t offset = 0;
|
||||||
|
size_t stride = 1;
|
||||||
|
JanetTArrayBuffer *buffer = NULL;
|
||||||
|
const uint8_t *keyw = janet_getkeyword(argv, 0);
|
||||||
|
JanetTArrayType type = get_ta_type_by_name(keyw);
|
||||||
|
size_t size = janet_getsize(argv, 1);
|
||||||
|
if (argc > 2)
|
||||||
|
stride = janet_getsize(argv, 2);
|
||||||
|
if (argc > 3)
|
||||||
|
offset = janet_getsize(argv, 3);
|
||||||
|
if (argc > 4) {
|
||||||
|
if (is_ta_anytype(argv[4])) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[4]);
|
||||||
|
offset = (view->buffer->data - (uint8_t *)(view->data)) + offset * ta_type_sizes[view->type];
|
||||||
|
stride *= view->stride;
|
||||||
|
buffer = view->buffer;
|
||||||
|
} else {
|
||||||
|
buffer = (JanetTArrayBuffer *)janet_getabstract(argv, 4, &ta_buffer_type);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
JanetTArrayView *view = janet_tarray_view(type, size, stride, offset, buffer);
|
||||||
|
return janet_wrap_abstract(view);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_buffer(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
if (is_ta_anytype(argv[0])) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||||
|
return janet_wrap_abstract(view->buffer);
|
||||||
|
}
|
||||||
|
size_t size = janet_getsize(argv, 0);
|
||||||
|
JanetTArrayBuffer *buf = janet_tarray_buffer(size);
|
||||||
|
return janet_wrap_abstract(buf);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_size(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
if (is_ta_anytype(argv[0])) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||||
|
return janet_wrap_number((double) view->size);
|
||||||
|
}
|
||||||
|
JanetTArrayBuffer *buf = (JanetTArrayBuffer *)janet_getabstract(argv, 0, &ta_buffer_type);
|
||||||
|
return janet_wrap_number((double) buf->size);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_properties(int32_t argc, Janet *argv) {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
if (is_ta_anytype(argv[0])) {
|
||||||
|
JanetTArrayView *view = (JanetTArrayView *)janet_unwrap_abstract(argv[0]);
|
||||||
|
JanetKV *props = janet_struct_begin(6);
|
||||||
|
ptrdiff_t boffset = (uint8_t *)(view->data) - view->buffer->data;
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) view->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("byte-offset"),
|
||||||
|
janet_wrap_number((double) boffset));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("stride"),
|
||||||
|
janet_wrap_number((double) view->stride));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type"),
|
||||||
|
janet_ckeywordv(ta_type_names[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("type-size"),
|
||||||
|
janet_wrap_number((double) ta_type_sizes[view->type]));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("buffer"),
|
||||||
|
janet_wrap_abstract(view->buffer));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
} else {
|
||||||
|
JanetTArrayBuffer *buffer = janet_gettarray_buffer(argv, 0);
|
||||||
|
JanetKV *props = janet_struct_begin(2);
|
||||||
|
janet_struct_put(props, janet_ckeywordv("size"),
|
||||||
|
janet_wrap_number((double) buffer->size));
|
||||||
|
janet_struct_put(props, janet_ckeywordv("big-endian"),
|
||||||
|
janet_wrap_boolean(buffer->flags & TA_FLAG_BIG_ENDIAN));
|
||||||
|
return janet_wrap_struct(janet_struct_end(props));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_slice(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 1, 3);
|
||||||
|
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||||
|
const JanetAbstractType *at = janet_abstract_type(janet_unwrap_abstract(argv[0]));
|
||||||
|
JanetRange range;
|
||||||
|
int32_t length = (int32_t)src->size;
|
||||||
|
if (argc == 1) {
|
||||||
|
range.start = 0;
|
||||||
|
range.end = length;
|
||||||
|
} else if (argc == 2) {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = length;
|
||||||
|
} else {
|
||||||
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
|
if (range.end < range.start)
|
||||||
|
range.end = range.start;
|
||||||
|
}
|
||||||
|
JanetArray *array = janet_array(range.end - range.start);
|
||||||
|
if (array->data) {
|
||||||
|
for (int32_t i = range.start; i < range.end; i++) {
|
||||||
|
array->data[i - range.start] = at->get(src, janet_wrap_number(i));
|
||||||
|
}
|
||||||
|
}
|
||||||
|
array->count = range.end - range.start;
|
||||||
|
return janet_wrap_array(array);
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_copy_bytes(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 4, 5);
|
||||||
|
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
|
||||||
|
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];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memmove(pd, ps, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array copy out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||||
|
janet_arity(argc, 4, 5);
|
||||||
|
JanetTArrayView *src = janet_gettarray_view(argv, 0, JANET_TARRAY_TYPE_any);
|
||||||
|
size_t index_src = janet_getsize(argv, 1);
|
||||||
|
JanetTArrayView *dst = janet_gettarray_view(argv, 2, JANET_TARRAY_TYPE_any);
|
||||||
|
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];
|
||||||
|
size_t dst_atom_size = ta_type_sizes[dst->type];
|
||||||
|
size_t step_src = src->stride * src_atom_size;
|
||||||
|
size_t step_dst = dst->stride * dst_atom_size;
|
||||||
|
size_t pos_src = ((uint8_t *)(src->data) - src->buffer->data) + (index_src * step_src);
|
||||||
|
size_t pos_dst = ((uint8_t *)(dst->data) - dst->buffer->data) + (index_dst * step_dst);
|
||||||
|
uint8_t *ps = src->buffer->data + pos_src, * pd = dst->buffer->data + pos_dst;
|
||||||
|
uint8_t temp[TA_ATOM_MAXSIZE];
|
||||||
|
if ((pos_dst + (count - 1)*step_dst + src_atom_size <= dst->buffer->size) &&
|
||||||
|
(pos_src + (count - 1)*step_src + src_atom_size <= src->buffer->size)) {
|
||||||
|
for (size_t i = 0; i < count; i++) {
|
||||||
|
memcpy(temp, ps, src_atom_size);
|
||||||
|
memcpy(ps, pd, src_atom_size);
|
||||||
|
memcpy(pd, temp, src_atom_size);
|
||||||
|
pd += step_dst;
|
||||||
|
ps += step_src;
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
janet_panic("typed array swap out of bounds");
|
||||||
|
}
|
||||||
|
return janet_wrap_nil();
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg ta_cfuns[] = {
|
||||||
|
{
|
||||||
|
"tarray/new", cfun_typed_array_new,
|
||||||
|
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
|
||||||
|
"Create new typed array.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/buffer", cfun_typed_array_buffer,
|
||||||
|
JDOC("(tarray/buffer (array | size) )\n\n"
|
||||||
|
"Return typed array buffer or create a new buffer.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/length", cfun_typed_array_size,
|
||||||
|
JDOC("(tarray/length (array | buffer) )\n\n"
|
||||||
|
"Return typed array or buffer size.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/properties", cfun_typed_array_properties,
|
||||||
|
JDOC("(tarray/properties array )\n\n"
|
||||||
|
"Return typed array properties as a struct.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||||
|
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
|
"Copy count elements of src array from index sindex "
|
||||||
|
"to dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||||
|
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
|
"Swap count elements between src array from index sindex "
|
||||||
|
"and dst array at position dindex "
|
||||||
|
"memory can overlap.")
|
||||||
|
},
|
||||||
|
{
|
||||||
|
"tarray/slice", cfun_typed_array_slice,
|
||||||
|
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
|
||||||
|
"Takes a slice of a typed array from start to end. The range is half "
|
||||||
|
"open, [start, end). Indexes can also be negative, indicating indexing "
|
||||||
|
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||||
|
"the size of the typed array. Returns a new janet array.")
|
||||||
|
},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Module entry point */
|
||||||
|
void janet_lib_typed_array(JanetTable *env) {
|
||||||
|
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||||
|
janet_register_abstract_type(&ta_buffer_type);
|
||||||
|
for (int i = 0; i < TA_COUNT_TYPES; i++) {
|
||||||
|
janet_register_abstract_type(ta_array_types + i);
|
||||||
|
}
|
||||||
|
}
|
||||||
137
src/core/util.c
137
src/core/util.c
@@ -20,11 +20,14 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
|
||||||
#include <inttypes.h>
|
#include <inttypes.h>
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Base 64 lookup table for digits */
|
/* Base 64 lookup table for digits */
|
||||||
const char janet_base64[65] =
|
const char janet_base64[65] =
|
||||||
@@ -39,7 +42,6 @@ const char *const janet_type_names[16] = {
|
|||||||
"number",
|
"number",
|
||||||
"nil",
|
"nil",
|
||||||
"boolean",
|
"boolean",
|
||||||
"boolean",
|
|
||||||
"fiber",
|
"fiber",
|
||||||
"string",
|
"string",
|
||||||
"symbol",
|
"symbol",
|
||||||
@@ -51,7 +53,8 @@ const char *const janet_type_names[16] = {
|
|||||||
"buffer",
|
"buffer",
|
||||||
"function",
|
"function",
|
||||||
"cfunction",
|
"cfunction",
|
||||||
"abstract"
|
"abstract",
|
||||||
|
"pointer"
|
||||||
};
|
};
|
||||||
|
|
||||||
const char *const janet_signal_names[14] = {
|
const char *const janet_signal_names[14] = {
|
||||||
@@ -207,10 +210,10 @@ int janet_cstrcmp(const uint8_t *str, const char *other) {
|
|||||||
* have a string as its first element, and the struct must be sorted
|
* have a string as its first element, and the struct must be sorted
|
||||||
* lexicographically by that element. */
|
* lexicographically by that element. */
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
size_t itemsize,
|
size_t itemsize,
|
||||||
const uint8_t *key) {
|
const uint8_t *key) {
|
||||||
size_t low = 0;
|
size_t low = 0;
|
||||||
size_t hi = tabcount;
|
size_t hi = tabcount;
|
||||||
const char *t = (const char *)tab;
|
const char *t = (const char *)tab;
|
||||||
@@ -281,6 +284,76 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
/* Abstract type introspection */
|
||||||
|
|
||||||
|
static const JanetAbstractType type_wrap = {
|
||||||
|
"core/type-info",
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL,
|
||||||
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
|
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))) {
|
||||||
|
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));
|
||||||
|
}
|
||||||
|
|
||||||
|
const JanetAbstractType *janet_get_abstract_type(Janet key) {
|
||||||
|
Janet twrap = janet_table_get(janet_vm_registry, key);
|
||||||
|
if (janet_checktype(twrap, 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;
|
||||||
|
}
|
||||||
|
|
||||||
|
#ifndef JANET_BOOTSTRAP
|
||||||
|
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||||
|
(void) p;
|
||||||
|
Janet key = janet_csymbolv(name);
|
||||||
|
Janet value;
|
||||||
|
/* During boot, allow replacing core library cfunctions with values from
|
||||||
|
* the env. */
|
||||||
|
Janet check = janet_table_get(env, key);
|
||||||
|
if (janet_checktype(check, JANET_NIL)) {
|
||||||
|
value = x;
|
||||||
|
} else {
|
||||||
|
value = check;
|
||||||
|
if (janet_checktype(check, JANET_CFUNCTION)) {
|
||||||
|
janet_table_put(janet_vm_registry, value, key);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
janet_table_put(env, key, value);
|
||||||
|
}
|
||||||
|
|
||||||
|
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||||
|
(void) regprefix;
|
||||||
|
while (cfuns->name) {
|
||||||
|
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||||
|
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||||
|
cfuns++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Resolve a symbol in the environment */
|
/* Resolve a symbol in the environment */
|
||||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||||
Janet ref;
|
Janet ref;
|
||||||
@@ -290,8 +363,8 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
|
|||||||
return JANET_BINDING_NONE;
|
return JANET_BINDING_NONE;
|
||||||
entry_table = janet_unwrap_table(entry);
|
entry_table = janet_unwrap_table(entry);
|
||||||
if (!janet_checktype(
|
if (!janet_checktype(
|
||||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||||
JANET_NIL)) {
|
JANET_NIL)) {
|
||||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||||
return JANET_BINDING_MACRO;
|
return JANET_BINDING_MACRO;
|
||||||
}
|
}
|
||||||
@@ -313,7 +386,7 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
|||||||
return 1;
|
return 1;
|
||||||
} else if (janet_checktype(seq, JANET_TUPLE)) {
|
} else if (janet_checktype(seq, JANET_TUPLE)) {
|
||||||
*data = janet_unwrap_tuple(seq);
|
*data = janet_unwrap_tuple(seq);
|
||||||
*len = janet_tuple_length(janet_unwrap_struct(seq));
|
*len = janet_tuple_length(janet_unwrap_tuple(seq));
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
@@ -367,42 +440,10 @@ int janet_checkint64(Janet x) {
|
|||||||
return janet_checkint64range(dval);
|
return janet_checkint64range(dval);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Useful for inspecting values while debugging */
|
int janet_checksize(Janet x) {
|
||||||
void janet_inspect(Janet x) {
|
if (!janet_checktype(x, JANET_NUMBER))
|
||||||
printf("<type=%s, ", janet_type_names[janet_type(x)]);
|
return 0;
|
||||||
|
double dval = janet_unwrap_number(x);
|
||||||
#ifdef JANET_BIG_ENDIAN
|
return dval == (double)((size_t) dval) &&
|
||||||
printf("be ");
|
dval <= SIZE_MAX;
|
||||||
#else
|
|
||||||
printf("le ");
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_64
|
|
||||||
printf("nanbox64 raw=0x%.16" PRIx64 ", ", x.u64);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_NANBOX_32
|
|
||||||
printf("nanbox32 type=0x%.8" PRIx32 ", ", x.tagged.type);
|
|
||||||
printf("payload=%" PRId32 ", ", x.tagged.payload.integer);
|
|
||||||
#endif
|
|
||||||
|
|
||||||
switch (janet_type(x)) {
|
|
||||||
case JANET_NIL:
|
|
||||||
printf("value=nil");
|
|
||||||
break;
|
|
||||||
case JANET_NUMBER:
|
|
||||||
printf("number=%.17g", janet_unwrap_number(x));
|
|
||||||
break;
|
|
||||||
case JANET_TRUE:
|
|
||||||
printf("value=true");
|
|
||||||
break;
|
|
||||||
case JANET_FALSE:
|
|
||||||
printf("value=false");
|
|
||||||
break;
|
|
||||||
default:
|
|
||||||
printf("pointer=%p", janet_unwrap_pointer(x));
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
|
|
||||||
printf(">\n");
|
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -23,11 +23,14 @@
|
|||||||
#ifndef JANET_UTIL_H_defined
|
#ifndef JANET_UTIL_H_defined
|
||||||
#define JANET_UTIL_H_defined
|
#define JANET_UTIL_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Omit docstrings in some builds */
|
/* Omit docstrings in some builds */
|
||||||
#ifdef JANET_NO_BOOTSTRAP
|
#ifndef JANET_BOOTSTRAP
|
||||||
#define JDOC(x) NULL
|
#define JDOC(x) NULL
|
||||||
|
#define JANET_NO_BOOTSTRAP
|
||||||
#else
|
#else
|
||||||
#define JDOC(x) x
|
#define JDOC(x) x
|
||||||
#endif
|
#endif
|
||||||
@@ -45,10 +48,26 @@ Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
|||||||
void janet_memempty(JanetKV *mem, int32_t count);
|
void janet_memempty(JanetKV *mem, int32_t count);
|
||||||
void *janet_memalloc_empty(int32_t count);
|
void *janet_memalloc_empty(int32_t count);
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
size_t itemsize,
|
size_t itemsize,
|
||||||
const uint8_t *key);
|
const uint8_t *key);
|
||||||
|
void janet_buffer_format(
|
||||||
|
JanetBuffer *b,
|
||||||
|
const char *strfrmt,
|
||||||
|
int32_t argstart,
|
||||||
|
int32_t argc,
|
||||||
|
Janet *argv);
|
||||||
|
|
||||||
|
/* Inside the janet core, defining globals is different
|
||||||
|
* at bootstrap time and normal runtime */
|
||||||
|
#ifdef JANET_BOOTSTRAP
|
||||||
|
#define janet_core_def janet_def
|
||||||
|
#define janet_core_cfuns janet_cfuns
|
||||||
|
#else
|
||||||
|
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
|
||||||
|
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Initialize builtin libraries */
|
/* Initialize builtin libraries */
|
||||||
void janet_lib_io(JanetTable *env);
|
void janet_lib_io(JanetTable *env);
|
||||||
@@ -67,5 +86,11 @@ void janet_lib_asm(JanetTable *env);
|
|||||||
#endif
|
#endif
|
||||||
void janet_lib_compile(JanetTable *env);
|
void janet_lib_compile(JanetTable *env);
|
||||||
void janet_lib_debug(JanetTable *env);
|
void janet_lib_debug(JanetTable *env);
|
||||||
|
#ifdef JANET_PEG
|
||||||
|
void janet_lib_peg(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
void janet_lib_typed_array(JanetTable *env);
|
||||||
|
#endif
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
361
src/core/value.c
361
src/core/value.c
@@ -20,7 +20,9 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* Define a number of functions that can be used internally on ANY Janet.
|
* Define a number of functions that can be used internally on ANY Janet.
|
||||||
@@ -33,27 +35,28 @@ int janet_equals(Janet x, Janet y) {
|
|||||||
result = 0;
|
result = 0;
|
||||||
} else {
|
} else {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_TRUE:
|
result = 1;
|
||||||
case JANET_FALSE:
|
break;
|
||||||
result = 1;
|
case JANET_BOOLEAN:
|
||||||
break;
|
result = (janet_unwrap_boolean(x) == janet_unwrap_boolean(y));
|
||||||
case JANET_NUMBER:
|
break;
|
||||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
case JANET_NUMBER:
|
||||||
break;
|
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||||
case JANET_STRING:
|
break;
|
||||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
case JANET_STRING:
|
||||||
break;
|
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||||
case JANET_TUPLE:
|
break;
|
||||||
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
case JANET_TUPLE:
|
||||||
break;
|
result = janet_tuple_equal(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||||
case JANET_STRUCT:
|
break;
|
||||||
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
case JANET_STRUCT:
|
||||||
break;
|
result = janet_struct_equal(janet_unwrap_struct(x), janet_unwrap_struct(y));
|
||||||
default:
|
break;
|
||||||
/* compare pointers */
|
default:
|
||||||
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
/* compare pointers */
|
||||||
break;
|
result = (janet_unwrap_pointer(x) == janet_unwrap_pointer(y));
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return result;
|
return result;
|
||||||
@@ -63,41 +66,38 @@ int janet_equals(Janet x, Janet y) {
|
|||||||
int32_t janet_hash(Janet x) {
|
int32_t janet_hash(Janet x) {
|
||||||
int32_t hash = 0;
|
int32_t hash = 0;
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
hash = 0;
|
hash = 0;
|
||||||
break;
|
break;
|
||||||
case JANET_FALSE:
|
case JANET_BOOLEAN:
|
||||||
hash = 1;
|
hash = janet_unwrap_boolean(x);
|
||||||
break;
|
break;
|
||||||
case JANET_TRUE:
|
case JANET_STRING:
|
||||||
hash = 2;
|
case JANET_SYMBOL:
|
||||||
break;
|
case JANET_KEYWORD:
|
||||||
case JANET_STRING:
|
hash = janet_string_hash(janet_unwrap_string(x));
|
||||||
case JANET_SYMBOL:
|
break;
|
||||||
case JANET_KEYWORD:
|
case JANET_TUPLE:
|
||||||
hash = janet_string_hash(janet_unwrap_string(x));
|
hash = janet_tuple_hash(janet_unwrap_tuple(x));
|
||||||
break;
|
break;
|
||||||
case JANET_TUPLE:
|
case JANET_STRUCT:
|
||||||
hash = janet_tuple_hash(janet_unwrap_tuple(x));
|
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||||
break;
|
break;
|
||||||
case JANET_STRUCT:
|
default:
|
||||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
/* TODO - test performance with different hash functions */
|
||||||
break;
|
if (sizeof(double) == sizeof(void *)) {
|
||||||
default:
|
/* Assuming 8 byte pointer */
|
||||||
/* TODO - test performance with different hash functions */
|
uint64_t i = janet_u64(x);
|
||||||
if (sizeof(double) == sizeof(void *)) {
|
hash = (int32_t)(i & 0xFFFFFFFF);
|
||||||
/* Assuming 8 byte pointer */
|
/* Get a bit more entropy by shifting the low bits out */
|
||||||
uint64_t i = janet_u64(x);
|
hash >>= 3;
|
||||||
hash = (int32_t)(i & 0xFFFFFFFF);
|
hash ^= (int32_t)(i >> 32);
|
||||||
/* Get a bit more entropy by shifting the low bits out */
|
} else {
|
||||||
hash >>= 3;
|
/* Assuming 4 byte pointer (or smaller) */
|
||||||
hash ^= (int32_t) (i >> 32);
|
hash = (int32_t)((char *)janet_unwrap_pointer(x) - (char *)0);
|
||||||
} else {
|
hash >>= 2;
|
||||||
/* Assuming 4 byte pointer (or smaller) */
|
}
|
||||||
hash = (int32_t) ((char *)janet_unwrap_pointer(x) - (char *)0);
|
break;
|
||||||
hash >>= 2;
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
return hash;
|
return hash;
|
||||||
}
|
}
|
||||||
@@ -109,15 +109,15 @@ int janet_compare(Janet x, Janet y) {
|
|||||||
if (janet_type(x) == janet_type(y)) {
|
if (janet_type(x) == janet_type(y)) {
|
||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
case JANET_NIL:
|
case JANET_NIL:
|
||||||
case JANET_FALSE:
|
|
||||||
case JANET_TRUE:
|
|
||||||
return 0;
|
return 0;
|
||||||
|
case JANET_BOOLEAN:
|
||||||
|
return janet_unwrap_boolean(x) - janet_unwrap_boolean(y);
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
/* Check for NaNs to ensure total order */
|
/* Check for NaNs to ensure total order */
|
||||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||||
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
||||||
? 0
|
? 0
|
||||||
: -1;
|
: -1;
|
||||||
if (janet_unwrap_number(y) != janet_unwrap_number(y))
|
if (janet_unwrap_number(y) != janet_unwrap_number(y))
|
||||||
return 1;
|
return 1;
|
||||||
|
|
||||||
@@ -159,64 +159,70 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
value = janet_table_get(janet_unwrap_table(ds), key);
|
value = janet_table_get(janet_unwrap_table(ds), key);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
int32_t index;
|
||||||
int32_t index;
|
if (!janet_checkint(key))
|
||||||
if (!janet_checkint(key))
|
janet_panic("expected integer key");
|
||||||
janet_panic("expected integer key");
|
index = janet_unwrap_integer(key);
|
||||||
index = janet_unwrap_integer(key);
|
if (index < 0 || index >= array->count) {
|
||||||
if (index < 0 || index >= array->count) {
|
value = janet_wrap_nil();
|
||||||
value = janet_wrap_nil();
|
} else {
|
||||||
} else {
|
value = array->data[index];
|
||||||
value = array->data[index];
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
case JANET_TUPLE:
|
break;
|
||||||
{
|
}
|
||||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
case JANET_TUPLE: {
|
||||||
int32_t index;
|
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||||
if (!janet_checkint(key))
|
int32_t index;
|
||||||
janet_panic("expected integer key");
|
if (!janet_checkint(key))
|
||||||
index = janet_unwrap_integer(key);
|
janet_panic("expected integer key");
|
||||||
if (index < 0 || index >= janet_tuple_length(tuple)) {
|
index = janet_unwrap_integer(key);
|
||||||
value = janet_wrap_nil();
|
if (index < 0 || index >= janet_tuple_length(tuple)) {
|
||||||
} else {
|
value = janet_wrap_nil();
|
||||||
value = tuple[index];
|
} else {
|
||||||
}
|
value = tuple[index];
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
break;
|
||||||
{
|
}
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
case JANET_BUFFER: {
|
||||||
int32_t index;
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
if (!janet_checkint(key))
|
int32_t index;
|
||||||
janet_panic("expected integer key");
|
if (!janet_checkint(key))
|
||||||
index = janet_unwrap_integer(key);
|
janet_panic("expected integer key");
|
||||||
if (index < 0 || index >= buffer->count) {
|
index = janet_unwrap_integer(key);
|
||||||
value = janet_wrap_nil();
|
if (index < 0 || index >= buffer->count) {
|
||||||
} else {
|
value = janet_wrap_nil();
|
||||||
value = janet_wrap_integer(buffer->data[index]);
|
} else {
|
||||||
}
|
value = janet_wrap_integer(buffer->data[index]);
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD: {
|
||||||
{
|
const uint8_t *str = janet_unwrap_string(ds);
|
||||||
const uint8_t *str = janet_unwrap_string(ds);
|
int32_t index;
|
||||||
int32_t index;
|
if (!janet_checkint(key))
|
||||||
if (!janet_checkint(key))
|
janet_panic("expected integer key");
|
||||||
janet_panic("expected integer key");
|
index = janet_unwrap_integer(key);
|
||||||
index = janet_unwrap_integer(key);
|
if (index < 0 || index >= janet_string_length(str)) {
|
||||||
if (index < 0 || index >= janet_string_length(str)) {
|
value = janet_wrap_nil();
|
||||||
value = janet_wrap_nil();
|
} else {
|
||||||
} else {
|
value = janet_wrap_integer(str[index]);
|
||||||
value = janet_wrap_integer(str[index]);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->get) {
|
||||||
|
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
return value;
|
return value;
|
||||||
}
|
}
|
||||||
@@ -265,6 +271,16 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
|||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
||||||
break;
|
break;
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->get) {
|
||||||
|
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||||
|
} else {
|
||||||
|
janet_panicf("no getter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
return value;
|
return value;
|
||||||
}
|
}
|
||||||
@@ -295,36 +311,42 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
if (index >= array->count) {
|
||||||
if (index >= array->count) {
|
janet_array_ensure(array, index + 1, 2);
|
||||||
janet_array_ensure(array, index + 1, 2);
|
array->count = index + 1;
|
||||||
array->count = index + 1;
|
|
||||||
}
|
|
||||||
array->data[index] = value;
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
array->data[index] = value;
|
||||||
{
|
break;
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
}
|
||||||
if (!janet_checkint(value))
|
case JANET_BUFFER: {
|
||||||
janet_panicf("can only put integers in buffers, got %v", value);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
if (index >= buffer->count) {
|
if (!janet_checkint(value))
|
||||||
janet_buffer_ensure(buffer, index + 1, 2);
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
buffer->count = index + 1;
|
if (index >= buffer->count) {
|
||||||
}
|
janet_buffer_ensure(buffer, index + 1, 2);
|
||||||
buffer->data[index] = janet_unwrap_integer(value);
|
buffer->count = index + 1;
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
case JANET_TABLE:
|
buffer->data[index] = janet_unwrap_integer(value);
|
||||||
{
|
break;
|
||||||
JanetTable *table = janet_unwrap_table(ds);
|
}
|
||||||
janet_table_put(table, janet_wrap_integer(index), value);
|
case JANET_TABLE: {
|
||||||
break;
|
JanetTable *table = janet_unwrap_table(ds);
|
||||||
|
janet_table_put(table, janet_wrap_integer(index), value);
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->put) {
|
||||||
|
(type->put)(janet_unwrap_abstract(ds), janet_wrap_integer(index), value);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
}
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -332,38 +354,45 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
break;
|
break;
|
||||||
case JANET_ARRAY:
|
case JANET_ARRAY: {
|
||||||
{
|
int32_t index;
|
||||||
int32_t index;
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
index = janet_unwrap_integer(key);
|
||||||
index = janet_unwrap_integer(key);
|
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
if (index >= array->count) {
|
||||||
if (index >= array->count) {
|
janet_array_setcount(array, index + 1);
|
||||||
janet_array_setcount(array, index + 1);
|
|
||||||
}
|
|
||||||
array->data[index] = value;
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
case JANET_BUFFER:
|
array->data[index] = value;
|
||||||
{
|
break;
|
||||||
int32_t index;
|
}
|
||||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
case JANET_BUFFER: {
|
||||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
int32_t index;
|
||||||
index = janet_unwrap_integer(key);
|
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||||
if (!janet_checkint(value))
|
index = janet_unwrap_integer(key);
|
||||||
janet_panicf("can only put integers in buffers, got %v", value);
|
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||||
if (index >= buffer->count) {
|
if (!janet_checkint(value))
|
||||||
janet_buffer_setcount(buffer, index + 1);
|
janet_panicf("can only put integers in buffers, got %v", value);
|
||||||
}
|
if (index >= buffer->count) {
|
||||||
buffer->data[index] = (uint8_t) (janet_unwrap_integer(value) & 0xFF);
|
janet_buffer_setcount(buffer, index + 1);
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
|
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
||||||
|
break;
|
||||||
|
}
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
janet_table_put(janet_unwrap_table(ds), key, value);
|
janet_table_put(janet_unwrap_table(ds), key, value);
|
||||||
break;
|
break;
|
||||||
|
case JANET_ABSTRACT: {
|
||||||
|
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(janet_unwrap_abstract(ds));
|
||||||
|
if (type->put) {
|
||||||
|
(type->put)(janet_unwrap_abstract(ds), key, value);
|
||||||
|
} else {
|
||||||
|
janet_panicf("no setter for %T ", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -20,39 +20,25 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
|
#ifndef JANET_AMALG
|
||||||
#include "vector.h"
|
#include "vector.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Grow the buffer dynamically. Used for push operations. */
|
/* Grow the buffer dynamically. Used for push operations. */
|
||||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||||
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
||||||
int32_t min_needed = janet_v_count(v) + increment;
|
int32_t min_needed = janet_v_count(v) + increment;
|
||||||
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
||||||
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t)*2);
|
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||||
if (NULL != p) {
|
if (NULL != p) {
|
||||||
if (!v) p[1] = 0;
|
if (!v) p[1] = 0;
|
||||||
p[0] = m;
|
p[0] = m;
|
||||||
return p + 2;
|
return p + 2;
|
||||||
} else {
|
|
||||||
{
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
return (void *) (2 * sizeof(int32_t));
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Clone a buffer. */
|
|
||||||
void *janet_v_copymem(void *v, int32_t itemsize) {
|
|
||||||
int32_t *p;
|
|
||||||
if (NULL == v) return NULL;
|
|
||||||
p = malloc(2 * sizeof(int32_t) + itemsize * janet_v__cap(v));
|
|
||||||
if (NULL != p) {
|
|
||||||
memcpy(p, janet_v__raw(v), 2 * sizeof(int32_t) + itemsize * janet_v__cnt(v));
|
|
||||||
return p + 2;
|
|
||||||
} else {
|
} else {
|
||||||
{
|
{
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
return (void *) (2 * sizeof(int32_t));
|
return (void *)(2 * sizeof(int32_t));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -67,10 +53,10 @@ void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
|||||||
memcpy(p, v, sizen);
|
memcpy(p, v, sizen);
|
||||||
return p;
|
return p;
|
||||||
} else {
|
} else {
|
||||||
{
|
{
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -23,7 +23,9 @@
|
|||||||
#ifndef JANET_VECTOR_H_defined
|
#ifndef JANET_VECTOR_H_defined
|
||||||
#define JANET_VECTOR_H_defined
|
#define JANET_VECTOR_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
/*
|
/*
|
||||||
* vector code modified from
|
* vector code modified from
|
||||||
@@ -38,7 +40,6 @@
|
|||||||
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
||||||
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
||||||
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
||||||
#define janet_v_add(v, n) (janet_v__maybegrow(v, n), janet_v_cnt(v) += (n), &(v)[janet_v__cnt(v) - (n)])
|
|
||||||
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
||||||
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||||
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
||||||
|
|||||||
214
src/core/vm.c
214
src/core/vm.c
@@ -20,17 +20,21 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "fiber.h"
|
#include "fiber.h"
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "symcache.h"
|
#include "symcache.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
|
#endif
|
||||||
|
|
||||||
/* VM state */
|
/* VM state */
|
||||||
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||||
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
JANET_THREAD_LOCAL int janet_vm_stackn = 0;
|
||||||
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
||||||
|
JANET_THREAD_LOCAL Janet *janet_vm_return_reg = NULL;
|
||||||
|
JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||||
|
|
||||||
/* Virtual registers
|
/* Virtual registers
|
||||||
*
|
*
|
||||||
@@ -58,7 +62,7 @@ JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber = NULL;
|
|||||||
#define VM_END() }
|
#define VM_END() }
|
||||||
#define VM_OP(op) label_##op :
|
#define VM_OP(op) label_##op :
|
||||||
#define VM_DEFAULT() label_unknown_op:
|
#define VM_DEFAULT() label_unknown_op:
|
||||||
#define vm_next() goto *op_lookup[*pc & 0xFF];
|
#define vm_next() goto *op_lookup[*pc & 0xFF]
|
||||||
static void *op_lookup[255] = {
|
static void *op_lookup[255] = {
|
||||||
&&label_JOP_NOOP,
|
&&label_JOP_NOOP,
|
||||||
&&label_JOP_ERROR,
|
&&label_JOP_ERROR,
|
||||||
@@ -146,7 +150,7 @@ static void *op_lookup[255] = {
|
|||||||
} while (0)
|
} while (0)
|
||||||
#define vm_return(sig, val) do { \
|
#define vm_return(sig, val) do { \
|
||||||
vm_commit(); \
|
vm_commit(); \
|
||||||
janet_fiber_push(fiber, (val)); \
|
janet_vm_return_reg[0] = (val); \
|
||||||
return (sig); \
|
return (sig); \
|
||||||
} while (0)
|
} while (0)
|
||||||
|
|
||||||
@@ -224,7 +228,8 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
|||||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||||
Janet ds, key;
|
Janet ds, key;
|
||||||
if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn);
|
if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn);
|
||||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)) {
|
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||||
|
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||||
ds = callee;
|
ds = callee;
|
||||||
key = fiber->data[fiber->stackstart];
|
key = fiber->data[fiber->stackstart];
|
||||||
} else {
|
} else {
|
||||||
@@ -236,7 +241,7 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Interpreter main loop */
|
/* Interpreter main loop */
|
||||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||||
|
|
||||||
/* Interpreter state */
|
/* Interpreter state */
|
||||||
register Janet *stack;
|
register Janet *stack;
|
||||||
@@ -248,7 +253,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
* waiting to be resumed. In those cases, use input and increment pc. We
|
* waiting to be resumed. In those cases, use input and increment pc. We
|
||||||
* DO NOT use input when resuming a fiber that has been interrupted at a
|
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||||
* breakpoint. */
|
* breakpoint. */
|
||||||
if (janet_fiber_status(fiber) != JANET_STATUS_NEW &&
|
if (status != JANET_STATUS_NEW &&
|
||||||
((*pc & 0xFF) == JOP_SIGNAL || (*pc & 0xFF) == JOP_RESUME)) {
|
((*pc & 0xFF) == JOP_SIGNAL || (*pc & 0xFF) == JOP_RESUME)) {
|
||||||
stack[A] = in;
|
stack[A] = in;
|
||||||
pc++;
|
pc++;
|
||||||
@@ -257,9 +262,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
/* The first opcode to execute. If the first opcode has
|
/* The first opcode to execute. If the first opcode has
|
||||||
* the breakpoint bit set and we were in the debug state, skip
|
* the breakpoint bit set and we were in the debug state, skip
|
||||||
* that first breakpoint. */
|
* that first breakpoint. */
|
||||||
uint8_t first_opcode = (janet_fiber_status(fiber) == JANET_STATUS_DEBUG)
|
uint8_t first_opcode = (status == JANET_STATUS_DEBUG)
|
||||||
? (*pc & 0x7F)
|
? (*pc & 0x7F)
|
||||||
: (*pc & 0xFF);
|
: (*pc & 0xFF);
|
||||||
|
|
||||||
/* Main interpreter loop. Semantically is a switch on
|
/* Main interpreter loop. Semantically is a switch on
|
||||||
* (*pc & 0xFF) inside of an infinite loop. */
|
* (*pc & 0xFF) inside of an infinite loop. */
|
||||||
@@ -278,21 +283,21 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_assert_types(stack[A], E);
|
vm_assert_types(stack[A], E);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_RETURN)
|
VM_OP(JOP_RETURN) {
|
||||||
{
|
|
||||||
Janet retval = stack[D];
|
Janet retval = stack[D];
|
||||||
|
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, retval);
|
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||||
vm_restore();
|
vm_restore();
|
||||||
stack[A] = retval;
|
stack[A] = retval;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_RETURN_NIL)
|
VM_OP(JOP_RETURN_NIL) {
|
||||||
{
|
|
||||||
Janet retval = janet_wrap_nil();
|
Janet retval = janet_wrap_nil();
|
||||||
|
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, retval);
|
if (entrance_frame) vm_return(JANET_SIGNAL_OK, retval);
|
||||||
vm_restore();
|
vm_restore();
|
||||||
stack[A] = retval;
|
stack[A] = retval;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
@@ -314,37 +319,36 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_binop(*);
|
vm_binop(*);
|
||||||
|
|
||||||
VM_OP(JOP_NUMERIC_LESS_THAN)
|
VM_OP(JOP_NUMERIC_LESS_THAN)
|
||||||
vm_numcomp(<);
|
vm_numcomp( <);
|
||||||
|
|
||||||
VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
|
VM_OP(JOP_NUMERIC_LESS_THAN_EQUAL)
|
||||||
vm_numcomp(<=);
|
vm_numcomp( <=);
|
||||||
|
|
||||||
VM_OP(JOP_NUMERIC_GREATER_THAN)
|
VM_OP(JOP_NUMERIC_GREATER_THAN)
|
||||||
vm_numcomp(>);
|
vm_numcomp( >);
|
||||||
|
|
||||||
VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
|
VM_OP(JOP_NUMERIC_GREATER_THAN_EQUAL)
|
||||||
vm_numcomp(>=);
|
vm_numcomp( >=);
|
||||||
|
|
||||||
VM_OP(JOP_NUMERIC_EQUAL)
|
VM_OP(JOP_NUMERIC_EQUAL)
|
||||||
vm_numcomp(==);
|
vm_numcomp( ==);
|
||||||
|
|
||||||
VM_OP(JOP_DIVIDE_IMMEDIATE)
|
VM_OP(JOP_DIVIDE_IMMEDIATE)
|
||||||
vm_binop_immediate(/);
|
vm_binop_immediate( /);
|
||||||
|
|
||||||
VM_OP(JOP_DIVIDE)
|
VM_OP(JOP_DIVIDE)
|
||||||
vm_binop(/);
|
vm_binop( /);
|
||||||
|
|
||||||
VM_OP(JOP_BAND)
|
VM_OP(JOP_BAND)
|
||||||
vm_bitop(&);
|
vm_bitop(&);
|
||||||
|
|
||||||
VM_OP(JOP_BOR)
|
VM_OP(JOP_BOR)
|
||||||
vm_bitop(|);
|
vm_bitop( |);
|
||||||
|
|
||||||
VM_OP(JOP_BXOR)
|
VM_OP(JOP_BXOR)
|
||||||
vm_bitop(^);
|
vm_bitop(^);
|
||||||
|
|
||||||
VM_OP(JOP_BNOT)
|
VM_OP(JOP_BNOT) {
|
||||||
{
|
|
||||||
Janet op = stack[E];
|
Janet op = stack[E];
|
||||||
vm_assert_type(op, JANET_NUMBER);
|
vm_assert_type(op, JANET_NUMBER);
|
||||||
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
stack[A] = janet_wrap_integer(~janet_unwrap_integer(op));
|
||||||
@@ -352,22 +356,22 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
|
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED)
|
||||||
vm_bitopu(>>);
|
vm_bitopu( >>);
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE)
|
VM_OP(JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE)
|
||||||
vm_bitopu_immediate(>>);
|
vm_bitopu_immediate( >>);
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_RIGHT)
|
VM_OP(JOP_SHIFT_RIGHT)
|
||||||
vm_bitop(>>);
|
vm_bitop( >>);
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE)
|
VM_OP(JOP_SHIFT_RIGHT_IMMEDIATE)
|
||||||
vm_bitop_immediate(>>);
|
vm_bitop_immediate( >>);
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_LEFT)
|
VM_OP(JOP_SHIFT_LEFT)
|
||||||
vm_bitop(<<);
|
vm_bitop( <<);
|
||||||
|
|
||||||
VM_OP(JOP_SHIFT_LEFT_IMMEDIATE)
|
VM_OP(JOP_SHIFT_LEFT_IMMEDIATE)
|
||||||
vm_bitop_immediate(<<);
|
vm_bitop_immediate( <<);
|
||||||
|
|
||||||
VM_OP(JOP_MOVE_NEAR)
|
VM_OP(JOP_MOVE_NEAR)
|
||||||
stack[A] = stack[E];
|
stack[A] = stack[E];
|
||||||
@@ -441,8 +445,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack[A] = janet_wrap_integer(ES);
|
stack[A] = janet_wrap_integer(ES);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_LOAD_CONSTANT)
|
VM_OP(JOP_LOAD_CONSTANT) {
|
||||||
{
|
|
||||||
int32_t cindex = (int32_t)E;
|
int32_t cindex = (int32_t)E;
|
||||||
vm_assert(cindex < func->def->constants_length, "invalid constant");
|
vm_assert(cindex < func->def->constants_length, "invalid constant");
|
||||||
stack[A] = func->def->constants[cindex];
|
stack[A] = func->def->constants[cindex];
|
||||||
@@ -453,8 +456,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack[D] = janet_wrap_function(func);
|
stack[D] = janet_wrap_function(func);
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_LOAD_UPVALUE)
|
VM_OP(JOP_LOAD_UPVALUE) {
|
||||||
{
|
|
||||||
int32_t eindex = B;
|
int32_t eindex = B;
|
||||||
int32_t vindex = C;
|
int32_t vindex = C;
|
||||||
JanetFuncEnv *env;
|
JanetFuncEnv *env;
|
||||||
@@ -471,8 +473,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_SET_UPVALUE)
|
VM_OP(JOP_SET_UPVALUE) {
|
||||||
{
|
|
||||||
int32_t eindex = B;
|
int32_t eindex = B;
|
||||||
int32_t vindex = C;
|
int32_t vindex = C;
|
||||||
JanetFuncEnv *env;
|
JanetFuncEnv *env;
|
||||||
@@ -487,8 +488,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_CLOSURE)
|
VM_OP(JOP_CLOSURE) {
|
||||||
{
|
|
||||||
JanetFuncDef *fd;
|
JanetFuncDef *fd;
|
||||||
JanetFunction *fn;
|
JanetFunction *fn;
|
||||||
int32_t elen;
|
int32_t elen;
|
||||||
@@ -537,8 +537,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_PUSH_ARRAY)
|
VM_OP(JOP_PUSH_ARRAY) {
|
||||||
{
|
|
||||||
const Janet *vals;
|
const Janet *vals;
|
||||||
int32_t len;
|
int32_t len;
|
||||||
if (janet_indexed_view(stack[D], &vals, &len)) {
|
if (janet_indexed_view(stack[D], &vals, &len)) {
|
||||||
@@ -550,8 +549,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_CALL)
|
VM_OP(JOP_CALL) {
|
||||||
{
|
|
||||||
Janet callee = stack[E];
|
Janet callee = stack[E];
|
||||||
if (fiber->stacktop > fiber->maxstack) {
|
if (fiber->stacktop > fiber->maxstack) {
|
||||||
vm_throw("stack overflow");
|
vm_throw("stack overflow");
|
||||||
@@ -568,7 +566,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
if (janet_fiber_funcframe(fiber, func)) {
|
if (janet_fiber_funcframe(fiber, func)) {
|
||||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||||
janet_panicf("%v called with %d argument%s, expected %d",
|
janet_panicf("%v called with %d argument%s, expected %d",
|
||||||
callee, n, n == 1 ? "" : "s", func->def->arity);
|
callee, n, n == 1 ? "" : "s", func->def->arity);
|
||||||
}
|
}
|
||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
pc = func->def->bytecode;
|
pc = func->def->bytecode;
|
||||||
@@ -579,7 +577,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
|
janet_fiber_cframe(fiber, janet_unwrap_cfunction(callee));
|
||||||
Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
|
Janet ret = janet_unwrap_cfunction(callee)(argc, fiber->data + fiber->frame);
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, ret);
|
/*if (fiber->frame == 0) vm_return(JANET_SIGNAL_OK, ret);*/
|
||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
stack[A] = ret;
|
stack[A] = ret;
|
||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
@@ -590,8 +588,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_TAILCALL)
|
VM_OP(JOP_TAILCALL) {
|
||||||
{
|
|
||||||
Janet callee = stack[D];
|
Janet callee = stack[D];
|
||||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||||
vm_commit();
|
vm_commit();
|
||||||
@@ -605,13 +602,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||||
janet_panicf("%v called with %d argument%s, expected %d",
|
janet_panicf("%v called with %d argument%s, expected %d",
|
||||||
callee, n, n == 1 ? "" : "s", func->def->arity);
|
callee, n, n == 1 ? "" : "s", func->def->arity);
|
||||||
}
|
}
|
||||||
stack = fiber->data + fiber->frame;
|
stack = fiber->data + fiber->frame;
|
||||||
pc = func->def->bytecode;
|
pc = func->def->bytecode;
|
||||||
vm_checkgc_next();
|
vm_checkgc_next();
|
||||||
} else {
|
} else {
|
||||||
Janet retreg;
|
Janet retreg;
|
||||||
|
int entrance_frame = janet_stack_frame(stack)->flags & JANET_STACKFRAME_ENTRANCE;
|
||||||
vm_commit();
|
vm_commit();
|
||||||
if (janet_checktype(callee, JANET_CFUNCTION)) {
|
if (janet_checktype(callee, JANET_CFUNCTION)) {
|
||||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||||
@@ -622,7 +620,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
retreg = call_nonfn(fiber, callee);
|
retreg = call_nonfn(fiber, callee);
|
||||||
}
|
}
|
||||||
janet_fiber_popframe(fiber);
|
janet_fiber_popframe(fiber);
|
||||||
if (fiber->frame == 0)
|
if (entrance_frame)
|
||||||
vm_return(JANET_SIGNAL_OK, retreg);
|
vm_return(JANET_SIGNAL_OK, retreg);
|
||||||
vm_restore();
|
vm_restore();
|
||||||
stack[A] = retreg;
|
stack[A] = retreg;
|
||||||
@@ -630,8 +628,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_RESUME)
|
VM_OP(JOP_RESUME) {
|
||||||
{
|
|
||||||
Janet retreg;
|
Janet retreg;
|
||||||
vm_assert_type(stack[B], JANET_FIBER);
|
vm_assert_type(stack[B], JANET_FIBER);
|
||||||
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
JanetFiber *child = janet_unwrap_fiber(stack[B]);
|
||||||
@@ -644,8 +641,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_SIGNAL)
|
VM_OP(JOP_SIGNAL) {
|
||||||
{
|
|
||||||
int32_t s = C;
|
int32_t s = C;
|
||||||
if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
|
if (s > JANET_SIGNAL_USER9) s = JANET_SIGNAL_USER9;
|
||||||
if (s < 0) s = 0;
|
if (s < 0) s = 0;
|
||||||
@@ -677,8 +673,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_ARRAY)
|
VM_OP(JOP_MAKE_ARRAY) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
stack[D] = janet_wrap_array(janet_array_n(mem, count));
|
stack[D] = janet_wrap_array(janet_array_n(mem, count));
|
||||||
@@ -686,8 +681,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_TUPLE)
|
VM_OP(JOP_MAKE_TUPLE) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count));
|
stack[D] = janet_wrap_tuple(janet_tuple_n(mem, count));
|
||||||
@@ -695,8 +689,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_TABLE)
|
VM_OP(JOP_MAKE_TABLE) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1)
|
||||||
@@ -709,8 +702,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_STRUCT)
|
VM_OP(JOP_MAKE_STRUCT) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
if (count & 1)
|
if (count & 1)
|
||||||
@@ -723,8 +715,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_STRING)
|
VM_OP(JOP_MAKE_STRING) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
JanetBuffer buffer;
|
JanetBuffer buffer;
|
||||||
@@ -737,8 +728,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
vm_checkgc_pcnext();
|
vm_checkgc_pcnext();
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_BUFFER)
|
VM_OP(JOP_MAKE_BUFFER) {
|
||||||
{
|
|
||||||
int32_t count = fiber->stacktop - fiber->stackstart;
|
int32_t count = fiber->stacktop - fiber->stackstart;
|
||||||
Janet *mem = fiber->data + fiber->stackstart;
|
Janet *mem = fiber->data + fiber->stackstart;
|
||||||
JanetBuffer *buffer = janet_buffer(10 * count);
|
JanetBuffer *buffer = janet_buffer(10 * count);
|
||||||
@@ -752,19 +742,57 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
|||||||
VM_END()
|
VM_END()
|
||||||
}
|
}
|
||||||
|
|
||||||
|
Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||||
|
Janet ret;
|
||||||
|
Janet *old_return_reg = janet_vm_return_reg;
|
||||||
|
|
||||||
|
/* Check entry conditions */
|
||||||
|
if (!janet_vm_fiber)
|
||||||
|
janet_panic("janet_call failed because there is no current fiber");
|
||||||
|
if (janet_vm_stackn >= JANET_RECURSION_GUARD)
|
||||||
|
janet_panic("C stack recursed too deeply");
|
||||||
|
|
||||||
|
/* Push frame */
|
||||||
|
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||||
|
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||||
|
janet_panicf("arity mismatch in %v", fun);
|
||||||
|
}
|
||||||
|
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||||
|
|
||||||
|
/* Set up */
|
||||||
|
int32_t oldn = janet_vm_stackn++;
|
||||||
|
int handle = janet_gclock();
|
||||||
|
janet_vm_return_reg = &ret;
|
||||||
|
|
||||||
|
/* Run vm */
|
||||||
|
JanetSignal signal = run_vm(janet_vm_fiber,
|
||||||
|
janet_wrap_nil(),
|
||||||
|
JANET_STATUS_ALIVE);
|
||||||
|
|
||||||
|
/* Teardown */
|
||||||
|
janet_vm_return_reg = old_return_reg;
|
||||||
|
janet_vm_stackn = oldn;
|
||||||
|
janet_gcunlock(handle);
|
||||||
|
|
||||||
|
if (signal != JANET_SIGNAL_OK) janet_panicv(ret);
|
||||||
|
|
||||||
|
return ret;
|
||||||
|
}
|
||||||
|
|
||||||
/* Enter the main vm loop */
|
/* Enter the main vm loop */
|
||||||
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
||||||
|
jmp_buf buf;
|
||||||
|
|
||||||
/* Check conditions */
|
/* Check conditions */
|
||||||
|
JanetFiberStatus old_status = janet_fiber_status(fiber);
|
||||||
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
if (janet_vm_stackn >= JANET_RECURSION_GUARD) {
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||||
*out = janet_cstringv("C stack recursed too deeply");
|
*out = janet_cstringv("C stack recursed too deeply");
|
||||||
return JANET_SIGNAL_ERROR;
|
return JANET_SIGNAL_ERROR;
|
||||||
}
|
}
|
||||||
JanetFiberStatus startstatus = janet_fiber_status(fiber);
|
if (old_status == JANET_STATUS_ALIVE ||
|
||||||
if (startstatus == JANET_STATUS_ALIVE ||
|
old_status == JANET_STATUS_DEAD ||
|
||||||
startstatus == JANET_STATUS_DEAD ||
|
old_status == JANET_STATUS_ERROR) {
|
||||||
startstatus == JANET_STATUS_ERROR) {
|
|
||||||
*out = janet_cstringv("cannot resume alive, dead, or errored fiber");
|
*out = janet_cstringv("cannot resume alive, dead, or errored fiber");
|
||||||
return JANET_SIGNAL_ERROR;
|
return JANET_SIGNAL_ERROR;
|
||||||
}
|
}
|
||||||
@@ -782,40 +810,54 @@ JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out) {
|
|||||||
fiber->child = NULL;
|
fiber->child = NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Prepare state */
|
/* Save global state */
|
||||||
janet_vm_stackn++;
|
int32_t oldn = janet_vm_stackn++;
|
||||||
janet_gcroot(janet_wrap_fiber(fiber));
|
int handle = janet_vm_gc_suspend;
|
||||||
JanetFiber *old_vm_fiber = janet_vm_fiber;
|
JanetFiber *old_vm_fiber = janet_vm_fiber;
|
||||||
|
jmp_buf *old_vm_jmp_buf = janet_vm_jmp_buf;
|
||||||
|
Janet *old_vm_return_reg = janet_vm_return_reg;
|
||||||
|
|
||||||
|
/* Setup fiber */
|
||||||
janet_vm_fiber = fiber;
|
janet_vm_fiber = fiber;
|
||||||
|
janet_gcroot(janet_wrap_fiber(fiber));
|
||||||
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
janet_fiber_set_status(fiber, JANET_STATUS_ALIVE);
|
||||||
|
janet_vm_return_reg = out;
|
||||||
|
janet_vm_jmp_buf = &buf;
|
||||||
|
|
||||||
/* Run loop */
|
/* Run loop */
|
||||||
JanetSignal signal;
|
JanetSignal signal;
|
||||||
if (setjmp(fiber->buf)) {
|
if (setjmp(buf)) {
|
||||||
signal = JANET_SIGNAL_ERROR;
|
signal = JANET_SIGNAL_ERROR;
|
||||||
} else {
|
} else {
|
||||||
signal = run_vm(fiber, in);
|
signal = run_vm(fiber, in, old_status);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Tear down */
|
/* Tear down fiber */
|
||||||
janet_fiber_set_status(fiber, signal);
|
janet_fiber_set_status(fiber, signal);
|
||||||
janet_vm_fiber = old_vm_fiber;
|
|
||||||
janet_vm_stackn--;
|
|
||||||
janet_gcunroot(janet_wrap_fiber(fiber));
|
janet_gcunroot(janet_wrap_fiber(fiber));
|
||||||
|
|
||||||
/* Pop error or return value from fiber stack */
|
/* Restore global state */
|
||||||
*out = fiber->data[--fiber->stacktop];
|
janet_vm_gc_suspend = handle;
|
||||||
|
janet_vm_fiber = old_vm_fiber;
|
||||||
|
janet_vm_stackn = oldn;
|
||||||
|
janet_vm_return_reg = old_vm_return_reg;
|
||||||
|
janet_vm_jmp_buf = old_vm_jmp_buf;
|
||||||
|
|
||||||
return signal;
|
return signal;
|
||||||
}
|
}
|
||||||
|
|
||||||
JanetSignal janet_call(
|
JanetSignal janet_pcall(
|
||||||
JanetFunction *fun,
|
JanetFunction *fun,
|
||||||
int32_t argn,
|
int32_t argc,
|
||||||
const Janet *argv,
|
const Janet *argv,
|
||||||
Janet *out,
|
Janet *out,
|
||||||
JanetFiber **f) {
|
JanetFiber **f) {
|
||||||
JanetFiber *fiber = janet_fiber_n(fun, 64, argv, argn);
|
JanetFiber *fiber;
|
||||||
|
if (f && *f) {
|
||||||
|
fiber = janet_fiber_reset(*f, fun, argc, argv);
|
||||||
|
} else {
|
||||||
|
fiber = janet_fiber(fun, 64, argc, argv);
|
||||||
|
}
|
||||||
if (f) *f = fiber;
|
if (f) *f = fiber;
|
||||||
if (!fiber) {
|
if (!fiber) {
|
||||||
*out = janet_cstringv("arity mismatch");
|
*out = janet_cstringv("arity mismatch");
|
||||||
|
|||||||
@@ -20,11 +20,16 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#ifndef JANET_AMALG
|
||||||
|
#include <janet.h>
|
||||||
|
#endif
|
||||||
|
|
||||||
void *janet_memalloc_empty(int32_t count) {
|
void *janet_memalloc_empty(int32_t count) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
void *mem = malloc(count * sizeof(JanetKV));
|
void *mem = malloc(count * sizeof(JanetKV));
|
||||||
|
if (NULL == mem) {
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
JanetKV *mmem = (JanetKV *)mem;
|
JanetKV *mmem = (JanetKV *)mem;
|
||||||
for (i = 0; i < count; i++) {
|
for (i = 0; i < count; i++) {
|
||||||
JanetKV *kv = mmem + i;
|
JanetKV *kv = mmem + i;
|
||||||
@@ -120,22 +125,22 @@ Janet janet_wrap_nil() {
|
|||||||
|
|
||||||
Janet janet_wrap_true(void) {
|
Janet janet_wrap_true(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_TRUE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 1;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_false(void) {
|
Janet janet_wrap_false(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = 0;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_boolean(int x) {
|
Janet janet_wrap_boolean(int x) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = x ? JANET_TRUE : JANET_FALSE;
|
y.type = JANET_BOOLEAN;
|
||||||
y.as.u64 = 0;
|
y.as.u64 = !!x;
|
||||||
return y;
|
return y;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -161,6 +166,7 @@ JANET_WRAP_DEFINE(function, JanetFunction *, JANET_FUNCTION, pointer)
|
|||||||
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
JANET_WRAP_DEFINE(cfunction, JanetCFunction, JANET_CFUNCTION, pointer)
|
||||||
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
JANET_WRAP_DEFINE(table, JanetTable *, JANET_TABLE, pointer)
|
||||||
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
JANET_WRAP_DEFINE(abstract, void *, JANET_ABSTRACT, pointer)
|
||||||
|
JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||||
|
|
||||||
#undef JANET_WRAP_DEFINE
|
#undef JANET_WRAP_DEFINE
|
||||||
|
|
||||||
|
|||||||
@@ -29,7 +29,7 @@ extern "C" {
|
|||||||
|
|
||||||
/***** START SECTION CONFIG *****/
|
/***** START SECTION CONFIG *****/
|
||||||
|
|
||||||
#define JANET_VERSION "0.3.0"
|
#define JANET_VERSION "0.4.1"
|
||||||
|
|
||||||
#ifndef JANET_BUILD
|
#ifndef JANET_BUILD
|
||||||
#define JANET_BUILD "local"
|
#define JANET_BUILD "local"
|
||||||
@@ -67,7 +67,7 @@ extern "C" {
|
|||||||
/* Check 64-bit vs 32-bit */
|
/* Check 64-bit vs 32-bit */
|
||||||
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
#if ((defined(__x86_64__) || defined(_M_X64)) \
|
||||||
&& (defined(JANET_UNIX) || defined(JANET_WINDOWS))) \
|
&& (defined(JANET_UNIX) || defined(JANET_WINDOWS))) \
|
||||||
|| (defined(_WIN64)) /* Windows 64 bit */ \
|
|| (defined(_WIN64)) /* Windows 64 bit */ \
|
||||||
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|
|| (defined(__ia64__) && defined(__LP64__)) /* Itanium in LP64 mode */ \
|
||||||
|| defined(__alpha__) /* DEC Alpha */ \
|
|| defined(__alpha__) /* DEC Alpha */ \
|
||||||
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|
|| (defined(__sparc__) && defined(__arch64__) || defined (__sparcv9)) /* BE */ \
|
||||||
@@ -123,6 +123,16 @@ extern "C" {
|
|||||||
#define JANET_ASSEMBLER
|
#define JANET_ASSEMBLER
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable the peg module */
|
||||||
|
#ifndef JANET_NO_PEG
|
||||||
|
#define JANET_PEG
|
||||||
|
#endif
|
||||||
|
|
||||||
|
/* Enable or disable the typedarray module */
|
||||||
|
#ifndef JANET_NO_TYPED_ARRAY
|
||||||
|
#define JANET_TYPED_ARRAY
|
||||||
|
#endif
|
||||||
|
|
||||||
/* How to export symbols */
|
/* How to export symbols */
|
||||||
#ifndef JANET_API
|
#ifndef JANET_API
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
@@ -154,9 +164,6 @@ extern "C" {
|
|||||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Helper for debugging */
|
|
||||||
#define janet_trace(x) janet_puts(janet_formatc("JANET TRACE %s, %d: %v\n", __FILE__, __LINE__, x))
|
|
||||||
|
|
||||||
/* Prevent some recursive functions from recursing too deeply
|
/* Prevent some recursive functions from recursing too deeply
|
||||||
* ands crashing (the parser). Instead, error out. */
|
* ands crashing (the parser). Instead, error out. */
|
||||||
#define JANET_RECURSION_GUARD 1024
|
#define JANET_RECURSION_GUARD 1024
|
||||||
@@ -170,7 +177,9 @@ extern "C" {
|
|||||||
/* Define max stack size for stacks before raising a stack overflow error.
|
/* Define max stack size for stacks before raising a stack overflow error.
|
||||||
* If this is not defined, fiber stacks can grow without limit (until memory
|
* If this is not defined, fiber stacks can grow without limit (until memory
|
||||||
* runs out) */
|
* runs out) */
|
||||||
#define JANET_STACK_MAX 8192
|
#ifndef JANET_STACK_MAX
|
||||||
|
#define JANET_STACK_MAX 16384
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
||||||
* To turn of nanboxing, for debugging purposes or for certain
|
* To turn of nanboxing, for debugging purposes or for certain
|
||||||
@@ -202,6 +211,7 @@ extern "C" {
|
|||||||
#include <stdlib.h>
|
#include <stdlib.h>
|
||||||
#include <stdarg.h>
|
#include <stdarg.h>
|
||||||
#include <setjmp.h>
|
#include <setjmp.h>
|
||||||
|
#include <stddef.h>
|
||||||
|
|
||||||
/* Names of all of the types */
|
/* Names of all of the types */
|
||||||
extern const char *const janet_type_names[16];
|
extern const char *const janet_type_names[16];
|
||||||
@@ -254,34 +264,42 @@ typedef union Janet Janet;
|
|||||||
typedef struct Janet Janet;
|
typedef struct Janet Janet;
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* All of the janet types */
|
/* Use type punning for GC objects */
|
||||||
|
typedef struct JanetGCObject JanetGCObject;
|
||||||
|
|
||||||
|
/* All of the primary Janet GCed types */
|
||||||
typedef struct JanetFunction JanetFunction;
|
typedef struct JanetFunction JanetFunction;
|
||||||
typedef struct JanetArray JanetArray;
|
typedef struct JanetArray JanetArray;
|
||||||
typedef struct JanetBuffer JanetBuffer;
|
typedef struct JanetBuffer JanetBuffer;
|
||||||
typedef struct JanetTable JanetTable;
|
typedef struct JanetTable JanetTable;
|
||||||
typedef struct JanetFiber JanetFiber;
|
typedef struct JanetFiber JanetFiber;
|
||||||
|
|
||||||
|
/* Prefixed Janet types */
|
||||||
|
typedef struct JanetTupleHead JanetTupleHead;
|
||||||
|
typedef struct JanetStructHead JanetStructHead;
|
||||||
|
typedef struct JanetStringHead JanetStringHead;
|
||||||
|
typedef struct JanetAbstractHead JanetAbstractHead;
|
||||||
|
|
||||||
/* Other structs */
|
/* Other structs */
|
||||||
typedef struct JanetAbstractHeader JanetAbstractHeader;
|
|
||||||
typedef struct JanetFuncDef JanetFuncDef;
|
typedef struct JanetFuncDef JanetFuncDef;
|
||||||
typedef struct JanetFuncEnv JanetFuncEnv;
|
typedef struct JanetFuncEnv JanetFuncEnv;
|
||||||
typedef struct JanetKV JanetKV;
|
typedef struct JanetKV JanetKV;
|
||||||
typedef struct JanetStackFrame JanetStackFrame;
|
typedef struct JanetStackFrame JanetStackFrame;
|
||||||
typedef struct JanetAbstractType JanetAbstractType;
|
typedef struct JanetAbstractType JanetAbstractType;
|
||||||
typedef struct JanetReg JanetReg;
|
typedef struct JanetReg JanetReg;
|
||||||
|
typedef struct JanetMethod JanetMethod;
|
||||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||||
typedef struct JanetView JanetView;
|
typedef struct JanetView JanetView;
|
||||||
typedef struct JanetByteView JanetByteView;
|
typedef struct JanetByteView JanetByteView;
|
||||||
typedef struct JanetDictView JanetDictView;
|
typedef struct JanetDictView JanetDictView;
|
||||||
typedef struct JanetRange JanetRange;
|
typedef struct JanetRange JanetRange;
|
||||||
typedef Janet (*JanetCFunction)(int32_t argc, Janet *argv);
|
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||||
|
|
||||||
/* Basic types for all Janet Values */
|
/* Basic types for all Janet Values */
|
||||||
typedef enum JanetType {
|
typedef enum JanetType {
|
||||||
JANET_NUMBER,
|
JANET_NUMBER,
|
||||||
JANET_NIL,
|
JANET_NIL,
|
||||||
JANET_FALSE,
|
JANET_BOOLEAN,
|
||||||
JANET_TRUE,
|
|
||||||
JANET_FIBER,
|
JANET_FIBER,
|
||||||
JANET_STRING,
|
JANET_STRING,
|
||||||
JANET_SYMBOL,
|
JANET_SYMBOL,
|
||||||
@@ -293,15 +311,15 @@ typedef enum JanetType {
|
|||||||
JANET_BUFFER,
|
JANET_BUFFER,
|
||||||
JANET_FUNCTION,
|
JANET_FUNCTION,
|
||||||
JANET_CFUNCTION,
|
JANET_CFUNCTION,
|
||||||
JANET_ABSTRACT
|
JANET_ABSTRACT,
|
||||||
|
JANET_POINTER
|
||||||
} JanetType;
|
} JanetType;
|
||||||
|
|
||||||
#define JANET_COUNT_TYPES (JANET_ABSTRACT + 1)
|
#define JANET_COUNT_TYPES (JANET_POINTER + 1)
|
||||||
|
|
||||||
/* Type flags */
|
/* Type flags */
|
||||||
#define JANET_TFLAG_NIL (1 << JANET_NIL)
|
#define JANET_TFLAG_NIL (1 << JANET_NIL)
|
||||||
#define JANET_TFLAG_FALSE (1 << JANET_FALSE)
|
#define JANET_TFLAG_BOOLEAN (1 << JANET_BOOLEAN)
|
||||||
#define JANET_TFLAG_TRUE (1 << JANET_TRUE)
|
|
||||||
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
||||||
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
||||||
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
||||||
@@ -315,9 +333,9 @@ typedef enum JanetType {
|
|||||||
#define JANET_TFLAG_FUNCTION (1 << JANET_FUNCTION)
|
#define JANET_TFLAG_FUNCTION (1 << JANET_FUNCTION)
|
||||||
#define JANET_TFLAG_CFUNCTION (1 << JANET_CFUNCTION)
|
#define JANET_TFLAG_CFUNCTION (1 << JANET_CFUNCTION)
|
||||||
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
||||||
|
#define JANET_TFLAG_POINTER (1 << JANET_POINTER)
|
||||||
|
|
||||||
/* Some abstractions */
|
/* Some abstractions */
|
||||||
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
|
|
||||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||||
@@ -384,7 +402,8 @@ JANET_API Janet janet_nanbox_from_double(double d);
|
|||||||
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||||
|
|
||||||
#define janet_truthy(x) \
|
#define janet_truthy(x) \
|
||||||
(!(janet_checktype((x), JANET_NIL) || janet_checktype((x), JANET_FALSE)))
|
(!janet_checktype((x), JANET_NIL) && \
|
||||||
|
(!janet_checktype((x), JANET_BOOLEAN) || ((x).u64 & 0x1)))
|
||||||
|
|
||||||
#define janet_nanbox_from_payload(t, p) \
|
#define janet_nanbox_from_payload(t, p) \
|
||||||
janet_nanbox_from_bits(janet_nanbox_tag(t) | (p))
|
janet_nanbox_from_bits(janet_nanbox_tag(t) | (p))
|
||||||
@@ -397,14 +416,13 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
|||||||
|
|
||||||
/* Wrap the simple types */
|
/* Wrap the simple types */
|
||||||
#define janet_wrap_nil() janet_nanbox_from_payload(JANET_NIL, 1)
|
#define janet_wrap_nil() janet_nanbox_from_payload(JANET_NIL, 1)
|
||||||
#define janet_wrap_true() janet_nanbox_from_payload(JANET_TRUE, 1)
|
#define janet_wrap_true() janet_nanbox_from_payload(JANET_BOOLEAN, 1)
|
||||||
#define janet_wrap_false() janet_nanbox_from_payload(JANET_FALSE, 1)
|
#define janet_wrap_false() janet_nanbox_from_payload(JANET_BOOLEAN, 0)
|
||||||
#define janet_wrap_boolean(b) janet_nanbox_from_payload((b) ? JANET_TRUE : JANET_FALSE, 1)
|
#define janet_wrap_boolean(b) janet_nanbox_from_payload(JANET_BOOLEAN, !!(b))
|
||||||
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
||||||
|
|
||||||
/* Unwrap the simple types */
|
/* Unwrap the simple types */
|
||||||
#define janet_unwrap_boolean(x) \
|
#define janet_unwrap_boolean(x) ((x).u64 & 0x1)
|
||||||
(janet_checktype(x, JANET_TRUE))
|
|
||||||
#define janet_unwrap_number(x) ((x).number)
|
#define janet_unwrap_number(x) ((x).number)
|
||||||
|
|
||||||
/* Wrap the pointer types */
|
/* Wrap the pointer types */
|
||||||
@@ -420,6 +438,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
|||||||
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
#define janet_wrap_abstract(s) janet_nanbox_wrap_((s), JANET_ABSTRACT)
|
||||||
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
#define janet_wrap_function(s) janet_nanbox_wrap_((s), JANET_FUNCTION)
|
||||||
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
#define janet_wrap_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
||||||
|
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
|
||||||
|
|
||||||
/* Unwrap the pointer types */
|
/* Unwrap the pointer types */
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
|
||||||
@@ -466,16 +485,17 @@ union Janet {
|
|||||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||||
: (x).tagged.type == (t))
|
: (x).tagged.type == (t))
|
||||||
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
|
#define janet_truthy(x) \
|
||||||
|
((x).tagged.type != JANET_NIL && ((x).tagged.type != JANET_BOOLEAN || ((x).tagged.payload.integer & 0x1)))
|
||||||
|
|
||||||
JANET_API Janet janet_wrap_number(double x);
|
JANET_API Janet janet_wrap_number(double x);
|
||||||
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
||||||
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||||
|
|
||||||
#define janet_wrap_nil() janet_nanbox32_from_tagi(JANET_NIL, 0)
|
#define janet_wrap_nil() janet_nanbox32_from_tagi(JANET_NIL, 0)
|
||||||
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_TRUE, 0)
|
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_BOOLEAN, 1)
|
||||||
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_FALSE, 0)
|
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_BOOLEAN, 0)
|
||||||
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi((b) ? JANET_TRUE : JANET_FALSE, 0)
|
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi(JANET_BOOLEAN, !!(b))
|
||||||
|
|
||||||
/* Wrap the pointer types */
|
/* Wrap the pointer types */
|
||||||
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
||||||
@@ -490,6 +510,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||||||
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
#define janet_wrap_abstract(s) janet_nanbox32_from_tagp(JANET_ABSTRACT, (void *)(s))
|
||||||
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
#define janet_wrap_function(s) janet_nanbox32_from_tagp(JANET_FUNCTION, (void *)(s))
|
||||||
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||||
|
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
|
||||||
|
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
|
||||||
@@ -504,7 +525,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
|||||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||||
#define janet_unwrap_boolean(x) ((x).tagged.type == JANET_TRUE)
|
#define janet_unwrap_boolean(x) ((x).tagged.payload.integer)
|
||||||
JANET_API double janet_unwrap_number(Janet x);
|
JANET_API double janet_unwrap_number(Janet x);
|
||||||
|
|
||||||
#else
|
#else
|
||||||
@@ -525,7 +546,7 @@ struct Janet {
|
|||||||
#define janet_type(x) ((x).type)
|
#define janet_type(x) ((x).type)
|
||||||
#define janet_checktype(x, t) ((x).type == (t))
|
#define janet_checktype(x, t) ((x).type == (t))
|
||||||
#define janet_truthy(x) \
|
#define janet_truthy(x) \
|
||||||
((x).type != JANET_NIL && (x).type != JANET_FALSE)
|
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.integer & 0x1)))
|
||||||
|
|
||||||
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
|
||||||
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
|
||||||
@@ -540,7 +561,7 @@ struct Janet {
|
|||||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
||||||
#define janet_unwrap_boolean(x) ((x).type == JANET_TRUE)
|
#define janet_unwrap_boolean(x) ((x).as.u64 & 0x1)
|
||||||
#define janet_unwrap_number(x) ((x).as.number)
|
#define janet_unwrap_number(x) ((x).as.number)
|
||||||
|
|
||||||
JANET_API Janet janet_wrap_nil(void);
|
JANET_API Janet janet_wrap_nil(void);
|
||||||
@@ -560,12 +581,14 @@ JANET_API Janet janet_wrap_function(JanetFunction *x);
|
|||||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||||
JANET_API Janet janet_wrap_abstract(void *x);
|
JANET_API Janet janet_wrap_abstract(void *x);
|
||||||
|
JANET_API Janet janet_wrap_pointer(void *x);
|
||||||
|
|
||||||
/* End of tagged union implementation */
|
/* End of tagged union implementation */
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
JANET_API int janet_checkint(Janet x);
|
JANET_API int janet_checkint(Janet x);
|
||||||
JANET_API int janet_checkint64(Janet x);
|
JANET_API int janet_checkint64(Janet x);
|
||||||
|
JANET_API int janet_checksize(Janet x);
|
||||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||||
@@ -573,6 +596,14 @@ JANET_API int janet_checkint64(Janet x);
|
|||||||
|
|
||||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||||
|
|
||||||
|
/* GC Object type pun. The lower 16 bits of flags are reserved for the garbage collector,
|
||||||
|
* but the upper 16 can be used per type for custom flags. The current collector is a linked
|
||||||
|
* list of blocks, which is naive but works. */
|
||||||
|
struct JanetGCObject {
|
||||||
|
int32_t flags;
|
||||||
|
JanetGCObject *next;
|
||||||
|
};
|
||||||
|
|
||||||
/* Fiber signal masks. */
|
/* Fiber signal masks. */
|
||||||
#define JANET_FIBER_MASK_ERROR 2
|
#define JANET_FIBER_MASK_ERROR 2
|
||||||
#define JANET_FIBER_MASK_DEBUG 4
|
#define JANET_FIBER_MASK_DEBUG 4
|
||||||
@@ -598,20 +629,23 @@ JANET_API int janet_checkint64(Janet x);
|
|||||||
/* A lightweight green thread in janet. Does not correspond to
|
/* A lightweight green thread in janet. Does not correspond to
|
||||||
* operating system threads. */
|
* operating system threads. */
|
||||||
struct JanetFiber {
|
struct JanetFiber {
|
||||||
Janet *data;
|
JanetGCObject gc; /* GC Object stuff */
|
||||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
int32_t flags; /* More flags */
|
||||||
int32_t frame; /* Index of the stack frame */
|
int32_t frame; /* Index of the stack frame */
|
||||||
int32_t stackstart; /* Beginning of next args */
|
int32_t stackstart; /* Beginning of next args */
|
||||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||||
int32_t flags; /* Various flags */
|
Janet *data;
|
||||||
jmp_buf buf; /* Handle errors */
|
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||||
};
|
};
|
||||||
|
|
||||||
/* Mark if a stack frame is a tail call for debugging */
|
/* Mark if a stack frame is a tail call for debugging */
|
||||||
#define JANET_STACKFRAME_TAILCALL 1
|
#define JANET_STACKFRAME_TAILCALL 1
|
||||||
|
|
||||||
|
/* Mark if a stack frame is an entrance frame */
|
||||||
|
#define JANET_STACKFRAME_ENTRANCE 2
|
||||||
|
|
||||||
/* A stack frame on the fiber. Is stored along with the stack values. */
|
/* A stack frame on the fiber. Is stored along with the stack values. */
|
||||||
struct JanetStackFrame {
|
struct JanetStackFrame {
|
||||||
JanetFunction *func;
|
JanetFunction *func;
|
||||||
@@ -626,25 +660,28 @@ struct JanetStackFrame {
|
|||||||
|
|
||||||
/* A dynamic array type. */
|
/* A dynamic array type. */
|
||||||
struct JanetArray {
|
struct JanetArray {
|
||||||
Janet *data;
|
JanetGCObject gc;
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
|
Janet *data;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||||
struct JanetBuffer {
|
struct JanetBuffer {
|
||||||
uint8_t *data;
|
JanetGCObject gc;
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
|
uint8_t *data;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A mutable associative data type. Backed by a hashtable. */
|
/* A mutable associative data type. Backed by a hashtable. */
|
||||||
struct JanetTable {
|
struct JanetTable {
|
||||||
JanetKV *data;
|
JanetGCObject gc;
|
||||||
JanetTable *proto;
|
|
||||||
int32_t count;
|
int32_t count;
|
||||||
int32_t capacity;
|
int32_t capacity;
|
||||||
int32_t deleted;
|
int32_t deleted;
|
||||||
|
JanetKV *data;
|
||||||
|
JanetTable *proto;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A key value pair in a struct or table */
|
/* A key value pair in a struct or table */
|
||||||
@@ -653,10 +690,44 @@ struct JanetKV {
|
|||||||
Janet value;
|
Janet value;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
/* Prefix for a tuple */
|
||||||
|
struct JanetTupleHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
int32_t sm_start;
|
||||||
|
int32_t sm_end;
|
||||||
|
const Janet data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for a struct */
|
||||||
|
struct JanetStructHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
int32_t capacity;
|
||||||
|
const JanetKV data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for a string */
|
||||||
|
struct JanetStringHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
int32_t length;
|
||||||
|
int32_t hash;
|
||||||
|
const uint8_t data[];
|
||||||
|
};
|
||||||
|
|
||||||
|
/* Prefix for an abstract value */
|
||||||
|
struct JanetAbstractHead {
|
||||||
|
JanetGCObject gc;
|
||||||
|
const JanetAbstractType *type;
|
||||||
|
size_t size;
|
||||||
|
long long data[]; /* Use long long to ensure most general alignment */
|
||||||
|
};
|
||||||
|
|
||||||
/* Some function definition flags */
|
/* Some function definition flags */
|
||||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||||
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
|
|
||||||
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
#define JANET_FUNCDEF_FLAG_HASNAME 0x80000
|
||||||
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
#define JANET_FUNCDEF_FLAG_HASSOURCE 0x100000
|
||||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||||
@@ -672,6 +743,7 @@ struct JanetSourceMapping {
|
|||||||
|
|
||||||
/* A function definition. Contains information needed to instantiate closures. */
|
/* A function definition. Contains information needed to instantiate closures. */
|
||||||
struct JanetFuncDef {
|
struct JanetFuncDef {
|
||||||
|
JanetGCObject gc;
|
||||||
int32_t *environments; /* Which environments to capture from parent. */
|
int32_t *environments; /* Which environments to capture from parent. */
|
||||||
Janet *constants;
|
Janet *constants;
|
||||||
JanetFuncDef **defs;
|
JanetFuncDef **defs;
|
||||||
@@ -685,6 +757,8 @@ struct JanetFuncDef {
|
|||||||
int32_t flags;
|
int32_t flags;
|
||||||
int32_t slotcount; /* The amount of stack space required for the function */
|
int32_t slotcount; /* The amount of stack space required for the function */
|
||||||
int32_t arity; /* Not including varargs */
|
int32_t arity; /* Not including varargs */
|
||||||
|
int32_t min_arity; /* Including varargs */
|
||||||
|
int32_t max_arity; /* Including varargs */
|
||||||
int32_t constants_length;
|
int32_t constants_length;
|
||||||
int32_t bytecode_length;
|
int32_t bytecode_length;
|
||||||
int32_t environments_length;
|
int32_t environments_length;
|
||||||
@@ -693,6 +767,7 @@ struct JanetFuncDef {
|
|||||||
|
|
||||||
/* A function environment */
|
/* A function environment */
|
||||||
struct JanetFuncEnv {
|
struct JanetFuncEnv {
|
||||||
|
JanetGCObject gc;
|
||||||
union {
|
union {
|
||||||
JanetFiber *fiber;
|
JanetFiber *fiber;
|
||||||
Janet *values;
|
Janet *values;
|
||||||
@@ -704,6 +779,7 @@ struct JanetFuncEnv {
|
|||||||
|
|
||||||
/* A function */
|
/* A function */
|
||||||
struct JanetFunction {
|
struct JanetFunction {
|
||||||
|
JanetGCObject gc;
|
||||||
JanetFuncDef *def;
|
JanetFuncDef *def;
|
||||||
JanetFuncEnv *envs[];
|
JanetFuncEnv *envs[];
|
||||||
};
|
};
|
||||||
@@ -714,12 +790,13 @@ typedef struct JanetParser JanetParser;
|
|||||||
enum JanetParserStatus {
|
enum JanetParserStatus {
|
||||||
JANET_PARSE_ROOT,
|
JANET_PARSE_ROOT,
|
||||||
JANET_PARSE_ERROR,
|
JANET_PARSE_ERROR,
|
||||||
JANET_PARSE_PENDING
|
JANET_PARSE_PENDING,
|
||||||
|
JANET_PARSE_DEAD
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A janet parser */
|
/* A janet parser */
|
||||||
struct JanetParser {
|
struct JanetParser {
|
||||||
Janet* args;
|
Janet *args;
|
||||||
const char *error;
|
const char *error;
|
||||||
JanetParseState *states;
|
JanetParseState *states;
|
||||||
uint8_t *buf;
|
uint8_t *buf;
|
||||||
@@ -732,19 +809,25 @@ struct JanetParser {
|
|||||||
size_t offset;
|
size_t offset;
|
||||||
size_t pending;
|
size_t pending;
|
||||||
int lookback;
|
int lookback;
|
||||||
|
int flag;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
void *m_state; /* void* to not expose MarshalState ?*/
|
||||||
|
void *u_state;
|
||||||
|
int flags;
|
||||||
|
const uint8_t *data;
|
||||||
|
} JanetMarshalContext;
|
||||||
|
|
||||||
/* Defines an abstract type */
|
/* Defines an abstract type */
|
||||||
struct JanetAbstractType {
|
struct JanetAbstractType {
|
||||||
const char *name;
|
const char *name;
|
||||||
int (*gc)(void *data, size_t len);
|
int (*gc)(void *data, size_t len);
|
||||||
int (*gcmark)(void *data, size_t len);
|
int (*gcmark)(void *data, size_t len);
|
||||||
};
|
Janet(*get)(void *data, Janet key);
|
||||||
|
void (*put)(void *data, Janet key, Janet value);
|
||||||
/* Contains information about abstract types */
|
void (*marshal)(void *p, JanetMarshalContext *ctx);
|
||||||
struct JanetAbstractHeader {
|
void (*unmarshal)(void *p, JanetMarshalContext *ctx);
|
||||||
const JanetAbstractType *type;
|
|
||||||
size_t size;
|
|
||||||
};
|
};
|
||||||
|
|
||||||
struct JanetReg {
|
struct JanetReg {
|
||||||
@@ -753,6 +836,11 @@ struct JanetReg {
|
|||||||
const char *documentation;
|
const char *documentation;
|
||||||
};
|
};
|
||||||
|
|
||||||
|
struct JanetMethod {
|
||||||
|
const char *name;
|
||||||
|
JanetCFunction cfun;
|
||||||
|
};
|
||||||
|
|
||||||
struct JanetView {
|
struct JanetView {
|
||||||
const Janet *items;
|
const Janet *items;
|
||||||
int32_t len;
|
int32_t len;
|
||||||
@@ -890,12 +978,12 @@ extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
|||||||
/* Parsing */
|
/* Parsing */
|
||||||
JANET_API void janet_parser_init(JanetParser *parser);
|
JANET_API void janet_parser_init(JanetParser *parser);
|
||||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||||
JANET_API int janet_parser_consume(JanetParser *parser, uint8_t c);
|
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||||
JANET_API JanetParser *janet_check_parser(Janet x);
|
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||||
#define janet_parser_has_more(P) ((P)->pending)
|
#define janet_parser_has_more(P) ((P)->pending)
|
||||||
|
|
||||||
/* Assembly */
|
/* Assembly */
|
||||||
@@ -931,7 +1019,7 @@ struct JanetCompileResult {
|
|||||||
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *where);
|
||||||
|
|
||||||
/* Get the default environment for janet */
|
/* Get the default environment for janet */
|
||||||
JANET_API JanetTable *janet_core_env(void);
|
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||||
|
|
||||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||||
@@ -943,8 +1031,8 @@ JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
|||||||
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||||
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||||
JANET_API void janet_debug_find(
|
JANET_API void janet_debug_find(
|
||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t offset);
|
const uint8_t *source, int32_t offset);
|
||||||
|
|
||||||
/* Array functions */
|
/* Array functions */
|
||||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||||
@@ -973,11 +1061,15 @@ JANET_API void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x);
|
|||||||
JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||||
|
|
||||||
/* Tuple */
|
/* Tuple */
|
||||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 4)
|
|
||||||
#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
|
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
|
||||||
#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
|
|
||||||
#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
|
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||||
#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
|
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||||
|
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||||
|
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
|
||||||
|
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
|
||||||
|
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||||
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
||||||
@@ -985,9 +1077,9 @@ JANET_API int janet_tuple_equal(const Janet *lhs, const Janet *rhs);
|
|||||||
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
JANET_API int janet_tuple_compare(const Janet *lhs, const Janet *rhs);
|
||||||
|
|
||||||
/* String/Symbol functions */
|
/* String/Symbol functions */
|
||||||
#define janet_string_raw(s) ((int32_t *)(s) - 2)
|
#define janet_string_head(s) ((JanetStringHead *)((char *)s - offsetof(JanetStringHead, data)))
|
||||||
#define janet_string_length(s) (janet_string_raw(s)[0])
|
#define janet_string_length(s) (janet_string_head(s)->length)
|
||||||
#define janet_string_hash(s) ((janet_string_raw(s)[1]))
|
#define janet_string_hash(s) (janet_string_head(s)->hash)
|
||||||
JANET_API uint8_t *janet_string_begin(int32_t length);
|
JANET_API uint8_t *janet_string_begin(int32_t length);
|
||||||
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
JANET_API const uint8_t *janet_string_end(uint8_t *str);
|
||||||
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
JANET_API const uint8_t *janet_string(const uint8_t *buf, int32_t len);
|
||||||
@@ -1002,7 +1094,6 @@ JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
|||||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||||
JANET_API void janet_puts(const uint8_t *str);
|
|
||||||
|
|
||||||
/* Symbol functions */
|
/* Symbol functions */
|
||||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||||
@@ -1018,11 +1109,10 @@ JANET_API const uint8_t *janet_symbol_gen(void);
|
|||||||
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
||||||
|
|
||||||
/* Structs */
|
/* Structs */
|
||||||
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
|
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
|
||||||
#define janet_struct_length(t) (janet_struct_raw(t)[0])
|
#define janet_struct_length(t) (janet_struct_head(t)->length)
|
||||||
#define janet_struct_capacity(t) (janet_struct_raw(t)[1])
|
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
|
||||||
#define janet_struct_hash(t) (janet_struct_raw(t)[2])
|
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
|
||||||
/* Do something with the 4th header slot - flags? */
|
|
||||||
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||||
@@ -1046,8 +1136,8 @@ JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other)
|
|||||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||||
|
|
||||||
/* Fiber */
|
/* Fiber */
|
||||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity);
|
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||||
JANET_API JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn);
|
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||||
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
||||||
|
|
||||||
/* Treat similar types through uniform interfaces for iteration */
|
/* Treat similar types through uniform interfaces for iteration */
|
||||||
@@ -1058,7 +1148,7 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
|
|||||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||||
|
|
||||||
/* Abstract */
|
/* Abstract */
|
||||||
#define janet_abstract_header(u) ((JanetAbstractHeader *)(u) - 1)
|
#define janet_abstract_header(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||||
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
||||||
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
||||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||||
@@ -1068,19 +1158,17 @@ typedef void (*JanetModule)(JanetTable *);
|
|||||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||||
|
|
||||||
/* Marshaling */
|
/* Marshaling */
|
||||||
JANET_API int janet_marshal(
|
JANET_API void janet_marshal(
|
||||||
JanetBuffer *buf,
|
JanetBuffer *buf,
|
||||||
Janet x,
|
Janet x,
|
||||||
Janet *errval,
|
JanetTable *rreg,
|
||||||
JanetTable *rreg,
|
int flags);
|
||||||
int flags);
|
JANET_API Janet janet_unmarshal(
|
||||||
JANET_API int janet_unmarshal(
|
const uint8_t *bytes,
|
||||||
const uint8_t *bytes,
|
size_t len,
|
||||||
size_t len,
|
int flags,
|
||||||
int flags,
|
JanetTable *reg,
|
||||||
Janet *out,
|
const uint8_t **next);
|
||||||
JanetTable *reg,
|
|
||||||
const uint8_t **next);
|
|
||||||
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
||||||
|
|
||||||
/* GC */
|
/* GC */
|
||||||
@@ -1110,14 +1198,14 @@ JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
|||||||
JANET_API int32_t janet_length(Janet x);
|
JANET_API int32_t janet_length(Janet x);
|
||||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||||
JANET_API void janet_inspect(Janet x);
|
|
||||||
|
|
||||||
/* VM functions */
|
/* VM functions */
|
||||||
JANET_API int janet_init(void);
|
JANET_API int janet_init(void);
|
||||||
JANET_API void janet_deinit(void);
|
JANET_API void janet_deinit(void);
|
||||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||||
JANET_API JanetSignal janet_call(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||||
JANET_API void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err);
|
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||||
|
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||||
|
|
||||||
/* C Library helpers */
|
/* C Library helpers */
|
||||||
typedef enum {
|
typedef enum {
|
||||||
@@ -1145,6 +1233,7 @@ JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType
|
|||||||
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
JANET_API void janet_arity(int32_t arity, int32_t min, int32_t max);
|
||||||
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
||||||
|
|
||||||
|
JANET_API Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods);
|
||||||
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
||||||
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
||||||
@@ -1158,14 +1247,73 @@ JANET_API JanetFiber *janet_getfiber(const Janet *argv, int32_t n);
|
|||||||
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
JANET_API JanetFunction *janet_getfunction(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
||||||
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
||||||
|
JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
||||||
|
|
||||||
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
JANET_API int32_t janet_getinteger(const Janet *argv, int32_t n);
|
||||||
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
JANET_API int64_t janet_getinteger64(const Janet *argv, int32_t n);
|
||||||
|
JANET_API size_t janet_getsize(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
JANET_API JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
||||||
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
||||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||||
|
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||||
|
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||||
|
|
||||||
|
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||||
|
|
||||||
|
/* Marshal API */
|
||||||
|
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||||
|
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||||
|
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||||
|
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||||
|
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||||
|
|
||||||
|
JANET_API void janet_unmarshal_int(JanetMarshalContext *ctx, int32_t *i);
|
||||||
|
JANET_API void janet_unmarshal_size(JanetMarshalContext *ctx, size_t *i);
|
||||||
|
JANET_API void janet_unmarshal_byte(JanetMarshalContext *ctx, uint8_t *b);
|
||||||
|
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
|
||||||
|
JANET_API void janet_unmarshal_janet(JanetMarshalContext *ctx, Janet *out);
|
||||||
|
|
||||||
|
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);
|
||||||
|
JANET_API const JanetAbstractType *janet_get_abstract_type(Janet key);
|
||||||
|
|
||||||
|
#ifdef JANET_TYPED_ARRAY
|
||||||
|
|
||||||
|
typedef enum {
|
||||||
|
JANET_TARRAY_TYPE_uint8,
|
||||||
|
JANET_TARRAY_TYPE_int8,
|
||||||
|
JANET_TARRAY_TYPE_uint16,
|
||||||
|
JANET_TARRAY_TYPE_int16,
|
||||||
|
JANET_TARRAY_TYPE_uint32,
|
||||||
|
JANET_TARRAY_TYPE_int32,
|
||||||
|
JANET_TARRAY_TYPE_float32,
|
||||||
|
JANET_TARRAY_TYPE_float64,
|
||||||
|
JANET_TARRAY_TYPE_any,
|
||||||
|
} JanetTArrayType;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
uint8_t *data;
|
||||||
|
size_t size;
|
||||||
|
int32_t flags;
|
||||||
|
} JanetTArrayBuffer;
|
||||||
|
|
||||||
|
typedef struct {
|
||||||
|
JanetTArrayBuffer *buffer;
|
||||||
|
void *data; /* pointer inside buffer->data */
|
||||||
|
size_t size;
|
||||||
|
size_t stride;
|
||||||
|
JanetTArrayType type;
|
||||||
|
} JanetTArrayView;
|
||||||
|
|
||||||
|
JANET_API JanetTArrayBuffer *janet_tarray_buffer(size_t size);
|
||||||
|
JANET_API JanetTArrayView *janet_tarray_view(JanetTArrayType type, size_t size, size_t stride, size_t offset, JanetTArrayBuffer *buffer);
|
||||||
|
JANET_API int janet_is_tarray_view(Janet x, JanetTArrayType type);
|
||||||
|
JANET_API size_t janet_tarray_type_size(JanetTArrayType type);
|
||||||
|
JANET_API JanetTArrayBuffer *janet_gettarray_buffer(const Janet *argv, int32_t n);
|
||||||
|
JANET_API JanetTArrayView *janet_gettarray_view(const Janet *argv, int32_t n, JanetTArrayType type);
|
||||||
|
|
||||||
|
#endif
|
||||||
|
|
||||||
/***** END SECTION MAIN *****/
|
/***** END SECTION MAIN *****/
|
||||||
|
|
||||||
@@ -2,32 +2,50 @@
|
|||||||
|
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(var *should-repl* :private false)
|
(var *should-repl* false)
|
||||||
(var *no-file* :private true)
|
(var *no-file* true)
|
||||||
(var *raw-stdin* :private false)
|
(var *quiet* false)
|
||||||
(var *handleopts* :private true)
|
(var *raw-stdin* false)
|
||||||
(var *exit-on-error* :private true)
|
(var *handleopts* true)
|
||||||
|
(var *exit-on-error* true)
|
||||||
|
|
||||||
|
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
|
||||||
|
|
||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers :private
|
(def handlers :private
|
||||||
{"h" (fn [&]
|
{"h" (fn [&]
|
||||||
(print "usage: " (get process/args 0) " [options] scripts...")
|
(print "usage: " (get process/args 0) " [options] script args...")
|
||||||
(print
|
(print
|
||||||
`Options are:
|
`Options are:
|
||||||
-h Show this help
|
-h : Show this help
|
||||||
-v Print the version string
|
-v : Print the version string
|
||||||
-s Use raw stdin instead of getline like functionality
|
-s : Use raw stdin instead of getline like functionality
|
||||||
-e Execute a string of janet
|
-e code : Execute a string of janet
|
||||||
-r Enter the repl after running all scripts
|
-r : Enter the repl after running all scripts
|
||||||
-p Keep on executing if there is a top level error (persistent)
|
-p : Keep on executing if there is a top level error (persistent)
|
||||||
-- Stop handling options`)
|
-q : Hide prompt, logo, and repl output (quiet)
|
||||||
|
-m syspath : Set system path for loading global modules
|
||||||
|
-c source output : Compile janet source code into an image
|
||||||
|
-l path : Execute code in a file before running the main script
|
||||||
|
-- : Stop handling options`)
|
||||||
(os/exit 0)
|
(os/exit 0)
|
||||||
1)
|
1)
|
||||||
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
||||||
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
||||||
"r" (fn [&] (set *should-repl* true) 1)
|
"r" (fn [&] (set *should-repl* true) 1)
|
||||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||||
|
"q" (fn [&] (set *quiet* true) 1)
|
||||||
|
"m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
|
||||||
|
"c" (fn [i &]
|
||||||
|
(def e (require (get process/args (+ i 1))))
|
||||||
|
(spit (get process/args (+ i 2)) (make-image e))
|
||||||
|
(set *no-file* false)
|
||||||
|
3)
|
||||||
"-" (fn [&] (set *handleopts* false) 1)
|
"-" (fn [&] (set *handleopts* false) 1)
|
||||||
|
"l" (fn [i &]
|
||||||
|
(import* *env* (get process/args (+ i 1))
|
||||||
|
:prefix "" :exit *exit-on-error*)
|
||||||
|
2)
|
||||||
"e" (fn [i &]
|
"e" (fn [i &]
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
(eval-string (get process/args (+ i 1)))
|
(eval-string (get process/args (+ i 1)))
|
||||||
@@ -46,15 +64,23 @@
|
|||||||
(+= i (dohandler (string/slice arg 1 2) i))
|
(+= i (dohandler (string/slice arg 1 2) i))
|
||||||
(do
|
(do
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
(import* _env arg :prefix "" :exit *exit-on-error*)
|
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
||||||
(++ i))))
|
(set i lenargs))))
|
||||||
|
|
||||||
(when (or *should-repl* *no-file*)
|
(when (or *should-repl* *no-file*)
|
||||||
(if *raw-stdin*
|
(if-not *quiet*
|
||||||
(repl nil (fn [x &] x))
|
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
(do
|
(defn noprompt [_] "")
|
||||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
(defn getprompt [p]
|
||||||
(repl (fn [buf p]
|
(def offset (parser/where p))
|
||||||
(def offset (parser/where p))
|
(string "janet:" offset ":" (parser/state p) "> "))
|
||||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
(def prompter (if *quiet* noprompt getprompt))
|
||||||
(getline prompt buf)))))))
|
(defn getstdin [prompt buf]
|
||||||
|
(file/write stdout prompt)
|
||||||
|
(file/flush stdout)
|
||||||
|
(file/read stdin :line buf))
|
||||||
|
(def getter (if *raw-stdin* getstdin getline))
|
||||||
|
(defn getchunk [buf p]
|
||||||
|
(getter (prompter p) buf))
|
||||||
|
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||||
|
(repl getchunk onsig)))
|
||||||
|
|||||||
@@ -24,11 +24,11 @@
|
|||||||
|
|
||||||
/* Common */
|
/* Common */
|
||||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 2);
|
janet_arity(argc, 0, 2);
|
||||||
const uint8_t *str = janet_getstring(argv, 0);
|
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
|
||||||
JanetBuffer *buf = janet_getbuffer(argv, 1);
|
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||||
janet_line_get(str, buf);
|
janet_line_get(str, buf);
|
||||||
return argv[0];
|
return janet_wrap_buffer(buf);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void simpleline(JanetBuffer *buffer) {
|
static void simpleline(JanetBuffer *buffer) {
|
||||||
@@ -55,8 +55,8 @@ void janet_line_deinit() {
|
|||||||
;
|
;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
fputs((const char *)p, stdout);
|
fputs(p, stdout);
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -144,8 +144,8 @@ static int curpos() {
|
|||||||
int cols, rows;
|
int cols, rows;
|
||||||
unsigned int i = 0;
|
unsigned int i = 0;
|
||||||
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
if (write(STDOUT_FILENO, "\x1b[6n", 4) != 4) return -1;
|
||||||
while (i < sizeof(buf)-1) {
|
while (i < sizeof(buf) - 1) {
|
||||||
if (read(STDIN_FILENO, buf+i, 1) != 1) break;
|
if (read(STDIN_FILENO, buf + i, 1) != 1) break;
|
||||||
if (buf[i] == 'R') break;
|
if (buf[i] == 'R') break;
|
||||||
i++;
|
i++;
|
||||||
}
|
}
|
||||||
@@ -166,7 +166,7 @@ static int getcols() {
|
|||||||
if (cols == -1) goto failed;
|
if (cols == -1) goto failed;
|
||||||
if (cols > start) {
|
if (cols > start) {
|
||||||
char seq[32];
|
char seq[32];
|
||||||
snprintf(seq, 32, "\x1b[%dD", cols-start);
|
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
||||||
}
|
}
|
||||||
return cols;
|
return cols;
|
||||||
@@ -178,7 +178,7 @@ failed:
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void clear() {
|
static void clear() {
|
||||||
if (write(STDOUT_FILENO,"\x1b[H\x1b[2J",7) <= 0) {}
|
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void refresh() {
|
static void refresh() {
|
||||||
@@ -206,7 +206,7 @@ static void refresh() {
|
|||||||
/* Erase to right */
|
/* Erase to right */
|
||||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||||
/* Move cursor to original position. */
|
/* Move cursor to original position. */
|
||||||
snprintf(seq, 64,"\r\x1b[%dC", (int)(_pos + plen));
|
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + plen));
|
||||||
janet_buffer_push_cstring(&b, seq);
|
janet_buffer_push_cstring(&b, seq);
|
||||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
||||||
janet_buffer_deinit(&b);
|
janet_buffer_deinit(&b);
|
||||||
@@ -321,103 +321,103 @@ static int line() {
|
|||||||
nread = read(STDIN_FILENO, &c, 1);
|
nread = read(STDIN_FILENO, &c, 1);
|
||||||
if (nread <= 0) return -1;
|
if (nread <= 0) return -1;
|
||||||
|
|
||||||
switch(c) {
|
switch (c) {
|
||||||
default:
|
default:
|
||||||
if (insert(c)) return -1;
|
if (insert(c)) return -1;
|
||||||
break;
|
break;
|
||||||
case 9: /* tab */
|
case 9: /* tab */
|
||||||
if (insert(' ')) return -1;
|
if (insert(' ')) return -1;
|
||||||
if (insert(' ')) return -1;
|
if (insert(' ')) return -1;
|
||||||
break;
|
break;
|
||||||
case 13: /* enter */
|
case 13: /* enter */
|
||||||
return 0;
|
return 0;
|
||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
errno = EAGAIN;
|
errno = EAGAIN;
|
||||||
return -1;
|
return -1;
|
||||||
case 127: /* backspace */
|
case 127: /* backspace */
|
||||||
case 8: /* ctrl-h */
|
case 8: /* ctrl-h */
|
||||||
kbackspace();
|
kbackspace();
|
||||||
break;
|
break;
|
||||||
case 4: /* ctrl-d, eof */
|
case 4: /* ctrl-d, eof */
|
||||||
return -1;
|
return -1;
|
||||||
case 2: /* ctrl-b */
|
case 2: /* ctrl-b */
|
||||||
kleft();
|
kleft();
|
||||||
break;
|
break;
|
||||||
case 6: /* ctrl-f */
|
case 6: /* ctrl-f */
|
||||||
kright();
|
kright();
|
||||||
break;
|
break;
|
||||||
case 21:
|
case 21:
|
||||||
buf[0] = '\0';
|
buf[0] = '\0';
|
||||||
pos = len = 0;
|
pos = len = 0;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 26: /* ctrl-z */
|
case 26: /* ctrl-z */
|
||||||
norawmode();
|
norawmode();
|
||||||
kill(getpid(), SIGSTOP);
|
kill(getpid(), SIGSTOP);
|
||||||
rawmode();
|
rawmode();
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 12:
|
case 12:
|
||||||
clear();
|
clear();
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 27: /* escape sequence */
|
case 27: /* escape sequence */
|
||||||
/* Read the next two bytes representing the escape sequence.
|
/* Read the next two bytes representing the escape sequence.
|
||||||
* Use two calls to handle slow terminals returning the two
|
* Use two calls to handle slow terminals returning the two
|
||||||
* chars at different times. */
|
* chars at different times. */
|
||||||
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
if (read(STDIN_FILENO, seq, 1) == -1) break;
|
||||||
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
if (read(STDIN_FILENO, seq + 1, 1) == -1) break;
|
||||||
if (seq[0] == '[') {
|
if (seq[0] == '[') {
|
||||||
if (seq[1] >= '0' && seq[1] <= '9') {
|
if (seq[1] >= '0' && seq[1] <= '9') {
|
||||||
/* Extended escape, read additional byte. */
|
/* Extended escape, read additional byte. */
|
||||||
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
if (read(STDIN_FILENO, seq + 2, 1) == -1) break;
|
||||||
if (seq[2] == '~') {
|
if (seq[2] == '~') {
|
||||||
switch(seq[1]) {
|
switch (seq[1]) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
switch (seq[1]) {
|
||||||
|
default:
|
||||||
|
break;
|
||||||
|
case 'A':
|
||||||
|
historymove(1);
|
||||||
|
break;
|
||||||
|
case 'B':
|
||||||
|
historymove(-1);
|
||||||
|
break;
|
||||||
|
case 'C': /* Right */
|
||||||
|
kright();
|
||||||
|
break;
|
||||||
|
case 'D': /* Left */
|
||||||
|
kleft();
|
||||||
|
break;
|
||||||
|
case 'H':
|
||||||
|
pos = 0;
|
||||||
|
refresh();
|
||||||
|
break;
|
||||||
|
case 'F':
|
||||||
|
pos = len;
|
||||||
|
refresh();
|
||||||
|
break;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else {
|
} else if (seq[0] == 'O') {
|
||||||
switch (seq[1]) {
|
switch (seq[1]) {
|
||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
case 'A':
|
case 'H':
|
||||||
historymove(1);
|
pos = 0;
|
||||||
break;
|
refresh();
|
||||||
case 'B':
|
break;
|
||||||
historymove(-1);
|
case 'F':
|
||||||
break;
|
pos = len;
|
||||||
case 'C': /* Right */
|
refresh();
|
||||||
kright();
|
break;
|
||||||
break;
|
|
||||||
case 'D': /* Left */
|
|
||||||
kleft();
|
|
||||||
break;
|
|
||||||
case 'H':
|
|
||||||
pos = 0;
|
|
||||||
refresh();
|
|
||||||
break;
|
|
||||||
case 'F':
|
|
||||||
pos = len;
|
|
||||||
refresh();
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
} else if (seq[0] == 'O') {
|
break;
|
||||||
switch (seq[1]) {
|
|
||||||
default:
|
|
||||||
break;
|
|
||||||
case 'H':
|
|
||||||
pos = 0;
|
|
||||||
refresh();
|
|
||||||
break;
|
|
||||||
case 'F':
|
|
||||||
pos = len;
|
|
||||||
refresh();
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
@@ -444,8 +444,8 @@ static int checktermsupport() {
|
|||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
prompt = (const char *)p;
|
prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
historyi = 0;
|
historyi = 0;
|
||||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||||
|
|||||||
@@ -23,12 +23,12 @@
|
|||||||
#ifndef JANET_LINE_H_defined
|
#ifndef JANET_LINE_H_defined
|
||||||
#define JANET_LINE_H_defined
|
#define JANET_LINE_H_defined
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
|
|
||||||
void janet_line_init();
|
void janet_line_init();
|
||||||
void janet_line_deinit();
|
void janet_line_deinit();
|
||||||
|
|
||||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer);
|
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include "line.h"
|
#include "line.h"
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_init;
|
extern const unsigned char *janet_gen_init;
|
||||||
@@ -33,7 +33,14 @@ int main(int argc, char **argv) {
|
|||||||
|
|
||||||
/* Set up VM */
|
/* Set up VM */
|
||||||
janet_init();
|
janet_init();
|
||||||
env = janet_core_env();
|
|
||||||
|
/* Replace original getline with new line getter */
|
||||||
|
JanetTable *replacements = janet_table(0);
|
||||||
|
janet_table_put(replacements, janet_csymbolv("getline"), janet_wrap_cfunction(janet_line_getter));
|
||||||
|
janet_line_init();
|
||||||
|
|
||||||
|
/* Get core env */
|
||||||
|
env = janet_core_env(replacements);
|
||||||
|
|
||||||
/* Create args tuple */
|
/* Create args tuple */
|
||||||
args = janet_array(argc);
|
args = janet_array(argc);
|
||||||
@@ -41,11 +48,6 @@ int main(int argc, char **argv) {
|
|||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
/* Expose line getter */
|
|
||||||
janet_def(env, "getline", janet_wrap_cfunction(janet_line_getter), NULL);
|
|
||||||
janet_register("getline", janet_line_getter);
|
|
||||||
janet_line_init();
|
|
||||||
|
|
||||||
/* Run startup script */
|
/* Run startup script */
|
||||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||||
|
|
||||||
|
|||||||
@@ -20,7 +20,7 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
#include <janet/janet.h>
|
#include <janet.h>
|
||||||
#include <emscripten.h>
|
#include <emscripten.h>
|
||||||
|
|
||||||
extern const unsigned char *janet_gen_webinit;
|
extern const unsigned char *janet_gen_webinit;
|
||||||
@@ -44,7 +44,7 @@ static int enter_loop(void) {
|
|||||||
Janet ret;
|
Janet ret;
|
||||||
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
||||||
if (status == JANET_SIGNAL_ERROR) {
|
if (status == JANET_SIGNAL_ERROR) {
|
||||||
janet_stacktrace(repl_fiber, "runtime", ret);
|
janet_stacktrace(repl_fiber, ret);
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
repl_fiber = NULL;
|
repl_fiber = NULL;
|
||||||
return 1;
|
return 1;
|
||||||
@@ -70,7 +70,7 @@ void repl_init(void) {
|
|||||||
janet_init();
|
janet_init();
|
||||||
janet_register("repl-yield", repl_yield);
|
janet_register("repl-yield", repl_yield);
|
||||||
janet_register("js", cfun_js);
|
janet_register("js", cfun_js);
|
||||||
env = janet_core_env();
|
env = janet_core_env(NULL);
|
||||||
|
|
||||||
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
janet_def(env, "repl-yield", janet_wrap_cfunction(repl_yield), NULL);
|
||||||
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
janet_def(env, "js", janet_wrap_cfunction(cfun_js), NULL);
|
||||||
|
|||||||
@@ -1,6 +1,6 @@
|
|||||||
# Copyright 2017-2019 (C) Calvin Rose
|
# Copyright 2017-2019 (C) Calvin Rose
|
||||||
|
|
||||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
|
|
||||||
(fiber/new (fn webrepl []
|
(fiber/new (fn webrepl []
|
||||||
(repl (fn get-line [buf p]
|
(repl (fn get-line [buf p]
|
||||||
|
|||||||
@@ -21,6 +21,16 @@
|
|||||||
(print e)))
|
(print e)))
|
||||||
x)
|
x)
|
||||||
|
|
||||||
|
(defmacro assert-error
|
||||||
|
[msg & forms]
|
||||||
|
(def errsym (keyword (gensym)))
|
||||||
|
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||||
|
|
||||||
|
(defmacro assert-no-error
|
||||||
|
[msg & forms]
|
||||||
|
(def errsym (keyword (gensym)))
|
||||||
|
~(assert (not= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||||
|
|
||||||
(defn start-suite [x]
|
(defn start-suite [x]
|
||||||
(set suite-num x)
|
(set suite-num x)
|
||||||
(print "\nRunning test suite " x " tests...\n "))
|
(print "\nRunning test suite " x " tests...\n "))
|
||||||
|
|||||||
1
test/install/.gitignore
vendored
Normal file
1
test/install/.gitignore
vendored
Normal file
@@ -0,0 +1 @@
|
|||||||
|
/build
|
||||||
11
test/install/test.janet
Normal file
11
test/install/test.janet
Normal file
@@ -0,0 +1,11 @@
|
|||||||
|
(import cook)
|
||||||
|
|
||||||
|
(cook/make-native
|
||||||
|
:name "testmod"
|
||||||
|
:source @["testmod.c"])
|
||||||
|
|
||||||
|
(import build/testmod :as testmod)
|
||||||
|
|
||||||
|
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
||||||
|
|
||||||
|
(print "OK!")
|
||||||
40
test/install/testmod.c
Normal file
40
test/install/testmod.c
Normal file
@@ -0,0 +1,40 @@
|
|||||||
|
/*
|
||||||
|
* Copyright (c) 2019 Calvin Rose and contributors
|
||||||
|
*
|
||||||
|
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
* of this software and associated documentation files (the "Software"), to
|
||||||
|
* deal in 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.
|
||||||
|
*/
|
||||||
|
|
||||||
|
/* A very simple native module */
|
||||||
|
|
||||||
|
#include <janet.h>
|
||||||
|
|
||||||
|
static Janet cfun_get_five(int32_t argc, Janet *argv) {
|
||||||
|
(void) argv;
|
||||||
|
janet_fixarity(argc, 0);
|
||||||
|
return janet_wrap_number(5.0);
|
||||||
|
}
|
||||||
|
|
||||||
|
static const JanetReg array_cfuns[] = {
|
||||||
|
{"get5", cfun_get_five, NULL},
|
||||||
|
{NULL, NULL, NULL}
|
||||||
|
};
|
||||||
|
|
||||||
|
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||||
|
janet_cfuns(env, NULL, array_cfuns);
|
||||||
|
}
|
||||||
@@ -283,5 +283,22 @@
|
|||||||
(++ i))
|
(++ i))
|
||||||
(assert (= i 6) "when macro"))
|
(assert (= i 6) "when macro"))
|
||||||
|
|
||||||
|
# Denormal tables and structs
|
||||||
|
|
||||||
|
(assert (= (length {1 2 nil 3}) 1) "nil key struct literal")
|
||||||
|
(assert (= (length @{1 2 nil 3}) 1) "nil key table literal")
|
||||||
|
(assert (= (length (struct 1 2 nil 3)) 1) "nil key struct ctor")
|
||||||
|
(assert (= (length (table 1 2 nil 3)) 1) "nil key table ctor")
|
||||||
|
|
||||||
|
(assert (= (length (struct (/ 0 0) 2 1 3)) 1) "nan key struct ctor")
|
||||||
|
(assert (= (length (table (/ 0 0) 2 1 3)) 1) "nan key table ctor")
|
||||||
|
(assert (= (length {1 2 nil 3}) 1) "nan key struct literal")
|
||||||
|
(assert (= (length @{1 2 nil 3}) 1) "nan key table literal")
|
||||||
|
|
||||||
|
(assert (= (length (struct 2 1 3 nil)) 1) "nil value struct ctor")
|
||||||
|
(assert (= (length (table 2 1 3 nil)) 1) "nil value table ctor")
|
||||||
|
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||||
|
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
@@ -97,8 +97,8 @@
|
|||||||
# of the triangle to the leaves of the triangle.
|
# of the triangle to the leaves of the triangle.
|
||||||
|
|
||||||
(defn myfold [xs ys]
|
(defn myfold [xs ys]
|
||||||
(let [xs1 (tuple/prepend xs 0)
|
(let [xs1 [;xs 0]
|
||||||
xs2 (tuple/append xs 0)
|
xs2 [0 ;xs]
|
||||||
m1 (map + xs1 ys)
|
m1 (map + xs1 ys)
|
||||||
m2 (map + xs2 ys)]
|
m2 (map + xs2 ys)]
|
||||||
(map max m1 m2)))
|
(map max m1 m2)))
|
||||||
@@ -140,7 +140,7 @@
|
|||||||
|
|
||||||
# Marshal
|
# Marshal
|
||||||
|
|
||||||
(def um-lookup (env-lookup _env))
|
(def um-lookup (env-lookup *env*))
|
||||||
(def m-lookup (invert um-lookup))
|
(def m-lookup (invert um-lookup))
|
||||||
|
|
||||||
(defn testmarsh [x msg]
|
(defn testmarsh [x msg]
|
||||||
@@ -154,6 +154,10 @@
|
|||||||
(testmarsh 1 "marshal small integers")
|
(testmarsh 1 "marshal small integers")
|
||||||
(testmarsh -1 "marshal integers (-1)")
|
(testmarsh -1 "marshal integers (-1)")
|
||||||
(testmarsh 199 "marshal small integers (199)")
|
(testmarsh 199 "marshal small integers (199)")
|
||||||
|
(testmarsh 5000 "marshal medium integers (5000)")
|
||||||
|
(testmarsh -5000 "marshal small integers (-5000)")
|
||||||
|
(testmarsh 10000 "marshal large integers (10000)")
|
||||||
|
(testmarsh -10000 "marshal large integers (-10000)")
|
||||||
(testmarsh 1.0 "marshal double")
|
(testmarsh 1.0 "marshal double")
|
||||||
(testmarsh "doctordolittle" "marshal string")
|
(testmarsh "doctordolittle" "marshal string")
|
||||||
(testmarsh :chickenshwarma "marshal symbol")
|
(testmarsh :chickenshwarma "marshal symbol")
|
||||||
@@ -171,10 +175,14 @@
|
|||||||
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
(testmarsh (fiber/new (fn [] (yield 1) 2)) "marshal simple fiber 1")
|
||||||
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
(testmarsh (fiber/new (fn [&] (yield 1) 2)) "marshal simple fiber 2")
|
||||||
|
|
||||||
|
(def strct {:a @[nil]})
|
||||||
|
(put (strct :a) 0 strct)
|
||||||
|
(testmarsh strct "cyclic struct")
|
||||||
|
|
||||||
# Large functions
|
# Large functions
|
||||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||||
(def f (compile (tuple/prepend manydefs 'do) *env*))
|
(def f (compile ['do ;manydefs] *env*))
|
||||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||||
|
|
||||||
# Some higher order functions and macros
|
# Some higher order functions and macros
|
||||||
@@ -208,6 +216,9 @@
|
|||||||
(def xs (apply tuple (seq [x :range [0 10] :when (even? x)] (tuple (/ x 2) x))))
|
(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")
|
(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")
|
||||||
|
|
||||||
# Some testing for not=
|
# Some testing for not=
|
||||||
(assert (not= 1 1 0) "not= 1")
|
(assert (not= 1 1 0) "not= 1")
|
||||||
(assert (not= 0 1 1) "not= 2")
|
(assert (not= 0 1 1) "not= 2")
|
||||||
|
|||||||
@@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2019 Calvin Rose
|
#' Copyright (c) 2019 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
|||||||
@@ -53,6 +53,12 @@
|
|||||||
|
|
||||||
(assert (= var-b "hello") "regression 1")
|
(assert (= var-b "hello") "regression 1")
|
||||||
|
|
||||||
|
# Scan number
|
||||||
|
|
||||||
|
(assert (= 1 (scan-number "1")) "scan-number 1")
|
||||||
|
(assert (= -1 (scan-number "-1")) "scan-number -1")
|
||||||
|
(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
|
||||||
|
|
||||||
# Some macros
|
# Some macros
|
||||||
|
|
||||||
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
||||||
@@ -122,4 +128,235 @@
|
|||||||
(def spot (make-dog "spot"))
|
(def spot (make-dog "spot"))
|
||||||
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
||||||
|
|
||||||
|
# Negative tests
|
||||||
|
|
||||||
|
(assert-error "+ check types" (+ 1 ()))
|
||||||
|
(assert-error "- check types" (- 1 ()))
|
||||||
|
(assert-error "* check types" (* 1 ()))
|
||||||
|
(assert-error "/ check types" (/ 1 ()))
|
||||||
|
(assert-error "band check types" (band 1 ()))
|
||||||
|
(assert-error "bor check types" (bor 1 ()))
|
||||||
|
(assert-error "bxor check types" (bxor 1 ()))
|
||||||
|
(assert-error "bnot check types" (bnot ()))
|
||||||
|
|
||||||
|
# Buffer blitting
|
||||||
|
|
||||||
|
(def b (buffer/new-filled 100))
|
||||||
|
(buffer/bit-set b 100)
|
||||||
|
(buffer/bit-clear b 100)
|
||||||
|
(assert (zero? (sum b)) "buffer bit set and clear")
|
||||||
|
(buffer/bit-toggle b 101)
|
||||||
|
(assert (= 32 (sum b)) "buffer bit set and clear")
|
||||||
|
|
||||||
|
(def b2 @"hello world")
|
||||||
|
|
||||||
|
(buffer/blit b2 "joyto ")
|
||||||
|
(assert (= (string b2) "joyto world") "buffer/blit 1")
|
||||||
|
|
||||||
|
(buffer/blit b2 "joyto" 6)
|
||||||
|
(assert (= (string b2) "joyto joyto") "buffer/blit 2")
|
||||||
|
|
||||||
|
(buffer/blit b2 "abcdefg" 5 6)
|
||||||
|
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||||
|
|
||||||
|
# Buffer push word
|
||||||
|
|
||||||
|
(def b3 @"")
|
||||||
|
(buffer/push-word b3 0xFF 0x11)
|
||||||
|
(assert (= 8 (length b3)) "buffer/push-word 1")
|
||||||
|
(assert (= "\xFF\0\0\0\x11\0\0\0" (string b3)) "buffer/push-word 2")
|
||||||
|
(buffer/clear b3)
|
||||||
|
(buffer/push-word b3 0xFFFFFFFF 0x1100)
|
||||||
|
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||||
|
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||||
|
|
||||||
|
# Peg
|
||||||
|
|
||||||
|
(defn check-match
|
||||||
|
[pat text should-match]
|
||||||
|
(def result (peg/match pat text))
|
||||||
|
(assert (= (not should-match) (not result)) text))
|
||||||
|
|
||||||
|
(defn check-deep
|
||||||
|
[pat text what]
|
||||||
|
(def result (peg/match pat text))
|
||||||
|
(assert (deep= result what) text))
|
||||||
|
|
||||||
|
# Just numbers
|
||||||
|
|
||||||
|
(check-match '(* 4 -1) "abcd" true)
|
||||||
|
(check-match '(* 4 -1) "abc" false)
|
||||||
|
(check-match '(* 4 -1) "abcde" false)
|
||||||
|
|
||||||
|
# Simple pattern
|
||||||
|
|
||||||
|
(check-match '(* (some (range "az" "AZ")) -1) "hello" true)
|
||||||
|
(check-match '(* (some (range "az" "AZ")) -1) "hello world" false)
|
||||||
|
(check-match '(* (some (range "az" "AZ")) -1) "1he11o" false)
|
||||||
|
(check-match '(* (some (range "az" "AZ")) -1) "" false)
|
||||||
|
|
||||||
|
# Pre compile
|
||||||
|
|
||||||
|
(def pegleg (peg/compile '{:item "abc" :main (* :item "," :item -1)}))
|
||||||
|
|
||||||
|
(peg/match pegleg "abc,abc")
|
||||||
|
|
||||||
|
# Bad Grammars
|
||||||
|
|
||||||
|
(assert-error "peg/compile error 1" (peg/compile nil))
|
||||||
|
(assert-error "peg/compile error 2" (peg/compile @{}))
|
||||||
|
(assert-error "peg/compile error 3" (peg/compile '{:a "abc" :b "def"}))
|
||||||
|
(assert-error "peg/compile error 4" (peg/compile '(blarg "abc")))
|
||||||
|
(assert-error "peg/compile error 5" (peg/compile '(1 2 3)))
|
||||||
|
|
||||||
|
# IP address
|
||||||
|
|
||||||
|
(def ip-address
|
||||||
|
'{:d (range "09")
|
||||||
|
:0-4 (range "04")
|
||||||
|
:0-5 (range "05")
|
||||||
|
:byte (+
|
||||||
|
(* "25" :0-5)
|
||||||
|
(* "2" :0-4 :d)
|
||||||
|
(* "1" :d :d)
|
||||||
|
(between 1 2 :d))
|
||||||
|
:main (* :byte "." :byte "." :byte "." :byte)})
|
||||||
|
|
||||||
|
(check-match ip-address "10.240.250.250" true)
|
||||||
|
(check-match ip-address "0.0.0.0" true)
|
||||||
|
(check-match ip-address "1.2.3.4" true)
|
||||||
|
(check-match ip-address "256.2.3.4" false)
|
||||||
|
(check-match ip-address "256.2.3.2514" false)
|
||||||
|
|
||||||
|
# Substitution test with peg
|
||||||
|
|
||||||
|
(file/flush stderr)
|
||||||
|
(file/flush stdout)
|
||||||
|
|
||||||
|
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||||
|
(defn try-grammar [text]
|
||||||
|
(assert (= (string/replace-all "dog" "purple panda" text) (0 (peg/match grammar text))) text))
|
||||||
|
|
||||||
|
(try-grammar "i have a dog called doug the dog. he is good.")
|
||||||
|
(try-grammar "i have a dog called doug the dog. he is a good boy.")
|
||||||
|
(try-grammar "i have a dog called doug the do")
|
||||||
|
(try-grammar "i have a dog called doug the dog")
|
||||||
|
(try-grammar "i have a dog called doug the dogg")
|
||||||
|
(try-grammar "i have a dog called doug the doggg")
|
||||||
|
(try-grammar "i have a dog called doug the dogggg")
|
||||||
|
|
||||||
|
# Peg CSV test
|
||||||
|
|
||||||
|
(def csv
|
||||||
|
'{:field (+
|
||||||
|
(* `"` (% (any (+ (<- (if-not `"` 1)) (* (constant `"`) `""`)))) `"`)
|
||||||
|
(<- (any (if-not (set ",\n") 1))))
|
||||||
|
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
||||||
|
|
||||||
|
(defn check-csv
|
||||||
|
[str res]
|
||||||
|
(check-deep csv str res))
|
||||||
|
|
||||||
|
(check-csv "1,2,3" @["1" "2" "3"])
|
||||||
|
(check-csv "1,\"2\",3" @["1" "2" "3"])
|
||||||
|
(check-csv ``1,"1""",3`` @["1" "1\"" "3"])
|
||||||
|
|
||||||
|
# Nested Captures
|
||||||
|
|
||||||
|
(def grmr '(capture (* (capture "a") (capture 1) (capture "c"))))
|
||||||
|
(check-deep grmr "abc" @["a" "b" "c" "abc"])
|
||||||
|
(check-deep grmr "acc" @["a" "c" "c" "acc"])
|
||||||
|
|
||||||
|
# Functions in grammar
|
||||||
|
|
||||||
|
(def grmr-triple ~(% (any (/ (<- 1) ,(fn [x] (string x x x))))))
|
||||||
|
(check-deep grmr-triple "abc" @["aaabbbccc"])
|
||||||
|
(check-deep grmr-triple "" @[""])
|
||||||
|
(check-deep grmr-triple " " @[" "])
|
||||||
|
|
||||||
|
(def counter ~(/ (group (any (<- 1))) ,length))
|
||||||
|
(check-deep counter "abcdefg" @[7])
|
||||||
|
|
||||||
|
# Capture Backtracking
|
||||||
|
|
||||||
|
(check-deep '(+ (* (capture "c") "d") "ce") "ce" @[])
|
||||||
|
|
||||||
|
# Matchtime capture
|
||||||
|
|
||||||
|
(def scanner (peg/compile ~(cmt (capture (some 1)) ,scan-number)))
|
||||||
|
|
||||||
|
(check-deep scanner "123" @[123])
|
||||||
|
(check-deep scanner "0x86" @[0x86])
|
||||||
|
(check-deep scanner "-1.3e-7" @[-1.3e-7])
|
||||||
|
(check-deep scanner "123A" nil)
|
||||||
|
|
||||||
|
# Recursive grammars
|
||||||
|
|
||||||
|
(def g '{:main (+ (* "a" :main "b") "c")})
|
||||||
|
|
||||||
|
(check-match g "c" true)
|
||||||
|
(check-match g "acb" true)
|
||||||
|
(check-match g "aacbb" true)
|
||||||
|
(check-match g "aadbb" false)
|
||||||
|
|
||||||
|
# Back reference
|
||||||
|
|
||||||
|
(def wrapped-string
|
||||||
|
~{:pad (any "=")
|
||||||
|
:open (* "[" (<- :pad :n) "[")
|
||||||
|
:close (* "]" (cmt (* (-> :n) (<- :pad)) ,=) "]")
|
||||||
|
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||||
|
|
||||||
|
(check-match wrapped-string "[[]]" true)
|
||||||
|
(check-match wrapped-string "[==[a]==]" true)
|
||||||
|
(check-match wrapped-string "[==[]===]" false)
|
||||||
|
(check-match wrapped-string "[[blark]]" true)
|
||||||
|
(check-match wrapped-string "[[bl[ark]]" true)
|
||||||
|
(check-match wrapped-string "[[bl]rk]]" true)
|
||||||
|
(check-match wrapped-string "[[bl]rk]] " false)
|
||||||
|
(check-match wrapped-string "[=[bl]]rk]=] " false)
|
||||||
|
(check-match wrapped-string "[=[bl]==]rk]=] " false)
|
||||||
|
(check-match wrapped-string "[===[]==]===]" true)
|
||||||
|
|
||||||
|
(def janet-longstring
|
||||||
|
~{:delim (some "`")
|
||||||
|
:open (capture :delim :n)
|
||||||
|
:close (cmt (* (not (> -1 "`")) (-> :n) (<- :delim)) ,=)
|
||||||
|
:main (* :open (any (if-not :close 1)) :close -1)})
|
||||||
|
|
||||||
|
(check-match janet-longstring "`john" false)
|
||||||
|
(check-match janet-longstring "abc" false)
|
||||||
|
(check-match janet-longstring "` `" true)
|
||||||
|
(check-match janet-longstring "` `" true)
|
||||||
|
(check-match janet-longstring "`` ``" true)
|
||||||
|
(check-match janet-longstring "``` `` ```" true)
|
||||||
|
(check-match janet-longstring "`` ```" false)
|
||||||
|
|
||||||
|
# Optional
|
||||||
|
|
||||||
|
(check-match '(* (opt "hi") -1) "" true)
|
||||||
|
(check-match '(* (opt "hi") -1) "hi" true)
|
||||||
|
(check-match '(* (opt "hi") -1) "no" false)
|
||||||
|
(check-match '(* (? "hi") -1) "" true)
|
||||||
|
(check-match '(* (? "hi") -1) "hi" true)
|
||||||
|
(check-match '(* (? "hi") -1) "no" false)
|
||||||
|
|
||||||
|
# Drop
|
||||||
|
|
||||||
|
(check-deep '(drop '"hello") "hello" @[])
|
||||||
|
(check-deep '(drop "hello") "hello" @[])
|
||||||
|
|
||||||
|
# Regression #24
|
||||||
|
|
||||||
|
(def t (put @{} :hi 1))
|
||||||
|
(assert (deep= t @{:hi 1}) "regression #24")
|
||||||
|
|
||||||
|
# Tuple types
|
||||||
|
|
||||||
|
(assert (= (tuple/type '(1 2 3)) :parens) "normal tuple")
|
||||||
|
(assert (= (tuple/type [1 2 3]) :parens) "normal tuple 1")
|
||||||
|
(assert (= (tuple/type '[1 2 3]) :brackets) "bracketed tuple 2")
|
||||||
|
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
|
||||||
|
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
72
test/suite4.janet
Normal file
72
test/suite4.janet
Normal file
@@ -0,0 +1,72 @@
|
|||||||
|
# Copyright (c) 2019 Calvin Rose
|
||||||
|
#
|
||||||
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
|
# of this software and associated documentation files (the "Software"), to
|
||||||
|
# deal in the Software without restriction, including without limitation the
|
||||||
|
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||||
|
# sell copies of the Software, and to permit persons to whom the Software is
|
||||||
|
# furnished to do so, subject to the following conditions:
|
||||||
|
#
|
||||||
|
# The above copyright notice and this permission notice shall be included in
|
||||||
|
# all copies or substantial portions of the Software.
|
||||||
|
#
|
||||||
|
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||||
|
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||||
|
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||||
|
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||||
|
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||||
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
|
(import test/helper :prefix "" :exit true)
|
||||||
|
(start-suite 4)
|
||||||
|
# some tests for string/format and buffer/format
|
||||||
|
|
||||||
|
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142") "%6.3f")
|
||||||
|
(assert (= (string (buffer/format @"" "pi = %+6.3f" math/pi)) "pi = +3.142") "%6.3f")
|
||||||
|
(assert (= (string (buffer/format @"" "pi = %40.20g" math/pi)) "pi = 3.141592653589793116") "%6.3f")
|
||||||
|
|
||||||
|
(assert (= (string (buffer/format @"" "🐼 = %6.3f" math/pi)) "🐼 = 3.142") "UTF-8")
|
||||||
|
(assert (= (string (buffer/format @"" "π = %.8g" math/pi)) "π = 3.1415927") "π")
|
||||||
|
(assert (= (string (buffer/format @"" "\xCF\x80 = %.8g" math/pi)) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||||
|
|
||||||
|
(assert (= (string/format "pi = %6.3f" math/pi) "pi = 3.142") "%6.3f")
|
||||||
|
(assert (= (string/format "pi = %+6.3f" math/pi) "pi = +3.142") "%6.3f")
|
||||||
|
(assert (= (string/format "pi = %40.20g" math/pi) "pi = 3.141592653589793116") "%6.3f")
|
||||||
|
|
||||||
|
(assert (= (string/format "🐼 = %6.3f" math/pi) "🐼 = 3.142") "UTF-8")
|
||||||
|
(assert (= (string/format "π = %.8g" math/pi) "π = 3.1415927") "π")
|
||||||
|
(assert (= (string/format "\xCF\x80 = %.8g" math/pi) "\xCF\x80 = 3.1415927") "\xCF\x80")
|
||||||
|
|
||||||
|
# Range
|
||||||
|
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
|
||||||
|
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
|
||||||
|
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
|
||||||
|
|
||||||
|
# More marshalling code
|
||||||
|
|
||||||
|
(defn check-image
|
||||||
|
"Run a marshaling test using the make-image and load-image functions."
|
||||||
|
[x msg]
|
||||||
|
(assert-no-error msg (load-image (make-image x))))
|
||||||
|
|
||||||
|
(check-image (fn [] (fn [] 1)) "marshal nested functions")
|
||||||
|
(check-image (fiber/new (fn [] (fn [] 1))) "marshal nested functions in fiber")
|
||||||
|
(check-image (fiber/new (fn [] (fiber/new (fn [] 1)))) "marshal nested fibers")
|
||||||
|
|
||||||
|
(def issue-53-x
|
||||||
|
(fiber/new
|
||||||
|
(fn []
|
||||||
|
(var y (fiber/new (fn [] (print "1") (yield) (print "2")))))))
|
||||||
|
|
||||||
|
(check-image issue-53-x "issue 53 regression")
|
||||||
|
|
||||||
|
# Bracket tuple issue
|
||||||
|
|
||||||
|
(def do 3)
|
||||||
|
(assert (= [3 1 2 3] [do 1 2 3]) "bracket tuples are never special forms")
|
||||||
|
(assert (= ~(,defn 1 2 3) [defn 1 2 3]) "bracket tuples are never macros")
|
||||||
|
(assert (= ~(,+ 1 2 3) [+ 1 2 3]) "bracket tuples are never function calls")
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
|
|
||||||
91
test/suite5.janet
Normal file
91
test/suite5.janet
Normal file
@@ -0,0 +1,91 @@
|
|||||||
|
# Copyright (c) 2019 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 test/helper :prefix "" :exit true)
|
||||||
|
(start-suite 5)
|
||||||
|
|
||||||
|
# some tests typed array
|
||||||
|
|
||||||
|
(defn inspect-tarray
|
||||||
|
[x]
|
||||||
|
(def a @[])
|
||||||
|
(for i 0 (tarray/length x) (array/push a (x i)))
|
||||||
|
(pp a))
|
||||||
|
|
||||||
|
(assert-no-error
|
||||||
|
"create some typed arrays"
|
||||||
|
(do
|
||||||
|
(def a (tarray/new :float64 10))
|
||||||
|
(def b (tarray/new :float64 5 2 0 a))
|
||||||
|
(def c (tarray/new :uint32 20))))
|
||||||
|
|
||||||
|
(assert-no-error
|
||||||
|
"create some typed arrays from a buffer"
|
||||||
|
(do
|
||||||
|
(def buf (tarray/buffer (+ 64 (* (+ 1 (* (- 10 1) 2)) 8))))
|
||||||
|
(def b (tarray/new :float64 10 2 64 buf))))
|
||||||
|
|
||||||
|
(def a (tarray/new :float64 10))
|
||||||
|
(def b (tarray/new :float64 5 2 0 a))
|
||||||
|
|
||||||
|
(assert-no-error
|
||||||
|
"fill tarray"
|
||||||
|
(for i 0 (tarray/length a)
|
||||||
|
(set (a i) i)))
|
||||||
|
|
||||||
|
(assert (= (tarray/buffer a) (tarray/buffer b)) "tarray views pointing same buffer")
|
||||||
|
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
||||||
|
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
||||||
|
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||||
|
|
||||||
|
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||||
|
|
||||||
|
# Array remove
|
||||||
|
|
||||||
|
(assert (deep= (array/remove @[1 2 3 4 5] 2) @[1 2 4 5]) "array/remove 1")
|
||||||
|
(assert (deep= (array/remove @[1 2 3 4 5] 2 2) @[1 2 5]) "array/remove 2")
|
||||||
|
(assert (deep= (array/remove @[1 2 3 4 5] 2 200) @[1 2]) "array/remove 3")
|
||||||
|
(assert (deep= (array/remove @[1 2 3 4 5] -3 200) @[1 2 3]) "array/remove 4")
|
||||||
|
|
||||||
|
# Break
|
||||||
|
|
||||||
|
(var summation 0)
|
||||||
|
(for i 0 10
|
||||||
|
(+= summation i)
|
||||||
|
(if (= i 7) (break)))
|
||||||
|
(assert (= summation 28) "break 1")
|
||||||
|
|
||||||
|
(assert (= nil ((fn [] (break) 4))) "break 2")
|
||||||
|
|
||||||
|
# Break with value
|
||||||
|
|
||||||
|
# Shouldn't error out
|
||||||
|
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
||||||
|
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
||||||
|
|
||||||
|
# drop-until
|
||||||
|
|
||||||
|
(assert (deep= (drop-until pos? @[]) @[]) "drop-until 1")
|
||||||
|
(assert (deep= (drop-until pos? @[1 2 3]) @[1 2 3]) "drop-until 2")
|
||||||
|
(assert (deep= (drop-until pos? @[-1 -2 -3]) @[]) "drop-until 3")
|
||||||
|
(assert (deep= (drop-until pos? @[-1 -2 3]) @[3]) "drop-until 4")
|
||||||
|
(assert (deep= (drop-until pos? @[-1 1 -2]) @[1 -2]) "drop-until 5")
|
||||||
|
|
||||||
|
(end-suite)
|
||||||
76
tools/amalg.janet
Normal file
76
tools/amalg.janet
Normal file
@@ -0,0 +1,76 @@
|
|||||||
|
# Creates an amalgamated janet.c and janet.h to
|
||||||
|
# allow for easy embedding
|
||||||
|
|
||||||
|
(def {:year YY :month MM :month-day DD} (os/date))
|
||||||
|
|
||||||
|
(defn dofile
|
||||||
|
"Print one file to stdout"
|
||||||
|
[path]
|
||||||
|
(print (slurp path)))
|
||||||
|
|
||||||
|
# Order is important here, as some headers
|
||||||
|
# depend on other headers.
|
||||||
|
(def headers
|
||||||
|
@["src/core/util.h"
|
||||||
|
"src/core/state.h"
|
||||||
|
"src/core/gc.h"
|
||||||
|
"src/core/vector.h"
|
||||||
|
"src/core/fiber.h"
|
||||||
|
"src/core/regalloc.h"
|
||||||
|
"src/core/compile.h"
|
||||||
|
"src/core/emit.h"
|
||||||
|
"src/core/symcache.h"])
|
||||||
|
|
||||||
|
(def sources
|
||||||
|
@["src/core/abstract.c"
|
||||||
|
"src/core/array.c"
|
||||||
|
"src/core/asm.c"
|
||||||
|
"src/core/buffer.c"
|
||||||
|
"src/core/bytecode.c"
|
||||||
|
"src/core/capi.c"
|
||||||
|
"src/core/cfuns.c"
|
||||||
|
"src/core/compile.c"
|
||||||
|
"src/core/corelib.c"
|
||||||
|
"src/core/debug.c"
|
||||||
|
"src/core/emit.c"
|
||||||
|
"src/core/fiber.c"
|
||||||
|
"src/core/gc.c"
|
||||||
|
"src/core/io.c"
|
||||||
|
"src/core/marsh.c"
|
||||||
|
"src/core/math.c"
|
||||||
|
"src/core/os.c"
|
||||||
|
"src/core/parse.c"
|
||||||
|
"src/core/peg.c"
|
||||||
|
"src/core/pp.c"
|
||||||
|
"src/core/regalloc.c"
|
||||||
|
"src/core/run.c"
|
||||||
|
"src/core/specials.c"
|
||||||
|
"src/core/string.c"
|
||||||
|
"src/core/strtod.c"
|
||||||
|
"src/core/struct.c"
|
||||||
|
"src/core/symcache.c"
|
||||||
|
"src/core/table.c"
|
||||||
|
"src/core/tuple.c"
|
||||||
|
"src/core/typedarray.c"
|
||||||
|
"src/core/util.c"
|
||||||
|
"src/core/value.c"
|
||||||
|
"src/core/vector.c"
|
||||||
|
"src/core/vm.c"
|
||||||
|
"src/core/wrap.c"])
|
||||||
|
|
||||||
|
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||||
|
(print "/* Generated " YY "-" (inc MM) "-" (inc DD)
|
||||||
|
" with janet version " janet/version "-" janet/build " */")
|
||||||
|
|
||||||
|
# Assume the version of janet used to run this script is the same
|
||||||
|
# as the version being generated
|
||||||
|
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||||
|
|
||||||
|
(print ```#define JANET_AMALG```)
|
||||||
|
(print ```#include "janet.h"```)
|
||||||
|
|
||||||
|
(each h headers (dofile h))
|
||||||
|
(each s sources (dofile s))
|
||||||
|
|
||||||
|
# Relies on these files being built
|
||||||
|
(dofile "build/core_image.c")
|
||||||
55
tools/bars.janet
Normal file
55
tools/bars.janet
Normal file
@@ -0,0 +1,55 @@
|
|||||||
|
# A flexible templater for janet. Compiles
|
||||||
|
# templates to janet functions that produce buffers.
|
||||||
|
|
||||||
|
(defn template
|
||||||
|
"Compile a template string into a function"
|
||||||
|
[source]
|
||||||
|
|
||||||
|
# State for compilation machine
|
||||||
|
(def p (parser/new))
|
||||||
|
(def forms @[])
|
||||||
|
|
||||||
|
(defn parse-chunk
|
||||||
|
"Parse a string and push produced values to forms."
|
||||||
|
[chunk]
|
||||||
|
(parser/consume p chunk)
|
||||||
|
(while (parser/has-more p)
|
||||||
|
(array/push forms (parser/produce p)))
|
||||||
|
(if (= :error (parser/status p))
|
||||||
|
(error (parser/error p))))
|
||||||
|
|
||||||
|
(defn code-chunk
|
||||||
|
"Parse all the forms in str and return them
|
||||||
|
in a tuple prefixed with 'do."
|
||||||
|
[str]
|
||||||
|
(parse-chunk str)
|
||||||
|
true)
|
||||||
|
|
||||||
|
(defn string-chunk
|
||||||
|
"Insert string chunk into parser"
|
||||||
|
[str]
|
||||||
|
(parser/insert p str)
|
||||||
|
(parse-chunk "")
|
||||||
|
true)
|
||||||
|
|
||||||
|
# Run peg
|
||||||
|
(def grammar
|
||||||
|
~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
|
||||||
|
:main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
|
||||||
|
:main (any (+ :code-chunk :main-chunk (error "")))})
|
||||||
|
(def parts (peg/match grammar source))
|
||||||
|
|
||||||
|
# Check errors in template and parser
|
||||||
|
(unless parts (error "invalid template syntax"))
|
||||||
|
(parse-chunk "\n")
|
||||||
|
(case (parser/status p)
|
||||||
|
:pending (error (string "unfinished parser state " (parser/state p)))
|
||||||
|
:error (error (parser/error p)))
|
||||||
|
|
||||||
|
# Make ast from forms
|
||||||
|
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||||
|
|
||||||
|
(def ctor (compile ast *env* source))
|
||||||
|
(if-not (function? ctor)
|
||||||
|
(error (string "could not compile template")))
|
||||||
|
(ctor))
|
||||||
@@ -3,6 +3,7 @@
|
|||||||
|
|
||||||
# Windows is the OS outlier
|
# Windows is the OS outlier
|
||||||
(def- is-win (= (os/which) :windows))
|
(def- is-win (= (os/which) :windows))
|
||||||
|
(def- is-mac (= (os/which) :macos))
|
||||||
(def- sep (if is-win "\\" "/"))
|
(def- sep (if is-win "\\" "/"))
|
||||||
(def- objext (if is-win ".obj" ".o"))
|
(def- objext (if is-win ".obj" ".o"))
|
||||||
(def- modext (if is-win ".dll" ".so"))
|
(def- modext (if is-win ".dll" ".so"))
|
||||||
@@ -34,7 +35,7 @@
|
|||||||
[f1 f2]
|
[f1 f2]
|
||||||
"Check if f1 is newer than f2. Used for checking if a file should be updated."
|
"Check if f1 is newer than f2. Used for checking if a file should be updated."
|
||||||
(if is-win true
|
(if is-win true
|
||||||
(zero? (os/shell (string "[ " f1 " -ot " f2 " ]")))))
|
(not (zero? (os/shell (string "[ " f1 " -nt " f2 " ]"))))))
|
||||||
|
|
||||||
(defn- older-than-some
|
(defn- older-than-some
|
||||||
[f others]
|
[f others]
|
||||||
@@ -79,22 +80,30 @@
|
|||||||
(defn- make-define
|
(defn- make-define
|
||||||
"Generate strings for adding custom defines to the compiler."
|
"Generate strings for adding custom defines to the compiler."
|
||||||
[define value]
|
[define value]
|
||||||
(def prefix (if is-win "\\D" "-D"))
|
(def prefix (if is-win "/D" "-D"))
|
||||||
(if value
|
(if value
|
||||||
(string prefix define "=" value)
|
(string prefix define "=" value)
|
||||||
(string prefix define)))
|
(string prefix define)))
|
||||||
|
|
||||||
(defn- make-defines
|
(defn- make-defines
|
||||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||||
true, generates -DNAME (\\DNAME on windows), otherwise -DNAME=value."
|
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
||||||
[defines]
|
[defines]
|
||||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||||
|
|
||||||
# Defaults
|
# Defaults
|
||||||
(def OPTIMIZE 2)
|
(def OPTIMIZE 2)
|
||||||
(def CC (if is-win "cl" "cc"))
|
(def CC (if is-win "cl" "cc"))
|
||||||
(def LD (if is-win "link" (string CC " -shared")))
|
(def LD (if is-win
|
||||||
(def CFLAGS (string (if is-win "/0" "-std=c99 -Wall -Wextra -fpic -O") OPTIMIZE))
|
"link"
|
||||||
|
(string CC
|
||||||
|
" -shared"
|
||||||
|
(if is-mac " -undefined dynamic_lookup" ""))))
|
||||||
|
(def CFLAGS (string
|
||||||
|
(if is-win "/I" "-I")
|
||||||
|
module/*syspath*
|
||||||
|
(if is-win " /O" " -std=c99 -Wall -Wextra -fpic -O")
|
||||||
|
OPTIMIZE))
|
||||||
|
|
||||||
(defn- compile-c
|
(defn- compile-c
|
||||||
"Compile a C file into an object file."
|
"Compile a C file into an object file."
|
||||||
@@ -105,18 +114,19 @@
|
|||||||
(if (older-than dest src)
|
(if (older-than dest src)
|
||||||
(if is-win
|
(if is-win
|
||||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
||||||
(shell cc " " ;defines " " cflags " -o " dest " -c " src))))
|
(shell cc " -c " src " " ;defines " " cflags " -o " dest))))
|
||||||
|
|
||||||
(defn- link-c
|
(defn- link-c
|
||||||
"Link a number of object files together."
|
"Link a number of object files together."
|
||||||
[opts target & objects]
|
[opts target & objects]
|
||||||
(def ld (or (opts :linker) LD))
|
(def ld (or (opts :linker) LD))
|
||||||
(def cflags (or (opts :cflags) CFLAGS))
|
(def cflags (or (opts :cflags) CFLAGS))
|
||||||
|
(def lflags (or (opts :lflags) ""))
|
||||||
(def olist (string/join objects " "))
|
(def olist (string/join objects " "))
|
||||||
(if (older-than-some target objects)
|
(if (older-than-some target objects)
|
||||||
(if is-win
|
(if is-win
|
||||||
(shell ld "/out:" target " " olist)
|
(shell ld " /DLL /OUT:" target " " olist " %JANET_PATH%\\janet.lib")
|
||||||
(shell ld " " cflags " -o " target " " olist))))
|
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||||
|
|
||||||
(defn- create-buffer-c
|
(defn- create-buffer-c
|
||||||
"Inline raw byte file as a c file."
|
"Inline raw byte file as a c file."
|
||||||
|
|||||||
@@ -1,7 +1,5 @@
|
|||||||
# Generate documentation
|
# Generate documentation
|
||||||
|
|
||||||
# TODO - make tool reusable
|
|
||||||
|
|
||||||
(def- prelude
|
(def- prelude
|
||||||
```
|
```
|
||||||
<!doctype html>
|
<!doctype html>
|
||||||
@@ -57,14 +55,29 @@
|
|||||||
(buffer/push-byte buf byte)))
|
(buffer/push-byte buf byte)))
|
||||||
buf)
|
buf)
|
||||||
|
|
||||||
|
(def- months '("January" "February" "March" "April" "May" "June" "July" "August" "September"
|
||||||
|
"October" "November" "December"))
|
||||||
|
(defn nice-date
|
||||||
|
"Get the current date nicely formatted"
|
||||||
|
[]
|
||||||
|
(let [date (os/date)
|
||||||
|
M (months (date :month))
|
||||||
|
D (+ (date :month-day) 1)
|
||||||
|
Y (date :year)
|
||||||
|
HH (date :hours)
|
||||||
|
MM (date :minutes)
|
||||||
|
SS (date :seconds)]
|
||||||
|
(string/format "%s %d, %d at %.2d:%.2d:%.2d"
|
||||||
|
M D Y HH MM SS)))
|
||||||
|
|
||||||
(defn- make-title
|
(defn- make-title
|
||||||
"Generate title"
|
"Generate title"
|
||||||
[]
|
[]
|
||||||
(string "<h1>Janet Core API</h1>"
|
(string "<h1>Janet Core API</h1>"
|
||||||
"<p>Version " janet/version "-" janet/build "</p>"
|
"<p>Version " janet/version "-" janet/build "</p>"
|
||||||
"<p>Generated "
|
"<p>Generated "
|
||||||
(string/number (os/time) :f 0 20)
|
(nice-date)
|
||||||
" seconds after epoch</p>"
|
"</p>"
|
||||||
"<hr>"))
|
"<hr>"))
|
||||||
|
|
||||||
(defn- emit-item
|
(defn- emit-item
|
||||||
@@ -75,6 +88,7 @@
|
|||||||
:ref ref
|
:ref ref
|
||||||
:source-map sm
|
:source-map sm
|
||||||
:doc docstring} env-entry
|
:doc docstring} env-entry
|
||||||
|
html-key (html-escape key)
|
||||||
binding-type (cond
|
binding-type (cond
|
||||||
macro :macro
|
macro :macro
|
||||||
ref (string :var " (" (type (get ref 0)) ")")
|
ref (string :var " (" (type (get ref 0)) ")")
|
||||||
@@ -82,14 +96,14 @@
|
|||||||
source-ref (if-let [[path start end] sm]
|
source-ref (if-let [[path start end] sm]
|
||||||
(string "<span class=\"source-map\">" path " (" start ":" end ")</span>")
|
(string "<span class=\"source-map\">" path " (" start ":" end ")</span>")
|
||||||
"")]
|
"")]
|
||||||
(string "<h2 class=\"binding\">" (html-escape key) "</h2>\n"
|
(string "<h2 class=\"binding\"><a id=\"" key "\">" html-key "</a></h2>\n"
|
||||||
"<span class=\"binding-type\">" binding-type "</span>\n"
|
"<span class=\"binding-type\">" binding-type "</span>\n"
|
||||||
"<p class=\"docstring\">" (trim-lead (html-escape docstring)) "</p>\n"
|
"<p class=\"docstring\">" (trim-lead (html-escape docstring)) "</p>\n"
|
||||||
source-ref)))
|
source-ref)))
|
||||||
|
|
||||||
# Generate parts and print them to stdout
|
# Generate parts and print them to stdout
|
||||||
(def parts (seq [[k entry]
|
(def parts (seq [[k entry]
|
||||||
:in (sort (pairs (table/getproto _env)))
|
:in (sort (pairs (table/getproto *env*)))
|
||||||
:when (and (get entry :doc) (not (get entry :private)))]
|
:when (and (get entry :doc) (not (get entry :private)))]
|
||||||
(emit-item k entry)))
|
(emit-item k entry)))
|
||||||
(print
|
(print
|
||||||
|
|||||||
198
tools/highlight.janet
Normal file
198
tools/highlight.janet
Normal file
@@ -0,0 +1,198 @@
|
|||||||
|
# Copyright (C) Calvin Rose 2019
|
||||||
|
#
|
||||||
|
# Takes in a janet string and colorizes for multiple
|
||||||
|
# output formats.
|
||||||
|
|
||||||
|
# Constants for checking if symbols should be
|
||||||
|
# highlighted.
|
||||||
|
(def- core-env (table/getproto *env*))
|
||||||
|
(def- specials {'fn true
|
||||||
|
'var true
|
||||||
|
'do true
|
||||||
|
'while true
|
||||||
|
'def true
|
||||||
|
'splice true
|
||||||
|
'set true
|
||||||
|
'break true
|
||||||
|
'unquote true
|
||||||
|
'quasiquote true
|
||||||
|
'quote true
|
||||||
|
'if true})
|
||||||
|
|
||||||
|
(defn check-number [text] (and (scan-number text) text))
|
||||||
|
|
||||||
|
(defn- make-grammar
|
||||||
|
"Creates the grammar based on the paint function, which
|
||||||
|
colorizes fragments of text."
|
||||||
|
[paint]
|
||||||
|
|
||||||
|
(defn <-c
|
||||||
|
"Peg rule for capturing and coloring a rule."
|
||||||
|
[color what]
|
||||||
|
~(/ (<- ,what) ,(partial paint color)))
|
||||||
|
|
||||||
|
(defn color-symbol
|
||||||
|
"Color a symbol only if it is a core library binding or special."
|
||||||
|
[text]
|
||||||
|
(def sym (symbol text))
|
||||||
|
(def should-color (or (specials sym) (core-env sym)))
|
||||||
|
(paint (if should-color :coresym :symbol) text))
|
||||||
|
|
||||||
|
~{:ws (set " \t\r\f\n\v\0")
|
||||||
|
:readermac (set "';~,")
|
||||||
|
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
|
||||||
|
:token (some :symchars)
|
||||||
|
:hex (range "09" "af" "AF")
|
||||||
|
:escape (* "\\" (+ (set "ntrvzf0\"\\e")
|
||||||
|
(* "x" :hex :hex)
|
||||||
|
(error (constant "bad hex escape"))))
|
||||||
|
|
||||||
|
:comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1))))
|
||||||
|
|
||||||
|
:symbol (/ ':token ,color-symbol)
|
||||||
|
:keyword ,(<-c :keyword ~(* ":" (any :symchars)))
|
||||||
|
:constant ,(<-c :constant ~(+ "true" "false" "nil"))
|
||||||
|
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
|
||||||
|
:string ,(<-c :string :bytes)
|
||||||
|
:buffer ,(<-c :string ~(* "@" :bytes))
|
||||||
|
:long-bytes {:delim (some "`")
|
||||||
|
:open (capture :delim :n)
|
||||||
|
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
|
||||||
|
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||||
|
:long-string ,(<-c :string :long-bytes)
|
||||||
|
:long-buffer ,(<-c :string ~(* "@" :long-bytes))
|
||||||
|
:number (/ (cmt ':token ,check-number) ,(partial paint :number))
|
||||||
|
|
||||||
|
:raw-value (+ :comment :constant :number :keyword
|
||||||
|
:string :buffer :long-string :long-buffer
|
||||||
|
:parray :barray :ptuple :btuple :struct :dict :symbol)
|
||||||
|
|
||||||
|
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
|
||||||
|
:root (any :value)
|
||||||
|
:root2 (any (* :value :value))
|
||||||
|
:ptuple (* '"(" :root (+ '")" (error "")))
|
||||||
|
:btuple (* '"[" :root (+ '"]" (error "")))
|
||||||
|
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||||
|
:parray (* '"@" :ptuple)
|
||||||
|
:barray (* '"@" :btuple)
|
||||||
|
:dict (* '"@" :struct)
|
||||||
|
|
||||||
|
:main (+ (% :root) (error ""))})
|
||||||
|
|
||||||
|
# Terminal syntax highlighting
|
||||||
|
|
||||||
|
(def- terminal-colors
|
||||||
|
{:number 32
|
||||||
|
:keyword 33
|
||||||
|
:string 35
|
||||||
|
:coresym 31
|
||||||
|
:constant 34
|
||||||
|
:comment 36})
|
||||||
|
|
||||||
|
(defn- terminal-paint
|
||||||
|
"Paint colors for ansi terminals"
|
||||||
|
[what str]
|
||||||
|
(def code (get terminal-colors what))
|
||||||
|
(if code (string "\e[" code "m" str "\e[0m") str))
|
||||||
|
|
||||||
|
# HTML syntax highlighting
|
||||||
|
|
||||||
|
(def- html-colors
|
||||||
|
{:number "j-number"
|
||||||
|
:keyword "j-keyword"
|
||||||
|
:string "j-string"
|
||||||
|
:coresym "j-coresym"
|
||||||
|
:constant "j-constant"
|
||||||
|
:comment "j-comment"
|
||||||
|
:line "j-line"})
|
||||||
|
|
||||||
|
(def- escapes
|
||||||
|
{38 "&"
|
||||||
|
60 "<"
|
||||||
|
62 ">"
|
||||||
|
34 """
|
||||||
|
39 "'"
|
||||||
|
47 "/"})
|
||||||
|
|
||||||
|
(def html-style
|
||||||
|
"Style tag to add to a page to highlight janet code"
|
||||||
|
```
|
||||||
|
<style type="text/css">
|
||||||
|
.j-main { color: white; background: #111; font-size: 1.4em; }
|
||||||
|
.j-number { color: #89dc76; }
|
||||||
|
.j-keyword { color: #ffd866; }
|
||||||
|
.j-string { color: #ab90f2; }
|
||||||
|
.j-coresym { color: #ff6188; }
|
||||||
|
.j-constant { color: #fc9867; }
|
||||||
|
.j-comment { color: darkgray; }
|
||||||
|
.j-line { color: gray; }
|
||||||
|
</style>
|
||||||
|
```)
|
||||||
|
|
||||||
|
(defn html-escape
|
||||||
|
"Escape special characters for HTML encoding."
|
||||||
|
[str]
|
||||||
|
(def buf @"")
|
||||||
|
(loop [byte :in str]
|
||||||
|
(if-let [rep (get escapes byte)]
|
||||||
|
(buffer/push-string buf rep)
|
||||||
|
(buffer/push-byte buf byte)))
|
||||||
|
buf)
|
||||||
|
|
||||||
|
(defn- html-paint
|
||||||
|
"Paint colors for HTML"
|
||||||
|
[what str]
|
||||||
|
(def color (get html-colors what))
|
||||||
|
(def escaped (html-escape str))
|
||||||
|
(if color
|
||||||
|
(string "<span class=\"" color "\">" escaped "</span>")
|
||||||
|
escaped))
|
||||||
|
|
||||||
|
# Create Pegs
|
||||||
|
|
||||||
|
(def- terminal-grammar (peg/compile (make-grammar terminal-paint)))
|
||||||
|
(def- html-grammar (peg/compile (make-grammar html-paint)))
|
||||||
|
|
||||||
|
# API
|
||||||
|
|
||||||
|
(defn ansi
|
||||||
|
"Highlight janet source code ANSI Termianl escape colors."
|
||||||
|
[source]
|
||||||
|
(0 (peg/match terminal-grammar source)))
|
||||||
|
|
||||||
|
(defn html
|
||||||
|
"Highlight janet source code and output HTML."
|
||||||
|
[source]
|
||||||
|
(string "<pre class=\"j-main\"><code>"
|
||||||
|
(0 (peg/match html-grammar source))
|
||||||
|
"</code></pre>"))
|
||||||
|
|
||||||
|
(defn html-file
|
||||||
|
"Highlight a janet file and print out a highlighted HTML version
|
||||||
|
of the file. Must provide a default title when creating the file."
|
||||||
|
[in-path out-path title &]
|
||||||
|
(default title in-path)
|
||||||
|
(def f (file/open in-path :r))
|
||||||
|
(def source (file/read f :all))
|
||||||
|
(file/close f)
|
||||||
|
(def markup (0 (peg/match html-grammar source)))
|
||||||
|
(def out (file/open out-path :w))
|
||||||
|
(file/write out
|
||||||
|
"<!doctype html><html><head><meta charset=\"UTF-8\">"
|
||||||
|
html-style
|
||||||
|
"<title>"
|
||||||
|
title
|
||||||
|
"</title></head>"
|
||||||
|
"<body class=\"j-main\"><pre>"
|
||||||
|
markup
|
||||||
|
"</pre></body></html>")
|
||||||
|
(file/close out))
|
||||||
|
|
||||||
|
(defn ansi-file
|
||||||
|
"Highlight a janet file and print the highlighted output to stdout."
|
||||||
|
[in-path]
|
||||||
|
(def f (file/open in-path :r))
|
||||||
|
(def source (file/read f :all))
|
||||||
|
(file/close f)
|
||||||
|
(def markup (0 (peg/match terminal-grammar source)))
|
||||||
|
(print markup))
|
||||||
@@ -1,21 +0,0 @@
|
|||||||
# Tool to dump a marshalled version of the janet core to stdout. The
|
|
||||||
# image should eventually allow janet to be started from a pre-compiled
|
|
||||||
# image rather than recompiled every time from the embedded source. More
|
|
||||||
# work will go into shrinking the image (it isn't currently that large but
|
|
||||||
# could be smaller), creating the mechanism to load the image, and modifying
|
|
||||||
# the build process to compile janet with a built image rather than
|
|
||||||
# embedded source.
|
|
||||||
|
|
||||||
# Get image. This image contains as much of the core library and documentation that
|
|
||||||
# can be written to an image (no cfunctions, no abstracts (stdout, stdin, stderr)),
|
|
||||||
# everything else goes. Cfunctions and abstracts will be referenced from a register
|
|
||||||
# table which will be generated on janet startup.
|
|
||||||
(def image (let [env-pairs (pairs (env-lookup _env))
|
|
||||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
|
||||||
lookup (table ;(mapcat identity essential-pairs))
|
|
||||||
reverse-lookup (invert lookup)]
|
|
||||||
(marshal (table/getproto _env) reverse-lookup)))
|
|
||||||
|
|
||||||
# Write image
|
|
||||||
(file/write stdout image)
|
|
||||||
(file/flush stdout)
|
|
||||||
@@ -29,23 +29,23 @@ static int is_symbol_char_gen(uint8_t c) {
|
|||||||
if (c >= 'A' && c <= 'Z') return 1;
|
if (c >= 'A' && c <= 'Z') return 1;
|
||||||
if (c >= '0' && c <= '9') return 1;
|
if (c >= '0' && c <= '9') return 1;
|
||||||
return (c == '!' ||
|
return (c == '!' ||
|
||||||
c == '$' ||
|
c == '$' ||
|
||||||
c == '%' ||
|
c == '%' ||
|
||||||
c == '&' ||
|
c == '&' ||
|
||||||
c == '*' ||
|
c == '*' ||
|
||||||
c == '+' ||
|
c == '+' ||
|
||||||
c == '-' ||
|
c == '-' ||
|
||||||
c == '.' ||
|
c == '.' ||
|
||||||
c == '/' ||
|
c == '/' ||
|
||||||
c == ':' ||
|
c == ':' ||
|
||||||
c == '<' ||
|
c == '<' ||
|
||||||
c == '?' ||
|
c == '?' ||
|
||||||
c == '=' ||
|
c == '=' ||
|
||||||
c == '>' ||
|
c == '>' ||
|
||||||
c == '@' ||
|
c == '@' ||
|
||||||
c == '^' ||
|
c == '^' ||
|
||||||
c == '_' ||
|
c == '_' ||
|
||||||
c == '|');
|
c == '|');
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int main() {
|
||||||
|
|||||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user