mirror of
https://github.com/janet-lang/janet
synced 2025-11-22 02:04:49 +00:00
Compare commits
215 Commits
0.2.0
...
clean-stri
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
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 | ||
|
|
d5bab72620 | ||
|
|
aa079e3145 | ||
|
|
d64a57297d | ||
|
|
be85196de8 | ||
|
|
eae4e0dede | ||
|
|
92e9e64945 | ||
|
|
63dd6d03f4 | ||
|
|
2a79d2e749 | ||
|
|
6f3bc3d577 | ||
|
|
ef5eed2c21 | ||
|
|
5865692401 | ||
|
|
b626e73d19 | ||
|
|
b535c91ee1 | ||
|
|
7b28032f5c | ||
|
|
0fdd404a71 | ||
|
|
1f98eff33a | ||
|
|
338b31f5a2 | ||
|
|
b60e3e302a | ||
|
|
5b62c8e6db | ||
|
|
cd6a7793e8 | ||
|
|
5afb00859a | ||
|
|
001917f8d9 | ||
|
|
b9c0fc8201 | ||
|
|
d8b0a5ed01 | ||
|
|
5fa96a6f8c | ||
|
|
dd3fc24a1e | ||
|
|
ddba0010b0 | ||
|
|
337a498edb | ||
|
|
5fff36d047 | ||
|
|
a679f60e07 | ||
|
|
58d480539c | ||
|
|
6afaacf2af | ||
|
|
e9c94598e6 | ||
|
|
29ec30c79f | ||
|
|
122312dbf6 | ||
|
|
618f8d6818 | ||
|
|
0d4ab7dee0 | ||
|
|
6b4824c2ab | ||
|
|
8dde89126e | ||
|
|
56927e1b81 | ||
|
|
9e6254bf56 | ||
|
|
fe22a8db39 | ||
|
|
d724c5b959 | ||
|
|
ca9c017ec4 | ||
|
|
65be318306 | ||
|
|
7c4671d98f | ||
|
|
7880d73201 | ||
|
|
00f0f628e8 | ||
|
|
21b7583a7c | ||
|
|
42c6aca526 | ||
|
|
52b8781684 | ||
|
|
5d39570ec9 | ||
|
|
28331ad6ab | ||
|
|
129ec1e3c5 | ||
|
|
bdcd3a3dbf | ||
|
|
6c8f49206d | ||
|
|
b06f7226c4 | ||
|
|
2bcedd5920 | ||
|
|
5c84f0f5d9 | ||
|
|
424073bbb8 | ||
|
|
e9a80d4e4a | ||
|
|
1ec7f04642 | ||
|
|
59f6c335ad | ||
|
|
6b95326d7c | ||
|
|
5a3190d471 | ||
|
|
e7a8958c63 | ||
|
|
017ee2b0d1 | ||
|
|
a7933f5f08 | ||
|
|
be7fc79b6f | ||
|
|
6c8da9fe5c | ||
|
|
17283241ab |
@@ -1,9 +1,9 @@
|
||||
image: freebsd
|
||||
image: freebsd/latest
|
||||
packages:
|
||||
- gmake
|
||||
- gcc
|
||||
sources:
|
||||
- https://github.com/bakpakin/janet.git
|
||||
- https://github.com/janet-lang/janet.git
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
|
||||
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
|
||||
4
.gitignore
vendored
4
.gitignore
vendored
@@ -12,6 +12,9 @@ janet
|
||||
janet-*.tar.gz
|
||||
dist
|
||||
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
# Emscripten
|
||||
*.bc
|
||||
janet.js
|
||||
@@ -39,6 +42,7 @@ tags
|
||||
|
||||
# Valgrind files
|
||||
vgcore.*
|
||||
*.out.*
|
||||
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
|
||||
@@ -19,5 +19,5 @@ deploy:
|
||||
skip_cleanup: true
|
||||
on:
|
||||
tags: true
|
||||
repo: bakpakin/janet
|
||||
repo: janet-lang/janet
|
||||
condition: "$CC = clang"
|
||||
|
||||
29
CHANGELOG.md
Normal file
29
CHANGELOG.md
Normal file
@@ -0,0 +1,29 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 0.4.0 - ??
|
||||
- `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.
|
||||
@@ -33,6 +33,29 @@ may require changes before being merged.
|
||||
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.
|
||||
|
||||
## C style
|
||||
|
||||
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
|
||||
a subset of C99 that works with Microsoft Visual C++. This means most of C99 but with the following
|
||||
omissions.
|
||||
|
||||
* No Variable Length Arrays (yes these may work in newer MSVC compilers)
|
||||
* No `restrict`
|
||||
* Certain functions in the standard library are not always available
|
||||
|
||||
In practice, this means programming for both MSVC on one hand and everything else on the other.
|
||||
The code must also build with emscripten, even if some features are not available, although
|
||||
this is not a priority.
|
||||
|
||||
Code should compile warning free and run valgrind clean. I find that these two criteria are some
|
||||
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.
|
||||
|
||||
## Janet style
|
||||
|
||||
All janet code in the project should be formatted similar to the code in core.janet.
|
||||
The auto formatting from janet.vim will work well.
|
||||
|
||||
## Suggesting Changes
|
||||
|
||||
To suggest changes, open an issue on GitHub. Check GitHub for other issues
|
||||
|
||||
2
LICENSE
2
LICENSE
@@ -1,4 +1,4 @@
|
||||
Copyright (c) 2018 Calvin Rose
|
||||
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
|
||||
|
||||
91
Makefile
91
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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -31,7 +31,7 @@ JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
CLIBS=-lm -ldl
|
||||
CLIBS=-lm
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_PATH?=/usr/local/lib/janet
|
||||
@@ -42,12 +42,15 @@ LDCONFIG:=ldconfig
|
||||
ifeq ($(UNAME), Darwin)
|
||||
# Add other macos/clang flags
|
||||
LDCONFIG:=
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
else ifeq ($(UNAME), OpenBSD)
|
||||
# pass ...
|
||||
else
|
||||
CFLAGS:=$(CFLAGS) -rdynamic
|
||||
CLIBS:=$(CLIBS) -lrt
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient)
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
|
||||
# Source headers
|
||||
JANET_HEADERS=$(sort $(wildcard src/include/janet/*.h))
|
||||
@@ -60,14 +63,33 @@ JANET_WEBCLIENT_SOURCES=$(sort $(wildcard src/webclient/*.c))
|
||||
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
||||
|
||||
##################################################################
|
||||
##### The bootstrap interpreter that compiles the core image #####
|
||||
##################################################################
|
||||
|
||||
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) src/boot/boot.c) \
|
||||
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
|
||||
build/janet_boot
|
||||
|
||||
##########################################################
|
||||
##### 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
|
||||
|
||||
%.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 $<
|
||||
|
||||
build/%.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
@@ -92,11 +114,14 @@ EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
||||
JANET_EMTARGET=build/janet.js
|
||||
JANET_WEB_SOURCES=$(JANET_CORE_SOURCES) $(JANET_WEBCLIENT_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
|
||||
$(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)
|
||||
$(EMCC) $(EMCFLAGS) -o $@ -c $<
|
||||
|
||||
@@ -109,6 +134,9 @@ emscripten: $(JANET_EMTARGET)
|
||||
##### Generated C files #####
|
||||
#############################
|
||||
|
||||
%.gen.o: %.gen.c
|
||||
$(CC) $(CFLAGS) -o $@ -c $<
|
||||
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
@@ -118,37 +146,47 @@ build/init.gen.c: src/mainclient/init.janet build/xxd
|
||||
build/xxd $< $@ janet_gen_init
|
||||
build/webinit.gen.c: src/webclient/webinit.janet build/xxd
|
||||
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/janet.h
|
||||
cp $< $@
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
|
||||
TEST_SOURCES=$(wildcard ctest/*.c)
|
||||
TEST_PROGRAMS=$(patsubst ctest/%.c,build/%.out,$(TEST_SOURCES))
|
||||
TEST_SCRIPTS=$(wildcard test/suite*.janet)
|
||||
|
||||
build/%.out: ctest/%.c $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
repl: $(JANET_TARGET)
|
||||
./$(JANET_TARGET)
|
||||
|
||||
debug: $(JANET_TARGET)
|
||||
$(DEBUGGER) ./$(JANET_TARGET)
|
||||
|
||||
VALGRIND_COMMAND=valgrind --leak-check=full
|
||||
|
||||
valgrind: $(JANET_TARGET)
|
||||
valgrind --leak-check=full -v ./$(JANET_TARGET)
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in build/*.out; do "$$f" || exit; done
|
||||
for f in test/*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
VALGRIND_COMMAND=valgrind --leak-check=full -v
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in build/*.out; do $(VALGRIND_COMMAND) "$$f" || exit; done
|
||||
for f in test/*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
|
||||
########################
|
||||
##### Distribution #####
|
||||
########################
|
||||
@@ -157,7 +195,7 @@ dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet/janet.h \
|
||||
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 $@ $^
|
||||
|
||||
#########################
|
||||
@@ -166,15 +204,19 @@ build/janet-%.tar.gz: $(JANET_TARGET) src/include/janet/janet.h \
|
||||
|
||||
docs: build/doc.html
|
||||
|
||||
build/doc.html: $(JANET_TARGET) doc/gendoc.janet
|
||||
$(JANET_TARGET) doc/gendoc.janet > build/doc.html
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
#################
|
||||
|
||||
grammar: build/janet.tmLanguage
|
||||
build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) $< > $@
|
||||
|
||||
clean:
|
||||
-rm -rf build
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
|
||||
install: $(JANET_TARGET)
|
||||
mkdir -p $(BINDIR)
|
||||
@@ -183,6 +225,9 @@ install: $(JANET_TARGET)
|
||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
||||
mkdir -p $(LIBDIR)
|
||||
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so
|
||||
mkdir -p $(JANET_PATH)
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp janet.1 /usr/local/share/man/man1/
|
||||
mandb
|
||||
$(LDCONFIG)
|
||||
@@ -193,6 +238,6 @@ uninstall:
|
||||
-rm -rf $(INCLUDEDIR)
|
||||
$(LDCONFIG)
|
||||
|
||||
.PHONY: clean install repl debug valgrind test \
|
||||
valtest emscripten dist uninstall docs \
|
||||
.PHONY: clean install repl debug valgrind test amalg \
|
||||
valtest emscripten dist uninstall docs grammar \
|
||||
$(TEST_PROGRAM_PHONIES) $(TEST_PROGRAM_VALPHONIES)
|
||||
|
||||
56
README.md
56
README.md
@@ -1,7 +1,10 @@
|
||||
[](https://travis-ci.org/bakpakin/janet)
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet)
|
||||
[](https://gitter.im/janet-language/community)
|
||||
|
||||
[](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/honix/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
|
||||
modern lisp, but lists are replaced
|
||||
@@ -10,7 +13,7 @@ The language also bridging bridging to native code written in C, meta-programmin
|
||||
|
||||
There is a repl for trying out the language, as well as the ability
|
||||
to run script files. This client program is separate from the core runtime, so
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
janet could be embedded into other programs. Try janet in your browser at
|
||||
[https://janet-lang.org](https://janet-lang.org).
|
||||
|
||||
#
|
||||
@@ -19,9 +22,9 @@ Implemented in mostly standard C99, janet runs on Windows, Linux and macOS.
|
||||
The few features that are not standard C (dynamic library loading, compiler specific optimizations),
|
||||
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/bakpakin/janet.vim).
|
||||
Generic lisp syntax highlighting should, however, provide good results. There is also a janet.tmLanguage file
|
||||
that should provide good syntax highlighting for many editors.
|
||||
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. One can also generate a janet.tmLanguage
|
||||
file for other programs with `make grammar`.
|
||||
|
||||
## Use Cases
|
||||
|
||||
@@ -46,12 +49,14 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
* Lexical scoping
|
||||
* Imperative programming as well as functional
|
||||
* REPL
|
||||
* Parsing Expression Grammars built in to the core library
|
||||
* 300+ functions and macros in the core library
|
||||
* Embedding Janet in other programs
|
||||
* Interactive environment with detailed stack traces
|
||||
|
||||
## Documentation
|
||||
|
||||
Documentation can be found in the doc directory of
|
||||
Documentation can be found in the doc directory of
|
||||
the repository. There is an introduction
|
||||
section contains a good overview of the language.
|
||||
|
||||
@@ -66,15 +71,16 @@ documentation for the core library. For example,
|
||||
(doc doc)
|
||||
```
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-symbols)` function.
|
||||
|
||||
## Installation
|
||||
|
||||
Install a stable version of janet from the [releases page](https://github.com/bakpakin/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
|
||||
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
|
||||
|
||||
@@ -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`
|
||||
|
||||
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
|
||||
@@ -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
|
||||
|
||||
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
|
||||
before compilation.
|
||||
|
||||
### Unix-like
|
||||
### macos and Unix-like
|
||||
|
||||
On most platforms, use Make to build janet. The resulting binary will be in `build/janet`.
|
||||
|
||||
@@ -159,3 +177,15 @@ Building with emscripten on windows is currently unsupported.
|
||||
## Examples
|
||||
|
||||
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
|
||||
|
||||
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">
|
||||
|
||||
|
||||
@@ -45,4 +45,4 @@ deploy:
|
||||
artifact: janet-windows
|
||||
draft: true
|
||||
on:
|
||||
APPVEYOR_REPO_TAG: true
|
||||
APPVEYOR_REPO_TAG: true
|
||||
|
||||
BIN
assets/janet-the-good-place.gif
Normal file
BIN
assets/janet-the-good-place.gif
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 109 KiB |
@@ -22,6 +22,7 @@
|
||||
mkdir build
|
||||
mkdir build\core
|
||||
mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the xxd tool for generating sources
|
||||
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
@@ -30,15 +31,36 @@ mkdir build\mainclient
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@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
|
||||
@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
|
||||
|
||||
@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
|
||||
@%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
|
||||
build\janet_boot
|
||||
|
||||
@rem Build the core image
|
||||
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the sources
|
||||
@@ -54,7 +76,7 @@ for %%f in (src\mainclient\*.c) do (
|
||||
)
|
||||
|
||||
@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
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
@@ -93,13 +115,16 @@ exit /b 0
|
||||
@rem Build a dist directory
|
||||
:DIST
|
||||
mkdir dist
|
||||
janet.exe doc\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 LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
copy src\include\janet\janet.h dist\janet.h
|
||||
copy tools\cook.janet dist\cook.janet
|
||||
copy tools\highlight.janet dist\highlight.janet
|
||||
exit /b 0
|
||||
|
||||
:TESTFAIL
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
int i;
|
||||
JanetArray *array1, *array2;
|
||||
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
int i;
|
||||
JanetBuffer *buffer1, *buffer2;
|
||||
|
||||
|
||||
69
ctest/number_test.c
Normal file
69
ctest/number_test.c
Normal file
@@ -0,0 +1,69 @@
|
||||
/*
|
||||
* 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/janet.h>
|
||||
#include <stdio.h>
|
||||
#include <string.h>
|
||||
#include <assert.h>
|
||||
|
||||
/* Check a subset of numbers against system implementation.
|
||||
* Note that this depends on the system implementation being correct,
|
||||
* which may not be the case for old or non compliant systems. Also,
|
||||
* we cannot check against bases other 10. */
|
||||
|
||||
/* Compare valid c numbers to system implementation. */
|
||||
static void test_valid_str(const char *str) {
|
||||
int err;
|
||||
double cnum, jnum;
|
||||
jnum = 0.0;
|
||||
cnum = atof(str);
|
||||
err = janet_scan_number((const uint8_t *) str, strlen(str), &jnum);
|
||||
assert(!err);
|
||||
assert(cnum == jnum);
|
||||
}
|
||||
|
||||
int main() {
|
||||
|
||||
janet_init();
|
||||
|
||||
test_valid_str("1.0");
|
||||
test_valid_str("1");
|
||||
test_valid_str("2.1");
|
||||
test_valid_str("1e10");
|
||||
test_valid_str("2e10");
|
||||
test_valid_str("1e-10");
|
||||
test_valid_str("2e-10");
|
||||
test_valid_str("1.123123e10");
|
||||
test_valid_str("1.123123e-10");
|
||||
test_valid_str("-1.23e2");
|
||||
test_valid_str("-4.5e15");
|
||||
test_valid_str("-4.5e151");
|
||||
test_valid_str("-4.5e200");
|
||||
test_valid_str("-4.5e123");
|
||||
test_valid_str("123123123123123123132123");
|
||||
test_valid_str("0000000011111111111111111111111111");
|
||||
test_valid_str(".112312333333323123123123123123123");
|
||||
|
||||
janet_deinit();
|
||||
|
||||
return 0;
|
||||
}
|
||||
@@ -1,6 +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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -43,8 +42,8 @@ int main() {
|
||||
assert(janet_equals(janet_wrap_integer(INT32_MAX), janet_wrap_integer(INT32_MAX)));
|
||||
assert(janet_equals(janet_wrap_integer(-2), janet_wrap_integer(-2)));
|
||||
assert(janet_equals(janet_wrap_integer(INT32_MIN), janet_wrap_integer(INT32_MIN)));
|
||||
assert(janet_equals(janet_wrap_real(1.4), janet_wrap_real(1.4)));
|
||||
assert(janet_equals(janet_wrap_real(3.14159265), janet_wrap_real(3.14159265)));
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -24,7 +24,7 @@
|
||||
#include <assert.h>
|
||||
|
||||
int main() {
|
||||
|
||||
|
||||
JanetTable *t1, *t2;
|
||||
|
||||
janet_init();
|
||||
@@ -39,7 +39,7 @@ int main() {
|
||||
|
||||
assert(t1->count == 4);
|
||||
assert(t1->capacity >= t1->count);
|
||||
|
||||
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("hello")), janet_wrap_integer(2)));
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("akey")), janet_wrap_integer(5)));
|
||||
assert(janet_equals(janet_table_get(t1, janet_cstringv("box")), janet_wrap_boolean(0)));
|
||||
|
||||
@@ -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,746 +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.
|
||||
|
||||
Janet actually has two "flavors" of numbers; integers and real numbers. Integers are any
|
||||
integer value between -2,147,483,648 and 2,147,483,647 (32 bit signed integer).
|
||||
Reals are real numbers, and are represented by IEEE-754 double precision floating point
|
||||
numbers. That means that they can represent any number an integer can represent, as well
|
||||
fractions to very high precision.
|
||||
|
||||
Although real numbers can represent any value an integer can, try to distinguish between
|
||||
real numbers and integers in your program. If you are using a number to index into a structure,
|
||||
you probably want integers. Otherwise, you may want to use reals (this is only a rule of thumb).
|
||||
|
||||
Arithmetic operator will convert integers to real numbers if needed, but real numbers
|
||||
will not be converted to integers, as not all real numbers can be safely converted to integers.
|
||||
|
||||
## 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 bitwise 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!) Bitwise functions are all prefixed with b.
|
||||
Thet are `bnot`, `bor`, `bxor`, `band`, `blshift`, `brshift`, and `brushift`. Bitwise
|
||||
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 are actually just special cases of symbols, which are similar but don't start with
|
||||
a semicolon. 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.
|
||||
|
||||
```
|
||||
(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.
|
||||
|
||||
```
|
||||
# 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.
|
||||
|
||||
```
|
||||
(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.
|
||||
|
||||
```
|
||||
(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 |
|
||||
| Byteseq | Buffer | String (Symbol) |
|
||||
|
||||
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 'byteseq' abstraction is any type that contains a sequence of bytes. A 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.
|
||||
|
||||
```
|
||||
# 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 backtick 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 guarenteed 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!
|
||||
245
doc/Parser.md
245
doc/Parser.md
@@ -1,245 +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. 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 really just 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 either 32 bit integers or
|
||||
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 definining multiline 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 whitespace.
|
||||
|
||||
```
|
||||
(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 whitespace 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 multiline comments. For ricm multiline comments, use a
|
||||
string literal.
|
||||
|
||||
## Shorthands
|
||||
|
||||
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`
|
||||
@@ -1,31 +0,0 @@
|
||||
# SQLite bindings
|
||||
|
||||
There are some sqlite3 bindings in the directory natives/sqlite3 bundled with
|
||||
the janet source code. They serve mostly as a
|
||||
proof of concept external c library. To use, first compile the module with Make.
|
||||
|
||||
```sh
|
||||
make natives
|
||||
```
|
||||
|
||||
Next, enter the repl and create a database and a table.
|
||||
|
||||
```
|
||||
janet:1:> (import natives/sqlite3 :as sql)
|
||||
nil
|
||||
janet:2:> (def db (sql/open "test.db"))
|
||||
<sqlite3.connection 0x5561A138C470>
|
||||
janet:3:> (sql/eval db `CREATE TABLE customers(id INTEGER PRIMARY KEY, name TEXT);`)
|
||||
@[]
|
||||
janet:4:> (sql/eval db `INSERT INTO customers VALUES(:id, :name);` {:name "John" :id 12345})
|
||||
@[]
|
||||
janet:5:> (sql/eval db `SELECT * FROM customers;`)
|
||||
@[{"id" 12345 "name" "John"}]
|
||||
```
|
||||
|
||||
Finally, close the database connection when done with it.
|
||||
|
||||
```
|
||||
janet:6:> (sql/close db)
|
||||
nil
|
||||
```
|
||||
@@ -1,238 +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 typechecking 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
|
||||
bitwise 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. The 'i' suffix is short for integer,
|
||||
and the 'r' suffix is short for real.
|
||||
|
||||
### Reference Table
|
||||
|
||||
| Instruction | Signature | Description |
|
||||
| ----------- | --------------------------- | --------------------------------- |
|
||||
| `add` | `(add dest lhs rhs)` | $dest = $lhs + $rhs |
|
||||
| `addi` | `(addi dest lhs rhs)` | $dest = $lhs +i $rhs |
|
||||
| `addim` | `(addim dest lhs im)` | $dest = $lhs +i im |
|
||||
| `addr` | `(addr dest lhs rhs)` | $dest = $lhs +r $rhs |
|
||||
| `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 |
|
||||
| `divi` | `(divi dest lhs rhs)` | $dest = $lhs /i $rhs |
|
||||
| `divim` | `(divim dest lhs im)` | $dest = $lhs /i im |
|
||||
| `divr` | `(divr dest lhs rhs)` | $dest = $lhs /r $rhs |
|
||||
| `eq` | `(eq dest lhs rhs)` | $dest = $lhs == $rhs |
|
||||
| `eqi` | `(eqi dest lhs rhs)` | $dest = $lhs ==i $rhs |
|
||||
| `eqim` | `(eqim dest lhs im)` | $dest = $lhs ==i im |
|
||||
| `eqr` | `(eqr dest lhs rhs)` | $dest = $lhs ==r $rhs |
|
||||
| `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 |
|
||||
| `gti` | `(gti dest lhs rhs)` | $dest = $lhs \>i $rhs |
|
||||
| `gtim` | `(gtim dest lhs im)` | $dest = $lhs \>i im |
|
||||
| `gtr` | `(gtr dest lhs rhs)` | $dest = $lhs \>r $rhs |
|
||||
| `gter` | `(gter dest lhs rhs)` | $dest = $lhs >=r $rhs |
|
||||
| `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 |
|
||||
| `lti` | `(lti dest lhs rhs)` | $dest = $lhs \<i $rhs |
|
||||
| `ltim` | `(ltim dest lhs im)` | $dest = $lhs \<i im |
|
||||
| `ltr` | `(ltr dest lhs rhs)` | $dest = $lhs \<r $rhs |
|
||||
| `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 |
|
||||
| `muli` | `(muli dest lhs rhs)` | $dest = $lhs \*i $rhs |
|
||||
| `mulim` | `(mulim dest lhs im)` | $dest = $lhs \*i im |
|
||||
| `mulr` | `(mulr dest lhs rhs)` | $dest = $lhs \*r $rhs |
|
||||
| `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 |
|
||||
|
||||
@@ -5,10 +5,14 @@
|
||||
(def solutions @{})
|
||||
(def len (length s))
|
||||
(for k 0 len
|
||||
(put tab s@k k))
|
||||
(put tab (s k) k))
|
||||
(for i 0 len
|
||||
(for j 0 len
|
||||
(def k (get tab (- 0 s@i s@j)))
|
||||
(def k (get tab (- 0 (s i) (s j))))
|
||||
(when (and k (not= k i) (not= k j) (not= i j))
|
||||
(put solutions {i true j true k true} true))))
|
||||
(map keys (keys solution)))
|
||||
(map keys (keys solutions)))
|
||||
|
||||
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||
(print "3sum of " (string/pretty arr) ":")
|
||||
(print (string/pretty (sum3 arr)))
|
||||
|
||||
@@ -13,8 +13,16 @@
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(addi 0 0 2) # $0 = $0 + $2 (integers)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
# Test it
|
||||
|
||||
(defn testn
|
||||
[n]
|
||||
(print "fibasm(" n ") = " (fibasm n)))
|
||||
|
||||
(for i 0 10 (testn i))
|
||||
|
||||
@@ -35,7 +35,13 @@
|
||||
:bright-white 97
|
||||
:bg-bright-white 107})
|
||||
|
||||
(loop [[name color] :in (pairs colormap)]
|
||||
(defglobal (string.slice name 1)
|
||||
(fn color-wrapper [& pieces]
|
||||
(string "\e[" color "m" (apply string pieces) "\e[0m"))))
|
||||
(defn color
|
||||
"Take a string made by concatenating xs and colorize it for an ANSI terminal."
|
||||
[c & xs]
|
||||
(def code (get colormap c))
|
||||
(if (not code) (error (string "color " c " unknown")))
|
||||
(string "\e[" code "m" ;xs "\e[0m"))
|
||||
|
||||
# Print all colors
|
||||
|
||||
(loop [c :keys colormap] (print (color c c)))
|
||||
|
||||
@@ -19,7 +19,7 @@
|
||||
,state
|
||||
(do
|
||||
(set ,loaded true)
|
||||
(set ,state (do ;forms)))))))
|
||||
(set ,state (do ,;forms)))))))
|
||||
|
||||
# Use tuples instead of structs to save memory
|
||||
(def- HEAD 0)
|
||||
@@ -52,7 +52,7 @@
|
||||
|
||||
(defn lazy-range
|
||||
"Return a sequence of integers [start, end)."
|
||||
@[start end]
|
||||
[start end &]
|
||||
(if end
|
||||
(if (< start end)
|
||||
(delay (tuple start (lazy-range (+ 1 start) end)))
|
||||
@@ -94,7 +94,7 @@
|
||||
(defn randseq
|
||||
"Return a sequence of random numbers."
|
||||
[]
|
||||
(delay (tuple (math.random) (randseq))))
|
||||
(delay (tuple (math/random) (randseq))))
|
||||
|
||||
(defn take-while
|
||||
"Returns a sequence of values until the predicate is false."
|
||||
|
||||
@@ -16,7 +16,7 @@
|
||||
(def cell-set (frequencies state))
|
||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||
(seq [coord :keys neighbor-set
|
||||
:let [count neighbor-set.coord]
|
||||
:let [count (get neighbor-set coord)]
|
||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||
coord))
|
||||
|
||||
@@ -24,7 +24,7 @@
|
||||
"Draw cells in the game of life from (x1, y1) to (x2, y2)"
|
||||
[state x1 y1 x2 y2]
|
||||
(def cellset @{})
|
||||
(each cell state (set cellset.cell true))
|
||||
(each cell state (put cellset cell true))
|
||||
(loop [x :range [x1 (+ 1 x2)]
|
||||
:after (print)
|
||||
y :range [y1 (+ 1 y2)]]
|
||||
|
||||
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))
|
||||
115
examples/numarray/numarray.c
Normal file
115
examples/numarray/numarray.c
Normal file
@@ -0,0 +1,115 @@
|
||||
#include <stdlib.h>
|
||||
#include <janet/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);
|
||||
}
|
||||
@@ -12,3 +12,5 @@
|
||||
(if (zero? (% i trial)) (set isprime? false)))
|
||||
(if isprime? (array/push list i)))
|
||||
list)
|
||||
|
||||
(print (string/pretty (primes 100)))
|
||||
|
||||
@@ -1,30 +0,0 @@
|
||||
# Helper to generate core library mappings for janet
|
||||
|
||||
(def allsyms (all-symbols))
|
||||
|
||||
(def- escapes
|
||||
{(get "|" 0) `\|`
|
||||
(get "-" 0) `\-`
|
||||
(get "+" 0) `\+`
|
||||
(get "*" 0) `\*`
|
||||
(get "^" 0) `\^`
|
||||
(get "$" 0) `\$`
|
||||
(get "?" 0) `\?`
|
||||
38 "&"
|
||||
60 "<"
|
||||
62 ">"
|
||||
34 """
|
||||
39 "'"
|
||||
47 "/"})
|
||||
|
||||
(defn- escape
|
||||
"Escape special characters for HTML and regex encoding."
|
||||
[str]
|
||||
(def buf @"")
|
||||
(loop [byte :in str]
|
||||
(if-let [rep escapes.byte]
|
||||
(buffer/push-string buf rep)
|
||||
(buffer/push-byte buf byte)))
|
||||
buf)
|
||||
|
||||
(print (string/join (map escape allsyms) "|"))
|
||||
45
janet.1
45
janet.1
@@ -1,25 +1,26 @@
|
||||
.TH JANET 1
|
||||
.SH NAME
|
||||
janet \- run the janet language abstract machine
|
||||
janet \- run the Janet language abstract machine
|
||||
.SH SYNOPSIS
|
||||
.B janet
|
||||
[\fB\-hvsrp\fR]
|
||||
[\fB\-e\fR \fIJANET SOURCE\fR]
|
||||
[\fB\-\-\fR]
|
||||
.IR files ...
|
||||
.IR script
|
||||
.IR args ...
|
||||
.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
|
||||
and performance (arrays, tables, structs, tuples). The language also bridging bridging
|
||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||
|
||||
There is a repl for trying out the language, as well as the ability to run script files.
|
||||
This client program is separate from the core runtime, so janet could be embedded
|
||||
into other programs. Try janet in your browser at https://janet-lang.org.
|
||||
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.
|
||||
|
||||
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
|
||||
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.
|
||||
.SH DOCUMENTATION
|
||||
|
||||
@@ -37,24 +38,34 @@ Shows the version text and exits immediately.
|
||||
|
||||
.TP
|
||||
.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 \-q
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
|
||||
.TP
|
||||
.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.
|
||||
|
||||
.TP
|
||||
.BR \-p
|
||||
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
|
||||
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
|
||||
after an error. Persistent mode can be good for debugging and testing.
|
||||
|
||||
.TP
|
||||
.BR \-e
|
||||
Execute a string of janet source. Source code is executed in the order it is encountered, so earlier
|
||||
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
|
||||
.BR \-l
|
||||
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
|
||||
.BR \-\-
|
||||
Stop parsing command line arguments. All arguments after this one will be considered file names.
|
||||
@@ -63,11 +74,11 @@ Stop parsing command line arguments. All arguments after this one will be consid
|
||||
|
||||
.B JANET_PATH
|
||||
.RS
|
||||
The location to look for janet libraries. This is the only environment variable janet needs to
|
||||
find native and source code modules. If no JANET_PATH is set, janet will look in
|
||||
/usr/local/lib/janet for modules.
|
||||
To make janet search multiple locations, modify the module.paths
|
||||
array in janet.
|
||||
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
|
||||
/usr/local/lib/Janet for modules.
|
||||
To make Janet search multiple locations, modify the module.paths
|
||||
array in Janet.
|
||||
.RE
|
||||
|
||||
.SH AUTHOR
|
||||
|
||||
@@ -1,44 +0,0 @@
|
||||
# Copyright (c) 2018 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.
|
||||
|
||||
CFLAGS:=-std=c99 -Wall -Wextra -O2 -shared -fpic
|
||||
CFLAGS=-std=c99 -Wall -Wextra -I../../src/include -O2 -shared -fpic
|
||||
OBJECTS:=json.o
|
||||
TARGET:=json.so
|
||||
|
||||
# MacOS specifics
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CFLAGS:=$(CFLAGS) -undefined dynamic_lookup
|
||||
endif
|
||||
|
||||
all: $(TARGET)
|
||||
|
||||
%.o: %.c $(HEADERS)
|
||||
$(CC) $(CFLAGS) -c $<
|
||||
|
||||
$(TARGET): $(OBJECTS)
|
||||
$(CC) $(CFLAGS) -o $@ $^
|
||||
|
||||
clean:
|
||||
rm $(OBJECTS)
|
||||
rm $(TARGET)
|
||||
|
||||
.PHONY: all clean
|
||||
@@ -1,25 +0,0 @@
|
||||
@rem Generated batch script, run in 'Visual Studio Developer Prompt'
|
||||
|
||||
@rem
|
||||
|
||||
@echo off
|
||||
|
||||
cl /nologo /I..\..\src\include /c /O2 /W3 json.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
link /nologo /dll ..\..\janet.lib /out:json.dll *.obj
|
||||
if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@echo .
|
||||
@echo ======
|
||||
@echo Build Succeeded.
|
||||
@echo =====
|
||||
exit /b 0
|
||||
|
||||
:BUILDFAIL
|
||||
@echo .
|
||||
@echo =====
|
||||
@echo BUILD FAILED. See Output For Details.
|
||||
@echo =====
|
||||
@echo .
|
||||
exit /b 1
|
||||
@@ -1,605 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2018 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/janet.h>
|
||||
#include <stdlib.h>
|
||||
#include <errno.h>
|
||||
|
||||
/*****************/
|
||||
/* JSON Decoding */
|
||||
/*****************/
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int white(uint8_t c) {
|
||||
return c == '\t' || c == '\n' || c == ' ' || c == '\r';
|
||||
}
|
||||
|
||||
/* Skip whitespace */
|
||||
static void skipwhite(const char **p) {
|
||||
const char *cp = *p;
|
||||
for (;;) {
|
||||
if (white(*cp))
|
||||
cp++;
|
||||
else
|
||||
break;
|
||||
}
|
||||
*p = cp;
|
||||
}
|
||||
|
||||
/* Get a hex digit value */
|
||||
static int hexdig(char dig) {
|
||||
if (dig >= '0' && dig <= '9')
|
||||
return dig - '0';
|
||||
if (dig >= 'a' && dig <= 'f')
|
||||
return 10 + dig - 'a';
|
||||
if (dig >= 'A' && dig <= 'F')
|
||||
return 10 + dig - 'A';
|
||||
return -1;
|
||||
}
|
||||
|
||||
/* Read the hex value for a unicode escape */
|
||||
static const char *decode_utf16_escape(const char *p, uint32_t *outpoint) {
|
||||
if (!p[0] || !p[1] || !p[2] || !p[3])
|
||||
return "unexpected end of source";
|
||||
int d1 = hexdig(p[0]);
|
||||
int d2 = hexdig(p[1]);
|
||||
int d3 = hexdig(p[2]);
|
||||
int d4 = hexdig(p[3]);
|
||||
if (d1 < 0 || d2 < 0 || d3 < 0 || d4 < 0)
|
||||
return "invalid hex digit";
|
||||
*outpoint = d4 | (d3 << 4) | (d2 << 8) | (d1 << 12);
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Parse a string. Also handles the conversion of utf-16 to
|
||||
* utf-8. */
|
||||
static const char *decode_string(const char **p, Janet *out) {
|
||||
JanetBuffer *buffer = janet_buffer(0);
|
||||
const char *cp = *p;
|
||||
while (*cp != '"') {
|
||||
uint8_t b = (uint8_t) *cp;
|
||||
if (b < 32) return "invalid character in string";
|
||||
if (b == '\\') {
|
||||
cp++;
|
||||
switch(*cp) {
|
||||
default:
|
||||
return "unknown string escape";
|
||||
case 'b':
|
||||
b = '\b';
|
||||
break;
|
||||
case 'f':
|
||||
b = '\f';
|
||||
break;
|
||||
case 'n':
|
||||
b = '\n';
|
||||
break;
|
||||
case 'r':
|
||||
b = '\r';
|
||||
break;
|
||||
case 't':
|
||||
b = '\t';
|
||||
break;
|
||||
case '"':
|
||||
b = '"';
|
||||
break;
|
||||
case '\\':
|
||||
b = '\\';
|
||||
break;
|
||||
case 'u':
|
||||
{
|
||||
/* Get codepoint and check for surrogate pair */
|
||||
uint32_t codepoint;
|
||||
const char *err = decode_utf16_escape(cp + 1, &codepoint);
|
||||
if (err) return err;
|
||||
if (codepoint >= 0xDC00 && codepoint <= 0xDFFF) {
|
||||
return "unexpected utf-16 low surrogate";
|
||||
} else if (codepoint >= 0xD800 && codepoint <= 0xDBFF) {
|
||||
if (cp[5] != '\\') return "expected utf-16 low surrogate pair";
|
||||
if (cp[6] != 'u') return "expected utf-16 low surrogate pair";
|
||||
uint32_t lowsur;
|
||||
const char *err = decode_utf16_escape(cp + 7, &lowsur);
|
||||
if (err) return err;
|
||||
if (lowsur < 0xDC00 || lowsur > 0xDFFF)
|
||||
return "expected utf-16 low surrogate pair";
|
||||
codepoint = ((codepoint - 0xD800) << 10) +
|
||||
(lowsur - 0xDC00) + 0x10000;
|
||||
cp += 11;
|
||||
} else {
|
||||
cp += 5;
|
||||
}
|
||||
/* Write codepoint */
|
||||
if (codepoint <= 0x7F) {
|
||||
janet_buffer_push_u8(buffer, codepoint);
|
||||
} else if (codepoint <= 0x7FF) {
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x1F) | 0xC0);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else if (codepoint <= 0xFFFF) {
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x0F) | 0xE0);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
||||
} else {
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 18) & 0x07) | 0xF0);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 12) & 0x3F) | 0x80);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 6) & 0x3F) | 0x80);
|
||||
janet_buffer_push_u8(buffer, ((codepoint >> 0) & 0x3F) | 0x80);
|
||||
}
|
||||
}
|
||||
continue;
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(buffer, b);
|
||||
cp++;
|
||||
}
|
||||
*out = janet_stringv(buffer->data, buffer->count);
|
||||
*p = cp + 1;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static const char *decode_one(const char **p, Janet *out, int depth) {
|
||||
|
||||
/* Prevent stack overflow */
|
||||
if (depth > JANET_RECURSION_GUARD) goto recurdepth;
|
||||
|
||||
/* Skip leading whitepspace */
|
||||
skipwhite(p);
|
||||
|
||||
/* Main switch */
|
||||
switch (**p) {
|
||||
default:
|
||||
goto badchar;
|
||||
case '\0':
|
||||
goto eos;
|
||||
/* Numbers */
|
||||
case '-': case '0': case '1' : case '2': case '3' : case '4':
|
||||
case '5': case '6': case '7' : case '8': case '9':
|
||||
{
|
||||
errno = 0;
|
||||
char *end = NULL;
|
||||
double x = strtod(*p, &end);
|
||||
if (end == *p) goto badnum;
|
||||
*p = end;
|
||||
*out = janet_wrap_real(x);
|
||||
break;
|
||||
}
|
||||
/* false, null, true */
|
||||
case 'f':
|
||||
{
|
||||
const char *cp = *p;
|
||||
if (cp[1] != 'a' || cp[2] != 'l' || cp[3] != 's' || cp[4] != 'e')
|
||||
goto badident;
|
||||
*out = janet_wrap_false();
|
||||
*p = cp + 5;
|
||||
break;
|
||||
}
|
||||
case 'n':
|
||||
{
|
||||
const char *cp = *p;
|
||||
|
||||
if (cp[1] != 'u' || cp[2] != 'l' || cp[3] != 'l')
|
||||
goto badident;
|
||||
*out = janet_wrap_nil();
|
||||
*p = cp + 4;
|
||||
break;
|
||||
}
|
||||
case 't':
|
||||
{
|
||||
const char *cp = *p;
|
||||
if (cp[1] != 'r' || cp[2] != 'u' || cp[3] != 'e')
|
||||
goto badident;
|
||||
*out = janet_wrap_true();
|
||||
*p = cp + 4;
|
||||
break;
|
||||
}
|
||||
/* String */
|
||||
case '"':
|
||||
{
|
||||
const char *cp = *p + 1;
|
||||
const char *start = cp;
|
||||
while (*cp >= 32 && *cp != '"' && *cp != '\\')
|
||||
cp++;
|
||||
/* Only use a buffer for strings with escapes, else just copy
|
||||
* memory from source */
|
||||
if (*cp == '\\') {
|
||||
*p = *p + 1;
|
||||
const char *err = decode_string(p, out);
|
||||
if (err) return err;
|
||||
break;
|
||||
}
|
||||
if (*cp != '"') goto badchar;
|
||||
*p = cp + 1;
|
||||
*out = janet_stringv((const uint8_t *)start, cp - start);
|
||||
break;
|
||||
}
|
||||
/* Array */
|
||||
case '[':
|
||||
{
|
||||
*p = *p + 1;
|
||||
JanetArray *array = janet_array(0);
|
||||
const char *err;
|
||||
Janet subval;
|
||||
skipwhite(p);
|
||||
while (**p != ']') {
|
||||
err = decode_one(p, &subval, depth + 1);
|
||||
if (err) return err;
|
||||
janet_array_push(array, subval);
|
||||
skipwhite(p);
|
||||
if (**p == ']') break;
|
||||
if (**p != ',') goto wantcomma;
|
||||
*p = *p + 1;
|
||||
}
|
||||
*p = *p + 1;
|
||||
*out = janet_wrap_array(array);
|
||||
}
|
||||
break;
|
||||
/* Object */
|
||||
case '{':
|
||||
{
|
||||
*p = *p + 1;
|
||||
JanetTable *table = janet_table(0);
|
||||
const char *err;
|
||||
Janet subkey, subval;
|
||||
skipwhite(p);
|
||||
while (**p != '}') {
|
||||
skipwhite(p);
|
||||
if (**p != '"') goto wantstring;
|
||||
err = decode_one(p, &subkey, depth + 1);
|
||||
if (err) return err;
|
||||
skipwhite(p);
|
||||
if (**p != ':') goto wantcolon;
|
||||
*p = *p + 1;
|
||||
err = decode_one(p, &subval, depth + 1);
|
||||
if (err) return err;
|
||||
janet_table_put(table, subkey, subval);
|
||||
skipwhite(p);
|
||||
if (**p == '}') break;
|
||||
if (**p != ',') goto wantcomma;
|
||||
*p = *p + 1;
|
||||
}
|
||||
*p = *p + 1;
|
||||
*out = janet_wrap_table(table);
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return NULL;
|
||||
|
||||
/* Errors */
|
||||
recurdepth:
|
||||
return "recured too deeply";
|
||||
eos:
|
||||
return "unexpected end of source";
|
||||
badident:
|
||||
return "bad identifier";
|
||||
badnum:
|
||||
return "bad number";
|
||||
wantcomma:
|
||||
return "expected comma";
|
||||
wantcolon:
|
||||
return "expected colon";
|
||||
badchar:
|
||||
return "unexpected character";
|
||||
wantstring:
|
||||
return "expected json string";
|
||||
}
|
||||
|
||||
static int json_decode(JanetArgs args) {
|
||||
Janet ret;
|
||||
JANET_FIXARITY(args, 1);
|
||||
const char *err;
|
||||
const char *start;
|
||||
const char *p;
|
||||
if (janet_checktype(args.v[0], JANET_BUFFER)) {
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(args.v[0]);
|
||||
/* Ensure 0 padded */
|
||||
janet_buffer_push_u8(buffer, 0);
|
||||
start = p = (const char *)buffer->data;
|
||||
err = decode_one(&p, &ret, 0);
|
||||
buffer->count--;
|
||||
} else {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
||||
start = p = (const char *)bytes;
|
||||
err = decode_one(&p, &ret, 0);
|
||||
}
|
||||
/* Check trailing values */
|
||||
if (!err) {
|
||||
skipwhite(&p);
|
||||
if (*p)
|
||||
err = "unexpected extra token";
|
||||
}
|
||||
if (err) {
|
||||
JANET_THROWV(args, janet_wrap_string(janet_formatc(
|
||||
"decode error at postion %d: %s",
|
||||
p - start,
|
||||
err)));
|
||||
}
|
||||
JANET_RETURN(args, ret);
|
||||
}
|
||||
|
||||
/*****************/
|
||||
/* JSON Encoding */
|
||||
/*****************/
|
||||
|
||||
typedef struct {
|
||||
JanetBuffer *buffer;
|
||||
int32_t indent;
|
||||
const uint8_t *tab;
|
||||
const uint8_t *newline;
|
||||
int32_t tablen;
|
||||
int32_t newlinelen;
|
||||
} Encoder;
|
||||
|
||||
static const char *encode_newline(Encoder *e) {
|
||||
if (janet_buffer_push_bytes(e->buffer, e->newline, e->newlinelen))
|
||||
return "buffer overflow";
|
||||
/* Skip loop if no tab string */
|
||||
if (e->tablen) {
|
||||
for (int32_t i = 0; i < e->indent; i++)
|
||||
if (janet_buffer_push_bytes(e->buffer, e->tab, e->tablen))
|
||||
return "buffer overflow";
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static const char *encode_one(Encoder *e, Janet x, int depth) {
|
||||
switch(janet_type(x)) {
|
||||
default:
|
||||
goto badtype;
|
||||
case JANET_NIL:
|
||||
{
|
||||
if (janet_buffer_push_cstring(e->buffer, "null"))
|
||||
goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_FALSE:
|
||||
{
|
||||
if (janet_buffer_push_cstring(e->buffer, "false"))
|
||||
goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_TRUE:
|
||||
{
|
||||
if (janet_buffer_push_cstring(e->buffer, "true"))
|
||||
goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
{
|
||||
char cbuf[20];
|
||||
sprintf(cbuf, "%d", janet_unwrap_integer(x));
|
||||
if (janet_buffer_push_cstring(e->buffer, cbuf))
|
||||
goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_REAL:
|
||||
{
|
||||
char cbuf[25];
|
||||
sprintf(cbuf, "%.17g", janet_unwrap_real(x));
|
||||
if (janet_buffer_push_cstring(e->buffer, cbuf))
|
||||
goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
const uint8_t *bytes;
|
||||
const uint8_t *c;
|
||||
const uint8_t *end;
|
||||
int32_t len;
|
||||
janet_bytes_view(x, &bytes, &len);
|
||||
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
|
||||
c = bytes;
|
||||
end = bytes + len;
|
||||
while (c < end) {
|
||||
|
||||
/* get codepoint */
|
||||
uint32_t codepoint;
|
||||
if (*c < 0x80) {
|
||||
/* one byte */
|
||||
codepoint = *c++;
|
||||
} else if (*c < 0xE0) {
|
||||
/* two bytes */
|
||||
if (c + 2 > end) goto overflow;
|
||||
codepoint = ((c[0] & 0x1F) << 6) |
|
||||
(c[1] & 0x3F);
|
||||
c += 2;
|
||||
} else if (*c < 0xF0) {
|
||||
/* three bytes */
|
||||
if (c + 3 > end) goto overflow;
|
||||
codepoint = ((c[0] & 0x0F) << 12) |
|
||||
((c[1] & 0x3F) << 6) |
|
||||
(c[2] & 0x3F);
|
||||
c += 3;
|
||||
} else if (*c < 0xF8) {
|
||||
/* four bytes */
|
||||
if (c + 4 > end) goto overflow;
|
||||
codepoint = ((c[0] & 0x07) << 18) |
|
||||
((c[1] & 0x3F) << 12) |
|
||||
((c[3] & 0x3F) << 6) |
|
||||
(c[3] & 0x3F);
|
||||
c += 4;
|
||||
} else {
|
||||
/* invalid */
|
||||
goto invalidutf8;
|
||||
}
|
||||
|
||||
/* write codepoint */
|
||||
if (codepoint > 0x1F && codepoint < 0x80) {
|
||||
/* Normal, no escape */
|
||||
if (codepoint == '\\' || codepoint == '"')
|
||||
if (janet_buffer_push_u8(e->buffer, '\\'))
|
||||
goto overflow;
|
||||
if (janet_buffer_push_u8(e->buffer, (uint8_t) codepoint))
|
||||
goto overflow;
|
||||
} else if (codepoint < 0x10000) {
|
||||
/* One unicode escape */
|
||||
uint8_t buf[6];
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'u';
|
||||
buf[2] = (codepoint >> 12) & 0xF;
|
||||
buf[3] = (codepoint >> 8) & 0xF;
|
||||
buf[4] = (codepoint >> 4) & 0xF;
|
||||
buf[5] = codepoint & 0xF;
|
||||
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
|
||||
goto overflow;
|
||||
} else {
|
||||
/* Two unicode escapes (surrogate pair) */
|
||||
uint32_t hi, lo;
|
||||
uint8_t buf[12];
|
||||
hi = ((codepoint - 0x10000) >> 10) + 0xD800;
|
||||
lo = ((codepoint - 0x10000) & 0x3FF) + 0xDC00;
|
||||
buf[0] = '\\';
|
||||
buf[1] = 'u';
|
||||
buf[2] = (hi >> 12) & 0xF;
|
||||
buf[3] = (hi >> 8) & 0xF;
|
||||
buf[4] = (hi >> 4) & 0xF;
|
||||
buf[5] = hi & 0xF;
|
||||
buf[6] = '\\';
|
||||
buf[7] = 'u';
|
||||
buf[8] = (lo >> 12) & 0xF;
|
||||
buf[9] = (lo >> 8) & 0xF;
|
||||
buf[10] = (lo >> 4) & 0xF;
|
||||
buf[11] = lo & 0xF;
|
||||
if (janet_buffer_push_bytes(e->buffer, buf, sizeof(buf)))
|
||||
goto overflow;
|
||||
}
|
||||
}
|
||||
if (janet_buffer_push_u8(e->buffer, '"')) goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
const char *err;
|
||||
const Janet *items;
|
||||
int32_t len;
|
||||
janet_indexed_view(x, &items, &len);
|
||||
if (janet_buffer_push_u8(e->buffer, '[')) goto overflow;
|
||||
e->indent++;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if ((err = encode_newline(e))) return err;
|
||||
if ((err = encode_one(e, items[i], depth + 1)))
|
||||
return err;
|
||||
if (janet_buffer_push_u8(e->buffer, ','))
|
||||
goto overflow;
|
||||
}
|
||||
e->indent--;
|
||||
if (e->buffer->data[e->buffer->count - 1] == ',') {
|
||||
e->buffer->count--;
|
||||
if ((err = encode_newline(e))) return err;
|
||||
}
|
||||
if (janet_buffer_push_u8(e->buffer, ']')) goto overflow;
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE:
|
||||
case JANET_STRUCT:
|
||||
{
|
||||
const char *err;
|
||||
const JanetKV *kvs;
|
||||
int32_t count, capacity;
|
||||
janet_dictionary_view(x, &kvs, &count, &capacity);
|
||||
if (janet_buffer_push_u8(e->buffer, '{')) goto overflow;
|
||||
e->indent++;
|
||||
for (int32_t i = 0; i < capacity; i++) {
|
||||
if (janet_checktype(kvs[i].key, JANET_NIL))
|
||||
continue;
|
||||
if (!janet_checktype(kvs[i].key, JANET_STRING))
|
||||
return "only strings keys are allowed in objects";
|
||||
if ((err = encode_newline(e))) return err;
|
||||
if ((err = encode_one(e, kvs[i].key, depth + 1)))
|
||||
return err;
|
||||
const char *sep = e->tablen ? ": " : ":";
|
||||
if (janet_buffer_push_cstring(e->buffer, sep))
|
||||
goto overflow;
|
||||
if ((err = encode_one(e, kvs[i].value, depth + 1)))
|
||||
return err;
|
||||
if (janet_buffer_push_u8(e->buffer, ','))
|
||||
goto overflow;
|
||||
}
|
||||
e->indent--;
|
||||
if (e->buffer->data[e->buffer->count - 1] == ',') {
|
||||
e->buffer->count--;
|
||||
if ((err = encode_newline(e))) return err;
|
||||
}
|
||||
if (janet_buffer_push_u8(e->buffer, '}')) goto overflow;
|
||||
}
|
||||
break;
|
||||
}
|
||||
return NULL;
|
||||
|
||||
/* Errors */
|
||||
overflow:
|
||||
return "buffer overflow";
|
||||
badtype:
|
||||
return "type not supported";
|
||||
invalidutf8:
|
||||
return "string contains invalid utf-8";
|
||||
}
|
||||
|
||||
static int json_encode(JanetArgs args) {
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 3);
|
||||
Encoder e;
|
||||
e.indent = 0;
|
||||
e.buffer = janet_buffer(10);
|
||||
e.tab = NULL;
|
||||
e.newline = NULL;
|
||||
e.tablen = 0;
|
||||
e.newlinelen = 0;
|
||||
if (args.n >= 2) {
|
||||
JANET_ARG_BYTES(e.tab, e.tablen, args, 1);
|
||||
if (args.n >= 3) {
|
||||
JANET_ARG_BYTES(e.newline, e.newlinelen, args, 2);
|
||||
} else {
|
||||
e.newline = (const uint8_t *)"\r\n";
|
||||
e.newlinelen = 2;
|
||||
}
|
||||
}
|
||||
const char *err = encode_one(&e, args.v[0], 0);
|
||||
if (err) JANET_THROW(args, err);
|
||||
JANET_RETURN_BUFFER(args, e.buffer);
|
||||
}
|
||||
|
||||
/****************/
|
||||
/* Module Entry */
|
||||
/****************/
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"encode", json_encode,
|
||||
"(json/encode x [,tab [,newline]])\n\n"
|
||||
"Encodes a janet value in JSON (utf-8)."
|
||||
},
|
||||
{"decode", json_decode,
|
||||
"(json/decode json-source)\n\n"
|
||||
"Returns a janet object after parsing JSON."
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, "json", cfuns);
|
||||
return 0;
|
||||
}
|
||||
62
natives/sqlite3/.gitignore
vendored
62
natives/sqlite3/.gitignore
vendored
@@ -1,62 +0,0 @@
|
||||
# Created by https://www.gitignore.io/api/c
|
||||
|
||||
### C ###
|
||||
# Prerequisites
|
||||
*.d
|
||||
|
||||
# Object files
|
||||
*.o
|
||||
*.ko
|
||||
*.obj
|
||||
*.elf
|
||||
|
||||
# Linker output
|
||||
*.ilk
|
||||
*.map
|
||||
*.exp
|
||||
|
||||
# Precompiled Headers
|
||||
*.gch
|
||||
*.pch
|
||||
|
||||
# Libraries
|
||||
*.lib
|
||||
*.a
|
||||
*.la
|
||||
*.lo
|
||||
|
||||
# Shared objects (inc. Windows DLLs)
|
||||
*.dll
|
||||
*.so
|
||||
*.so.*
|
||||
*.dylib
|
||||
|
||||
# Executables
|
||||
*.exe
|
||||
*.out
|
||||
*.app
|
||||
*.i*86
|
||||
*.x86_64
|
||||
*.hex
|
||||
|
||||
# Debug files
|
||||
*.dSYM/
|
||||
*.su
|
||||
*.idb
|
||||
*.pdb
|
||||
|
||||
# Kernel Module Compile Results
|
||||
*.mod*
|
||||
*.cmd
|
||||
.tmp_versions/
|
||||
modules.order
|
||||
Module.symvers
|
||||
Mkfile.old
|
||||
dkms.conf
|
||||
|
||||
|
||||
# End of https://www.gitignore.io/api/c
|
||||
|
||||
sqlite3.c
|
||||
sqlite3.h
|
||||
sqlite-autoconf-3230100
|
||||
@@ -1,60 +0,0 @@
|
||||
# Copyright (c) 2018 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.
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -I../../src/include -O2 -shared -fpic \
|
||||
-DSQLITE_THREADSAFE=0 \
|
||||
-DSQLITE_OMIT_LOAD_EXTENSION
|
||||
TARGET=sqlite3.so
|
||||
|
||||
# MacOS specifics
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CFLAGS:=$(CFLAGS) -undefined dynamic_lookup
|
||||
endif
|
||||
|
||||
# Default target
|
||||
all: $(TARGET)
|
||||
|
||||
OBJECTS:=main.o sqlite3.o
|
||||
$(TARGET): $(OBJECTS)
|
||||
$(CC) $(CFLAGS) -o $@ $^
|
||||
|
||||
sqlite-autoconf-3230100/sqlite3.%:
|
||||
curl https://www.sqlite.org/2018/sqlite-autoconf-3230100.tar.gz | tar -xvz
|
||||
|
||||
sqlite3.c: sqlite-autoconf-3230100/sqlite3.c
|
||||
cp $< $@
|
||||
sqlite3.h: sqlite-autoconf-3230100/sqlite3.h
|
||||
cp $< $@
|
||||
|
||||
%.o: %.c sqlite3.h
|
||||
$(CC) $(CFLAGS) -c $<
|
||||
|
||||
clean:
|
||||
rm -rf sqlite-autoconf-3230100
|
||||
rm *.o
|
||||
rm sqlite3.c
|
||||
rm sqlite3.h
|
||||
rm $(TARGET)
|
||||
|
||||
install:
|
||||
cp $(TARGET) $(DST_PATH)
|
||||
|
||||
.PHONY: clean all
|
||||
@@ -1,428 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2018 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 "sqlite3.h"
|
||||
#include <janet/janet.h>
|
||||
|
||||
#define FLAG_CLOSED 1
|
||||
|
||||
#define MSG_DB_CLOSED "database already closed"
|
||||
|
||||
typedef struct {
|
||||
sqlite3* handle;
|
||||
int flags;
|
||||
} Db;
|
||||
|
||||
/* Close a db, noop if already closed */
|
||||
static void closedb(Db *db) {
|
||||
if (!(db->flags & FLAG_CLOSED)) {
|
||||
db->flags |= FLAG_CLOSED;
|
||||
sqlite3_close_v2(db->handle);
|
||||
}
|
||||
}
|
||||
|
||||
/* Called to garbage collect a sqlite3 connection */
|
||||
static int gcsqlite(void *p, size_t s) {
|
||||
(void) s;
|
||||
Db *db = (Db *)p;
|
||||
closedb(db);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static const JanetAbstractType sql_conn_type = {
|
||||
":sqlite3.connection",
|
||||
gcsqlite,
|
||||
NULL,
|
||||
};
|
||||
|
||||
/* Open a new database connection */
|
||||
static int sql_open(JanetArgs args) {
|
||||
sqlite3 *conn;
|
||||
const uint8_t *filename;
|
||||
int status;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_STRING(filename, args, 0);
|
||||
status = sqlite3_open((const char *)filename, &conn);
|
||||
if (status == SQLITE_OK) {
|
||||
Db *db = (Db *) janet_abstract(&sql_conn_type, sizeof(Db));
|
||||
db->handle = conn;
|
||||
db->flags = 0;
|
||||
JANET_RETURN_ABSTRACT(args, db);
|
||||
} else {
|
||||
const char *err = sqlite3_errmsg(conn);
|
||||
JANET_THROW(args, err);
|
||||
}
|
||||
}
|
||||
|
||||
/* Close a database connection */
|
||||
static int sql_close(JanetArgs args) {
|
||||
Db *db;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_ABSTRACT(db, args, 0, &sql_conn_type);
|
||||
closedb(db);
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
|
||||
/* Check for embedded NULL bytes */
|
||||
static int has_null(const uint8_t *str, int32_t len) {
|
||||
while (len--) {
|
||||
if (!str[len])
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Bind a single parameter */
|
||||
static const char *bind1(sqlite3_stmt *stmt, int index, Janet value) {
|
||||
int res;
|
||||
switch (janet_type(value)) {
|
||||
default:
|
||||
return "invalid sql value";
|
||||
case JANET_NIL:
|
||||
res = sqlite3_bind_null(stmt, index);
|
||||
break;
|
||||
case JANET_FALSE:
|
||||
res = sqlite3_bind_int(stmt, index, 0);
|
||||
break;
|
||||
case JANET_TRUE:
|
||||
res = sqlite3_bind_int(stmt, index, 1);
|
||||
break;
|
||||
case JANET_REAL:
|
||||
res = sqlite3_bind_double(stmt, index, janet_unwrap_real(value));
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
res = sqlite3_bind_int64(stmt, index, janet_unwrap_integer(value));
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
{
|
||||
const uint8_t *str = janet_unwrap_string(value);
|
||||
int32_t len = janet_string_length(str);
|
||||
if (has_null(str, len)) {
|
||||
return "cannot have embedded nulls in text values";
|
||||
} else {
|
||||
res = sqlite3_bind_text(stmt, index, (const char *)str, len + 1, SQLITE_STATIC);
|
||||
}
|
||||
}
|
||||
break;
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(value);
|
||||
res = sqlite3_bind_blob(stmt, index, buffer->data, buffer->count, SQLITE_STATIC);
|
||||
}
|
||||
break;
|
||||
}
|
||||
if (res != SQLITE_OK) {
|
||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
||||
return sqlite3_errmsg(db);
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Bind many parameters */
|
||||
static const char *bindmany(sqlite3_stmt *stmt, Janet params) {
|
||||
/* parameters */
|
||||
const Janet *seq;
|
||||
const JanetKV *kvs;
|
||||
int32_t len, cap;
|
||||
int limitindex = sqlite3_bind_parameter_count(stmt);
|
||||
if (janet_indexed_view(params, &seq, &len)) {
|
||||
if (len > limitindex + 1) {
|
||||
return "invalid index in sql parameters";
|
||||
}
|
||||
for (int i = 0; i < len; i++) {
|
||||
const char *err = bind1(stmt, i + 1, seq[i]);
|
||||
if (err) {
|
||||
return err;
|
||||
}
|
||||
}
|
||||
} else if (janet_dictionary_view(params, &kvs, &len, &cap)) {
|
||||
for (int i = 0; i < cap; i++) {
|
||||
int index = 0;
|
||||
switch (janet_type(kvs[i].key)) {
|
||||
default:
|
||||
/* Will fail */
|
||||
break;
|
||||
case JANET_NIL:
|
||||
/* Will skip as nil keys indicate empty hash table slot */
|
||||
continue;
|
||||
case JANET_INTEGER:
|
||||
index = janet_unwrap_integer(kvs[i].key);
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
{
|
||||
const uint8_t *s = janet_unwrap_string(kvs[i].key);
|
||||
index = sqlite3_bind_parameter_index(
|
||||
stmt,
|
||||
(const char *)s);
|
||||
}
|
||||
break;
|
||||
}
|
||||
if (index <= 0 || index > limitindex) {
|
||||
return "invalid index in sql parameters";
|
||||
}
|
||||
const char *err = bind1(stmt, index, kvs[i].value);
|
||||
if (err) {
|
||||
return err;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
return "invalid type for sql parameters";
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Execute a statement but don't collect results */
|
||||
static const char *execute(sqlite3_stmt *stmt) {
|
||||
int status;
|
||||
const char *ret = NULL;
|
||||
do {
|
||||
status = sqlite3_step(stmt);
|
||||
} while (status == SQLITE_ROW);
|
||||
/* Check for errors */
|
||||
if (status != SQLITE_DONE) {
|
||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
||||
ret = sqlite3_errmsg(db);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Execute and return values from prepared statement */
|
||||
static const char *execute_collect(sqlite3_stmt *stmt, JanetArray *rows) {
|
||||
/* Count number of columns in result */
|
||||
int ncol = sqlite3_column_count(stmt);
|
||||
int status;
|
||||
const char *ret = NULL;
|
||||
|
||||
/* Get column names */
|
||||
Janet *tupstart = janet_tuple_begin(ncol);
|
||||
for (int i = 0; i < ncol; i++) {
|
||||
tupstart[i] = janet_cstringv(sqlite3_column_name(stmt, i));
|
||||
}
|
||||
const Janet *colnames = janet_tuple_end(tupstart);
|
||||
|
||||
do {
|
||||
status = sqlite3_step(stmt);
|
||||
if (status == SQLITE_ROW) {
|
||||
JanetKV *row = janet_struct_begin(ncol);
|
||||
for (int i = 0; i < ncol; i++) {
|
||||
int t = sqlite3_column_type(stmt, i);
|
||||
Janet value;
|
||||
switch (t) {
|
||||
case SQLITE_NULL:
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case SQLITE_INTEGER:
|
||||
value = janet_wrap_integer(sqlite3_column_int(stmt, i));
|
||||
break;
|
||||
case SQLITE_FLOAT:
|
||||
value = janet_wrap_real(sqlite3_column_double(stmt, i));
|
||||
break;
|
||||
case SQLITE_TEXT:
|
||||
{
|
||||
int nbytes = sqlite3_column_bytes(stmt, i);
|
||||
uint8_t *str = janet_string_begin(nbytes);
|
||||
memcpy(str, sqlite3_column_text(stmt, i), nbytes);
|
||||
value = janet_wrap_string(janet_string_end(str));
|
||||
}
|
||||
break;
|
||||
case SQLITE_BLOB:
|
||||
{
|
||||
int nbytes = sqlite3_column_bytes(stmt, i);
|
||||
JanetBuffer *b = janet_buffer(nbytes);
|
||||
memcpy(b->data, sqlite3_column_blob(stmt, i), nbytes);
|
||||
b->count = nbytes;
|
||||
value = janet_wrap_buffer(b);
|
||||
}
|
||||
break;
|
||||
}
|
||||
janet_struct_put(row, colnames[i], value);
|
||||
}
|
||||
janet_array_push(rows, janet_wrap_struct(janet_struct_end(row)));
|
||||
}
|
||||
} while (status == SQLITE_ROW);
|
||||
|
||||
/* Check for errors */
|
||||
if (status != SQLITE_DONE) {
|
||||
sqlite3 *db = sqlite3_db_handle(stmt);
|
||||
ret = sqlite3_errmsg(db);
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Evaluate a string of sql */
|
||||
static int sql_eval(JanetArgs args) {
|
||||
const char *err;
|
||||
sqlite3_stmt *stmt = NULL, *stmt_next = NULL;
|
||||
const uint8_t *query;
|
||||
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_MAXARITY(args, 3);
|
||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
||||
if (db->flags & FLAG_CLOSED) {
|
||||
JANET_THROW(args, MSG_DB_CLOSED);
|
||||
}
|
||||
JANET_ARG_STRING(query, args, 1);
|
||||
if (has_null(query, janet_string_length(query))) {
|
||||
err = "cannot have embedded NULL in sql statememts";
|
||||
goto error;
|
||||
}
|
||||
JanetArray *rows = janet_array(10);
|
||||
const char *c = (const char *)query;
|
||||
|
||||
/* Evaluate all statements in a loop */
|
||||
do {
|
||||
/* Compile the next statement */
|
||||
if (sqlite3_prepare_v2(db->handle, c, -1, &stmt_next, &c) != SQLITE_OK) {
|
||||
err = sqlite3_errmsg(db->handle);
|
||||
goto error;
|
||||
}
|
||||
/* Check if we have found last statement */
|
||||
if (NULL == stmt_next) {
|
||||
/* Execute current statement and collect results */
|
||||
if (stmt) {
|
||||
err = execute_collect(stmt, rows);
|
||||
if (err) goto error;
|
||||
}
|
||||
} else {
|
||||
/* Execute current statement but don't collect results. */
|
||||
if (stmt) {
|
||||
err = execute(stmt);
|
||||
if (err) goto error;
|
||||
}
|
||||
/* Bind params to next statement*/
|
||||
if (args.n == 3) {
|
||||
/* parameters */
|
||||
err = bindmany(stmt_next, args.v[2]);
|
||||
if (err) goto error;
|
||||
}
|
||||
}
|
||||
/* rotate stmt and stmt_next */
|
||||
if (stmt) sqlite3_finalize(stmt);
|
||||
stmt = stmt_next;
|
||||
stmt_next = NULL;
|
||||
} while (NULL != stmt);
|
||||
|
||||
/* Good return path */
|
||||
JANET_RETURN_ARRAY(args, rows);
|
||||
|
||||
error:
|
||||
if (stmt) sqlite3_finalize(stmt);
|
||||
if (stmt_next) sqlite3_finalize(stmt_next);
|
||||
JANET_THROW(args, err);
|
||||
}
|
||||
|
||||
/* Convert int64_t to a string */
|
||||
static const uint8_t *coerce_int64(int64_t x) {
|
||||
uint8_t bytes[40];
|
||||
int i = 0;
|
||||
/* Edge cases */
|
||||
if (x == 0) return janet_cstring("0");
|
||||
if (x == INT64_MIN) return janet_cstring("-9,223,372,036,854,775,808");
|
||||
/* Negative becomes pos */
|
||||
if (x < 0) {
|
||||
bytes[i++] = '-';
|
||||
x = -x;
|
||||
}
|
||||
while (x) {
|
||||
bytes[i++] = x % 10;
|
||||
x = x / 10;
|
||||
}
|
||||
bytes[i] = '\0';
|
||||
return janet_string(bytes, i);
|
||||
}
|
||||
|
||||
/* Gets the last inserted row id */
|
||||
static int sql_last_insert_rowid(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
||||
if (db->flags & FLAG_CLOSED) {
|
||||
JANET_THROW(args, MSG_DB_CLOSED);
|
||||
}
|
||||
sqlite3_int64 id = sqlite3_last_insert_rowid(db->handle);
|
||||
if (id >= INT32_MIN && id <= INT32_MAX) {
|
||||
JANET_RETURN_INTEGER(args, (int32_t) id);
|
||||
}
|
||||
/* Convert to string */
|
||||
JANET_RETURN_STRING(args, coerce_int64(id));
|
||||
}
|
||||
|
||||
/* Get the sqlite3 errcode */
|
||||
static int sql_error_code(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &sql_conn_type);
|
||||
Db *db = (Db *)janet_unwrap_abstract(args.v[0]);
|
||||
if (db->flags & FLAG_CLOSED) {
|
||||
JANET_THROW(args, MSG_DB_CLOSED);
|
||||
}
|
||||
int errcode = sqlite3_errcode(db->handle);
|
||||
JANET_RETURN_INTEGER(args, errcode);
|
||||
}
|
||||
|
||||
/*****************************************************************************/
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"open", sql_open,
|
||||
"(sqlite3/open path)\n\n"
|
||||
"Opens a sqlite3 database on disk. Returns the database handle if the database was opened "
|
||||
"successfully, and otheriwse throws an error."
|
||||
},
|
||||
{"close", sql_close,
|
||||
"(sqlite3/close db)\n\n"
|
||||
"Closes a database. Use this to free a database after use. Returns nil."
|
||||
},
|
||||
{"eval", sql_eval,
|
||||
"(sqlite3/eval db sql [,params])\n\n"
|
||||
"Evaluate sql in the context of database db. Multiple sql statements "
|
||||
"can be changed together, and optionally parameters maybe passed in. "
|
||||
"The optional parameters maybe either an indexed data type (tuple or array), or a dictionary "
|
||||
"data type (struct or table). If params is a tuple or array, then sqlite "
|
||||
"parameters are substituted using indices. For example:\n\n"
|
||||
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = ?;` [123])\n\n"
|
||||
"Will select rows from tab where id is equal to 123. Alternatively, "
|
||||
"the programmer can use named parameters with tables or structs, like so:\n\n"
|
||||
"\t(sqlite3/eval db `SELECT * FROM tab WHERE id = :id;` {:id 123})\n\n"
|
||||
"Will return an array of rows, where each row contains a table where columns names "
|
||||
"are keys for column values."
|
||||
},
|
||||
{"last-insert-rowid", sql_last_insert_rowid,
|
||||
"(sqlite3/last-insert-rowid db)\n\n"
|
||||
"Returns the id of the last inserted row. If the id will fit into a 32-bit"
|
||||
"signed integer, will returned an integer, otherwise will return a string representation "
|
||||
"of the id (an 8 bytes string containing a long integer)."
|
||||
},
|
||||
{"error-code", sql_error_code,
|
||||
"(sqlite3/error-code db)\n\n"
|
||||
"Returns the error number of the last sqlite3 command that threw an error. Cross "
|
||||
"check these numbers with the SQLite documentation for more information."
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, "sqlite3", cfuns);
|
||||
return 0;
|
||||
}
|
||||
43
src/boot/boot.c
Normal file
43
src/boot/boot.c
Normal file
@@ -0,0 +1,43 @@
|
||||
/*
|
||||
* 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/janet.h>
|
||||
|
||||
extern const unsigned char *janet_gen_boot;
|
||||
extern int32_t janet_gen_boot_size;
|
||||
|
||||
int main() {
|
||||
int status;
|
||||
JanetTable *env;
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
env = janet_core_env();
|
||||
|
||||
/* 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;
|
||||
}
|
||||
40
src/boot/boot.janet
Normal file
40
src/boot/boot.janet
Normal file
@@ -0,0 +1,40 @@
|
||||
# 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 (seq [b :in image] (string b)))
|
||||
(def image-file (file/open "build/core_image.c" :w))
|
||||
(file/write image-file
|
||||
"#include <janet/janet.h>\n"
|
||||
"static const unsigned char janet_core_image_bytes[] = {")
|
||||
(loop [line :in (partition 16 chunks)]
|
||||
(def str (string ;(interpose ", " line)))
|
||||
(file/write image-file str ",\n"))
|
||||
(file/write image-file
|
||||
"0};\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))
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,8 +20,10 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
/* Create new userdata */
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||
|
||||
238
src/core/array.c
238
src/core/array.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,8 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Initializes an array */
|
||||
@@ -118,194 +122,150 @@ Janet janet_array_peek(JanetArray *array) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
int32_t cap;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
array = janet_array(cap);
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
static Janet cfun_array_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetArray *array = janet_array(cap);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_pop(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_RETURN(args, janet_array_pop(array));
|
||||
static Janet cfun_array_pop(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_pop(array);
|
||||
}
|
||||
|
||||
static int cfun_peek(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_RETURN(args, janet_array_peek(array));
|
||||
static Janet cfun_array_peek(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
return janet_array_peek(array);
|
||||
}
|
||||
|
||||
static int cfun_push(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
int32_t newcount;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
newcount = array->count - 1 + args.n;
|
||||
static Janet cfun_array_push(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = array->count - 1 + argc;
|
||||
janet_array_ensure(array, newcount, 2);
|
||||
if (args.n > 1) memcpy(array->data + array->count, args.v + 1, (args.n - 1) * sizeof(Janet));
|
||||
if (argc > 1) memcpy(array->data + array->count, argv + 1, (argc - 1) * sizeof(Janet));
|
||||
array->count = newcount;
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_ensure(JanetArgs args) {
|
||||
JanetArray *array;
|
||||
int32_t newcount;
|
||||
int32_t growth;
|
||||
JANET_FIXARITY(args, 3);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_ARG_INTEGER(newcount, args, 1);
|
||||
JANET_ARG_INTEGER(growth, args, 2);
|
||||
if (newcount < 0) JANET_THROW(args, "expected positive integer");
|
||||
static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t newcount = janet_getinteger(argv, 1);
|
||||
int32_t growth = janet_getinteger(argv, 2);
|
||||
if (newcount < 1) janet_panic("expected positive integer");
|
||||
janet_array_ensure(array, newcount, growth);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const Janet *vals;
|
||||
int32_t len;
|
||||
JanetArray *ret;
|
||||
int32_t start, end;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 3);
|
||||
if (!janet_indexed_view(args.v[0], &vals, &len))
|
||||
JANET_THROW(args, "expected array|tuple");
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
||||
start = janet_unwrap_integer(args.v[1]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
||||
end = janet_unwrap_integer(args.v[2]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_array(end - start);
|
||||
memcpy(ret->data, vals + start, sizeof(Janet) * (end - start));
|
||||
ret->count = end - start;
|
||||
} else {
|
||||
ret = janet_array(0);
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, ret);
|
||||
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||
array->count = range.end - range.start;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_concat(JanetArgs args) {
|
||||
static Janet cfun_array_concat(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetArray *array;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
switch (janet_type(args.v[i])) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
switch (janet_type(argv[i])) {
|
||||
default:
|
||||
janet_array_push(array, args.v[i]);
|
||||
janet_array_push(array, argv[i]);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE:
|
||||
{
|
||||
int32_t j, len;
|
||||
const Janet *vals;
|
||||
janet_indexed_view(args.v[i], &vals, &len);
|
||||
janet_indexed_view(argv[i], &vals, &len);
|
||||
for (j = 0; j < len; j++)
|
||||
janet_array_push(array, vals[j]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_insert(JanetArgs args) {
|
||||
int32_t at;
|
||||
static Janet cfun_array_insert(int32_t argc, Janet *argv) {
|
||||
size_t chunksize, restsize;
|
||||
JanetArray *array;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_ARG_ARRAY(array, args, 0);
|
||||
JANET_ARG_INTEGER(at, args, 1);
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetArray *array = janet_getarray(argv, 0);
|
||||
int32_t at = janet_getinteger(argv, 1);
|
||||
if (at < 0) {
|
||||
at = array->count + at + 1;
|
||||
at = array->count + at + 1;
|
||||
}
|
||||
if (at < 0 || at > array->count)
|
||||
JANET_THROW(args, "insertion index out of bounds");
|
||||
chunksize = (args.n - 2) * sizeof(Janet);
|
||||
janet_panicf("insertion index %d out of range [0,%d]", at, array->count);
|
||||
chunksize = (argc - 2) * sizeof(Janet);
|
||||
restsize = (array->count - at) * sizeof(Janet);
|
||||
janet_array_ensure(array, array->count + args.n - 2, 2);
|
||||
memmove(array->data + at + args.n - 2,
|
||||
janet_array_ensure(array, array->count + argc - 2, 2);
|
||||
memmove(array->data + at + argc - 2,
|
||||
array->data + at,
|
||||
restsize);
|
||||
memcpy(array->data + at, args.v + 2, chunksize);
|
||||
array->count += (args.n - 2);
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
memcpy(array->data + at, argv + 2, chunksize);
|
||||
array->count += (argc - 2);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"array/new", cfun_new,
|
||||
"(array/new capacity)\n\n"
|
||||
"Creates a new empty array with a preallocated capacity. The same as "
|
||||
"(array) but can be more efficient if the maximum size of an array is known."
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"array/new", cfun_array_new,
|
||||
JDOC("(array/new capacity)\n\n"
|
||||
"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/pop", cfun_pop,
|
||||
"(array/pop arr)\n\n"
|
||||
"Remove the last element of the array and return it. If the array is empty, will return nil. Modifies "
|
||||
"the input array."
|
||||
{"array/pop", cfun_array_pop,
|
||||
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 "
|
||||
"the input array.")
|
||||
},
|
||||
{"array/peek", cfun_peek,
|
||||
"(array/peek arr)\n\n"
|
||||
"Returns the last element of the array. Does not modify the array."
|
||||
{"array/peek", cfun_array_peek,
|
||||
JDOC("(array/peek arr)\n\n"
|
||||
"Returns the last element of the array. Does not modify the array.")
|
||||
},
|
||||
{"array/push", cfun_push,
|
||||
"(array/push arr x)\n\n"
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it."
|
||||
{"array/push", cfun_array_push,
|
||||
JDOC("(array/push arr x)\n\n"
|
||||
"Insert an element in the end of an array. Modifies the input array and returns it.")
|
||||
},
|
||||
{"array/ensure", cfun_ensure,
|
||||
"(array/ensure arr capacity)\n\n"
|
||||
"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, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space."
|
||||
{"array/ensure", cfun_array_ensure,
|
||||
JDOC("(array/ensure arr capacity)\n\n"
|
||||
"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, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space.")
|
||||
},
|
||||
{"array/slice", cfun_slice,
|
||||
"(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, "
|
||||
"[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. "
|
||||
"Returns a new array."
|
||||
{"array/slice", cfun_array_slice,
|
||||
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, "
|
||||
"[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. "
|
||||
"Returns a new array.")
|
||||
},
|
||||
{"array/concat", cfun_concat,
|
||||
"(array/concat arr & parts)\n\n"
|
||||
"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 "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr."
|
||||
{"array/concat", cfun_array_concat,
|
||||
JDOC("(array/concat arr & parts)\n\n"
|
||||
"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 "
|
||||
"be inserted into the array. Otherwise, each part in parts will be appended to arr in order. "
|
||||
"Return the modified array arr.")
|
||||
},
|
||||
{"array/insert", cfun_insert,
|
||||
"(array/insert arr at & xs)\n\n"
|
||||
"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 "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array."
|
||||
{"array/insert", cfun_array_insert,
|
||||
JDOC("(array/insert arr at & xs)\n\n"
|
||||
"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 "
|
||||
"the end of the array, such that inserting at -1 appends to the array. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the array module */
|
||||
int janet_lib_array(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
|
||||
201
src/core/asm.c
201
src/core/asm.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,9 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <setjmp.h>
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <setjmp.h>
|
||||
|
||||
/* Conditionally compile this file */
|
||||
#ifdef JANET_ASSEMBLER
|
||||
@@ -48,23 +51,21 @@ struct JanetAssembler {
|
||||
int32_t bytecode_count; /* Used for calculating labels */
|
||||
|
||||
Janet name;
|
||||
JanetTable labels; /* symbol -> bytecode index */
|
||||
JanetTable labels; /* keyword -> bytecode index */
|
||||
JanetTable constants; /* symbol -> constant index */
|
||||
JanetTable slots; /* symbol -> slot index */
|
||||
JanetTable envs; /* symbol -> environment index */
|
||||
JanetTable defs; /* symbol -> funcdefs index */
|
||||
};
|
||||
|
||||
/* Janet opcode descriptions in lexographic order. This
|
||||
/* Janet opcode descriptions in lexicographic order. This
|
||||
* allows a binary search over the elements to find the
|
||||
* correct opcode given a name. This works in reasonable
|
||||
* time and is easier to setup statically than a hash table or
|
||||
* prefix tree. */
|
||||
static const JanetInstructionDef janet_ops[] = {
|
||||
{"add", JOP_ADD},
|
||||
{"addi", JOP_ADD_INTEGER},
|
||||
{"addim", JOP_ADD_IMMEDIATE},
|
||||
{"addr", JOP_ADD_REAL},
|
||||
{"band", JOP_BAND},
|
||||
{"bnot", JOP_BNOT},
|
||||
{"bor", JOP_BOR},
|
||||
@@ -73,24 +74,17 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"clo", JOP_CLOSURE},
|
||||
{"cmp", JOP_COMPARE},
|
||||
{"div", JOP_DIVIDE},
|
||||
{"divi", JOP_DIVIDE_INTEGER},
|
||||
{"divim", JOP_DIVIDE_IMMEDIATE},
|
||||
{"divr", JOP_DIVIDE_REAL},
|
||||
{"eq", JOP_EQUALS},
|
||||
{"eqi", JOP_EQUALS_INTEGER},
|
||||
{"eqim", JOP_EQUALS_IMMEDIATE},
|
||||
{"eqn", JOP_NUMERIC_EQUAL},
|
||||
{"eqr", JOP_EQUALS_REAL},
|
||||
{"err", JOP_ERROR},
|
||||
{"get", JOP_GET},
|
||||
{"geti", JOP_GET_INDEX},
|
||||
{"gt", JOP_GREATER_THAN},
|
||||
{"gti", JOP_GREATER_THAN_INTEGER},
|
||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||
{"gtim", JOP_GREATER_THAN_IMMEDIATE},
|
||||
{"gtn", JOP_NUMERIC_GREATER_THAN},
|
||||
{"gtr", JOP_GREATER_THAN_REAL},
|
||||
{"gten", JOP_NUMERIC_GREATER_THAN_EQUAL},
|
||||
{"gter", JOP_GREATER_THAN_EQUAL_REAL},
|
||||
{"jmp", JOP_JUMP},
|
||||
{"jmpif", JOP_JUMP_IF},
|
||||
{"jmpno", JOP_JUMP_IF_NOT},
|
||||
@@ -104,11 +98,8 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"len", JOP_LENGTH},
|
||||
{"lt", JOP_LESS_THAN},
|
||||
{"lten", JOP_NUMERIC_LESS_THAN_EQUAL},
|
||||
{"lter", JOP_LESS_THAN_EQUAL_REAL},
|
||||
{"lti", JOP_LESS_THAN_INTEGER},
|
||||
{"ltim", JOP_LESS_THAN_IMMEDIATE},
|
||||
{"ltn", JOP_NUMERIC_LESS_THAN},
|
||||
{"ltr", JOP_LESS_THAN_REAL},
|
||||
{"mkarr", JOP_MAKE_ARRAY},
|
||||
{"mkbuf", JOP_MAKE_BUFFER},
|
||||
{"mkstr", JOP_MAKE_STRING},
|
||||
@@ -118,9 +109,7 @@ static const JanetInstructionDef janet_ops[] = {
|
||||
{"movf", JOP_MOVE_FAR},
|
||||
{"movn", JOP_MOVE_NEAR},
|
||||
{"mul", JOP_MULTIPLY},
|
||||
{"muli", JOP_MULTIPLY_INTEGER},
|
||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||
{"mulr", JOP_MULTIPLY_REAL},
|
||||
{"noop", JOP_NOOP},
|
||||
{"push", JOP_PUSH},
|
||||
{"push2", JOP_PUSH_2},
|
||||
@@ -151,27 +140,26 @@ typedef struct TypeAlias {
|
||||
} TypeAlias;
|
||||
|
||||
static const TypeAlias type_aliases[] = {
|
||||
{":abstract", JANET_TFLAG_ABSTRACT},
|
||||
{":array", JANET_TFLAG_ARRAY},
|
||||
{":boolean", JANET_TFLAG_BOOLEAN},
|
||||
{":buffer", JANET_TFLAG_BUFFER},
|
||||
{":callable", JANET_TFLAG_CALLABLE},
|
||||
{":cfunction", JANET_TFLAG_CFUNCTION},
|
||||
{":dictionary", JANET_TFLAG_DICTIONARY},
|
||||
{":false", JANET_TFLAG_FALSE},
|
||||
{":fiber", JANET_TFLAG_FIBER},
|
||||
{":function", JANET_TFLAG_FUNCTION},
|
||||
{":indexed", JANET_TFLAG_INDEXED},
|
||||
{":integer", JANET_TFLAG_INTEGER},
|
||||
{":nil", JANET_TFLAG_NIL},
|
||||
{":number", JANET_TFLAG_NUMBER},
|
||||
{":real", JANET_TFLAG_REAL},
|
||||
{":string", JANET_TFLAG_STRING},
|
||||
{":struct", JANET_TFLAG_STRUCT},
|
||||
{":symbol", JANET_TFLAG_SYMBOL},
|
||||
{":table", JANET_TFLAG_BOOLEAN},
|
||||
{":true", JANET_TFLAG_TRUE},
|
||||
{":tuple", JANET_TFLAG_BOOLEAN}
|
||||
{"abstract", JANET_TFLAG_ABSTRACT},
|
||||
{"array", JANET_TFLAG_ARRAY},
|
||||
{"boolean", JANET_TFLAG_BOOLEAN},
|
||||
{"buffer", JANET_TFLAG_BUFFER},
|
||||
{"callable", JANET_TFLAG_CALLABLE},
|
||||
{"cfunction", JANET_TFLAG_CFUNCTION},
|
||||
{"dictionary", JANET_TFLAG_DICTIONARY},
|
||||
{"false", JANET_TFLAG_FALSE},
|
||||
{"fiber", JANET_TFLAG_FIBER},
|
||||
{"function", JANET_TFLAG_FUNCTION},
|
||||
{"indexed", JANET_TFLAG_INDEXED},
|
||||
{"nil", JANET_TFLAG_NIL},
|
||||
{"number", JANET_TFLAG_NUMBER},
|
||||
{"string", JANET_TFLAG_STRING},
|
||||
{"struct", JANET_TFLAG_STRUCT},
|
||||
{"symbol", JANET_TFLAG_SYMBOL},
|
||||
{"keyword", JANET_TFLAG_KEYWORD},
|
||||
{"table", JANET_TFLAG_BOOLEAN},
|
||||
{"true", JANET_TFLAG_TRUE},
|
||||
{"tuple", JANET_TFLAG_BOOLEAN}
|
||||
};
|
||||
|
||||
/* Deinitialize an Assembler. Does not deinitialize the parents. */
|
||||
@@ -199,7 +187,7 @@ static void janet_asm_errorv(JanetAssembler *a, const uint8_t *m) {
|
||||
/* Add a closure environment to the assembler. Sub funcdefs may need
|
||||
* to reference outer function environments, and may change the outer environment.
|
||||
* Returns the index of the environment in the assembler's environments, or -1
|
||||
* if not found. */
|
||||
* if not found. */
|
||||
static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
||||
Janet check;
|
||||
JanetFuncDef *def = a->def;
|
||||
@@ -210,8 +198,8 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
||||
}
|
||||
/* Check for memoized value */
|
||||
check = janet_table_get(&a->envs, envname);
|
||||
if (janet_checktype(check, JANET_INTEGER)) {
|
||||
return janet_unwrap_integer(check);
|
||||
if (janet_checktype(check, JANET_NUMBER)) {
|
||||
return (int32_t) janet_unwrap_number(check);
|
||||
}
|
||||
if (NULL == a->parent) return -2;
|
||||
res = janet_asm_addenv(a->parent, envname);
|
||||
@@ -219,7 +207,7 @@ static int32_t janet_asm_addenv(JanetAssembler *a, Janet envname) {
|
||||
return res;
|
||||
}
|
||||
envindex = def->environments_length;
|
||||
janet_table_put(&a->envs, envname, janet_wrap_integer(envindex));
|
||||
janet_table_put(&a->envs, envname, janet_wrap_number(envindex));
|
||||
if (envindex >= a->environments_capacity) {
|
||||
int32_t newcap = 2 * envindex;
|
||||
def->environments = realloc(def->environments, newcap * sizeof(int32_t));
|
||||
@@ -265,9 +253,16 @@ static int32_t doarg_1(
|
||||
default:
|
||||
goto error;
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
ret = janet_unwrap_integer(x);
|
||||
case JANET_NUMBER:
|
||||
{
|
||||
double y = janet_unwrap_number(x);
|
||||
if (janet_checkintrange(y)) {
|
||||
ret = (int32_t) y;
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_TUPLE:
|
||||
{
|
||||
const Janet *t = janet_unwrap_tuple(x);
|
||||
@@ -282,25 +277,21 @@ static int32_t doarg_1(
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
if (NULL != c) {
|
||||
if (NULL != c && argtype == JANET_OAT_LABEL) {
|
||||
Janet result = janet_table_get(c, x);
|
||||
if (janet_checktype(result, JANET_INTEGER)) {
|
||||
if (argtype == JANET_OAT_LABEL) {
|
||||
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
||||
} else {
|
||||
ret = janet_unwrap_integer(result);
|
||||
}
|
||||
if (janet_checktype(result, JANET_NUMBER)) {
|
||||
ret = janet_unwrap_integer(result) - a->bytecode_count;
|
||||
} else {
|
||||
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
||||
goto error;
|
||||
}
|
||||
} else if (argtype == JANET_OAT_TYPE || argtype == JANET_OAT_SIMPLETYPE) {
|
||||
const TypeAlias *alias = janet_strbinsearch(
|
||||
&type_aliases,
|
||||
sizeof(type_aliases)/sizeof(TypeAlias),
|
||||
sizeof(TypeAlias),
|
||||
janet_unwrap_symbol(x));
|
||||
janet_unwrap_keyword(x));
|
||||
if (alias) {
|
||||
ret = alias->mask;
|
||||
} else {
|
||||
@@ -309,6 +300,20 @@ static int32_t doarg_1(
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_SYMBOL:
|
||||
{
|
||||
if (NULL != c) {
|
||||
Janet result = janet_table_get(c, x);
|
||||
if (janet_checktype(result, JANET_NUMBER)) {
|
||||
ret = (int32_t) janet_unwrap_number(result);
|
||||
} else {
|
||||
janet_asm_errorv(a, janet_formatc("unknown name %v", x));
|
||||
}
|
||||
} else {
|
||||
goto error;
|
||||
}
|
||||
if (argtype == JANET_OAT_ENVIRONMENT && ret == -1) {
|
||||
/* Add a new env */
|
||||
ret = janet_asm_addenv(a, x);
|
||||
@@ -469,7 +474,7 @@ static uint32_t read_instruction(
|
||||
}
|
||||
|
||||
/* Helper to get from a structure */
|
||||
static Janet janet_get(Janet ds, Janet key) {
|
||||
static Janet janet_get1(Janet ds, Janet key) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
return janet_wrap_nil();
|
||||
@@ -528,29 +533,29 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
"expected struct or table for assembly source");
|
||||
|
||||
/* Check for function name */
|
||||
a.name = janet_get(s, janet_csymbolv("name"));
|
||||
a.name = janet_get1(s, janet_csymbolv("name"));
|
||||
if (!janet_checktype(a.name, JANET_NIL)) {
|
||||
def->name = janet_to_string(a.name);
|
||||
}
|
||||
|
||||
/* Set function arity */
|
||||
x = janet_get(s, janet_csymbolv("arity"));
|
||||
def->arity = janet_checktype(x, JANET_INTEGER) ? janet_unwrap_integer(x) : 0;
|
||||
x = janet_get1(s, janet_csymbolv("arity"));
|
||||
def->arity = janet_checkint(x) ? janet_unwrap_integer(x) : 0;
|
||||
|
||||
/* Check vararg */
|
||||
x = janet_get(s, janet_csymbolv("vararg"));
|
||||
x = janet_get1(s, janet_csymbolv("vararg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
|
||||
/* Check strict arity */
|
||||
x = janet_get(s, janet_csymbolv("fix-arity"));
|
||||
x = janet_get1(s, janet_csymbolv("fix-arity"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_FIXARITY;
|
||||
|
||||
/* Check source */
|
||||
x = janet_get(s, janet_csymbolv("source"));
|
||||
x = janet_get1(s, janet_csymbolv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
|
||||
/* Create slot aliases */
|
||||
x = janet_get(s, janet_csymbolv("slots"));
|
||||
x = janet_get1(s, janet_csymbolv("slots"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
for (i = 0; i < count; i++) {
|
||||
Janet v = arr[i];
|
||||
@@ -571,7 +576,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse constants */
|
||||
x = janet_get(s, janet_csymbolv("constants"));
|
||||
x = janet_get1(s, janet_csymbolv("constants"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
def->constants_length = count;
|
||||
def->constants = malloc(sizeof(Janet) * count);
|
||||
@@ -606,7 +611,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse sub funcdefs */
|
||||
x = janet_get(s, janet_csymbolv("closures"));
|
||||
x = janet_get1(s, janet_csymbolv("closures"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
@@ -617,7 +622,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (subres.status != JANET_ASSEMBLE_OK) {
|
||||
janet_asm_errorv(&a, subres.error);
|
||||
}
|
||||
subname = janet_get(arr[i], janet_csymbolv("name"));
|
||||
subname = janet_get1(arr[i], janet_csymbolv("name"));
|
||||
if (!janet_checktype(subname, JANET_NIL)) {
|
||||
janet_table_put(&a.defs, subname, janet_wrap_integer(def->defs_length));
|
||||
}
|
||||
@@ -636,13 +641,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
}
|
||||
|
||||
/* Parse bytecode and labels */
|
||||
x = janet_get(s, janet_csymbolv("bytecode"));
|
||||
x = janet_get1(s, janet_csymbolv("bytecode"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
/* Do labels and find length */
|
||||
int32_t blength = 0;
|
||||
for (i = 0; i < count; ++i) {
|
||||
Janet instr = arr[i];
|
||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
||||
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||
janet_table_put(&a.labels, instr, janet_wrap_integer(blength));
|
||||
} else if (janet_checktype(instr, JANET_TUPLE)) {
|
||||
blength++;
|
||||
@@ -660,7 +665,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
/* Do bytecode */
|
||||
for (i = 0; i < count; ++i) {
|
||||
Janet instr = arr[i];
|
||||
if (janet_checktype(instr, JANET_SYMBOL)) {
|
||||
if (janet_checktype(instr, JANET_KEYWORD)) {
|
||||
continue;
|
||||
} else {
|
||||
uint32_t op;
|
||||
@@ -692,7 +697,7 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
a.errindex = -1;
|
||||
|
||||
/* Check for source mapping */
|
||||
x = janet_get(s, janet_csymbolv("sourcemap"));
|
||||
x = janet_get1(s, janet_csymbolv("sourcemap"));
|
||||
if (janet_indexed_view(x, &arr, &count)) {
|
||||
janet_asm_assert(&a, count == def->bytecode_length, "sourcemap must have the same length as the bytecode");
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * count);
|
||||
@@ -704,10 +709,10 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
janet_asm_error(&a, "expected tuple");
|
||||
}
|
||||
tup = janet_unwrap_tuple(entry);
|
||||
if (!janet_checktype(tup[0], JANET_INTEGER)) {
|
||||
if (!janet_checkint(tup[0])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
if (!janet_checktype(tup[1], JANET_INTEGER)) {
|
||||
if (!janet_checkint(tup[1])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
mapping.start = janet_unwrap_integer(tup[0]);
|
||||
@@ -740,7 +745,7 @@ JanetAssembleResult janet_asm(Janet source, int flags) {
|
||||
|
||||
/* Disassembly */
|
||||
|
||||
/* Find the deinfintion of an instruction given the instruction word. Return
|
||||
/* Find the definition of an instruction given the instruction word. Return
|
||||
* NULL if not found. */
|
||||
static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
||||
size_t i;
|
||||
@@ -781,7 +786,7 @@ static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
}
|
||||
|
||||
/* Given an argument, convert it to the appriate integer or symbol */
|
||||
/* Given an argument, convert it to the appropriate integer or symbol */
|
||||
Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
const JanetInstructionDef *def = janet_asm_reverse_lookup(instr);
|
||||
Janet name;
|
||||
@@ -912,45 +917,41 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
}
|
||||
|
||||
/* C Function for assembly */
|
||||
static int cfun_asm(JanetArgs args) {
|
||||
static Janet cfun_asm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetAssembleResult res;
|
||||
JANET_FIXARITY(args, 1);
|
||||
res = janet_asm(args.v[0], 0);
|
||||
if (res.status == JANET_ASSEMBLE_OK) {
|
||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
||||
} else {
|
||||
JANET_THROWV(args, janet_wrap_string(res.error));
|
||||
res = janet_asm(argv[0], 0);
|
||||
if (res.status != JANET_ASSEMBLE_OK) {
|
||||
janet_panics(res.error);
|
||||
}
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
}
|
||||
|
||||
static int cfun_disasm(JanetArgs args) {
|
||||
JanetFunction *f;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FUNCTION(f, args, 0);
|
||||
JANET_RETURN(args, janet_disasm(f->def));
|
||||
static Janet cfun_disasm(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 1);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
return janet_disasm(f->def);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
static const JanetReg asm_cfuns[] = {
|
||||
{"asm", cfun_asm,
|
||||
"(asm assembly)\n\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"
|
||||
"error on invalid assembly."
|
||||
JDOC("(asm assembly)\n\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"
|
||||
"error on invalid assembly.")
|
||||
},
|
||||
{"disasm", cfun_disasm,
|
||||
"(disasm func)\n\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"
|
||||
"typed argument."
|
||||
JDOC("(disasm func)\n\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"
|
||||
"typed argument.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
int janet_lib_asm(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_asm(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, asm_cfuns);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,8 +20,11 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
@@ -54,7 +57,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
||||
uint8_t *new_data;
|
||||
uint8_t *old = buffer->data;
|
||||
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));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -77,10 +81,10 @@ void janet_buffer_setcount(JanetBuffer *buffer, int32_t count) {
|
||||
|
||||
/* Adds capacity for enough extra bytes to the buffer. Ensures that the
|
||||
* next n bytes pushed to the buffer will not cause a reallocation */
|
||||
int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
/* Check for buffer overflow */
|
||||
if ((int64_t)n + buffer->count > INT32_MAX) {
|
||||
return -1;
|
||||
janet_panic("buffer overflow");
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
@@ -92,59 +96,54 @@ int janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
buffer->data = new_data;
|
||||
buffer->capacity = new_capacity;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a cstring to buffer */
|
||||
int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring) {
|
||||
int32_t len = 0;
|
||||
while (cstring[len]) ++len;
|
||||
return janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *) cstring, len);
|
||||
}
|
||||
|
||||
/* Push multiple bytes into the buffer */
|
||||
int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
if (janet_buffer_extra(buffer, length)) return -1;
|
||||
void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t length) {
|
||||
janet_buffer_extra(buffer, length);
|
||||
memcpy(buffer->data + buffer->count, string, length);
|
||||
buffer->count += length;
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
||||
return janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
||||
void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string) {
|
||||
janet_buffer_push_bytes(buffer, string, janet_string_length(string));
|
||||
}
|
||||
|
||||
/* Push a single byte to the buffer */
|
||||
int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
||||
if (janet_buffer_extra(buffer, 1)) return -1;
|
||||
void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t byte) {
|
||||
janet_buffer_extra(buffer, 1);
|
||||
buffer->data[buffer->count] = byte;
|
||||
buffer->count++;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 16 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
||||
if (janet_buffer_extra(buffer, 2)) return -1;
|
||||
void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x) {
|
||||
janet_buffer_extra(buffer, 2);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->count += 2;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 32 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
||||
if (janet_buffer_extra(buffer, 4)) return -1;
|
||||
void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x) {
|
||||
janet_buffer_extra(buffer, 4);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||
buffer->data[buffer->count + 3] = (x >> 24) & 0xFF;
|
||||
buffer->count += 4;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Push a 64 bit unsigned integer to the buffer */
|
||||
int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
if (janet_buffer_extra(buffer, 8)) return -1;
|
||||
void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
janet_buffer_extra(buffer, 8);
|
||||
buffer->data[buffer->count] = x & 0xFF;
|
||||
buffer->data[buffer->count + 1] = (x >> 8) & 0xFF;
|
||||
buffer->data[buffer->count + 2] = (x >> 16) & 0xFF;
|
||||
@@ -154,165 +153,252 @@ int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x) {
|
||||
buffer->data[buffer->count + 6] = (x >> 48) & 0xFF;
|
||||
buffer->data[buffer->count + 7] = (x >> 56) & 0xFF;
|
||||
buffer->count += 8;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
int32_t cap;
|
||||
JanetBuffer *buffer;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
buffer = janet_buffer(cap);
|
||||
JANET_RETURN_BUFFER(args, buffer);
|
||||
static Janet cfun_buffer_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(cap);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static int cfun_u8(JanetArgs args) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t integer;
|
||||
JANET_ARG_INTEGER(integer, args, i);
|
||||
if (janet_buffer_push_u8(buffer, (uint8_t) (integer & 0xFF)))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
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;
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
JanetBuffer *buffer = janet_buffer(count);
|
||||
memset(buffer->data, byte, count);
|
||||
buffer->count = count;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static int cfun_int(JanetArgs args) {
|
||||
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t integer;
|
||||
JANET_ARG_INTEGER(integer, args, i);
|
||||
if (janet_buffer_push_u32(buffer, (uint32_t) integer))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
janet_buffer_push_u8(buffer, (uint8_t) (janet_getinteger(argv, i) & 0xFF));
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_chars(JanetArgs args) {
|
||||
static Janet cfun_buffer_word(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
JanetBuffer *buffer;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
int32_t len;
|
||||
const uint8_t *str;
|
||||
JANET_ARG_BYTES(str, len, args, i);
|
||||
if (janet_buffer_push_bytes(buffer, str, len))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
double number = janet_getnumber(argv, i);
|
||||
uint32_t word = (uint32_t) number;
|
||||
if (word != number)
|
||||
janet_panicf("cannot convert %v to machine word", argv[i]);
|
||||
janet_buffer_push_u32(buffer, word);
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_clear(JanetArgs args) {
|
||||
JanetBuffer *buffer;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
buffer->count = 0;
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_popn(JanetArgs args) {
|
||||
JanetBuffer *buffer;
|
||||
int32_t n;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_BUFFER(buffer, args, 0);
|
||||
JANET_ARG_INTEGER(n, args, 1);
|
||||
if (n < 0) JANET_THROW(args, "n must be non-negative");
|
||||
static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
int32_t n = janet_getinteger(argv, 1);
|
||||
if (n < 0) janet_panic("n must be non-negative");
|
||||
if (buffer->count < n) {
|
||||
buffer->count = 0;
|
||||
} else {
|
||||
buffer->count -= n;
|
||||
}
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const uint8_t *data;
|
||||
int32_t len, start, end;
|
||||
JanetBuffer *ret;
|
||||
JANET_ARG_BYTES(data, len, args, 0);
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
||||
start = janet_unwrap_integer(args.v[1]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
||||
end = janet_unwrap_integer(args.v[2]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_buffer(end - start);
|
||||
memcpy(ret->data, data + start, end - start);
|
||||
ret->count = end - start;
|
||||
} else {
|
||||
ret = janet_buffer(0);
|
||||
}
|
||||
JANET_RETURN_BUFFER(args, ret);
|
||||
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||
buffer->count = range.end - range.start;
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"buffer/new", cfun_new,
|
||||
"(buffer/new capacity)\n\n"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer."
|
||||
static void bitloc(int32_t argc, Janet *argv, JanetBuffer **b, int32_t *index, int *bit) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
double x = janet_getnumber(argv, 1);
|
||||
int64_t bitindex = (int64_t) x;
|
||||
int64_t byteindex = bitindex >> 3;
|
||||
int which_bit = bitindex & 7;
|
||||
if (bitindex != x || bitindex < 0 || byteindex >= buffer->count)
|
||||
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"
|
||||
"Creates a new, empty buffer with enough memory for capacity bytes. "
|
||||
"Returns a new buffer.")
|
||||
},
|
||||
{"buffer/push-byte", cfun_u8,
|
||||
"(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows."
|
||||
{"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-integer", cfun_int,
|
||||
"(buffer/push-integer buffer x)\n\n"
|
||||
"Append an integer to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows."
|
||||
{"buffer/push-byte", cfun_buffer_u8,
|
||||
JDOC("(buffer/push-byte buffer x)\n\n"
|
||||
"Append a byte to a buffer. Will expand the buffer as necessary. "
|
||||
"Returns the modified buffer. Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/push-string", cfun_chars,
|
||||
"(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows."
|
||||
{"buffer/push-word", cfun_buffer_word,
|
||||
JDOC("(buffer/push-word buffer x)\n\n"
|
||||
"Append a machine word to a buffer. The 4 bytes of the integer are appended "
|
||||
"in twos complement, big endian order, unsigned. Returns the modified buffer. Will "
|
||||
"throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/popn", cfun_popn,
|
||||
"(buffer/popn buffer n)\n\n"
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer."
|
||||
{"buffer/push-string", cfun_buffer_chars,
|
||||
JDOC("(buffer/push-string buffer str)\n\n"
|
||||
"Push a string onto the end of a buffer. Non string values will be converted "
|
||||
"to strings before being pushed. Returns the modified buffer. "
|
||||
"Will throw an error if the buffer overflows.")
|
||||
},
|
||||
{"buffer/clear", cfun_clear,
|
||||
"(buffer/clear buffer)\n\n"
|
||||
"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."
|
||||
{"buffer/popn", cfun_buffer_popn,
|
||||
JDOC("(buffer/popn buffer n)\n\n"
|
||||
"Removes the last n bytes from the buffer. Returns the modified buffer.")
|
||||
},
|
||||
{"buffer/slice", cfun_slice,
|
||||
"(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, "
|
||||
"[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. "
|
||||
"Returns a new buffer."
|
||||
{"buffer/clear", cfun_buffer_clear,
|
||||
JDOC("(buffer/clear buffer)\n\n"
|
||||
"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.")
|
||||
},
|
||||
{"buffer/slice", cfun_buffer_slice,
|
||||
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, "
|
||||
"[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. "
|
||||
"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}
|
||||
};
|
||||
|
||||
int janet_lib_buffer(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_buffer(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, buffer_cfuns);
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,8 +20,10 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
/* Look up table for instructions */
|
||||
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
@@ -30,20 +32,12 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_ST, /* JOP_TYPECHECK, */
|
||||
JINT_S, /* JOP_RETURN, */
|
||||
JINT_0, /* JOP_RETURN_NIL, */
|
||||
JINT_SSS, /* JOP_ADD_INTEGER, */
|
||||
JINT_SSI, /* JOP_ADD_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_ADD_REAL, */
|
||||
JINT_SSS, /* JOP_ADD, */
|
||||
JINT_SSS, /* JOP_SUBTRACT_INTEGER, */
|
||||
JINT_SSS, /* JOP_SUBTRACT_REAL, */
|
||||
JINT_SSS, /* JOP_SUBTRACT, */
|
||||
JINT_SSS, /* JOP_MULTIPLY_INTEGER, */
|
||||
JINT_SSI, /* JOP_MULTIPLY_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_MULTIPLY_REAL, */
|
||||
JINT_SSS, /* JOP_MULTIPLY, */
|
||||
JINT_SSS, /* JOP_DIVIDE_INTEGER, */
|
||||
JINT_SSI, /* JOP_DIVIDE_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_DIVIDE_REAL, */
|
||||
JINT_SSS, /* JOP_DIVIDE, */
|
||||
JINT_SSS, /* JOP_BAND, */
|
||||
JINT_SSS, /* JOP_BOR, */
|
||||
@@ -61,19 +55,11 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_SL, /* JOP_JUMP_IF, */
|
||||
JINT_SL, /* JOP_JUMP_IF_NOT, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_INTEGER, */
|
||||
JINT_SSI, /* JOP_GREATER_THAN_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_REAL, */
|
||||
JINT_SSS, /* JOP_GREATER_THAN_EQUAL_REAL, */
|
||||
JINT_SSS, /* JOP_LESS_THAN, */
|
||||
JINT_SSS, /* JOP_LESS_THAN_INTEGER, */
|
||||
JINT_SSI, /* JOP_LESS_THAN_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_LESS_THAN_REAL, */
|
||||
JINT_SSS, /* JOP_LESS_THAN_EQUAL_REAL, */
|
||||
JINT_SSS, /* JOP_EQUALS, */
|
||||
JINT_SSS, /* JOP_EQUALS_INTEGER, */
|
||||
JINT_SSI, /* JOP_EQUALS_IMMEDIATE, */
|
||||
JINT_SSS, /* JOP_EQUALS_REAL, */
|
||||
JINT_SSS, /* JOP_COMPARE, */
|
||||
JINT_S, /* JOP_LOAD_NIL, */
|
||||
JINT_S, /* JOP_LOAD_TRUE, */
|
||||
|
||||
197
src/core/capi.c
Normal file
197
src/core/capi.c
Normal file
@@ -0,0 +1,197 @@
|
||||
/*
|
||||
* 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.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "state.h"
|
||||
#include "fiber.h"
|
||||
#endif
|
||||
|
||||
void janet_panicv(Janet message) {
|
||||
if (janet_vm_return_reg != NULL) {
|
||||
*janet_vm_return_reg = message;
|
||||
longjmp(*janet_vm_jmp_buf, 1);
|
||||
} else {
|
||||
fputs((const char *)janet_formatc("janet top level panic - %v\n", message), stdout);
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
void janet_panic(const char *message) {
|
||||
janet_panicv(janet_cstringv(message));
|
||||
}
|
||||
|
||||
void janet_panics(const uint8_t *message) {
|
||||
janet_panicv(janet_wrap_string(message));
|
||||
}
|
||||
|
||||
void janet_panic_type(Janet x, int32_t n, int expected) {
|
||||
janet_panicf("bad slot #%d, expected %T, got %v", n, expected, x);
|
||||
}
|
||||
|
||||
void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at) {
|
||||
janet_panicf("bad slot #%d, expected %s, got %v", n, at->name, x);
|
||||
}
|
||||
|
||||
void janet_fixarity(int32_t arity, int32_t fix) {
|
||||
if (arity != fix)
|
||||
janet_panicf("arity mismatch, expected %d, got %d", fix, arity);
|
||||
}
|
||||
|
||||
void janet_arity(int32_t arity, int32_t min, int32_t max) {
|
||||
if (min >= 0 && arity < min)
|
||||
janet_panicf("arity mismatch, expected at least %d, got %d", min, arity);
|
||||
if (max >= 0 && arity > max)
|
||||
janet_panicf("arity mismatch, expected at most %d, got %d", max, arity);
|
||||
}
|
||||
|
||||
#define DEFINE_GETTER(name, NAME, type) \
|
||||
type janet_get##name(const Janet *argv, int32_t n) { \
|
||||
Janet x = argv[n]; \
|
||||
if (!janet_checktype(x, JANET_##NAME)) { \
|
||||
janet_panic_type(x, n, JANET_TFLAG_##NAME); \
|
||||
} \
|
||||
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(array, ARRAY, JanetArray *)
|
||||
DEFINE_GETTER(tuple, TUPLE, const Janet *)
|
||||
DEFINE_GETTER(table, TABLE, JanetTable *)
|
||||
DEFINE_GETTER(struct, STRUCT, const JanetKV *)
|
||||
DEFINE_GETTER(string, STRING, const uint8_t *)
|
||||
DEFINE_GETTER(keyword, KEYWORD, const uint8_t *)
|
||||
DEFINE_GETTER(symbol, SYMBOL, const uint8_t *)
|
||||
DEFINE_GETTER(buffer, BUFFER, JanetBuffer *)
|
||||
DEFINE_GETTER(fiber, FIBER, JanetFiber *)
|
||||
DEFINE_GETTER(function, FUNCTION, JanetFunction *)
|
||||
DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||
|
||||
int janet_getboolean(const Janet *argv, int32_t n) {
|
||||
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) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) {
|
||||
janet_panicf("bad slot #%d, expected integer, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
int64_t janet_getinteger64(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint64(x)) {
|
||||
janet_panicf("bad slot #%d, expected 64 bit integer, got %v", n, x);
|
||||
}
|
||||
return (int64_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) {
|
||||
Janet x = argv[n];
|
||||
JanetView view;
|
||||
if (!janet_indexed_view(x, &view.items, &view.len)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_INDEXED);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetByteView janet_getbytes(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
JanetByteView view;
|
||||
if (!janet_bytes_view(x, &view.bytes, &view.len)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_BYTES);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
JanetDictView janet_getdictionary(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
JanetDictView view;
|
||||
if (!janet_dictionary_view(x, &view.kvs, &view.len, &view.cap)) {
|
||||
janet_panic_type(x, n, JANET_TFLAG_DICTIONARY);
|
||||
}
|
||||
return view;
|
||||
}
|
||||
|
||||
void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) {
|
||||
janet_panic_abstract(x, n, at);
|
||||
}
|
||||
void *abstractx = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstractx) != at) {
|
||||
janet_panic_abstract(x, n, at);
|
||||
}
|
||||
return abstractx;
|
||||
}
|
||||
|
||||
JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetRange range;
|
||||
int32_t length = janet_length(argv[0]);
|
||||
if (argc == 1) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_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;
|
||||
}
|
||||
return range;
|
||||
}
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2017 Calvin Rose
|
||||
* 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
|
||||
@@ -20,10 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
static int fixarity0(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
@@ -46,14 +48,14 @@ static int fixarity3(JanetFopts opts, JanetSlot *args) {
|
||||
return janet_v_count(args) == 3;
|
||||
}
|
||||
|
||||
/* Generic hanldling for $A = op $B */
|
||||
/* Generic handling for $A = op $B */
|
||||
static JanetSlot genericSS(JanetFopts opts, int op, JanetSlot s) {
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
janetc_emit_ss(opts.compiler, op, target, s, 1);
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Generic hanldling for $A = $B op I */
|
||||
/* Generic handling for $A = $B op I */
|
||||
static JanetSlot genericSSI(JanetFopts opts, int op, JanetSlot s, int32_t imm) {
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
janetc_emit_ssi(opts.compiler, op, target, s, imm, 1);
|
||||
@@ -99,8 +101,15 @@ static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, args[0], args[1], args[2], 0);
|
||||
return args[0];
|
||||
if (opts.flags & JANET_FOPTS_DROP) {
|
||||
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) {
|
||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||
@@ -136,7 +145,7 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
|
||||
return target;
|
||||
}
|
||||
|
||||
/* Varidadic operators specialization */
|
||||
/* Variadic operators specialization */
|
||||
|
||||
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,10 +20,13 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||
JanetFopts ret;
|
||||
@@ -235,7 +238,7 @@ JanetSlot janetc_resolve(
|
||||
scope->flags |= JANET_SCOPE_ENV;
|
||||
scope = scope->child;
|
||||
|
||||
/* Propogate env up to current scope */
|
||||
/* Propagate env up to current scope */
|
||||
int32_t envindex = -1;
|
||||
while (scope) {
|
||||
if (scope->flags & JANET_SCOPE_FUNCTION) {
|
||||
@@ -402,7 +405,9 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
}
|
||||
if (!specialized) {
|
||||
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);
|
||||
retslot = janetc_cslot(janet_wrap_nil());
|
||||
retslot.flags = JANET_SLOT_RETURNED;
|
||||
@@ -433,6 +438,14 @@ static JanetSlot janetc_array(JanetFopts opts, Janet x) {
|
||||
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) {
|
||||
JanetCompiler *c = opts.compiler;
|
||||
return janetc_maker(opts,
|
||||
@@ -480,12 +493,11 @@ static int macroexpand1(
|
||||
!janet_checktype(macroval, JANET_FUNCTION))
|
||||
return 0;
|
||||
|
||||
|
||||
/* Evaluate macro */
|
||||
JanetFiber *fiberp;
|
||||
JanetFunction *macro = janet_unwrap_function(macroval);
|
||||
int lock = janet_gclock();
|
||||
JanetSignal status = janet_call(
|
||||
JanetSignal status = janet_pcall(
|
||||
macro,
|
||||
janet_tuple_length(form) - 1,
|
||||
form + 1,
|
||||
@@ -543,6 +555,8 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
/* Empty tuple is tuple literal */
|
||||
if (janet_tuple_length(tup) == 0) {
|
||||
ret = janetc_cslot(x);
|
||||
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||
ret = janetc_tuple(opts, x);
|
||||
} else {
|
||||
JanetSlot head = janetc_value(subopts, tup[0]);
|
||||
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
||||
@@ -553,7 +567,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
}
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
ret = janetc_sym_rvalue(opts, janet_unwrap_symbol(x));
|
||||
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
ret = janetc_array(opts, x);
|
||||
@@ -576,13 +590,13 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
if (c->result.status == JANET_COMPILE_ERROR)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
if (opts.flags & JANET_FOPTS_TAIL)
|
||||
ret = janetc_return(opts.compiler, ret);
|
||||
ret = janetc_return(c, ret);
|
||||
if (opts.flags & JANET_FOPTS_HINT) {
|
||||
janetc_copy(opts.compiler, opts.hint, ret);
|
||||
janetc_copy(c, opts.hint, ret);
|
||||
ret = opts.hint;
|
||||
}
|
||||
c->current_mapping = last_mapping;
|
||||
opts.compiler->recursion_guard++;
|
||||
c->recursion_guard++;
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -700,45 +714,39 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
}
|
||||
|
||||
/* C Function for compiling */
|
||||
static int cfun(JanetArgs args) {
|
||||
JanetCompileResult res;
|
||||
JanetTable *t;
|
||||
JanetTable *env;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_MAXARITY(args, 3);
|
||||
JANET_ARG_TABLE(env, args, 1);
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetTable *env = janet_gettable(argv, 1);
|
||||
const uint8_t *source = NULL;
|
||||
if (args.n == 3) {
|
||||
JANET_ARG_STRING(source, args, 2);
|
||||
if (argc == 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
}
|
||||
res = janet_compile(args.v[0], env, source);
|
||||
JanetCompileResult res = janet_compile(argv[0], env, source);
|
||||
if (res.status == JANET_COMPILE_OK) {
|
||||
JANET_RETURN_FUNCTION(args, janet_thunk(res.funcdef));
|
||||
return janet_wrap_function(janet_thunk(res.funcdef));
|
||||
} else {
|
||||
t = janet_table(4);
|
||||
janet_table_put(t, janet_csymbolv(":error"), janet_wrap_string(res.error));
|
||||
janet_table_put(t, janet_csymbolv(":start"), janet_wrap_integer(res.error_mapping.start));
|
||||
janet_table_put(t, janet_csymbolv(":end"), janet_wrap_integer(res.error_mapping.end));
|
||||
JanetTable *t = janet_table(4);
|
||||
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||
janet_table_put(t, janet_ckeywordv("start"), janet_wrap_integer(res.error_mapping.start));
|
||||
janet_table_put(t, janet_ckeywordv("end"), janet_wrap_integer(res.error_mapping.end));
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_csymbolv(":fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
JANET_RETURN_TABLE(args, t);
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{"compile", cfun,
|
||||
"(compile ast env [, source])\n\n"
|
||||
"Compiles an Abstract Sytnax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled."
|
||||
JDOC("(compile ast env [, source])\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
"error if the ast cannot be compiled.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
int janet_lib_compile(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_compile(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, compile_cfuns);
|
||||
}
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
/*
|
||||
* Copyright (c) 2017 Calvin Rose
|
||||
* 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
|
||||
@@ -23,8 +23,10 @@
|
||||
#ifndef JANET_COMPILE_H
|
||||
#define JANET_COMPILE_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
@@ -240,10 +242,4 @@ JanetSlot janetc_cslot(Janet x);
|
||||
/* Search for a symbol */
|
||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Compile a symbol (or mutltisym) when used as an rvalue. */
|
||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym);
|
||||
|
||||
/* Compile an assignment to a symbol (or multisym) */
|
||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value);
|
||||
|
||||
#endif
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
341
src/core/debug.c
341
src/core/debug.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,35 +20,37 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
/* Implements functionality to build a debugger from within janet.
|
||||
* The repl should also be able to serve as pretty featured debugger
|
||||
* out of the box. */
|
||||
|
||||
/* Add a break point to a function */
|
||||
int janet_debug_break(JanetFuncDef *def, int32_t pc) {
|
||||
void janet_debug_break(JanetFuncDef *def, int32_t pc) {
|
||||
if (pc >= def->bytecode_length || pc < 0)
|
||||
return 1;
|
||||
janet_panic("invalid bytecode offset");
|
||||
def->bytecode[pc] |= 0x80;
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Remove a break point from a function */
|
||||
int janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||
void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||
if (pc >= def->bytecode_length || pc < 0)
|
||||
return 1;
|
||||
janet_panic("invalid bytecode offset");
|
||||
def->bytecode[pc] &= ~((uint32_t)0x80);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Find a location for a breakpoint given a source file an
|
||||
* location.
|
||||
*/
|
||||
int janet_debug_find(
|
||||
void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset) {
|
||||
/* Scan the heap for right func def */
|
||||
@@ -84,98 +86,143 @@ int janet_debug_find(
|
||||
if (best_def) {
|
||||
*def_out = best_def;
|
||||
*pc_out = besti;
|
||||
return 0;
|
||||
} else {
|
||||
return 1;
|
||||
janet_panic("could not find breakpoint");
|
||||
}
|
||||
}
|
||||
|
||||
/* 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
|
||||
*/
|
||||
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
* Takes a source file name and byte offset. */
|
||||
static int helper_find(JanetArgs args, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
const uint8_t *source;
|
||||
int32_t source_offset;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_STRING(source, args, 0);
|
||||
JANET_ARG_INTEGER(source_offset, args, 1);
|
||||
if (janet_debug_find(
|
||||
def, bytecode_offset, source, source_offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
JANET_RETURN_NIL(args);
|
||||
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
janet_fixarity(argc, 2);
|
||||
const uint8_t *source = janet_getstring(argv, 0);
|
||||
int32_t source_offset = janet_getinteger(argv, 1);
|
||||
janet_debug_find(def, bytecode_offset, source, source_offset);
|
||||
}
|
||||
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
* Takes a function and byte offset*/
|
||||
static int helper_find_fun(JanetArgs args, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
JanetFunction *func;
|
||||
int32_t offset = 0;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_FUNCTION(func, args, 0);
|
||||
if (args.n == 2) {
|
||||
JANET_ARG_INTEGER(offset, args, 1);
|
||||
}
|
||||
static void helper_find_fun(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
int32_t offset = (argc == 2) ? janet_getinteger(argv, 1) : 0;
|
||||
*def = func->def;
|
||||
*bytecode_offset = offset;
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
|
||||
static int cfun_break(JanetArgs args) {
|
||||
static Janet cfun_debug_break(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find(args, &def, &offset);
|
||||
if (status == 0) janet_debug_break(def, offset);
|
||||
return status;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
janet_debug_break(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_unbreak(JanetArgs args) {
|
||||
static Janet cfun_debug_unbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find(args, &def, &offset);
|
||||
if (status == 0) janet_debug_unbreak(def, offset);
|
||||
return status;
|
||||
helper_find(argc, argv, &def, &offset);
|
||||
janet_debug_unbreak(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_fbreak(JanetArgs args) {
|
||||
static Janet cfun_debug_fbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find_fun(args, &def, &offset);
|
||||
if (status == 0) {
|
||||
if (janet_debug_break(def, offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
}
|
||||
return status;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
janet_debug_break(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_unfbreak(JanetArgs args) {
|
||||
static Janet cfun_debug_unfbreak(int32_t argc, Janet *argv) {
|
||||
JanetFuncDef *def;
|
||||
int32_t offset;
|
||||
int status = helper_find_fun(args, &def, &offset);
|
||||
if (status == 0) {
|
||||
if (janet_debug_unbreak(def, offset)) {
|
||||
JANET_THROW(args, "could not find breakpoint");
|
||||
}
|
||||
}
|
||||
return status;
|
||||
helper_find_fun(argc, argv, &def, &offset);
|
||||
janet_debug_unbreak(def, offset);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_lineage(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(0);
|
||||
static Janet cfun_debug_lineage(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
while (fiber) {
|
||||
janet_array_push(array, janet_wrap_fiber(fiber));
|
||||
fiber = fiber->child;
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
/* Extract info from one stack frame */
|
||||
@@ -184,52 +231,50 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
JanetTable *t = janet_table(3);
|
||||
JanetFuncDef *def = NULL;
|
||||
if (frame->func) {
|
||||
janet_table_put(t, janet_csymbolv(":function"), janet_wrap_function(frame->func));
|
||||
janet_table_put(t, janet_ckeywordv("function"), janet_wrap_function(frame->func));
|
||||
def = frame->func->def;
|
||||
if (def->name) {
|
||||
janet_table_put(t, janet_csymbolv(":name"), janet_wrap_string(def->name));
|
||||
janet_table_put(t, janet_ckeywordv("name"), janet_wrap_string(def->name));
|
||||
}
|
||||
} 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)) {
|
||||
janet_table_put(t, janet_csymbolv(":name"), name);
|
||||
janet_table_put(t, janet_ckeywordv("name"), name);
|
||||
}
|
||||
}
|
||||
janet_table_put(t, janet_csymbolv(":c"), janet_wrap_true());
|
||||
janet_table_put(t, janet_ckeywordv("c"), janet_wrap_true());
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL) {
|
||||
janet_table_put(t, janet_csymbolv(":tail"), janet_wrap_true());
|
||||
janet_table_put(t, janet_ckeywordv("tail"), janet_wrap_true());
|
||||
}
|
||||
if (frame->func && frame->pc) {
|
||||
Janet *stack = (Janet *)frame + JANET_FRAME_SIZE;
|
||||
JanetArray *slots;
|
||||
off = (int32_t) (frame->pc - def->bytecode);
|
||||
janet_table_put(t, janet_csymbolv(":pc"), janet_wrap_integer(off));
|
||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
janet_table_put(t, janet_csymbolv(":source-start"), janet_wrap_integer(mapping.start));
|
||||
janet_table_put(t, janet_csymbolv(":source-end"), janet_wrap_integer(mapping.end));
|
||||
janet_table_put(t, janet_ckeywordv("source-start"), janet_wrap_integer(mapping.start));
|
||||
janet_table_put(t, janet_ckeywordv("source-end"), janet_wrap_integer(mapping.end));
|
||||
}
|
||||
if (def->source) {
|
||||
janet_table_put(t, janet_csymbolv(":source"), janet_wrap_string(def->source));
|
||||
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||
}
|
||||
/* Add stack arguments */
|
||||
slots = janet_array(def->slotcount);
|
||||
memcpy(slots->data, stack, sizeof(Janet) * def->slotcount);
|
||||
slots->count = def->slotcount;
|
||||
janet_table_put(t, janet_csymbolv(":slots"), janet_wrap_array(slots));
|
||||
janet_table_put(t, janet_ckeywordv("slots"), janet_wrap_array(slots));
|
||||
}
|
||||
return janet_wrap_table(t);
|
||||
}
|
||||
|
||||
static int cfun_stack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(0);
|
||||
static Janet cfun_debug_stack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(0);
|
||||
{
|
||||
int32_t i = fiber->frame;
|
||||
JanetStackFrame *frame;
|
||||
@@ -239,75 +284,97 @@ static int cfun_stack(JanetArgs args) {
|
||||
i = frame->prevframe;
|
||||
}
|
||||
}
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int cfun_argstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JanetArray *array;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
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);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
JanetArray *array = janet_array(fiber->stacktop - fiber->stackstart);
|
||||
memcpy(array->data, fiber->data + fiber->stackstart, array->capacity * sizeof(Janet));
|
||||
array->count = array->capacity;
|
||||
JANET_RETURN_ARRAY(args, array);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"debug/break", cfun_break,
|
||||
"(debug/break source byte-offset)\n\n"
|
||||
"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 "
|
||||
"cannot be found. For example\n\n"
|
||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte of the file core.janet."},
|
||||
{"debug/unbreak", cfun_unbreak,
|
||||
"(debug/unbreak source byte-offset)\n\n"
|
||||
"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 "
|
||||
"cannot be found."},
|
||||
{"debug/fbreak", cfun_fbreak,
|
||||
"(debug/fbreak fun [,pc=0])\n\n"
|
||||
"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 "
|
||||
"if the offset is too large or negative."},
|
||||
{"debug/unfbreak", cfun_unfbreak,
|
||||
"(debug/unfbreak fun [,pc=0])\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak."},
|
||||
{"debug/arg-stack", cfun_argstack,
|
||||
"(debug/arg-stack fiber)\n\n"
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array."},
|
||||
{"debug/stack", cfun_stack,
|
||||
"(debug/stack fib)\n\n"
|
||||
"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 "
|
||||
"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"
|
||||
"\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:function - the function that the stack frame represents\n"
|
||||
"\t:line - the current source line of the stack frame\n"
|
||||
"\t:name - the human friendly name of the function\n"
|
||||
"\t:pc - integer indicating the location of the program counter\n"
|
||||
"\t:source - string with filename or other identifier for the source code\n"
|
||||
"\t:slots - array of all values in each slot\n"
|
||||
"\t:tail - boolean indicating a tail call"
|
||||
static const JanetReg debug_cfuns[] = {
|
||||
{
|
||||
"debug/break", cfun_debug_break,
|
||||
JDOC("(debug/break source byte-offset)\n\n"
|
||||
"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 "
|
||||
"cannot be found. For example\n\n"
|
||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||
},
|
||||
{"debug/lineage", cfun_lineage,
|
||||
"(debug/lineage fib)\n\n"
|
||||
"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, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes."
|
||||
{
|
||||
"debug/unbreak", cfun_debug_unbreak,
|
||||
JDOC("(debug/unbreak source byte-offset)\n\n"
|
||||
"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 "
|
||||
"cannot be found.")
|
||||
},
|
||||
{
|
||||
"debug/fbreak", cfun_debug_fbreak,
|
||||
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||
"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 "
|
||||
"if the offset is too large or negative.")
|
||||
},
|
||||
{
|
||||
"debug/unfbreak", cfun_debug_unfbreak,
|
||||
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak.")
|
||||
},
|
||||
{
|
||||
"debug/arg-stack", cfun_debug_argstack,
|
||||
JDOC("(debug/arg-stack fiber)\n\n"
|
||||
"Gets all values currently on the fiber's argument stack. Normally, "
|
||||
"this should be empty unless the fiber signals while pushing arguments "
|
||||
"to make a function call. Returns a new array.")
|
||||
},
|
||||
{
|
||||
"debug/stack", cfun_debug_stack,
|
||||
JDOC("(debug/stack fib)\n\n"
|
||||
"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 "
|
||||
"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"
|
||||
"\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:function - the function that the stack frame represents\n"
|
||||
"\t:line - the current source line of the stack frame\n"
|
||||
"\t:name - the human friendly name of the function\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:slots - array of all values in each slot\n"
|
||||
"\t:tail - boolean indicating a tail call")
|
||||
},
|
||||
{
|
||||
"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"
|
||||
"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, "
|
||||
"the fiber handling the error can see which fiber raised the signal. This function should "
|
||||
"be used mostly for debugging purposes.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_debug(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_debug(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, debug_cfuns);
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,10 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
/* Get a register */
|
||||
int32_t janetc_allocfar(JanetCompiler *c) {
|
||||
@@ -61,7 +63,7 @@ static int32_t janetc_const(JanetCompiler *c, Janet x) {
|
||||
if (janet_equals(x, scope->consts[i]))
|
||||
return i;
|
||||
}
|
||||
/* Ensure not too many constsants. */
|
||||
/* Ensure not too many constants. */
|
||||
if (len >= 0xFFFF) {
|
||||
janetc_cerror(c, "too many constants");
|
||||
return 0;
|
||||
@@ -82,17 +84,17 @@ static void janetc_loadconst(JanetCompiler *c, Janet k, int32_t reg) {
|
||||
case JANET_FALSE:
|
||||
janetc_emit(c, (reg << 8) | JOP_LOAD_FALSE);
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
case JANET_NUMBER:
|
||||
{
|
||||
int32_t i = janet_unwrap_integer(k);
|
||||
if (i <= INT16_MAX && i >= INT16_MIN) {
|
||||
janetc_emit(c,
|
||||
(i << 16) |
|
||||
(reg << 8) |
|
||||
JOP_LOAD_INTEGER);
|
||||
break;
|
||||
}
|
||||
goto do_constant;
|
||||
double dval = janet_unwrap_number(k);
|
||||
int32_t i = (int32_t) dval;
|
||||
if (dval != i || !(dval >= INT16_MIN && dval <= INT16_MAX))
|
||||
goto do_constant;
|
||||
janetc_emit(c,
|
||||
(i << 16) |
|
||||
(reg << 8) |
|
||||
JOP_LOAD_INTEGER);
|
||||
break;
|
||||
}
|
||||
default:
|
||||
do_constant:
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_EMIT_H
|
||||
#define JANET_EMIT_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "compile.h"
|
||||
#endif
|
||||
|
||||
void janetc_emit(JanetCompiler *c, uint32_t instr);
|
||||
|
||||
|
||||
249
src/core/fiber.c
249
src/core/fiber.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,12 +20,25 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "fiber.h"
|
||||
#include "state.h"
|
||||
#include "gc.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;
|
||||
JanetFiber *fiber = janet_gcalloc(JANET_MEMORY_FIBER, sizeof(JanetFiber));
|
||||
if (capacity < 32) {
|
||||
@@ -37,39 +50,31 @@ static JanetFiber *make_fiber(int32_t capacity) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
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;
|
||||
}
|
||||
|
||||
/* Initialize a new fiber */
|
||||
JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity) {
|
||||
JanetFiber *fiber = make_fiber(capacity);
|
||||
if (janet_fiber_funcframe(fiber, callee))
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||
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) {
|
||||
/* Create a new fiber with argn values on the stack by reusing a fiber. */
|
||||
JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv) {
|
||||
int32_t newstacktop;
|
||||
JanetFiber *fiber = make_fiber(capacity);
|
||||
newstacktop = fiber->stacktop + argn;
|
||||
if (newstacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newstacktop);
|
||||
fiber_reset(fiber);
|
||||
if (argc) {
|
||||
newstacktop = fiber->stacktop + argc;
|
||||
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))
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_ERROR);
|
||||
if (janet_fiber_funcframe(fiber, callee)) return NULL;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
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 */
|
||||
void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
Janet *newData = realloc(fiber->data, sizeof(Janet) * n);
|
||||
@@ -132,6 +137,13 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t nextstacktop = nextframe + func->def->slotcount + JANET_FRAME_SIZE;
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@@ -163,13 +175,6 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Check strict arity AFTER getting fiber to valid state. */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
@@ -198,6 +203,13 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
int32_t next_arity = fiber->stacktop - fiber->stackstart;
|
||||
int32_t stacksize;
|
||||
|
||||
/* Check strict arity before messing with state */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
if (fiber->capacity < nextstacktop) {
|
||||
janet_fiber_setcapacity(fiber, 2 * nextstacktop);
|
||||
}
|
||||
@@ -205,7 +217,7 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
Janet *stack = fiber->data + fiber->frame;
|
||||
Janet *args = fiber->data + fiber->stackstart;
|
||||
|
||||
/* Detatch old function */
|
||||
/* Detach old function */
|
||||
if (NULL != janet_fiber_frame(fiber)->func)
|
||||
janet_env_detach(janet_fiber_frame(fiber)->env);
|
||||
janet_fiber_frame(fiber)->env = NULL;
|
||||
@@ -241,13 +253,6 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
janet_fiber_frame(fiber)->pc = func->def->bytecode;
|
||||
janet_fiber_frame(fiber)->flags |= JANET_STACKFRAME_TAILCALL;
|
||||
|
||||
/* Check strict arity AFTER getting fiber to valid state. */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != next_arity) {
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
|
||||
/* Good return */
|
||||
return 0;
|
||||
}
|
||||
@@ -294,32 +299,28 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
JanetFiber *fiber;
|
||||
JanetFunction *func;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_FUNCTION(func, args, 0);
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_FIXARITY) {
|
||||
if (func->def->arity != 0) {
|
||||
JANET_THROW(args, "expected nullary function in fiber constructor");
|
||||
janet_panic("expected nullary function in fiber constructor");
|
||||
}
|
||||
}
|
||||
fiber = janet_fiber(func, 64);
|
||||
if (args.n == 2) {
|
||||
const uint8_t *flags;
|
||||
int32_t len, i;
|
||||
JANET_ARG_BYTES(flags, len, args, 1);
|
||||
fiber = janet_fiber(func, 64, 0, NULL);
|
||||
if (argc == 2) {
|
||||
int32_t i;
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
fiber->flags = 0;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
for (i = 0; i < len; i++) {
|
||||
if (flags[i] >= '0' && flags[i] <= '9') {
|
||||
fiber->flags |= JANET_FIBER_MASK_USERN(flags[i] - '0');
|
||||
for (i = 0; i < view.len; i++) {
|
||||
if (view.bytes[i] >= '0' && view.bytes[i] <= '9') {
|
||||
fiber->flags |= JANET_FIBER_MASK_USERN(view.bytes[i] - '0');
|
||||
} else {
|
||||
switch (flags[i]) {
|
||||
switch (view.bytes[i]) {
|
||||
default:
|
||||
JANET_THROW(args, "invalid flag, expected a, d, e, u, or y");
|
||||
case ':':
|
||||
janet_panicf("invalid flag %c, expected a, d, e, u, or y", view.bytes[i]);
|
||||
break;
|
||||
case 'a':
|
||||
fiber->flags |=
|
||||
@@ -344,93 +345,93 @@ static int cfun_new(JanetArgs args) {
|
||||
}
|
||||
}
|
||||
}
|
||||
JANET_RETURN_FIBER(args, fiber);
|
||||
return janet_wrap_fiber(fiber);
|
||||
}
|
||||
|
||||
static int cfun_status(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
||||
JANET_FIBER_STATUS_OFFSET;
|
||||
JANET_RETURN_CSYMBOL(args, janet_status_names[s]);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
static int cfun_current(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
JANET_RETURN_FIBER(args, janet_vm_fiber);
|
||||
static Janet cfun_fiber_current(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm_fiber);
|
||||
}
|
||||
|
||||
static int cfun_maxstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
JANET_RETURN_INTEGER(args, fiber->maxstack);
|
||||
static Janet cfun_fiber_maxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return janet_wrap_integer(fiber->maxstack);
|
||||
}
|
||||
|
||||
static int cfun_setmaxstack(JanetArgs args) {
|
||||
JanetFiber *fiber;
|
||||
int32_t maxs;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_FIBER(fiber, args, 0);
|
||||
JANET_ARG_INTEGER(maxs, args, 1);
|
||||
static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
int32_t maxs = janet_getinteger(argv, 1);
|
||||
if (maxs < 0) {
|
||||
JANET_THROW(args, "expected positive integer");
|
||||
janet_panic("expected positive integer");
|
||||
}
|
||||
fiber->maxstack = maxs;
|
||||
JANET_RETURN_FIBER(args, fiber);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"fiber/new", cfun_new,
|
||||
"(fiber/new func [,sigmask])\n\n"
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a symbol where each character "
|
||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||
"For example, \n\n"
|
||||
"\t(fiber/new myfun :e123)\n\n"
|
||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||
"as follows: \n\n"
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal"
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a keyword where each character "
|
||||
"is used to indicate a signal to block. The default sigmask is :y. "
|
||||
"For example, \n\n"
|
||||
"\t(fiber/new myfun :e123)\n\n"
|
||||
"blocks error signals and user signals 1, 2 and 3. The signals are "
|
||||
"as follows: \n\n"
|
||||
"\ta - block all signals\n"
|
||||
"\td - block debug signals\n"
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal")
|
||||
},
|
||||
{"fiber/status", cfun_status,
|
||||
"(fiber/status fib)\n\n"
|
||||
"Get the status of a fiber. The status will be one of:\n\n"
|
||||
"\t:dead - the fiber has finished\n"
|
||||
"\t:error - the fiber has errored out\n"
|
||||
"\t:debug - the fiber is suspended in debug mode\n"
|
||||
"\t:pending - the fiber has been yielded\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:new - the fiber has just been created and not yet run"
|
||||
{
|
||||
"fiber/status", cfun_fiber_status,
|
||||
JDOC("(fiber/status fib)\n\n"
|
||||
"Get the status of a fiber. The status will be one of:\n\n"
|
||||
"\t:dead - the fiber has finished\n"
|
||||
"\t:error - the fiber has errored out\n"
|
||||
"\t:debug - the fiber is suspended in debug mode\n"
|
||||
"\t:pending - the fiber has been yielded\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:new - the fiber has just been created and not yet run")
|
||||
},
|
||||
{"fiber/current", cfun_current,
|
||||
"(fiber/current)\n\n"
|
||||
"Returns the currently running fiber."
|
||||
{
|
||||
"fiber/current", cfun_fiber_current,
|
||||
JDOC("(fiber/current)\n\n"
|
||||
"Returns the currently running fiber.")
|
||||
},
|
||||
{"fiber/maxstack", cfun_maxstack,
|
||||
"(fiber/maxstack fib)\n\n"
|
||||
"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 "
|
||||
"than this amount and will throw a stackoverflow error if more memory is needed. "
|
||||
{
|
||||
"fiber/maxstack", cfun_fiber_maxstack,
|
||||
JDOC("(fiber/maxstack fib)\n\n"
|
||||
"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 "
|
||||
"than this amount and will throw a stack-overflow error if more memory is needed. ")
|
||||
},
|
||||
{"fiber/setmaxstack", cfun_setmaxstack,
|
||||
"(fiber/setmaxstack fib maxstack)\n\n"
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stacksize is usually 8192."
|
||||
{
|
||||
"fiber/setmaxstack", cfun_fiber_setmaxstack,
|
||||
JDOC("(fiber/setmaxstack fib maxstack)\n\n"
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_fiber(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_fiber(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, fiber_cfuns);
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_FIBER_H_defined
|
||||
#define JANET_FIBER_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,10 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "state.h"
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
/* GC State */
|
||||
JANET_THREAD_LOCAL void *janet_vm_blocks;
|
||||
@@ -60,6 +62,7 @@ void janet_mark(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default: break;
|
||||
case JANET_STRING:
|
||||
case JANET_KEYWORD:
|
||||
case JANET_SYMBOL: janet_mark_string(janet_unwrap_string(x)); break;
|
||||
case JANET_FUNCTION: janet_mark_function(janet_unwrap_function(x)); break;
|
||||
case JANET_ARRAY: janet_mark_array(janet_unwrap_array(x)); break;
|
||||
@@ -195,6 +198,11 @@ recur:
|
||||
if (janet_gc_reachable(fiber))
|
||||
return;
|
||||
janet_gc_mark(fiber);
|
||||
|
||||
/* Mark values on the argument stack */
|
||||
janet_mark_many(fiber->data + fiber->stackstart,
|
||||
fiber->stacktop - fiber->stackstart);
|
||||
|
||||
i = fiber->frame;
|
||||
j = fiber->stackstart - JANET_FRAME_SIZE;
|
||||
while (i > 0) {
|
||||
@@ -357,11 +365,9 @@ static int janet_gc_idequals(Janet lhs, Janet rhs) {
|
||||
case JANET_TRUE:
|
||||
case JANET_FALSE:
|
||||
case JANET_NIL:
|
||||
case JANET_NUMBER:
|
||||
/* These values don't really matter to the gc so returning 1 all the time is fine. */
|
||||
return 1;
|
||||
case JANET_INTEGER:
|
||||
return janet_unwrap_integer(lhs) == janet_unwrap_integer(rhs);
|
||||
case JANET_REAL:
|
||||
return janet_unwrap_real(lhs) == janet_unwrap_real(rhs);
|
||||
default:
|
||||
return janet_unwrap_pointer(lhs) == janet_unwrap_pointer(rhs);
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_GC_H
|
||||
#define JANET_GC_H
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/* The metadata header associated with an allocated block of memory */
|
||||
#define janet_gc_header(mem) ((JanetGCMemoryHeader *)(mem) - 1)
|
||||
@@ -36,7 +38,6 @@
|
||||
#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_unmark(m) (janet_gc_header(m)->flags &= ~JANET_MEM_COLOR)
|
||||
#define janet_gc_reachable(m) (janet_gc_header(m)->flags & JANET_MEM_REACHABLE)
|
||||
|
||||
/* Memory header struct. Node of a linked list of memory blocks. */
|
||||
|
||||
475
src/core/io.c
475
src/core/io.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,9 +25,13 @@
|
||||
#define _BSD_SOURCE
|
||||
|
||||
#include <stdio.h>
|
||||
#include <janet/janet.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#define IO_WRITE 1
|
||||
#define IO_READ 2
|
||||
#define IO_APPEND 4
|
||||
@@ -44,22 +48,28 @@ struct IOFile {
|
||||
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 = {
|
||||
":core/file",
|
||||
janet_io_gc,
|
||||
JanetAbstractType cfun_io_filetype = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
NULL,
|
||||
io_file_get,
|
||||
NULL
|
||||
};
|
||||
|
||||
/* Check argupments to fopen */
|
||||
static int checkflags(const uint8_t *str, int32_t len) {
|
||||
/* Check arguments to fopen */
|
||||
static int checkflags(const uint8_t *str) {
|
||||
int flags = 0;
|
||||
int32_t i;
|
||||
if (!len || len > 3) return -1;
|
||||
int32_t len = janet_string_length(str);
|
||||
if (!len || len > 3)
|
||||
janet_panic("file mode must have a length between 1 and 3");
|
||||
switch (*str) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("invalid flag %c, expected w, a, or r", *str);
|
||||
break;
|
||||
case 'w':
|
||||
flags |= IO_WRITE;
|
||||
break;
|
||||
@@ -73,7 +83,8 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
||||
for (i = 1; i < len; i++) {
|
||||
switch (str[i]) {
|
||||
default:
|
||||
return -1;
|
||||
janet_panicf("invalid flag %c, expected + or b", str[i]);
|
||||
break;
|
||||
case '+':
|
||||
if (flags & IO_UPDATE) return -1;
|
||||
flags |= IO_UPDATE;
|
||||
@@ -87,223 +98,164 @@ static int checkflags(const uint8_t *str, int32_t len) {
|
||||
return flags;
|
||||
}
|
||||
|
||||
/* Check file argument */
|
||||
static IOFile *checkfile(JanetArgs args, int32_t n) {
|
||||
IOFile *iof;
|
||||
if (n >= args.n) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(args.v[n], JANET_ABSTRACT)) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
iof = (IOFile *) janet_unwrap_abstract(args.v[n]);
|
||||
if (janet_abstract_type(iof) != &janet_io_filetype) {
|
||||
*args.ret = janet_cstringv("expected core.file");
|
||||
return NULL;
|
||||
}
|
||||
return iof;
|
||||
}
|
||||
|
||||
/* Check buffer argument */
|
||||
static JanetBuffer *checkbuffer(JanetArgs args, int32_t n, int optional) {
|
||||
if (optional && n == args.n) {
|
||||
return janet_buffer(0);
|
||||
}
|
||||
if (n >= args.n) {
|
||||
*args.ret = janet_cstringv("expected buffer");
|
||||
return NULL;
|
||||
}
|
||||
if (!janet_checktype(args.v[n], JANET_BUFFER)) {
|
||||
*args.ret = janet_cstringv("expected buffer");
|
||||
return NULL;
|
||||
}
|
||||
return janet_unwrap_abstract(args.v[n]);
|
||||
}
|
||||
|
||||
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->flags = flags;
|
||||
return janet_wrap_abstract(iof);
|
||||
}
|
||||
|
||||
/* Open a process */
|
||||
static int janet_io_popen(JanetArgs args) {
|
||||
const uint8_t *fname, *fmode;
|
||||
int32_t modelen;
|
||||
FILE *f;
|
||||
#ifdef __EMSCRIPTEN__
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_panic("not implemented on this platform");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
#else
|
||||
static Janet cfun_io_popen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode = NULL;
|
||||
int flags;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_STRING(fname, args, 0);
|
||||
if (args.n == 2) {
|
||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected string mode");
|
||||
fmode = janet_unwrap_string(args.v[1]);
|
||||
modelen = janet_string_length(fmode);
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
if (janet_string_length(fmode) != 1 ||
|
||||
!(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
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";
|
||||
modelen = 1;
|
||||
flags = IO_PIPED | IO_READ;
|
||||
}
|
||||
if (fmode[0] == ':') {
|
||||
fmode++;
|
||||
modelen--;
|
||||
}
|
||||
if (modelen != 1 || !(fmode[0] == 'r' || fmode[0] == 'w')) {
|
||||
JANET_THROW(args, "invalid file mode");
|
||||
}
|
||||
flags = (fmode[0] == 'r') ? IO_PIPED | IO_READ : IO_PIPED | IO_WRITE;
|
||||
#ifdef JANET_WINDOWS
|
||||
#define popen _popen
|
||||
#endif
|
||||
#ifdef __EMSCRIPTEN__
|
||||
#define popen(A, B) (errno = 0, NULL)
|
||||
#endif
|
||||
f = popen((const char *)fname, (const char *)fmode);
|
||||
FILE *f = popen((const char *)fname, (const char *)fmode);
|
||||
if (!f) {
|
||||
if (errno == EMFILE) {
|
||||
JANET_THROW(args, "too many streams are open");
|
||||
}
|
||||
JANET_THROW(args, "could not open file");
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
JANET_RETURN(args, makef(f, flags));
|
||||
return makef(f, flags);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Open a a file and return a userdata wrapper around the C file API. */
|
||||
static int janet_io_fopen(JanetArgs args) {
|
||||
const uint8_t *fname, *fmode;
|
||||
int32_t modelen;
|
||||
FILE *f;
|
||||
static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *fname = janet_getstring(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_STRING(fname, args, 0);
|
||||
if (args.n == 2) {
|
||||
if (!janet_checktype(args.v[1], JANET_STRING) &&
|
||||
!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected string mode");
|
||||
fmode = janet_unwrap_string(args.v[1]);
|
||||
modelen = janet_string_length(fmode);
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
modelen = 1;
|
||||
flags = IO_READ;
|
||||
}
|
||||
if (fmode[0] == ':') {
|
||||
fmode++;
|
||||
modelen--;
|
||||
}
|
||||
if ((flags = checkflags(fmode, modelen)) < 0) {
|
||||
JANET_THROW(args, "invalid file mode");
|
||||
}
|
||||
f = fopen((const char *)fname, (const char *)fmode);
|
||||
JANET_RETURN(args, f ? makef(f, flags) : janet_wrap_nil());
|
||||
FILE *f = fopen((const char *)fname, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. Return error string if error. */
|
||||
static const char *read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
return "file is not readable";
|
||||
/* Ensure buffer size */
|
||||
if (janet_buffer_extra(buffer, nBytesMax))
|
||||
return "buffer overflow";
|
||||
janet_panic("file is not readable");
|
||||
janet_buffer_extra(buffer, nBytesMax);
|
||||
size_t ntoread = nBytesMax;
|
||||
size_t nread = fread((char *)(buffer->data + buffer->count), 1, ntoread, iof->file);
|
||||
if (nread != ntoread && ferror(iof->file))
|
||||
return "could not read file";
|
||||
janet_panic("could not read file");
|
||||
buffer->count += (int32_t) nread;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Read a certain number of bytes into memory */
|
||||
static int janet_io_fread(JanetArgs args) {
|
||||
JanetBuffer *b;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
b = checkbuffer(args, 2, 1);
|
||||
if (!b) return 1;
|
||||
if (janet_checktype(args.v[1], JANET_SYMBOL)) {
|
||||
const uint8_t *sym = janet_unwrap_symbol(args.v[1]);
|
||||
if (!janet_cstrcmp(sym, ":all")) {
|
||||
static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED) janet_panic("file is closed");
|
||||
JanetBuffer *buffer;
|
||||
if (argc == 2) {
|
||||
buffer = janet_buffer(0);
|
||||
} else {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
}
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
/* Read whole file */
|
||||
int status = fseek(iof->file, 0, SEEK_SET);
|
||||
if (status) {
|
||||
/* backwards fseek did not work (stream like popen) */
|
||||
int32_t sizeBefore;
|
||||
do {
|
||||
sizeBefore = b->count;
|
||||
const char *maybeErr = read_chunk(iof, b, 1024);
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
} while (sizeBefore < b->count);
|
||||
sizeBefore = buffer->count;
|
||||
read_chunk(iof, buffer, 1024);
|
||||
} while (sizeBefore < buffer->count);
|
||||
} else {
|
||||
fseek(iof->file, 0, SEEK_END);
|
||||
long fsize = ftell(iof->file);
|
||||
if (fsize < 0) {
|
||||
janet_panicf("could not get file size of %v", argv[0]);
|
||||
}
|
||||
fseek(iof->file, 0, SEEK_SET);
|
||||
if (fsize > INT32_MAX) JANET_THROW(args, "buffer overflow");
|
||||
const char *maybeErr = read_chunk(iof, b, (int32_t) fsize);;
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
read_chunk(iof, buffer, (int32_t) fsize);
|
||||
}
|
||||
} else if (!janet_cstrcmp(sym, ":line")) {
|
||||
} else if (!janet_cstrcmp(sym, "line")) {
|
||||
for (;;) {
|
||||
int x = fgetc(iof->file);
|
||||
if (x != EOF && janet_buffer_push_u8(b, (uint8_t)x))
|
||||
JANET_THROW(args, "buffer overflow");
|
||||
if (x != EOF) janet_buffer_push_u8(buffer, (uint8_t)x);
|
||||
if (x == EOF || x == '\n') break;
|
||||
}
|
||||
} else {
|
||||
JANET_THROW(args, "expected one of :all, :line");
|
||||
janet_panicf("expected one of :all, :line, got %v", argv[1]);
|
||||
}
|
||||
} else if (!janet_checktype(args.v[1], JANET_INTEGER)) {
|
||||
JANET_THROW(args, "expected positive integer");
|
||||
} else {
|
||||
int32_t len = janet_unwrap_integer(args.v[1]);
|
||||
if (len < 0) JANET_THROW(args, "expected positive integer");
|
||||
const char *maybeErr = read_chunk(iof, b, len);
|
||||
if (maybeErr) JANET_THROW(args, maybeErr);
|
||||
int32_t len = janet_getinteger(argv, 1);
|
||||
if (len < 0) janet_panic("expected positive integer");
|
||||
read_chunk(iof, buffer, len);
|
||||
}
|
||||
JANET_RETURN(args, janet_wrap_buffer(b));
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
/* Write bytes to a file */
|
||||
static int janet_io_fwrite(JanetArgs args) {
|
||||
int32_t len, i;
|
||||
const uint8_t *str;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
static Janet cfun_io_fwrite(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
JANET_THROW(args, "file is not writeable");
|
||||
for (i = 1; i < args.n; i++) {
|
||||
JANET_CHECKMANY(args, i, JANET_TFLAG_BYTES);
|
||||
}
|
||||
for (i = 1; i < args.n; i++) {
|
||||
JANET_ARG_BYTES(str, len, args, i);
|
||||
if (len) {
|
||||
if (!fwrite(str, len, 1, iof->file)) JANET_THROW(args, "error writing to file");
|
||||
janet_panic("file is not writeable");
|
||||
int32_t i;
|
||||
/* Verify all arguments before writing to file */
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_getbytes(argv, i);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.len) {
|
||||
if (!fwrite(view.bytes, view.len, 1, iof->file)) {
|
||||
janet_panic("error writing to file");
|
||||
}
|
||||
}
|
||||
}
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* Flush the bytes in the file */
|
||||
static int janet_io_fflush(JanetArgs args) {
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
static Janet cfun_io_fflush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
janet_panic("file is closed");
|
||||
if (!(iof->flags & (IO_WRITE | IO_APPEND | IO_UPDATE)))
|
||||
JANET_THROW(args, "file is not flushable");
|
||||
if (fflush(iof->file)) JANET_THROW(args, "could not flush file");
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
janet_panic("file is not writeable");
|
||||
if (fflush(iof->file))
|
||||
janet_panic("could not flush file");
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* 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;
|
||||
IOFile *iof = (IOFile *)p;
|
||||
if (!(iof->flags & (IO_NOT_CLOSEABLE | IO_CLOSED))) {
|
||||
@@ -313,139 +265,150 @@ static int janet_io_gc(void *p, size_t len) {
|
||||
}
|
||||
|
||||
/* Close a file */
|
||||
static int janet_io_fclose(JanetArgs args) {
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & (IO_CLOSED))
|
||||
JANET_THROW(args, "file already closed");
|
||||
static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
if (iof->flags & (IO_NOT_CLOSEABLE))
|
||||
JANET_THROW(args, "file not closable");
|
||||
janet_panic("file not closable");
|
||||
if (iof->flags & IO_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#endif
|
||||
if (pclose(iof->file)) JANET_THROW(args, "could not close file");
|
||||
if (pclose(iof->file)) janet_panic("could not close file");
|
||||
} else {
|
||||
if (fclose(iof->file)) JANET_THROW(args, "could not close file");
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= IO_CLOSED;
|
||||
JANET_RETURN(args, janet_wrap_abstract(iof));
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
static int janet_io_fseek(JanetArgs args) {
|
||||
static Janet cfun_io_fseek(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
int whence = SEEK_CUR;
|
||||
IOFile *iof = checkfile(args, 0);
|
||||
if (!iof) return 1;
|
||||
if (iof->flags & IO_CLOSED)
|
||||
JANET_THROW(args, "file is closed");
|
||||
if (args.n >= 2) {
|
||||
const uint8_t *whence_sym;
|
||||
if (!janet_checktype(args.v[1], JANET_SYMBOL))
|
||||
JANET_THROW(args, "expected symbol");
|
||||
whence_sym = janet_unwrap_symbol(args.v[1]);
|
||||
if (!janet_cstrcmp(whence_sym, ":cur")) {
|
||||
if (argc >= 2) {
|
||||
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
||||
if (!janet_cstrcmp(whence_sym, "cur")) {
|
||||
whence = SEEK_CUR;
|
||||
} else if (!janet_cstrcmp(whence_sym, ":set")) {
|
||||
} else if (!janet_cstrcmp(whence_sym, "set")) {
|
||||
whence = SEEK_SET;
|
||||
} else if (!janet_cstrcmp(whence_sym, ":end")) {
|
||||
} else if (!janet_cstrcmp(whence_sym, "end")) {
|
||||
whence = SEEK_END;
|
||||
} else {
|
||||
JANET_THROW(args, "expected one of :cur, :set, :end");
|
||||
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
||||
}
|
||||
if (args.n >= 3) {
|
||||
double doffset;
|
||||
JANET_ARG_NUMBER(doffset, args, 2);
|
||||
offset = (long int)doffset;
|
||||
if (argc == 3) {
|
||||
offset = (long) janet_getinteger64(argv, 2);
|
||||
}
|
||||
}
|
||||
if (fseek(iof->file, offset, whence))
|
||||
JANET_THROW(args, "error seeking file");
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"file/open", janet_io_fopen,
|
||||
"(file/open path [,mode])\n\n"
|
||||
"Open a file. path is files absolute or relative path, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow witing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it"
|
||||
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", cfun_io_fopen,
|
||||
JDOC("(file/open path [,mode])\n\n"
|
||||
"Open a file. path is an absolute or relative path, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{"file/close", janet_io_fclose,
|
||||
"(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file."
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
"Close a file and release all related resources. When you are "
|
||||
"done reading a file, close it to prevent a resource leak and let "
|
||||
"other processes read the file.")
|
||||
},
|
||||
{"file/read", janet_io_fread,
|
||||
"(file/read f what [,buf])\n\n"
|
||||
"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 "
|
||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||
"buffer with file contents. "
|
||||
"Values for 'what':\n\n"
|
||||
"\t:all - read the whole file\n"
|
||||
"\t:line - read up to and including the next newline character\n"
|
||||
"\tn (integer) - read up to n bytes from the file"
|
||||
{
|
||||
"file/read", cfun_io_fread,
|
||||
JDOC("(file/read f what [,buf])\n\n"
|
||||
"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 "
|
||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||
"buffer with file contents. "
|
||||
"Values for 'what':\n\n"
|
||||
"\t:all - read the whole file\n"
|
||||
"\t:line - read up to and including the next newline character\n"
|
||||
"\tn (integer) - read up to n bytes from the file")
|
||||
},
|
||||
{"file/write", janet_io_fwrite,
|
||||
"(file/write f bytes)\n\n"
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file"
|
||||
{
|
||||
"file/write", cfun_io_fwrite,
|
||||
JDOC("(file/write f bytes)\n\n"
|
||||
"Writes to a file. 'bytes' must be string, buffer, or symbol. Returns the "
|
||||
"file.")
|
||||
},
|
||||
{"file/flush", janet_io_fflush,
|
||||
"(file/flush f)\n\n"
|
||||
"Flush any buffered bytes to the filesystem. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle."
|
||||
{
|
||||
"file/flush", cfun_io_fflush,
|
||||
JDOC("(file/flush f)\n\n"
|
||||
"Flush any buffered bytes to the file system. In most files, writes are "
|
||||
"buffered for efficiency reasons. Returns the file handle.")
|
||||
},
|
||||
{"file/seek", janet_io_fseek,
|
||||
"(file/seek f [,whence [,n]])\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:set - jump relative to the beginning of the file\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 "
|
||||
"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."
|
||||
{
|
||||
"file/seek", cfun_io_fseek,
|
||||
JDOC("(file/seek f [,whence [,n]])\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:set - jump relative to the beginning of the file\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 "
|
||||
"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.")
|
||||
},
|
||||
{"file/popen", janet_io_popen,
|
||||
"(file/popen path [,mode])\n\n"
|
||||
"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 "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file."
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path [,mode])\n\n"
|
||||
"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 "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
"can be written to. Returns the new file.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_io(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
void janet_lib_io(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, io_cfuns);
|
||||
|
||||
/* stdout */
|
||||
janet_def(env, "stdout",
|
||||
janet_core_def(env, "stdout",
|
||||
makef(stdout, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard output file.");
|
||||
|
||||
|
||||
JDOC("The standard output file."));
|
||||
/* stderr */
|
||||
janet_def(env, "stderr",
|
||||
janet_core_def(env, "stderr",
|
||||
makef(stderr, IO_APPEND | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard error file.");
|
||||
|
||||
JDOC("The standard error file."));
|
||||
/* stdin */
|
||||
janet_def(env, "stdin",
|
||||
janet_core_def(env, "stdin",
|
||||
makef(stdin, IO_READ | IO_NOT_CLOSEABLE | IO_SERIALIZABLE),
|
||||
"The standard input file.");
|
||||
|
||||
return 0;
|
||||
JDOC("The standard input file."));
|
||||
}
|
||||
|
||||
260
src/core/marsh.c
260
src/core/marsh.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,13 +20,14 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
#include "state.h"
|
||||
#include "vector.h"
|
||||
#include "gc.h"
|
||||
#include "fiber.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
typedef struct {
|
||||
jmp_buf err;
|
||||
@@ -61,14 +62,15 @@ const char *mr_strings[] = {
|
||||
|
||||
/* Lead bytes in marshaling protocol */
|
||||
enum {
|
||||
LB_NIL = 200,
|
||||
LB_REAL = 200,
|
||||
LB_NIL,
|
||||
LB_FALSE,
|
||||
LB_TRUE,
|
||||
LB_FIBER,
|
||||
LB_INTEGER,
|
||||
LB_REAL,
|
||||
LB_STRING,
|
||||
LB_SYMBOL,
|
||||
LB_KEYWORD,
|
||||
LB_ARRAY,
|
||||
LB_TUPLE,
|
||||
LB_TABLE,
|
||||
@@ -87,16 +89,16 @@ enum {
|
||||
static Janet entry_getval(Janet env_entry) {
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
Janet checkval = janet_table_get(entry, janet_csymbolv(":value"));
|
||||
Janet checkval = janet_table_get(entry, janet_ckeywordv("value"));
|
||||
if (janet_checktype(checkval, JANET_NIL)) {
|
||||
checkval = janet_table_get(entry, janet_csymbolv(":ref"));
|
||||
checkval = janet_table_get(entry, janet_ckeywordv("ref"));
|
||||
}
|
||||
return checkval;
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
Janet checkval = janet_struct_get(entry, janet_csymbolv(":value"));
|
||||
Janet checkval = janet_struct_get(entry, janet_ckeywordv("value"));
|
||||
if (janet_checktype(checkval, JANET_NIL)) {
|
||||
checkval = janet_struct_get(entry, janet_csymbolv(":ref"));
|
||||
checkval = janet_struct_get(entry, janet_ckeywordv("ref"));
|
||||
}
|
||||
return checkval;
|
||||
} else {
|
||||
@@ -122,25 +124,30 @@ JanetTable *janet_env_lookup(JanetTable *env) {
|
||||
|
||||
/* Marshal an integer onto the buffer */
|
||||
static void pushint(MarshalState *st, int32_t x) {
|
||||
if (x >= 0 && x < 200) {
|
||||
if (janet_buffer_push_u8(st->buf, x)) longjmp(st->err, MR_OVERFLOW);
|
||||
if (x >= 0 && x < 128) {
|
||||
janet_buffer_push_u8(st->buf, x);
|
||||
} else if (x <= 8191 && x >= -8192) {
|
||||
uint8_t intbuf[2];
|
||||
intbuf[0] = ((x >> 8) & 0x3F) | 0x80;
|
||||
intbuf[1] = x & 0xFF;
|
||||
janet_buffer_push_bytes(st->buf, intbuf, 2);
|
||||
} else {
|
||||
uint8_t intbuf[5];
|
||||
intbuf[0] = LB_INTEGER;
|
||||
intbuf[1] = x & 0xFF;
|
||||
intbuf[2] = (x >> 8) & 0xFF;
|
||||
intbuf[3] = (x >> 16) & 0xFF;
|
||||
intbuf[4] = (x >> 24) & 0xFF;
|
||||
if (janet_buffer_push_bytes(st->buf, intbuf, 5)) longjmp(st->err, MR_OVERFLOW);
|
||||
intbuf[1] = (x >> 24) & 0xFF;
|
||||
intbuf[2] = (x >> 16) & 0xFF;
|
||||
intbuf[3] = (x >> 8) & 0xFF;
|
||||
intbuf[4] = x & 0xFF;
|
||||
janet_buffer_push_bytes(st->buf, intbuf, 5);
|
||||
}
|
||||
}
|
||||
|
||||
static void pushbyte(MarshalState *st, uint8_t b) {
|
||||
if (janet_buffer_push_u8(st->buf, b)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_u8(st->buf, b);
|
||||
}
|
||||
|
||||
static void pushbytes(MarshalState *st, const uint8_t *bytes, int32_t len) {
|
||||
if (janet_buffer_push_bytes(st->buf, bytes, len)) longjmp(st->err, MR_OVERFLOW);
|
||||
janet_buffer_push_bytes(st->buf, bytes, len);
|
||||
}
|
||||
|
||||
/* Forward declaration to enable mutual recursion. */
|
||||
@@ -224,7 +231,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal the environments if needed */
|
||||
for (int32_t i = 0; i < def->environments_length; i++)
|
||||
pushint(st, def->environments[i]);
|
||||
pushint(st, def->environments[i]);
|
||||
|
||||
/* marshal the sub funcdefs if needed */
|
||||
for (int32_t i = 0; i < def->defs_length; i++)
|
||||
@@ -232,10 +239,12 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
|
||||
/* marshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
int32_t current = 0;
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
JanetSourceMapping map = def->sourcemap[i];
|
||||
pushint(st, map.start);
|
||||
pushint(st, map.end);
|
||||
pushint(st, map.start - current);
|
||||
pushint(st, map.end - map.start);
|
||||
current = map.end;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -297,9 +306,15 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
case JANET_TRUE:
|
||||
pushbyte(st, 200 + type);
|
||||
goto done;
|
||||
case JANET_INTEGER:
|
||||
pushint(st, janet_unwrap_integer(x));
|
||||
goto done;
|
||||
case JANET_NUMBER:
|
||||
{
|
||||
double xval = janet_unwrap_number(x);
|
||||
if (janet_checkintrange(xval)) {
|
||||
pushint(st, (int32_t) xval);
|
||||
goto done;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
#define MARK_SEEN() \
|
||||
@@ -308,7 +323,7 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
/* Check reference and registry value */
|
||||
{
|
||||
Janet check = janet_table_get(&st->seen, x);
|
||||
if (janet_checktype(check, JANET_INTEGER)) {
|
||||
if (janet_checkint(check)) {
|
||||
pushbyte(st, LB_REFERENCE);
|
||||
pushint(st, janet_unwrap_integer(check));
|
||||
goto done;
|
||||
@@ -328,13 +343,13 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
|
||||
/* Reference types */
|
||||
switch (type) {
|
||||
case JANET_REAL:
|
||||
case JANET_NUMBER:
|
||||
{
|
||||
union {
|
||||
double d;
|
||||
uint8_t bytes[8];
|
||||
} u;
|
||||
u.d = janet_unwrap_real(x);
|
||||
u.d = janet_unwrap_number(x);
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
/* Swap byte order */
|
||||
uint8_t temp;
|
||||
@@ -350,12 +365,15 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
goto done;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
const uint8_t *str = janet_unwrap_string(x);
|
||||
int32_t length = janet_string_length(str);
|
||||
/* Record reference */
|
||||
MARK_SEEN();
|
||||
uint8_t lb = (type == JANET_STRING) ? LB_STRING : LB_SYMBOL;
|
||||
uint8_t lb = (type == JANET_STRING) ? LB_STRING :
|
||||
(type == JANET_SYMBOL) ? LB_SYMBOL :
|
||||
LB_KEYWORD;
|
||||
pushbyte(st, lb);
|
||||
pushint(st, length);
|
||||
pushbytes(st, str, length);
|
||||
@@ -384,11 +402,13 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
goto done;
|
||||
case JANET_TUPLE:
|
||||
{
|
||||
int32_t i, count;
|
||||
int32_t i, count, flag;
|
||||
const Janet *tup = janet_unwrap_tuple(x);
|
||||
count = janet_tuple_length(tup);
|
||||
flag = janet_tuple_flag(tup);
|
||||
pushbyte(st, LB_TUPLE);
|
||||
pushint(st, count);
|
||||
pushint(st, flag);
|
||||
for (i = 0; i < count; i++)
|
||||
marshal_one(st, tup[i], flags + 1);
|
||||
/* Mark as seen AFTER marshaling */
|
||||
@@ -397,30 +417,32 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
|
||||
goto done;
|
||||
case JANET_TABLE:
|
||||
{
|
||||
const JanetKV *kv = NULL;
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
MARK_SEEN();
|
||||
pushbyte(st, t->proto ? LB_TABLE_PROTO : LB_TABLE);
|
||||
pushint(st, t->count);
|
||||
if (t->proto)
|
||||
marshal_one(st, janet_wrap_table(t->proto), flags + 1);
|
||||
while ((kv = janet_table_next(t, kv))) {
|
||||
marshal_one(st, kv->key, flags + 1);
|
||||
marshal_one(st, kv->value, flags + 1);
|
||||
for (int32_t i = 0; i < t->capacity; i++) {
|
||||
if (janet_checktype(t->data[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, t->data[i].key, flags + 1);
|
||||
marshal_one(st, t->data[i].value, flags + 1);
|
||||
}
|
||||
}
|
||||
goto done;
|
||||
case JANET_STRUCT:
|
||||
{
|
||||
int32_t count;
|
||||
const JanetKV *kv = NULL;
|
||||
const JanetKV *struct_ = janet_unwrap_struct(x);
|
||||
count = janet_struct_length(struct_);
|
||||
pushbyte(st, LB_STRUCT);
|
||||
pushint(st, count);
|
||||
while ((kv = janet_struct_next(struct_, kv))) {
|
||||
marshal_one(st, kv->key, flags + 1);
|
||||
marshal_one(st, kv->value, flags + 1);
|
||||
for (int32_t i = 0; i < janet_struct_capacity(struct_); i++) {
|
||||
if (janet_checktype(struct_[i].key, JANET_NIL))
|
||||
continue;
|
||||
marshal_one(st, struct_[i].key, flags + 1);
|
||||
marshal_one(st, struct_[i].value, flags + 1);
|
||||
}
|
||||
/* Mark as seen AFTER marshaling */
|
||||
MARK_SEEN();
|
||||
@@ -533,14 +555,19 @@ static int32_t readint(UnmarshalState *st, const uint8_t **atdata) {
|
||||
const uint8_t *data = *atdata;
|
||||
int32_t ret;
|
||||
if (data >= st->end) longjmp(st->err, UMR_EOS);
|
||||
if (*data < 200) {
|
||||
if (*data < 128) {
|
||||
ret = *data++;
|
||||
} else if (*data < 192) {
|
||||
if (data + 2 > st->end) longjmp(st->err, UMR_EOS);
|
||||
ret = ((data[0] & 0x3F) << 8) + data[1];
|
||||
ret = ((ret << 18) >> 18);
|
||||
data += 2;
|
||||
} else if (*data == LB_INTEGER) {
|
||||
if (data + 5 > st->end) longjmp(st->err, UMR_EOS);
|
||||
ret = (data[1]) |
|
||||
(data[2] << 8) |
|
||||
(data[3] << 16) |
|
||||
(data[4] << 24);
|
||||
ret = ((int32_t)(data[1]) << 24) |
|
||||
((int32_t)(data[2]) << 16) |
|
||||
((int32_t)(data[3]) << 8) |
|
||||
(int32_t)(data[4]);
|
||||
data += 5;
|
||||
} else {
|
||||
longjmp(st->err, UMR_EXPECTED_INTEGER);
|
||||
@@ -598,7 +625,7 @@ static const uint8_t *unmarshal_one_env(
|
||||
data = unmarshal_one(st, data, &fiberv, flags);
|
||||
if (!janet_checktype(fiberv, JANET_FIBER)) longjmp(st->err, UMR_EXPECTED_FIBER);
|
||||
env->as.fiber = janet_unwrap_fiber(fiberv);
|
||||
/* Unmarshaling fiber may set values */
|
||||
/* Unmarshalling fiber may set values */
|
||||
if (env->offset != 0 && env->offset != offset) longjmp(st->err, UMR_UNKNOWN);
|
||||
if (env->length != 0 && env->length != length) longjmp(st->err, UMR_UNKNOWN);
|
||||
} else {
|
||||
@@ -633,7 +660,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
*out = st->lookup_defs[index];
|
||||
} else {
|
||||
/* Initialize with values that will not break garbage collection
|
||||
* if unmarshaling fails. */
|
||||
* if unmarshalling fails. */
|
||||
JanetFuncDef *def = janet_gcalloc(JANET_MEMORY_FUNCDEF, sizeof(JanetFuncDef));
|
||||
def->environments_length = 0;
|
||||
def->defs_length = 0;
|
||||
@@ -735,13 +762,16 @@ static const uint8_t *unmarshal_one_def(
|
||||
|
||||
/* Unmarshal source maps if needed */
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASSOURCEMAP) {
|
||||
int32_t current = 0;
|
||||
def->sourcemap = malloc(sizeof(JanetSourceMapping) * bytecode_length);
|
||||
if (!def->sourcemap) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
def->sourcemap[i].start = readint(st, &data);
|
||||
def->sourcemap[i].end = readint(st, &data);
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].start = current;
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].end = current;
|
||||
}
|
||||
} else {
|
||||
def->sourcemap = NULL;
|
||||
@@ -774,7 +804,7 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshaling fails */
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
int32_t stack = 0;
|
||||
int32_t stacktop = 0;
|
||||
@@ -790,7 +820,6 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
if ((int32_t)(frame + JANET_FRAME_SIZE) > fiber->stackstart ||
|
||||
fiber->stackstart > fiber->stacktop ||
|
||||
fiber->stacktop > fiber->maxstack) {
|
||||
/* printf("bad flags and ints.\n"); */
|
||||
goto error;
|
||||
}
|
||||
|
||||
@@ -820,7 +849,6 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
Janet funcv;
|
||||
data = unmarshal_one(st, data, &funcv, flags + 1);
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) {
|
||||
/* printf("bad root func.\n"); */
|
||||
goto error;
|
||||
}
|
||||
func = janet_unwrap_function(funcv);
|
||||
@@ -894,8 +922,8 @@ static const uint8_t *unmarshal_one(
|
||||
EXTRA(1);
|
||||
lead = data[0];
|
||||
if (lead < 200) {
|
||||
*out = janet_wrap_integer(lead);
|
||||
return data + 1;
|
||||
*out = janet_wrap_integer(readint(st, &data));
|
||||
return data;
|
||||
}
|
||||
switch (lead) {
|
||||
case LB_NIL:
|
||||
@@ -911,10 +939,10 @@ static const uint8_t *unmarshal_one(
|
||||
/* Long integer */
|
||||
EXTRA(5);
|
||||
*out = janet_wrap_integer(
|
||||
(data[1]) |
|
||||
(data[2] << 8) |
|
||||
(data[3] << 16) |
|
||||
(data[4] << 24));
|
||||
(data[4]) |
|
||||
(data[3] << 8) |
|
||||
(data[2] << 16) |
|
||||
(data[1] << 24));
|
||||
return data + 5;
|
||||
case LB_REAL:
|
||||
/* Real */
|
||||
@@ -936,13 +964,14 @@ static const uint8_t *unmarshal_one(
|
||||
#else
|
||||
memcpy(&u.bytes, data + 1, sizeof(double));
|
||||
#endif
|
||||
*out = janet_wrap_real(u.d);
|
||||
*out = janet_wrap_number(u.d);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
return data + 9;
|
||||
}
|
||||
case LB_STRING:
|
||||
case LB_SYMBOL:
|
||||
case LB_BUFFER:
|
||||
case LB_KEYWORD:
|
||||
case LB_REGISTRY:
|
||||
{
|
||||
data++;
|
||||
@@ -954,6 +983,9 @@ static const uint8_t *unmarshal_one(
|
||||
} else if (lead == LB_SYMBOL) {
|
||||
const uint8_t *str = janet_symbol(data, len);
|
||||
*out = janet_wrap_symbol(str);
|
||||
} else if (lead == LB_KEYWORD) {
|
||||
const uint8_t *str = janet_keyword(data, len);
|
||||
*out = janet_wrap_keyword(str);
|
||||
} else if (lead == LB_REGISTRY) {
|
||||
if (st->reg) {
|
||||
Janet regkey = janet_symbolv(data, len);
|
||||
@@ -983,7 +1015,7 @@ static const uint8_t *unmarshal_one(
|
||||
JanetFuncDef *def;
|
||||
data = unmarshal_one_def(st, data + 1, &def, flags + 1);
|
||||
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
|
||||
def->environments_length * sizeof(JanetFuncEnv));
|
||||
def->environments_length * sizeof(JanetFuncEnv));
|
||||
func->def = def;
|
||||
*out = janet_wrap_function(func);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
@@ -1014,6 +1046,8 @@ static const uint8_t *unmarshal_one(
|
||||
} else if (lead == LB_TUPLE) {
|
||||
/* Tuple */
|
||||
Janet *tup = janet_tuple_begin(len);
|
||||
int32_t flag = readint(st, &data);
|
||||
janet_tuple_flag(tup) = flag;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one(st, data, tup + i, flags + 1);
|
||||
}
|
||||
@@ -1088,91 +1122,77 @@ int janet_unmarshal(
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int cfun_env_lookup(JanetArgs args) {
|
||||
JanetTable *env;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(env, args, 0);
|
||||
JANET_RETURN_TABLE(args, janet_env_lookup(env));
|
||||
static Janet cfun_env_lookup(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *env = janet_gettable(argv, 0);
|
||||
return janet_wrap_table(janet_env_lookup(env));
|
||||
}
|
||||
|
||||
static int cfun_marshal(JanetArgs args) {
|
||||
static Janet cfun_marshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetBuffer *buffer;
|
||||
JanetTable *rreg;
|
||||
JanetTable *rreg = NULL;
|
||||
Janet err_param = janet_wrap_nil();
|
||||
int status;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 3);
|
||||
if (args.n > 1) {
|
||||
/* Reverse Registry provided */
|
||||
JANET_ARG_TABLE(rreg, args, 1);
|
||||
} else {
|
||||
rreg = NULL;
|
||||
if (argc > 1) {
|
||||
rreg = janet_gettable(argv, 1);
|
||||
}
|
||||
if (args.n > 2) {
|
||||
/* Buffer provided */
|
||||
JANET_ARG_BUFFER(buffer, args, 2);
|
||||
if (argc > 2) {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
} else {
|
||||
buffer = janet_buffer(10);
|
||||
}
|
||||
status = janet_marshal(buffer, args.v[0], &err_param, rreg, 0);
|
||||
if (status) {
|
||||
const uint8_t *errstr = janet_formatc(
|
||||
"%s for %V",
|
||||
mr_strings[status],
|
||||
err_param);
|
||||
JANET_THROWV(args, janet_wrap_string(errstr));
|
||||
}
|
||||
JANET_RETURN_BUFFER(args, buffer);
|
||||
status = janet_marshal(buffer, argv[0], &err_param, rreg, 0);
|
||||
if (status)
|
||||
janet_panicf("%s for %V", mr_strings[status], err_param);
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
static int cfun_unmarshal(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
JanetTable *reg;
|
||||
int32_t len;
|
||||
static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetTable *reg = NULL;
|
||||
Janet ret;
|
||||
int status;
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
||||
if (args.n > 1) {
|
||||
JANET_ARG_TABLE(reg, args, 1);
|
||||
} else {
|
||||
reg = NULL;
|
||||
if (argc > 1) {
|
||||
reg = janet_gettable(argv, 1);
|
||||
}
|
||||
status = janet_unmarshal(bytes, (size_t) len, 0, args.ret, reg, NULL);
|
||||
status = janet_unmarshal(view.bytes, (size_t) view.len, 0, &ret, reg, NULL);
|
||||
if (status) {
|
||||
JANET_THROW(args, umr_strings[status]);
|
||||
janet_panic(umr_strings[status]);
|
||||
}
|
||||
return JANET_SIGNAL_OK;
|
||||
return ret;
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"marshal", cfun_marshal,
|
||||
"(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the origrinal janet value when "
|
||||
"unmarshaling."
|
||||
static const JanetReg marsh_cfuns[] = {
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"lookup table can be used to recover the original janet value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
{"unmarshal", cfun_unmarshal,
|
||||
"(unmarshal buffer [,lookup])\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshaled from the buffer."
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer [,lookup])\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
},
|
||||
{"env-lookup", cfun_env_lookup,
|
||||
"(env-lookup env)\n\n"
|
||||
"Creates a forward lookup table for unmarshaling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table."
|
||||
{
|
||||
"env-lookup", cfun_env_lookup,
|
||||
JDOC("(env-lookup env)\n\n"
|
||||
"Creates a forward lookup table for unmarshalling from an environment. "
|
||||
"To create a reverse lookup table, use the invert function to swap keys "
|
||||
"and values in the returned table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_marsh(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_marsh(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, marsh_cfuns);
|
||||
}
|
||||
|
||||
270
src/core/math.c
270
src/core/math.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,79 +20,41 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <janet/janet.h>
|
||||
#include <math.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Get a random number */
|
||||
int janet_rand(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
||||
JANET_RETURN_REAL(args, r);
|
||||
return janet_wrap_number(r);
|
||||
}
|
||||
|
||||
/* Seed the random number generator */
|
||||
int janet_srand(JanetArgs args) {
|
||||
int32_t x = 0;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(x, args, 0);
|
||||
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t x = janet_getinteger(argv, 0);
|
||||
srand((unsigned) x);
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Convert a number to an integer */
|
||||
int janet_int(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
switch (janet_type(args.v[0])) {
|
||||
default:
|
||||
JANET_THROW(args, "could not convert to integer");
|
||||
case JANET_REAL:
|
||||
*args.ret = janet_wrap_integer((int32_t) janet_unwrap_real(args.v[0]));
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
*args.ret = args.v[0];
|
||||
break;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Convert a number to a real number */
|
||||
int janet_real(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
switch (janet_type(args.v[0])) {
|
||||
default:
|
||||
JANET_THROW(args, "could not convert to real");
|
||||
case JANET_REAL:
|
||||
*args.ret = args.v[0];
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
*args.ret = janet_wrap_real((double) janet_unwrap_integer(args.v[0]));
|
||||
break;
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
int janet_remainder(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
if (janet_checktype(args.v[0], JANET_INTEGER) &&
|
||||
janet_checktype(args.v[1], JANET_INTEGER)) {
|
||||
int32_t x, y;
|
||||
x = janet_unwrap_integer(args.v[0]);
|
||||
y = janet_unwrap_integer(args.v[1]);
|
||||
JANET_RETURN_INTEGER(args, x % y);
|
||||
} else {
|
||||
double x, y;
|
||||
JANET_ARG_NUMBER(x, args, 0);
|
||||
JANET_ARG_NUMBER(y, args, 1);
|
||||
JANET_RETURN_REAL(args, fmod(x, y));
|
||||
}
|
||||
static Janet janet_remainder(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
double x = janet_getnumber(argv, 0);
|
||||
double y = janet_getnumber(argv, 1);
|
||||
return janet_wrap_number(fmod(x, y));
|
||||
}
|
||||
|
||||
#define JANET_DEFINE_MATHOP(name, fop)\
|
||||
int janet_##name(JanetArgs args) {\
|
||||
double x;\
|
||||
JANET_FIXARITY(args, 1);\
|
||||
JANET_ARG_NUMBER(x, args, 0);\
|
||||
JANET_RETURN_REAL(args, fop(x));\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 1); \
|
||||
double x = janet_getnumber(argv, 0); \
|
||||
return janet_wrap_number(fop(x)); \
|
||||
}
|
||||
|
||||
JANET_DEFINE_MATHOP(acos, acos)
|
||||
@@ -113,110 +75,144 @@ JANET_DEFINE_MATHOP(fabs, fabs)
|
||||
JANET_DEFINE_MATHOP(floor, floor)
|
||||
|
||||
#define JANET_DEFINE_MATH2OP(name, fop)\
|
||||
int janet_##name(JanetArgs args) {\
|
||||
double lhs, rhs;\
|
||||
JANET_FIXARITY(args, 2);\
|
||||
JANET_ARG_NUMBER(lhs, args, 0);\
|
||||
JANET_ARG_NUMBER(rhs, args, 1);\
|
||||
JANET_RETURN_REAL(args, fop(lhs, rhs));\
|
||||
static Janet janet_##name(int32_t argc, Janet *argv) {\
|
||||
janet_fixarity(argc, 2); \
|
||||
double lhs = janet_getnumber(argv, 0); \
|
||||
double rhs = janet_getnumber(argv, 1); \
|
||||
return janet_wrap_number(fop(lhs, rhs)); \
|
||||
}\
|
||||
|
||||
JANET_DEFINE_MATH2OP(atan2, atan2)
|
||||
JANET_DEFINE_MATH2OP(pow, pow)
|
||||
|
||||
static int janet_not(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_RETURN_BOOLEAN(args, !janet_truthy(args.v[0]));
|
||||
static Janet janet_not(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
return janet_wrap_boolean(!janet_truthy(argv[0]));
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"%", janet_remainder,
|
||||
"(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor."
|
||||
static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"%", janet_remainder,
|
||||
JDOC("(% dividend divisor)\n\n"
|
||||
"Returns the remainder of dividend / divisor.")
|
||||
},
|
||||
{"not", janet_not,
|
||||
"(not x)\n\nReturns the boolen inverse of x."
|
||||
{
|
||||
"not", janet_not,
|
||||
JDOC("(not x)\n\nReturns the boolean inverse of x.")
|
||||
},
|
||||
{"int", janet_int,
|
||||
"(int x)\n\nCast a number x to an integer."
|
||||
{
|
||||
"math/random", janet_rand,
|
||||
JDOC("(math/random)\n\n"
|
||||
"Returns a uniformly distributed random number between 0 and 1.")
|
||||
},
|
||||
{"real", janet_real,
|
||||
"(real x)\n\nCast a number x to a real number."
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be an "
|
||||
"an integer.")
|
||||
},
|
||||
{"math/random", janet_rand,
|
||||
"(math/random)\n\n"
|
||||
"Returns a uniformly distrbuted random real number between 0 and 1."
|
||||
{
|
||||
"math/cos", janet_cos,
|
||||
JDOC("(math/cos x)\n\n"
|
||||
"Returns the cosine of x.")
|
||||
},
|
||||
{"math/seedrandom", janet_srand,
|
||||
"(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be an "
|
||||
"an integer."
|
||||
{
|
||||
"math/sin", janet_sin,
|
||||
JDOC("(math/sin x)\n\n"
|
||||
"Returns the sine of x.")
|
||||
},
|
||||
{"math/cos", janet_cos,
|
||||
"(math/cos x)\n\n"
|
||||
"Returns the cosine of x."
|
||||
{
|
||||
"math/tan", janet_tan,
|
||||
JDOC("(math/tan x)\n\n"
|
||||
"Returns the tangent of x.")
|
||||
},
|
||||
{"math/sin", janet_sin,
|
||||
"(math/sin x)\n\n"
|
||||
"Returns the sine of x."
|
||||
{
|
||||
"math/acos", janet_acos,
|
||||
JDOC("(math/acos x)\n\n"
|
||||
"Returns the arccosine of x.")
|
||||
},
|
||||
{"math/tan", janet_tan,
|
||||
"(math/tan x)\n\n"
|
||||
"Returns the tangent of x."
|
||||
{
|
||||
"math/asin", janet_asin,
|
||||
JDOC("(math/asin x)\n\n"
|
||||
"Returns the arcsine of x.")
|
||||
},
|
||||
{"math/acos", janet_acos,
|
||||
"(math/acos x)\n\n"
|
||||
"Returns the arccosine of x."
|
||||
{
|
||||
"math/atan", janet_atan,
|
||||
JDOC("(math/atan x)\n\n"
|
||||
"Returns the arctangent of x.")
|
||||
},
|
||||
{"math/asin", janet_asin,
|
||||
"(math/asin x)\n\n"
|
||||
"Returns the arcsine of x."
|
||||
{
|
||||
"math/exp", janet_exp,
|
||||
JDOC("(math/exp x)\n\n"
|
||||
"Returns e to the power of x.")
|
||||
},
|
||||
{"math/atan", janet_atan,
|
||||
"(math/atan x)\n\n"
|
||||
"Returns the arctangent of x."
|
||||
{
|
||||
"math/log", janet_log,
|
||||
JDOC("(math/log x)\n\n"
|
||||
"Returns log base 2 of x.")
|
||||
},
|
||||
{"math/exp", janet_exp,
|
||||
"(math/exp x)\n\n"
|
||||
"Returns e to the power of x."
|
||||
{
|
||||
"math/log10", janet_log10,
|
||||
JDOC("(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x.")
|
||||
},
|
||||
{"math/log", janet_log,
|
||||
"(math/log x)\n\n"
|
||||
"Returns log base 2 of x."
|
||||
{
|
||||
"math/sqrt", janet_sqrt,
|
||||
JDOC("(math/sqrt x)\n\n"
|
||||
"Returns the square root of x.")
|
||||
},
|
||||
{"math/log10", janet_log10,
|
||||
"(math/log10 x)\n\n"
|
||||
"Returns log base 10 of x."
|
||||
{
|
||||
"math/floor", janet_floor,
|
||||
JDOC("(math/floor x)\n\n"
|
||||
"Returns the largest integer value number that is not greater than x.")
|
||||
},
|
||||
{"math/sqrt", janet_sqrt,
|
||||
"(math/sqrt x)\n\n"
|
||||
"Returns the square root of x."
|
||||
{
|
||||
"math/ceil", janet_ceil,
|
||||
JDOC("(math/ceil x)\n\n"
|
||||
"Returns the smallest integer value number that is not less than x.")
|
||||
},
|
||||
{"math/floor", janet_floor,
|
||||
"(math/floor x)\n\n"
|
||||
"Returns the largest integer value real number that is not greater than x."
|
||||
{
|
||||
"math/pow", janet_pow,
|
||||
JDOC("(math/pow a x)\n\n"
|
||||
"Return a to the power of x.")
|
||||
},
|
||||
{"math/ceil", janet_ceil,
|
||||
"(math/ceil x)\n\n"
|
||||
"Returns the smallest integer value real number that is not less than x."
|
||||
{
|
||||
"math/abs", janet_fabs,
|
||||
JDOC("(math/abs x)\n\n"
|
||||
"Return the absolute value of x.")
|
||||
},
|
||||
{"math/pow", janet_pow,
|
||||
"(math/pow a x)\n\n"
|
||||
"Return a to the power 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}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_math(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
|
||||
janet_def(env, "math/pi", janet_wrap_real(3.1415926535897931),
|
||||
"The value pi.");
|
||||
janet_def(env, "math/e", janet_wrap_real(2.7182818284590451),
|
||||
"The base of the natural log.");
|
||||
janet_def(env, "math/inf", janet_wrap_real(INFINITY),
|
||||
"The real number representing positive infinity");
|
||||
return 0;
|
||||
void janet_lib_math(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, math_cfuns);
|
||||
#ifdef JANET_BOOTSTRAP
|
||||
janet_def(env, "math/pi", janet_wrap_number(3.1415926535897931),
|
||||
JDOC("The value pi."));
|
||||
janet_def(env, "math/e", janet_wrap_number(2.7182818284590451),
|
||||
JDOC("The base of the natural log."));
|
||||
janet_def(env, "math/inf", janet_wrap_number(INFINITY),
|
||||
JDOC("The number representing positive infinity"));
|
||||
#endif
|
||||
}
|
||||
|
||||
@@ -1,111 +0,0 @@
|
||||
/*
|
||||
* Copyright (c) 2018 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/janet.h>
|
||||
#include "compile.h"
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
|
||||
/* Parse a part of a symbol that can be used for building up code. */
|
||||
static JanetSlot multisym_parse_part(JanetCompiler *c, const uint8_t *sympart, int32_t len) {
|
||||
if (sympart[0] == ':') {
|
||||
return janetc_cslot(janet_symbolv(sympart, len));
|
||||
} else {
|
||||
int err = 0;
|
||||
int32_t num = janet_scan_integer(sympart + 1, len - 1, &err);
|
||||
if (err) {
|
||||
return janetc_resolve(c, janet_symbol(sympart + 1, len - 1));
|
||||
} else {
|
||||
return janetc_cslot(janet_wrap_integer(num));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static JanetSlot multisym_do_parts(JanetFopts opts, int put, const uint8_t *sym, Janet rvalue) {
|
||||
JanetSlot slot;
|
||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||
int i, j;
|
||||
for (i = 1, j = 0; sym[i]; i++) {
|
||||
if (sym[i] == ':' || sym[i] == '.') {
|
||||
if (j) {
|
||||
JanetSlot target = janetc_gettarget(subopts);
|
||||
JanetSlot value = multisym_parse_part(opts.compiler, sym + j, i - j);
|
||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, value, 1);
|
||||
slot = target;
|
||||
} else {
|
||||
const uint8_t *nextsym = janet_symbol(sym + j, i - j);
|
||||
slot = janetc_resolve(opts.compiler, nextsym);
|
||||
}
|
||||
j = i;
|
||||
}
|
||||
}
|
||||
|
||||
if (j) {
|
||||
/* multisym (outermost get or put) */
|
||||
JanetSlot target = janetc_gettarget(opts);
|
||||
JanetSlot key = multisym_parse_part(opts.compiler, sym + j, i - j);
|
||||
if (put) {
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = target;
|
||||
JanetSlot r_slot = janetc_value(subopts, rvalue);
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, slot, key, r_slot, 0);
|
||||
janetc_copy(opts.compiler, target, r_slot);
|
||||
} else {
|
||||
janetc_emit_sss(opts.compiler, JOP_GET, target, slot, key, 1);
|
||||
}
|
||||
return target;
|
||||
} else {
|
||||
/* normal symbol */
|
||||
if (put) {
|
||||
JanetSlot ret, dest;
|
||||
dest = janetc_resolve(opts.compiler, sym);
|
||||
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
||||
janetc_cerror(opts.compiler, "cannot set constant");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = dest;
|
||||
ret = janetc_value(subopts, rvalue);
|
||||
janetc_copy(opts.compiler, dest, ret);
|
||||
return ret;
|
||||
}
|
||||
return janetc_resolve(opts.compiler, sym);
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a symbol is a multisym, and if so, transform
|
||||
* it and emit the code for treating it as a bunch of nested
|
||||
* gets. */
|
||||
JanetSlot janetc_sym_rvalue(JanetFopts opts, const uint8_t *sym) {
|
||||
if (janet_string_length(sym) && sym[0] != ':') {
|
||||
return multisym_do_parts(opts, 0, sym, janet_wrap_nil());
|
||||
} else {
|
||||
/* keyword */
|
||||
return janetc_cslot(janet_wrap_symbol(sym));
|
||||
}
|
||||
}
|
||||
|
||||
/* Check if a symbol is a multisym, and if so, transform
|
||||
* it into the correct 'put' expression. */
|
||||
JanetSlot janetc_sym_lvalue(JanetFopts opts, const uint8_t *sym, Janet value) {
|
||||
return multisym_do_parts(opts, 1, sym, value);
|
||||
}
|
||||
309
src/core/os.c
309
src/core/os.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,11 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#include <stdlib.h>
|
||||
#include <time.h>
|
||||
|
||||
@@ -40,27 +44,28 @@
|
||||
#include <mach/mach.h>
|
||||
#endif
|
||||
|
||||
static int os_which(JanetArgs args) {
|
||||
static Janet os_which(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
JANET_RETURN_CSYMBOL(args, ":windows");
|
||||
return janet_ckeywordv("windows");
|
||||
#elif __APPLE__
|
||||
JANET_RETURN_CSYMBOL(args, ":macos");
|
||||
return janet_ckeywordv("macos");
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
JANET_RETURN_CSYMBOL(args, ":web");
|
||||
return janet_ckeywordv("web");
|
||||
#else
|
||||
JANET_RETURN_CSYMBOL(args, ":posix");
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
}
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
static int os_execute(JanetArgs args) {
|
||||
JANET_MINARITY(args, 1);
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(10);
|
||||
for (int32_t i = 0; i < args.n; i++) {
|
||||
const uint8_t *argstring;
|
||||
JANET_ARG_STRING(argstring, args, i);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
const uint8_t *argstring = janet_getstring(argv, i);
|
||||
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
||||
if (i != args.n - 1) {
|
||||
if (i != argc - 1) {
|
||||
janet_buffer_push_u8(buffer, ' ');
|
||||
}
|
||||
}
|
||||
@@ -80,7 +85,7 @@ static int os_execute(JanetArgs args) {
|
||||
buffer->count);
|
||||
if (nwritten == 0) {
|
||||
free(sys_str);
|
||||
JANET_THROW(args, "could not create process");
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
|
||||
STARTUPINFO si;
|
||||
@@ -102,7 +107,7 @@ static int os_execute(JanetArgs args) {
|
||||
&si,
|
||||
&pi)) {
|
||||
free(sys_str);
|
||||
JANET_THROW(args, "could not create process");
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
free(sys_str);
|
||||
|
||||
@@ -114,61 +119,57 @@ static int os_execute(JanetArgs args) {
|
||||
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
||||
CloseHandle(pi.hProcess);
|
||||
CloseHandle(pi.hThread);
|
||||
JANET_RETURN_INTEGER(args, (int32_t)status);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
#else
|
||||
static int os_execute(JanetArgs args) {
|
||||
JANET_MINARITY(args, 1);
|
||||
const uint8_t **argv = malloc(sizeof(uint8_t *) * (args.n + 1));
|
||||
if (NULL == argv) {
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const uint8_t **child_argv = malloc(sizeof(uint8_t *) * (argc + 1));
|
||||
if (NULL == child_argv) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
for (int32_t i = 0; i < args.n; i++) {
|
||||
JANET_ARG_STRING(argv[i], args, i);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
child_argv[i] = janet_getstring(argv, i);
|
||||
}
|
||||
argv[args.n] = NULL;
|
||||
child_argv[argc] = NULL;
|
||||
|
||||
/* Fork child process */
|
||||
pid_t pid = fork();
|
||||
if (pid < 0) {
|
||||
JANET_THROW(args, "failed to execute");
|
||||
janet_panic("failed to execute");
|
||||
} else if (pid == 0) {
|
||||
if (-1 == execve((const char *)argv[0], (char **)argv, NULL)) {
|
||||
if (-1 == execve((const char *)child_argv[0], (char **)child_argv, NULL)) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
int status;
|
||||
waitpid(pid, &status, 0);
|
||||
JANET_RETURN_INTEGER(args, status);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
#endif
|
||||
|
||||
static int os_shell(JanetArgs args) {
|
||||
int nofirstarg = (args.n < 1 || !janet_checktype(args.v[0], JANET_STRING));
|
||||
const char *cmd = nofirstarg
|
||||
? NULL
|
||||
: (const char *) janet_unwrap_string(args.v[0]);
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
const char *cmd = argc
|
||||
? (const char *)janet_getstring(argv, 0)
|
||||
: NULL;
|
||||
int stat = system(cmd);
|
||||
JANET_RETURN(args, cmd
|
||||
? janet_wrap_integer(stat)
|
||||
: janet_wrap_boolean(stat));
|
||||
return argc
|
||||
? janet_wrap_integer(stat)
|
||||
: janet_wrap_boolean(stat);
|
||||
}
|
||||
|
||||
static int os_getenv(JanetArgs args) {
|
||||
const uint8_t *k;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_STRING(k, args, 0);
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *cstr = (const char *) k;
|
||||
const char *res = getenv(cstr);
|
||||
if (!res) {
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
JANET_RETURN(args, cstr
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil());
|
||||
return (res && cstr)
|
||||
? janet_cstringv(res)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_setenv(JanetArgs args) {
|
||||
static Janet os_setenv(int32_t argc, Janet *argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define SETENV(K,V) _putenv_s(K, V)
|
||||
#define UNSETENV(K) _putenv_s(K, "")
|
||||
@@ -176,39 +177,35 @@ static int os_setenv(JanetArgs args) {
|
||||
#define SETENV(K,V) setenv(K, V, 1)
|
||||
#define UNSETENV(K) unsetenv(K)
|
||||
#endif
|
||||
const uint8_t *k;
|
||||
const char *ks;
|
||||
JANET_MAXARITY(args, 2);
|
||||
JANET_MINARITY(args, 1);
|
||||
JANET_ARG_STRING(k, args, 0);
|
||||
ks = (const char *) k;
|
||||
if (args.n == 1 || janet_checktype(args.v[1], JANET_NIL)) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *k = janet_getstring(argv, 0);
|
||||
const char *ks = (const char *) k;
|
||||
if (argc == 1 || janet_checktype(argv[1], JANET_NIL)) {
|
||||
UNSETENV(ks);
|
||||
} else {
|
||||
const uint8_t *v;
|
||||
JANET_ARG_STRING(v, args, 1);
|
||||
const char *vc = (const char *) v;
|
||||
SETENV(ks, vc);
|
||||
const uint8_t *v = janet_getstring(argv, 1);
|
||||
SETENV(ks, (const char *)v);
|
||||
}
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_exit(JanetArgs args) {
|
||||
JANET_MAXARITY(args, 1);
|
||||
if (args.n == 0) {
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 0) {
|
||||
exit(EXIT_SUCCESS);
|
||||
} else if (janet_checktype(args.v[0], JANET_INTEGER)) {
|
||||
exit(janet_unwrap_integer(args.v[0]));
|
||||
} else if (janet_checkint(argv[0])) {
|
||||
exit(janet_unwrap_integer(argv[0]));
|
||||
} else {
|
||||
exit(EXIT_FAILURE);
|
||||
}
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_time(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_time(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
double dtime = (double)(time(NULL));
|
||||
JANET_RETURN_REAL(args, dtime);
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
/* Clock shims */
|
||||
@@ -238,22 +235,19 @@ static int gettime(struct timespec *spec) {
|
||||
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
|
||||
#endif
|
||||
|
||||
static int os_clock(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_clock(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
struct timespec tv;
|
||||
if (gettime(&tv))
|
||||
JANET_THROW(args, "could not get time");
|
||||
if (gettime(&tv)) janet_panic("could not get time");
|
||||
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
|
||||
JANET_RETURN_REAL(args, dtime);
|
||||
return janet_wrap_number(dtime);
|
||||
}
|
||||
|
||||
static int os_sleep(JanetArgs args) {
|
||||
double delay;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_NUMBER(delay, args, 0);
|
||||
if (delay < 0) {
|
||||
JANET_THROW(args, "invalid argument to sleep");
|
||||
}
|
||||
static Janet os_sleep(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
double delay = janet_getnumber(argv, 0);
|
||||
if (delay < 0) janet_panic("invalid argument to sleep");
|
||||
#ifdef JANET_WINDOWS
|
||||
Sleep((DWORD) (delay * 1000));
|
||||
#else
|
||||
@@ -264,11 +258,12 @@ static int os_sleep(JanetArgs args) {
|
||||
: 0;
|
||||
nanosleep(&ts, NULL);
|
||||
#endif
|
||||
return 0;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int os_cwd(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
char buf[FILENAME_MAX];
|
||||
char *ptr;
|
||||
#ifdef JANET_WINDOWS
|
||||
@@ -276,68 +271,112 @@ static int os_cwd(JanetArgs args) {
|
||||
#else
|
||||
ptr = getcwd(buf, FILENAME_MAX);
|
||||
#endif
|
||||
if (NULL == ptr) {
|
||||
JANET_THROW(args, "could not get current directory");
|
||||
}
|
||||
JANET_RETURN_CSTRING(args, ptr);
|
||||
if (NULL == ptr) janet_panic("could not get current directory");
|
||||
return janet_cstringv(ptr);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"os/which", os_which,
|
||||
"(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"\t:windows - Microsoft Windows\n"
|
||||
"\t:macos - Apple macos\n"
|
||||
"\t:posix - A POSIX compatible system (default)"
|
||||
},
|
||||
{"os/execute", os_execute,
|
||||
"(os/execute program & args)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Returns "
|
||||
"the exit status of the program."
|
||||
},
|
||||
{"os/shell", os_shell,
|
||||
"(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell."
|
||||
},
|
||||
{"os/exit", os_exit,
|
||||
"(os/exit x)\n\n"
|
||||
"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."
|
||||
},
|
||||
{"os/getenv", os_getenv,
|
||||
"(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable."
|
||||
},
|
||||
{"os/setenv", os_setenv,
|
||||
"(os/setenv variable value)\n\n"
|
||||
"Set an environment variable."
|
||||
},
|
||||
{"os/time", os_time,
|
||||
"(os/time)\n\n"
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number."
|
||||
},
|
||||
{"os/clock", os_clock,
|
||||
"(os/clock)\n\n"
|
||||
"Return the number of seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreased in real time."
|
||||
},
|
||||
{"os/sleep", os_sleep,
|
||||
"(os/sleep nsec)\n\n"
|
||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||
"nil."
|
||||
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,
|
||||
JDOC("(os/which)\n\n"
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"\t:windows - Microsoft Windows\n"
|
||||
"\t:macos - Apple macos\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{"os/cwd", os_cwd,
|
||||
"(os/cwd)\n\n"
|
||||
"Returns the current working directory."
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute program & args)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Returns "
|
||||
"the exit status of the program.")
|
||||
},
|
||||
{
|
||||
"os/shell", os_shell,
|
||||
JDOC("(os/shell str)\n\n"
|
||||
"Pass a command string str directly to the system shell.")
|
||||
},
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit x)\n\n"
|
||||
"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.")
|
||||
},
|
||||
{
|
||||
"os/getenv", os_getenv,
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/setenv", os_setenv,
|
||||
JDOC("(os/setenv variable value)\n\n"
|
||||
"Set an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/time", os_time,
|
||||
JDOC("(os/time)\n\n"
|
||||
"Get the current time expressed as the number of seconds since "
|
||||
"January 1, 1970, the Unix epoch. Returns a real number.")
|
||||
},
|
||||
{
|
||||
"os/clock", os_clock,
|
||||
JDOC("(os/clock)\n\n"
|
||||
"Return the number of seconds since some fixed point in time. The clock "
|
||||
"is guaranteed to be non decreasing in real time.")
|
||||
},
|
||||
{
|
||||
"os/sleep", os_sleep,
|
||||
JDOC("(os/sleep nsec)\n\n"
|
||||
"Suspend the program for nsec seconds. 'nsec' can be a real number. Returns "
|
||||
"nil.")
|
||||
},
|
||||
{
|
||||
"os/cwd", os_cwd,
|
||||
JDOC("(os/cwd)\n\n"
|
||||
"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}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
int janet_lib_os(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_os(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, os_cfuns);
|
||||
}
|
||||
|
||||
503
src/core/parse.c
503
src/core/parse.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,10 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Check if a character is whitespace */
|
||||
static int is_whitespace(uint8_t c) {
|
||||
@@ -49,7 +52,7 @@ static int is_symbol_char(uint8_t c) {
|
||||
}
|
||||
|
||||
/* Validate some utf8. Useful for identifiers. Only validates
|
||||
* the encoding, does not check for valid codepoints (they
|
||||
* the encoding, does not check for valid code points (they
|
||||
* are less well defined than the encoding). */
|
||||
static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||
int32_t i = 0;
|
||||
@@ -74,7 +77,7 @@ static int valid_utf8(const uint8_t *str, int32_t len) {
|
||||
if ((str[j] >> 6) != 2) return 0;
|
||||
}
|
||||
|
||||
/* Check for overlong encodings */
|
||||
/* Check for overlong encoding */
|
||||
if ((nexti == i + 2) && str[i] < 0xC2) return 0;
|
||||
if ((str[i] == 0xE0) && str[i + 1] < 0xA0) return 0;
|
||||
if ((str[i] == 0xF0) && str[i + 1] < 0x90) return 0;
|
||||
@@ -139,6 +142,7 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
||||
#define PFLAG_STRING 0x2000
|
||||
#define PFLAG_LONGSTRING 0x4000
|
||||
#define PFLAG_READERMAC 0x8000
|
||||
#define PFLAG_ATSYM 0x10000
|
||||
|
||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||
JanetParseState s;
|
||||
@@ -161,12 +165,14 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset;
|
||||
}
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, val);
|
||||
return;
|
||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
int c = newtop->flags & 0xFF;
|
||||
const char *which =
|
||||
const char *which =
|
||||
(c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
@@ -279,7 +285,8 @@ static int check_str_const(const char *cstr, const uint8_t *str, int32_t len) {
|
||||
}
|
||||
|
||||
static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
Janet numcheck, ret;
|
||||
Janet ret;
|
||||
double numval;
|
||||
int32_t blen;
|
||||
if (is_symbol_char(c)) {
|
||||
push_buf(p, (uint8_t) c);
|
||||
@@ -288,9 +295,12 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
/* Token finished */
|
||||
blen = (int32_t) p->bufcount;
|
||||
numcheck = janet_scan_number(p->buf, blen);
|
||||
if (!janet_checktype(numcheck, JANET_NIL)) {
|
||||
ret = numcheck;
|
||||
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] == ':') {
|
||||
ret = janet_keywordv(p->buf + 1, blen - 1);
|
||||
} else if (start_num && !janet_scan_number(p->buf, blen, &numval)) {
|
||||
ret = janet_wrap_number(numval);
|
||||
} else if (!check_str_const("nil", p->buf, blen)) {
|
||||
ret = janet_wrap_nil();
|
||||
} else if (!check_str_const("false", p->buf, blen)) {
|
||||
@@ -298,11 +308,11 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
} else if (!check_str_const("true", p->buf, blen)) {
|
||||
ret = janet_wrap_true();
|
||||
} 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";
|
||||
return 0;
|
||||
} else {
|
||||
/* Don't do full utf8 check unless we have seen non ascii characters. */
|
||||
/* Don't do full utf-8 check unless we have seen non ascii characters. */
|
||||
int valid = (!state->argn) || valid_utf8(p->buf, blen);
|
||||
if (!valid) {
|
||||
p->error = "invalid utf-8 in symbol";
|
||||
@@ -325,78 +335,40 @@ static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Forward declaration */
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int dotuple(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (state->flags & PFLAG_SQRBRACKETS
|
||||
? c == ']'
|
||||
: c == ')') {
|
||||
int32_t i;
|
||||
Janet *ret = janet_tuple_begin(state->argn);
|
||||
for (i = state->argn - 1; i >= 0; i--) {
|
||||
ret[i] = p->args[--p->argcount];
|
||||
}
|
||||
popstate(p, janet_wrap_tuple(janet_tuple_end(ret)));
|
||||
return 1;
|
||||
}
|
||||
return root(p, state, c);
|
||||
static Janet close_tuple(JanetParser *p, JanetParseState *state, int32_t flag) {
|
||||
Janet *ret = janet_tuple_begin(state->argn);
|
||||
janet_tuple_flag(ret) = flag;
|
||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||
ret[i] = p->args[--p->argcount];
|
||||
return janet_wrap_tuple(janet_tuple_end(ret));
|
||||
}
|
||||
|
||||
static int doarray(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (state->flags & PFLAG_SQRBRACKETS
|
||||
? c == ']'
|
||||
: c == ')') {
|
||||
int32_t i;
|
||||
JanetArray *array = janet_array(state->argn);
|
||||
for (i = state->argn - 1; i >= 0; i--) {
|
||||
array->data[i] = p->args[--p->argcount];
|
||||
}
|
||||
array->count = state->argn;
|
||||
popstate(p, janet_wrap_array(array));
|
||||
return 1;
|
||||
}
|
||||
return root(p, state, c);
|
||||
static Janet close_array(JanetParser *p, JanetParseState *state) {
|
||||
JanetArray *array = janet_array(state->argn);
|
||||
for (int32_t i = state->argn - 1; i >= 0; i--)
|
||||
array->data[i] = p->args[--p->argcount];
|
||||
array->count = state->argn;
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static int dostruct(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (c == '}') {
|
||||
int32_t i;
|
||||
JanetKV *st;
|
||||
if (state->argn & 1) {
|
||||
p->error = "struct literal expects even number of arguments";
|
||||
return 1;
|
||||
}
|
||||
st = janet_struct_begin(state->argn >> 1);
|
||||
for (i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
popstate(p, janet_wrap_struct(janet_struct_end(st)));
|
||||
return 1;
|
||||
static Janet close_struct(JanetParser *p, JanetParseState *state) {
|
||||
JanetKV *st = janet_struct_begin(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_struct_put(st, key, value);
|
||||
}
|
||||
return root(p, state, c);
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
static int dotable(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
if (c == '}') {
|
||||
int32_t i;
|
||||
JanetTable *table;
|
||||
if (state->argn & 1) {
|
||||
p->error = "table literal expects even number of arguments";
|
||||
return 1;
|
||||
}
|
||||
table = janet_table(state->argn >> 1);
|
||||
for (i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
popstate(p, janet_wrap_table(table));
|
||||
return 1;
|
||||
static Janet close_table(JanetParser *p, JanetParseState *state) {
|
||||
JanetTable *table = janet_table(state->argn >> 1);
|
||||
for (int32_t i = state->argn; i > 0; i -= 2) {
|
||||
Janet value = p->args[--p->argcount];
|
||||
Janet key = p->args[--p->argcount];
|
||||
janet_table_put(table, key, value);
|
||||
}
|
||||
return root(p, state, c);
|
||||
return janet_wrap_table(table);
|
||||
}
|
||||
|
||||
#define PFLAG_INSTRING 0x100000
|
||||
@@ -443,12 +415,14 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
}
|
||||
}
|
||||
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
p->statecount--;
|
||||
switch (c) {
|
||||
case '{':
|
||||
pushstate(p, dotable, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
case '"':
|
||||
pushstate(p, stringchar, PFLAG_BUFFER | PFLAG_STRING);
|
||||
@@ -457,10 +431,10 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
pushstate(p, longstring, PFLAG_BUFFER | PFLAG_LONGSTRING);
|
||||
return 1;
|
||||
case '[':
|
||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
case '(':
|
||||
pushstate(p, doarray, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS | PFLAG_ATSYM);
|
||||
return 1;
|
||||
default:
|
||||
break;
|
||||
@@ -472,7 +446,6 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
/* The root state of the parser */
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
switch (c) {
|
||||
default:
|
||||
if (is_whitespace(c)) return 1;
|
||||
@@ -503,16 +476,44 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
case ')':
|
||||
case ']':
|
||||
case '}':
|
||||
p->error = "mismatched delimiter";
|
||||
{
|
||||
Janet ds;
|
||||
if (p->statecount == 1) {
|
||||
p->error = "unexpected delimiter";
|
||||
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 '(':
|
||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_PARENS);
|
||||
return 1;
|
||||
case '[':
|
||||
pushstate(p, dotuple, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_SQRBRACKETS);
|
||||
return 1;
|
||||
case '{':
|
||||
pushstate(p, dostruct, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
pushstate(p, root, PFLAG_CONTAINER | PFLAG_CURLYBRACKETS);
|
||||
return 1;
|
||||
}
|
||||
}
|
||||
@@ -532,7 +533,6 @@ int janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||
enum JanetParserStatus janet_parser_status(JanetParser *parser) {
|
||||
if (parser->error) return JANET_PARSE_ERROR;
|
||||
if (parser->statecount > 1) return JANET_PARSE_PENDING;
|
||||
if (parser->argcount) return JANET_PARSE_FULL;
|
||||
return JANET_PARSE_ROOT;
|
||||
}
|
||||
|
||||
@@ -540,6 +540,7 @@ void janet_parser_flush(JanetParser *parser) {
|
||||
parser->argcount = 0;
|
||||
parser->statecount = 1;
|
||||
parser->bufcount = 0;
|
||||
parser->pending = 0;
|
||||
}
|
||||
|
||||
const char *janet_parser_error(JanetParser *parser) {
|
||||
@@ -556,12 +557,12 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
Janet janet_parser_produce(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
enum JanetParserStatus status = janet_parser_status(parser);
|
||||
if (status != JANET_PARSE_FULL) return janet_wrap_nil();
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
ret = parser->args[0];
|
||||
for (i = 1; i < parser->argcount; i++) {
|
||||
parser->args[i - 1] = parser->args[i];
|
||||
}
|
||||
parser->pending--;
|
||||
parser->argcount--;
|
||||
return ret;
|
||||
}
|
||||
@@ -579,6 +580,7 @@ void janet_parser_init(JanetParser *parser) {
|
||||
parser->error = NULL;
|
||||
parser->lookback = -1;
|
||||
parser->offset = 0;
|
||||
parser->pending = 0;
|
||||
|
||||
pushstate(parser, root, PFLAG_CONTAINER);
|
||||
}
|
||||
@@ -608,143 +610,148 @@ static int parsergc(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static Janet parserget(void *p, Janet key);
|
||||
|
||||
static JanetAbstractType janet_parse_parsertype = {
|
||||
":core/parser",
|
||||
"core/parser",
|
||||
parsergc,
|
||||
parsermark
|
||||
parsermark,
|
||||
parserget,
|
||||
NULL
|
||||
};
|
||||
|
||||
JanetParser *janet_check_parser(Janet x) {
|
||||
if (!janet_checktype(x, JANET_ABSTRACT))
|
||||
return NULL;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &janet_parse_parsertype)
|
||||
return NULL;
|
||||
return (JanetParser *)abstract;
|
||||
}
|
||||
|
||||
/* C Function parser */
|
||||
static int cfun_parser(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 0);
|
||||
static Janet cfun_parse_parser(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
JanetParser *p = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_init(p);
|
||||
JANET_RETURN_ABSTRACT(args, p);
|
||||
return janet_wrap_abstract(p);
|
||||
}
|
||||
|
||||
static int cfun_consume(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
JanetParser *p;
|
||||
int32_t i;
|
||||
JANET_MINARITY(args, 2);
|
||||
JANET_MAXARITY(args, 3);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_ARG_BYTES(bytes, len, args, 1);
|
||||
if (args.n == 3) {
|
||||
int32_t offset;
|
||||
JANET_ARG_INTEGER(offset, args, 2);
|
||||
if (offset < 0 || offset > len)
|
||||
JANET_THROW(args, "invalid offset");
|
||||
len -= offset;
|
||||
bytes += offset;
|
||||
static Janet cfun_parse_consume(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetByteView view = janet_getbytes(argv, 1);
|
||||
if (argc == 3) {
|
||||
int32_t offset = janet_getinteger(argv, 2);
|
||||
if (offset < 0 || offset > view.len)
|
||||
janet_panicf("invalid offset %d out of range [0,%d]", offset, view.len);
|
||||
view.len -= offset;
|
||||
view.bytes += offset;
|
||||
}
|
||||
for (i = 0; i < len; i++) {
|
||||
janet_parser_consume(p, bytes[i]);
|
||||
int32_t i;
|
||||
for (i = 0; i < view.len; i++) {
|
||||
janet_parser_consume(p, view.bytes[i]);
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_ROOT:
|
||||
case JANET_PARSE_PENDING:
|
||||
break;
|
||||
default:
|
||||
JANET_RETURN_INTEGER(args, i + 1);
|
||||
return janet_wrap_integer(i + 1);
|
||||
}
|
||||
}
|
||||
JANET_RETURN_INTEGER(args, i);
|
||||
return janet_wrap_integer(i);
|
||||
}
|
||||
|
||||
static int cfun_byte(JanetArgs args) {
|
||||
int32_t i;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_ARG_INTEGER(i, args, 1);
|
||||
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);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_wrap_boolean(janet_parser_has_more(p));
|
||||
}
|
||||
|
||||
static Janet cfun_parse_byte(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
int32_t i = janet_getinteger(argv, 1);
|
||||
janet_parser_consume(p, 0xFF & i);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_status(JanetArgs args) {
|
||||
static Janet cfun_parse_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
const char *stat = NULL;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
switch (janet_parser_status(p)) {
|
||||
case JANET_PARSE_FULL:
|
||||
stat = ":full";
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
stat = ":pending";
|
||||
stat = "pending";
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
stat = ":error";
|
||||
stat = "error";
|
||||
break;
|
||||
case JANET_PARSE_ROOT:
|
||||
stat = ":root";
|
||||
stat = "root";
|
||||
break;
|
||||
}
|
||||
JANET_RETURN_CSYMBOL(args, stat);
|
||||
return janet_ckeywordv(stat);
|
||||
}
|
||||
|
||||
static int cfun_error(JanetArgs args) {
|
||||
const char *err;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
err = janet_parser_error(p);
|
||||
if (err) {
|
||||
JANET_RETURN_CSYMBOL(args, err);
|
||||
} else {
|
||||
JANET_RETURN_NIL(args);
|
||||
}
|
||||
static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
const char *err = janet_parser_error(p);
|
||||
if (err) return janet_cstringv(err);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_produce(JanetArgs args) {
|
||||
Janet val;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
val = janet_parser_produce(p);
|
||||
JANET_RETURN(args, val);
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
|
||||
static int cfun_flush(JanetArgs args) {
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
janet_parser_flush(p);
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_where(JanetArgs args) {
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
JANET_RETURN_INTEGER(args, p->offset);
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
return janet_wrap_integer(p->offset);
|
||||
}
|
||||
|
||||
static int cfun_state(JanetArgs args) {
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
JanetParser *p;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_CHECKABSTRACT(args, 0, &janet_parse_parsertype);
|
||||
p = (JanetParser *) janet_unwrap_abstract(args.v[0]);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
@@ -765,70 +772,110 @@ static int cfun_state(JanetArgs args) {
|
||||
}
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
JANET_RETURN_STRING(args, str);
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"parser/new", cfun_parser,
|
||||
"(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values. "
|
||||
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},
|
||||
{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_parse_parser,
|
||||
JDOC("(parser/new)\n\n"
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values. ")
|
||||
},
|
||||
{"parser/produce", cfun_produce,
|
||||
"(parser/produce parser)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value."
|
||||
{
|
||||
"parser/has-more", cfun_parse_has_more,
|
||||
JDOC("(parser/has-more parser)\n\n"
|
||||
"Check if the parser has more values in the value queue.")
|
||||
},
|
||||
{"parser/consume", cfun_consume,
|
||||
"(parser/consume parser bytes [, index])\n\n"
|
||||
"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 "
|
||||
"the number of bytes read."
|
||||
{
|
||||
"parser/produce", cfun_parse_produce,
|
||||
JDOC("(parser/produce parser)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value.")
|
||||
},
|
||||
{"parser/byte", cfun_byte,
|
||||
"(parser/byte parser b)\n\n"
|
||||
"Input a single byte into the parser byte stream. Returns the parser."
|
||||
{
|
||||
"parser/consume", cfun_parse_consume,
|
||||
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||
"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 "
|
||||
"the number of bytes read.")
|
||||
},
|
||||
{"parser/error", cfun_error,
|
||||
"(parser/error parser)\n\n"
|
||||
"If the parser is in the error state, returns the message asscoiated with "
|
||||
"that error. Otherwise, returns nil."
|
||||
{
|
||||
"parser/byte", cfun_parse_byte,
|
||||
JDOC("(parser/byte parser b)\n\n"
|
||||
"Input a single byte into the parser byte stream. Returns the parser.")
|
||||
},
|
||||
{"parser/status", cfun_status,
|
||||
"(parser/status parser)\n\n"
|
||||
"Gets the current status of the parser state machine. The status will "
|
||||
"be one of:\n\n"
|
||||
"\t:full - there are values in the parse queue to be consumed.\n"
|
||||
"\t:pending - no values in the queue but a value is being parsed.\n"
|
||||
"\t:error - a parsing error was encountered.\n"
|
||||
"\t:root - the parser can either read more values or safely terminate."
|
||||
{
|
||||
"parser/error", cfun_parse_error,
|
||||
JDOC("(parser/error parser)\n\n"
|
||||
"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 "
|
||||
"queue, so be sure to handle everything in the queue before calling "
|
||||
"parser/error.")
|
||||
},
|
||||
{"parser/flush", cfun_flush,
|
||||
"(parser/flush parser)\n\n"
|
||||
"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 "
|
||||
"to begin parsing in a new context, create a new parser."
|
||||
{
|
||||
"parser/status", cfun_parse_status,
|
||||
JDOC("(parser/status parser)\n\n"
|
||||
"Gets the current status of the parser state machine. The status will "
|
||||
"be one of:\n\n"
|
||||
"\t:pending - a value is being parsed.\n"
|
||||
"\t:error - a parsing error was encountered.\n"
|
||||
"\t:root - the parser can either read more values or safely terminate.")
|
||||
},
|
||||
{"parser/state", cfun_state,
|
||||
"(parser/state parser)\n\n"
|
||||
"Returns a string representation of the internal state of the parser. "
|
||||
"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 "
|
||||
"string inside of square brackets inside parens. Can be used to augment a repl prompt."
|
||||
{
|
||||
"parser/flush", cfun_parse_flush,
|
||||
JDOC("(parser/flush parser)\n\n"
|
||||
"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 "
|
||||
"to begin parsing in a new context, create a new parser.")
|
||||
},
|
||||
{"parser/where", cfun_where,
|
||||
"(parser/where parser)\n\n"
|
||||
"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 "
|
||||
"1, (the first byte is line1, column 1) and a newline is considered ascii 0x0A."
|
||||
{
|
||||
"parser/state", cfun_parse_state,
|
||||
JDOC("(parser/state parser)\n\n"
|
||||
"Returns a string representation of the internal state of the parser. "
|
||||
"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 "
|
||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
||||
},
|
||||
{
|
||||
"parser/where", cfun_parse_where,
|
||||
JDOC("(parser/where parser)\n\n"
|
||||
"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 "
|
||||
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||
},
|
||||
{
|
||||
"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}
|
||||
};
|
||||
|
||||
/* Load the library */
|
||||
int janet_lib_parse(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_parse(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, parse_cfuns);
|
||||
}
|
||||
|
||||
1107
src/core/peg.c
Normal file
1107
src/core/peg.c
Normal file
File diff suppressed because it is too large
Load Diff
697
src/core/pp.c
Normal file
697
src/core/pp.c
Normal file
@@ -0,0 +1,697 @@
|
||||
/*
|
||||
* 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/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 '\\':
|
||||
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_TRUE:
|
||||
janet_buffer_push_cstring(buffer, "true");
|
||||
return;
|
||||
case JANET_FALSE:
|
||||
janet_buffer_push_cstring(buffer, "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_TRUE:
|
||||
case JANET_FALSE:
|
||||
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);
|
||||
size_t l = janet_string_length(s);
|
||||
if (form[2] == '\0')
|
||||
janet_buffer_push_bytes(b, s, l);
|
||||
else {
|
||||
if (l != 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);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,8 +20,10 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "regalloc.h"
|
||||
#endif
|
||||
|
||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||
ra->chunks = NULL;
|
||||
@@ -57,7 +59,7 @@ static int32_t count_trailing_ones(uint32_t x) {
|
||||
/* Get N bits */
|
||||
#define nbits(N) (ithbit(N) - 1)
|
||||
|
||||
/* Copy a regsiter allocator */
|
||||
/* Copy a register allocator */
|
||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src) {
|
||||
size_t size;
|
||||
dest->count = src->count;
|
||||
@@ -153,78 +155,3 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
||||
if (reg < 0xF0)
|
||||
janetc_regalloc_free(ra, reg);
|
||||
}
|
||||
|
||||
/* Disable multi-slot allocation for now. */
|
||||
|
||||
/*
|
||||
static int32_t checkrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
while (ra->count <= chunk) pushchunk(ra);
|
||||
uint32_t mask = 0xFFFFFFFF;
|
||||
if (chunk == startchunk)
|
||||
mask &= ~nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask &= nbits(end & 0x1F);
|
||||
uint32_t block = ra->chunks[chunk];
|
||||
uint32_t masking = mask & block;
|
||||
if (masking) {
|
||||
int32_t nextbit = (block == 0xFFFFFFFF)
|
||||
? 32
|
||||
: count_trailing_zeros(masking) + 1;
|
||||
return chunk * 32 + nextbit;
|
||||
}
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
static void markrange(JanetcRegisterAllocator *ra, int32_t start, int32_t end) {
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
uint32_t mask = 0xFFFFFFFF;
|
||||
if (chunk == startchunk)
|
||||
mask &= ~nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask &= nbits(end & 0x1F);
|
||||
ra->chunks[chunk] |= mask;
|
||||
}
|
||||
}
|
||||
|
||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t start, int32_t n) {
|
||||
int32_t end = start + n - 1;
|
||||
int32_t startchunk = start / 32;
|
||||
int32_t endchunk = end / 32;
|
||||
for (int32_t chunk = startchunk; chunk <= endchunk; chunk++) {
|
||||
uint32_t mask = 0;
|
||||
if (chunk == startchunk)
|
||||
mask |= nbits(start & 0x1F);
|
||||
if (chunk == endchunk)
|
||||
mask |= ~nbits(end & 0x1F);
|
||||
ra->chunks[chunk] &= mask;
|
||||
}
|
||||
}
|
||||
|
||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n) {
|
||||
int32_t start = 0, end = 0, next = 0;
|
||||
while (next >= 0) {
|
||||
start = next;
|
||||
end = start + n - 1;
|
||||
next = checkrange(ra, start, end);
|
||||
}
|
||||
markrange(ra, start, end);
|
||||
if (end > ra->max)
|
||||
ra->max = end;
|
||||
return start;
|
||||
}
|
||||
|
||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs) {
|
||||
if (checkrange(ra, callee, callee + nargs) < 0) {
|
||||
markrange(ra, callee + 1, callee + nargs);
|
||||
return callee;
|
||||
}
|
||||
return janetc_regalloc_n(ra, nargs + 1);
|
||||
}
|
||||
|
||||
*/
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -44,7 +44,7 @@ typedef struct {
|
||||
int32_t count; /* number of chunks in chunks */
|
||||
int32_t capacity; /* amount allocated for chunks */
|
||||
int32_t max; /* The maximum allocated register so far */
|
||||
int32_t regtemps; /* Hold which tempregistered are alloced. */
|
||||
int32_t regtemps; /* Hold which temp. registers are allocated. */
|
||||
} JanetcRegisterAllocator;
|
||||
|
||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra);
|
||||
@@ -57,11 +57,4 @@ void janetc_regalloc_freetemp(JanetcRegisterAllocator *ra, int32_t reg, JanetcRe
|
||||
void janetc_regalloc_clone(JanetcRegisterAllocator *dest, JanetcRegisterAllocator *src);
|
||||
void janetc_regalloc_touch(JanetcRegisterAllocator *ra, int32_t reg);
|
||||
|
||||
/* Mutli-slot allocation disabled */
|
||||
/*
|
||||
int32_t janetc_regalloc_n(JanetcRegisterAllocator *ra, int32_t n);
|
||||
int32_t janetc_regalloc_call(JanetcRegisterAllocator *ra, int32_t callee, int32_t nargs);
|
||||
void janetc_regalloc_freerange(JanetcRegisterAllocator *ra, int32_t regstart, int32_t n);
|
||||
*/
|
||||
|
||||
#endif
|
||||
|
||||
108
src/core/run.c
108
src/core/run.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,64 +20,10 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "state.h"
|
||||
#include "vector.h"
|
||||
|
||||
/* 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);
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Run a string */
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||
@@ -89,38 +35,43 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
Janet ret = janet_wrap_nil();
|
||||
const uint8_t *where = sourcePath ? janet_cstring(sourcePath) : NULL;
|
||||
if (where) janet_gcroot(janet_wrap_string(where));
|
||||
if (NULL == sourcePath) sourcePath = "<unknown>";
|
||||
janet_parser_init(&parser);
|
||||
|
||||
while (!errflags && !done) {
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_FULL:
|
||||
{
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64);
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, "runtime", ret);
|
||||
errflags |= 0x01;
|
||||
}
|
||||
} else {
|
||||
janet_stacktrace(cres.macrofiber, "compile",
|
||||
janet_wrap_string(cres.error));
|
||||
errflags |= 0x02;
|
||||
}
|
||||
|
||||
/* Evaluate parsed values */
|
||||
while (janet_parser_has_more(&parser)) {
|
||||
Janet form = janet_parser_produce(&parser);
|
||||
JanetCompileResult cres = janet_compile(form, env, where);
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
errflags |= 0x01;
|
||||
}
|
||||
break;
|
||||
} else {
|
||||
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
errflags |= 0x02;
|
||||
}
|
||||
}
|
||||
|
||||
/* Dispatch based on parse state */
|
||||
switch (janet_parser_status(&parser)) {
|
||||
case JANET_PARSE_ERROR:
|
||||
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));
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
if (index >= len) {
|
||||
if (dudeol) {
|
||||
errflags |= 0x04;
|
||||
fprintf(stderr, "internal parse error: unexpected end of source\n");
|
||||
fprintf(stderr, "internal parse error in %s: unexpected end of source\n",
|
||||
sourcePath);
|
||||
} else {
|
||||
dudeol = 1;
|
||||
janet_parser_consume(&parser, '\n');
|
||||
@@ -137,6 +88,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
}
|
||||
break;
|
||||
}
|
||||
|
||||
}
|
||||
janet_parser_deinit(&parser);
|
||||
if (where) janet_gcunroot(janet_wrap_string(where));
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,11 +20,13 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "compile.h"
|
||||
#include "util.h"
|
||||
#include "vector.h"
|
||||
#include "emit.h"
|
||||
#endif
|
||||
|
||||
static JanetSlot janetc_quote(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
if (argn != 1) {
|
||||
@@ -94,7 +96,7 @@ static JanetSlot quasiquote(JanetFopts opts, Janet x) {
|
||||
janet_v_push(slots, key);
|
||||
janet_v_push(slots, value);
|
||||
}
|
||||
return qq_slots(opts, slots,
|
||||
return qq_slots(opts, slots,
|
||||
janet_checktype(x, JANET_TABLE) ? JOP_MAKE_TABLE : JOP_MAKE_STRUCT);
|
||||
}
|
||||
}
|
||||
@@ -116,7 +118,7 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
|
||||
}
|
||||
|
||||
/* Preform destructuring. Be careful to
|
||||
* keep the order registers are freed.
|
||||
* keep the order registers are freed.
|
||||
* Returns if the slot 'right' can be freed. */
|
||||
static int destructure(JanetCompiler *c,
|
||||
Janet left,
|
||||
@@ -182,19 +184,46 @@ static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||
}
|
||||
|
||||
static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
/*JanetFopts subopts = janetc_fopts_default(opts.compiler);*/
|
||||
/*JanetSlot ret, dest;*/
|
||||
Janet head;
|
||||
if (argn != 2) {
|
||||
janetc_cerror(opts.compiler, "expected 2 arguments");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
head = argv[0];
|
||||
if (!janet_checktype(head, JANET_SYMBOL)) {
|
||||
janetc_cerror(opts.compiler, "expected symbol");
|
||||
JanetFopts subopts = janetc_fopts_default(opts.compiler);
|
||||
if (janet_checktype(argv[0], JANET_SYMBOL)) {
|
||||
/* Normal var - (set a 1) */
|
||||
const uint8_t *sym = janet_unwrap_symbol(argv[0]);
|
||||
JanetSlot dest = janetc_resolve(opts.compiler, sym);
|
||||
if (!(dest.flags & JANET_SLOT_MUTABLE)) {
|
||||
janetc_cerror(opts.compiler, "cannot set constant");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
subopts.flags = JANET_FOPTS_HINT;
|
||||
subopts.hint = dest;
|
||||
JanetSlot ret = janetc_value(subopts, argv[1]);
|
||||
janetc_copy(opts.compiler, dest, ret);
|
||||
return ret;
|
||||
} else if (janet_checktype(argv[0], JANET_TUPLE)) {
|
||||
/* Set a field (setf behavior) - (set (tab :key) 2) */
|
||||
const Janet *tup = janet_unwrap_tuple(argv[0]);
|
||||
/* Tuple must have 2 elements */
|
||||
if (janet_tuple_length(tup) != 2) {
|
||||
janetc_cerror(opts.compiler, "expected 2 element tuple for l-value to set");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
JanetSlot ds = janetc_value(subopts, tup[0]);
|
||||
JanetSlot key = janetc_value(subopts, tup[1]);
|
||||
/* Can't be tail position because we will emit a PUT instruction afterwards */
|
||||
/* Also can't drop either */
|
||||
opts.flags &= ~(JANET_FOPTS_TAIL | JANET_FOPTS_DROP);
|
||||
JanetSlot rvalue = janetc_value(opts, argv[1]);
|
||||
/* Emit the PUT instruction */
|
||||
janetc_emit_sss(opts.compiler, JOP_PUT, ds, key, rvalue, 0);
|
||||
return rvalue;
|
||||
} else {
|
||||
/* Error */
|
||||
janetc_cerror(opts.compiler, "expected symbol or tuple for l-value to set");
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
return janetc_sym_lvalue(opts, janet_unwrap_symbol(head), argv[1]);
|
||||
}
|
||||
|
||||
/* Add attributes to a global def or var table */
|
||||
@@ -207,11 +236,11 @@ static JanetTable *handleattr(JanetCompiler *c, int32_t argn, const Janet *argv)
|
||||
default:
|
||||
janetc_cerror(c, "could not add metadata to binding");
|
||||
break;
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
janet_table_put(tab, attr, janet_wrap_true());
|
||||
break;
|
||||
case JANET_STRING:
|
||||
janet_table_put(tab, janet_csymbolv(":doc"), attr);
|
||||
janet_table_put(tab, janet_ckeywordv("doc"), attr);
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -260,8 +289,8 @@ static int varleaf(
|
||||
reftab->proto = attr;
|
||||
JanetArray *ref = janet_array(1);
|
||||
janet_array_push(ref, janet_wrap_nil());
|
||||
janet_table_put(reftab, janet_csymbolv(":ref"), janet_wrap_array(ref));
|
||||
janet_table_put(reftab, janet_csymbolv(":source-map"),
|
||||
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
||||
refslot = janetc_cslot(janet_wrap_array(ref));
|
||||
@@ -289,10 +318,10 @@ static int defleaf(
|
||||
JanetTable *attr) {
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
JanetTable *tab = janet_table(2);
|
||||
janet_table_put(tab, janet_csymbolv(":source-map"),
|
||||
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
tab->proto = attr;
|
||||
JanetSlot valsym = janetc_cslot(janet_csymbolv(":value"));
|
||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||
|
||||
/* Add env entry to env */
|
||||
@@ -369,8 +398,9 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
falsebody = truebody;
|
||||
truebody = temp;
|
||||
}
|
||||
janetc_scope(&tempscope, c, 0, "if-body");
|
||||
target = janetc_value(bodyopts, truebody);
|
||||
janetc_scope(&tempscope, c, 0, "if-true");
|
||||
right = janetc_value(bodyopts, truebody);
|
||||
if (!drop && !tail) janetc_copy(c, target, right);
|
||||
janetc_popscope(c);
|
||||
janetc_throwaway(bodyopts, falsebody);
|
||||
janetc_popscope(c);
|
||||
@@ -510,7 +540,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Recompile in the function scope */
|
||||
cond = janetc_value(subopts, argv[0]);
|
||||
if (!(cond.flags & JANET_SLOT_CONSTANT)) {
|
||||
/* If not an infinte loop, return nil when condition false */
|
||||
/* If not an infinite loop, return nil when condition false */
|
||||
janetc_emit_si(c, JOP_JUMP_IF, cond, 2, 0);
|
||||
janetc_emit(c, JOP_RETURN_NIL);
|
||||
}
|
||||
@@ -535,7 +565,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
|
||||
/* Compile jump to whiletop */
|
||||
/* Compile jump to :whiletop */
|
||||
labeljt = janet_v_count(c->buffer);
|
||||
janetc_emit(c, JOP_JUMP);
|
||||
|
||||
@@ -596,7 +626,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
Janet param = params[i];
|
||||
if (janet_checktype(param, JANET_SYMBOL)) {
|
||||
/* Check for varargs and unfixed arity */
|
||||
if ((!seenamp) &&
|
||||
if ((!seenamp) &&
|
||||
(0 == janet_cstrcmp(janet_unwrap_symbol(param), "&"))) {
|
||||
seenamp = 1;
|
||||
fixarity = 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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -27,10 +27,10 @@
|
||||
|
||||
/* The VM state. Rather than a struct that is passed
|
||||
* around, the vm state is global for simplicity. If
|
||||
* at some point a a global state object, or context,
|
||||
* is required to be passed around, this is waht would
|
||||
* be in it. However, thread local globals for interpreter
|
||||
* state should allow easy multithreading. */
|
||||
* at some point a global state object, or context,
|
||||
* is required to be passed around, this is what would
|
||||
* be in it. However, thread local global variables for interpreter
|
||||
* state should allow easy multi-threading. */
|
||||
|
||||
/* How many VM stacks have been entered */
|
||||
extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
@@ -39,7 +39,12 @@ extern JANET_THREAD_LOCAL int janet_vm_stackn;
|
||||
* Set and unset by janet_run. */
|
||||
extern JANET_THREAD_LOCAL JanetFiber *janet_vm_fiber;
|
||||
|
||||
/* The global registry for c functions. Used to store metadata
|
||||
/* 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
|
||||
* along with otherwise bare c function pointers. */
|
||||
extern JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
|
||||
|
||||
|
||||
1232
src/core/string.c
1232
src/core/string.c
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -21,26 +21,21 @@
|
||||
*/
|
||||
|
||||
/* Use a custom double parser instead of libc's strtod for better portability
|
||||
* and control. Also, uses a less strict rounding method than ieee to not incur
|
||||
* the cost of 4000 loc and dependence on arbitary precision arithmetic. There
|
||||
* is no plan to use arbitrary precision arithmetic for parsing numbers, and a
|
||||
* formal rounding mode has yet to be chosen (round towards 0 seems
|
||||
* reasonable).
|
||||
* and control.
|
||||
*
|
||||
* This version has been modified for much greater flexibility in parsing, such
|
||||
* as choosing the radix, supporting integer output, and returning Janets
|
||||
* directly.
|
||||
* 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
|
||||
* the integer part, F is the fractional part, and X is the exponent. All
|
||||
* signs, radix, decimal point, fractional part, and exponent can be ommited.
|
||||
* signs, radix, decimal point, fractional part, and exponent can be omitted.
|
||||
* The number will be considered and integer if the there is no decimal point
|
||||
* 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
|
||||
* because E is a vaid digit in bases 15 or greater. For bases greater than 10,
|
||||
* the letters are used as digitis. A through Z correspond to the digits 10
|
||||
* because E is a valid digit in bases 15 or greater. For bases greater than 10,
|
||||
* the letters are used as digits. A through Z correspond to the digits 10
|
||||
* through 35, and the lowercase letters have the same values. The radix number
|
||||
* is always in base 10. For example, a hexidecimal number could be written
|
||||
* '16rdeadbeef'. janet_scan_number also supports some c style syntax for
|
||||
@@ -49,8 +44,12 @@
|
||||
* 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 <string.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/* 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. */
|
||||
@@ -65,98 +64,194 @@ static uint8_t digit_lookup[128] = {
|
||||
25,26,27,28,29,30,31,32,33,34,35,0xff,0xff,0xff,0xff,0xff
|
||||
};
|
||||
|
||||
#define BIGNAT_NBIT 31
|
||||
#define BIGNAT_BASE 0x80000000U
|
||||
|
||||
/* Allow for large mantissa. BigNat is a natural number. */
|
||||
struct BigNat {
|
||||
uint32_t first_digit; /* First digit so we don't need to allocate when not needed. */
|
||||
int32_t n; /* n digits */
|
||||
int32_t cap; /* allocated digit capacity */
|
||||
uint32_t *digits; /* Each digit is base (2 ^ 31). Digits are least significant first. */
|
||||
};
|
||||
|
||||
static void bignat_zero(struct BigNat *x) {
|
||||
x->first_digit = 0;
|
||||
x->n = 0;
|
||||
x->cap = 0;
|
||||
x->digits = NULL;
|
||||
}
|
||||
|
||||
/* Allocate n more digits for mant. Return a pointer to these digits. */
|
||||
static uint32_t *bignat_extra(struct BigNat *mant, int32_t n) {
|
||||
int32_t oldn = mant->n;
|
||||
int32_t newn = oldn + n;
|
||||
if (mant->cap < newn) {
|
||||
int32_t newcap = 2 * newn;
|
||||
uint32_t *mem = realloc(mant->digits, newcap * sizeof(uint32_t));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
mant->cap = newcap;
|
||||
mant->digits = mem;
|
||||
}
|
||||
mant->n = newn;
|
||||
return mant->digits + oldn;
|
||||
}
|
||||
|
||||
/* Append a digit */
|
||||
static void bignat_append(struct BigNat *mant, uint32_t dig) {
|
||||
bignat_extra(mant, 1)[0] = dig;
|
||||
}
|
||||
|
||||
/* Multiply the mantissa mant by a factor and the add a term
|
||||
* in one operation. factor will be between 2 and 36^4,
|
||||
* term will be between 0 and 36. */
|
||||
static void bignat_muladd(struct BigNat *mant, uint32_t factor, uint32_t term) {
|
||||
int32_t i;
|
||||
uint64_t carry = ((uint64_t) mant->first_digit) * factor + term;
|
||||
mant->first_digit = carry % BIGNAT_BASE;
|
||||
carry /= BIGNAT_BASE;
|
||||
for (i = 0; i < mant->n; i++) {
|
||||
carry += ((uint64_t) mant->digits[i]) * factor;
|
||||
mant->digits[i] = carry % BIGNAT_BASE;
|
||||
carry /= BIGNAT_BASE;
|
||||
}
|
||||
if (carry) bignat_append(mant, (uint32_t) carry);
|
||||
}
|
||||
|
||||
/* Divide the mantissa mant by a factor. Drop the remainder. */
|
||||
static void bignat_div(struct BigNat *mant, uint32_t divisor) {
|
||||
int32_t i;
|
||||
uint32_t quotient, remainder;
|
||||
uint64_t dividend;
|
||||
remainder = 0, quotient = 0;
|
||||
for (i = mant->n - 1; i >= 0; i--) {
|
||||
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->digits[i];
|
||||
if (i < mant->n - 1) mant->digits[i + 1] = quotient;
|
||||
quotient = (uint32_t)(dividend / divisor);
|
||||
remainder = (uint32_t)(dividend % divisor);
|
||||
mant->digits[i] = remainder;
|
||||
}
|
||||
dividend = ((uint64_t)remainder * BIGNAT_BASE) + mant->first_digit;
|
||||
if (mant->n && mant->digits[mant->n - 1] == 0) mant->n--;
|
||||
mant->first_digit = (uint32_t)(dividend / divisor);
|
||||
}
|
||||
|
||||
/* Shift left by a multiple of BIGNAT_NBIT */
|
||||
static void bignat_lshift_n(struct BigNat *mant, int n) {
|
||||
if (!n) return;
|
||||
int32_t oldn = mant->n;
|
||||
bignat_extra(mant, n);
|
||||
memmove(mant->digits + n, mant->digits, sizeof(uint32_t) * oldn);
|
||||
memset(mant->digits, 0, sizeof(uint32_t) * (n - 1));
|
||||
mant->digits[n - 1] = mant->first_digit;
|
||||
mant->first_digit = 0;
|
||||
}
|
||||
|
||||
#ifdef __GNUC__
|
||||
#define clz(x) __builtin_clz(x)
|
||||
#else
|
||||
static int clz(uint32_t x) {
|
||||
int n = 0;
|
||||
if (x <= 0x0000ffff) n += 16, x <<= 16;
|
||||
if (x <= 0x00ffffff) n += 8, x <<= 8;
|
||||
if (x <= 0x0fffffff) n += 4, x <<= 4;
|
||||
if (x <= 0x3fffffff) n += 2, x <<= 2;
|
||||
if (x <= 0x7fffffff) n ++;
|
||||
return n;
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Extract double value from mantissa */
|
||||
static double bignat_extract(struct BigNat *mant, int32_t exponent2) {
|
||||
uint64_t top53;
|
||||
int32_t n = mant->n;
|
||||
/* Get most significant 53 bits from mant. Bit 52 (0 indexed) should
|
||||
* always be 1. This is essentially a large right shift on mant.*/
|
||||
if (n) {
|
||||
/* Two or more digits */
|
||||
uint64_t d1 = mant->digits[n - 1]; /* MSD (non-zero) */
|
||||
uint64_t d2 = (n == 1) ? mant->first_digit : mant->digits[n - 2];
|
||||
uint64_t d3 = (n > 2) ? mant->digits[n - 3] : (n == 2) ? mant->first_digit : 0;
|
||||
int lz = clz((uint32_t) d1);
|
||||
int nbits = 32 - lz;
|
||||
/* First get 54 bits */
|
||||
top53 = (d2 << (54 - BIGNAT_NBIT)) + (d3 >> (2 * BIGNAT_NBIT - 54));
|
||||
top53 >>= nbits;
|
||||
top53 |= (d1 << (54 - nbits));
|
||||
/* Rounding based on lowest bit of 54 */
|
||||
if (top53 & 1) top53++;
|
||||
top53 >>= 1;
|
||||
if (top53 > 0x1FffffFFFFffffUL) {
|
||||
top53 >>= 1;
|
||||
exponent2++;
|
||||
}
|
||||
/* Correct exponent - to correct for large right shift to mantissa. */
|
||||
exponent2 += (nbits - 53) + BIGNAT_NBIT * n;
|
||||
} else {
|
||||
/* One digit */
|
||||
top53 = mant->first_digit;
|
||||
}
|
||||
return ldexp((double)top53, exponent2);
|
||||
}
|
||||
|
||||
/* Read in a mantissa and exponent of a certain base, and give
|
||||
* back the double value. Should properly handle 0s, Inifinties, and
|
||||
* back the double value. Should properly handle 0s, Infinities, and
|
||||
* denormalized numbers. (When the exponent values are too large) */
|
||||
static double convert(
|
||||
int negative,
|
||||
uint64_t mantissa,
|
||||
struct BigNat *mant,
|
||||
int32_t base,
|
||||
int32_t exponent) {
|
||||
|
||||
int32_t exponent2 = 0;
|
||||
|
||||
/* Short circuit zero and huge numbers */
|
||||
if (mantissa == 0)
|
||||
return 0.0;
|
||||
if (exponent > 1022)
|
||||
if (mant->n == 0 && mant->first_digit == 0)
|
||||
return negative ? -0.0 : 0.0;
|
||||
if (exponent > 1023)
|
||||
return negative ? -INFINITY : INFINITY;
|
||||
|
||||
/* TODO add fast paths */
|
||||
/* Final value is X = mant * base ^ exponent * 2 ^ exponent2
|
||||
* Get exponent to zero while holding X constant. */
|
||||
|
||||
/* Convert exponent on the base into exponent2, the power of
|
||||
* 2 the will be used. Modify the mantissa as we convert. */
|
||||
if (exponent > 0) {
|
||||
/* Make the mantissa large enough so no precision is lost */
|
||||
while (mantissa <= 0x03ffffffffffffffULL && exponent > 0) {
|
||||
mantissa *= base;
|
||||
exponent--;
|
||||
}
|
||||
while (exponent > 0) {
|
||||
/* Allow 6 bits of room when multiplying. This is because
|
||||
* the largest base is 36, which is 6 bits. The space of 6 should
|
||||
* prevent overflow.*/
|
||||
mantissa >>= 1;
|
||||
exponent2++;
|
||||
if (mantissa <= 0x03ffffffffffffffULL) {
|
||||
mantissa *= base;
|
||||
exponent--;
|
||||
}
|
||||
}
|
||||
} else {
|
||||
while (exponent < 0) {
|
||||
mantissa <<= 1;
|
||||
exponent2--;
|
||||
/* Ensure that the last bit is set for minimum error
|
||||
* before dividing by the base */
|
||||
if (mantissa > 0x7fffffffffffffffULL) {
|
||||
mantissa /= base;
|
||||
exponent++;
|
||||
}
|
||||
}
|
||||
/* Positive exponents are simple */
|
||||
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 > 0; exponent -= 1) bignat_muladd(mant, base, 0);
|
||||
|
||||
/* Negative exponents are tricky - we don't want to loose bits
|
||||
* from integer division, so we need to premultiply. */
|
||||
if (exponent < 0) {
|
||||
int32_t shamt = 5 - exponent / 4;
|
||||
bignat_lshift_n(mant, shamt);
|
||||
exponent2 -= shamt * BIGNAT_NBIT;
|
||||
for (;exponent < -3; exponent += 4) bignat_div(mant, base * base * base * base);
|
||||
for (;exponent < -1; exponent += 2) bignat_div(mant, base * base);
|
||||
for (;exponent < 0; exponent += 1) bignat_div(mant, base);
|
||||
}
|
||||
|
||||
return negative
|
||||
? -ldexp((double) mantissa, exponent2)
|
||||
: ldexp((double) mantissa, exponent2);
|
||||
? -bignat_extract(mant, exponent2)
|
||||
: bignat_extract(mant, exponent2);
|
||||
}
|
||||
|
||||
/* Result of scanning a number source string. Will be further processed
|
||||
* depending on the desired resultant type. */
|
||||
struct JanetScanRes {
|
||||
uint64_t mant;
|
||||
int32_t ex;
|
||||
int error;
|
||||
int base;
|
||||
int seenpoint;
|
||||
int foundexp;
|
||||
int neg;
|
||||
};
|
||||
|
||||
/* Get the mantissa and exponent of decimal number. The
|
||||
* mantissa will be stored in a 64 bit unsigned integer (always positive).
|
||||
* The exponent will be in a signed 32 bit integer. Will also check if
|
||||
* the decimal point has been seen. Returns -1 if there is an invalid
|
||||
* number. */
|
||||
static struct JanetScanRes janet_scan_impl(
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len) {
|
||||
|
||||
struct JanetScanRes res;
|
||||
int32_t len,
|
||||
double *out) {
|
||||
const uint8_t *end = str + len;
|
||||
|
||||
/* Initialize flags */
|
||||
int seenadigit = 0;
|
||||
int gotradix = 0;
|
||||
|
||||
/* Initialize result */
|
||||
res.mant = 0;
|
||||
res.ex = 0;
|
||||
res.error = 0;
|
||||
res.base = 10;
|
||||
res.seenpoint = 0;
|
||||
res.foundexp = 0;
|
||||
res.neg = 0;
|
||||
int ex = 0;
|
||||
int base = 10;
|
||||
int seenpoint = 0;
|
||||
int foundexp = 0;
|
||||
int neg = 0;
|
||||
struct BigNat mant;
|
||||
bignat_zero(&mant);
|
||||
|
||||
/* Prevent some kinds of overflow bugs relating to the exponent
|
||||
* overflowing. For example, if a string was passed 2GB worth of 0s after
|
||||
@@ -168,18 +263,36 @@ static struct JanetScanRes janet_scan_impl(
|
||||
/* Get sign */
|
||||
if (str >= end) goto error;
|
||||
if (*str == '-') {
|
||||
res.neg = 1;
|
||||
neg = 1;
|
||||
str++;
|
||||
} else if (*str == '+') {
|
||||
str++;
|
||||
}
|
||||
|
||||
/* Check for leading 0x or digit digit r */
|
||||
if (str + 1 < end && str[0] == '0' && str[1] == 'x') {
|
||||
base = 16;
|
||||
str += 2;
|
||||
} else if (str + 1 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] == 'r') {
|
||||
base = str[0] - '0';
|
||||
str += 2;
|
||||
} else if (str + 2 < end &&
|
||||
str[0] >= '0' && str[0] <= '9' &&
|
||||
str[1] >= '0' && str[1] <= '9' &&
|
||||
str[2] == 'r') {
|
||||
base = 10 * (str[0] - '0') + (str[1] - '0');
|
||||
if (base < 2 || base > 36) goto error;
|
||||
str += 3;
|
||||
}
|
||||
|
||||
/* Skip leading zeros */
|
||||
while (str < end && (*str == '0' || *str == '.')) {
|
||||
if (res.seenpoint) res.ex--;
|
||||
if (seenpoint) ex--;
|
||||
if (*str == '.') {
|
||||
if (res.seenpoint) goto error;
|
||||
res.seenpoint = 1;
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
}
|
||||
seenadigit = 1;
|
||||
str++;
|
||||
@@ -188,37 +301,21 @@ static struct JanetScanRes janet_scan_impl(
|
||||
/* Parse significant digits */
|
||||
while (str < end) {
|
||||
if (*str == '.') {
|
||||
if (res.seenpoint) goto error;
|
||||
res.seenpoint = 1;
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
} else if (*str == '&') {
|
||||
res.foundexp = 1;
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (res.base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
res.foundexp = 1;
|
||||
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
|
||||
foundexp = 1;
|
||||
break;
|
||||
} else if (!gotradix && (*str == 'x' || *str == 'X')) {
|
||||
} else if (*str == '_') {
|
||||
if (!seenadigit) goto error;
|
||||
if (res.seenpoint || res.mant > 0) goto error;
|
||||
res.base = 16;
|
||||
res.mant = 0;
|
||||
seenadigit = 0;
|
||||
gotradix = 1;
|
||||
} else if (!gotradix && (*str == 'r' || *str == 'R')) {
|
||||
if (res.seenpoint) goto error;
|
||||
if (res.mant < 2 || res.mant > 36) goto error;
|
||||
res.base = (int) res.mant;
|
||||
res.mant = 0;
|
||||
seenadigit = 0;
|
||||
gotradix = 1;
|
||||
} else if (*str != '_') {
|
||||
/* underscores are ignored - can be used for separator */
|
||||
} else {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= res.base) goto error;
|
||||
if (res.seenpoint) res.ex--;
|
||||
if (res.mant > 0x00ffffffffffffff)
|
||||
res.ex++;
|
||||
else
|
||||
res.mant = res.base * res.mant + digit;
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
if (seenpoint) ex--;
|
||||
bignat_muladd(&mant, base, digit);
|
||||
seenadigit = 1;
|
||||
}
|
||||
str++;
|
||||
@@ -228,7 +325,7 @@ static struct JanetScanRes janet_scan_impl(
|
||||
goto error;
|
||||
|
||||
/* Read exponent */
|
||||
if (str < end && res.foundexp) {
|
||||
if (str < end && foundexp) {
|
||||
int eneg = 0;
|
||||
int ee = 0;
|
||||
seenadigit = 0;
|
||||
@@ -241,90 +338,28 @@ static struct JanetScanRes janet_scan_impl(
|
||||
str++;
|
||||
}
|
||||
/* Skip leading 0s in exponent */
|
||||
while (str < end && *str == '0') str++;
|
||||
while (str < end && ee < (INT32_MAX / 40)) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str == '_') {
|
||||
str++;
|
||||
continue;
|
||||
}
|
||||
if (*str > 127 || digit >= res.base) goto error;
|
||||
ee = res.base * ee + digit;
|
||||
while (str < end && *str == '0') {
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
if (eneg) res.ex -= ee; else res.ex += ee;
|
||||
while (str < end && ee < (INT32_MAX / 40)) {
|
||||
int digit = digit_lookup[*str & 0x7F];
|
||||
if (*str > 127 || digit >= base) goto error;
|
||||
ee = base * ee + digit;
|
||||
str++;
|
||||
seenadigit = 1;
|
||||
}
|
||||
if (eneg) ex -= ee; else ex += ee;
|
||||
}
|
||||
|
||||
if (!seenadigit)
|
||||
goto error;
|
||||
|
||||
return res;
|
||||
|
||||
error:
|
||||
res.error = 1;
|
||||
return res;
|
||||
}
|
||||
|
||||
/* Scan an integer from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
int32_t janet_scan_integer(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int *err) {
|
||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
||||
int64_t i64;
|
||||
if (res.error) goto error;
|
||||
if (res.seenpoint) goto error;
|
||||
if (res.ex < 0) goto error;
|
||||
i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
|
||||
while (res.ex > 0) {
|
||||
i64 *= res.base;
|
||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
||||
res.ex--;
|
||||
}
|
||||
if (i64 > INT32_MAX || i64 < INT32_MIN) goto error;
|
||||
if (NULL != err)
|
||||
*err = 0;
|
||||
return (int32_t) i64;
|
||||
error:
|
||||
if (NULL != err)
|
||||
*err = 1;
|
||||
*out = convert(neg, &mant, base, ex);
|
||||
free(mant.digits);
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Scan a real (double) from a string. If the string cannot be converted into
|
||||
* and integer, set *err to 1 and return 0. */
|
||||
double janet_scan_real(
|
||||
const uint8_t *str,
|
||||
int32_t len,
|
||||
int *err) {
|
||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
||||
if (res.error) {
|
||||
if (NULL != err)
|
||||
*err = 1;
|
||||
return 0.0;
|
||||
} else {
|
||||
if (NULL != err)
|
||||
*err = 0;
|
||||
}
|
||||
return convert(res.neg, res.mant, res.base, res.ex);
|
||||
}
|
||||
|
||||
/* Scans a number from a string. Can return either an integer or a real if
|
||||
* the number cannot be represented as an integer. Will return nil in case of
|
||||
* an error. */
|
||||
Janet janet_scan_number(
|
||||
const uint8_t *str,
|
||||
int32_t len) {
|
||||
struct JanetScanRes res = janet_scan_impl(str, len);
|
||||
if (res.error)
|
||||
return janet_wrap_nil();
|
||||
if (!res.foundexp && !res.seenpoint) {
|
||||
int64_t i64 = res.neg ? -(int64_t)res.mant : (int64_t)res.mant;
|
||||
if (i64 <= INT32_MAX && i64 >= INT32_MIN) {
|
||||
return janet_wrap_integer((int32_t) i64);
|
||||
}
|
||||
}
|
||||
return janet_wrap_real(convert(res.neg, res.mant, res.base, res.ex));
|
||||
error:
|
||||
free(mant.digits);
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,9 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
/* Begin creation of a struct */
|
||||
JanetKV *janet_struct_begin(int32_t count) {
|
||||
@@ -62,7 +65,7 @@ const JanetKV *janet_struct_find(const JanetKV *st, Janet key) {
|
||||
*
|
||||
* Runs will be in sorted order, as the collisions resolver essentially
|
||||
* preforms an in-place insertion sort. This ensures the internal structure of the
|
||||
* hash map is independant of insertion order.
|
||||
* hash map is independent of insertion order.
|
||||
*/
|
||||
void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
int32_t cap = janet_struct_capacity(st);
|
||||
@@ -71,6 +74,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
int32_t i, j, dist;
|
||||
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_NUMBER) && isnan(janet_unwrap_number(key))) return;
|
||||
/* Avoid extra items */
|
||||
if (janet_struct_hash(st) == janet_struct_length(st)) return;
|
||||
for (dist = 0, j = 0; j < 4; j += 2)
|
||||
@@ -89,9 +93,9 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
}
|
||||
/* 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 contsructed
|
||||
* 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}.
|
||||
* 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);
|
||||
@@ -118,9 +122,7 @@ void janet_struct_put(JanetKV *st, Janet key, Janet value) {
|
||||
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");
|
||||
/* A key was added to the struct more than once */
|
||||
return;
|
||||
}
|
||||
}
|
||||
@@ -132,15 +134,8 @@ const JanetKV *janet_struct_end(JanetKV *st) {
|
||||
/* Error building struct, probably duplicate values. We need to rebuild
|
||||
* the struct using only the values that went in. The second creation should always
|
||||
* succeed. */
|
||||
int32_t i, realCount;
|
||||
JanetKV *newst;
|
||||
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 *newst = janet_struct_begin(janet_struct_hash(st));
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
JanetKV *kv = st + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_struct_put(newst, kv->key, kv->value);
|
||||
@@ -158,17 +153,6 @@ Janet janet_struct_get(const JanetKV *st, Janet key) {
|
||||
return kv ? kv->value : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get the next key in a struct */
|
||||
const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv) {
|
||||
const JanetKV *end = st + janet_struct_capacity(st);
|
||||
kv = (kv == NULL) ? st : kv + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) return kv;
|
||||
kv++;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Convert struct to table */
|
||||
JanetTable *janet_struct_to_table(const JanetKV *st) {
|
||||
JanetTable *table = janet_table(janet_struct_capacity(st));
|
||||
@@ -229,5 +213,3 @@ int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs) {
|
||||
}
|
||||
return 0;
|
||||
}
|
||||
|
||||
#undef janet_maphash
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -25,10 +25,12 @@
|
||||
* 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. */
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Cache state */
|
||||
JANET_THREAD_LOCAL const uint8_t **janet_vm_cache = NULL;
|
||||
@@ -190,17 +192,6 @@ const uint8_t *janet_csymbol(const char *cstr) {
|
||||
return janet_symbol((const uint8_t *)cstr, len);
|
||||
}
|
||||
|
||||
/* Convert a string to a symbol */
|
||||
const uint8_t *janet_symbol_from_string(const uint8_t *str) {
|
||||
int success = 0;
|
||||
const uint8_t **bucket = janet_symcache_find(str, &success);
|
||||
if (success)
|
||||
return *bucket;
|
||||
janet_symcache_put((const uint8_t *)str, bucket);
|
||||
janet_gc_settype(janet_string_raw(str), JANET_MEMORY_SYMBOL);
|
||||
return str;
|
||||
}
|
||||
|
||||
/* Store counter for genysm to avoid quadratic behavior */
|
||||
JANET_THREAD_LOCAL uint8_t gensym_counter[8] = {'_', '0', '0', '0', '0', '0', '0', 0};
|
||||
|
||||
@@ -234,16 +225,16 @@ const uint8_t *janet_symbol_gen(void) {
|
||||
* is enough for resolving collisions. */
|
||||
do {
|
||||
hash = janet_string_calchash(
|
||||
gensym_counter,
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1);
|
||||
bucket = janet_symcache_findmem(
|
||||
gensym_counter,
|
||||
gensym_counter,
|
||||
sizeof(gensym_counter) - 1,
|
||||
hash,
|
||||
&status);
|
||||
} while (status && (inc_gensym(), 1));
|
||||
sym = (uint8_t *) janet_gcalloc(
|
||||
JANET_MEMORY_SYMBOL,
|
||||
JANET_MEMORY_SYMBOL,
|
||||
2 * sizeof(int32_t) + sizeof(gensym_counter)) +
|
||||
(2 * sizeof(int32_t));
|
||||
memcpy(sym, gensym_counter, sizeof(gensym_counter));
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_SYMCACHE_H_defined
|
||||
#define JANET_SYMCACHE_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/* Initialize the cache (allocate cache memory) */
|
||||
void janet_symcache_init(void);
|
||||
|
||||
135
src/core/table.c
135
src/core/table.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,9 +20,12 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
/* Initialize a table */
|
||||
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 */
|
||||
void janet_table_put(JanetTable *t, Janet key, Janet value) {
|
||||
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)) {
|
||||
janet_table_remove(t, key);
|
||||
} else {
|
||||
@@ -158,18 +162,6 @@ void janet_table_clear(JanetTable *t) {
|
||||
t->deleted = 0;
|
||||
}
|
||||
|
||||
/* Find next key in an object. Returns NULL if no next key. */
|
||||
const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv) {
|
||||
JanetKV *end = t->data + t->capacity;
|
||||
kv = (kv == NULL) ? t->data : kv + 1;
|
||||
while (kv < end) {
|
||||
if (!janet_checktype(kv->key, JANET_NIL))
|
||||
return kv;
|
||||
kv++;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Convert table to struct */
|
||||
const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||
JanetKV *st = janet_struct_begin(t->count);
|
||||
@@ -206,87 +198,80 @@ void janet_table_merge_struct(JanetTable *table, const JanetKV *other) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_new(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
int32_t cap;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_INTEGER(cap, args, 0);
|
||||
t = janet_table(cap);
|
||||
JANET_RETURN_TABLE(args, t);
|
||||
static Janet cfun_table_new(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t cap = janet_getinteger(argv, 0);
|
||||
return janet_wrap_table(janet_table(cap));
|
||||
}
|
||||
|
||||
static int cfun_getproto(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(t, args, 0);
|
||||
JANET_RETURN(args, t->proto
|
||||
? janet_wrap_table(t->proto)
|
||||
: janet_wrap_nil());
|
||||
static Janet cfun_table_getproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return t->proto
|
||||
? janet_wrap_table(t->proto)
|
||||
: janet_wrap_nil();
|
||||
}
|
||||
|
||||
static int cfun_setproto(JanetArgs args) {
|
||||
JanetTable *table, *proto;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_TABLE(table, args, 0);
|
||||
if (janet_checktype(args.v[1], JANET_NIL)) {
|
||||
proto = NULL;
|
||||
} else {
|
||||
JANET_ARG_TABLE(proto, args, 1);
|
||||
static Janet cfun_table_setproto(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
JanetTable *proto = NULL;
|
||||
if (!janet_checktype(argv[1], JANET_NIL)) {
|
||||
proto = janet_gettable(argv, 1);
|
||||
}
|
||||
table->proto = proto;
|
||||
JANET_RETURN_TABLE(args, table);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static int cfun_tostruct(JanetArgs args) {
|
||||
JanetTable *t;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_TABLE(t, args, 0);
|
||||
JANET_RETURN_STRUCT(args, janet_table_to_struct(t));
|
||||
static Janet cfun_table_tostruct(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetTable *t = janet_gettable(argv, 0);
|
||||
return janet_wrap_struct(janet_table_to_struct(t));
|
||||
}
|
||||
|
||||
static int cfun_rawget(JanetArgs args) {
|
||||
JanetTable *table;
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_TABLE(table, args, 0);
|
||||
JANET_RETURN(args, janet_table_rawget(table, args.v[1]));
|
||||
static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetTable *table = janet_gettable(argv, 0);
|
||||
return janet_table_rawget(table, argv[1]);
|
||||
}
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{"table/new", cfun_new,
|
||||
"(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table."
|
||||
static const JanetReg table_cfuns[] = {
|
||||
{
|
||||
"table/new", cfun_table_new,
|
||||
JDOC("(table/new capacity)\n\n"
|
||||
"Creates a new empty table with pre-allocated memory "
|
||||
"for capacity entries. This means that if one knows the number of "
|
||||
"entries going to go in a table on creation, extra memory allocation "
|
||||
"can be avoided. Returns the new table.")
|
||||
},
|
||||
{"table/to-struct", cfun_tostruct,
|
||||
"(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables."
|
||||
{
|
||||
"table/to-struct", cfun_table_tostruct,
|
||||
JDOC("(table/to-struct tab)\n\n"
|
||||
"Convert a table to a struct. Returns a new struct. This function "
|
||||
"does not take into account prototype tables.")
|
||||
},
|
||||
{"table/getproto", cfun_getproto,
|
||||
"(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype."
|
||||
{
|
||||
"table/getproto", cfun_table_getproto,
|
||||
JDOC("(table/getproto tab)\n\n"
|
||||
"Get the prototype table of a table. Returns nil if a table "
|
||||
"has no prototype, otherwise returns the prototype.")
|
||||
},
|
||||
{"table/setproto", cfun_setproto,
|
||||
"(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab."
|
||||
{
|
||||
"table/setproto", cfun_table_setproto,
|
||||
JDOC("(table/setproto tab proto)\n\n"
|
||||
"Set the prototype of a table. Returns the original table tab.")
|
||||
},
|
||||
{"table/rawget", cfun_rawget,
|
||||
"(table/rawget tab key)\n\n"
|
||||
"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 "
|
||||
"nil without checking the prototype. Returns the value in the table."
|
||||
{
|
||||
"table/rawget", cfun_table_rawget,
|
||||
JDOC("(table/rawget tab key)\n\n"
|
||||
"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 "
|
||||
"nil without checking the prototype. Returns the value in the table.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the table module */
|
||||
int janet_lib_table(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_table(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, table_cfuns);
|
||||
}
|
||||
|
||||
#undef janet_maphash
|
||||
|
||||
156
src/core/tuple.c
156
src/core/tuple.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,20 +20,23 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Create a new empty tuple of the given size. This will return memory
|
||||
* which should be filled with Janets. The memory will not be collected until
|
||||
* janet_tuple_end is called. */
|
||||
Janet *janet_tuple_begin(int32_t length) {
|
||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 4 * sizeof(int32_t) + length * sizeof(Janet));
|
||||
Janet *tuple = (Janet *)(data + (4 * sizeof(int32_t)));
|
||||
char *data = janet_gcalloc(JANET_MEMORY_TUPLE, 5 * sizeof(int32_t) + length * sizeof(Janet));
|
||||
Janet *tuple = (Janet *)(data + (5 * sizeof(int32_t)));
|
||||
janet_tuple_length(tuple) = length;
|
||||
janet_tuple_sm_start(tuple) = -1;
|
||||
janet_tuple_sm_end(tuple) = -1;
|
||||
janet_tuple_flag(tuple) = 0;
|
||||
return tuple;
|
||||
}
|
||||
|
||||
@@ -91,95 +94,88 @@ int janet_tuple_compare(const Janet *lhs, const Janet *rhs) {
|
||||
|
||||
/* C Functions */
|
||||
|
||||
static int cfun_slice(JanetArgs args) {
|
||||
const Janet *vals;
|
||||
int32_t len;
|
||||
Janet *ret;
|
||||
int32_t start, end;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &vals, &len)) JANET_THROW(args, "expected array/tuple");
|
||||
/* Get start */
|
||||
if (args.n < 2) {
|
||||
start = 0;
|
||||
} else if (janet_checktype(args.v[1], JANET_INTEGER)) {
|
||||
start = janet_unwrap_integer(args.v[1]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
/* Get end */
|
||||
if (args.n < 3) {
|
||||
end = -1;
|
||||
} else if (janet_checktype(args.v[2], JANET_INTEGER)) {
|
||||
end = janet_unwrap_integer(args.v[2]);
|
||||
} else {
|
||||
JANET_THROW(args, "expected integer");
|
||||
}
|
||||
if (start < 0) start = len + start;
|
||||
if (end < 0) end = len + end + 1;
|
||||
if (end < 0 || start < 0 || end > len || start > len)
|
||||
JANET_THROW(args, "slice range out of bounds");
|
||||
if (end >= start) {
|
||||
ret = janet_tuple_begin(end - start);
|
||||
memcpy(ret, vals + start, sizeof(Janet) * (end - start));
|
||||
} else {
|
||||
ret = janet_tuple_begin(0);
|
||||
}
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(ret));
|
||||
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 int cfun_prepend(JanetArgs args) {
|
||||
const Janet *t;
|
||||
int32_t len, i;
|
||||
Janet *n;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
||||
JANET_THROW(args, "expected tuple/array");
|
||||
n = janet_tuple_begin(len - 1 + args.n);
|
||||
memcpy(n - 1 + args.n, t, sizeof(Janet) * len);
|
||||
for (i = 1; i < args.n; i++) {
|
||||
n[args.n - i - 1] = args.v[i];
|
||||
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_prepend(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
Janet *n = janet_tuple_begin(view.len - 1 + argc);
|
||||
memcpy(n - 1 + argc, view.items, sizeof(Janet) * view.len);
|
||||
for (int32_t i = 1; i < argc; i++) {
|
||||
n[argc - i - 1] = argv[i];
|
||||
}
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
||||
return janet_wrap_tuple(janet_tuple_end(n));
|
||||
}
|
||||
|
||||
static int cfun_append(JanetArgs args) {
|
||||
const Janet *t;
|
||||
int32_t len;
|
||||
Janet *n;
|
||||
JANET_MINARITY(args, 1);
|
||||
if (!janet_indexed_view(args.v[0], &t, &len))
|
||||
JANET_THROW(args, "expected tuple/array");
|
||||
n = janet_tuple_begin(len - 1 + args.n);
|
||||
memcpy(n, t, sizeof(Janet) * len);
|
||||
memcpy(n + len, args.v + 1, sizeof(Janet) * (args.n - 1));
|
||||
JANET_RETURN_TUPLE(args, janet_tuple_end(n));
|
||||
static Janet cfun_tuple_append(int32_t argc, Janet *argv) {
|
||||
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/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"Returns the new tuple."
|
||||
static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) {
|
||||
return janet_ckeywordv("brackets");
|
||||
} else {
|
||||
return janet_ckeywordv("parens");
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/brackets", cfun_tuple_brackets,
|
||||
JDOC("(tuple/brackets & xs)\n\n"
|
||||
"Creates a new bracketed tuple containing the elements xs.")
|
||||
},
|
||||
{"tuple/append", cfun_append,
|
||||
"(tuple/append tup & items)\n\n"
|
||||
"Returns a new tuple that is the result of appending "
|
||||
"each element in items to tup."
|
||||
{
|
||||
"tuple/slice", cfun_tuple_slice,
|
||||
JDOC("(tuple/slice arrtup [,start=0 [,end=(length arrtup)]])\n\n"
|
||||
"Take a sub sequence of an array or tuple from index start "
|
||||
"inclusive to index end exclusive. If start or end are not provided, "
|
||||
"they default to 0 and the length of arrtup respectively."
|
||||
"Returns the new tuple.")
|
||||
},
|
||||
{"tuple/prepend", cfun_prepend,
|
||||
"(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."
|
||||
{
|
||||
"tuple/append", cfun_tuple_append,
|
||||
JDOC("(tuple/append tup & items)\n\n"
|
||||
"Returns a new tuple that is the result of appending "
|
||||
"each element in items to tup.")
|
||||
},
|
||||
{
|
||||
"tuple/prepend", cfun_tuple_prepend,
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"tuple/type", cfun_tuple_type,
|
||||
JDOC("(tuple/type tup)\n\n"
|
||||
"Checks how the tuple was constructed. Will return the keyword "
|
||||
":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 "
|
||||
"the compiler.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
/* Load the tuple module */
|
||||
int janet_lib_tuple(JanetArgs args) {
|
||||
JanetTable *env = janet_env(args);
|
||||
janet_cfuns(env, NULL, cfuns);
|
||||
return 0;
|
||||
void janet_lib_tuple(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, tuple_cfuns);
|
||||
}
|
||||
|
||||
256
src/core/util.c
256
src/core/util.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,10 +20,14 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#include <inttypes.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#include "gc.h"
|
||||
#endif
|
||||
|
||||
/* Base 64 lookup table for digits */
|
||||
const char janet_base64[65] =
|
||||
@@ -35,58 +39,58 @@ const char janet_base64[65] =
|
||||
/* The JANET value types in order. These types can be used as
|
||||
* mnemonics instead of a bit pattern for type checking */
|
||||
const char *const janet_type_names[16] = {
|
||||
":nil",
|
||||
":boolean",
|
||||
":boolean",
|
||||
":fiber",
|
||||
":integer",
|
||||
":real",
|
||||
":string",
|
||||
":symbol",
|
||||
":array",
|
||||
":tuple",
|
||||
":table",
|
||||
":struct",
|
||||
":buffer",
|
||||
":function",
|
||||
":cfunction",
|
||||
":abstract"
|
||||
"number",
|
||||
"nil",
|
||||
"boolean",
|
||||
"boolean",
|
||||
"fiber",
|
||||
"string",
|
||||
"symbol",
|
||||
"keyword",
|
||||
"array",
|
||||
"tuple",
|
||||
"table",
|
||||
"struct",
|
||||
"buffer",
|
||||
"function",
|
||||
"cfunction",
|
||||
"abstract"
|
||||
};
|
||||
|
||||
const char *const janet_signal_names[14] = {
|
||||
":ok",
|
||||
":error",
|
||||
":debug",
|
||||
":yield",
|
||||
":user0",
|
||||
":user1",
|
||||
":user2",
|
||||
":user3",
|
||||
":user4",
|
||||
":user5",
|
||||
":user6",
|
||||
":user7",
|
||||
":user8",
|
||||
":user9"
|
||||
"ok",
|
||||
"error",
|
||||
"debug",
|
||||
"yield",
|
||||
"user0",
|
||||
"user1",
|
||||
"user2",
|
||||
"user3",
|
||||
"user4",
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9"
|
||||
};
|
||||
|
||||
const char *const janet_status_names[16] = {
|
||||
":dead",
|
||||
":error",
|
||||
":debug",
|
||||
":pending",
|
||||
":user0",
|
||||
":user1",
|
||||
":user2",
|
||||
":user3",
|
||||
":user4",
|
||||
":user5",
|
||||
":user6",
|
||||
":user7",
|
||||
":user8",
|
||||
":user9",
|
||||
":new",
|
||||
":alive"
|
||||
"dead",
|
||||
"error",
|
||||
"debug",
|
||||
"pending",
|
||||
"user0",
|
||||
"user1",
|
||||
"user2",
|
||||
"user3",
|
||||
"user4",
|
||||
"user5",
|
||||
"user6",
|
||||
"user7",
|
||||
"user8",
|
||||
"user9",
|
||||
"new",
|
||||
"alive"
|
||||
};
|
||||
|
||||
/* Calculate hash for string */
|
||||
@@ -132,7 +136,7 @@ int32_t janet_tablen(int32_t n) {
|
||||
}
|
||||
|
||||
/* Helper to find a value in a Janet struct or table. Returns the bucket
|
||||
* containg the key, or the first empty bucket if there is no such key. */
|
||||
* containing the key, or the first empty bucket if there is no such key. */
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
int32_t index = janet_maphash(cap, janet_hash(key));
|
||||
int32_t i;
|
||||
@@ -187,7 +191,7 @@ const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const Jane
|
||||
return NULL;
|
||||
}
|
||||
|
||||
/* Compare a janet string with a cstring. more efficient than loading
|
||||
/* Compare a janet string with a cstring. More efficient than loading
|
||||
* c string as a janet string. */
|
||||
int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||
int32_t len = janet_string_length(str);
|
||||
@@ -204,7 +208,7 @@ int janet_cstrcmp(const uint8_t *str, const char *other) {
|
||||
|
||||
/* Do a binary search on a static array of structs. Each struct must
|
||||
* have a string as its first element, and the struct must be sorted
|
||||
* lexogrpahically by that element. */
|
||||
* lexicographically by that element. */
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
@@ -239,9 +243,9 @@ void janet_register(const char *name, JanetCFunction cfun) {
|
||||
/* Add a def to an environment */
|
||||
void janet_def(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_table_put(subt, janet_csymbolv(":value"), val);
|
||||
janet_table_put(subt, janet_ckeywordv("value"), val);
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
|
||||
@@ -250,9 +254,9 @@ void janet_var(JanetTable *env, const char *name, Janet val, const char *doc) {
|
||||
JanetArray *array = janet_array(1);
|
||||
JanetTable *subt = janet_table(2);
|
||||
janet_array_push(array, val);
|
||||
janet_table_put(subt, janet_csymbolv(":ref"), janet_wrap_array(array));
|
||||
janet_table_put(subt, janet_ckeywordv("ref"), janet_wrap_array(array));
|
||||
if (doc)
|
||||
janet_table_put(subt, janet_csymbolv(":doc"), janet_cstringv(doc));
|
||||
janet_table_put(subt, janet_ckeywordv("doc"), janet_cstringv(doc));
|
||||
janet_table_put(env, janet_csymbolv(name), janet_wrap_table(subt));
|
||||
}
|
||||
|
||||
@@ -269,7 +273,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
uint8_t *longname_buffer =
|
||||
janet_string_begin(reglen + 1 + nmlen);
|
||||
memcpy(longname_buffer, regprefix, reglen);
|
||||
longname_buffer[reglen] = '.';
|
||||
longname_buffer[reglen] = '/';
|
||||
memcpy(longname_buffer + reglen + 1, cfuns->name, nmlen);
|
||||
longname = janet_wrap_symbol(janet_string_end(longname_buffer));
|
||||
}
|
||||
@@ -280,6 +284,24 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
}
|
||||
}
|
||||
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p) {
|
||||
(void) p;
|
||||
janet_table_put(env, janet_csymbolv(name), x);
|
||||
}
|
||||
|
||||
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
Janet name = janet_csymbolv(cfuns->name);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_core_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_table_put(janet_vm_registry, fun, name);
|
||||
cfuns++;
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
/* Resolve a symbol in the environment */
|
||||
JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out) {
|
||||
Janet ref;
|
||||
@@ -289,32 +311,20 @@ JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out)
|
||||
return JANET_BINDING_NONE;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
if (!janet_checktype(
|
||||
janet_table_get(entry_table, janet_csymbolv(":macro")),
|
||||
janet_table_get(entry_table, janet_ckeywordv("macro")),
|
||||
JANET_NIL)) {
|
||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_MACRO;
|
||||
}
|
||||
ref = janet_table_get(entry_table, janet_csymbolv(":ref"));
|
||||
ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
if (janet_checktype(ref, JANET_ARRAY)) {
|
||||
*out = ref;
|
||||
return JANET_BINDING_VAR;
|
||||
}
|
||||
*out = janet_table_get(entry_table, janet_csymbolv(":value"));
|
||||
*out = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
return JANET_BINDING_DEF;
|
||||
}
|
||||
|
||||
/* Get module from the arguments passed to library */
|
||||
JanetTable *janet_env(JanetArgs args) {
|
||||
JanetTable *module;
|
||||
if (args.n >= 1 && janet_checktype(args.v[0], JANET_TABLE)) {
|
||||
module = janet_unwrap_table(args.v[0]);
|
||||
} else {
|
||||
module = janet_table(0);
|
||||
}
|
||||
*args.ret = janet_wrap_table(module);
|
||||
return module;
|
||||
}
|
||||
|
||||
/* Read both tuples and arrays as c pointers + int32_t length. Return 1 if the
|
||||
* view can be constructed, 0 if an invalid type. */
|
||||
int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
@@ -324,7 +334,7 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
return 1;
|
||||
} else if (janet_checktype(seq, JANET_TUPLE)) {
|
||||
*data = janet_unwrap_tuple(seq);
|
||||
*len = janet_tuple_length(janet_unwrap_struct(seq));
|
||||
*len = janet_tuple_length(janet_unwrap_tuple(seq));
|
||||
return 1;
|
||||
}
|
||||
return 0;
|
||||
@@ -333,7 +343,8 @@ int janet_indexed_view(Janet seq, const Janet **data, int32_t *len) {
|
||||
/* Read both strings and buffer as unsigned character array + int32_t len.
|
||||
* Returns 1 if the view can be constructed and 0 if the type is invalid. */
|
||||
int janet_bytes_view(Janet str, const uint8_t **data, int32_t *len) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL)) {
|
||||
if (janet_checktype(str, JANET_STRING) || janet_checktype(str, JANET_SYMBOL) ||
|
||||
janet_checktype(str, JANET_KEYWORD)) {
|
||||
*data = janet_unwrap_string(str);
|
||||
*len = janet_string_length(janet_unwrap_string(str));
|
||||
return 1;
|
||||
@@ -363,63 +374,56 @@ int janet_dictionary_view(Janet tab, const JanetKV **data, int32_t *len, int32_t
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Get actual type name of a value for debugging purposes */
|
||||
static const char *typestr(JanetArgs args, int32_t n) {
|
||||
JanetType actual = n < args.n ? janet_type(args.v[n]) : JANET_NIL;
|
||||
return ((actual == JANET_ABSTRACT)
|
||||
? janet_abstract_type(janet_unwrap_abstract(args.v[n]))->name
|
||||
: janet_type_names[actual]) + 1;
|
||||
int janet_checkint(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkintrange(dval);
|
||||
}
|
||||
|
||||
int janet_type_err(JanetArgs args, int32_t n, JanetType expected) {
|
||||
const uint8_t *message = janet_formatc(
|
||||
"bad slot #%d, expected %t, got %s",
|
||||
n,
|
||||
expected,
|
||||
typestr(args, n));
|
||||
JANET_THROWV(args, janet_wrap_string(message));
|
||||
int janet_checkint64(Janet x) {
|
||||
if (!janet_checktype(x, JANET_NUMBER))
|
||||
return 0;
|
||||
double dval = janet_unwrap_number(x);
|
||||
return janet_checkint64range(dval);
|
||||
}
|
||||
|
||||
void janet_buffer_push_types(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] + 1);
|
||||
}
|
||||
i++;
|
||||
types >>= 1;
|
||||
/* Useful for inspecting values while debugging */
|
||||
void janet_inspect(Janet x) {
|
||||
printf("<type=%s, ", janet_type_names[janet_type(x)]);
|
||||
|
||||
#ifdef JANET_BIG_ENDIAN
|
||||
printf("be ");
|
||||
#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;
|
||||
}
|
||||
}
|
||||
|
||||
int janet_typemany_err(JanetArgs args, int32_t n, int expected) {
|
||||
const uint8_t *message;
|
||||
JanetBuffer buf;
|
||||
janet_buffer_init(&buf, 20);
|
||||
janet_buffer_push_string(&buf, janet_formatc("bad slot #%d, expected ", n));
|
||||
janet_buffer_push_types(&buf, expected);
|
||||
janet_buffer_push_cstring(&buf, ", got ");
|
||||
janet_buffer_push_cstring(&buf, typestr(args, n));
|
||||
message = janet_string(buf.data, buf.count);
|
||||
janet_buffer_deinit(&buf);
|
||||
JANET_THROWV(args, janet_wrap_string(message));
|
||||
}
|
||||
|
||||
int janet_arity_err(JanetArgs args, int32_t n, const char *prefix) {
|
||||
JANET_THROWV(args,
|
||||
janet_wrap_string(janet_formatc(
|
||||
"expected %s%d argument%s, got %d",
|
||||
prefix, n, n == 1 ? "" : "s", args.n)));
|
||||
}
|
||||
|
||||
int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at) {
|
||||
JANET_THROWV(args,
|
||||
janet_wrap_string(janet_formatc(
|
||||
"bad slot #%d, expected %s, got %s",
|
||||
n, at->name, typestr(args, n))));
|
||||
printf(">\n");
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,17 @@
|
||||
#ifndef JANET_UTIL_H_defined
|
||||
#define JANET_UTIL_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
#define JANET_NO_BOOTSTRAP
|
||||
#else
|
||||
#define JDOC(x) x
|
||||
#endif
|
||||
|
||||
/* Utils */
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
@@ -35,28 +45,47 @@ int32_t janet_tablen(int32_t n);
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
size_t itemsize,
|
||||
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 */
|
||||
int janet_lib_io(JanetArgs args);
|
||||
int janet_lib_math(JanetArgs args);
|
||||
int janet_lib_array(JanetArgs args);
|
||||
int janet_lib_tuple(JanetArgs args);
|
||||
int janet_lib_buffer(JanetArgs args);
|
||||
int janet_lib_table(JanetArgs args);
|
||||
int janet_lib_fiber(JanetArgs args);
|
||||
int janet_lib_os(JanetArgs args);
|
||||
int janet_lib_string(JanetArgs args);
|
||||
int janet_lib_marsh(JanetArgs args);
|
||||
int janet_lib_parse(JanetArgs args);
|
||||
void janet_lib_io(JanetTable *env);
|
||||
void janet_lib_math(JanetTable *env);
|
||||
void janet_lib_array(JanetTable *env);
|
||||
void janet_lib_tuple(JanetTable *env);
|
||||
void janet_lib_buffer(JanetTable *env);
|
||||
void janet_lib_table(JanetTable *env);
|
||||
void janet_lib_fiber(JanetTable *env);
|
||||
void janet_lib_os(JanetTable *env);
|
||||
void janet_lib_string(JanetTable *env);
|
||||
void janet_lib_marsh(JanetTable *env);
|
||||
void janet_lib_parse(JanetTable *env);
|
||||
#ifdef JANET_ASSEMBLER
|
||||
int janet_lib_asm(JanetArgs args);
|
||||
void janet_lib_asm(JanetTable *env);
|
||||
#endif
|
||||
int janet_lib_compile(JanetArgs args);
|
||||
int janet_lib_debug(JanetArgs args);
|
||||
void janet_lib_compile(JanetTable *env);
|
||||
void janet_lib_debug(JanetTable *env);
|
||||
void janet_lib_peg(JanetTable *env);
|
||||
|
||||
#endif
|
||||
|
||||
304
src/core/value.c
304
src/core/value.c
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,9 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
* Define a number of functions that can be used internally on ANY Janet.
|
||||
@@ -38,11 +40,8 @@ int janet_equals(Janet x, Janet y) {
|
||||
case JANET_FALSE:
|
||||
result = 1;
|
||||
break;
|
||||
case JANET_REAL:
|
||||
result = (janet_unwrap_real(x) == janet_unwrap_real(y));
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
result = (janet_unwrap_integer(x) == janet_unwrap_integer(y));
|
||||
case JANET_NUMBER:
|
||||
result = (janet_unwrap_number(x) == janet_unwrap_number(y));
|
||||
break;
|
||||
case JANET_STRING:
|
||||
result = janet_string_equal(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
@@ -77,6 +76,7 @@ int32_t janet_hash(Janet x) {
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
hash = janet_string_hash(janet_unwrap_string(x));
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
@@ -85,9 +85,6 @@ int32_t janet_hash(Janet x) {
|
||||
case JANET_STRUCT:
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
break;
|
||||
case JANET_INTEGER:
|
||||
hash = janet_unwrap_integer(x);
|
||||
break;
|
||||
default:
|
||||
/* TODO - test performance with different hash functions */
|
||||
if (sizeof(double) == sizeof(void *)) {
|
||||
@@ -107,7 +104,7 @@ int32_t janet_hash(Janet x) {
|
||||
return hash;
|
||||
}
|
||||
|
||||
/* Compares x to y. If they are equal retuns 0. If x is less, returns -1.
|
||||
/* Compares x to y. If they are equal returns 0. If x is less, returns -1.
|
||||
* If y is less, returns 1. All types are comparable
|
||||
* and should have strict ordering. */
|
||||
int janet_compare(Janet x, Janet y) {
|
||||
@@ -117,28 +114,23 @@ int janet_compare(Janet x, Janet y) {
|
||||
case JANET_FALSE:
|
||||
case JANET_TRUE:
|
||||
return 0;
|
||||
case JANET_REAL:
|
||||
/* Check for nans to ensure total order */
|
||||
if (janet_unwrap_real(x) != janet_unwrap_real(x))
|
||||
return janet_unwrap_real(y) != janet_unwrap_real(y)
|
||||
case JANET_NUMBER:
|
||||
/* Check for NaNs to ensure total order */
|
||||
if (janet_unwrap_number(x) != janet_unwrap_number(x))
|
||||
return janet_unwrap_number(y) != janet_unwrap_number(y)
|
||||
? 0
|
||||
: -1;
|
||||
if (janet_unwrap_real(y) != janet_unwrap_real(y))
|
||||
if (janet_unwrap_number(y) != janet_unwrap_number(y))
|
||||
return 1;
|
||||
|
||||
if (janet_unwrap_real(x) == janet_unwrap_real(y)) {
|
||||
if (janet_unwrap_number(x) == janet_unwrap_number(y)) {
|
||||
return 0;
|
||||
} else {
|
||||
return janet_unwrap_real(x) > janet_unwrap_real(y) ? 1 : -1;
|
||||
}
|
||||
case JANET_INTEGER:
|
||||
if (janet_unwrap_integer(x) == janet_unwrap_integer(y)) {
|
||||
return 0;
|
||||
} else {
|
||||
return janet_unwrap_integer(x) > janet_unwrap_integer(y) ? 1 : -1;
|
||||
return janet_unwrap_number(x) > janet_unwrap_number(y) ? 1 : -1;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_compare(janet_unwrap_string(x), janet_unwrap_string(y));
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_compare(janet_unwrap_tuple(x), janet_unwrap_tuple(y));
|
||||
@@ -154,3 +146,269 @@ int janet_compare(Janet x, Janet y) {
|
||||
}
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
}
|
||||
|
||||
/* Gets a value and returns. Can panic. */
|
||||
Janet janet_get(Janet ds, Janet key) {
|
||||
Janet value;
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||
break;
|
||||
case JANET_TABLE:
|
||||
value = janet_table_get(janet_unwrap_table(ds), key);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= array->count) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = array->data[index];
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_TUPLE:
|
||||
{
|
||||
const Janet *tuple = janet_unwrap_tuple(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= janet_tuple_length(tuple)) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = tuple[index];
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= buffer->count) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_wrap_integer(buffer->data[index]);
|
||||
}
|
||||
break;
|
||||
}
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
{
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
int32_t index;
|
||||
if (!janet_checkint(key))
|
||||
janet_panic("expected integer key");
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index >= janet_string_length(str)) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_wrap_integer(str[index]);
|
||||
}
|
||||
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;
|
||||
}
|
||||
|
||||
Janet janet_getindex(Janet ds, int32_t index) {
|
||||
Janet value;
|
||||
if (index < 0) janet_panic("expected non-negative index");
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
if (index >= janet_string_length(janet_unwrap_string(ds))) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_wrap_integer(janet_unwrap_string(ds)[index]);
|
||||
}
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
if (index >= janet_unwrap_array(ds)->count) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_unwrap_array(ds)->data[index];
|
||||
}
|
||||
break;
|
||||
case JANET_BUFFER:
|
||||
if (index >= janet_unwrap_buffer(ds)->count) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_wrap_integer(janet_unwrap_buffer(ds)->data[index]);
|
||||
}
|
||||
break;
|
||||
case JANET_TUPLE:
|
||||
if (index >= janet_tuple_length(janet_unwrap_tuple(ds))) {
|
||||
value = janet_wrap_nil();
|
||||
} else {
|
||||
value = janet_unwrap_tuple(ds)[index];
|
||||
}
|
||||
break;
|
||||
case JANET_TABLE:
|
||||
value = janet_table_get(janet_unwrap_table(ds), janet_wrap_integer(index));
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
value = janet_struct_get(janet_unwrap_struct(ds), janet_wrap_integer(index));
|
||||
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;
|
||||
}
|
||||
|
||||
int32_t janet_length(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||
return 0;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_string_length(janet_unwrap_string(x));
|
||||
case JANET_ARRAY:
|
||||
return janet_unwrap_array(x)->count;
|
||||
case JANET_BUFFER:
|
||||
return janet_unwrap_buffer(x)->count;
|
||||
case JANET_TUPLE:
|
||||
return janet_tuple_length(janet_unwrap_tuple(x));
|
||||
case JANET_STRUCT:
|
||||
return janet_struct_length(janet_unwrap_struct(x));
|
||||
case JANET_TABLE:
|
||||
return janet_unwrap_table(x)->count;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
if (index >= array->count) {
|
||||
janet_array_ensure(array, index + 1, 2);
|
||||
array->count = index + 1;
|
||||
}
|
||||
array->data[index] = value;
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
janet_buffer_ensure(buffer, index + 1, 2);
|
||||
buffer->count = index + 1;
|
||||
}
|
||||
buffer->data[index] = janet_unwrap_integer(value);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE:
|
||||
{
|
||||
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;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void janet_put(Janet ds, Janet key, Janet value) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY:
|
||||
{
|
||||
int32_t index;
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||
if (index >= array->count) {
|
||||
janet_array_setcount(array, index + 1);
|
||||
}
|
||||
array->data[index] = value;
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
{
|
||||
int32_t index;
|
||||
JanetBuffer *buffer = janet_unwrap_buffer(ds);
|
||||
if (!janet_checkint(key)) janet_panicf("expected integer key, got %v", key);
|
||||
index = janet_unwrap_integer(key);
|
||||
if (index < 0 || index == INT32_MAX) janet_panicf("bad integer key, got %v", key);
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
janet_buffer_setcount(buffer, index + 1);
|
||||
}
|
||||
buffer->data[index] = (uint8_t) (janet_unwrap_integer(value) & 0xFF);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE:
|
||||
janet_table_put(janet_unwrap_table(ds), key, value);
|
||||
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;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,9 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "vector.h"
|
||||
#endif
|
||||
|
||||
/* Grow the buffer dynamically. Used for push operations. */
|
||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||
@@ -40,22 +42,6 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||
}
|
||||
}
|
||||
|
||||
/* 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 {
|
||||
{
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
return (void *) (2 * sizeof(int32_t));
|
||||
}
|
||||
}
|
||||
|
||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||
void *janet_v_flattenmem(void *v, int32_t itemsize) {
|
||||
int32_t *p;
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_VECTOR_H_defined
|
||||
#define JANET_VECTOR_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
/*
|
||||
* 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_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_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_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
||||
|
||||
1319
src/core/vm.c
1319
src/core/vm.c
File diff suppressed because it is too large
Load Diff
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -20,7 +20,32 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet/janet.h>
|
||||
#endif
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
kv->key = janet_wrap_nil();
|
||||
kv->value = janet_wrap_nil();
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_memempty(JanetKV *mem, int32_t count) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
mem[i].key = janet_wrap_nil();
|
||||
mem[i].value = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
|
||||
@@ -45,10 +70,7 @@ Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
|
||||
|
||||
Janet janet_nanbox_from_double(double d) {
|
||||
Janet ret;
|
||||
ret.real = d;
|
||||
/* Normalize NaNs */
|
||||
if (d != d)
|
||||
ret.u64 = janet_nanbox_tag(JANET_REAL);
|
||||
ret.number = d;
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -58,31 +80,11 @@ Janet janet_nanbox_from_bits(uint64_t bits) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
void *janet_nanbox_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
kv->key = janet_wrap_nil();
|
||||
kv->value = janet_wrap_nil();
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
void janet_nanbox_memempty(JanetKV *mem, int32_t count) {
|
||||
int32_t i;
|
||||
for (i = 0; i < count; i++) {
|
||||
mem[i].key = janet_wrap_nil();
|
||||
mem[i].value = janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
#elif defined(JANET_NANBOX_32)
|
||||
|
||||
Janet janet_wrap_real(double x) {
|
||||
Janet janet_wrap_number(double x) {
|
||||
Janet ret;
|
||||
ret.real = x;
|
||||
ret.number = x;
|
||||
ret.tagged.type += JANET_DOUBLE_OFFSET;
|
||||
return ret;
|
||||
}
|
||||
@@ -101,9 +103,9 @@ Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
double janet_unwrap_real(Janet x) {
|
||||
double janet_unwrap_number(Janet x) {
|
||||
x.tagged.type -= JANET_DOUBLE_OFFSET;
|
||||
return x.real;
|
||||
return x.number;
|
||||
}
|
||||
|
||||
#else
|
||||
@@ -151,10 +153,10 @@ Janet janet_wrap_##NAME(TYPE x) {\
|
||||
return y;\
|
||||
}
|
||||
|
||||
JANET_WRAP_DEFINE(real, double, JANET_REAL, real)
|
||||
JANET_WRAP_DEFINE(integer, int32_t, JANET_INTEGER, integer)
|
||||
JANET_WRAP_DEFINE(number, double, JANET_NUMBER, number)
|
||||
JANET_WRAP_DEFINE(string, const uint8_t *, JANET_STRING, cpointer)
|
||||
JANET_WRAP_DEFINE(symbol, const uint8_t *, JANET_SYMBOL, cpointer)
|
||||
JANET_WRAP_DEFINE(keyword, const uint8_t *, JANET_KEYWORD, cpointer)
|
||||
JANET_WRAP_DEFINE(array, JanetArray *, JANET_ARRAY, pointer)
|
||||
JANET_WRAP_DEFINE(tuple, const Janet *, JANET_TUPLE, cpointer)
|
||||
JANET_WRAP_DEFINE(struct, const JanetKV *, JANET_STRUCT, cpointer)
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -29,7 +29,7 @@ extern "C" {
|
||||
|
||||
/***** START SECTION CONFIG *****/
|
||||
|
||||
#define JANET_VERSION "0.2.0"
|
||||
#define JANET_VERSION "0.4.0"
|
||||
|
||||
#ifndef JANET_BUILD
|
||||
#define JANET_BUILD "local"
|
||||
@@ -113,7 +113,7 @@ extern "C" {
|
||||
#define JANET_THREAD_LOCAL
|
||||
#endif
|
||||
|
||||
/* Enable or disbale dynamic module loading. Enabled by default. */
|
||||
/* Enable or disable dynamic module loading. Enabled by default. */
|
||||
#ifndef JANET_NO_DYNAMIC_MODULES
|
||||
#define JANET_DYNAMIC_MODULES
|
||||
#endif
|
||||
@@ -154,9 +154,6 @@ extern "C" {
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#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
|
||||
* ands crashing (the parser). Instead, error out. */
|
||||
#define JANET_RECURSION_GUARD 1024
|
||||
@@ -201,6 +198,7 @@ extern "C" {
|
||||
#include <string.h>
|
||||
#include <stdlib.h>
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
extern const char *const janet_type_names[16];
|
||||
@@ -267,21 +265,25 @@ typedef struct JanetFuncEnv JanetFuncEnv;
|
||||
typedef struct JanetKV JanetKV;
|
||||
typedef struct JanetStackFrame JanetStackFrame;
|
||||
typedef struct JanetAbstractType JanetAbstractType;
|
||||
typedef struct JanetArgs JanetArgs;
|
||||
typedef struct JanetReg JanetReg;
|
||||
typedef struct JanetMethod JanetMethod;
|
||||
typedef struct JanetSourceMapping JanetSourceMapping;
|
||||
typedef int (*JanetCFunction)(JanetArgs args);
|
||||
typedef struct JanetView JanetView;
|
||||
typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef Janet (*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
typedef enum JanetType {
|
||||
JANET_NUMBER,
|
||||
JANET_NIL,
|
||||
JANET_FALSE,
|
||||
JANET_TRUE,
|
||||
JANET_FIBER,
|
||||
JANET_INTEGER,
|
||||
JANET_REAL,
|
||||
JANET_STRING,
|
||||
JANET_SYMBOL,
|
||||
JANET_KEYWORD,
|
||||
JANET_ARRAY,
|
||||
JANET_TUPLE,
|
||||
JANET_TABLE,
|
||||
@@ -299,10 +301,10 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_FALSE (1 << JANET_FALSE)
|
||||
#define JANET_TFLAG_TRUE (1 << JANET_TRUE)
|
||||
#define JANET_TFLAG_FIBER (1 << JANET_FIBER)
|
||||
#define JANET_TFLAG_INTEGER (1 << JANET_INTEGER)
|
||||
#define JANET_TFLAG_REAL (1 << JANET_REAL)
|
||||
#define JANET_TFLAG_NUMBER (1 << JANET_NUMBER)
|
||||
#define JANET_TFLAG_STRING (1 << JANET_STRING)
|
||||
#define JANET_TFLAG_SYMBOL (1 << JANET_SYMBOL)
|
||||
#define JANET_TFLAG_KEYWORD (1 << JANET_KEYWORD)
|
||||
#define JANET_TFLAG_ARRAY (1 << JANET_ARRAY)
|
||||
#define JANET_TFLAG_TUPLE (1 << JANET_TUPLE)
|
||||
#define JANET_TFLAG_TABLE (1 << JANET_TABLE)
|
||||
@@ -314,14 +316,13 @@ typedef enum JanetType {
|
||||
|
||||
/* Some abstractions */
|
||||
#define JANET_TFLAG_BOOLEAN (JANET_TFLAG_TRUE | JANET_TFLAG_FALSE)
|
||||
#define JANET_TFLAG_NUMBER (JANET_TFLAG_REAL | JANET_TFLAG_INTEGER)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER)
|
||||
#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_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
|
||||
/* We provide three possible implemenations of Janets. The preferred
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
* application must interact through exposed interface. */
|
||||
|
||||
@@ -349,7 +350,7 @@ typedef enum JanetType {
|
||||
union Janet {
|
||||
uint64_t u64;
|
||||
int64_t i64;
|
||||
double real;
|
||||
double number;
|
||||
void *pointer;
|
||||
};
|
||||
#define janet_u64(x) ((x).u64)
|
||||
@@ -359,33 +360,27 @@ union Janet {
|
||||
#define janet_nanbox_lowtag(type) ((uint64_t)(type) | 0x1FFF0)
|
||||
#define janet_nanbox_tag(type) (janet_nanbox_lowtag(type) << 47)
|
||||
#define janet_type(x) \
|
||||
(isnan((x).real) \
|
||||
(isnan((x).number) \
|
||||
? (((x).u64 >> 47) & 0xF) \
|
||||
: JANET_REAL)
|
||||
: JANET_NUMBER)
|
||||
|
||||
#define janet_nanbox_checkauxtype(x, type) \
|
||||
(((x).u64 & JANET_NANBOX_TAGBITS) == janet_nanbox_tag((type)))
|
||||
|
||||
#define janet_nanbox_isreal(x) \
|
||||
(!isnan((x).real) || janet_nanbox_checkauxtype((x), JANET_REAL))
|
||||
#define janet_nanbox_isnumber(x) \
|
||||
(!isnan((x).number) || janet_nanbox_checkauxtype((x), JANET_NUMBER))
|
||||
|
||||
#define janet_checktype(x, t) \
|
||||
(((t) == JANET_REAL) \
|
||||
? janet_nanbox_isreal(x) \
|
||||
(((t) == JANET_NUMBER) \
|
||||
? janet_nanbox_isnumber(x) \
|
||||
: janet_nanbox_checkauxtype((x), (t)))
|
||||
|
||||
JANET_API void *janet_nanbox_to_pointer(Janet x);
|
||||
JANET_API void janet_nanbox_memempty(JanetKV *mem, int32_t count);
|
||||
JANET_API void *janet_nanbox_memalloc_empty(int32_t count);
|
||||
JANET_API Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask);
|
||||
JANET_API Janet janet_nanbox_from_double(double d);
|
||||
JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
|
||||
#define janet_memempty(mem, len) janet_nanbox_memempty((mem), (len))
|
||||
#define janet_memalloc_empty(count) janet_nanbox_memalloc_empty(count)
|
||||
|
||||
/* Todo - check for single mask operation */
|
||||
#define janet_truthy(x) \
|
||||
(!(janet_checktype((x), JANET_NIL) || janet_checktype((x), JANET_FALSE)))
|
||||
|
||||
@@ -403,15 +398,12 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_wrap_true() janet_nanbox_from_payload(JANET_TRUE, 1)
|
||||
#define janet_wrap_false() janet_nanbox_from_payload(JANET_FALSE, 1)
|
||||
#define janet_wrap_boolean(b) janet_nanbox_from_payload((b) ? JANET_TRUE : JANET_FALSE, 1)
|
||||
#define janet_wrap_integer(i) janet_nanbox_from_payload(JANET_INTEGER, (uint32_t)(i))
|
||||
#define janet_wrap_real(r) janet_nanbox_from_double(r)
|
||||
#define janet_wrap_number(r) janet_nanbox_from_double(r)
|
||||
|
||||
/* Unwrap the simple types */
|
||||
#define janet_unwrap_boolean(x) \
|
||||
(janet_checktype(x, JANET_TRUE))
|
||||
#define janet_unwrap_integer(x) \
|
||||
((int32_t)((x).u64 & 0xFFFFFFFFlu))
|
||||
#define janet_unwrap_real(x) ((x).real)
|
||||
#define janet_unwrap_number(x) ((x).number)
|
||||
|
||||
/* Wrap the pointer types */
|
||||
#define janet_wrap_struct(s) janet_nanbox_wrap_c((s), JANET_STRUCT)
|
||||
@@ -422,6 +414,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_wrap_buffer(s) janet_nanbox_wrap_((s), JANET_BUFFER)
|
||||
#define janet_wrap_string(s) janet_nanbox_wrap_c((s), JANET_STRING)
|
||||
#define janet_wrap_symbol(s) janet_nanbox_wrap_c((s), JANET_SYMBOL)
|
||||
#define janet_wrap_keyword(s) janet_nanbox_wrap_c((s), JANET_KEYWORD)
|
||||
#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_cfunction(s) janet_nanbox_wrap_((s), JANET_CFUNCTION)
|
||||
@@ -435,6 +428,7 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)janet_nanbox_to_pointer(x))
|
||||
@@ -459,20 +453,20 @@ union Janet {
|
||||
uint32_t type;
|
||||
#endif
|
||||
} tagged;
|
||||
double real;
|
||||
double number;
|
||||
uint64_t u64;
|
||||
};
|
||||
|
||||
#define JANET_DOUBLE_OFFSET 0xFFFF
|
||||
|
||||
#define janet_u64(x) ((x).u64)
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_REAL)
|
||||
#define janet_checktype(x, t) ((x).tagged.type == (t))
|
||||
#define janet_memempty(mem, count) memset((mem), 0, sizeof(JanetKV) * (count))
|
||||
#define janet_memalloc_empty(count) calloc((count), sizeof(JanetKV))
|
||||
#define janet_type(x) (((x).tagged.type < JANET_DOUBLE_OFFSET) ? (x).tagged.type : JANET_NUMBER)
|
||||
#define janet_checktype(x, t) ((t) == JANET_NUMBER \
|
||||
? (x).tagged.type >= JANET_DOUBLE_OFFSET \
|
||||
: (x).tagged.type == (t))
|
||||
#define janet_truthy(x) ((x).tagged.type != JANET_NIL && (x).tagged.type != JANET_FALSE)
|
||||
|
||||
JANET_API Janet janet_wrap_real(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_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
@@ -480,7 +474,6 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_wrap_true() janet_nanbox32_from_tagi(JANET_TRUE, 0)
|
||||
#define janet_wrap_false() janet_nanbox32_from_tagi(JANET_FALSE, 0)
|
||||
#define janet_wrap_boolean(b) janet_nanbox32_from_tagi((b) ? JANET_TRUE : JANET_FALSE, 0)
|
||||
#define janet_wrap_integer(i) janet_nanbox32_from_tagi(JANET_INTEGER, (i))
|
||||
|
||||
/* Wrap the pointer types */
|
||||
#define janet_wrap_struct(s) janet_nanbox32_from_tagp(JANET_STRUCT, (void *)(s))
|
||||
@@ -491,6 +484,7 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_wrap_buffer(s) janet_nanbox32_from_tagp(JANET_BUFFER, (void *)(s))
|
||||
#define janet_wrap_string(s) janet_nanbox32_from_tagp(JANET_STRING, (void *)(s))
|
||||
#define janet_wrap_symbol(s) janet_nanbox32_from_tagp(JANET_SYMBOL, (void *)(s))
|
||||
#define janet_wrap_keyword(s) janet_nanbox32_from_tagp(JANET_KEYWORD, (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_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
|
||||
@@ -503,13 +497,13 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).tagged.type == JANET_TRUE)
|
||||
#define janet_unwrap_integer(x) ((x).tagged.payload.integer)
|
||||
JANET_API double janet_unwrap_real(Janet x);
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
|
||||
#else
|
||||
|
||||
@@ -517,7 +511,7 @@ JANET_API double janet_unwrap_real(Janet x);
|
||||
struct Janet {
|
||||
union {
|
||||
uint64_t u64;
|
||||
double real;
|
||||
double number;
|
||||
int32_t integer;
|
||||
void *pointer;
|
||||
const void *cpointer;
|
||||
@@ -526,8 +520,6 @@ struct Janet {
|
||||
};
|
||||
|
||||
#define janet_u64(x) ((x).as.u64)
|
||||
#define janet_memempty(mem, count) memset((mem), 0, sizeof(JanetKV) * (count))
|
||||
#define janet_memalloc_empty(count) calloc((count), sizeof(JanetKV))
|
||||
#define janet_type(x) ((x).type)
|
||||
#define janet_checktype(x, t) ((x).type == (t))
|
||||
#define janet_truthy(x) \
|
||||
@@ -541,22 +533,22 @@ struct Janet {
|
||||
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
|
||||
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
|
||||
#define janet_unwrap_abstract(x) ((x).as.pointer)
|
||||
#define janet_unwrap_pointer(x) ((x).as.pointer)
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).as.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).type == JANET_TRUE)
|
||||
#define janet_unwrap_integer(x) ((x).as.integer)
|
||||
#define janet_unwrap_real(x) ((x).as.real)
|
||||
#define janet_unwrap_number(x) ((x).as.number)
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_real(double x);
|
||||
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
@@ -570,12 +562,14 @@ JANET_API Janet janet_wrap_abstract(void *x);
|
||||
/* End of tagged union implementation */
|
||||
#endif
|
||||
|
||||
/* Hold components of arguments passed to JanetCFunction. */
|
||||
struct JanetArgs {
|
||||
Janet *v;
|
||||
Janet *ret;
|
||||
int32_t n;
|
||||
};
|
||||
JANET_API int janet_checkint(Janet x);
|
||||
JANET_API int janet_checkint64(Janet x);
|
||||
#define janet_checkintrange(x) ((x) == (int32_t)(x))
|
||||
#define janet_checkint64range(x) ((x) == (int64_t)(x))
|
||||
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
|
||||
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
|
||||
|
||||
#define janet_checktypes(x, tps) ((1 << janet_type(x)) & (tps))
|
||||
|
||||
/* Fiber signal masks. */
|
||||
#define JANET_FIBER_MASK_ERROR 2
|
||||
@@ -615,6 +609,9 @@ struct JanetFiber {
|
||||
/* Mark if a stack frame is a tail call for debugging */
|
||||
#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. */
|
||||
struct JanetStackFrame {
|
||||
JanetFunction *func;
|
||||
@@ -634,7 +631,7 @@ struct JanetArray {
|
||||
int32_t capacity;
|
||||
};
|
||||
|
||||
/* A bytebuffer type. Used as a mutable string or string builder. */
|
||||
/* A byte buffer type. Used as a mutable string or string builder. */
|
||||
struct JanetBuffer {
|
||||
uint8_t *data;
|
||||
int32_t count;
|
||||
@@ -656,7 +653,7 @@ struct JanetKV {
|
||||
Janet value;
|
||||
};
|
||||
|
||||
/* Some function defintion flags */
|
||||
/* Some function definition flags */
|
||||
#define JANET_FUNCDEF_FLAG_VARARG 0x10000
|
||||
#define JANET_FUNCDEF_FLAG_NEEDSENV 0x20000
|
||||
#define JANET_FUNCDEF_FLAG_FIXARITY 0x40000
|
||||
@@ -694,7 +691,7 @@ struct JanetFuncDef {
|
||||
int32_t defs_length;
|
||||
};
|
||||
|
||||
/* A fuction environment */
|
||||
/* A function environment */
|
||||
struct JanetFuncEnv {
|
||||
union {
|
||||
JanetFiber *fiber;
|
||||
@@ -717,7 +714,6 @@ typedef struct JanetParser JanetParser;
|
||||
enum JanetParserStatus {
|
||||
JANET_PARSE_ROOT,
|
||||
JANET_PARSE_ERROR,
|
||||
JANET_PARSE_FULL,
|
||||
JANET_PARSE_PENDING
|
||||
};
|
||||
|
||||
@@ -734,6 +730,7 @@ struct JanetParser {
|
||||
size_t bufcount;
|
||||
size_t bufcap;
|
||||
size_t offset;
|
||||
size_t pending;
|
||||
int lookback;
|
||||
};
|
||||
|
||||
@@ -742,9 +739,11 @@ struct JanetAbstractType {
|
||||
const char *name;
|
||||
int (*gc)(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 userdata */
|
||||
/* Contains information about abstract types */
|
||||
struct JanetAbstractHeader {
|
||||
const JanetAbstractType *type;
|
||||
size_t size;
|
||||
@@ -756,6 +755,32 @@ struct JanetReg {
|
||||
const char *documentation;
|
||||
};
|
||||
|
||||
struct JanetMethod {
|
||||
const char *name;
|
||||
JanetCFunction cfun;
|
||||
};
|
||||
|
||||
struct JanetView {
|
||||
const Janet *items;
|
||||
int32_t len;
|
||||
};
|
||||
|
||||
struct JanetByteView {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
};
|
||||
|
||||
struct JanetDictView {
|
||||
const JanetKV *kvs;
|
||||
int32_t len;
|
||||
int32_t cap;
|
||||
};
|
||||
|
||||
struct JanetRange {
|
||||
int32_t start;
|
||||
int32_t end;
|
||||
};
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
|
||||
/***** START SECTION OPCODES *****/
|
||||
@@ -797,20 +822,12 @@ enum JanetOpCode {
|
||||
JOP_TYPECHECK,
|
||||
JOP_RETURN,
|
||||
JOP_RETURN_NIL,
|
||||
JOP_ADD_INTEGER,
|
||||
JOP_ADD_IMMEDIATE,
|
||||
JOP_ADD_REAL,
|
||||
JOP_ADD,
|
||||
JOP_SUBTRACT_INTEGER,
|
||||
JOP_SUBTRACT_REAL,
|
||||
JOP_SUBTRACT,
|
||||
JOP_MULTIPLY_INTEGER,
|
||||
JOP_MULTIPLY_IMMEDIATE,
|
||||
JOP_MULTIPLY_REAL,
|
||||
JOP_MULTIPLY,
|
||||
JOP_DIVIDE_INTEGER,
|
||||
JOP_DIVIDE_IMMEDIATE,
|
||||
JOP_DIVIDE_REAL,
|
||||
JOP_DIVIDE,
|
||||
JOP_BAND,
|
||||
JOP_BOR,
|
||||
@@ -828,19 +845,11 @@ enum JanetOpCode {
|
||||
JOP_JUMP_IF,
|
||||
JOP_JUMP_IF_NOT,
|
||||
JOP_GREATER_THAN,
|
||||
JOP_GREATER_THAN_INTEGER,
|
||||
JOP_GREATER_THAN_IMMEDIATE,
|
||||
JOP_GREATER_THAN_REAL,
|
||||
JOP_GREATER_THAN_EQUAL_REAL,
|
||||
JOP_LESS_THAN,
|
||||
JOP_LESS_THAN_INTEGER,
|
||||
JOP_LESS_THAN_IMMEDIATE,
|
||||
JOP_LESS_THAN_REAL,
|
||||
JOP_LESS_THAN_EQUAL_REAL,
|
||||
JOP_EQUALS,
|
||||
JOP_EQUALS_INTEGER,
|
||||
JOP_EQUALS_IMMEDIATE,
|
||||
JOP_EQUALS_REAL,
|
||||
JOP_COMPARE,
|
||||
JOP_LOAD_NIL,
|
||||
JOP_LOAD_TRUE,
|
||||
@@ -894,6 +903,7 @@ JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API JanetParser *janet_check_parser(Janet x);
|
||||
#define janet_parser_has_more(P) ((P)->pending)
|
||||
|
||||
/* Assembly */
|
||||
#ifdef JANET_ASSEMBLER
|
||||
@@ -934,14 +944,12 @@ JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len,
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
|
||||
/* Number scanning */
|
||||
JANET_API Janet janet_scan_number(const uint8_t *src, int32_t len);
|
||||
JANET_API int32_t janet_scan_integer(const uint8_t *str, int32_t len, int *err);
|
||||
JANET_API double janet_scan_real(const uint8_t *str, int32_t len, int *err);
|
||||
JANET_API int janet_scan_number(const uint8_t *str, int32_t len, double *out);
|
||||
|
||||
/* Debugging */
|
||||
JANET_API int janet_debug_break(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API int janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||
JANET_API int janet_debug_find(
|
||||
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_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset);
|
||||
|
||||
@@ -962,21 +970,25 @@ JANET_API JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity);
|
||||
JANET_API void janet_buffer_deinit(JanetBuffer *buffer);
|
||||
JANET_API void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_buffer_setcount(JanetBuffer *buffer, int32_t count);
|
||||
JANET_API int janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API int janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API int janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string);
|
||||
JANET_API int janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API int janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
JANET_API int janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x);
|
||||
JANET_API int janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x);
|
||||
JANET_API int janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
JANET_API void janet_buffer_extra(JanetBuffer *buffer, int32_t n);
|
||||
JANET_API void janet_buffer_push_bytes(JanetBuffer *buffer, const uint8_t *string, int32_t len);
|
||||
JANET_API void janet_buffer_push_string(JanetBuffer *buffer, const uint8_t *string);
|
||||
JANET_API void janet_buffer_push_cstring(JanetBuffer *buffer, const char *cstring);
|
||||
JANET_API void janet_buffer_push_u8(JanetBuffer *buffer, uint8_t x);
|
||||
JANET_API void janet_buffer_push_u16(JanetBuffer *buffer, uint16_t x);
|
||||
JANET_API void janet_buffer_push_u32(JanetBuffer *buffer, uint32_t x);
|
||||
JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
|
||||
/* Tuple */
|
||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 4)
|
||||
|
||||
#define JANET_TUPLE_FLAG_BRACKETCTOR 1
|
||||
|
||||
#define janet_tuple_raw(t) ((int32_t *)(t) - 5)
|
||||
#define janet_tuple_length(t) (janet_tuple_raw(t)[0])
|
||||
#define janet_tuple_hash(t) ((janet_tuple_raw(t)[1]))
|
||||
#define janet_tuple_sm_start(t) ((janet_tuple_raw(t)[2]))
|
||||
#define janet_tuple_sm_end(t) ((janet_tuple_raw(t)[3]))
|
||||
#define janet_tuple_flag(t) ((janet_tuple_raw(t)[4]))
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||
JANET_API const Janet *janet_tuple_n(const Janet *values, int32_t n);
|
||||
@@ -994,25 +1006,27 @@ JANET_API const uint8_t *janet_cstring(const char *cstring);
|
||||
JANET_API int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equal(const uint8_t *lhs, const uint8_t *rhs);
|
||||
JANET_API int janet_string_equalconst(const uint8_t *lhs, const uint8_t *rhs, int32_t rlen, int32_t rhash);
|
||||
JANET_API const uint8_t *janet_string_unique(const uint8_t *buf, int32_t len);
|
||||
JANET_API const uint8_t *janet_cstring_unique(const char *s);
|
||||
JANET_API const uint8_t *janet_description(Janet x);
|
||||
JANET_API const uint8_t *janet_to_string(Janet x);
|
||||
JANET_API void janet_to_string_b(JanetBuffer *buffer, Janet x);
|
||||
JANET_API void janet_to_description_b(JanetBuffer *buffer, Janet x);
|
||||
JANET_API void janet_description_b(JanetBuffer *buffer, Janet x);
|
||||
#define janet_cstringv(cstr) janet_wrap_string(janet_cstring(cstr))
|
||||
#define janet_stringv(str, len) janet_wrap_string(janet_string((str), (len)))
|
||||
JANET_API const uint8_t *janet_formatc(const char *format, ...);
|
||||
JANET_API void janet_puts(const uint8_t *str);
|
||||
|
||||
/* Symbol functions */
|
||||
JANET_API const uint8_t *janet_symbol(const uint8_t *str, int32_t len);
|
||||
JANET_API const uint8_t *janet_symbol_from_string(const uint8_t *str);
|
||||
JANET_API const uint8_t *janet_csymbol(const char *str);
|
||||
JANET_API const uint8_t *janet_symbol_gen(void);
|
||||
#define janet_symbolv(str, len) janet_wrap_symbol(janet_symbol((str), (len)))
|
||||
#define janet_csymbolv(cstr) janet_wrap_symbol(janet_csymbol(cstr))
|
||||
|
||||
/* Keyword functions */
|
||||
#define janet_keyword janet_symbol
|
||||
#define janet_ckeyword janet_csymbol
|
||||
#define janet_keywordv(str, len) janet_wrap_keyword(janet_keyword((str), (len)))
|
||||
#define janet_ckeywordv(cstr) janet_wrap_keyword(janet_ckeyword(cstr))
|
||||
|
||||
/* Structs */
|
||||
#define janet_struct_raw(t) ((int32_t *)(t) - 4)
|
||||
#define janet_struct_length(t) (janet_struct_raw(t)[0])
|
||||
@@ -1023,7 +1037,6 @@ JANET_API JanetKV *janet_struct_begin(int32_t count);
|
||||
JANET_API void janet_struct_put(JanetKV *st, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_struct_end(JanetKV *st);
|
||||
JANET_API Janet janet_struct_get(const JanetKV *st, Janet key);
|
||||
JANET_API const JanetKV *janet_struct_next(const JanetKV *st, const JanetKV *kv);
|
||||
JANET_API JanetTable *janet_struct_to_table(const JanetKV *st);
|
||||
JANET_API int janet_struct_equal(const JanetKV *lhs, const JanetKV *rhs);
|
||||
JANET_API int janet_struct_compare(const JanetKV *lhs, const JanetKV *rhs);
|
||||
@@ -1037,15 +1050,14 @@ JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
|
||||
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);
|
||||
JANET_API const JanetKV *janet_table_next(JanetTable *t, const JanetKV *kv);
|
||||
JANET_API const JanetKV *janet_table_to_struct(JanetTable *t);
|
||||
JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||
JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other);
|
||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
|
||||
/* Fiber */
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity);
|
||||
JANET_API JanetFiber *janet_fiber_n(JanetFunction *callee, int32_t capacity, const Janet *argv, int32_t argn);
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
@@ -1062,7 +1074,8 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||
|
||||
/* Native */
|
||||
JANET_API JanetCFunction janet_native(const char *name, const uint8_t **error);
|
||||
typedef void (*JanetModule)(JanetTable *);
|
||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||
|
||||
/* Marshaling */
|
||||
JANET_API int janet_marshal(
|
||||
@@ -1102,13 +1115,19 @@ JANET_API int32_t janet_hash(Janet x);
|
||||
JANET_API int janet_compare(Janet x, Janet y);
|
||||
JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, Janet x);
|
||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
JANET_API void janet_deinit(void);
|
||||
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 void janet_stacktrace(JanetFiber *fiber, const char *errtype, Janet err);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
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 */
|
||||
typedef enum {
|
||||
@@ -1121,139 +1140,48 @@ JANET_API void janet_def(JanetTable *env, const char *name, Janet val, const cha
|
||||
JANET_API void janet_var(JanetTable *env, const char *name, Janet val, const char *documentation);
|
||||
JANET_API void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
|
||||
JANET_API JanetBindingType janet_resolve(JanetTable *env, const uint8_t *sym, Janet *out);
|
||||
JANET_API JanetTable *janet_env(JanetArgs args);
|
||||
JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* C Function helpers */
|
||||
JANET_API int janet_arity_err(JanetArgs args, int32_t n, const char *prefix);
|
||||
JANET_API int janet_type_err(JanetArgs args, int32_t n, JanetType expected);
|
||||
JANET_API int janet_typemany_err(JanetArgs args, int32_t n, int expected);
|
||||
JANET_API int janet_typeabstract_err(JanetArgs args, int32_t n, const JanetAbstractType *at);
|
||||
/* New C API */
|
||||
|
||||
/* Helpers for writing modules */
|
||||
#define JANET_MODULE_ENTRY JANET_API int _janet_init
|
||||
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
||||
JANET_API void janet_panicv(Janet message);
|
||||
JANET_API void janet_panic(const char *message);
|
||||
JANET_API void janet_panics(const uint8_t *message);
|
||||
#define janet_panicf(...) janet_panics(janet_formatc(__VA_ARGS__))
|
||||
#define janet_printf(...) fputs((const char *)janet_formatc(__VA_ARGS__), stdout)
|
||||
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
||||
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 Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods);
|
||||
JANET_API double janet_getnumber(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 JanetTable *janet_gettable(const Janet *argv, int32_t n);
|
||||
JANET_API const JanetKV *janet_getstruct(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getstring(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getsymbol(const Janet *argv, int32_t n);
|
||||
JANET_API const uint8_t *janet_getkeyword(const Janet *argv, int32_t n);
|
||||
JANET_API JanetBuffer *janet_getbuffer(const Janet *argv, int32_t n);
|
||||
JANET_API JanetFiber *janet_getfiber(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 int janet_getboolean(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 JanetView janet_getindexed(const Janet *argv, int32_t n);
|
||||
JANET_API JanetByteView janet_getbytes(const Janet *argv, int32_t n);
|
||||
JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
|
||||
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
|
||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
|
||||
/***** END SECTION MAIN *****/
|
||||
|
||||
/***** START SECTION MACROS *****/
|
||||
|
||||
/* Macros */
|
||||
#define JANET_THROW(a, e) return (*((a).ret) = janet_cstringv(e), 1)
|
||||
#define JANET_THROWV(a, v) return (*((a).ret) = (v), 1)
|
||||
#define JANET_RETURN(a, v) return (*((a).ret) = (v), 0)
|
||||
|
||||
/* Early exit macros */
|
||||
#define JANET_MAXARITY(A, N) do { if ((A).n > (N))\
|
||||
return janet_arity_err(A, N, "at most "); } while (0)
|
||||
#define JANET_MINARITY(A, N) do { if ((A).n < (N))\
|
||||
return janet_arity_err(A, N, "at least "); } while (0)
|
||||
#define JANET_FIXARITY(A, N) do { if ((A).n != (N))\
|
||||
return janet_arity_err(A, N, ""); } while (0)
|
||||
#define JANET_CHECK(A, N, T) do {\
|
||||
if ((A).n > (N)) {\
|
||||
if (!janet_checktype((A).v[(N)], (T))) return janet_type_err(A, N, T);\
|
||||
} else {\
|
||||
if ((T) != JANET_NIL) return janet_type_err(A, N, T);\
|
||||
}\
|
||||
} while (0)
|
||||
#define JANET_CHECKMANY(A, N, TS) do {\
|
||||
if ((A).n > (N)) {\
|
||||
JanetType _t_ = janet_type((A).v[(N)]);\
|
||||
if (!((1 << _t_) & (TS))) return janet_typemany_err(A, N, TS);\
|
||||
} else {\
|
||||
if (!((TS) & JANET_NIL)) return janet_typemany_err(A, N, TS);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_CHECKABSTRACT(A, N, AT) do {\
|
||||
if ((A).n > (N)) {\
|
||||
Janet _x_ = (A).v[(N)];\
|
||||
if (!janet_checktype(_x_, JANET_ABSTRACT) ||\
|
||||
janet_abstract_type(janet_unwrap_abstract(_x_)) != (AT))\
|
||||
return janet_typeabstract_err(A, N, AT);\
|
||||
} else {\
|
||||
return janet_typeabstract_err(A, N, AT);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_NUMBER(DEST, A, N) do { \
|
||||
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_NUMBER); \
|
||||
Janet _val_ = (A).v[(N)];\
|
||||
JanetType _type_ = janet_type(_val_); \
|
||||
if (_type_ == JANET_REAL) { \
|
||||
DEST = janet_unwrap_real(_val_); \
|
||||
} else if (_type_ == JANET_INTEGER) {\
|
||||
DEST = (double) janet_unwrap_integer(_val_);\
|
||||
} else { \
|
||||
return janet_typemany_err(A, N, JANET_TFLAG_NUMBER); \
|
||||
} \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_BOOLEAN(DEST, A, N) do { \
|
||||
JANET_CHECKMANY(A, N, JANET_TFLAG_TRUE | JANET_TFLAG_FALSE);\
|
||||
DEST = janet_unwrap_boolean((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_BYTES(DESTBYTES, DESTLEN, A, N) do {\
|
||||
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_BYTES);\
|
||||
if (!janet_bytes_view((A).v[(N)], &(DESTBYTES), &(DESTLEN))) {\
|
||||
return janet_typemany_err(A, N, JANET_TFLAG_BYTES);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_INDEXED(DESTVALS, DESTLEN, A, N) do {\
|
||||
if ((A).n <= (N)) return janet_typemany_err(A, N, JANET_TFLAG_INDEXED);\
|
||||
if (!janet_indexed_view((A).v[(N)], &(DESTVALS), &(DESTLEN))) {\
|
||||
return janet_typemany_err(A, N, JANET_TFLAG_INDEXED);\
|
||||
}\
|
||||
} while (0)
|
||||
|
||||
#define _JANET_ARG(TYPE, NAME, DEST, A, N) do { \
|
||||
JANET_CHECK(A, N, TYPE);\
|
||||
DEST = janet_unwrap_##NAME((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_ARG_FIBER(DEST, A, N) _JANET_ARG(JANET_FIBER, fiber, DEST, A, N)
|
||||
#define JANET_ARG_INTEGER(DEST, A, N) _JANET_ARG(JANET_INTEGER, integer, DEST, A, N)
|
||||
#define JANET_ARG_REAL(DEST, A, N) _JANET_ARG(JANET_REAL, real, DEST, A, N)
|
||||
#define JANET_ARG_STRING(DEST, A, N) _JANET_ARG(JANET_STRING, string, DEST, A, N)
|
||||
#define JANET_ARG_SYMBOL(DEST, A, N) _JANET_ARG(JANET_SYMBOL, symbol, DEST, A, N)
|
||||
#define JANET_ARG_ARRAY(DEST, A, N) _JANET_ARG(JANET_ARRAY, array, DEST, A, N)
|
||||
#define JANET_ARG_TUPLE(DEST, A, N) _JANET_ARG(JANET_TUPLE, tuple, DEST, A, N)
|
||||
#define JANET_ARG_TABLE(DEST, A, N) _JANET_ARG(JANET_TABLE, table, DEST, A, N)
|
||||
#define JANET_ARG_STRUCT(DEST, A, N) _JANET_ARG(JANET_STRUCT, struct, DEST, A, N)
|
||||
#define JANET_ARG_BUFFER(DEST, A, N) _JANET_ARG(JANET_BUFFER, buffer, DEST, A, N)
|
||||
#define JANET_ARG_FUNCTION(DEST, A, N) _JANET_ARG(JANET_FUNCTION, function, DEST, A, N)
|
||||
#define JANET_ARG_CFUNCTION(DEST, A, N) _JANET_ARG(JANET_CFUNCTION, cfunction, DEST, A, N)
|
||||
|
||||
#define JANET_ARG_ABSTRACT(DEST, A, N, AT) do { \
|
||||
JANET_CHECKABSTRACT(A, N, AT); \
|
||||
DEST = janet_unwrap_abstract((A).v[(N)]); \
|
||||
} while (0)
|
||||
|
||||
#define JANET_RETURN_NIL(A) do { return JANET_SIGNAL_OK; } while (0)
|
||||
#define JANET_RETURN_FALSE(A) JANET_RETURN(A, janet_wrap_false())
|
||||
#define JANET_RETURN_TRUE(A) JANET_RETURN(A, janet_wrap_true())
|
||||
#define JANET_RETURN_BOOLEAN(A, X) JANET_RETURN(A, janet_wrap_boolean(X))
|
||||
#define JANET_RETURN_FIBER(A, X) JANET_RETURN(A, janet_wrap_fiber(X))
|
||||
#define JANET_RETURN_INTEGER(A, X) JANET_RETURN(A, janet_wrap_integer(X))
|
||||
#define JANET_RETURN_REAL(A, X) JANET_RETURN(A, janet_wrap_real(X))
|
||||
#define JANET_RETURN_STRING(A, X) JANET_RETURN(A, janet_wrap_string(X))
|
||||
#define JANET_RETURN_SYMBOL(A, X) JANET_RETURN(A, janet_wrap_symbol(X))
|
||||
#define JANET_RETURN_ARRAY(A, X) JANET_RETURN(A, janet_wrap_array(X))
|
||||
#define JANET_RETURN_TUPLE(A, X) JANET_RETURN(A, janet_wrap_tuple(X))
|
||||
#define JANET_RETURN_TABLE(A, X) JANET_RETURN(A, janet_wrap_table(X))
|
||||
#define JANET_RETURN_STRUCT(A, X) JANET_RETURN(A, janet_wrap_struct(X))
|
||||
#define JANET_RETURN_BUFFER(A, X) JANET_RETURN(A, janet_wrap_buffer(X))
|
||||
#define JANET_RETURN_FUNCTION(A, X) JANET_RETURN(A, janet_wrap_function(X))
|
||||
#define JANET_RETURN_CFUNCTION(A, X) JANET_RETURN(A, janet_wrap_cfunction(X))
|
||||
#define JANET_RETURN_ABSTRACT(A, X) JANET_RETURN(A, janet_wrap_abstract(X))
|
||||
|
||||
#define JANET_RETURN_CSTRING(A, X) JANET_RETURN(A, janet_cstringv(X))
|
||||
#define JANET_RETURN_CSYMBOL(A, X) JANET_RETURN(A, janet_csymbolv(X))
|
||||
|
||||
/**** END SECTION MACROS *****/
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -1,17 +1,18 @@
|
||||
# Copyright 2017-2018 (C) Calvin Rose
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(do
|
||||
|
||||
(var *should-repl* :private false)
|
||||
(var *no-file* :private true)
|
||||
(var *raw-stdin* :private false)
|
||||
(var *handleopts* :private true)
|
||||
(var *exit-on-error* :private true)
|
||||
(var *should-repl* false)
|
||||
(var *no-file* true)
|
||||
(var *quiet* false)
|
||||
(var *raw-stdin* false)
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
|
||||
# Flag handlers
|
||||
(def handlers :private
|
||||
{"h" (fn [&]
|
||||
(print "usage: " process/args.0 " [options] scripts...")
|
||||
(print "usage: " (get process/args 0) " [options] script args...")
|
||||
(print
|
||||
`Options are:
|
||||
-h Show this help
|
||||
@@ -20,6 +21,8 @@
|
||||
-e Execute a string of janet
|
||||
-r Enter the repl after running all scripts
|
||||
-p Keep on executing if there is a top level error (persistent)
|
||||
-q Hide prompt, logo, and repl output (quiet)
|
||||
-l Execute code in a file before running the main script
|
||||
-- Stop handling options`)
|
||||
(os/exit 0)
|
||||
1)
|
||||
@@ -27,10 +30,15 @@
|
||||
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
||||
"r" (fn [&] (set *should-repl* true) 1)
|
||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||
"q" (fn [&] (set *quiet* true) 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 &]
|
||||
(set *no-file* false)
|
||||
(eval (get process/args (+ i 1)))
|
||||
(eval-string (get process/args (+ i 1)))
|
||||
2)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
@@ -46,15 +54,23 @@
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(import* _env arg :prefix "" :exit *exit-on-error*)
|
||||
(++ i))))
|
||||
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
||||
(set i lenargs))))
|
||||
|
||||
(when (or *should-repl* *no-file*)
|
||||
(if *raw-stdin*
|
||||
(repl nil identity)
|
||||
(do
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
||||
(repl (fn [buf p]
|
||||
(def offset (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||
(getline prompt buf)))))))
|
||||
(if-not *quiet*
|
||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
(defn noprompt [_] "")
|
||||
(defn getprompt [p]
|
||||
(def offset (parser/where p))
|
||||
(string "janet:" offset ":" (parser/state p) "> "))
|
||||
(def prompter (if *quiet* noprompt getprompt))
|
||||
(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)))
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -23,14 +23,12 @@
|
||||
#include "line.h"
|
||||
|
||||
/* Common */
|
||||
int janet_line_getter(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_CHECK(args, 0, JANET_STRING);
|
||||
JANET_CHECK(args, 1, JANET_BUFFER);
|
||||
janet_line_get(
|
||||
janet_unwrap_string(args.v[0]),
|
||||
janet_unwrap_buffer(args.v[1]));
|
||||
JANET_RETURN(args, args.v[0]);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 2);
|
||||
const char *str = (argc >= 1) ? (const char *) janet_getstring(argv, 0) : "";
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
janet_line_get(str, buf);
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
@@ -57,8 +55,8 @@ void janet_line_deinit() {
|
||||
;
|
||||
}
|
||||
|
||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
||||
fputs((const char *)p, stdout);
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
fputs(p, stdout);
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
@@ -186,7 +184,7 @@ static void clear() {
|
||||
static void refresh() {
|
||||
char seq[64];
|
||||
JanetBuffer b;
|
||||
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = buf;
|
||||
int _len = len;
|
||||
@@ -298,7 +296,7 @@ static void kright() {
|
||||
static void kbackspace() {
|
||||
if (pos > 0) {
|
||||
memmove(buf + pos - 1, buf + pos, len - pos);
|
||||
pos--;
|
||||
pos--;
|
||||
buf[--len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
@@ -446,8 +444,8 @@ static int checktermsupport() {
|
||||
return 1;
|
||||
}
|
||||
|
||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer) {
|
||||
prompt = (const char *)p;
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
prompt = p;
|
||||
buffer->count = 0;
|
||||
historyi = 0;
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -28,7 +28,7 @@
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
void janet_line_get(const uint8_t *p, JanetBuffer *buffer);
|
||||
int janet_line_getter(JanetArgs args);
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer);
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv);
|
||||
|
||||
#endif
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -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
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
@@ -32,11 +32,11 @@ static const uint8_t *line_prompt = NULL;
|
||||
|
||||
/* Yield to JS event loop from janet. Takes a repl prompt
|
||||
* and a buffer to fill with input data. */
|
||||
static int repl_yield(JanetArgs args) {
|
||||
JANET_FIXARITY(args, 2);
|
||||
JANET_ARG_STRING(line_prompt, args, 0);
|
||||
JANET_ARG_BUFFER(line_buffer, args, 1);
|
||||
JANET_RETURN_NIL(args);
|
||||
static Janet repl_yield(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
line_prompt = janet_getstring(argv, 0);
|
||||
line_buffer = janet_getbuffer(argv, 1);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Re-enter the loop */
|
||||
@@ -44,7 +44,7 @@ static int enter_loop(void) {
|
||||
Janet ret;
|
||||
JanetSignal status = janet_continue(repl_fiber, janet_wrap_nil(), &ret);
|
||||
if (status == JANET_SIGNAL_ERROR) {
|
||||
janet_stacktrace(repl_fiber, "runtime", ret);
|
||||
janet_stacktrace(repl_fiber, ret);
|
||||
janet_deinit();
|
||||
repl_fiber = NULL;
|
||||
return 1;
|
||||
@@ -52,18 +52,15 @@ static int enter_loop(void) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Allow JS interop from within janet */
|
||||
static int cfun_js(JanetArgs args) {
|
||||
const uint8_t *bytes;
|
||||
int32_t len;
|
||||
JANET_FIXARITY(args, 1);
|
||||
JANET_ARG_BYTES(bytes, len, args, 0);
|
||||
(void) len;
|
||||
emscripten_run_script((const char *)bytes);
|
||||
JANET_RETURN_NIL(args);
|
||||
/* Allow JS interoperation from within janet */
|
||||
static Janet cfun_js(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetByteView bytes = janet_getbytes(argv, 0);
|
||||
emscripten_run_script((const char *)bytes.bytes);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Intialize the repl */
|
||||
/* Initialize the repl */
|
||||
EMSCRIPTEN_KEEPALIVE
|
||||
void repl_init(void) {
|
||||
int status;
|
||||
|
||||
@@ -1,5 +1,6 @@
|
||||
# Copyright 2017-2018 (C) Calvin Rose
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2018 Calvin Rose"))
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
(repl (fn get-line [buf p]
|
||||
|
||||
@@ -3,20 +3,34 @@
|
||||
(var num-tests-passed 0)
|
||||
(var num-tests-run 0)
|
||||
(var suite-num 0)
|
||||
(var numchecks 0)
|
||||
|
||||
(defn assert [x e]
|
||||
(++ num-tests-run)
|
||||
(when x (++ num-tests-passed))
|
||||
(print (if x
|
||||
" \e[32m✔\e[0m "
|
||||
" \e[31m✘\e[0m ") e)
|
||||
(if x
|
||||
(do
|
||||
(when (= numchecks 25)
|
||||
(set numchecks 0)
|
||||
(print))
|
||||
(++ numchecks)
|
||||
(file/write stdout "\e[32m✔\e[0m"))
|
||||
(do
|
||||
(file/write stdout "\n\e[31m✘\e[0m ")
|
||||
(set numchecks 0)
|
||||
(print e)))
|
||||
x)
|
||||
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defn start-suite [x]
|
||||
(set suite-num x)
|
||||
(print "\nRunning test suite " x " tests...\n"))
|
||||
(print "\nRunning test suite " x " tests...\n "))
|
||||
|
||||
(defn end-suite []
|
||||
(print "\nTest suite " suite-num " finished.")
|
||||
(print "\n\nTest suite " suite-num " finished.")
|
||||
(print num-tests-passed " of " num-tests-run " tests passed.\n")
|
||||
(if (not= num-tests-passed num-tests-run) (os/exit 1)))
|
||||
|
||||
@@ -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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -37,10 +37,11 @@
|
||||
(assert (= 7 (% 20 13)) "modulo 1")
|
||||
(assert (= -7 (% -20 13)) "modulo 2")
|
||||
|
||||
(assert (order< nil false true
|
||||
(assert (order< 1.0 nil false true
|
||||
(fiber/new (fn [] 1))
|
||||
1 1.0 "hi"
|
||||
"hi"
|
||||
(quote hello)
|
||||
:hello
|
||||
(array 1 2 3)
|
||||
(tuple 1 2 3)
|
||||
(table "a" "b" "c" "d")
|
||||
@@ -78,7 +79,7 @@
|
||||
(assert (= "\e" "\x1B") "escape character")
|
||||
(assert (= "\x09" "\t") "tab character")
|
||||
|
||||
# Mcarthy's 91 function
|
||||
# McCarthy's 91 function
|
||||
(var f91 nil)
|
||||
(set f91 (fn [n] (if (> n 100) (- n 10) (f91 (f91 (+ n 11))))))
|
||||
(assert (= 91 (f91 10)) "f91(10) = 91")
|
||||
@@ -201,7 +202,7 @@
|
||||
|
||||
(def 🦊 :fox)
|
||||
(def 🐮 :cow)
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼:fox:cow") "emojis 🙉 :)")
|
||||
(assert (= (string "🐼" 🦊 🐮) "🐼foxcow") "emojis 🙉 :)")
|
||||
(assert (not= 🦊 "🦊") "utf8 strings are not symbols and vice versa")
|
||||
|
||||
# Symbols with @ character
|
||||
@@ -216,7 +217,7 @@
|
||||
# Merge sort
|
||||
|
||||
# Imperative (and verbose) merge sort merge
|
||||
(defn merge
|
||||
(defn merge
|
||||
[xs ys]
|
||||
(def ret @[])
|
||||
(def xlen (length xs))
|
||||
@@ -282,5 +283,22 @@
|
||||
(++ i))
|
||||
(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)
|
||||
|
||||
|
||||
@@ -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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
@@ -21,8 +21,7 @@
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(start-suite 1)
|
||||
|
||||
(assert (= 400.0 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
(assert (= (real 400) (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
|
||||
(def test-struct {'def 1 'bork 2 'sam 3 'a 'b 'het @[1 2 3 4 5]})
|
||||
(assert (= (get test-struct 'def) 1) "struct get")
|
||||
@@ -96,7 +95,7 @@
|
||||
|
||||
# Find the maximum path from the top (root)
|
||||
# of the triangle to the leaves of the triangle.
|
||||
|
||||
|
||||
(defn myfold [xs ys]
|
||||
(let [xs1 (tuple/prepend xs 0)
|
||||
xs2 (tuple/append xs 0)
|
||||
@@ -141,7 +140,7 @@
|
||||
|
||||
# Marshal
|
||||
|
||||
(def um-lookup (env-lookup _env))
|
||||
(def um-lookup (env-lookup *env*))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
(defn testmarsh [x msg]
|
||||
@@ -155,6 +154,10 @@
|
||||
(testmarsh 1 "marshal small integers")
|
||||
(testmarsh -1 "marshal integers (-1)")
|
||||
(testmarsh 199 "marshal small integers (199)")
|
||||
(testmarsh 5000 "marshal medium integers (5000)")
|
||||
(testmarsh -5000 "marshal small integers (-5000)")
|
||||
(testmarsh 10000 "marshal large integers (10000)")
|
||||
(testmarsh -10000 "marshal large integers (-10000)")
|
||||
(testmarsh 1.0 "marshal double")
|
||||
(testmarsh "doctordolittle" "marshal string")
|
||||
(testmarsh :chickenshwarma "marshal symbol")
|
||||
@@ -188,10 +191,10 @@
|
||||
|
||||
(assert (= 14 (sum (map inc @[1 2 3 4]))) "sum map")
|
||||
(def myfun (juxt + - * /))
|
||||
(assert (= '[2 -2 2 0] (myfun 2)) "juxt")
|
||||
(assert (= '[2 -2 2 0.5] (myfun 2)) "juxt")
|
||||
|
||||
# Case statements
|
||||
(assert
|
||||
(assert
|
||||
(= :six (case (+ 1 2 3)
|
||||
1 :one
|
||||
2 :two
|
||||
@@ -215,11 +218,11 @@
|
||||
|
||||
# Closure in while loop
|
||||
(def closures (seq [i :range [0 5]] (fn [] i)))
|
||||
(assert (= 0 (closures.0)) "closure in loop 0")
|
||||
(assert (= 1 (closures.1)) "closure in loop 1")
|
||||
(assert (= 2 (closures.2)) "closure in loop 2")
|
||||
(assert (= 3 (closures.3)) "closure in loop 3")
|
||||
(assert (= 4 (closures.4)) "closure in loop 4")
|
||||
(assert (= 0 ((get closures 0))) "closure in loop 0")
|
||||
(assert (= 1 ((get closures 1))) "closure in loop 1")
|
||||
(assert (= 2 ((get closures 2))) "closure in loop 2")
|
||||
(assert (= 3 ((get closures 3))) "closure in loop 3")
|
||||
(assert (= 4 ((get closures 4))) "closure in loop 4")
|
||||
|
||||
# More numerical tests
|
||||
(assert (== 1 1.0) "numerical equal 1")
|
||||
@@ -239,7 +242,7 @@
|
||||
(def arr (array))
|
||||
(array/push arr :hello)
|
||||
(array/push arr :world)
|
||||
(assert (array= arr @[:hello :world]) "array comparision")
|
||||
(assert (array= arr @[:hello :world]) "array comparison")
|
||||
(assert (array= @[1 2 3 4 5] @[1 2 3 4 5]) "array comparison 2")
|
||||
(assert (array= @[:one :two :three :four :five] @[:one :two :three :four :five]) "array comparison 3")
|
||||
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
|
||||
|
||||
@@ -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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
||||
@@ -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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
@@ -46,4 +46,317 @@
|
||||
@[x y] (+ x y 10)
|
||||
0)) "match 3")
|
||||
|
||||
# Edge case should cause old compilers to fail due to
|
||||
# if statement optimization
|
||||
(var var-a 1)
|
||||
(var var-b (if false 2 (string "hello")))
|
||||
|
||||
(assert (= var-b "hello") "regression 1")
|
||||
|
||||
# Scan number
|
||||
|
||||
(assert (= 1 (scan-number "1")) "scan-number 1")
|
||||
(assert (= -1 (scan-number "-1")) "scan-number -1")
|
||||
(assert (= 1.3e4 (scan-number "1.3e4")) "scan-number 1.3e4")
|
||||
|
||||
# Some macros
|
||||
|
||||
(assert (= 2 (if-not 1 3 2)) "if-not 1")
|
||||
(assert (= 3 (if-not false 3)) "if-not 2")
|
||||
(assert (= 3 (if-not nil 3 2)) "if-not 3")
|
||||
(assert (= nil (if-not true 3)) "if-not 4")
|
||||
|
||||
(assert (= 4 (unless false (+ 1 2 3) 4)) "unless")
|
||||
|
||||
(def res @{})
|
||||
(loop [[k v] :pairs @{1 2 3 4 5 6}]
|
||||
(put res k v))
|
||||
(assert (and
|
||||
(= (get res 1) 2)
|
||||
(= (get res 3) 4)
|
||||
(= (get res 5) 6)) "loop :pairs")
|
||||
|
||||
# Another regression test - no segfaults
|
||||
(defn afn [x] x)
|
||||
(assert (= 1 (try (afn) ([err] 1))) "bad arity 1")
|
||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||
(assert (= 1 (try (identity) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not) ([err] 1))) "bad arity 5")
|
||||
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
(def fibasm (asm '{
|
||||
arity 1
|
||||
bytecode [
|
||||
(ltim 1 0 0x2) # $1 = $0 < 2
|
||||
(jmpif 1 :done) # if ($1) goto :done
|
||||
(lds 1) # $1 = self
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0), push argument for next function call
|
||||
(call 2 1) # $2 = call($1)
|
||||
(addim 0 0 -0x1) # $0 = $0 - 1
|
||||
(push 0) # push($0)
|
||||
(call 0 1) # $0 = call($1)
|
||||
(add 0 0 2) # $0 = $0 + $2 (integers)
|
||||
:done
|
||||
(ret 0) # return $0
|
||||
]
|
||||
}))
|
||||
|
||||
(assert (= 0 (fibasm 0)) "fibasm 1")
|
||||
(assert (= 1 (fibasm 1)) "fibasm 2")
|
||||
(assert (= 55 (fibasm 10)) "fibasm 3")
|
||||
(assert (= 6765 (fibasm 20)) "fibasm 4")
|
||||
|
||||
# Calling non functions
|
||||
|
||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||
(assert (= :bad (try (@{:ok 2} :ok :no) ([err] :bad))) "calling table too many arguments")
|
||||
(assert (= :bad (try (:ok @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
||||
(assert (= :oops (try (1 1) ([err] :oops))) "calling number fails")
|
||||
|
||||
# Method test
|
||||
|
||||
(def Dog @{:bark (fn bark [self what] (string (self :name) " says " what "!"))})
|
||||
(defn make-dog
|
||||
[name]
|
||||
(table/setproto @{:name name} Dog))
|
||||
|
||||
(assert (= "fido" ((make-dog "fido") :name)) "oo 1")
|
||||
(def spot (make-dog "spot"))
|
||||
(assert (= "spot says hi!" (:bark spot "hi")) "oo 2")
|
||||
|
||||
# Negative tests
|
||||
|
||||
(assert-error "+ check types" (+ 1 ()))
|
||||
(assert-error "- check types" (- 1 ()))
|
||||
(assert-error "* check types" (* 1 ()))
|
||||
(assert-error "/ check types" (/ 1 ()))
|
||||
(assert-error "band check types" (band 1 ()))
|
||||
(assert-error "bor check types" (bor 1 ()))
|
||||
(assert-error "bxor check types" (bxor 1 ()))
|
||||
(assert-error "bnot check types" (bnot ()))
|
||||
|
||||
# Buffer blitting
|
||||
|
||||
(def b (buffer/new-filled 100))
|
||||
(buffer/bit-set b 100)
|
||||
(buffer/bit-clear b 100)
|
||||
(assert (zero? (sum b)) "buffer bit set and clear")
|
||||
(buffer/bit-toggle b 101)
|
||||
(assert (= 32 (sum b)) "buffer bit set and clear")
|
||||
|
||||
(def b2 @"hello world")
|
||||
|
||||
(buffer/blit b2 "joyto ")
|
||||
(assert (= (string b2) "joyto world") "buffer/blit 1")
|
||||
|
||||
(buffer/blit b2 "joyto" 6)
|
||||
(assert (= (string b2) "joyto joyto") "buffer/blit 2")
|
||||
|
||||
(buffer/blit b2 "abcdefg" 5 6)
|
||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||
|
||||
# Buffer 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)
|
||||
|
||||
42
test/suite4.janet
Normal file
42
test/suite4.janet
Normal file
@@ -0,0 +1,42 @@
|
||||
# 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")
|
||||
|
||||
(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/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.gen.c")
|
||||
(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 [params &] (default params @{}) (,buffer ;forms)))
|
||||
|
||||
(def ctor (compile ast *env* source))
|
||||
(if-not (function? ctor)
|
||||
(error (string "could not compile template")))
|
||||
(ctor))
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user