mirror of
https://github.com/janet-lang/janet
synced 2025-11-09 20:13:02 +00:00
Compare commits
202 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
0d2844b7c9 | ||
|
|
719f7ba0c4 | ||
|
|
44ed2c6b47 | ||
|
|
c9292ef648 | ||
|
|
135abff100 | ||
|
|
7252db1e63 | ||
|
|
05e3fd3cc6 | ||
|
|
6f1b03b67e | ||
|
|
dca247f01d | ||
|
|
63e7ca4623 | ||
|
|
75d21d9f45 | ||
|
|
8911daaf6c | ||
|
|
1f55d40a10 | ||
|
|
6591e7636d | ||
|
|
c12eaa926a | ||
|
|
0e464ded3d | ||
|
|
aee1687215 | ||
|
|
58e3e63a89 | ||
|
|
9b605b27bd | ||
|
|
c5010dffb4 | ||
|
|
026f26f05f | ||
|
|
cf2d3861d6 | ||
|
|
6ceaf9d28d | ||
|
|
25a9804d91 | ||
|
|
cf19cd5292 | ||
|
|
03824dd9f7 | ||
|
|
280dca3998 | ||
|
|
46e09e4c71 | ||
|
|
427b2638e0 | ||
|
|
2541806dc1 | ||
|
|
0d16b9e1a1 | ||
|
|
b2263ed5b5 | ||
|
|
45c2819068 | ||
|
|
d28925fdab | ||
|
|
9097e36ea0 | ||
|
|
99ef4c7510 | ||
|
|
b9e05d06fe | ||
|
|
423b6db855 | ||
|
|
bb54b940c0 | ||
|
|
4149df1fca | ||
|
|
8dd8af742a | ||
|
|
d47804d222 | ||
|
|
8dd322c0be | ||
|
|
7fd0748c19 | ||
|
|
655d4b3aad | ||
|
|
5f51476526 | ||
|
|
d47b5f8c6a | ||
|
|
a18a251d16 | ||
|
|
8ee54e887f | ||
|
|
088c926196 | ||
|
|
54b66a4199 | ||
|
|
f9d57103f4 | ||
|
|
f780df0aa6 | ||
|
|
fede40f279 | ||
|
|
6ae5a9be60 | ||
|
|
e9f3dc7d5c | ||
|
|
841b58042f | ||
|
|
63e3e02a39 | ||
|
|
944347e828 | ||
|
|
7910a5feef | ||
|
|
2becd196dd | ||
|
|
bcb45157a8 | ||
|
|
70ffe3b6bd | ||
|
|
339dea9390 | ||
|
|
b26a7bb22a | ||
|
|
45dfc7cc96 | ||
|
|
9d020c3ec5 | ||
|
|
8cda06b995 | ||
|
|
a8afc5b81f | ||
|
|
228d045a06 | ||
|
|
c447e7b3a5 | ||
|
|
803c3fc235 | ||
|
|
a032529437 | ||
|
|
7bee204390 | ||
|
|
064a700edd | ||
|
|
7809f89dfc | ||
|
|
940860755c | ||
|
|
1b283c47b4 | ||
|
|
8e427317cd | ||
|
|
908a3b6f5c | ||
|
|
f2ba91899f | ||
|
|
16127fc55c | ||
|
|
97d874f16b | ||
|
|
8aba5e76ae | ||
|
|
0e7144f2dc | ||
|
|
9f48c3e2db | ||
|
|
e6306ea188 | ||
|
|
0e99d8d80f | ||
|
|
de5cd73cd7 | ||
|
|
b585d19519 | ||
|
|
8753d2dcb8 | ||
|
|
39f1d81fd4 | ||
|
|
fcd203c646 | ||
|
|
4ebb749131 | ||
|
|
37a943d9b5 | ||
|
|
2f2b875c2a | ||
|
|
99f147219a | ||
|
|
7a13d24e6f | ||
|
|
8dc91755f7 | ||
|
|
96a3104fe2 | ||
|
|
97f525d069 | ||
|
|
4ad1bdec15 | ||
|
|
530d94a4b9 | ||
|
|
141d3e9588 | ||
|
|
98eaadf2d1 | ||
|
|
54a04b5894 | ||
|
|
8bc8709d0e | ||
|
|
730080e6fd | ||
|
|
d4b49cd622 | ||
|
|
7e0586cb55 | ||
|
|
05695a35c7 | ||
|
|
58ffb9d7a5 | ||
|
|
7eb487d998 | ||
|
|
f903ee8acc | ||
|
|
91cbe2e22c | ||
|
|
c45bad9437 | ||
|
|
4aa6afbf47 | ||
|
|
29054e8072 | ||
|
|
060d11e4c2 | ||
|
|
77870508de | ||
|
|
133ad0d355 | ||
|
|
711fe64a51 | ||
|
|
78b5c94cb0 | ||
|
|
95266bdcf8 | ||
|
|
b78879dc18 | ||
|
|
5d29079393 | ||
|
|
b052a57fc8 | ||
|
|
292be33b9d | ||
|
|
0360942942 | ||
|
|
c35d6d2396 | ||
|
|
1c73d8ce2b | ||
|
|
6a539df480 | ||
|
|
1de09ec149 | ||
|
|
a1f785038d | ||
|
|
5d475848a6 | ||
|
|
2695f2da46 | ||
|
|
3cdbf5753d | ||
|
|
daf92be5bc | ||
|
|
79bbb0ee1c | ||
|
|
826bb1abbe | ||
|
|
81789a6930 | ||
|
|
28fb2403d9 | ||
|
|
1872bd344f | ||
|
|
54170d92db | ||
|
|
ec62e871dd | ||
|
|
4ba912cd57 | ||
|
|
7713674ff6 | ||
|
|
0fce440455 | ||
|
|
ab782d8896 | ||
|
|
c84ddefc53 | ||
|
|
5802155882 | ||
|
|
ee8a68f7b2 | ||
|
|
61bbeebfba | ||
|
|
18da183ef7 | ||
|
|
19c6714f06 | ||
|
|
2193193b12 | ||
|
|
850a2d7f79 | ||
|
|
ca5dce5d9f | ||
|
|
40eff3e4a3 | ||
|
|
d334f070a3 | ||
|
|
44e752d737 | ||
|
|
5c83ebd75d | ||
|
|
02ce3031e9 | ||
|
|
2b295a5459 | ||
|
|
6caf8d3d56 | ||
|
|
b18f1e8127 | ||
|
|
3e67916971 | ||
|
|
21cccc00d7 | ||
|
|
4809867b33 | ||
|
|
8bbe518696 | ||
|
|
17b4dc1fc6 | ||
|
|
cca19e921e | ||
|
|
de50a38bb1 | ||
|
|
c2ef58d880 | ||
|
|
eafcb548ce | ||
|
|
ec32d11b76 | ||
|
|
7e97687c9e | ||
|
|
da5a64131f | ||
|
|
71e5278364 | ||
|
|
d6a1faa380 | ||
|
|
166862ecff | ||
|
|
3c133bd677 | ||
|
|
b0b1024f8a | ||
|
|
cc07ff987d | ||
|
|
efc38b87de | ||
|
|
a3a3e4c0dc | ||
|
|
d46bcd5b8f | ||
|
|
dfe00fee94 | ||
|
|
9118f2ce08 | ||
|
|
a0e98b9aa8 | ||
|
|
0d3986abbb | ||
|
|
529b34d84e | ||
|
|
e0fe8476aa | ||
|
|
0ca0180f27 | ||
|
|
21a355c89f | ||
|
|
e528b86a2a | ||
|
|
2e6ee39506 | ||
|
|
894877a0e3 | ||
|
|
6887dd05f6 | ||
|
|
95dbad6ec1 | ||
|
|
ea88ae1a5b | ||
|
|
e8e4d637ef |
2
.gitattributes
vendored
2
.gitattributes
vendored
@@ -1,2 +0,0 @@
|
||||
# Use an approximate language for syntax highlighting (clojure is pretty close)
|
||||
*.janet linguist-language=clojure
|
||||
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -20,6 +20,9 @@ dist
|
||||
.project
|
||||
.cproject
|
||||
|
||||
# Gnome Builder
|
||||
.buildconfig
|
||||
|
||||
# Local directory for testing
|
||||
local
|
||||
|
||||
|
||||
93
CHANGELOG.md
93
CHANGELOG.md
@@ -1,6 +1,99 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.5.0 - 2019-11-10
|
||||
- `os/date` now defaults to UTC.
|
||||
- Add `--test` flag to jpm to test libraries on installation.
|
||||
- Add `math/rng`, `math/rng-int`, and `math/rng-uniform`.
|
||||
- Add `in` function to index in a stricter manner. Opposingly, `get` will
|
||||
now not throw errors on bad keys.
|
||||
- Indexed types and byte sequences will now error when indexed out of range or
|
||||
with bad keys.
|
||||
- Add rng functions to Janet. This also replaces the RNG behind `math/random`
|
||||
and `math/seedrandom` with a consistent, platform independent RNG.
|
||||
- Add `with-vars` macro.
|
||||
- Add the `quickbin` command to jpm.
|
||||
- Create shell.c when making the amlagamated source. This can be compiled with
|
||||
janet.c to make the janet interpreter.
|
||||
- Add `cli-main` function to the core, which invokes Janet's CLI interface.
|
||||
This basically moves what was init.janet into boot.janet.
|
||||
- Improve flychecking, and fix flyching bugs introduced in 1.4.0.
|
||||
- Add `prin`, `eprint`, `eprintf` and `eprin` functions. The
|
||||
functions prefix with e print to `(dyn :err stderr)`
|
||||
- Print family of functions can now also print to buffers
|
||||
(before, they could only print to files.) Output can also
|
||||
be completely disabled with `(setdyn :out false)`.
|
||||
- `printf` is now a c function for optimizations in the case
|
||||
of printing to buffers.
|
||||
|
||||
## 1.4.0 - 2019-10-14
|
||||
- Add `quit` function to exit from a repl, but not always exit the entire
|
||||
application.
|
||||
- Add `update-pkgs` to jpm.
|
||||
- Integrate jpm with https://github.com/janet-lang/pkgs.git. jpm can now
|
||||
install packages based on their short names in the package listing, which
|
||||
can be customized via an env variable.
|
||||
- Add `varfn` macro
|
||||
- Add compile time arity checking when function in function call is known.
|
||||
- Added `slice` to the core library.
|
||||
- The `*/slice` family of functions now can take nil as start or end to get
|
||||
the same behavior as the defaults (0 and -1) for those parameters.
|
||||
- `string/` functions that take a pattern to search for will throw an error
|
||||
when receiving the empty string.
|
||||
- Replace (start:end) style stacktrace source position information with
|
||||
line, column. This should be more readable for humans. Also, range information
|
||||
can be recovered by re-parsing source.
|
||||
|
||||
## 1.3.1 - 2019-09-21
|
||||
- Fix some linking issues when creating executables with native dependencies.
|
||||
- jpm now runs each test script in a new interpreter.
|
||||
- Fix an issue that prevent some valid programs from compiling.
|
||||
- Add `mean` to core.
|
||||
- Abstract types that implement the `:+`, `:-`, `:*`, `:/`, `:>`, `:==`, `:<`,
|
||||
`:<=`, and `:>=` methods will work with the corresponding built-in
|
||||
arithmetic functions. This means built-in integer types can now be used as
|
||||
normal number values in many contexts.
|
||||
- Allow (length x) on typed arrays an other abstract types that implement
|
||||
the :length method.
|
||||
|
||||
## 1.3.0 - 2019-09-05
|
||||
- Add `get-in`, `put-in`, `update-in`, and `freeze` to core.
|
||||
- Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm.
|
||||
- Remove `cook` module and move `path` module to https://github.com/janet-lang/path.git.
|
||||
The functionality in `cook` is now bundled directly in the `jpm` script.
|
||||
- Add `buffer/format` and `string/format` format flags `Q` and `q` to print colored and
|
||||
non-colored single-line values, similar to `P` and `p`.
|
||||
- Change default repl to print long sequences on one line and color stacktraces if color is enabled.
|
||||
- Add `backmatch` pattern for PEGs.
|
||||
- jpm detects if not in a Developer Command prompt on windows for a better error message.
|
||||
- jpm install git submodules in dependencies
|
||||
- Change default fiber stack limit to the maximum value of a 32 bit signed integer.
|
||||
- Some bug fixes with `jpm`
|
||||
- Fix bugs with pegs.
|
||||
- Add `os/arch` to get ISA that janet was compiled for
|
||||
- Add color to stacktraces via `(dyn :err-color)`
|
||||
|
||||
## 1.2.0 - 2019-08-08
|
||||
- Add `take` and `drop` functions that are easier to use compared to the
|
||||
existing slice functions.
|
||||
- Add optional default value to `get`.
|
||||
- Add function literal short-hand via `|` reader macro, which maps to the
|
||||
`short-fn` macro.
|
||||
- Add `int?` and `nat?` functions to the core.
|
||||
- Add `(dyn :executable)` at top level to get what used to be
|
||||
`(process/args 0)`.
|
||||
- Add `:linux` to platforms returned by `(os/which)`.
|
||||
- Update jpm to build standalone executables. Use `declare-executable` for this.
|
||||
- Add `use` macro.
|
||||
- Remove `process/args` in favor of `(dyn :args)`.
|
||||
- Fix bug with Nanbox implementation allowing users to created
|
||||
custom values of any type with typed array and marshal modules, which
|
||||
was unsafe.
|
||||
- Add `janet_wrap_number_safe` to API, for converting numbers to Janets
|
||||
where the number could be any 64 bit, user provided bit pattern. Certain
|
||||
NaN values (which a machine will never generate as a result of a floating
|
||||
point operation) are guarded against and converted to a default NaN value.
|
||||
|
||||
## 1.1.0 - 2019-07-08
|
||||
- Change semantics of `-l` flag to be import rather than dofile.
|
||||
- Fix compiler regression in top level defs with destructuring.
|
||||
|
||||
109
Makefile
109
Makefile
@@ -24,32 +24,37 @@
|
||||
|
||||
PREFIX?=/usr/local
|
||||
|
||||
INCLUDEDIR=$(PREFIX)/include
|
||||
BINDIR=$(PREFIX)/bin
|
||||
LIBDIR=$(PREFIX)/lib
|
||||
INCLUDEDIR?=$(PREFIX)/include
|
||||
BINDIR?=$(PREFIX)/bin
|
||||
LIBDIR?=$(PREFIX)/lib
|
||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||
CLIBS=-lm
|
||||
JANET_TARGET=build/janet
|
||||
JANET_LIBRARY=build/libjanet.so
|
||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||
JANET_PATH?=$(PREFIX)/lib/janet
|
||||
JANET_PATH?=$(LIBDIR)/janet
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fpic -O2 -fvisibility=hidden \
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
LDFLAGS=-rdynamic
|
||||
|
||||
# For installation
|
||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
||||
|
||||
# Check OS
|
||||
UNAME:=$(shell uname -s)
|
||||
ifeq ($(UNAME), Darwin)
|
||||
CLIBS:=$(CLIBS) -ldl
|
||||
LDCONFIG:=
|
||||
else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME),Haiku)
|
||||
ifeq ($(UNAME), Haiku)
|
||||
LDCONFIG:=
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
@@ -135,14 +140,14 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/core_image.c: build/janet_boot
|
||||
build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet
|
||||
build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
##########################################################
|
||||
|
||||
JANET_CORE_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_CORE_SOURCES)) build/core_image.o
|
||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES)) build/init.gen.o
|
||||
JANET_MAINCLIENT_OBJECTS=$(patsubst src/%.c,build/%.o,$(JANET_MAINCLIENT_SOURCES))
|
||||
|
||||
# Compile the core image generated by the bootstrap build
|
||||
build/core_image.o: build/core_image.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS)
|
||||
@@ -199,8 +204,6 @@ emscripten: $(JANET_EMTARGET)
|
||||
build/xxd: tools/xxd.c
|
||||
$(CC) $< -o $@
|
||||
|
||||
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
|
||||
@@ -210,15 +213,22 @@ build/boot.gen.c: src/boot/boot.janet build/xxd
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
amalg: build/janet.c build/janet.h build/core_image.c
|
||||
amalg: build/shell.c build/janet.c build/janet.h build/core_image.c build/janetconf.h
|
||||
|
||||
AMALG_SOURCE=$(JANET_LOCAL_HEADERS) $(JANET_CORE_SOURCES) build/core_image.c
|
||||
build/janet.c: $(AMALG_SOURCE) tools/amalg.janet $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SOURCE) > $@
|
||||
|
||||
AMALG_SHELL_SOURCE=src/mainclient/line.h src/mainclient/line.c src/mainclient/main.c
|
||||
build/shell.c: $(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE)
|
||||
$(JANET_TARGET) tools/amalg.janet $(AMALG_SHELL_SOURCE) > $@
|
||||
|
||||
build/janet.h: src/include/janet.h
|
||||
cp $< $@
|
||||
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
###################
|
||||
##### Testing #####
|
||||
###################
|
||||
@@ -238,9 +248,11 @@ valgrind: $(JANET_TARGET)
|
||||
|
||||
test: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do ./$(JANET_TARGET) "$$f" || exit; done
|
||||
$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
valtest: $(JANET_TARGET) $(TEST_PROGRAMS)
|
||||
for f in test/suite*.janet; do $(VALGRIND_COMMAND) ./$(JANET_TARGET) "$$f" || exit; done
|
||||
$(VALGRIND_COMMAND) ./$(JANET_TARGET) -k auxbin/jpm
|
||||
|
||||
callgrind: $(JANET_TARGET)
|
||||
for f in test/suite*.janet; do valgrind --tool=callgrind ./$(JANET_TARGET) "$$f" || exit; done
|
||||
@@ -253,9 +265,12 @@ dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/conf/janetconf.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c
|
||||
tar -czvf $@ $^
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c auxbin/jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
|
||||
|
||||
#########################
|
||||
##### Documentation #####
|
||||
@@ -272,9 +287,8 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||
mkdir -p $(PKG_CONFIG_PATH)
|
||||
.PHONY: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||
@@ -288,31 +302,34 @@ $(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
|
||||
mkdir -p $(BINDIR)
|
||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||
mkdir -p $(INCLUDEDIR)/janet
|
||||
cp -rf $(JANET_HEADERS) $(INCLUDEDIR)/janet
|
||||
mkdir -p $(JANET_PATH)
|
||||
mkdir -p $(LIBDIR)
|
||||
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')
|
||||
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
|
||||
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
mkdir -p '$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(BINDIR)/janet'
|
||||
mkdir -p '$(INCLUDEDIR)/janet'
|
||||
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
|
||||
mkdir -p '$(JANET_PATH)'
|
||||
mkdir -p '$(LIBDIR)'
|
||||
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
||||
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||
cp -rf auxlib/* $(JANET_PATH)
|
||||
cp -rf auxbin/* $(BINDIR)
|
||||
mkdir -p $(MANPATH)
|
||||
cp janet.1 $(MANPATH)
|
||||
-ldconfig $(LIBDIR)
|
||||
cp -rf auxbin/* '$(BINDIR)'
|
||||
mkdir -p '$(MANPATH)'
|
||||
cp janet.1 '$(MANPATH)'
|
||||
cp jpm.1 '$(MANPATH)'
|
||||
mkdir -p '$(PKG_CONFIG_PATH)'
|
||||
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-$(LDCONFIG)
|
||||
|
||||
uninstall:
|
||||
-rm $(BINDIR)/janet
|
||||
-rm $(BINDIR)/jpm
|
||||
-rm -rf $(INCLUDEDIR)/janet
|
||||
-rm -rf $(LIBDIR)/libjanet.*
|
||||
-rm $(PKG_CONFIG_PATH)/janet.pc
|
||||
-rm $(MANPATH)/janet.1
|
||||
# -rm -rf $(JANET_PATH)/* - err on the side of correctness here
|
||||
-rm '$(BINDIR)/janet'
|
||||
-rm '$(BINDIR)/jpm'
|
||||
-rm -rf '$(INCLUDEDIR)/janet'
|
||||
-rm -rf '$(LIBDIR)'/libjanet.*
|
||||
-rm '$(PKG_CONFIG_PATH)/janet.pc'
|
||||
-rm '$(MANPATH)/janet.1'
|
||||
-rm '$(MANPATH)/jpm.1'
|
||||
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
@@ -329,7 +346,17 @@ clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
|
||||
test-install:
|
||||
cd test/install && rm -rf build && jpm build && jpm test
|
||||
cd test/install \
|
||||
&& rm -rf build .cache .manifests \
|
||||
&& jpm --verbose build \
|
||||
&& jpm --verbose test \
|
||||
&& build/testexec \
|
||||
&& jpm --verbose quickbin testexec.janet build/testexec2 \
|
||||
&& build/testexec2 \
|
||||
&& jpm --verbose --testdeps --modpath=. install https://github.com/janet-lang/json.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
cd test/install && jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
|
||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
|
||||
29
README.md
29
README.md
@@ -4,7 +4,6 @@
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||
<noscript><a href="https://liberapay.com/Janet-Language/donate"><img alt="Donate using Liberapay" src="https://liberapay.com/assets/widgets/donate.svg"></a></noscript>
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
@@ -62,7 +61,7 @@ documentation for symbols in the core library. For example,
|
||||
Shows documentation for the doc macro.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-symbols)` function.
|
||||
environment, use the `(all-bindings)` function.
|
||||
|
||||
## Source
|
||||
|
||||
@@ -132,6 +131,32 @@ is maybe more convenient and flexible for integrating into existing pipelines.
|
||||
Meson also provides much better IDE integration than Make or batch files, as well as support
|
||||
for cross compilation.
|
||||
|
||||
For the impatient, building with Meson is as simple as follows. The options provided to
|
||||
`meson setup` below emulate Janet's Makefile.
|
||||
|
||||
```sh
|
||||
git clone https://github.com/janet-lang/janet.git
|
||||
cd janet
|
||||
meson setup build \
|
||||
--buildtype release \
|
||||
--optimization 2 \
|
||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
||||
ninja -C build
|
||||
|
||||
# Run the binary
|
||||
build/janet
|
||||
|
||||
# Installation
|
||||
ninja -C build install
|
||||
```
|
||||
|
||||
## Development
|
||||
|
||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
||||
best option, as it has excellent meson integration. It also offers code completion
|
||||
for Janet's C API right out of the box, which is very useful for exploring.
|
||||
|
||||
## Installation
|
||||
|
||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
||||
|
||||
47
appveyor.yml
47
appveyor.yml
@@ -1,12 +1,13 @@
|
||||
version: build-{build}
|
||||
clone_folder: c:\projects\janet
|
||||
image:
|
||||
- Visual Studio 2017
|
||||
- Visual Studio 2019
|
||||
configuration:
|
||||
- Release
|
||||
- Debug
|
||||
platform:
|
||||
- x64
|
||||
- x86
|
||||
environment:
|
||||
matrix:
|
||||
- arch: Win64
|
||||
@@ -15,25 +16,41 @@ matrix:
|
||||
|
||||
# skip unsupported combinations
|
||||
init:
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat"
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
|
||||
install:
|
||||
- build_win
|
||||
- build_win test
|
||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
||||
- choco install nsis -y -pre
|
||||
- build_win dist
|
||||
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
|
||||
# Replace makensis.exe and files with special long string build. This should
|
||||
# prevent issues when setting PATH during installation.
|
||||
- 7z e "tools\nsis-3.04-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
||||
- build_win all
|
||||
- refreshenv
|
||||
# We need to reload vcvars after refreshing
|
||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvarsall.bat" %platform%
|
||||
- build_win test-install
|
||||
- set janet_outname=%appveyor_repo_tag_name%
|
||||
- if "%janet_outname%"=="" set janet_outname=v1.5.0
|
||||
build: off
|
||||
|
||||
only_commits:
|
||||
files:
|
||||
- appveyor.yml
|
||||
- src/
|
||||
|
||||
artifacts:
|
||||
- path: janet-installer.exe
|
||||
name: janet-v1.1.0-windows-installer.exe
|
||||
- name: janet.c
|
||||
path: dist\janet.c
|
||||
type: File
|
||||
- name: janet.h
|
||||
path: dist\janet.h
|
||||
type: File
|
||||
- name: janetconf.h
|
||||
path: dist\janetconf.h
|
||||
type: File
|
||||
- name: shell.c
|
||||
path: dist\shell.c
|
||||
type: File
|
||||
- name: "janet-$(janet_outname)-windows-%platform%"
|
||||
path: dist
|
||||
type: Zip
|
||||
- path: "janet-$(janet_outname)-windows-%platform%-installer.exe"
|
||||
name: "janet-$(janet_outname)-windows-installer.exe"
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
@@ -41,7 +58,7 @@ deploy:
|
||||
provider: GitHub
|
||||
auth_token:
|
||||
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
|
||||
artifact: janet-windows
|
||||
artifact: /janet.*/
|
||||
draft: true
|
||||
on:
|
||||
APPVEYOR_REPO_TAG: true
|
||||
|
||||
917
auxbin/jpm
917
auxbin/jpm
@@ -1,96 +1,941 @@
|
||||
#!/usr/bin/env janet
|
||||
|
||||
# CLI tool for building janet projects. Wraps cook.
|
||||
# CLI tool for building janet projects.
|
||||
|
||||
(import cook)
|
||||
#
|
||||
# Basic Path Settings
|
||||
#
|
||||
|
||||
# Windows is the OS outlier
|
||||
(def- is-win (= (os/which) :windows))
|
||||
(def- is-mac (= (os/which) :macos))
|
||||
(def- sep (if is-win "\\" "/"))
|
||||
(def- objext (if is-win ".obj" ".o"))
|
||||
(def- modext (if is-win ".dll" ".so"))
|
||||
(def- statext (if is-win ".static.lib" ".a"))
|
||||
(def- absprefix (if is-win "C:\\" "/"))
|
||||
|
||||
#
|
||||
# Rule Engine
|
||||
#
|
||||
|
||||
(defn- getrules []
|
||||
(if-let [rules (dyn :rules)] rules (setdyn :rules @{})))
|
||||
|
||||
(defn- gettarget [target]
|
||||
(def item ((getrules) target))
|
||||
(unless item (error (string "No rule for target " target)))
|
||||
item)
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(put (getrules) target @[(array/slice deps) thunk phony]))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
||||
|
||||
(defmacro phony
|
||||
"Add a phony rule to the rule graph. A phony rule will run every time
|
||||
(it is always considered out of date). Phony rules are good for defining
|
||||
user facing tasks."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target dep]
|
||||
(def [deps] (gettarget target))
|
||||
(array/push deps dep))
|
||||
|
||||
(defn- add-thunk
|
||||
[target more]
|
||||
(def item (gettarget target))
|
||||
(def [_ thunk] item)
|
||||
(put item 1 (fn [] (more) (thunk))))
|
||||
|
||||
(defmacro add-body
|
||||
"Add recipe code to an existing rule. This makes existing rules do more but
|
||||
does not modify the dependency graph."
|
||||
[target & body]
|
||||
~(,add-thunk ,target (fn [] ,;body)))
|
||||
|
||||
(defn- needs-build
|
||||
[dest src]
|
||||
(let [mod-dest (os/stat dest :modified)
|
||||
mod-src (os/stat src :modified)]
|
||||
(< mod-dest mod-src)))
|
||||
|
||||
(defn- needs-build-some
|
||||
[dest sources]
|
||||
(def f (file/open dest))
|
||||
(if (not f) (break true))
|
||||
(file/close f)
|
||||
(some (partial needs-build dest) sources))
|
||||
|
||||
(defn do-rule
|
||||
"Evaluate a given rule."
|
||||
[target]
|
||||
(def item ((getrules) target))
|
||||
(unless item
|
||||
(if (os/stat target :mode)
|
||||
(break target)
|
||||
(error (string "No rule for file " target " found."))))
|
||||
(def [deps thunk phony] item)
|
||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||
(when (or phony (needs-build-some target realdeps))
|
||||
(thunk))
|
||||
(unless phony target))
|
||||
|
||||
#
|
||||
# Configuration
|
||||
#
|
||||
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../include/janet"))))
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/../../bin"))))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(if-let [j (dyn :syspath)]
|
||||
(string j "/.."))))
|
||||
|
||||
#
|
||||
# Compilation Defaults
|
||||
#
|
||||
|
||||
(def default-compiler (if is-win "cl" "cc"))
|
||||
(def default-linker (if is-win "link" "cc"))
|
||||
(def default-archiver (if is-win "lib" "ar"))
|
||||
|
||||
# Default flags for natives, but not required
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
(def default-cflags
|
||||
(if is-win
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
# are used no matter what for dynamic libraries.
|
||||
(def- dynamic-cflags
|
||||
(if is-win
|
||||
["/LD"]
|
||||
["-fPIC"]))
|
||||
(def- dynamic-lflags
|
||||
(if is-win
|
||||
["/DLL"]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup"]
|
||||
["-shared"])))
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key dflt]
|
||||
(def ret (or (opts key) (dyn key dflt)))
|
||||
(if (= nil ret)
|
||||
(error (string "option :" key " not set")))
|
||||
ret)
|
||||
|
||||
(defn check-cc
|
||||
"Ensure we have a c compiler"
|
||||
[]
|
||||
(if is-win
|
||||
(do
|
||||
(if (os/getenv "INCLUDE") (break))
|
||||
(error "Run jpm inside a Developer Command Prompt.
|
||||
jpm needs a c compiler to compile natives. You can install the MSVC compiler from
|
||||
microsoft.com"))
|
||||
(do)))
|
||||
|
||||
#
|
||||
# Importing a file
|
||||
#
|
||||
|
||||
(def- _env (fiber/getenv (fiber/current)))
|
||||
|
||||
(defn- proto-flatten
|
||||
[into x]
|
||||
(when x
|
||||
(proto-flatten into (table/getproto x))
|
||||
(loop [k :keys x]
|
||||
(put into k (x k))))
|
||||
into)
|
||||
|
||||
(defn import-rules
|
||||
"Import another file that defines more rules. This ruleset
|
||||
is merged into the current ruleset."
|
||||
[path]
|
||||
(def env (make-env))
|
||||
(unless (os/stat path :mode)
|
||||
(error (string "cannot open " path)))
|
||||
(loop [k :keys _env :when (symbol? k)]
|
||||
(unless ((_env k) :private) (put env k (_env k))))
|
||||
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
|
||||
(loop [k :keys currenv :when (keyword? k)]
|
||||
(put env k (currenv k)))
|
||||
(dofile path :env env :exit true)
|
||||
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
||||
|
||||
#
|
||||
# OS and shell helpers
|
||||
#
|
||||
|
||||
(def- path-splitter
|
||||
"split paths on / and \\."
|
||||
(peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1)))))
|
||||
|
||||
(def- filepath-replacer
|
||||
"Convert url with potential bad characters into a file path element."
|
||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
||||
|
||||
(defn filepath-replace
|
||||
"Remove special characters from a string or path
|
||||
to make it into a path segment."
|
||||
[repo]
|
||||
(get (peg/match filepath-replacer repo) 0))
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(if (dyn :verbose)
|
||||
(print ;(interpose " " args)))
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(shell "xcopy" src dest "/y" "/s" "/e")
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
#
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all "\\" "___")
|
||||
(string/replace-all "/" "___")
|
||||
(string/replace-all ".janet" "")))
|
||||
|
||||
(defn- out-path
|
||||
"Take a source file path and convert it to an output path."
|
||||
[path from-ext to-ext]
|
||||
(->> path
|
||||
(string/replace-all "\\" "___")
|
||||
(string/replace-all "/" "___")
|
||||
(string/replace-all from-ext to-ext)
|
||||
(string "build" sep)))
|
||||
|
||||
(defn- make-define
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(if value
|
||||
(string (if is-win "/D" "-D") define "=" value)
|
||||
(string (if is-win "/D" "-D") define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
||||
[defines]
|
||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||
|
||||
(defn- getcflags
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
@[;(opt opts :cflags default-cflags)
|
||||
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
|
||||
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
"Name of symbol that enters static compilation of a module."
|
||||
[name]
|
||||
(string "janet_module_entry_" (filepath-replace name)))
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest &opt static?]
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
|
||||
(def entry-defines (if-let [n (opts :entry-name)]
|
||||
[(make-define "JANET_ENTRY_NAME" n)]
|
||||
[]))
|
||||
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
|
||||
(def headers (or (opts :headers) []))
|
||||
(rule dest [src ;headers]
|
||||
(check-cc)
|
||||
(print "compiling " dest "...")
|
||||
(if is-win
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn- libjanet
|
||||
"Find libjanet.a (or libjanet.lib on windows) at compile time"
|
||||
[]
|
||||
(def libpath (dyn :libpath JANET_LIBPATH))
|
||||
(unless libpath
|
||||
(error "cannot find libpath: provide --libpath or JANET_LIBPATH"))
|
||||
(string (dyn :libpath JANET_LIBPATH)
|
||||
sep
|
||||
(if is-win "libjanet.lib" "libjanet.a")))
|
||||
|
||||
(defn- win-import-library
|
||||
"On windows, an import library is needed to link to a dll statically."
|
||||
[]
|
||||
(def hpath (dyn :headerpath JANET_HEADERPATH))
|
||||
(unless hpath
|
||||
(error "cannot find headerpath: provide --headerpath or JANET_HEADERPATH"))
|
||||
(string hpath `\\janet.lib`))
|
||||
|
||||
(defn- link-c
|
||||
"Link object files together to make a native module."
|
||||
[opts target & objects]
|
||||
(def ld (opt opts :linker default-linker))
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags [;(opt opts :lflags default-lflags)
|
||||
;(if (opts :static) [] dynamic-lflags)])
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "linking " target "...")
|
||||
(if is-win
|
||||
(shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
||||
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- archive-c
|
||||
"Link object files together to make a static library."
|
||||
[opts target & objects]
|
||||
(def ar (opt opts :archiver default-archiver))
|
||||
(rule target objects
|
||||
(check-cc)
|
||||
(print "creating static library " target "...")
|
||||
(if is-win
|
||||
(shell ar "/nologo" (string "/out:" target) ;objects)
|
||||
(shell ar "rcs" target ;objects))))
|
||||
|
||||
(defn- create-buffer-c-impl
|
||||
[bytes dest name]
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in bytes] (string b)))
|
||||
(file/write out
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
(string/join (interpose ", " chunks))
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(rule dest [source]
|
||||
(print "generating " dest "...")
|
||||
(with [f (file/open source :r)]
|
||||
(create-buffer-c-impl (:read f :all) dest name))))
|
||||
|
||||
(def- root-env (table/getproto (fiber/getenv (fiber/current))))
|
||||
|
||||
(defn- modpath-to-meta
|
||||
"Get the meta file path (.meta.janet) corresponding to a native module path (.so)."
|
||||
[path]
|
||||
(string (string/slice path 0 (- (length modext))) "meta.janet"))
|
||||
|
||||
(defn- modpath-to-static
|
||||
"Get the static library (.a) path corresponding to a native module path (.so)."
|
||||
[path]
|
||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
||||
|
||||
(defn- create-executable
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
(rule dest [source]
|
||||
(check-cc)
|
||||
(print "generating executable c source...")
|
||||
# Load entry environment and get main function.
|
||||
(def entry-env (dofile source))
|
||||
(def main ((entry-env 'main) :value))
|
||||
(def dep-lflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict (invert (env-lookup root-env)))
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
(loop [[name m] :pairs module/cache
|
||||
:let [n (m :native)]
|
||||
:when n
|
||||
:let [prefix (gensym)]]
|
||||
(print "found native " n "...")
|
||||
(put prefixes prefix n)
|
||||
(array/push static-libs (modpath-to-static n))
|
||||
(def oldproto (table/getproto m))
|
||||
(table/setproto m nil)
|
||||
(loop [[sym value] :pairs (env-lookup m)]
|
||||
(put mdict value (symbol prefix sym)))
|
||||
(table/setproto m oldproto))
|
||||
|
||||
# Find static modules
|
||||
(def declarations @"")
|
||||
(def lookup-into-invocations @"")
|
||||
(loop [[prefix name] :pairs prefixes]
|
||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||
(buffer/push-string lookup-into-invocations
|
||||
" temptab = janet_table(0);\n"
|
||||
" temptab->proto = env;\n"
|
||||
" " (meta :static-entry) "(temptab);\n"
|
||||
" janet_env_lookup_into(lookup, temptab, \""
|
||||
prefix
|
||||
"\", 0);\n\n")
|
||||
(when-let [lfs (meta :lflags)]
|
||||
(array/concat dep-lflags lfs))
|
||||
(buffer/push-string declarations
|
||||
"extern void "
|
||||
(meta :static-entry)
|
||||
"(JanetTable *);\n"))
|
||||
|
||||
|
||||
# Build image
|
||||
(def image (marshal main mdict))
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (string
|
||||
"\n"
|
||||
declarations
|
||||
```
|
||||
|
||||
int main(int argc, const char **argv) {
|
||||
janet_init();
|
||||
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
JanetTable *lookup = janet_env_lookup(env);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
|
||||
/* Load natives into unmarshalling dictionary */
|
||||
|
||||
```
|
||||
lookup-into-invocations
|
||||
```
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
janet_payload_image_embed,
|
||||
janet_payload_image_embed_size,
|
||||
0,
|
||||
lookup,
|
||||
NULL);
|
||||
|
||||
/* Verify the marshalled object is a function */
|
||||
if (!janet_checktype(marsh_out, JANET_FUNCTION)) {
|
||||
fprintf(stderr, "invalid bytecode image - expected function.");
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Collect command line arguments */
|
||||
JanetArray *args = janet_array(argc);
|
||||
for (int i = 0; i < argc; i++) {
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
}
|
||||
|
||||
/* Create enviornment */
|
||||
temptab = janet_table(0);
|
||||
temptab = env;
|
||||
janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args));
|
||||
janet_gcroot(janet_wrap_table(temptab));
|
||||
|
||||
/* Unlock GC */
|
||||
janet_gcunlock(handle);
|
||||
|
||||
/* Run everything */
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(marsh_out), 64, argc, args->data);
|
||||
fiber->env = temptab;
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (result) {
|
||||
janet_stacktrace(fiber, out);
|
||||
janet_deinit();
|
||||
return result;
|
||||
}
|
||||
janet_deinit();
|
||||
return 0;
|
||||
}
|
||||
|
||||
```) :ab)
|
||||
|
||||
# Compile and link final exectable
|
||||
(do
|
||||
(def extra-lflags (case (os/which)
|
||||
:macos ["-ldl" "-lm"]
|
||||
:windows []
|
||||
:linux ["-lm" "-ldl" "-lrt"]
|
||||
#default
|
||||
["-lm"]))
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
|
||||
(def cflags (getcflags opts))
|
||||
(def defines (make-defines (opt opts :defines {})))
|
||||
(print "compiling and linking " dest "...")
|
||||
(if is-win
|
||||
(shell cc ;cflags cimage_dest ;static-libs (libjanet) ;lflags `/link` (string "/OUT:" dest))
|
||||
(shell cc ;cflags `-o` dest cimage_dest ;static-libs (libjanet) ;lflags)))))
|
||||
|
||||
(defn- abspath
|
||||
"Create an absolute path. Does not resolve . and .. (useful for
|
||||
generating entries in install manifest file)."
|
||||
[path]
|
||||
(if (if is-win
|
||||
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
|
||||
(string/has-prefix? "/" path))
|
||||
path
|
||||
(string (os/cwd) sep path)))
|
||||
|
||||
#
|
||||
# Public utilities
|
||||
#
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
[]
|
||||
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
|
||||
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name]
|
||||
(string (find-manifest-dir) sep name ".txt"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
[]
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(string path sep ".cache"))
|
||||
|
||||
(defn uninstall
|
||||
"Uninstall bundle named name"
|
||||
[name]
|
||||
(def manifest (find-manifest name))
|
||||
(def f (file/open manifest :r))
|
||||
(unless f (print manifest " does not exist") (break))
|
||||
(loop [line :iterate (:read f :line)]
|
||||
(def path ((string/split "\n" line) 0))
|
||||
(def path ((string/split "\r" path) 0))
|
||||
(print "removing " path)
|
||||
(try (rm path) ([err]
|
||||
(unless (= err "No such file or directory")
|
||||
(error err)))))
|
||||
(:close f)
|
||||
(print "removing " manifest)
|
||||
(rm manifest)
|
||||
(print "Uninstalled."))
|
||||
|
||||
(defn clear-cache
|
||||
"Clear the global git cache."
|
||||
[]
|
||||
(def cache (find-cache))
|
||||
(print "clearing " cache "...")
|
||||
(if is-win
|
||||
# Git for windows decided that .git should be hidden and everything in it read-only.
|
||||
# This means we can't delete things easily.
|
||||
(os/shell (string `rmdir /S /Q "` cache `"`))
|
||||
(rm cache)))
|
||||
|
||||
(def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
||||
|
||||
(defn install-git
|
||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
[repotab &opt recurse]
|
||||
(def repo (if (string? repotab) repotab (repotab :repo)))
|
||||
(def tag (unless (string? repotab) (repotab :tag)))
|
||||
# prevent infinite recursion (very unlikely, but consider
|
||||
# 'my-package "my-package" in the package listing)
|
||||
(when (> (or recurse 0) 100)
|
||||
(error "too many references resolving package url"))
|
||||
# Handle short names
|
||||
(unless (string/find ":" repo)
|
||||
(def pkgs
|
||||
(try (require "pkgs")
|
||||
([err f]
|
||||
(install-git (dyn :pkglist default-pkglist))
|
||||
(require "pkgs"))))
|
||||
(def next-repo (get-in pkgs ['packages :value (symbol repo)]))
|
||||
(unless next-repo
|
||||
(error (string "package " repo " not found.")))
|
||||
(unless (or (string? next-repo) (dictionary? next-repo))
|
||||
(error (string "expected string or table for repository, got " next-repo)))
|
||||
(break (install-git next-repo (if recurse (inc recurse) 0))))
|
||||
(def cache (find-cache))
|
||||
(os/mkdir cache)
|
||||
(def id (filepath-replace repo))
|
||||
(def module-dir (string cache sep id))
|
||||
(var fresh false)
|
||||
(when (os/mkdir module-dir)
|
||||
(set fresh true)
|
||||
(os/execute ["git" "clone" repo module-dir] :p))
|
||||
(def olddir (os/cwd))
|
||||
(try
|
||||
(with-dyns [:rules @{}
|
||||
:modpath (abspath (dyn :modpath JANET_MODPATH))
|
||||
:headerpath (abspath (dyn :headerpath JANET_HEADERPATH))
|
||||
:libpath (abspath (dyn :libpath JANET_LIBPATH))
|
||||
:binpath (abspath (dyn :binpath JANET_BINPATH))]
|
||||
(os/cd module-dir)
|
||||
(unless fresh
|
||||
(os/execute ["git" "pull" "origin" "master"] :p))
|
||||
(when tag
|
||||
(os/execute ["git" "reset" "--hard" tag] :p))
|
||||
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
|
||||
(import-rules "./project.janet")
|
||||
(do-rule "install-deps")
|
||||
(do-rule "build")
|
||||
(do-rule "install"))
|
||||
([err] (print "Error building git repository dependency: " err)))
|
||||
(os/cd olddir))
|
||||
|
||||
(defn install-rule
|
||||
"Add install and uninstall rule for moving file from src into destdir."
|
||||
[src destdir]
|
||||
(def parts (peg/match path-splitter src))
|
||||
(def name (last parts))
|
||||
(def path (string destdir sep name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(add-body "install"
|
||||
(os/mkdir destdir)
|
||||
(copy src destdir)))
|
||||
|
||||
#
|
||||
# Declaring Artifacts - used in project.janet, targets specifically
|
||||
# tailored for janet.
|
||||
#
|
||||
|
||||
(defn declare-native
|
||||
"Declare a native module. This is a shared library that can be loaded
|
||||
dynamically by a janet runtime. This also builds a static libary that
|
||||
can be used to bundle janet code and native into a single executable."
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def name (opts :name))
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
|
||||
# Make dynamic module
|
||||
(def lname (string "build" sep name modext))
|
||||
(loop [src :in sources]
|
||||
(compile-c opts src (out-path src ".c" objext)))
|
||||
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
(def o-src (out-path src ".janet" (if is-win ".janet.obj" ".janet.o")))
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opts c-src o-src)))
|
||||
(link-c opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(install-rule lname path)
|
||||
|
||||
# Add meta file
|
||||
(def metaname (modpath-to-meta lname))
|
||||
(def ename (entry-name name))
|
||||
(rule metaname []
|
||||
(print "generating meta file " metaname "...")
|
||||
(spit metaname (string/format
|
||||
"# Metadata for static library %s\n\n%.20p"
|
||||
(string name statext)
|
||||
{:static-entry ename
|
||||
:lflags (opts :lflags)})))
|
||||
(add-dep "build" metaname)
|
||||
(install-rule metaname path)
|
||||
|
||||
# Make static module
|
||||
(unless (dyn :nostatic)
|
||||
(def sname (string "build" sep name statext))
|
||||
(def opts (merge @{:entry-name ename} opts))
|
||||
(def sobjext (string ".static" objext))
|
||||
(def sjobjext (string ".janet" sobjext))
|
||||
(loop [src :in sources]
|
||||
(compile-c opts src (out-path src ".c" sobjext) true))
|
||||
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
(def o-src (out-path src ".janet" sjobjext))
|
||||
(array/push sobjects o-src)
|
||||
# Buffer c-src is already declared by dynamic module
|
||||
(compile-c opts c-src o-src true)))
|
||||
(archive-c opts sname ;sobjects)
|
||||
(add-dep "build" sname)
|
||||
(install-rule sname path)))
|
||||
|
||||
(defn declare-source
|
||||
"Create a Janet modules. This does not actually build the module(s),
|
||||
but registers it for packaging and installation."
|
||||
[&keys {:source sources}]
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(if (bytes? sources)
|
||||
(install-rule sources path)
|
||||
(each s sources
|
||||
(install-rule s path))))
|
||||
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys {:main main}]
|
||||
(install-rule main (dyn :binpath JANET_BINPATH)))
|
||||
|
||||
(defn declare-executable
|
||||
"Declare a janet file to be the entry of a standalone executable program. The entry
|
||||
file is evaluated and a main function is looked for in the entry file. This function
|
||||
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
(when install
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (dyn :binpath JANET_BINPATH))
|
||||
(install-rule main binpath)
|
||||
# Create a dud batch file when on windows.
|
||||
(when is-win
|
||||
(def name (last (peg/match path-splitter main)))
|
||||
(def fullname (string binpath sep name))
|
||||
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
|
||||
(def newname (string binpath sep name ".bat"))
|
||||
(array/push (dyn :installed-files) newname)
|
||||
(add-body "install"
|
||||
(spit newname bat))))
|
||||
|
||||
(defn declare-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
a janet vm and the required dependencies and run there."
|
||||
[&keys opts]
|
||||
(def entry (opts :entry))
|
||||
(def name (opts :name))
|
||||
(def iname (string "build" sep name ".jimage"))
|
||||
(rule iname (or (opts :deps) [])
|
||||
(spit iname (make-image (require entry))))
|
||||
(def path (dyn :modpath JANET_MODPATH))
|
||||
(add-dep "build" iname)
|
||||
(install-rule iname path))
|
||||
|
||||
(defn declare-project
|
||||
"Define your project metadata. This should
|
||||
be the first declaration in a project.janet file.
|
||||
Also sets up basic phony targets like clean, build, test, etc."
|
||||
[&keys meta]
|
||||
(setdyn :project meta)
|
||||
|
||||
(def installed-files @[])
|
||||
(def manifests (find-manifest-dir))
|
||||
(def manifest (find-manifest (meta :name)))
|
||||
(setdyn :manifest manifest)
|
||||
(setdyn :manifest-dir manifests)
|
||||
(setdyn :installed-files installed-files)
|
||||
|
||||
(rule "./build" [] (os/mkdir "build"))
|
||||
(phony "build" ["./build"])
|
||||
|
||||
(phony "manifest" []
|
||||
(print "generating " manifest "...")
|
||||
(os/mkdir manifests)
|
||||
(spit manifest (string (string/join installed-files "\n") "\n")))
|
||||
(phony "install" ["uninstall" "build" "manifest"]
|
||||
(when (dyn :test)
|
||||
(do-rule "test"))
|
||||
(print "Installed as '" (meta :name) "'."))
|
||||
|
||||
(phony "install-deps" []
|
||||
(if-let [deps (meta :dependencies)]
|
||||
(each dep deps
|
||||
(install-git dep))
|
||||
(print "no dependencies found")))
|
||||
|
||||
(phony "uninstall" []
|
||||
(uninstall (meta :name)))
|
||||
|
||||
(phony "clean" []
|
||||
(when (os/stat "./build" :mode)
|
||||
(rm "build")
|
||||
(print "Deleted build directory.")))
|
||||
|
||||
(phony "test" ["build"]
|
||||
(defn dodir
|
||||
[dir]
|
||||
(each sub (sort (os/dir dir))
|
||||
(def ndir (string dir sep sub))
|
||||
(case (os/stat ndir :mode)
|
||||
:file (when (string/has-suffix? ".janet" ndir)
|
||||
(print "running " ndir " ...")
|
||||
(def result (os/execute [(dyn :executable "janet") ndir] :p))
|
||||
(when (not= 0 result)
|
||||
(os/exit result)))
|
||||
:directory (dodir ndir))))
|
||||
(dodir "test")
|
||||
(print "All tests passed.")))
|
||||
|
||||
#
|
||||
# CLI
|
||||
#
|
||||
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
|
||||
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
|
||||
|
||||
(defn- local-rule
|
||||
[rule]
|
||||
(cook/import-rules "./project.janet")
|
||||
(cook/do-rule rule))
|
||||
(import-rules "./project.janet")
|
||||
(do-rule rule))
|
||||
|
||||
(defn- help
|
||||
[]
|
||||
(print `
|
||||
usage: jpm --key=value ... [subcommand] [args]...
|
||||
usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
|
||||
|
||||
Run from a directory containing a project.janet file to perform operations
|
||||
on a project, or from anywhere to do operations on the global module cache (modpath).
|
||||
|
||||
Subcommands are:
|
||||
build : build all artifacts
|
||||
install (repo) : install artifacts. If a repo is given, install the contents of that
|
||||
help : show this help text
|
||||
install (repo or name) : install artifacts. If a repo is given, install the contents of that
|
||||
git repository, assuming that the repository is a jpm project. If not, build
|
||||
and install the current project.
|
||||
uninstall (module) : uninstall a module. If no module is given, uninstall the module
|
||||
defined by the current directory.
|
||||
clean : remove any generated files or artifacts
|
||||
test : run tests
|
||||
deps : install dependencies.
|
||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
||||
deps : install dependencies for the current project.
|
||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
||||
or (rule "ouput.file" [deps...] ...).
|
||||
rules : list rules available with run.
|
||||
update-pkgs : Update the current package listing from the remote git repository selected.
|
||||
quickbin entry executable : Create an executable from a janet script with a main function.
|
||||
|
||||
Keys are:
|
||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH or (dyn :syspath)
|
||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH or (dyn :headerpath)
|
||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
|
||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
|
||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
|
||||
--compiler : C compiler to use for natives. Defaults to $COMPILER or cc.
|
||||
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
|
||||
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
|
||||
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
|
||||
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
|
||||
--compiler : C compiler to use for natives. Defaults to cc (cl on windows).
|
||||
--archiver : C compiler to use for static libraries. Defaults to ar (lib on windows).
|
||||
--linker : C linker to use for linking natives. Defaults to cc (link on windows).
|
||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
||||
|
||||
Flags are:
|
||||
--verbose : Print shell commands as they are executed.
|
||||
--test : If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
`))
|
||||
|
||||
(defn build
|
||||
(defn- show-help
|
||||
[]
|
||||
(print help))
|
||||
|
||||
(defn- build
|
||||
[]
|
||||
(local-rule "build"))
|
||||
|
||||
(defn clean
|
||||
(defn- clean
|
||||
[]
|
||||
(local-rule "clean"))
|
||||
|
||||
(defn install
|
||||
(defn- install
|
||||
[&opt repo]
|
||||
(if repo
|
||||
(cook/install-git repo)
|
||||
(install-git repo)
|
||||
(local-rule "install")))
|
||||
|
||||
(defn test
|
||||
(defn- test
|
||||
[]
|
||||
(local-rule "test"))
|
||||
|
||||
(defn uninstall
|
||||
(defn- uninstall-cmd
|
||||
[&opt what]
|
||||
(if what
|
||||
(cook/uninstall what)
|
||||
(uninstall what)
|
||||
(local-rule "uninstall")))
|
||||
|
||||
(defn deps
|
||||
(defn- deps
|
||||
[]
|
||||
(local-rule "install-deps"))
|
||||
|
||||
(def subcommands
|
||||
(defn- list-rules
|
||||
[]
|
||||
(import-rules "./project.janet")
|
||||
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
||||
(each k ks (print k)))
|
||||
|
||||
(defn- update-pkgs
|
||||
[]
|
||||
(install-git (dyn :pkglist default-pkglist)))
|
||||
|
||||
(defn- quickbin
|
||||
[input output]
|
||||
(create-executable @{} input output)
|
||||
(do-rule output))
|
||||
|
||||
(def- subcommands
|
||||
{"build" build
|
||||
"clean" clean
|
||||
"help" show-help
|
||||
"install" install
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"clear-cache" cook/clear-cache
|
||||
"uninstall" uninstall})
|
||||
"clear-cache" clear-cache
|
||||
"run" local-rule
|
||||
"rules" list-rules
|
||||
"update-pkgs" update-pkgs
|
||||
"uninstall" uninstall-cmd
|
||||
"quickbin" quickbin})
|
||||
|
||||
(def args (tuple/slice process/args 2))
|
||||
(def len (length args))
|
||||
(var i 0)
|
||||
(def- args (tuple/slice (dyn :args) 1))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
|
||||
# Get flags
|
||||
(while (< i len)
|
||||
(def arg (args i))
|
||||
(unless (string/has-prefix? "--" arg) (break))
|
||||
(if-let [m (peg/match argpeg arg)]
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(print "invalid argument " arg))
|
||||
(if-let [m (peg/match argpeg (args i))]
|
||||
(if (= 2 (length m))
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(setdyn (keyword (m 0)) true))
|
||||
(break))
|
||||
(++ i))
|
||||
|
||||
# Run subcommand
|
||||
|
||||
@@ -1,496 +0,0 @@
|
||||
### cook.janet
|
||||
###
|
||||
### Library to help build janet natives and other
|
||||
### build artifacts.
|
||||
###
|
||||
### Copyright 2019 © Calvin Rose
|
||||
|
||||
#
|
||||
# Basic Path Settings
|
||||
#
|
||||
|
||||
# Windows is the OS outlier
|
||||
(def- is-win (= (os/which) :windows))
|
||||
(def- is-mac (= (os/which) :macos))
|
||||
(def- sep (if is-win "\\" "/"))
|
||||
(def- objext (if is-win ".obj" ".o"))
|
||||
(def- modext (if is-win ".dll" ".so"))
|
||||
(def- absprefix (if is-win "C:\\" "/"))
|
||||
|
||||
#
|
||||
# Rule Engine
|
||||
#
|
||||
|
||||
(defn- getrules []
|
||||
(if-let [rules (dyn :rules)] rules (setdyn :rules @{})))
|
||||
|
||||
(defn- gettarget [target]
|
||||
(def item ((getrules) target))
|
||||
(unless item (error (string "No rule for target " target)))
|
||||
item)
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(put (getrules) target @[(array/slice deps) thunk phony]))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
||||
|
||||
(defmacro phony
|
||||
"Add a phony rule to the rule graph. A phony rule will run every time
|
||||
(it is always considered out of date). Phony rules are good for defining
|
||||
user facing tasks."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target dep]
|
||||
(def [deps] (gettarget target))
|
||||
(array/push deps dep))
|
||||
|
||||
(defn- add-thunk
|
||||
[target more]
|
||||
(def item (gettarget target))
|
||||
(def [_ thunk] item)
|
||||
(put item 1 (fn [] (more) (thunk))))
|
||||
|
||||
(defmacro add-body
|
||||
"Add recipe code to an existing rule. This makes existing rules do more but
|
||||
does not modify the dependency graph."
|
||||
[target & body]
|
||||
~(,add-thunk ,target (fn [] ,;body)))
|
||||
|
||||
(defn- needs-build
|
||||
[dest src]
|
||||
(let [mod-dest (os/stat dest :modified)
|
||||
mod-src (os/stat src :modified)]
|
||||
(< mod-dest mod-src)))
|
||||
|
||||
(defn- needs-build-some
|
||||
[dest sources]
|
||||
(def f (file/open dest))
|
||||
(if (not f) (break true))
|
||||
(file/close f)
|
||||
(some (partial needs-build dest) sources))
|
||||
|
||||
(defn do-rule
|
||||
"Evaluate a given rule."
|
||||
[target]
|
||||
(def item ((getrules) target))
|
||||
(unless item
|
||||
(if (os/stat target :mode)
|
||||
(break target)
|
||||
(error (string "No rule for file " target " found."))))
|
||||
(def [deps thunk phony] item)
|
||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||
(when (or phony (needs-build-some target realdeps))
|
||||
(thunk))
|
||||
(unless phony target))
|
||||
|
||||
(def- _env (fiber/getenv (fiber/current)))
|
||||
|
||||
(defn import-rules
|
||||
"Import another file that defines more cook rules. This ruleset
|
||||
is merged into the current ruleset."
|
||||
[path]
|
||||
(def env (make-env))
|
||||
(unless (os/stat path :mode)
|
||||
(error (string "cannot open " path)))
|
||||
(loop [k :keys _env :when (symbol? k)]
|
||||
(unless ((_env k) :private) (put env k (_env k))))
|
||||
(def currenv (fiber/getenv (fiber/current)))
|
||||
(loop [k :keys currenv :when (keyword? k)]
|
||||
(put env k (currenv k)))
|
||||
(dofile path :env env)
|
||||
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
||||
|
||||
#
|
||||
# Configuration
|
||||
#
|
||||
|
||||
# Installation settings
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
|
||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH") (unless is-win "/usr/local/bin")))
|
||||
|
||||
# Compilation settings
|
||||
(def- OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||
(def- COMPILER (or (os/getenv "COMPILER") (if is-win "cl" "cc")))
|
||||
(def- LINKER (or (os/getenv "LINKER") (if is-win "link" COMPILER)))
|
||||
(def- LFLAGS
|
||||
(if-let [lflags (os/getenv "LFLAGS")]
|
||||
(string/split " " lflags)
|
||||
(if is-win ["/nologo" "/DLL"]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup"]
|
||||
["-shared"]))))
|
||||
(def- CFLAGS
|
||||
(if-let [cflags (os/getenv "CFLAGS")]
|
||||
(string/split " " cflags)
|
||||
(if is-win
|
||||
["/nologo"]
|
||||
["-std=c99" "-Wall" "-Wextra" "-fpic"])))
|
||||
|
||||
# Some defaults
|
||||
(def default-cflags CFLAGS)
|
||||
(def default-lflags LFLAGS)
|
||||
(def default-cc COMPILER)
|
||||
(def default-ld LINKER)
|
||||
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key dflt]
|
||||
(def ret (or (opts key) (dyn key dflt)))
|
||||
(if (= nil ret)
|
||||
(error (string "option :" key " not set")))
|
||||
ret)
|
||||
|
||||
#
|
||||
# OS and shell helpers
|
||||
#
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(def res (os/execute args :p))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if is-win
|
||||
(shell "xcopy" src dest "/y" "/e")
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
#
|
||||
# C Compilation
|
||||
#
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all sep "___")
|
||||
(string/replace-all ".janet" "")))
|
||||
|
||||
(defn- embed-c-name
|
||||
"Rename a janet file for embedding."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all sep "___")
|
||||
(string/replace-all ".janet" ".janet.c")
|
||||
(string "build" sep)))
|
||||
|
||||
(defn- embed-o-name
|
||||
"Get object file for c file."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all sep "___")
|
||||
(string/replace-all ".janet" (string ".janet" objext))
|
||||
(string "build" sep)))
|
||||
|
||||
(defn- object-name
|
||||
"Rename a source file so it can be built in a flat source tree."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all sep "___")
|
||||
(string/replace-all ".c" (if is-win ".obj" ".o"))
|
||||
(string "build" sep)))
|
||||
|
||||
(defn- lib-name
|
||||
"Generate name for dynamic library."
|
||||
[name]
|
||||
(string "build" sep name modext))
|
||||
|
||||
(defn- make-define
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(def pre (if is-win "/D" "-D"))
|
||||
(if value
|
||||
(string pre define "=" value)
|
||||
(string pre define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
||||
[defines]
|
||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||
|
||||
(defn- getcflags
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
@[;(opt opts :cflags CFLAGS)
|
||||
(string (if is-win "/I" "-I") (opt opts :headerpath JANET_HEADERPATH))
|
||||
(string (if is-win "/O" "-O") (opt opts :optimize OPTIMIZE))])
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest]
|
||||
(def cc (opt opts :compiler COMPILER))
|
||||
(def cflags (getcflags opts))
|
||||
(def defines (interpose " " (make-defines (opt opts :defines {}))))
|
||||
(def headers (or (opts :headers) []))
|
||||
(rule dest [src ;headers]
|
||||
(print "compiling " dest "...")
|
||||
(if is-win
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn- link-c
|
||||
"Link a number of object files together."
|
||||
[opts target & objects]
|
||||
(def ld (opt opts :linker LINKER))
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags (opt opts :lflags LFLAGS))
|
||||
(rule target objects
|
||||
(print "linking " target "...")
|
||||
(if is-win
|
||||
(shell ld ;lflags (string "/OUT:" target) ;objects (string (opt opts :headerpath JANET_HEADERPATH) `\\janet.lib`))
|
||||
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(rule dest [source]
|
||||
(print "generating " dest "...")
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out)
|
||||
(file/close f)))
|
||||
|
||||
(defn- abspath
|
||||
"Create an absolute path. Does not resolve . and .. (useful for
|
||||
generating entries in install manifest file)."
|
||||
[path]
|
||||
(if (string/has-prefix? absprefix)
|
||||
path
|
||||
(string (os/cwd) sep path)))
|
||||
|
||||
#
|
||||
# Public utilities
|
||||
#
|
||||
|
||||
(defn repo-id
|
||||
"Convert a repo url into a path component that serves as its id."
|
||||
[repo]
|
||||
(string/replace-all "\\" "_" (string/replace-all "/" "_" repo)))
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
[&opt opts]
|
||||
(string (opt (or opts @{}) :modpath JANET_MODPATH) sep ".manifests"))
|
||||
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name &opt opts]
|
||||
(string (find-manifest-dir opts) sep name ".txt"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
[&opt opts]
|
||||
(def path (opt (or opts @{}) :modpath JANET_MODPATH))
|
||||
(string path sep ".cache"))
|
||||
|
||||
(defn uninstall
|
||||
"Uninstall bundle named name"
|
||||
[name &opt opts]
|
||||
(def manifest (find-manifest name opts))
|
||||
(def f (file/open manifest :r))
|
||||
(unless f (print manifest " does not exist") (break))
|
||||
(loop [line :iterate (:read f :line)]
|
||||
(def path ((string/split "\n" line) 0))
|
||||
(print "removing " path)
|
||||
(try (rm path) ([err]
|
||||
(unless (= err "No such file or directory")
|
||||
(error err)))))
|
||||
(print "removing " manifest)
|
||||
(rm manifest)
|
||||
(:close f)
|
||||
(print "Uninstalled."))
|
||||
|
||||
(defn clear-cache
|
||||
"Clear the global git cache."
|
||||
[&opt opts]
|
||||
(rm (find-cache opts)))
|
||||
|
||||
(defn install-git
|
||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
||||
[repo &opt opts]
|
||||
(def cache (find-cache opts))
|
||||
(os/mkdir cache)
|
||||
(def id (repo-id repo))
|
||||
(def module-dir (string cache sep id))
|
||||
(when (os/mkdir module-dir)
|
||||
(os/execute ["git" "clone" repo module-dir] :p))
|
||||
(def olddir (os/cwd))
|
||||
(os/cd module-dir)
|
||||
(try
|
||||
(with-dyns [:rules @{}]
|
||||
(import-rules "./project.janet")
|
||||
(do-rule "install-deps")
|
||||
(do-rule "build")
|
||||
(do-rule "install"))
|
||||
([err] nil))
|
||||
(os/cd olddir))
|
||||
|
||||
(defn install-rule
|
||||
"Add install and uninstall rule for moving file from src into destdir."
|
||||
[src destdir]
|
||||
(def parts (string/split sep src))
|
||||
(def name (last parts))
|
||||
(def path (string destdir sep name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(add-body "install"
|
||||
(try (os/mkdir destdir) ([err] nil))
|
||||
(copy src destdir)))
|
||||
|
||||
#
|
||||
# Declaring Artifacts - used in project.janet, targets specifically
|
||||
# tailored for janet.
|
||||
#
|
||||
|
||||
(defn declare-native
|
||||
"Declare a native binary. This is a shared library that can be loaded
|
||||
dynamically by a janet runtime."
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def name (opts :name))
|
||||
(def lname (lib-name name))
|
||||
(loop [src :in sources]
|
||||
(compile-c opts src (object-name src)))
|
||||
(def objects (map object-name sources))
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (embed-c-name src))
|
||||
(def o-src (embed-o-name src))
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opts c-src o-src)))
|
||||
(link-c opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(def path (opt opts :modpath JANET_MODPATH))
|
||||
(install-rule lname path))
|
||||
|
||||
(defn declare-source
|
||||
"Create a Janet modules. This does not actually build the module(s),
|
||||
but registers it for packaging and installation."
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def path (opt opts :modpath JANET_MODPATH))
|
||||
(each s sources
|
||||
(install-rule s path)))
|
||||
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||
(install-rule main binpath))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows."
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def binpath (opt opts :binpath JANET_BINPATH))
|
||||
(install-rule main binpath)
|
||||
# Create a dud batch file when on windows.
|
||||
(when is-win
|
||||
(def name (last (string/split sep main)))
|
||||
(def bat (string "@echo off\r\njanet %~dp0\\" name "%*"))
|
||||
(def newname (string binpath sep name ".bat"))
|
||||
(add-body "install"
|
||||
(spit newname bat))
|
||||
(add-body "uninstall"
|
||||
(os/rm newname))))
|
||||
|
||||
(defn declare-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
a janet vm and the required dependencies and run there."
|
||||
[&keys opts]
|
||||
(def entry (opts :entry))
|
||||
(def name (opts :name))
|
||||
(def iname (string "build" sep name ".jimage"))
|
||||
(rule iname (or (opts :deps) [])
|
||||
(spit iname (make-image (require entry))))
|
||||
(def path (opt opts :modpath JANET_MODPATH))
|
||||
(install-rule iname path))
|
||||
|
||||
(defn declare-project
|
||||
"Define your project metadata. This should
|
||||
be the first declaration in a project.janet file.
|
||||
Also sets up basic phony targets like clean, build, test, etc."
|
||||
[&keys meta]
|
||||
(setdyn :project meta)
|
||||
|
||||
(def installed-files @[])
|
||||
(def manifests (find-manifest-dir))
|
||||
(def manifest (find-manifest (meta :name)))
|
||||
(setdyn :manifest manifest)
|
||||
(setdyn :manifest-dir manifests)
|
||||
(setdyn :installed-files installed-files)
|
||||
|
||||
(rule "./build" [] (os/mkdir "build"))
|
||||
(phony "build" ["./build"])
|
||||
|
||||
(phony "manifest" []
|
||||
(print "generating " manifest "...")
|
||||
(os/mkdir manifests)
|
||||
(spit manifest (string (string/join installed-files "\n") "\n")))
|
||||
(phony "install" ["uninstall" "build" "manifest"]
|
||||
(print "Installed as '" (meta :name) "'."))
|
||||
|
||||
(phony "install-deps" []
|
||||
(if-let [deps (meta :dependencies)]
|
||||
(each dep deps
|
||||
(install-git dep))
|
||||
(print "no dependencies found")))
|
||||
|
||||
(phony "uninstall" []
|
||||
(uninstall (meta :name)))
|
||||
|
||||
(phony "clean" []
|
||||
(rm "build")
|
||||
(print "Deleted build directory."))
|
||||
|
||||
(phony "test" ["build"]
|
||||
(defn dodir
|
||||
[dir]
|
||||
(each sub (os/dir dir)
|
||||
(def ndir (string dir sep sub))
|
||||
(case (os/stat ndir :mode)
|
||||
:file (when (string/has-suffix? ".janet" ndir)
|
||||
(print "running " ndir " ...")
|
||||
(dofile ndir :exit true))
|
||||
:directory (dodir ndir))))
|
||||
(dodir "test")
|
||||
(print "All tests passed.")))
|
||||
@@ -1,149 +0,0 @@
|
||||
### path.janet
|
||||
###
|
||||
### A library for path manipulation.
|
||||
###
|
||||
### Copyright 2019 © Calvin Rose
|
||||
|
||||
#
|
||||
# Common
|
||||
#
|
||||
|
||||
(def- ext-peg
|
||||
(peg/compile ~{:back (> -1 (+ (* ($) (set "\\/.")) :back))
|
||||
:main :back}))
|
||||
|
||||
(defn ext
|
||||
"Get the file extension for a path."
|
||||
[path]
|
||||
(if-let [m (peg/match ext-peg path (length path))]
|
||||
(let [i (m 0)]
|
||||
(if (= (path i) 46)
|
||||
(string/slice path (m 0) -1)))))
|
||||
|
||||
(defn- redef
|
||||
"Redef a value, keeping all metadata."
|
||||
[from to]
|
||||
(setdyn (symbol to) (dyn (symbol from))))
|
||||
|
||||
#
|
||||
# Generating Macros
|
||||
#
|
||||
|
||||
(defmacro- decl-sep [pre sep] ~(def ,(symbol pre "/sep") ,sep))
|
||||
(defmacro- decl-delim [pre d] ~(def ,(symbol pre "/delim") ,d))
|
||||
|
||||
(defmacro- decl-last-sep
|
||||
[pre sep]
|
||||
~(def- ,(symbol pre "/last-sep-peg")
|
||||
(peg/compile ~{:back (> -1 (+ (* ,sep ($)) :back))
|
||||
:main :back})))
|
||||
|
||||
(defmacro- decl-basename
|
||||
[pre]
|
||||
~(defn ,(symbol pre "/basename")
|
||||
"Gets the base file name of a path."
|
||||
[path]
|
||||
(if-let [m (peg/match
|
||||
,(symbol pre "/last-sep-peg")
|
||||
path
|
||||
(length path))]
|
||||
(let [[p] m]
|
||||
(string/slice path p -1))
|
||||
path)))
|
||||
|
||||
(defmacro- decl-parts
|
||||
[pre sep]
|
||||
~(defn ,(symbol pre "/parts")
|
||||
"Split a path into its parts."
|
||||
[path]
|
||||
(string/split ,sep path)))
|
||||
|
||||
(defmacro- decl-normalize
|
||||
[pre sep lead]
|
||||
~(defn ,(symbol pre "/normalize")
|
||||
"Normalize a path. This removes . and .. in the
|
||||
path, as well as empty path elements."
|
||||
[path]
|
||||
(def els (string/split ,sep path))
|
||||
(def newparts @[])
|
||||
(if (,(symbol pre "/abspath?") path) (array/push newparts ,lead))
|
||||
(each part els
|
||||
(case part
|
||||
"" nil
|
||||
"." nil
|
||||
".." (array/pop newparts)
|
||||
(array/push newparts part)))
|
||||
(string/join newparts ,sep)))
|
||||
|
||||
(defmacro- decl-join
|
||||
[pre sep]
|
||||
~(defn ,(symbol pre "/join")
|
||||
"Join path elements together."
|
||||
[& els]
|
||||
(,(symbol pre "/normalize") (string/join els ,sep))))
|
||||
|
||||
(defmacro- decl-abspath
|
||||
[pre]
|
||||
~(defn ,(symbol pre "/abspath")
|
||||
"Coerce a path to be absolute."
|
||||
[path]
|
||||
(if (,(symbol pre "/abspath?") path)
|
||||
path
|
||||
(,(symbol pre "/join") (os/cwd) path))))
|
||||
|
||||
#
|
||||
# Posix
|
||||
#
|
||||
|
||||
(defn posix/abspath?
|
||||
"Check if a path is absolute."
|
||||
[path]
|
||||
(string/has-prefix? "/" path))
|
||||
|
||||
(redef "ext" "posix/ext")
|
||||
(decl-sep "posix" "/")
|
||||
(decl-delim "posix" ":")
|
||||
(decl-last-sep "posix" "/")
|
||||
(decl-basename "posix")
|
||||
(decl-parts "posix" "/")
|
||||
(decl-normalize "posix" "/" "")
|
||||
(decl-join "posix" "/")
|
||||
(decl-abspath "posix")
|
||||
|
||||
#
|
||||
# Windows
|
||||
#
|
||||
|
||||
(def- abs-peg (peg/compile '(* (range "AZ") ":\\")))
|
||||
(defn win32/abspath?
|
||||
"Check if a path is absolute."
|
||||
[path]
|
||||
(peg/match abs-peg path))
|
||||
|
||||
(redef "ext" "win32/ext")
|
||||
(decl-sep "win32" "\\")
|
||||
(decl-delim "win32" ";")
|
||||
(decl-last-sep "win32" "\\")
|
||||
(decl-basename "win32")
|
||||
(decl-parts "win32" "\\")
|
||||
(decl-normalize "win32" "\\" "C:")
|
||||
(decl-join "win32" "\\")
|
||||
(decl-abspath "win32")
|
||||
|
||||
#
|
||||
# Specialize for current OS
|
||||
#
|
||||
|
||||
(def- syms
|
||||
["ext"
|
||||
"sep"
|
||||
"delim"
|
||||
"basename"
|
||||
"abspath?"
|
||||
"abspath"
|
||||
"parts"
|
||||
"normalize"
|
||||
"join"])
|
||||
(let [pre (if (= :windows (os/which)) "win32" "posix")]
|
||||
(each sym syms
|
||||
(redef (string pre "/" sym) sym)))
|
||||
107
build_win.bat
107
build_win.bat
@@ -13,11 +13,20 @@
|
||||
@if "%1"=="clean" goto CLEAN
|
||||
@if "%1"=="test" goto TEST
|
||||
@if "%1"=="dist" goto DIST
|
||||
@if "%1"=="install" goto INSTALL
|
||||
@if "%1"=="test-install" goto TESTINSTALL
|
||||
@if "%1"=="all" goto ALL
|
||||
|
||||
@rem Set compile and link options here
|
||||
@setlocal
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD
|
||||
@set JANET_LINK=link /nologo
|
||||
@set JANET_LINK_STATIC=lib /nologo
|
||||
|
||||
@rem Add janet build tag
|
||||
if not "%JANET_BUILD%" == "" (
|
||||
@set JANET_COMPILE=%JANET_COMPILE% /DJANET_BUILD="\"%JANET_BUILD%\""
|
||||
)
|
||||
|
||||
mkdir build
|
||||
mkdir build\core
|
||||
@@ -25,30 +34,26 @@ mkdir build\mainclient
|
||||
mkdir build\boot
|
||||
|
||||
@rem Build the xxd tool for generating sources
|
||||
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@link /nologo /out:build\xxd.exe build\xxd.obj
|
||||
link /nologo /out:build\xxd.exe build\xxd.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Generate the embedded sources
|
||||
@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
|
||||
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\mainclient\init.gen.obj build\init.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the bootstrap interpretter
|
||||
@rem Build the bootstrap interpreter
|
||||
for %%f in (src\core\*.c) do (
|
||||
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
%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
|
||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@@ -56,12 +61,12 @@ for %%f in (src\boot\*.c) do (
|
||||
build\janet_boot build\core_image.c
|
||||
|
||||
@rem Build the core image
|
||||
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build the sources
|
||||
for %%f in (src\core\*.c) do (
|
||||
@%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@@ -70,7 +75,7 @@ rc /nologo /fobuild\janet_win.res janet_win.rc
|
||||
|
||||
@rem Build the main client
|
||||
for %%f in (src\mainclient\*.c) do (
|
||||
@%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||
%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@@ -78,6 +83,10 @@ for %%f in (src\mainclient\*.c) do (
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Build static library (libjanet.a)
|
||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
@@ -85,6 +94,11 @@ for %%f in (src\core\*.c) do (
|
||||
set "amalg_files=!amalg_files! %%f"
|
||||
)
|
||||
janet.exe tools\amalg.janet 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 %amalg_files% build\core_image.c > build\janet.c
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
|
||||
@rem Gen shell.c
|
||||
janet.exe tools\amalg.janet src\mainclient\line.h src\mainclient\line.c src\mainclient\main.c > build\shell.c
|
||||
janet.exe tools\removecr.janet build\shell.c
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
@@ -107,15 +121,16 @@ exit /b 0
|
||||
|
||||
@rem Clean build artifacts
|
||||
:CLEAN
|
||||
del janet.exe janet.exp janet.lib
|
||||
del *.exe *.lib *.exp
|
||||
rd /s /q build
|
||||
rd /s /q dist
|
||||
exit /b 0
|
||||
|
||||
@rem Run tests
|
||||
:TEST
|
||||
for %%f in (test/suite*.janet) do (
|
||||
janet.exe test\%%f
|
||||
@if errorlevel 1 goto :TESTFAIL
|
||||
@if errorlevel 1 goto TESTFAIL
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@@ -123,21 +138,75 @@ exit /b 0
|
||||
:DIST
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\shell.c dist\shell.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.h dist\janet.h
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
|
||||
copy auxlib\cook.janet dist\cook.janet
|
||||
copy build\libjanet.lib dist\libjanet.lib
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
|
||||
@rem Create installer
|
||||
"C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
exit /b 0
|
||||
|
||||
@rem Run the installer. (Installs to the local user with default settings)
|
||||
:INSTALL
|
||||
@echo Running Installer...
|
||||
FOR %%a in (janet-*-windows-installer.exe) DO (
|
||||
%%a /S /CurrentUser
|
||||
)
|
||||
exit /b 0
|
||||
|
||||
@rem Test the installation.
|
||||
:TESTINSTALL
|
||||
pushd test\install
|
||||
call jpm clean
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm test
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call build\testexec
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose quickbin testexec.janet build\testexec2.exe
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call build\testexec2.exe
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/jhydro.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
|
||||
@if errorlevel 1 goto :TESTINSTALLFAIL
|
||||
popd
|
||||
exit /b 0
|
||||
|
||||
:TESTINSTALLFAIL
|
||||
popd
|
||||
goto :TESTFAIL
|
||||
|
||||
@rem build, test, dist, install. Useful for local dev.
|
||||
:ALL
|
||||
call %0 build
|
||||
@if errorlevel 1 exit /b 1
|
||||
call %0 test
|
||||
@if errorlevel 1 exit /b 1
|
||||
call %0 dist
|
||||
@if errorlevel 1 exit /b 1
|
||||
call %0 install
|
||||
@if errorlevel 1 exit /b 1
|
||||
@echo Done!
|
||||
exit /b 0
|
||||
|
||||
:TESTFAIL
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# Version
|
||||
!define VERSION "1.1.0"
|
||||
!define VERSION "1.5.0"
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
@@ -14,6 +14,9 @@ VIFileVersion "${PRODUCT_VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
# For now, use 32 bit folder as build is 32 bit
|
||||
# !define MULTIUSER_USE_PROGRAMFILES64
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
@@ -22,7 +25,19 @@ VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
# Basics
|
||||
Name "Janet"
|
||||
OutFile "janet-v${VERSION}-windows-installer.exe"
|
||||
|
||||
# Do some NSIS-fu to figure out at compile time if we are in appveyor
|
||||
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
|
||||
!define "CHECK_${OUTNAME}"
|
||||
!define DOLLAR "$"
|
||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
||||
# We are not in the appveyor environment, use version name
|
||||
!define OUTNAME_PART v${VERSION}
|
||||
!else
|
||||
# We are in appveyor, use git tag name for installer
|
||||
!define OUTNAME_PART ${OUTNAME}
|
||||
!endif
|
||||
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
@@ -75,11 +90,12 @@ function .onInit
|
||||
functionEnd
|
||||
|
||||
section "Janet" BfWSection
|
||||
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
@@ -87,16 +103,13 @@ section "Janet" BfWSection
|
||||
file /oname=bin\jpm.janet auxbin\jpm
|
||||
file /oname=bin\jpm.bat tools\jpm.bat
|
||||
|
||||
# Modules
|
||||
file /oname=Library\cook.janet auxlib\cook.janet
|
||||
file /oname=Library\path.janet auxlib\path.janet
|
||||
|
||||
# C headers
|
||||
# C headers and library files
|
||||
file /oname=C\janet.h dist\janet.h
|
||||
file /oname=C\janetconf.h dist\janetconf.h
|
||||
file /oname=C\janet.lib dist\janet.lib
|
||||
file /oname=C\janet.exp dist\janet.exp
|
||||
file /oname=C\janet.c dist\janet.c
|
||||
file /oname=C\libjanet.lib dist\libjanet.lib
|
||||
|
||||
# Documentation
|
||||
file /oname=docs\docs.html dist\doc.html
|
||||
@@ -105,39 +118,43 @@ section "Janet" BfWSection
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
# Start Menu
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
# Set up Environment variables
|
||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Update path
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
${Else}
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||
${EndIf}
|
||||
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||
# Registry information for add/remove programs
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
||||
# Add uninstall
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
||||
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
||||
|
||||
|
||||
sectionEnd
|
||||
|
||||
# Uninstaller
|
||||
@@ -148,10 +165,10 @@ functionEnd
|
||||
|
||||
section "uninstall"
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
# Remove files
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
@@ -163,18 +180,23 @@ section "uninstall"
|
||||
# Remove env vars
|
||||
!insertmacro DelEnv JANET_PATH
|
||||
!insertmacro DelEnv JANET_HEADERPATH
|
||||
!insertmacro DelEnv JANET_LIBPATH
|
||||
!insertmacro DelEnv JANET_BINPATH
|
||||
|
||||
# Unset PATH
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
${Else}
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||
${EndIf}
|
||||
|
||||
# make sure windows knows about the change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
# Always delete uninstaller as the last action
|
||||
delete "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||
|
||||
sectionEnd
|
||||
|
||||
2
janet.1
2
janet.1
@@ -14,7 +14,7 @@ janet \- run the Janet language abstract machine
|
||||
.SH DESCRIPTION
|
||||
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
|
||||
and performance (arrays, tables, structs, tuples). The language also features 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.
|
||||
|
||||
201
jpm.1
Normal file
201
jpm.1
Normal file
@@ -0,0 +1,201 @@
|
||||
.TH JPM 1
|
||||
.SH NAME
|
||||
jpm \- the Janet Project Manager, a build tool for Janet
|
||||
.SH SYNOPSIS
|
||||
.B jpm
|
||||
[\fB\-\-flag ...\fR]
|
||||
[\fB\-\-option=value ...\fR]
|
||||
.IR command
|
||||
.IR args ...
|
||||
.SH DESCRIPTION
|
||||
jpm is the build tool that ships with a standard Janet install. It is
|
||||
used for building Janet projects, installing dependencies, installing
|
||||
projects, building native modules, and exporting your Janet project to a
|
||||
standalone executable. Although not required for working with Janet, it
|
||||
removes much of the boilerplate with installing dependencies and
|
||||
building native modules. jpm requires only Janet to run, and uses git
|
||||
to install dependencies (jpm will work without git installed).
|
||||
.SH DOCUMENTATION
|
||||
|
||||
jpm has several subcommands, each used for managing either a single Janet project or
|
||||
all Janet modules installed on the system. Global commands, those that manage modules
|
||||
at the system level, do things like install and uninstall packages, as well as clear the cache.
|
||||
More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
|
||||
|
||||
.SH FLAGS
|
||||
|
||||
.TP
|
||||
.BR \-\-verbose
|
||||
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
||||
|
||||
.TP
|
||||
.BR \-\-test
|
||||
If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
|
||||
.SH OPTIONS
|
||||
|
||||
.TP
|
||||
.BR \-\-modpath=/some/path
|
||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
|
||||
|
||||
.TP
|
||||
.BR \-\-headerpath=/some/path
|
||||
Set the path the jpm will include when building C source code. This lets
|
||||
you specify the location of janet.h and janetconf.h on your system. On a
|
||||
normal install, this option is not needed.
|
||||
|
||||
.TP
|
||||
.BR \-\-binpath=/some/path
|
||||
Set the path that jpm will install scripts and standalone executables to. Executables
|
||||
defined via declare-execuatble or scripts declared via declare-binscript will be installed
|
||||
here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
|
||||
See JANET_BINPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-libpath=/some/path
|
||||
Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
|
||||
is \fBnot\fR used for building native modules or standalone executables, only
|
||||
for linking into applications that want to embed janet as a dynamic module.
|
||||
Linking statically might be a better idea, even in that case. Defaults to
|
||||
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
||||
|
||||
.TP
|
||||
.BR \-\-compiler=cc
|
||||
Sets the compiler used for compiling native modules and standalone executables. Defaults
|
||||
to cc.
|
||||
|
||||
.TP
|
||||
.BR \-\-linker=ld
|
||||
Sets the linker used to create native modules and executables.
|
||||
|
||||
.TP
|
||||
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
|
||||
Sets the git repository for the package listing used to resolve shorthand package names.
|
||||
|
||||
.TP
|
||||
.BR \-\-archiver=ar
|
||||
Sets the command used for creating static libraries, use for linking into the standalone executable.
|
||||
Native modules are compiled twice, once a normal native module (shared object), and once as an
|
||||
archive.
|
||||
|
||||
.SH COMMANDS
|
||||
.TP
|
||||
.BR help
|
||||
Shows the usage text and exits immediately.
|
||||
|
||||
.TP
|
||||
.BR build
|
||||
Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
|
||||
be created in the ./build/ directory.
|
||||
|
||||
.TP
|
||||
.BR install\ [\fBrepo\fR]
|
||||
|
||||
When run with no arguments, installs all installable artifacts in the current project to
|
||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
||||
When run with an argument, install does not need to be run from a jpm project directory.
|
||||
|
||||
.TP
|
||||
.BR uninstall\ [\fBname\fR]
|
||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
||||
repository url, path to installed file or executable name. The name of the project must be specified
|
||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
||||
the current project if installed.
|
||||
|
||||
.TP
|
||||
.BR clean
|
||||
Remove all artifacts created by jpm. This just deletes the build folder.
|
||||
|
||||
.TP
|
||||
.BR test
|
||||
Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
|
||||
is considered failing if it exits with a non-zero exit code.
|
||||
|
||||
.TP
|
||||
.BR deps
|
||||
Install all dependencies that this project requires recursively. jpm does not
|
||||
resolve dependency issues, like conflicting versions of the same module are required, or
|
||||
different modules with the same name. Dependencies are installed with git, so deps requires
|
||||
git to be on the PATH.
|
||||
|
||||
.TP
|
||||
.BR clear-cache
|
||||
jpm caches git repositories that are needed to install modules from a remote
|
||||
source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
|
||||
date or too large, clear-cache will remove the cache and jpm will rebuild it
|
||||
when needed. clear-cache is a global command, so a project.janet is not
|
||||
required.
|
||||
|
||||
.TP
|
||||
.BR run\ [\fBrule\fR]
|
||||
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
|
||||
contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
|
||||
A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
|
||||
like make. run will run a single rule or build a single file.
|
||||
|
||||
.TP
|
||||
.BR rules
|
||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
||||
|
||||
.TP
|
||||
.BR update-pkgs
|
||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
||||
|
||||
.TP
|
||||
.BR quickbin [\fBentry\fR] [\fBexecutable\fR]
|
||||
Create a standalone, statically linked executable from a Janet source file that contains a main function.
|
||||
The main function is the entry point of the program and will receive command line arguments
|
||||
as function arguments. The entry file can import other modules, including native C modules, and
|
||||
jpm will attempt to include the dependencies into the generated executable.
|
||||
|
||||
.SH ENVIRONMENT
|
||||
|
||||
.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
|
||||
the default location set at compile time, which can be determined with (dyn :syspath)
|
||||
.RE
|
||||
|
||||
.B JANET_MODPATH
|
||||
.RS
|
||||
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
|
||||
set this to a different directory if you want to. Doing so would let you import Janet modules
|
||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
|
||||
This variable is overwritten by the --modpath=/some/path if it is provided.
|
||||
.RE
|
||||
|
||||
.B JANET_HEADERPATH
|
||||
.RS
|
||||
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
||||
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
||||
default includes on your system, this value is not required. If not provided, will default to
|
||||
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_LIBPATH
|
||||
.RS
|
||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
||||
libjanet.a for creating standalong executables. This does not need to be
|
||||
set on a normal install.
|
||||
If not provided, this will default to (dyn :syspath)/../../lib.
|
||||
The --libpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_BINPATH
|
||||
.RS
|
||||
The directory where jpm will install binary scripts and executables to.
|
||||
Defaults to
|
||||
(dyn :syspath)/../../lib.
|
||||
The --binpath=/some/path will override this variable.
|
||||
.RE
|
||||
|
||||
.B JANET_PKGLIST
|
||||
.RS
|
||||
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
|
||||
is mostly a convenience. However, package dependencies can use short names, package listings
|
||||
can be used to choose a particular set of dependency versions for a whole project.
|
||||
|
||||
.SH AUTHOR
|
||||
Written by Calvin Rose <calsrose@gmail.com>
|
||||
50
meson.build
50
meson.build
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.1.0')
|
||||
version : '1.5.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@@ -52,7 +52,7 @@ conf.set_quoted('JANET_VERSION', meson.project_version())
|
||||
# Use options
|
||||
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
|
||||
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
|
||||
conf.set('JANET_SINGLE_THREADED', not get_option('single_threaded'))
|
||||
conf.set('JANET_SINGLE_THREADED', get_option('single_threaded'))
|
||||
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
|
||||
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
conf.set('JANET_NO_SOURCEMAPS', not get_option('sourcemaps'))
|
||||
@@ -65,6 +65,12 @@ conf.set('JANET_RECURSION_GUARD', get_option('recursion_guard'))
|
||||
conf.set('JANET_MAX_PROTO_DEPTH', get_option('max_proto_depth'))
|
||||
conf.set('JANET_MAX_MACRO_EXPAND', get_option('max_macro_expand'))
|
||||
conf.set('JANET_STACK_MAX', get_option('stack_max'))
|
||||
if get_option('os_name') != ''
|
||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
||||
endif
|
||||
if get_option('arch_name') != ''
|
||||
conf.set('JANET_ARCH_NAME', get_option('arch_name'))
|
||||
endif
|
||||
jconf = configure_file(output : 'janetconf.h',
|
||||
configuration : conf)
|
||||
|
||||
@@ -77,7 +83,6 @@ gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
boot_gen = gen.process('src/boot/boot.janet', extra_args: 'janet_gen_boot')
|
||||
init_gen = gen.process('src/mainclient/init.janet', extra_args: 'janet_gen_init')
|
||||
|
||||
# Order is important here, as some headers
|
||||
# depend on other headers for the amalg target
|
||||
@@ -164,15 +169,32 @@ libjanet = library('janet', core_src, core_image,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
||||
native_cc = meson.get_compiler('c', native: true)
|
||||
cross_cc = meson.get_compiler('c', native: false)
|
||||
if native_cc.has_argument('-fvisibility=hidden')
|
||||
extra_native_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_native_cflags = []
|
||||
endif
|
||||
if cross_cc.has_argument('-fvisibility=hidden')
|
||||
extra_cross_cflags = ['-fvisibility=hidden']
|
||||
else
|
||||
extra_cross_cflags = []
|
||||
endif
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
c_args : extra_native_cflags,
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, init_gen, mainclient_src,
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
c_args : extra_cross_cflags,
|
||||
native : true)
|
||||
else
|
||||
janet_nativeclient = janet_mainclient
|
||||
@@ -191,9 +213,15 @@ amalg = custom_target('amalg',
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
amalg_shell = custom_target('amalg-shell',
|
||||
input : ['tools/amalg.janet', 'src/mainclient/line.h',
|
||||
'src/mainclient/line.c', 'src/mainclient/main.c'],
|
||||
output : ['shell.c'],
|
||||
capture : true,
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||
janet_amalgclient = executable('janet-amalg', amalg, amalg_shell,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
build_by_default : false)
|
||||
@@ -206,7 +234,8 @@ test_files = [
|
||||
'test/suite3.janet',
|
||||
'test/suite4.janet',
|
||||
'test/suite5.janet',
|
||||
'test/suite6.janet'
|
||||
'test/suite6.janet',
|
||||
'test/suite7.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
@@ -221,13 +250,10 @@ janet_dep = declare_dependency(include_directories : incdir,
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_libs = [
|
||||
'auxlib/cook.janet',
|
||||
'auxlib/path.janet'
|
||||
]
|
||||
janet_binscripts = [
|
||||
'auxbin/jpm'
|
||||
]
|
||||
install_data(sources : janet_libs, install_dir : janet_path)
|
||||
install_data(sources : janet_binscripts, install_dir : 'bin')
|
||||
install_data(sources : ['tools/.keep'], install_dir : 'lib/janet')
|
||||
|
||||
@@ -14,4 +14,7 @@ option('int_types', type : 'boolean', value : true)
|
||||
option('recursion_guard', type : 'integer', min : 10, max : 8000, value : 1024)
|
||||
option('max_proto_depth', type : 'integer', min : 10, max : 8000, value : 200)
|
||||
option('max_macro_expand', type : 'integer', min : 1, max : 8000, value : 200)
|
||||
option('stack_max', type : 'integer', min : 8096, max : 1000000000, value : 16384)
|
||||
option('stack_max', type : 'integer', min : 8096, max : 0x7fffffff, value : 0x7fffffff)
|
||||
|
||||
option('arch_name', type : 'string', value: '')
|
||||
option('os_name', type : 'string', value: '')
|
||||
|
||||
@@ -50,7 +50,7 @@ int main(int argc, const char **argv) {
|
||||
JanetArray *args = janet_array(argc);
|
||||
for (int i = 0; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||
janet_def(env, "boot/args", janet_wrap_array(args), "Command line arguments.");
|
||||
|
||||
/* Add in options from janetconf.h so boot.janet can configure the image as needed. */
|
||||
JanetTable *opts = janet_table(0);
|
||||
@@ -60,7 +60,7 @@ int main(int argc, const char **argv) {
|
||||
#ifdef JANET_NO_SOURCEMAPS
|
||||
janet_table_put(opts, janet_ckeywordv("no-sourcemaps"), janet_wrap_true());
|
||||
#endif
|
||||
janet_def(env, "process/config", janet_wrap_table(opts), "Boot options");
|
||||
janet_def(env, "boot/config", janet_wrap_table(opts), "Boot options");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
const char *boot_file;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@@ -27,10 +27,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 1
|
||||
#define JANET_VERSION_MINOR 5
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.1.0-dev"
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.5.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
@@ -56,5 +56,7 @@
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_OS_NAME my-custom-os */
|
||||
/* #define JANET_ARCH_NAME pdp-8 */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
|
||||
@@ -24,6 +24,7 @@
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
#include <string.h>
|
||||
@@ -33,6 +34,7 @@ JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
||||
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -62,11 +64,14 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
||||
Janet *newData;
|
||||
Janet *old = array->data;
|
||||
if (capacity <= array->capacity) return;
|
||||
capacity *= growth;
|
||||
int64_t new_capacity = ((int64_t) capacity) * growth;
|
||||
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
|
||||
capacity = (int32_t) new_capacity;
|
||||
newData = realloc(old, capacity * sizeof(Janet));
|
||||
if (NULL == newData) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet);
|
||||
array->data = newData;
|
||||
array->capacity = capacity;
|
||||
}
|
||||
@@ -153,8 +158,8 @@ static Janet cfun_array_ensure(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_array_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetArray *array = janet_array(range.end - range.start);
|
||||
if (array->data)
|
||||
memcpy(array->data, view.items + range.start, sizeof(Janet) * (range.end - range.start));
|
||||
|
||||
@@ -705,8 +705,8 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
if (!janet_checkint(tup[1])) {
|
||||
janet_asm_error(&a, "expected integer");
|
||||
}
|
||||
mapping.start = janet_unwrap_integer(tup[0]);
|
||||
mapping.end = janet_unwrap_integer(tup[1]);
|
||||
mapping.line = janet_unwrap_integer(tup[0]);
|
||||
mapping.column = janet_unwrap_integer(tup[1]);
|
||||
def->sourcemap[i] = mapping;
|
||||
}
|
||||
}
|
||||
@@ -749,31 +749,31 @@ static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
||||
}
|
||||
|
||||
/* Create some constant sized tuples */
|
||||
static Janet tup1(Janet x) {
|
||||
static const Janet *tup1(Janet x) {
|
||||
Janet *tup = janet_tuple_begin(1);
|
||||
tup[0] = x;
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
return janet_tuple_end(tup);
|
||||
}
|
||||
static Janet tup2(Janet x, Janet y) {
|
||||
static const Janet *tup2(Janet x, Janet y) {
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = x;
|
||||
tup[1] = y;
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
return janet_tuple_end(tup);
|
||||
}
|
||||
static Janet tup3(Janet x, Janet y, Janet z) {
|
||||
static const Janet *tup3(Janet x, Janet y, Janet z) {
|
||||
Janet *tup = janet_tuple_begin(3);
|
||||
tup[0] = x;
|
||||
tup[1] = y;
|
||||
tup[2] = z;
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
return janet_tuple_end(tup);
|
||||
}
|
||||
static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
|
||||
static const Janet *tup4(Janet w, Janet x, Janet y, Janet z) {
|
||||
Janet *tup = janet_tuple_begin(4);
|
||||
tup[0] = w;
|
||||
tup[1] = x;
|
||||
tup[2] = y;
|
||||
tup[3] = z;
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
return janet_tuple_end(tup);
|
||||
}
|
||||
|
||||
/* Given an argument, convert it to the appropriate integer or symbol */
|
||||
@@ -784,41 +784,56 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
||||
return janet_wrap_integer((int32_t)instr);
|
||||
}
|
||||
name = janet_csymbolv(def->name);
|
||||
const Janet *ret = NULL;
|
||||
#define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask))
|
||||
switch (janet_instructions[def->opcode]) {
|
||||
case JINT_0:
|
||||
return tup1(name);
|
||||
ret = tup1(name);
|
||||
break;
|
||||
case JINT_S:
|
||||
return tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF)));
|
||||
ret = tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF)));
|
||||
break;
|
||||
case JINT_L:
|
||||
return tup2(name, janet_wrap_integer((int32_t)instr >> 8));
|
||||
ret = tup2(name, janet_wrap_integer((int32_t)instr >> 8));
|
||||
break;
|
||||
case JINT_SS:
|
||||
case JINT_ST:
|
||||
case JINT_SC:
|
||||
case JINT_SU:
|
||||
case JINT_SD:
|
||||
return tup3(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFFFF)));
|
||||
ret = tup3(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFFFF)));
|
||||
break;
|
||||
case JINT_SI:
|
||||
case JINT_SL:
|
||||
return tup3(name,
|
||||
ret = tup3(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer((int32_t)instr >> 16));
|
||||
break;
|
||||
case JINT_SSS:
|
||||
case JINT_SES:
|
||||
case JINT_SSU:
|
||||
return tup4(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFF)),
|
||||
janet_wrap_integer(oparg(3, 0xFF)));
|
||||
ret = tup4(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFF)),
|
||||
janet_wrap_integer(oparg(3, 0xFF)));
|
||||
break;
|
||||
case JINT_SSI:
|
||||
return tup4(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFF)),
|
||||
janet_wrap_integer((int32_t)instr >> 24));
|
||||
ret = tup4(name,
|
||||
janet_wrap_integer(oparg(1, 0xFF)),
|
||||
janet_wrap_integer(oparg(2, 0xFF)),
|
||||
janet_wrap_integer((int32_t)instr >> 24));
|
||||
break;
|
||||
}
|
||||
#undef oparg
|
||||
if (ret) {
|
||||
/* Check if break point set */
|
||||
if (instr & 0x80) {
|
||||
janet_tuple_flag(ret) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
||||
}
|
||||
return janet_wrap_tuple(ret);
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -849,7 +864,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
Janet src = def->constants[i];
|
||||
Janet dest;
|
||||
if (janet_checktype(src, JANET_TUPLE)) {
|
||||
dest = tup2(janet_csymbolv("quote"), src);
|
||||
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
|
||||
} else {
|
||||
dest = src;
|
||||
}
|
||||
@@ -870,8 +885,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
Janet *t = janet_tuple_begin(2);
|
||||
JanetSourceMapping mapping = def->sourcemap[i];
|
||||
t[0] = janet_wrap_integer(mapping.start);
|
||||
t[1] = janet_wrap_integer(mapping.end);
|
||||
t[0] = janet_wrap_integer(mapping.line);
|
||||
t[1] = janet_wrap_integer(mapping.column);
|
||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||
}
|
||||
sourcemap->count = def->bytecode_length;
|
||||
|
||||
@@ -24,12 +24,14 @@
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Initialize a buffer */
|
||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||
uint8_t *data = NULL;
|
||||
if (capacity > 0) {
|
||||
janet_vm_next_collection += capacity;
|
||||
data = malloc(sizeof(uint8_t) * capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -57,8 +59,9 @@ 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;
|
||||
int64_t big_capacity = capacity * growth;
|
||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||
janet_vm_next_collection += capacity - buffer->capacity;
|
||||
new_data = realloc(old, capacity * sizeof(uint8_t));
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -90,6 +93,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = new_size * 2;
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_vm_next_collection += new_capacity - buffer->capacity;
|
||||
if (NULL == new_data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -238,8 +242,8 @@ static Janet cfun_buffer_popn(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_buffer_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetBuffer *buffer = janet_buffer(range.end - range.start);
|
||||
if (buffer->data)
|
||||
memcpy(buffer->data, view.bytes + range.start, range.end - range.start);
|
||||
|
||||
105
src/core/capi.c
105
src/core/capi.c
@@ -51,19 +51,6 @@ void janet_panicf(const char *format, ...) {
|
||||
janet_panics(ret);
|
||||
}
|
||||
|
||||
void janet_printf(const char *format, ...) {
|
||||
va_list args;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
va_start(args, format);
|
||||
janet_formatb(&buffer, format, args);
|
||||
va_end(args);
|
||||
fwrite(buffer.data, buffer.count, 1, janet_dynfile("out", stdout));
|
||||
janet_buffer_deinit(&buffer);
|
||||
}
|
||||
|
||||
void janet_panic(const char *message) {
|
||||
janet_panicv(janet_cstringv(message));
|
||||
}
|
||||
@@ -101,13 +88,27 @@ type janet_get##name(const Janet *argv, int32_t n) { \
|
||||
return janet_unwrap_##name(x); \
|
||||
}
|
||||
|
||||
#define DEFINE_OPT(name, NAME, type) \
|
||||
type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, type dflt) { \
|
||||
if (n >= argc) return dflt; \
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt; \
|
||||
return janet_get##name(argv, n); \
|
||||
}
|
||||
|
||||
#define DEFINE_OPTLEN(name, NAME, type) \
|
||||
type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len) { \
|
||||
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {\
|
||||
return janet_##name(dflt_len); \
|
||||
}\
|
||||
return janet_get##name(argv, n); \
|
||||
}
|
||||
|
||||
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();
|
||||
}
|
||||
|
||||
@@ -126,6 +127,26 @@ DEFINE_GETTER(cfunction, CFUNCTION, JanetCFunction)
|
||||
DEFINE_GETTER(boolean, BOOLEAN, int)
|
||||
DEFINE_GETTER(pointer, POINTER, void *)
|
||||
|
||||
DEFINE_OPT(number, NUMBER, double)
|
||||
DEFINE_OPT(tuple, TUPLE, const Janet *)
|
||||
DEFINE_OPT(struct, STRUCT, const JanetKV *)
|
||||
DEFINE_OPT(string, STRING, const uint8_t *)
|
||||
DEFINE_OPT(keyword, KEYWORD, const uint8_t *)
|
||||
DEFINE_OPT(symbol, SYMBOL, const uint8_t *)
|
||||
DEFINE_OPT(fiber, FIBER, JanetFiber *)
|
||||
DEFINE_OPT(function, FUNCTION, JanetFunction *)
|
||||
DEFINE_OPT(cfunction, CFUNCTION, JanetCFunction)
|
||||
DEFINE_OPT(boolean, BOOLEAN, int)
|
||||
DEFINE_OPT(pointer, POINTER, void *)
|
||||
|
||||
DEFINE_OPTLEN(buffer, BUFFER, JanetBuffer *)
|
||||
DEFINE_OPTLEN(table, TABLE, JanetTable *)
|
||||
DEFINE_OPTLEN(array, ARRAY, JanetArray *)
|
||||
|
||||
#undef DEFINE_GETTER
|
||||
#undef DEFINE_OPT
|
||||
#undef DEFINE_OPTLEN
|
||||
|
||||
const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
const uint8_t *jstr = janet_getstring(argv, n);
|
||||
const char *cstr = (const char *)jstr;
|
||||
@@ -135,10 +156,20 @@ const char *janet_getcstring(const Janet *argv, int32_t n) {
|
||||
return cstr;
|
||||
}
|
||||
|
||||
int32_t janet_getnat(const Janet *argv, int32_t n) {
|
||||
Janet x = argv[n];
|
||||
if (!janet_checkint(x)) goto bad;
|
||||
int32_t ret = janet_unwrap_integer(x);
|
||||
if (ret < 0) goto bad;
|
||||
return ret;
|
||||
bad:
|
||||
janet_panicf("bad slot #%d, expected non-negative 32 bit signed integer, got %v", n, x);
|
||||
}
|
||||
|
||||
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);
|
||||
janet_panicf("bad slot #%d, expected 32 bit signed integer, got %v", n, x);
|
||||
}
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
@@ -146,7 +177,7 @@ int32_t janet_getinteger(const Janet *argv, int32_t n) {
|
||||
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);
|
||||
janet_panicf("bad slot #%d, expected 64 bit signed integer, got %v", n, x);
|
||||
}
|
||||
return (int64_t) janet_unwrap_number(x);
|
||||
}
|
||||
@@ -222,11 +253,17 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
range.start = 0;
|
||||
range.end = length;
|
||||
} else if (argc == 2) {
|
||||
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: 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");
|
||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
||||
? 0
|
||||
: janet_gethalfrange(argv, 1, length, "start");
|
||||
range.end = janet_checktype(argv[2], JANET_NIL)
|
||||
? length
|
||||
: janet_gethalfrange(argv, 2, length, "end");
|
||||
if (range.end < range.start)
|
||||
range.end = range.start;
|
||||
}
|
||||
@@ -272,6 +309,36 @@ uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
int32_t janet_optnat(const Janet *argv, int32_t argc, int32_t n, int32_t dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getnat(argv, n);
|
||||
}
|
||||
|
||||
int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getinteger(argv, n);
|
||||
}
|
||||
|
||||
int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getinteger64(argv, n);
|
||||
}
|
||||
|
||||
size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getsize(argv, n);
|
||||
}
|
||||
|
||||
void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt) {
|
||||
if (argc <= n) return dflt;
|
||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
||||
return janet_getabstract(argv, n, at);
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||
|
||||
@@ -104,7 +104,7 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
|
||||
janetc_emit(opts.compiler, JOP_SIGNAL | (2 << 24));
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
|
||||
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
|
||||
}
|
||||
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
|
||||
@@ -275,7 +275,7 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{minarity2, do_apply},
|
||||
{maxarity1, do_yield},
|
||||
{fixarity2, do_resume},
|
||||
{fixarity2, do_get},
|
||||
{fixarity2, do_in},
|
||||
{fixarity3, do_put},
|
||||
{fixarity1, do_length},
|
||||
{NULL, do_add},
|
||||
|
||||
@@ -320,33 +320,46 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Push slots load via janetc_toslots. */
|
||||
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
||||
/* Push slots loaded via janetc_toslots. Return the minimum number of slots pushed,
|
||||
* or -1 - min_arity if there is a splice. (if there is no splice, min_arity is also
|
||||
* the maximum possible arity). */
|
||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
||||
int32_t i;
|
||||
int32_t count = janet_v_count(slots);
|
||||
int32_t min_arity = 0;
|
||||
int has_splice = 0;
|
||||
for (i = 0; i < count;) {
|
||||
if (slots[i].flags & JANET_SLOT_SPLICED) {
|
||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0);
|
||||
i++;
|
||||
has_splice = 1;
|
||||
} else if (i + 1 == count) {
|
||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||
i++;
|
||||
min_arity++;
|
||||
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
|
||||
i += 2;
|
||||
min_arity++;
|
||||
has_splice = 1;
|
||||
} else if (i + 2 == count) {
|
||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||
i += 2;
|
||||
min_arity += 2;
|
||||
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
|
||||
i += 3;
|
||||
min_arity += 2;
|
||||
has_splice = 1;
|
||||
} else {
|
||||
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
|
||||
i += 3;
|
||||
min_arity += 3;
|
||||
}
|
||||
}
|
||||
return has_splice ? (-1 - min_arity) : min_arity;
|
||||
}
|
||||
|
||||
/* Check if a list of slots has any spliced slots */
|
||||
@@ -403,7 +416,67 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
/* TODO janet function inlining (no c functions)*/
|
||||
}
|
||||
if (!specialized) {
|
||||
janetc_pushslots(c, slots);
|
||||
int32_t min_arity = janetc_pushslots(c, slots);
|
||||
/* Check for provably incorrect function calls */
|
||||
if (fun.flags & JANET_SLOT_CONSTANT) {
|
||||
|
||||
/* Check for bad arity type if fun is a constant */
|
||||
switch (janet_type(fun.constant)) {
|
||||
case JANET_FUNCTION: {
|
||||
JanetFunction *f = janet_unwrap_function(fun.constant);
|
||||
int32_t min = f->def->min_arity;
|
||||
int32_t max = f->def->max_arity;
|
||||
if (min_arity < 0) {
|
||||
/* Call has splices */
|
||||
min_arity = -1 - min_arity;
|
||||
if (min_arity > max && max >= 0) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at most %d argument, got at least %d",
|
||||
fun.constant, max, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
} else {
|
||||
/* Call has no splices */
|
||||
if (min_arity > max && max >= 0) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at most %d argument, got %d",
|
||||
fun.constant, max, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
if (min_arity < min) {
|
||||
const uint8_t *es = janet_formatc(
|
||||
"%v expects at least %d argument, got %d",
|
||||
fun.constant, min, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
case JANET_CFUNCTION:
|
||||
case JANET_ABSTRACT:
|
||||
break;
|
||||
case JANET_KEYWORD:
|
||||
if (min_arity == 0) {
|
||||
const uint8_t *es = janet_formatc("%v expects at least 1 argument, got 0",
|
||||
fun.constant);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
break;
|
||||
default:
|
||||
if (min_arity > 1 || min_arity == 0) {
|
||||
const uint8_t *es = janet_formatc("%v expects 1 argument, got %d",
|
||||
fun.constant, min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
if (min_arity < -2) {
|
||||
const uint8_t *es = janet_formatc("%v expects 1 argument, got at least %d",
|
||||
fun.constant, -1 - min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
if ((opts.flags & JANET_FOPTS_TAIL) &&
|
||||
/* Prevent top level tail calls for better errors */
|
||||
!(c->scope->flags & JANET_SCOPE_TOP)) {
|
||||
@@ -474,9 +547,9 @@ static int macroexpand1(
|
||||
if (janet_tuple_length(form) == 0)
|
||||
return 0;
|
||||
/* Source map - only set when we get a tuple */
|
||||
if (janet_tuple_sm_start(form) >= 0) {
|
||||
c->current_mapping.start = janet_tuple_sm_start(form);
|
||||
c->current_mapping.end = janet_tuple_sm_end(form);
|
||||
if (janet_tuple_sm_line(form) >= 0) {
|
||||
c->current_mapping.line = janet_tuple_sm_line(form);
|
||||
c->current_mapping.column = janet_tuple_sm_column(form);
|
||||
}
|
||||
/* Bracketed tuples are not specials or macros! */
|
||||
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||
@@ -555,7 +628,7 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
const Janet *tup = janet_unwrap_tuple(x);
|
||||
/* Empty tuple is tuple literal */
|
||||
if (janet_tuple_length(tup) == 0) {
|
||||
ret = janetc_cslot(x);
|
||||
ret = janetc_cslot(janet_wrap_tuple(janet_tuple_n(NULL, 0)));
|
||||
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||
ret = janetc_tuple(opts, x);
|
||||
} else {
|
||||
@@ -664,15 +737,15 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
|
||||
c->recursion_guard = JANET_RECURSION_GUARD;
|
||||
c->env = env;
|
||||
c->source = where;
|
||||
c->current_mapping.start = -1;
|
||||
c->current_mapping.end = -1;
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
c->result.funcdef = NULL;
|
||||
c->result.macrofiber = NULL;
|
||||
c->result.error_mapping.start = -1;
|
||||
c->result.error_mapping.end = -1;
|
||||
c->result.error_mapping.line = -1;
|
||||
c->result.error_mapping.column = -1;
|
||||
}
|
||||
|
||||
/* Deinitialize a compiler struct */
|
||||
@@ -733,8 +806,8 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
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));
|
||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
|
||||
@@ -34,7 +34,7 @@
|
||||
#define JANET_FUN_APPLY 3
|
||||
#define JANET_FUN_YIELD 4
|
||||
#define JANET_FUN_RESUME 5
|
||||
#define JANET_FUN_GET 6
|
||||
#define JANET_FUN_IN 6
|
||||
#define JANET_FUN_PUT 7
|
||||
#define JANET_FUN_LENGTH 8
|
||||
#define JANET_FUN_ADD 9
|
||||
@@ -214,7 +214,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||
|
||||
/* Push slots load via janetc_toslots. */
|
||||
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||
|
||||
/* Free slots loaded via janetc_toslots */
|
||||
void janetc_freeslots(JanetCompiler *c, JanetSlot *slots);
|
||||
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include <math.h>
|
||||
#include "compile.h"
|
||||
#include "state.h"
|
||||
#include "util.h"
|
||||
@@ -45,7 +46,14 @@ typedef int Clib;
|
||||
typedef HINSTANCE Clib;
|
||||
#define load_clib(name) LoadLibrary((name))
|
||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||
#define error_clib() "could not load dynamic library"
|
||||
static char error_clib_buf[256];
|
||||
static char *error_clib(void) {
|
||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
||||
return error_clib_buf;
|
||||
}
|
||||
#else
|
||||
#include <dlfcn.h>
|
||||
typedef void *Clib;
|
||||
@@ -218,6 +226,10 @@ static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
}
|
||||
dot_count = 0;
|
||||
} else {
|
||||
while (dot_count > 0) {
|
||||
--dot_count;
|
||||
*print++ = '.';
|
||||
}
|
||||
dot_count = -1;
|
||||
*print++ = *scan;
|
||||
}
|
||||
@@ -250,6 +262,61 @@ static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_get(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
Janet ds = argv[0];
|
||||
Janet key = argv[1];
|
||||
Janet dflt = argc == 3 ? argv[2] : janet_wrap_nil();
|
||||
JanetType t = janet_type(argv[0]);
|
||||
switch (t) {
|
||||
default:
|
||||
return dflt;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD: {
|
||||
if (!janet_checkint(key)) return dflt;
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return dflt;
|
||||
const uint8_t *str = janet_unwrap_string(ds);
|
||||
if (index >= janet_string_length(str)) return dflt;
|
||||
return janet_wrap_integer(str[index]);
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *abst = janet_unwrap_abstract(ds);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get) return dflt;
|
||||
return (type->get)(abst, key);
|
||||
}
|
||||
case JANET_ARRAY:
|
||||
case JANET_TUPLE: {
|
||||
if (!janet_checkint(key)) return dflt;
|
||||
int32_t index = janet_unwrap_integer(key);
|
||||
if (index < 0) return dflt;
|
||||
if (t == JANET_ARRAY) {
|
||||
JanetArray *a = janet_unwrap_array(ds);
|
||||
if (index >= a->count) return dflt;
|
||||
return a->data[index];
|
||||
} else {
|
||||
const Janet *t = janet_unwrap_tuple(ds);
|
||||
if (index >= janet_tuple_length(t)) return dflt;
|
||||
return t[index];
|
||||
}
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
JanetTable *flag = NULL;
|
||||
Janet ret = janet_table_get_ex(janet_unwrap_table(ds), key, &flag);
|
||||
if (flag == NULL) return dflt;
|
||||
return ret;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
const JanetKV *st = janet_unwrap_struct(ds);
|
||||
Janet ret = janet_struct_get(st, key);
|
||||
if (janet_checktype(ret, JANET_NIL)) return dflt;
|
||||
return ret;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -266,6 +333,7 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
janet_panicf("could not load native %S: %S", path, error);
|
||||
}
|
||||
init(env);
|
||||
janet_table_put(env, janet_ckeywordv("native"), argv[0]);
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
@@ -329,6 +397,21 @@ static Janet janet_core_array(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
|
||||
static Janet janet_core_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range;
|
||||
JanetByteView bview;
|
||||
JanetView iview;
|
||||
if (janet_bytes_view(argv[0], &bview.bytes, &bview.len)) {
|
||||
range = janet_getslice(argc, argv);
|
||||
return janet_stringv(bview.bytes + range.start, range.end - range.start);
|
||||
} else if (janet_indexed_view(argv[0], &iview.items, &iview.len)) {
|
||||
range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(iview.items + range.start, range.end - range.start));
|
||||
} else {
|
||||
janet_panic_type(argv[0], 0, JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_core_table(int32_t argc, Janet *argv) {
|
||||
int32_t i;
|
||||
if (argc & 1)
|
||||
@@ -447,6 +530,24 @@ static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num == (double)((int32_t)num));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
||||
double num = janet_unwrap_number(argv[0]);
|
||||
return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
|
||||
ret_false:
|
||||
return janet_wrap_false();
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
@@ -624,6 +725,29 @@ static const JanetReg corelib_cfuns[] = {
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files.")
|
||||
},
|
||||
{
|
||||
"int?", janet_core_check_int,
|
||||
JDOC("(int? x)\n\n"
|
||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"nat?", janet_core_check_nat,
|
||||
JDOC("(nat? x)\n\n"
|
||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
|
||||
},
|
||||
{
|
||||
"slice", janet_core_slice,
|
||||
JDOC("(slice x &opt start end)\n\n"
|
||||
"Extract a sub-range of an indexed data strutrue or byte sequence.")
|
||||
},
|
||||
{
|
||||
"get", janet_core_get,
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
|
||||
"Similar to get, but will not throw an error if the key is invalid for the data structure "
|
||||
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
|
||||
"an error.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -841,7 +965,11 @@ static const uint32_t resume_asm[] = {
|
||||
};
|
||||
static const uint32_t get_asm[] = {
|
||||
JOP_GET | (1 << 24),
|
||||
JOP_RETURN
|
||||
JOP_LOAD_NIL | (3 << 8),
|
||||
JOP_EQUALS | (3 << 8) | (3 << 24),
|
||||
JOP_JUMP_IF | (3 << 8) | (2 << 16),
|
||||
JOP_RETURN,
|
||||
JOP_RETURN | (2 << 8)
|
||||
};
|
||||
static const uint32_t put_asm[] = {
|
||||
JOP_PUT | (1 << 16) | (2 << 24),
|
||||
@@ -895,14 +1023,15 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"will be returned to the last yield in the case of a pending fiber, or the argument to "
|
||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||
janet_quick_asm(env, JANET_FUN_GET,
|
||||
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
|
||||
JDOC("(get ds key)\n\n"
|
||||
janet_quick_asm(env, JANET_FUN_IN,
|
||||
"in", 3, 2, 3, 4, get_asm, sizeof(get_asm),
|
||||
JDOC("(get ds key &opt dflt)\n\n"
|
||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||
"integer representations of bytes as result of a get call."));
|
||||
"integer representations of bytes as result of a get call. If no values is found, will return "
|
||||
"dflt or nil if no default is provided."));
|
||||
janet_quick_asm(env, JANET_FUN_PUT,
|
||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||
JDOC("(put ds key value)\n\n"
|
||||
|
||||
@@ -52,31 +52,35 @@ void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
||||
*/
|
||||
void janet_debug_find(
|
||||
JanetFuncDef **def_out, int32_t *pc_out,
|
||||
const uint8_t *source, int32_t offset) {
|
||||
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
||||
/* Scan the heap for right func def */
|
||||
JanetGCObject *current = janet_vm_blocks;
|
||||
/* Keep track of the best source mapping we have seen so far */
|
||||
int32_t besti = -1;
|
||||
int32_t best_range = INT32_MAX;
|
||||
int32_t best_line = -1;
|
||||
int32_t best_column = -1;
|
||||
JanetFuncDef *best_def = NULL;
|
||||
while (NULL != current) {
|
||||
if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) {
|
||||
JanetFuncDef *def = (JanetFuncDef *)(current + 1);
|
||||
JanetFuncDef *def = (JanetFuncDef *)(current);
|
||||
if (def->sourcemap &&
|
||||
def->source &&
|
||||
!janet_string_compare(source, def->source)) {
|
||||
/* Correct source file, check mappings. The chosen
|
||||
* pc index is the first match with the smallest range. */
|
||||
* pc index is the instruction closest to the given line column, but
|
||||
* not after. */
|
||||
int32_t i;
|
||||
for (i = 0; i < def->bytecode_length; i++) {
|
||||
int32_t start = def->sourcemap[i].start;
|
||||
int32_t end = def->sourcemap[i].end;
|
||||
if (end - start < best_range &&
|
||||
start <= offset &&
|
||||
end >= offset) {
|
||||
best_range = end - start;
|
||||
besti = i;
|
||||
best_def = def;
|
||||
int32_t line = def->sourcemap[i].line;
|
||||
int32_t column = def->sourcemap[i].column;
|
||||
if (line <= sourceLine && line >= best_line) {
|
||||
if (column <= sourceColumn &&
|
||||
(line > best_line || column > best_column)) {
|
||||
best_line = line;
|
||||
best_column = column;
|
||||
besti = i;
|
||||
best_def = def;
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -95,11 +99,13 @@ void janet_debug_find(
|
||||
* consitency with the top level code it is defined once. */
|
||||
void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
int32_t fi;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
const char *errstr = (const char *)janet_to_string(err);
|
||||
JanetFiber **fibers = NULL;
|
||||
int wrote_error = 0;
|
||||
|
||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
||||
if (print_color) janet_eprintf("\x1b[31m");
|
||||
|
||||
while (fiber) {
|
||||
janet_v_push(fibers, fiber);
|
||||
fiber = fiber->child;
|
||||
@@ -117,46 +123,48 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
if (!wrote_error) {
|
||||
JanetFiberStatus status = janet_fiber_status(fiber);
|
||||
const char *prefix = status == JANET_STATUS_ERROR ? "" : "status ";
|
||||
fprintf(out, "%s%s: %s\n",
|
||||
prefix,
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
janet_eprintf("%s%s: %s\n",
|
||||
prefix,
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
wrote_error = 1;
|
||||
}
|
||||
|
||||
fprintf(out, " in");
|
||||
janet_eprintf(" in");
|
||||
|
||||
if (frame->func) {
|
||||
def = frame->func->def;
|
||||
fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
janet_eprintf(" %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
if (def->source) {
|
||||
fprintf(out, " [%s]", (const char *)def->source);
|
||||
janet_eprintf(" [%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(out, " %s", (const char *)janet_to_string(name));
|
||||
janet_eprintf(" %s", (const char *)janet_to_string(name));
|
||||
else
|
||||
fprintf(out, " <cfunction>");
|
||||
janet_eprintf(" <cfunction>");
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
fprintf(out, " (tailcall)");
|
||||
janet_eprintf(" (tailcall)");
|
||||
if (frame->func && frame->pc) {
|
||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||
janet_eprintf(" on line %d, column %d", mapping.line, mapping.column);
|
||||
} else {
|
||||
fprintf(out, " pc=%d", off);
|
||||
janet_eprintf(" pc=%d", off);
|
||||
}
|
||||
}
|
||||
fprintf(out, "\n");
|
||||
janet_eprintf("\n");
|
||||
}
|
||||
}
|
||||
|
||||
if (print_color) janet_eprintf("\x1b[0m");
|
||||
|
||||
janet_v_free(fibers);
|
||||
}
|
||||
|
||||
@@ -167,10 +175,11 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
* Takes a source file name and byte offset. */
|
||||
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||
janet_fixarity(argc, 2);
|
||||
janet_fixarity(argc, 3);
|
||||
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);
|
||||
int32_t line = janet_getinteger(argv, 1);
|
||||
int32_t col = janet_getinteger(argv, 2);
|
||||
janet_debug_find(def, bytecode_offset, source, line, col);
|
||||
}
|
||||
|
||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||
@@ -257,8 +266,8 @@ static Janet doframe(JanetStackFrame *frame) {
|
||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
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));
|
||||
janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(mapping.line));
|
||||
janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(mapping.column));
|
||||
}
|
||||
if (def->source) {
|
||||
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||
@@ -308,17 +317,17 @@ 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 "
|
||||
"Sets a breakpoint with source a key at a given line and column. "
|
||||
"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_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 "
|
||||
JDOC("(debug/unbreak source line column)\n\n"
|
||||
"Remove a breakpoint with a source key at a given line and column. "
|
||||
"Will throw an error if the breakpoint "
|
||||
"cannot be found.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -50,6 +50,7 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_vm_next_collection += sizeof(Janet) * capacity;
|
||||
fiber->data = data;
|
||||
return fiber;
|
||||
}
|
||||
@@ -86,19 +87,27 @@ void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
||||
fiber->capacity = n;
|
||||
}
|
||||
|
||||
/* Grow fiber if needed */
|
||||
static void janet_fiber_grow(JanetFiber *fiber, int32_t needed) {
|
||||
int32_t cap = needed > (INT32_MAX / 2) ? INT32_MAX : 2 * needed;
|
||||
janet_fiber_setcapacity(fiber, cap);
|
||||
}
|
||||
|
||||
/* Push a value on the next stack frame */
|
||||
void janet_fiber_push(JanetFiber *fiber, Janet x) {
|
||||
if (fiber->stacktop == INT32_MAX) janet_panic("stack overflow");
|
||||
if (fiber->stacktop >= fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * fiber->stacktop);
|
||||
janet_fiber_grow(fiber, fiber->stacktop);
|
||||
}
|
||||
fiber->data[fiber->stacktop++] = x;
|
||||
}
|
||||
|
||||
/* Push 2 values on the next stack frame */
|
||||
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
|
||||
if (fiber->stacktop >= INT32_MAX - 1) janet_panic("stack overflow");
|
||||
int32_t newtop = fiber->stacktop + 2;
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
fiber->data[fiber->stacktop] = x;
|
||||
fiber->data[fiber->stacktop + 1] = y;
|
||||
@@ -107,9 +116,10 @@ void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
|
||||
|
||||
/* Push 3 values on the next stack frame */
|
||||
void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
|
||||
if (fiber->stacktop >= INT32_MAX - 2) janet_panic("stack overflow");
|
||||
int32_t newtop = fiber->stacktop + 3;
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
fiber->data[fiber->stacktop] = x;
|
||||
fiber->data[fiber->stacktop + 1] = y;
|
||||
@@ -119,9 +129,10 @@ void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
|
||||
|
||||
/* Push an array on the next stack frame */
|
||||
void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
if (fiber->stacktop > INT32_MAX - n) janet_panic("stack overflow");
|
||||
int32_t newtop = fiber->stacktop + n;
|
||||
if (newtop > fiber->capacity) {
|
||||
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||
janet_fiber_grow(fiber, newtop);
|
||||
}
|
||||
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||
fiber->stacktop = newtop;
|
||||
@@ -201,6 +212,7 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
||||
if (env) {
|
||||
size_t s = sizeof(Janet) * env->length;
|
||||
Janet *vmem = malloc(s);
|
||||
janet_vm_next_collection += (uint32_t) s;
|
||||
if (NULL == vmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
188
src/core/io.c
188
src/core/io.c
@@ -384,27 +384,195 @@ FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
return iofile->file;
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
FILE *f = janet_dynfile("out", stdout);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t j, len;
|
||||
const uint8_t *vstr = janet_to_string(argv[i]);
|
||||
len = janet_string_length(vstr);
|
||||
for (j = 0; j < len; ++j) {
|
||||
putc(vstr[j], f);
|
||||
static Janet cfun_io_print_impl(int32_t argc, Janet *argv,
|
||||
int newline, const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
janet_to_string_b(buf, argv[i]);
|
||||
}
|
||||
if (newline)
|
||||
janet_buffer_push_u8(buf, '\n');
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
}
|
||||
putc('\n', f);
|
||||
for (int32_t i = 0; i < argc; ++i) {
|
||||
int32_t len;
|
||||
const uint8_t *vstr;
|
||||
if (janet_checktype(argv[i], JANET_BUFFER)) {
|
||||
JanetBuffer *b = janet_unwrap_buffer(argv[i]);
|
||||
vstr = b->data;
|
||||
len = b->count;
|
||||
} else {
|
||||
vstr = janet_to_string(argv[i]);
|
||||
len = janet_string_length(vstr);
|
||||
}
|
||||
if (len) {
|
||||
if (1 != fwrite(vstr, len, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to (dyn :%s)", len, name);
|
||||
}
|
||||
}
|
||||
}
|
||||
if (newline)
|
||||
putc('\n', f);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_print(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_prin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprint(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 1, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprin(int32_t argc, Janet *argv) {
|
||||
return cfun_io_print_impl(argc, argv, 0, "err", stderr);
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf_impl(int32_t argc, Janet *argv,
|
||||
const char *name, FILE *dflt_file) {
|
||||
FILE *f;
|
||||
janet_arity(argc, 1, -1);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
Janet x = janet_dyn(name);
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
return janet_wrap_nil();
|
||||
case JANET_BUFFER: {
|
||||
/* Special case buffer */
|
||||
JanetBuffer *buf = janet_unwrap_buffer(x);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
case JANET_NIL:
|
||||
f = dflt_file;
|
||||
break;
|
||||
case JANET_ABSTRACT: {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
return janet_wrap_nil();
|
||||
IOFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
break;
|
||||
}
|
||||
}
|
||||
JanetBuffer *buf = janet_buffer(10);
|
||||
janet_buffer_format(buf, fmt, 0, argc, argv);
|
||||
if (buf->count) {
|
||||
if (1 != fwrite(buf->data, buf->count, 1, f)) {
|
||||
janet_panicf("could not print %d bytes to file", buf->count, name);
|
||||
}
|
||||
}
|
||||
/* Clear buffer to make things easier for GC */
|
||||
buf->count = 0;
|
||||
buf->capacity = 0;
|
||||
free(buf->data);
|
||||
buf->data = NULL;
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_printf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, "out", stdout);
|
||||
}
|
||||
|
||||
static Janet cfun_io_eprintf(int32_t argc, Janet *argv) {
|
||||
return cfun_io_printf_impl(argc, argv, "err", stderr);
|
||||
}
|
||||
|
||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
Janet x = janet_dyn(name);
|
||||
JanetType xtype = janet_type(x);
|
||||
switch (xtype) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
break;
|
||||
case JANET_NIL:
|
||||
case JANET_ABSTRACT: {
|
||||
FILE *f = dflt_file;
|
||||
JanetBuffer buffer;
|
||||
int32_t len = 0;
|
||||
while (format[len]) len++;
|
||||
janet_buffer_init(&buffer, len);
|
||||
janet_formatb(&buffer, format, args);
|
||||
if (xtype == JANET_ABSTRACT) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype)
|
||||
break;
|
||||
IOFile *iofile = abstract;
|
||||
f = iofile->file;
|
||||
}
|
||||
fwrite(buffer.data, buffer.count, 1, f);
|
||||
janet_buffer_deinit(&buffer);
|
||||
break;
|
||||
}
|
||||
case JANET_BUFFER:
|
||||
janet_formatb(janet_unwrap_buffer(x), format, args);
|
||||
break;
|
||||
}
|
||||
va_end(args);
|
||||
return;
|
||||
}
|
||||
|
||||
static const JanetReg io_cfuns[] = {
|
||||
{
|
||||
"print", cfun_io_print,
|
||||
JDOC("(print & xs)\n\n"
|
||||
"Print values to the console (standard out). Value are converted "
|
||||
"to strings if they are not already. After printing all values, a "
|
||||
"newline character is printed. Returns nil.")
|
||||
"newline character is printed. Use the value of (dyn :out stdout) to determine "
|
||||
"what to push characters to. Expects (dyn :out stdout) to be either a core/file or "
|
||||
"a buffer. Returns nil.")
|
||||
},
|
||||
{
|
||||
"prin", cfun_io_prin,
|
||||
JDOC("(prin & xs)\n\n"
|
||||
"Same as print, but does not add trailing newline.")
|
||||
},
|
||||
{
|
||||
"printf", cfun_io_printf,
|
||||
JDOC("(printf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :out stdout).")
|
||||
},
|
||||
{
|
||||
"eprin", cfun_io_eprin,
|
||||
JDOC("(eprin & xs)\n\n"
|
||||
"Same as prin, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||
},
|
||||
{
|
||||
"eprint", cfun_io_eprint,
|
||||
JDOC("(eprint & xs)\n\n"
|
||||
"Same as print, but uses (dyn :err stderr) instead of (dyn :out stdout).")
|
||||
},
|
||||
{
|
||||
"eprintf", cfun_io_eprintf,
|
||||
JDOC("(eprintf fmt & xs)\n\n"
|
||||
"Prints output formatted as if with (string/format fmt ;xs) to (dyn :err stderr).")
|
||||
},
|
||||
{
|
||||
"file/open", cfun_io_fopen,
|
||||
|
||||
@@ -84,19 +84,36 @@ static Janet entry_getval(Janet env_entry) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Make a forward lookup table from an environment (for unmarshaling) */
|
||||
JanetTable *janet_env_lookup(JanetTable *env) {
|
||||
JanetTable *renv = janet_table(env->count);
|
||||
/* Merge values from an environment into an existing lookup table. */
|
||||
void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
|
||||
while (env) {
|
||||
for (int32_t i = 0; i < env->capacity; i++) {
|
||||
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
|
||||
janet_table_put(renv,
|
||||
env->data[i].key,
|
||||
entry_getval(env->data[i].value));
|
||||
if (prefix) {
|
||||
int32_t prelen = (int32_t) strlen(prefix);
|
||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
||||
int32_t oldlen = janet_string_length(oldsym);
|
||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
||||
memcpy(symbuf, prefix, prelen);
|
||||
memcpy(symbuf + prelen, oldsym, oldlen);
|
||||
Janet s = janet_symbolv(symbuf, prelen + oldlen);
|
||||
janet_sfree(symbuf);
|
||||
janet_table_put(renv, s, entry_getval(env->data[i].value));
|
||||
} else {
|
||||
janet_table_put(renv,
|
||||
env->data[i].key,
|
||||
entry_getval(env->data[i].value));
|
||||
}
|
||||
}
|
||||
}
|
||||
env = env->proto;
|
||||
env = recurse ? env->proto : NULL;
|
||||
}
|
||||
}
|
||||
|
||||
/* Make a forward lookup table from an environment (for unmarshaling) */
|
||||
JanetTable *janet_env_lookup(JanetTable *env) {
|
||||
JanetTable *renv = janet_table(env->count);
|
||||
janet_env_lookup_into(renv, env, NULL, 1);
|
||||
return renv;
|
||||
}
|
||||
|
||||
@@ -241,9 +258,9 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
int32_t current = 0;
|
||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||
JanetSourceMapping map = def->sourcemap[i];
|
||||
pushint(st, map.start - current);
|
||||
pushint(st, map.end - map.start);
|
||||
current = map.end;
|
||||
pushint(st, map.line - current);
|
||||
pushint(st, map.column);
|
||||
current = map.line;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -810,9 +827,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
}
|
||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].start = current;
|
||||
current += readint(st, &data);
|
||||
def->sourcemap[i].end = current;
|
||||
def->sourcemap[i].line = current;
|
||||
def->sourcemap[i].column = readint(st, &data);
|
||||
}
|
||||
} else {
|
||||
def->sourcemap = NULL;
|
||||
@@ -1070,7 +1086,7 @@ static const uint8_t *unmarshal_one(
|
||||
#else
|
||||
memcpy(&u.bytes, data + 1, sizeof(double));
|
||||
#endif
|
||||
*out = janet_wrap_number(u.d);
|
||||
*out = janet_wrap_number_safe(u.d);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data + 9;
|
||||
}
|
||||
|
||||
140
src/core/math.c
140
src/core/math.c
@@ -27,19 +27,131 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
static JANET_THREAD_LOCAL JanetRNG janet_vm_rng = {0, 0, 0, 0, 0};
|
||||
|
||||
static Janet janet_rng_get(void *p, Janet key);
|
||||
|
||||
static void janet_rng_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = (JanetRNG *)p;
|
||||
janet_marshal_int(ctx, (int32_t) rng->a);
|
||||
janet_marshal_int(ctx, (int32_t) rng->b);
|
||||
janet_marshal_int(ctx, (int32_t) rng->c);
|
||||
janet_marshal_int(ctx, (int32_t) rng->d);
|
||||
janet_marshal_int(ctx, (int32_t) rng->counter);
|
||||
}
|
||||
|
||||
static void janet_rng_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
JanetRNG *rng = (JanetRNG *)p;
|
||||
rng->a = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->b = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->c = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->d = (uint32_t) janet_unmarshal_int(ctx);
|
||||
rng->counter = (uint32_t) janet_unmarshal_int(ctx);
|
||||
}
|
||||
|
||||
static JanetAbstractType JanetRNG_type = {
|
||||
"core/rng",
|
||||
NULL,
|
||||
NULL,
|
||||
janet_rng_get,
|
||||
NULL,
|
||||
janet_rng_marshal,
|
||||
janet_rng_unmarshal,
|
||||
NULL
|
||||
};
|
||||
|
||||
JanetRNG *janet_default_rng(void) {
|
||||
return &janet_vm_rng;
|
||||
}
|
||||
|
||||
void janet_rng_seed(JanetRNG *rng, uint32_t seed) {
|
||||
rng->a = seed + 123573u;
|
||||
rng->b = (seed + 43234283u) % 12391233u;
|
||||
rng->c = 0x17af0931u;
|
||||
rng->d = 0xFFFaaFFFu;
|
||||
rng->counter = 0u;
|
||||
}
|
||||
|
||||
uint32_t janet_rng_u32(JanetRNG *rng) {
|
||||
/* Algorithm "xorwow" from p. 5 of Marsaglia, "Xorshift RNGs" */
|
||||
uint32_t t = rng->d;
|
||||
uint32_t const s = rng->a;
|
||||
rng->d = rng->c;
|
||||
rng->c = rng->b;
|
||||
rng->b = s;
|
||||
t ^= t >> 2;
|
||||
t ^= t << 1;
|
||||
t ^= s ^ (s << 4);
|
||||
rng->a = t;
|
||||
rng->counter += 362437;
|
||||
return t + rng->counter;
|
||||
}
|
||||
|
||||
double janet_rng_double(JanetRNG *rng) {
|
||||
uint32_t hi = janet_rng_u32(rng);
|
||||
uint32_t lo = janet_rng_u32(rng);
|
||||
uint64_t big = (uint64_t)(lo) | (((uint64_t) hi) << 32);
|
||||
return ldexp((double)(big >> (64 - 52)), -52);
|
||||
}
|
||||
|
||||
static Janet cfun_rng_make(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
uint32_t seed = (uint32_t)(argc == 1 ? janet_getinteger(argv, 0) : 0);
|
||||
JanetRNG *rng = janet_abstract(&JanetRNG_type, sizeof(JanetRNG));
|
||||
janet_rng_seed(rng, seed);
|
||||
return janet_wrap_abstract(rng);
|
||||
}
|
||||
|
||||
static Janet cfun_rng_uniform(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
return janet_wrap_number(janet_rng_double(rng));
|
||||
}
|
||||
|
||||
static Janet cfun_rng_int(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetRNG *rng = janet_getabstract(argv, 0, &JanetRNG_type);
|
||||
if (argc == 1) {
|
||||
uint32_t word = janet_rng_u32(rng) >> 1;
|
||||
return janet_wrap_integer(word);
|
||||
} else {
|
||||
int32_t max = janet_optnat(argv, argc, 1, INT32_MAX);
|
||||
if (max == 0) return janet_wrap_number(0.0);
|
||||
uint32_t modulo = (uint32_t) max;
|
||||
uint32_t maxgen = INT32_MAX;
|
||||
uint32_t maxword = maxgen - (maxgen % modulo);
|
||||
uint32_t word;
|
||||
do {
|
||||
word = janet_rng_u32(rng) >> 1;
|
||||
} while (word > maxword);
|
||||
return janet_wrap_integer(word % modulo);
|
||||
}
|
||||
}
|
||||
|
||||
static const JanetMethod rng_methods[] = {
|
||||
{"uniform", cfun_rng_uniform},
|
||||
{"int", cfun_rng_int},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet janet_rng_get(void *p, Janet key) {
|
||||
(void) p;
|
||||
if (!janet_checktype(key, JANET_KEYWORD)) janet_panicf("expected keyword method");
|
||||
return janet_getmethod(janet_unwrap_keyword(key), rng_methods);
|
||||
}
|
||||
|
||||
/* Get a random number */
|
||||
static Janet janet_rand(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
double r = (rand() % RAND_MAX) / ((double) RAND_MAX);
|
||||
return janet_wrap_number(r);
|
||||
return janet_wrap_number(janet_rng_double(&janet_vm_rng));
|
||||
}
|
||||
|
||||
/* Seed the random number generator */
|
||||
static Janet janet_srand(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
int32_t x = janet_getinteger(argv, 0);
|
||||
srand((unsigned) x);
|
||||
janet_rng_seed(&janet_vm_rng, (uint32_t) x);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -108,7 +220,7 @@ static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"math/seedrandom", janet_srand,
|
||||
JDOC("(math/seedrandom seed)\n\n"
|
||||
"Set the seed for the random number generator. 'seed' should be an "
|
||||
"Set the seed for the random number generator. 'seed' should be "
|
||||
"an integer.")
|
||||
},
|
||||
{
|
||||
@@ -149,7 +261,7 @@ static const JanetReg math_cfuns[] = {
|
||||
{
|
||||
"math/log", janet_log,
|
||||
JDOC("(math/log x)\n\n"
|
||||
"Returns log base 2 of x.")
|
||||
"Returns log base natural number of x.")
|
||||
},
|
||||
{
|
||||
"math/log10", janet_log10,
|
||||
@@ -201,6 +313,24 @@ static const JanetReg math_cfuns[] = {
|
||||
JDOC("(math/atan2 y x)\n\n"
|
||||
"Return the arctangent of y/x. Works even when x is 0.")
|
||||
},
|
||||
{
|
||||
"math/rng", cfun_rng_make,
|
||||
JDOC("(math/rng &opt seed)\n\n"
|
||||
"Creates a Psuedo-Random number generator, with an optional seed. "
|
||||
"The seed should be an unsigned 32 bit integer. "
|
||||
"Do not use this for cryptography. Returns a core/rng abstract type.")
|
||||
},
|
||||
{
|
||||
"math/rng-uniform", cfun_rng_uniform,
|
||||
JDOC("(math/rng-seed rng seed)\n\n"
|
||||
"Extract a random number in the range [0, 1) from the RNG.")
|
||||
},
|
||||
{
|
||||
"math/rng-int", cfun_rng_int,
|
||||
JDOC("(math/rng-int rng &opt max)\n\n"
|
||||
"Extract a random random integer in the range [0, max] from the RNG. If "
|
||||
"no max is given, the default is 2^31 - 1.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
102
src/core/os.c
102
src/core/os.c
@@ -64,20 +64,60 @@ extern char **environ;
|
||||
|
||||
/* Full OS functions */
|
||||
|
||||
#define janet_stringify1(x) #x
|
||||
#define janet_stringify(x) janet_stringify1(x)
|
||||
|
||||
static Janet os_which(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
#ifdef JANET_WINDOWS
|
||||
#if defined(JANET_OS_NAME)
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_WINDOWS)
|
||||
return janet_ckeywordv("windows");
|
||||
#elif __APPLE__
|
||||
#elif defined(__APPLE__)
|
||||
return janet_ckeywordv("macos");
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("web");
|
||||
#elif defined(__linux__)
|
||||
return janet_ckeywordv("linux");
|
||||
#elif defined(__FreeBSD__)
|
||||
return janet_ckeywordv("freebsd");
|
||||
#elif defined(__NetBSD__)
|
||||
return janet_ckeywordv("netbsd");
|
||||
#elif defined(__OpenBSD__)
|
||||
return janet_ckeywordv("openbsd");
|
||||
#else
|
||||
return janet_ckeywordv("posix");
|
||||
#endif
|
||||
}
|
||||
|
||||
/* Detect the ISA we are compiled for */
|
||||
static Janet os_arch(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
/* Check 64-bit vs 32-bit */
|
||||
#if defined(JANET_ARCH_NAME)
|
||||
return janet_ckeywordv(janet_stringify(JANET_ARCH_NAME));
|
||||
#elif defined(__EMSCRIPTEN__)
|
||||
return janet_ckeywordv("wasm");
|
||||
#elif (defined(__x86_64__) || defined(_M_X64))
|
||||
return janet_ckeywordv("x86-64");
|
||||
#elif defined(__i386) || defined(_M_IX86)
|
||||
return janet_ckeywordv("x86");
|
||||
#elif defined(_M_ARM64) || defined(__aarch64__)
|
||||
return janet_ckeywordv("aarch64");
|
||||
#elif defined(_M_ARM) || defined(__arm__)
|
||||
return janet_ckeywordv("arm");
|
||||
#elif (defined(__sparc__))
|
||||
return janet_ckeywordv("sparc");
|
||||
#else
|
||||
return janet_ckeywordv("unknown");
|
||||
#endif
|
||||
}
|
||||
|
||||
#undef janet_stringify1
|
||||
#undef janet_stringify
|
||||
|
||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 0) {
|
||||
@@ -255,7 +295,7 @@ static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
JanetBuffer *buf = os_exec_escape(exargs);
|
||||
if (buf->count > 1025) {
|
||||
if (buf->count > 8191) {
|
||||
janet_panic("command line string too long");
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
@@ -434,16 +474,37 @@ static Janet os_cwd(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet os_date(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
janet_arity(argc, 0, 2);
|
||||
(void) argv;
|
||||
time_t t;
|
||||
struct tm *t_info;
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = NULL;
|
||||
if (argc) {
|
||||
t = (time_t) janet_getinteger64(argv, 0);
|
||||
int64_t integer = janet_getinteger64(argv, 0);
|
||||
if (integer < 0)
|
||||
janet_panicf("expected non-negative 64 bit signed integer, got %v", argv[0]);
|
||||
t = (time_t) integer;
|
||||
} else {
|
||||
time(&t);
|
||||
}
|
||||
t_info = localtime(&t);
|
||||
if (argc >= 2 && janet_truthy(argv[2])) {
|
||||
/* local time */
|
||||
#ifdef JANET_WINDOWS
|
||||
localtime_s(&t_infos, &t);
|
||||
t_info = &t_infos;
|
||||
#else
|
||||
tzset();
|
||||
t_info = localtime_r(&t, &t_infos);
|
||||
#endif
|
||||
} else {
|
||||
/* utc time */
|
||||
#ifdef JANET_WINDOWS
|
||||
gmtime_s(&t_infos, &t);
|
||||
t_info = &t_infos;
|
||||
#else
|
||||
t_info = gmtime_r(&t, &t_infos);
|
||||
#endif
|
||||
}
|
||||
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));
|
||||
@@ -761,8 +822,13 @@ 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:windows\n"
|
||||
"\t:macos\n"
|
||||
"\t:web - Web assembly (emscripten)\n"
|
||||
"\t:linux\n"
|
||||
"\t:freebsd\n"
|
||||
"\t:openbsd\n"
|
||||
"\t:netbsd\n"
|
||||
"\t:posix - A POSIX compatible system (default)")
|
||||
},
|
||||
{
|
||||
@@ -770,6 +836,18 @@ static const JanetReg os_cfuns[] = {
|
||||
JDOC("(os/getenv variable)\n\n"
|
||||
"Get the string value of an environment variable.")
|
||||
},
|
||||
{
|
||||
"os/arch", os_arch,
|
||||
JDOC("(os/arch)\n\n"
|
||||
"Check the ISA that janet was compiled for. Returns one of:\n\n"
|
||||
"\t:x86\n"
|
||||
"\t:x86-64\n"
|
||||
"\t:arm\n"
|
||||
"\t:aarch64\n"
|
||||
"\t:sparc\n"
|
||||
"\t:wasm\n"
|
||||
"\t:unknown\n")
|
||||
},
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
@@ -876,9 +954,11 @@ static const JanetReg os_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date &opt time)\n\n"
|
||||
JDOC("(os/date &opt time local)\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"
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless local is truthy, in which case the date is formated for "
|
||||
"the local timezone.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
"\t:hours - number of hours [0-23]\n"
|
||||
|
||||
@@ -42,7 +42,7 @@ static int is_whitespace(uint8_t c) {
|
||||
* if not. The upper characters are also considered symbol
|
||||
* chars and are then checked for utf-8 compliance. */
|
||||
static const uint32_t symchars[8] = {
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x17fffffe,
|
||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
||||
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
|
||||
};
|
||||
|
||||
@@ -106,7 +106,8 @@ struct JanetParseState {
|
||||
int32_t counter;
|
||||
int32_t argn;
|
||||
int flags;
|
||||
size_t start;
|
||||
size_t line;
|
||||
size_t column;
|
||||
Consumer consumer;
|
||||
};
|
||||
|
||||
@@ -153,7 +154,8 @@ static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||
s.argn = 0;
|
||||
s.flags = flags;
|
||||
s.consumer = consumer;
|
||||
s.start = p->offset;
|
||||
s.line = p->line;
|
||||
s.column = p->column;
|
||||
_pushstate(p, s);
|
||||
}
|
||||
|
||||
@@ -164,8 +166,8 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
/* Source mapping info */
|
||||
if (janet_checktype(val, JANET_TUPLE)) {
|
||||
janet_tuple_sm_start(janet_unwrap_tuple(val)) = (int32_t) top.start;
|
||||
janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset;
|
||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
||||
}
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
@@ -179,12 +181,13 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
(c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
(c == '|') ? "short-fn" :
|
||||
(c == '~') ? "quasiquote" : "<unknown>";
|
||||
t[0] = janet_csymbolv(which);
|
||||
t[1] = val;
|
||||
/* Quote source mapping info */
|
||||
janet_tuple_sm_start(t) = (int32_t) newtop->start;
|
||||
janet_tuple_sm_end(t) = (int32_t) p->offset;
|
||||
janet_tuple_sm_line(t) = (int32_t) newtop->line;
|
||||
janet_tuple_sm_column(t) = (int32_t) newtop->column;
|
||||
val = janet_wrap_tuple(janet_tuple_end(t));
|
||||
} else {
|
||||
return;
|
||||
@@ -294,7 +297,7 @@ static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
return stringend(p, state);
|
||||
}
|
||||
/* normal char */
|
||||
if (c != '\n')
|
||||
if (c != '\n' && c != '\r')
|
||||
push_buf(p, c);
|
||||
return 1;
|
||||
}
|
||||
@@ -492,6 +495,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
case ',':
|
||||
case ';':
|
||||
case '~':
|
||||
case '|':
|
||||
pushstate(p, root, PFLAG_READERMAC | c);
|
||||
return 1;
|
||||
case '"':
|
||||
@@ -560,7 +564,16 @@ static void janet_parser_checkdead(JanetParser *parser) {
|
||||
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||
int consumed = 0;
|
||||
janet_parser_checkdead(parser);
|
||||
parser->offset++;
|
||||
if (c == '\r') {
|
||||
parser->line++;
|
||||
parser->column = 0;
|
||||
} else if (c == '\n') {
|
||||
parser->column = 0;
|
||||
if (parser->lookback != '\r')
|
||||
parser->line++;
|
||||
} else {
|
||||
parser->column++;
|
||||
}
|
||||
while (!consumed && !parser->error) {
|
||||
JanetParseState *state = parser->states + parser->statecount - 1;
|
||||
consumed = state->consumer(parser, state, c);
|
||||
@@ -570,11 +583,14 @@ void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||
|
||||
void janet_parser_eof(JanetParser *parser) {
|
||||
janet_parser_checkdead(parser);
|
||||
size_t oldcolumn = parser->column;
|
||||
size_t oldline = parser->line;
|
||||
janet_parser_consume(parser, '\n');
|
||||
if (parser->statecount > 1) {
|
||||
parser->error = "unexpected end of source";
|
||||
}
|
||||
parser->offset--;
|
||||
parser->line = oldline;
|
||||
parser->column = oldcolumn;
|
||||
parser->flag = 1;
|
||||
}
|
||||
|
||||
@@ -628,7 +644,8 @@ void janet_parser_init(JanetParser *parser) {
|
||||
parser->statecap = 0;
|
||||
parser->error = NULL;
|
||||
parser->lookback = -1;
|
||||
parser->offset = 0;
|
||||
parser->line = 1;
|
||||
parser->column = 0;
|
||||
parser->pending = 0;
|
||||
parser->flag = 0;
|
||||
|
||||
@@ -646,7 +663,8 @@ void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
dest->flag = src->flag;
|
||||
dest->pending = src->pending;
|
||||
dest->lookback = src->lookback;
|
||||
dest->offset = src->offset;
|
||||
dest->line = src->line;
|
||||
dest->column = src->column;
|
||||
dest->error = src->error;
|
||||
|
||||
/* Keep counts */
|
||||
@@ -769,7 +787,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
JanetParseState *s = p->states + p->statecount - 1;
|
||||
if (s->consumer == tokenchar) {
|
||||
janet_parser_consume(p, ' ');
|
||||
p->offset--;
|
||||
p->column--;
|
||||
s = p->states + p->statecount - 1;
|
||||
}
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
@@ -853,15 +871,12 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
if (argc > 1) {
|
||||
int32_t offset = janet_getinteger(argv, 1);
|
||||
p->offset = offset;
|
||||
return argv[0];
|
||||
} else {
|
||||
return janet_wrap_integer(p->offset);
|
||||
}
|
||||
Janet *tup = janet_tuple_begin(2);
|
||||
tup[0] = janet_wrap_integer(p->line);
|
||||
tup[1] = janet_wrap_integer(p->column);
|
||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||
}
|
||||
|
||||
static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
@@ -926,8 +941,8 @@ static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
janet_table_put(state, janet_ckeywordv("buffer"), janet_wrap_string(buffer));
|
||||
}
|
||||
|
||||
janet_table_put(state, janet_ckeywordv("start"),
|
||||
janet_wrap_integer(s->start));
|
||||
janet_table_put(state, janet_ckeywordv("line"), janet_wrap_integer(s->line));
|
||||
janet_table_put(state, janet_ckeywordv("column"), janet_wrap_integer(s->column));
|
||||
return janet_wrap_table(state);
|
||||
}
|
||||
|
||||
@@ -1119,10 +1134,8 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/where", cfun_parse_where,
|
||||
JDOC("(parser/where parser &opt offset)\n\n"
|
||||
"Returns the current line number and column number of the parser's location "
|
||||
"in the byte stream as an index, counted from 0. "
|
||||
"If offset is supplied, then the byte offset is updated to that new value.")
|
||||
JDOC("(parser/where parser)\n\n"
|
||||
"Returns the current line number and column of the parser's internal state.")
|
||||
},
|
||||
{
|
||||
"parser/eof", cfun_parse_eof,
|
||||
|
||||
113
src/core/peg.c
113
src/core/peg.c
@@ -59,6 +59,7 @@ typedef enum {
|
||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||
RULE_ERROR, /* [rule] */
|
||||
RULE_DROP, /* [rule] */
|
||||
RULE_BACKMATCH, /* [tag] */
|
||||
} Opcode;
|
||||
|
||||
/* Hold captured patterns and match state */
|
||||
@@ -417,6 +418,24 @@ tail:
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
case RULE_BACKMATCH: {
|
||||
uint32_t search = rule[1];
|
||||
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
||||
if (s->tags->data[i] == search) {
|
||||
Janet capture = s->captures->data[i];
|
||||
if (!janet_checktype(capture, JANET_STRING))
|
||||
return NULL;
|
||||
const uint8_t *bytes = janet_unwrap_string(capture);
|
||||
int32_t len = janet_string_length(bytes);
|
||||
if (text + len > s->text_end)
|
||||
return NULL;
|
||||
return memcmp(text, bytes, len) ? NULL : text + len;
|
||||
}
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
|
||||
}
|
||||
}
|
||||
|
||||
@@ -426,7 +445,6 @@ tail:
|
||||
|
||||
typedef struct {
|
||||
JanetTable *grammar;
|
||||
JanetTable *memoized;
|
||||
JanetTable *tags;
|
||||
Janet *constants;
|
||||
uint32_t *bytecode;
|
||||
@@ -754,12 +772,20 @@ static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_2(r, RULE_GETTAG, search, tag);
|
||||
}
|
||||
|
||||
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
|
||||
static void spec_tag1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
||||
peg_arity(b, argc, 0, 1);
|
||||
Reserve r = reserve(b, 2);
|
||||
uint32_t tag = (argc) ? emit_tag(b, argv[0]) : 0;
|
||||
(void) argv;
|
||||
emit_1(r, RULE_POSITION, tag);
|
||||
emit_1(r, op, tag);
|
||||
}
|
||||
|
||||
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_tag1(b, argc, argv, RULE_POSITION);
|
||||
}
|
||||
|
||||
static void spec_backmatch(Builder *b, int32_t argc, const Janet *argv) {
|
||||
spec_tag1(b, argc, argv, RULE_BACKMATCH);
|
||||
}
|
||||
|
||||
static void spec_argument(Builder *b, int32_t argc, const Janet *argv) {
|
||||
@@ -824,6 +850,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"argument", spec_argument},
|
||||
{"at-least", spec_atleast},
|
||||
{"at-most", spec_atmost},
|
||||
{"backmatch", spec_backmatch},
|
||||
{"backref", spec_reference},
|
||||
{"between", spec_between},
|
||||
{"capture", spec_capture},
|
||||
@@ -850,27 +877,54 @@ static const SpecialPair peg_specials[] = {
|
||||
/* Compile a janet value into a rule and return the rule index. */
|
||||
static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
|
||||
/* Check for already compiled rules */
|
||||
Janet check = janet_table_get(b->memoized, peg);
|
||||
if (!janet_checktype(check, JANET_NIL)) {
|
||||
uint32_t rule = (uint32_t) janet_unwrap_number(check);
|
||||
return rule;
|
||||
}
|
||||
|
||||
/* Keep track of the form being compiled for error purposes */
|
||||
Janet old_form = b->form;
|
||||
JanetTable *old_grammar = b->grammar;
|
||||
b->form = peg;
|
||||
|
||||
/* Check depth */
|
||||
if (b->depth-- == 0) {
|
||||
peg_panic(b, "peg grammar recursed too deeply");
|
||||
/* Resolve keyword references */
|
||||
int i = JANET_RECURSION_GUARD;
|
||||
JanetTable *grammar = old_grammar;
|
||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
||||
peg = janet_table_get_ex(grammar, peg, &grammar);
|
||||
if (!grammar || janet_checktype(peg, JANET_NIL))
|
||||
peg_panic(b, "unkown rule");
|
||||
b->form = peg;
|
||||
b->grammar = grammar;
|
||||
}
|
||||
if (i == 0)
|
||||
peg_panic(b, "reference chain too deep");
|
||||
|
||||
/* Check cache - for tuples we check only the local cache, as
|
||||
* in a different grammar, the same tuple can compile to a different
|
||||
* rule - for example, (+ :a :b) depends on whatever :a and :b are bound to. */
|
||||
Janet check = janet_checktype(peg, JANET_TUPLE)
|
||||
? janet_table_rawget(grammar, peg)
|
||||
: janet_table_get(grammar, peg);
|
||||
if (!janet_checktype(check, JANET_NIL)) {
|
||||
b->form = old_form;
|
||||
b->grammar = old_grammar;
|
||||
return (uint32_t) janet_unwrap_number(check);
|
||||
}
|
||||
|
||||
/* Check depth */
|
||||
if (b->depth-- == 0)
|
||||
peg_panic(b, "peg grammar recursed too deeply");
|
||||
|
||||
/* The final rule to return */
|
||||
uint32_t rule = janet_v_count(b->bytecode);
|
||||
if (!janet_checktype(peg, JANET_KEYWORD) &&
|
||||
!janet_checktype(peg, JANET_STRUCT)) {
|
||||
janet_table_put(b->memoized, peg, janet_wrap_number(rule));
|
||||
|
||||
/* Add to cache. Do not cache structs, as we don't yet know
|
||||
* what rule they will return! We can just as effectively cache
|
||||
* the structs main rule. */
|
||||
if (!janet_checktype(peg, JANET_STRUCT)) {
|
||||
JanetTable *which_grammar = grammar;
|
||||
/* If we are a primitive pattern, add to the global cache (root grammar table) */
|
||||
if (!janet_checktype(peg, JANET_TUPLE)) {
|
||||
while (which_grammar->proto)
|
||||
which_grammar = which_grammar->proto;
|
||||
}
|
||||
janet_table_put(which_grammar, peg, janet_wrap_number(rule));
|
||||
}
|
||||
|
||||
switch (janet_type(peg)) {
|
||||
@@ -893,22 +947,22 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
emit_bytes(b, RULE_LITERAL, len, str);
|
||||
break;
|
||||
}
|
||||
case JANET_KEYWORD: {
|
||||
Janet check = janet_table_get(b->grammar, peg);
|
||||
if (janet_checktype(check, JANET_NIL))
|
||||
peg_panic(b, "unknown rule");
|
||||
rule = peg_compile1(b, check);
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT: {
|
||||
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
|
||||
grammar->proto = b->grammar;
|
||||
b->grammar = grammar;
|
||||
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
|
||||
/* Build grammar table */
|
||||
const JanetKV *st = janet_unwrap_struct(peg);
|
||||
JanetTable *new_grammar = janet_table(2 * janet_struct_capacity(st));
|
||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
||||
if (janet_checktype(st[i].key, JANET_KEYWORD)) {
|
||||
janet_table_put(new_grammar, st[i].key, st[i].value);
|
||||
}
|
||||
}
|
||||
new_grammar->proto = grammar;
|
||||
b->grammar = grammar = new_grammar;
|
||||
/* Run the main rule */
|
||||
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
|
||||
if (janet_checktype(main_rule, JANET_NIL))
|
||||
peg_panic(b, "grammar requires :main rule");
|
||||
rule = peg_compile1(b, main_rule);
|
||||
b->grammar = grammar->proto;
|
||||
break;
|
||||
}
|
||||
case JANET_TUPLE: {
|
||||
@@ -935,6 +989,7 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
/* Increase depth again */
|
||||
b->depth++;
|
||||
b->form = old_form;
|
||||
b->grammar = old_grammar;
|
||||
return rule;
|
||||
}
|
||||
|
||||
@@ -1029,6 +1084,7 @@ static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
case RULE_NOTNCHAR:
|
||||
case RULE_RANGE:
|
||||
case RULE_POSITION:
|
||||
case RULE_BACKMATCH:
|
||||
/* [1 word] */
|
||||
i += 2;
|
||||
break;
|
||||
@@ -1160,7 +1216,6 @@ static Peg *make_peg(Builder *b) {
|
||||
static Peg *compile_peg(Janet x) {
|
||||
Builder builder;
|
||||
builder.grammar = janet_table(0);
|
||||
builder.memoized = janet_table(0);
|
||||
builder.tags = janet_table(0);
|
||||
builder.constants = NULL;
|
||||
builder.bytecode = NULL;
|
||||
|
||||
@@ -30,7 +30,7 @@
|
||||
#endif
|
||||
|
||||
/* Implements a pretty printer for Janet. The pretty printer
|
||||
* is farily simple and not that flexible, but fast. */
|
||||
* is simple and not that flexible, but fast. */
|
||||
|
||||
/* Temporary buffer size */
|
||||
#define BUFSIZE 64
|
||||
@@ -310,7 +310,7 @@ struct pretty {
|
||||
|
||||
static void print_newline(struct pretty *S, int just_a_space) {
|
||||
int i;
|
||||
if (just_a_space) {
|
||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
return;
|
||||
}
|
||||
@@ -406,7 +406,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
} else {
|
||||
if (!isarray && len >= JANET_PRETTY_IND_ONELINE)
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
for (i = 0; i < len; i++) {
|
||||
@@ -725,12 +725,20 @@ void janet_buffer_format(
|
||||
janet_description_b(b, argv[arg]);
|
||||
break;
|
||||
}
|
||||
case 'Q':
|
||||
case 'q':
|
||||
case 'P':
|
||||
case 'p': { /* janet pretty , precision = depth */
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen);
|
||||
char c = strfrmt[-1];
|
||||
int has_color = (c == 'P') || (c == 'Q');
|
||||
int has_oneline = (c == 'Q') || (c == 'q');
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
|
||||
@@ -28,7 +28,6 @@
|
||||
/* Run a string */
|
||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||
JanetParser parser;
|
||||
FILE *errf = janet_dynfile("err", stderr);
|
||||
int errflags = 0, done = 0;
|
||||
int32_t index = 0;
|
||||
Janet ret = janet_wrap_nil();
|
||||
@@ -56,8 +55,13 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
fprintf(errf, "compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
if (cres.macrofiber) {
|
||||
janet_eprintf("compile error in %s: ", sourcePath);
|
||||
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
|
||||
} else {
|
||||
janet_eprintf("compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
}
|
||||
errflags |= 0x02;
|
||||
done = 1;
|
||||
}
|
||||
@@ -70,8 +74,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
errflags |= 0x04;
|
||||
fprintf(errf, "parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
janet_eprintf("parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
done = 1;
|
||||
break;
|
||||
case JANET_PARSE_PENDING:
|
||||
|
||||
@@ -175,8 +175,8 @@ static int destructure(JanetCompiler *c,
|
||||
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||
Janet *tup = janet_tuple_begin(3);
|
||||
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
||||
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
||||
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
||||
tup[1] = janet_wrap_integer(c->current_mapping.line);
|
||||
tup[2] = janet_wrap_integer(c->current_mapping.column);
|
||||
return janet_tuple_end(tup);
|
||||
}
|
||||
|
||||
@@ -602,6 +602,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
|
||||
janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
|
||||
janetc_emit(c, JOP_TAILCALL | (tempself << 8));
|
||||
janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0);
|
||||
/* Compile function */
|
||||
JanetFuncDef *def = janetc_pop_funcdef(c);
|
||||
def->name = janet_cstring("_while");
|
||||
@@ -610,7 +611,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
||||
janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
|
||||
janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
|
||||
janetc_regalloc_free(&c->scope->ra, cloreg);
|
||||
janetc_regalloc_freetemp(&c->scope->ra, cloreg, JANETC_REGTEMP_0);
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
return janetc_cslot(janet_wrap_nil());
|
||||
}
|
||||
@@ -660,8 +661,8 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||
janetc_scope(&fnscope, c, JANET_SCOPE_FUNCTION, "function");
|
||||
|
||||
if (argn < 2) {
|
||||
errmsg = "expected at least 2 arguments to function literal";
|
||||
if (argn == 0) {
|
||||
errmsg = "expected at least 1 argument to function literal";
|
||||
goto error;
|
||||
}
|
||||
|
||||
|
||||
@@ -104,6 +104,9 @@ static void kmp_init(
|
||||
struct kmp_state *s,
|
||||
const uint8_t *text, int32_t textlen,
|
||||
const uint8_t *pat, int32_t patlen) {
|
||||
if (patlen == 0) {
|
||||
janet_panic("expected non-empty pattern");
|
||||
}
|
||||
int32_t *lookup = calloc(patlen, sizeof(int32_t));
|
||||
if (!lookup) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@@ -167,8 +170,8 @@ static int32_t kmp_next(struct kmp_state *state) {
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_string_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_stringv(view.bytes + range.start, range.end - range.start);
|
||||
}
|
||||
|
||||
@@ -378,15 +381,13 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
}
|
||||
findsetup(argc, argv, &state, 1);
|
||||
array = janet_array(0);
|
||||
while ((result = kmp_next(&state)) >= 0 && limit--) {
|
||||
while ((result = kmp_next(&state)) >= 0 && --limit) {
|
||||
const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex);
|
||||
janet_array_push(array, janet_wrap_string(slice));
|
||||
lastindex = result + state.patlen;
|
||||
}
|
||||
{
|
||||
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
|
||||
janet_array_push(array, janet_wrap_string(slice));
|
||||
}
|
||||
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
|
||||
janet_array_push(array, janet_wrap_string(slice));
|
||||
kmp_deinit(&state);
|
||||
return janet_wrap_array(array);
|
||||
}
|
||||
@@ -499,6 +500,8 @@ static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
if (right_edge < left_edge)
|
||||
return janet_stringv(NULL, 0);
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
}
|
||||
|
||||
@@ -600,10 +603,12 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/split", cfun_string_split,
|
||||
JDOC("(string/split delim str)\n\n"
|
||||
JDOC("(string/split delim str &opt start limit)\n\n"
|
||||
"Splits a string str with delimiter delim and returns an array of "
|
||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||
"is not found, the returned array will have one element.")
|
||||
"is not found, the returned array will have one element. Will start searching "
|
||||
"for delim at the index start (if provided), and return up to a maximum "
|
||||
"of limit results (if provided).")
|
||||
},
|
||||
{
|
||||
"string/check-set", cfun_string_checkset,
|
||||
|
||||
@@ -137,6 +137,27 @@ Janet janet_table_get(JanetTable *t, Janet key) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get a value out of the table, and record which prototype it was from. */
|
||||
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
*which = t;
|
||||
return bucket->value;
|
||||
}
|
||||
/* Check prototypes */
|
||||
{
|
||||
int i;
|
||||
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
|
||||
bucket = janet_table_find(t, key);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
||||
*which = t;
|
||||
return bucket->value;
|
||||
}
|
||||
}
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Get a value out of the table. Don't check prototype tables. */
|
||||
Janet janet_table_rawget(JanetTable *t, Janet key) {
|
||||
JanetKV *bucket = janet_table_find(t, key);
|
||||
@@ -211,7 +232,10 @@ const JanetKV *janet_table_to_struct(JanetTable *t) {
|
||||
/* Clone a table. */
|
||||
JanetTable *janet_table_clone(JanetTable *table) {
|
||||
JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||
memcpy(newTable, table, sizeof(JanetTable));
|
||||
newTable->count = table->count;
|
||||
newTable->capacity = table->capacity;
|
||||
newTable->deleted = table->deleted;
|
||||
newTable->proto = table->proto;
|
||||
newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
|
||||
if (NULL == newTable->data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
|
||||
@@ -33,8 +33,8 @@
|
||||
Janet *janet_tuple_begin(int32_t length) {
|
||||
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||
head->sm_start = -1;
|
||||
head->sm_end = -1;
|
||||
head->sm_line = -1;
|
||||
head->sm_column = -1;
|
||||
head->length = length;
|
||||
return (Janet *)(head->data);
|
||||
}
|
||||
@@ -100,8 +100,8 @@ static Janet cfun_tuple_brackets(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_slice(int32_t argc, Janet *argv) {
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
JanetView view = janet_getindexed(argv, 0);
|
||||
JanetRange range = janet_getslice(argc, argv);
|
||||
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));
|
||||
}
|
||||
|
||||
@@ -119,16 +119,16 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
Janet contents[2];
|
||||
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start);
|
||||
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end);
|
||||
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_line);
|
||||
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_column);
|
||||
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||
}
|
||||
|
||||
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 3);
|
||||
const Janet *tup = janet_gettuple(argv, 0);
|
||||
janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1);
|
||||
janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2);
|
||||
janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
|
||||
janet_tuple_head(tup)->sm_column = janet_getinteger(argv, 2);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -158,16 +158,14 @@ static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||
JDOC("(tuple/sourcemap tup)\n\n"
|
||||
"Returns the sourcemap metadata attached to a tuple. "
|
||||
"The mapping is represented by a pair of byte offsets into the "
|
||||
"the source code representing the start and end byte indices where "
|
||||
"the tuple is. ")
|
||||
"Returns the sourcemap metadata attached to a tuple, "
|
||||
" which is another tuple (line, column).")
|
||||
},
|
||||
{
|
||||
"tuple/setmap", cfun_tuple_setmap,
|
||||
JDOC("(tuple/setmap tup start end)\n\n"
|
||||
"Set the sourcemap metadata on a tuple. start and end should "
|
||||
"be integers representing byte offsets into the file. Returns tup.")
|
||||
JDOC("(tuple/setmap tup line column)\n\n"
|
||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
||||
"should be integers.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -159,10 +159,14 @@ static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
view->as.u8 = view->buffer->data + offset;
|
||||
}
|
||||
|
||||
static JanetMethod tarray_view_methods[6];
|
||||
|
||||
static Janet ta_getter(void *p, Janet key) {
|
||||
Janet value;
|
||||
size_t index, i;
|
||||
JanetTArrayView *array = p;
|
||||
if (janet_checktype(key, JANET_KEYWORD))
|
||||
return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods);
|
||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||
index = (size_t) janet_unwrap_number(key);
|
||||
i = index * array->stride;
|
||||
@@ -197,10 +201,10 @@ static Janet ta_getter(void *p, Janet key) {
|
||||
break;
|
||||
#endif
|
||||
case JANET_TARRAY_TYPE_F32:
|
||||
value = janet_wrap_number(array->as.f32[i]);
|
||||
value = janet_wrap_number_safe(array->as.f32[i]);
|
||||
break;
|
||||
case JANET_TARRAY_TYPE_F64:
|
||||
value = janet_wrap_number(array->as.f64[i]);
|
||||
value = janet_wrap_number_safe(array->as.f64[i]);
|
||||
break;
|
||||
default:
|
||||
janet_panicf("cannot get from typed array of type %s",
|
||||
@@ -551,6 +555,15 @@ static const JanetReg ta_cfuns[] = {
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
static JanetMethod tarray_view_methods[] = {
|
||||
{"length", cfun_typed_array_size},
|
||||
{"properties", cfun_typed_array_properties},
|
||||
{"copy-bytes", cfun_typed_array_copy_bytes},
|
||||
{"swap-bytes", cfun_typed_array_swap_bytes},
|
||||
{"slice", cfun_typed_array_slice},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
/* Module entry point */
|
||||
void janet_lib_typed_array(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||
|
||||
@@ -145,6 +145,16 @@ int janet_compare(Janet x, Janet y) {
|
||||
return (janet_type(x) < janet_type(y)) ? -1 : 1;
|
||||
}
|
||||
|
||||
static int32_t getter_checkint(Janet key, int32_t max) {
|
||||
if (!janet_checkint(key)) goto bad;
|
||||
int32_t ret = janet_unwrap_integer(key);
|
||||
if (ret < 0) goto bad;
|
||||
if (ret >= max) goto bad;
|
||||
return ret;
|
||||
bad:
|
||||
janet_panicf("expected integer key in range [0, %d), got %v", max, key);
|
||||
}
|
||||
|
||||
/* Gets a value and returns. Can panic. */
|
||||
Janet janet_get(Janet ds, Janet key) {
|
||||
Janet value;
|
||||
@@ -160,56 +170,28 @@ Janet janet_get(Janet ds, Janet 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];
|
||||
}
|
||||
int32_t index = getter_checkint(key, array->count);
|
||||
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];
|
||||
}
|
||||
int32_t len = janet_tuple_length(tuple);
|
||||
value = tuple[getter_checkint(key, len)];
|
||||
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]);
|
||||
}
|
||||
int32_t index = getter_checkint(key, buffer->count);
|
||||
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]);
|
||||
}
|
||||
int32_t index = getter_checkint(key, janet_string_length(str));
|
||||
value = janet_wrap_integer(str[index]);
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
@@ -299,6 +281,38 @@ int32_t janet_length(Janet x) {
|
||||
return janet_struct_length(janet_unwrap_struct(x));
|
||||
case JANET_TABLE:
|
||||
return janet_unwrap_table(x)->count;
|
||||
case JANET_ABSTRACT: {
|
||||
Janet argv[1] = { x };
|
||||
Janet len = janet_mcall("length", 1, argv);
|
||||
if (!janet_checkint(len))
|
||||
janet_panicf("invalid integer length %v", len);
|
||||
return janet_unwrap_integer(len);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
Janet janet_lengthv(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
return janet_wrap_integer(janet_string_length(janet_unwrap_string(x)));
|
||||
case JANET_ARRAY:
|
||||
return janet_wrap_integer(janet_unwrap_array(x)->count);
|
||||
case JANET_BUFFER:
|
||||
return janet_wrap_integer(janet_unwrap_buffer(x)->count);
|
||||
case JANET_TUPLE:
|
||||
return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x)));
|
||||
case JANET_STRUCT:
|
||||
return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x)));
|
||||
case JANET_TABLE:
|
||||
return janet_wrap_integer(janet_unwrap_table(x)->count);
|
||||
case JANET_ABSTRACT: {
|
||||
Janet argv[1] = { x };
|
||||
return janet_mcall("length", 1, argv);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
@@ -324,7 +338,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
janet_buffer_ensure(buffer, index + 1, 2);
|
||||
buffer->count = index + 1;
|
||||
}
|
||||
buffer->data[index] = janet_unwrap_integer(value);
|
||||
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
||||
break;
|
||||
}
|
||||
case JANET_TABLE: {
|
||||
@@ -350,11 +364,8 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
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);
|
||||
int32_t index = getter_checkint(key, INT32_MAX - 1);
|
||||
if (index >= array->count) {
|
||||
janet_array_setcount(array, index + 1);
|
||||
}
|
||||
@@ -362,11 +373,8 @@ void janet_put(Janet ds, Janet key, Janet 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);
|
||||
int32_t index = getter_checkint(key, INT32_MAX - 1);
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
|
||||
@@ -30,7 +30,8 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
||||
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
||||
int32_t min_needed = janet_v_count(v) + increment;
|
||||
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
||||
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||
size_t newsize = ((size_t) itemsize) * m + sizeof(int32_t) * 2;
|
||||
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, newsize);
|
||||
if (!v) p[1] = 0;
|
||||
p[0] = m;
|
||||
return p + 2;
|
||||
|
||||
289
src/core/vm.c
289
src/core/vm.c
@@ -57,7 +57,11 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
/* How we dispatch instructions. By default, we use
|
||||
* a switch inside an infinite loop. For GCC/clang, we use
|
||||
* computed gotos. */
|
||||
#ifdef __GNUC__
|
||||
#if defined(__GNUC__) && !defined(__EMSCRIPTEN__)
|
||||
#define JANET_USE_COMPUTED_GOTOS
|
||||
#endif
|
||||
|
||||
#ifdef JANET_USE_COMPUTED_GOTOS
|
||||
#define VM_START() { goto *op_lookup[first_opcode];
|
||||
#define VM_END() }
|
||||
#define VM_OP(op) label_##op :
|
||||
@@ -113,9 +117,16 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
stack[A] = janet_wrap_number(x1 op CS);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define _vm_bitop_immediate(op, type1)\
|
||||
{\
|
||||
@@ -131,12 +142,19 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
Janet op2 = stack[C];\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
||||
vm_commit();\
|
||||
Janet _argv[2] = { op1, op2 };\
|
||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_assert_type(op1, JANET_NUMBER);\
|
||||
vm_assert_type(op2, JANET_NUMBER);\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = janet_unwrap_number(op2);\
|
||||
stack[A] = wrap(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
|
||||
@@ -175,7 +193,7 @@ static void vm_do_trace(JanetFunction *func) {
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
Janet ds, key;
|
||||
if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn);
|
||||
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
|
||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||
ds = callee;
|
||||
@@ -188,11 +206,21 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
return janet_get(ds, key);
|
||||
}
|
||||
|
||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
||||
Janet callee = janet_get(fiber->data[fiber->stackstart], name);
|
||||
if (janet_checktype(callee, JANET_NIL))
|
||||
janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
|
||||
return callee;
|
||||
}
|
||||
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||
|
||||
/* opcode -> label lookup if using clang/GCC */
|
||||
#ifdef __GNUC__
|
||||
#ifdef JANET_USE_COMPUTED_GOTOS
|
||||
static void *op_lookup[255] = {
|
||||
&&label_JOP_NOOP,
|
||||
&&label_JOP_ERROR,
|
||||
@@ -263,6 +291,191 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
@@ -582,9 +795,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||
vm_commit();
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call takes at least 1 argument, got %d", argc);
|
||||
callee = janet_get(fiber->data[fiber->stackstart], callee);
|
||||
callee = resolve_method(callee, fiber);
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
@@ -616,11 +827,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
|
||||
VM_OP(JOP_TAILCALL) {
|
||||
Janet callee = stack[D];
|
||||
if (fiber->stacktop > fiber->maxstack) {
|
||||
vm_throw("stack overflow");
|
||||
}
|
||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||
vm_commit();
|
||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||
if (argc < 1) janet_panicf("method call takes at least 1 argument, got %d", argc);
|
||||
callee = janet_get(fiber->data[fiber->stackstart], callee);
|
||||
callee = resolve_method(callee, fiber);
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
@@ -680,12 +892,12 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
Janet fv = stack[C];
|
||||
vm_assert_type(fv, JANET_FIBER);
|
||||
JanetFiber *f = janet_unwrap_fiber(fv);
|
||||
JanetFiberStatus status = janet_fiber_status(f);
|
||||
if (status > JANET_STATUS_USER9) {
|
||||
JanetFiberStatus sub_status = janet_fiber_status(f);
|
||||
if (sub_status > JANET_STATUS_USER9) {
|
||||
vm_throw("cannot propagate from new or alive fiber");
|
||||
}
|
||||
janet_vm_fiber->child = f;
|
||||
vm_return((int) status, stack[B]);
|
||||
vm_return((int) sub_status, stack[B]);
|
||||
}
|
||||
|
||||
VM_OP(JOP_PUT)
|
||||
@@ -710,7 +922,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
|
||||
VM_OP(JOP_LENGTH)
|
||||
vm_commit();
|
||||
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
||||
stack[A] = janet_lengthv(stack[E]);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_MAKE_ARRAY) {
|
||||
@@ -906,6 +1118,37 @@ JanetSignal janet_pcall(
|
||||
return janet_continue(fiber, janet_wrap_nil(), out);
|
||||
}
|
||||
|
||||
Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
||||
/* At least 1 argument */
|
||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
||||
/* Find method */
|
||||
Janet method;
|
||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
||||
void *abst = janet_unwrap_abstract(argv[0]);
|
||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
||||
if (!type->get)
|
||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
||||
method = (type->get)(abst, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
||||
method = janet_table_get(table, janet_ckeywordv(name));
|
||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
||||
} else {
|
||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
||||
}
|
||||
/* Invoke method */
|
||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
||||
JanetFunction *fun = janet_unwrap_function(method);
|
||||
return janet_call(fun, argc, argv);
|
||||
} else {
|
||||
janet_panicf("method %s has unexpected value %v", name, method);
|
||||
}
|
||||
}
|
||||
|
||||
/* Setup VM */
|
||||
int janet_init(void) {
|
||||
/* Garbage collection */
|
||||
@@ -928,6 +1171,8 @@ int janet_init(void) {
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
/* Seed RNG */
|
||||
janet_rng_seed(janet_default_rng(), 0);
|
||||
return 0;
|
||||
}
|
||||
|
||||
|
||||
@@ -21,8 +21,10 @@
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <math.h>
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
/* Macro fills */
|
||||
@@ -160,6 +162,7 @@ Janet(janet_wrap_number)(double x) {
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
janet_vm_next_collection += count * sizeof(JanetKV);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
@@ -182,6 +185,12 @@ void janet_memempty(JanetKV *mem, int32_t count) {
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
|
||||
Janet janet_wrap_number_safe(double d) {
|
||||
Janet ret;
|
||||
ret.number = isnan(d) ? NAN : d;
|
||||
return ret;
|
||||
}
|
||||
|
||||
void *janet_nanbox_to_pointer(Janet x) {
|
||||
x.i64 &= JANET_NANBOX_PAYLOADBITS;
|
||||
return x.pointer;
|
||||
@@ -222,6 +231,11 @@ Janet janet_wrap_number(double x) {
|
||||
return ret;
|
||||
}
|
||||
|
||||
Janet janet_wrap_number_safe(double d) {
|
||||
double x = isnan(d) ? NAN : d;
|
||||
return janet_wrap_number(x);
|
||||
}
|
||||
|
||||
Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer) {
|
||||
Janet ret;
|
||||
ret.tagged.type = tag;
|
||||
@@ -243,6 +257,10 @@ double janet_unwrap_number(Janet x) {
|
||||
|
||||
#else
|
||||
|
||||
Janet janet_wrap_number_safe(double d) {
|
||||
return janet_wrap_number(d);
|
||||
}
|
||||
|
||||
Janet janet_wrap_nil(void) {
|
||||
Janet y;
|
||||
y.type = JANET_NIL;
|
||||
@@ -298,3 +316,4 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
||||
#undef JANET_WRAP_DEFINE
|
||||
|
||||
#endif
|
||||
|
||||
|
||||
@@ -171,11 +171,10 @@ extern "C" {
|
||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||
#define JANET_MAX_MACRO_EXPAND 200
|
||||
|
||||
/* Define max stack size for stacks before raising a stack overflow error.
|
||||
* If this is not defined, fiber stacks can grow without limit (until memory
|
||||
* runs out) */
|
||||
/* Define default max stack size for stacks before raising a stack overflow error.
|
||||
* This can also be set on a per fiber basis. */
|
||||
#ifndef JANET_STACK_MAX
|
||||
#define JANET_STACK_MAX 16384
|
||||
#define JANET_STACK_MAX 0x7fffffff
|
||||
#endif
|
||||
|
||||
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
||||
@@ -238,9 +237,9 @@ typedef struct {
|
||||
#include <stdio.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
JANET_API const char *const janet_type_names[16];
|
||||
JANET_API const char *const janet_signal_names[14];
|
||||
JANET_API const char *const janet_status_names[16];
|
||||
JANET_API extern const char *const janet_type_names[16];
|
||||
JANET_API extern const char *const janet_signal_names[14];
|
||||
JANET_API extern const char *const janet_status_names[16];
|
||||
|
||||
/* Fiber signals */
|
||||
typedef enum {
|
||||
@@ -317,6 +316,7 @@ typedef struct JanetView JanetView;
|
||||
typedef struct JanetByteView JanetByteView;
|
||||
typedef struct JanetDictView JanetDictView;
|
||||
typedef struct JanetRange JanetRange;
|
||||
typedef struct JanetRNG JanetRNG;
|
||||
typedef Janet(*JanetCFunction)(int32_t argc, Janet *argv);
|
||||
|
||||
/* Basic types for all Janet Values */
|
||||
@@ -756,8 +756,8 @@ struct JanetTupleHead {
|
||||
JanetGCObject gc;
|
||||
int32_t length;
|
||||
int32_t hash;
|
||||
int32_t sm_start;
|
||||
int32_t sm_end;
|
||||
int32_t sm_line;
|
||||
int32_t sm_column;
|
||||
const Janet data[];
|
||||
};
|
||||
|
||||
@@ -799,8 +799,8 @@ struct JanetAbstractHead {
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
struct JanetSourceMapping {
|
||||
int32_t start;
|
||||
int32_t end;
|
||||
int32_t line;
|
||||
int32_t column;
|
||||
};
|
||||
|
||||
/* A function definition. Contains information needed to instantiate closures. */
|
||||
@@ -870,7 +870,8 @@ struct JanetParser {
|
||||
size_t statecap;
|
||||
size_t bufcount;
|
||||
size_t bufcap;
|
||||
size_t offset;
|
||||
size_t line;
|
||||
size_t column;
|
||||
size_t pending;
|
||||
int lookback;
|
||||
int flag;
|
||||
@@ -927,6 +928,11 @@ struct JanetRange {
|
||||
int32_t end;
|
||||
};
|
||||
|
||||
struct JanetRNG {
|
||||
uint32_t a, b, c, d;
|
||||
uint32_t counter;
|
||||
};
|
||||
|
||||
/***** END SECTION TYPES *****/
|
||||
|
||||
/***** START SECTION OPCODES *****/
|
||||
@@ -1101,7 +1107,12 @@ 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);
|
||||
const uint8_t *source, int32_t line, int32_t column);
|
||||
|
||||
/* RNG */
|
||||
JANET_API JanetRNG *janet_default_rng(void);
|
||||
JANET_API void janet_rng_seed(JanetRNG *rng, uint32_t seed);
|
||||
JANET_API uint32_t janet_rng_u32(JanetRNG *rng);
|
||||
|
||||
/* Array functions */
|
||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||
@@ -1134,8 +1145,8 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
|
||||
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
|
||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
||||
#define janet_tuple_sm_column(t) (janet_tuple_head(t)->sm_column)
|
||||
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||
@@ -1195,6 +1206,7 @@ JANET_API JanetTable *janet_table(int32_t capacity);
|
||||
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
|
||||
JANET_API void janet_table_deinit(JanetTable *table);
|
||||
JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||
JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
|
||||
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);
|
||||
@@ -1243,6 +1255,7 @@ JANET_API Janet janet_unmarshal(
|
||||
JanetTable *reg,
|
||||
const uint8_t **next);
|
||||
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
||||
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
|
||||
|
||||
/* GC */
|
||||
JANET_API void janet_mark(Janet x);
|
||||
@@ -1262,6 +1275,7 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
||||
|
||||
/* Pretty printing */
|
||||
#define JANET_PRETTY_COLOR 1
|
||||
#define JANET_PRETTY_ONELINE 2
|
||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||
|
||||
/* Misc */
|
||||
@@ -1272,10 +1286,11 @@ JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
||||
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 Janet janet_lengthv(Janet x);
|
||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||
JANET_API Janet janet_wrap_number_safe(double x);
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1283,6 +1298,7 @@ JANET_API void janet_deinit(void);
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
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 Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
@@ -1305,23 +1321,31 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* New C API */
|
||||
|
||||
/* Allow setting entry name for static libraries */
|
||||
#ifndef JANET_ENTRY_NAME
|
||||
#define JANET_ENTRY_NAME _janet_init
|
||||
#endif
|
||||
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_API void _janet_init
|
||||
JANET_API void JANET_ENTRY_NAME
|
||||
|
||||
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
|
||||
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
|
||||
JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message);
|
||||
JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...);
|
||||
JANET_API void janet_printf(const char *format, ...);
|
||||
JANET_API void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...);
|
||||
#define janet_printf(...) janet_dynprintf("out", stdout, __VA_ARGS__)
|
||||
#define janet_eprintf(...) janet_dynprintf("err", stderr, __VA_ARGS__)
|
||||
JANET_NO_RETURN JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||
JANET_NO_RETURN 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);
|
||||
@@ -1338,6 +1362,7 @@ JANET_API JanetCFunction janet_getcfunction(const Janet *argv, int32_t n);
|
||||
JANET_API int janet_getboolean(const Janet *argv, int32_t n);
|
||||
JANET_API void *janet_getpointer(const Janet *argv, int32_t n);
|
||||
|
||||
JANET_API int32_t janet_getnat(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 size_t janet_getsize(const Janet *argv, int32_t n);
|
||||
@@ -1348,6 +1373,31 @@ JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstr
|
||||
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
|
||||
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||
|
||||
/* Optionals */
|
||||
JANET_API double janet_optnumber(const Janet *argv, int32_t argc, int32_t n, double dflt);
|
||||
JANET_API const Janet *janet_opttuple(const Janet *argv, int32_t argc, int32_t n, const Janet *dflt);
|
||||
JANET_API const JanetKV *janet_optstruct(const Janet *argv, int32_t argc, int32_t n, const JanetKV *dflt);
|
||||
JANET_API const uint8_t *janet_optstring(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
|
||||
JANET_API const uint8_t *janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API const uint8_t *janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
||||
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);
|
||||
JANET_API JanetFunction *janet_optfunction(const Janet *argv, int32_t argc, int32_t n, JanetFunction *dflt);
|
||||
JANET_API JanetCFunction janet_optcfunction(const Janet *argv, int32_t argc, int32_t n, JanetCFunction dflt);
|
||||
JANET_API int janet_optboolean(const Janet *argv, int32_t argc, int32_t n, int dflt);
|
||||
JANET_API void *janet_optpointer(const Janet *argv, int32_t argc, int32_t n, void *dflt);
|
||||
JANET_API int32_t janet_optnat(const Janet *argv, int32_t argc, int32_t n, int32_t dflt);
|
||||
JANET_API int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt);
|
||||
JANET_API int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt);
|
||||
JANET_API size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt);
|
||||
JANET_API void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt);
|
||||
|
||||
/* Mutable optional types specify a size default, and construct a new value if none is provided */
|
||||
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
JANET_API JanetTable *janet_opttable(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n, int32_t dflt_len);
|
||||
|
||||
JANET_API Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
@@ -1,94 +0,0 @@
|
||||
# Copyright 2017-2019 (C) Calvin Rose
|
||||
|
||||
(do
|
||||
|
||||
(var *should-repl* false)
|
||||
(var *no-file* true)
|
||||
(var *quiet* false)
|
||||
(var *raw-stdin* false)
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
(var *colorize* true)
|
||||
(var *compile-only* false)
|
||||
|
||||
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
|
||||
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
||||
|
||||
# Flag handlers
|
||||
(def handlers :private
|
||||
{"h" (fn [&]
|
||||
(print "usage: " (get process/args 0) " [options] script args...")
|
||||
(print
|
||||
`Options are:
|
||||
-h : Show this help
|
||||
-v : Print the version string
|
||||
-s : Use raw stdin instead of getline like functionality
|
||||
-e code : Execute a string of janet
|
||||
-r : Enter the repl after running all scripts
|
||||
-p : Keep on executing if there is a top level error (persistent)
|
||||
-q : Hide prompt, logo, and repl output (quiet)
|
||||
-k : Compile scripts but do not execute
|
||||
-m syspath : Set system path for loading global modules
|
||||
-c source output : Compile janet source code into an image
|
||||
-n : Disable ANSI color output in the repl
|
||||
-l path : Execute code in a file before running the main script
|
||||
-- : Stop handling options`)
|
||||
(os/exit 0)
|
||||
1)
|
||||
"v" (fn [&] (print janet/version "-" janet/build) (os/exit 0) 1)
|
||||
"s" (fn [&] (set *raw-stdin* true) (set *should-repl* true) 1)
|
||||
"r" (fn [&] (set *should-repl* true) 1)
|
||||
"p" (fn [&] (set *exit-on-error* false) 1)
|
||||
"q" (fn [&] (set *quiet* true) 1)
|
||||
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||
"n" (fn [&] (set *colorize* false) 1)
|
||||
"m" (fn [i &] (setdyn :syspath (get process/args (+ i 1))) 2)
|
||||
"c" (fn [i &]
|
||||
(def e (dofile (get process/args (+ i 1))))
|
||||
(spit (get process/args (+ i 2)) (make-image e))
|
||||
(set *no-file* false)
|
||||
3)
|
||||
"-" (fn [&] (set *handleopts* false) 1)
|
||||
"l" (fn [i &]
|
||||
(import* (get process/args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
2)
|
||||
"e" (fn [i &]
|
||||
(set *no-file* false)
|
||||
(eval-string (get process/args (+ i 1)))
|
||||
2)})
|
||||
|
||||
(defn- dohandler [n i &]
|
||||
(def h (get handlers n))
|
||||
(if h (h i) (do (print "unknown flag -" n) ((get handlers "h")))))
|
||||
|
||||
# Process arguments
|
||||
(var i 1)
|
||||
(def lenargs (length process/args))
|
||||
(while (< i lenargs)
|
||||
(def arg (get process/args i))
|
||||
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||
(set i lenargs))))
|
||||
|
||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||
(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 :delimiters) "> "))
|
||||
(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))
|
||||
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||
(repl getchunk onsig)))
|
||||
@@ -20,7 +20,9 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
/* Common */
|
||||
Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
@@ -87,18 +89,18 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
||||
/* static state */
|
||||
#define JANET_LINE_MAX 1024
|
||||
#define JANET_HISTORY_MAX 100
|
||||
static int israwmode = 0;
|
||||
static const char *prompt = "> ";
|
||||
static int plen = 2;
|
||||
static char buf[JANET_LINE_MAX];
|
||||
static int len = 0;
|
||||
static int pos = 0;
|
||||
static int cols = 80;
|
||||
static char *history[JANET_HISTORY_MAX];
|
||||
static int history_count = 0;
|
||||
static int historyi = 0;
|
||||
static int sigint_flag = 0;
|
||||
static struct termios termios_start;
|
||||
static int gbl_israwmode = 0;
|
||||
static const char *gbl_prompt = "> ";
|
||||
static int gbl_plen = 2;
|
||||
static char gbl_buf[JANET_LINE_MAX];
|
||||
static int gbl_len = 0;
|
||||
static int gbl_pos = 0;
|
||||
static int gbl_cols = 80;
|
||||
static char *gbl_history[JANET_HISTORY_MAX];
|
||||
static int gbl_history_count = 0;
|
||||
static int gbl_historyi = 0;
|
||||
static int gbl_sigint_flag = 0;
|
||||
static struct termios gbl_termios_start;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
static const char *badterms[] = {
|
||||
@@ -121,8 +123,8 @@ static char *sdup(const char *s) {
|
||||
static int rawmode() {
|
||||
struct termios t;
|
||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||
if (tcgetattr(STDIN_FILENO, &termios_start) == -1) goto fatal;
|
||||
t = termios_start;
|
||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
||||
t = gbl_termios_start;
|
||||
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||
t.c_oflag &= ~(OPOST);
|
||||
t.c_cflag |= (CS8);
|
||||
@@ -130,7 +132,7 @@ static int rawmode() {
|
||||
t.c_cc[VMIN] = 1;
|
||||
t.c_cc[VTIME] = 0;
|
||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||
israwmode = 1;
|
||||
gbl_israwmode = 1;
|
||||
return 0;
|
||||
fatal:
|
||||
errno = ENOTTY;
|
||||
@@ -139,8 +141,8 @@ fatal:
|
||||
|
||||
/* Disable raw mode */
|
||||
static void norawmode() {
|
||||
if (israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &termios_start) != -1)
|
||||
israwmode = 0;
|
||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
||||
gbl_israwmode = 0;
|
||||
}
|
||||
|
||||
static int curpos() {
|
||||
@@ -171,7 +173,9 @@ static int getcols() {
|
||||
if (cols > start) {
|
||||
char seq[32];
|
||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
return cols;
|
||||
} else {
|
||||
@@ -182,7 +186,9 @@ failed:
|
||||
}
|
||||
|
||||
static void clear() {
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {}
|
||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
||||
exit(1);
|
||||
}
|
||||
}
|
||||
|
||||
static void refresh() {
|
||||
@@ -190,38 +196,40 @@ static void refresh() {
|
||||
JanetBuffer b;
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = buf;
|
||||
int _len = len;
|
||||
int _pos = pos;
|
||||
while ((plen + _pos) >= cols) {
|
||||
char *_buf = gbl_buf;
|
||||
int _len = gbl_len;
|
||||
int _pos = gbl_pos;
|
||||
while ((gbl_plen + _pos) >= gbl_cols) {
|
||||
_buf++;
|
||||
_len--;
|
||||
_pos--;
|
||||
}
|
||||
while ((plen + _len) > cols) {
|
||||
while ((gbl_plen + _len) > gbl_cols) {
|
||||
_len--;
|
||||
}
|
||||
|
||||
janet_buffer_init(&b, 0);
|
||||
/* Cursor to left edge, prompt and buffer */
|
||||
/* Cursor to left edge, gbl_prompt and buffer */
|
||||
janet_buffer_push_u8(&b, '\r');
|
||||
janet_buffer_push_cstring(&b, prompt);
|
||||
janet_buffer_push_cstring(&b, gbl_prompt);
|
||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||
/* Erase to right */
|
||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||
/* Move cursor to original position. */
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + plen));
|
||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
||||
exit(1);
|
||||
}
|
||||
janet_buffer_deinit(&b);
|
||||
}
|
||||
|
||||
static int insert(char c) {
|
||||
if (len < JANET_LINE_MAX - 1) {
|
||||
if (len == pos) {
|
||||
buf[pos++] = c;
|
||||
buf[++len] = '\0';
|
||||
if (plen + len < cols) {
|
||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
||||
if (gbl_len == gbl_pos) {
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||
@@ -229,9 +237,9 @@ static int insert(char c) {
|
||||
refresh();
|
||||
}
|
||||
} else {
|
||||
memmove(buf + pos + 1, buf + pos, len - pos);
|
||||
buf[pos++] = c;
|
||||
buf[++len] = '\0';
|
||||
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
@@ -239,21 +247,21 @@ static int insert(char c) {
|
||||
}
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (history_count > 1) {
|
||||
free(history[historyi]);
|
||||
history[historyi] = sdup(buf);
|
||||
if (gbl_history_count > 1) {
|
||||
free(gbl_history[gbl_historyi]);
|
||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
||||
|
||||
historyi += delta;
|
||||
if (historyi < 0) {
|
||||
historyi = 0;
|
||||
gbl_historyi += delta;
|
||||
if (gbl_historyi < 0) {
|
||||
gbl_historyi = 0;
|
||||
return;
|
||||
} else if (historyi >= history_count) {
|
||||
historyi = history_count - 1;
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
return;
|
||||
}
|
||||
strncpy(buf, history[historyi], JANET_LINE_MAX - 1);
|
||||
pos = len = strlen(buf);
|
||||
buf[len] = '\0';
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
}
|
||||
@@ -261,62 +269,62 @@ static void historymove(int delta) {
|
||||
|
||||
static void addhistory() {
|
||||
int i, len;
|
||||
char *newline = sdup(buf);
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
len = history_count;
|
||||
len = gbl_history_count;
|
||||
if (len < JANET_HISTORY_MAX) {
|
||||
history[history_count++] = newline;
|
||||
gbl_history[gbl_history_count++] = newline;
|
||||
len++;
|
||||
} else {
|
||||
free(history[JANET_HISTORY_MAX - 1]);
|
||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
||||
}
|
||||
for (i = len - 1; i > 0; i--) {
|
||||
history[i] = history[i - 1];
|
||||
gbl_history[i] = gbl_history[i - 1];
|
||||
}
|
||||
history[0] = newline;
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
|
||||
static void replacehistory() {
|
||||
char *newline = sdup(buf);
|
||||
char *newline = sdup(gbl_buf);
|
||||
if (!newline) return;
|
||||
free(history[0]);
|
||||
history[0] = newline;
|
||||
free(gbl_history[0]);
|
||||
gbl_history[0] = newline;
|
||||
}
|
||||
|
||||
static void kleft() {
|
||||
if (pos > 0) {
|
||||
pos--;
|
||||
if (gbl_pos > 0) {
|
||||
gbl_pos--;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kright() {
|
||||
if (pos != len) {
|
||||
pos++;
|
||||
if (gbl_pos != gbl_len) {
|
||||
gbl_pos++;
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static void kbackspace() {
|
||||
if (pos > 0) {
|
||||
memmove(buf + pos - 1, buf + pos, len - pos);
|
||||
pos--;
|
||||
buf[--len] = '\0';
|
||||
if (gbl_pos > 0) {
|
||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
||||
gbl_pos--;
|
||||
gbl_buf[--gbl_len] = '\0';
|
||||
refresh();
|
||||
}
|
||||
}
|
||||
|
||||
static int line() {
|
||||
cols = getcols();
|
||||
plen = 0;
|
||||
len = 0;
|
||||
pos = 0;
|
||||
while (prompt[plen]) plen++;
|
||||
buf[0] = '\0';
|
||||
gbl_cols = getcols();
|
||||
gbl_plen = 0;
|
||||
gbl_len = 0;
|
||||
gbl_pos = 0;
|
||||
while (gbl_prompt[gbl_plen]) gbl_plen++;
|
||||
gbl_buf[0] = '\0';
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write(STDOUT_FILENO, prompt, plen) == -1) return -1;
|
||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
int nread;
|
||||
@@ -337,7 +345,7 @@ static int line() {
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
sigint_flag = 1;
|
||||
gbl_sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
@@ -352,8 +360,8 @@ static int line() {
|
||||
kright();
|
||||
break;
|
||||
case 21:
|
||||
buf[0] = '\0';
|
||||
pos = len = 0;
|
||||
gbl_buf[0] = '\0';
|
||||
gbl_pos = gbl_len = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 26: /* ctrl-z */
|
||||
@@ -399,11 +407,11 @@ static int line() {
|
||||
kleft();
|
||||
break;
|
||||
case 'H':
|
||||
pos = 0;
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
pos = len;
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
@@ -413,11 +421,11 @@ static int line() {
|
||||
default:
|
||||
break;
|
||||
case 'H':
|
||||
pos = 0;
|
||||
gbl_pos = 0;
|
||||
refresh();
|
||||
break;
|
||||
case 'F':
|
||||
pos = len;
|
||||
gbl_pos = gbl_len;
|
||||
refresh();
|
||||
break;
|
||||
}
|
||||
@@ -435,9 +443,9 @@ void janet_line_init() {
|
||||
void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < history_count; i++)
|
||||
free(history[i]);
|
||||
historyi = 0;
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
}
|
||||
|
||||
static int checktermsupport() {
|
||||
@@ -450,9 +458,9 @@ static int checktermsupport() {
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
prompt = p;
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
historyi = 0;
|
||||
gbl_historyi = 0;
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
@@ -464,7 +472,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
if (sigint_flag) {
|
||||
if (gbl_sigint_flag) {
|
||||
raise(SIGINT);
|
||||
} else {
|
||||
fputc('\n', out);
|
||||
@@ -473,10 +481,10 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
norawmode();
|
||||
fputc('\n', out);
|
||||
janet_buffer_ensure(buffer, len + 1, 2);
|
||||
memcpy(buffer->data, buf, len);
|
||||
buffer->data[len] = '\n';
|
||||
buffer->count = len + 1;
|
||||
janet_buffer_ensure(buffer, gbl_len + 1, 2);
|
||||
memcpy(buffer->data, gbl_buf, gbl_len);
|
||||
buffer->data[gbl_len] = '\n';
|
||||
buffer->count = gbl_len + 1;
|
||||
replacehistory();
|
||||
}
|
||||
|
||||
|
||||
@@ -23,7 +23,9 @@
|
||||
#ifndef JANET_LINE_H_defined
|
||||
#define JANET_LINE_H_defined
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
void janet_line_init();
|
||||
void janet_line_deinit();
|
||||
|
||||
@@ -20,26 +20,26 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
#endif
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
#include <shlwapi.h>
|
||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||
#endif
|
||||
#endif
|
||||
|
||||
extern const unsigned char *janet_gen_init;
|
||||
extern int32_t janet_gen_init_size;
|
||||
|
||||
int main(int argc, char **argv) {
|
||||
int i, status;
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
#ifdef _WIN32
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
@@ -61,12 +61,22 @@ int main(int argc, char **argv) {
|
||||
|
||||
/* Create args tuple */
|
||||
args = janet_array(argc);
|
||||
for (i = 0; i < argc; i++)
|
||||
for (i = 1; i < argc; i++)
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||
|
||||
/* Save current executable path to (dyn :executable) */
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||
Janet mainfun, out;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
@@ -5,7 +5,7 @@
|
||||
(fiber/new (fn webrepl []
|
||||
(setdyn :pretty-format "%.20P")
|
||||
(repl (fn get-line [buf p]
|
||||
(def offset (parser/where p))
|
||||
(def [offset] (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
||||
(repl-yield prompt buf)
|
||||
(yield)
|
||||
|
||||
8
test/install/.gitignore
vendored
8
test/install/.gitignore
vendored
@@ -1 +1,9 @@
|
||||
/build
|
||||
.cache
|
||||
.manifests
|
||||
json.*
|
||||
jhydro.*
|
||||
circlet.*
|
||||
argparse.*
|
||||
sqlite3.*
|
||||
path.*
|
||||
|
||||
@@ -5,3 +5,6 @@
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(declare-executable
|
||||
:name "testexec"
|
||||
:entry "testexec.janet")
|
||||
|
||||
5
test/install/testexec.janet
Normal file
5
test/install/testexec.janet
Normal file
@@ -0,0 +1,5 @@
|
||||
(use build/testmod)
|
||||
|
||||
(defn main [&]
|
||||
(print "Hello from executable!")
|
||||
(print (get5)))
|
||||
@@ -62,8 +62,7 @@
|
||||
|
||||
# String functions
|
||||
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
||||
(assert (= nil (string/find "" "")) "string/find 2")
|
||||
(assert (= 0 (string/find "A" "A")) "string/find 3")
|
||||
(assert (= 0 (string/find "A" "A")) "string/find 2")
|
||||
(assert (string/has-prefix? "" "foo") "string/has-prefix? 1")
|
||||
(assert (string/has-prefix? "fo" "foo") "string/has-prefix? 2")
|
||||
(assert (not (string/has-prefix? "o" "foo")) "string/has-prefix? 3")
|
||||
@@ -98,6 +97,12 @@
|
||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||
(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
|
||||
|
||||
(assert-error "string/find error 1" (string/find "" "abcd"))
|
||||
(assert-error "string/split error 1" (string/split "" "abcd"))
|
||||
(assert-error "string/replace error 1" (string/replace "" "." "abcd"))
|
||||
(assert-error "string/replace-all error 1" (string/replace-all "" "." "abcdabcd"))
|
||||
(assert-error "string/find-all error 1" (string/find-all "" "abcd"))
|
||||
|
||||
# Check if abstract test works
|
||||
(assert (abstract? stdout) "abstract? stdout")
|
||||
(assert (abstract? stdin) "abstract? stdin")
|
||||
|
||||
@@ -78,11 +78,15 @@
|
||||
|
||||
# Another regression test - no segfaults
|
||||
(defn afn [x] x)
|
||||
(assert (= 1 (try (afn) ([err] 1))) "bad arity 1")
|
||||
(var afn-var afn)
|
||||
(var identity-var identity)
|
||||
(var map-var map)
|
||||
(var not-var not)
|
||||
(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
|
||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||
(assert (= 1 (try (identity) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not) ([err] 1))) "bad arity 5")
|
||||
(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
|
||||
(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
|
||||
(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
|
||||
|
||||
# Assembly test
|
||||
# Fibonacci sequence, implemented with naive recursion.
|
||||
@@ -113,9 +117,9 @@
|
||||
|
||||
(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")
|
||||
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad))) "calling table too many arguments")
|
||||
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
||||
(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops))) "calling number fails")
|
||||
|
||||
# Method test
|
||||
|
||||
@@ -356,6 +360,38 @@
|
||||
(check-match janet-longstring "``` `` ```" true)
|
||||
(check-match janet-longstring "`` ```" false)
|
||||
|
||||
# Backmatch
|
||||
|
||||
(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
|
||||
|
||||
(check-match backmatcher-1 "y" true)
|
||||
(check-match backmatcher-1 "xyx" true)
|
||||
(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-1 "xyxx" false)
|
||||
(check-match backmatcher-1 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
||||
|
||||
(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
|
||||
|
||||
(check-match backmatcher-2 "y" true)
|
||||
(check-match backmatcher-2 "xyx" true)
|
||||
(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
|
||||
(check-match backmatcher-2 "xyxx" false)
|
||||
(check-match backmatcher-2 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
|
||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
||||
|
||||
(def longstring-2 '(* '(some "`") (some (if-not (backmatch) 1)) (backmatch) -1))
|
||||
|
||||
(check-match longstring-2 "`john" false)
|
||||
(check-match longstring-2 "abc" false)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "` `" true)
|
||||
(check-match longstring-2 "`` ``" true)
|
||||
(check-match longstring-2 "``` `` ```" true)
|
||||
(check-match longstring-2 "`` ```" false)
|
||||
|
||||
# Optional
|
||||
|
||||
(check-match '(* (opt "hi") -1) "" true)
|
||||
@@ -389,4 +425,22 @@
|
||||
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
|
||||
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
|
||||
|
||||
# Check for bad memoization (+ :a) should mean different things in different contexts.
|
||||
(def redef-a
|
||||
~{:a "abc"
|
||||
:c (+ :a)
|
||||
:main (* :c {:a "def" :main (+ :a)} -1)})
|
||||
|
||||
(check-match redef-a "abcdef" true)
|
||||
(check-match redef-a "abcabc" false)
|
||||
(check-match redef-a "defdef" false)
|
||||
|
||||
(def redef-b
|
||||
~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
|
||||
:main :pork})
|
||||
|
||||
(check-match redef-b "abeef" true)
|
||||
(check-match redef-b "aabeef" false)
|
||||
(check-match redef-b "aaaaaa" false)
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -54,6 +54,7 @@
|
||||
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
||||
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||
(assert (= (:length a) (length a)) "length method and function")
|
||||
|
||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||
|
||||
@@ -80,13 +81,49 @@
|
||||
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
||||
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
||||
|
||||
# take
|
||||
|
||||
(assert (deep= (take 0 []) []) "take 1")
|
||||
(assert (deep= (take 10 []) []) "take 2")
|
||||
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
|
||||
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
|
||||
(assert (deep= (take -1 [:a :b :c]) []) "take 5")
|
||||
(assert-error :invalid-type (take 3 {}) "take 6")
|
||||
|
||||
# take-until
|
||||
|
||||
(assert (deep= (take-until pos? @[]) []) "take-until 1")
|
||||
(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
|
||||
(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
|
||||
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
|
||||
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
|
||||
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
|
||||
|
||||
# take-while
|
||||
|
||||
(assert (deep= (take-while neg? @[]) []) "take-while 1")
|
||||
(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
|
||||
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
|
||||
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
|
||||
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
|
||||
|
||||
# drop
|
||||
|
||||
(assert (deep= (drop 0 []) []) "drop 1")
|
||||
(assert (deep= (drop 10 []) []) "drop 2")
|
||||
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
|
||||
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
|
||||
(assert (deep= (drop -2 [:a :b :c]) [:a :b :c]) "drop 5")
|
||||
(assert-error :invalid-type (drop 3 {}) "drop 6")
|
||||
|
||||
# drop-until
|
||||
|
||||
(assert (deep= (drop-until pos? @[]) @[]) "drop-until 1")
|
||||
(assert (deep= (drop-until pos? @[1 2 3]) @[1 2 3]) "drop-until 2")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 -3]) @[]) "drop-until 3")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 3]) @[3]) "drop-until 4")
|
||||
(assert (deep= (drop-until pos? @[-1 1 -2]) @[1 -2]) "drop-until 5")
|
||||
(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
|
||||
(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
|
||||
(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
|
||||
(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
|
||||
(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
|
||||
|
||||
# Quasiquote bracketed tuples
|
||||
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
|
||||
|
||||
@@ -113,4 +113,112 @@
|
||||
(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
|
||||
(check-table-clone @{} "table/clone 1")
|
||||
|
||||
# Issue #142
|
||||
|
||||
(def buffer (tarray/buffer 8))
|
||||
(def buffer-float64-view (tarray/new :float64 1 1 0 buffer))
|
||||
(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer))
|
||||
|
||||
(set (buffer-uint32-view 1) 0xfffe9234)
|
||||
(set (buffer-uint32-view 0) 0x56789abc)
|
||||
|
||||
(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1")
|
||||
(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2")
|
||||
(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3")
|
||||
|
||||
# Make sure Carriage Returns don't end up in doc strings.
|
||||
|
||||
(assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc ""))) "no \\r in doc strings")
|
||||
|
||||
# module/expand-path regression
|
||||
(with-dyns [:syspath ".janet/.janet"]
|
||||
(assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
|
||||
".janet/.janet/hello.janet") "module/expand-path 1"))
|
||||
|
||||
# comp should be variadic
|
||||
(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
|
||||
(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
|
||||
(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
|
||||
(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
|
||||
(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
|
||||
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
|
||||
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4)) "variadic comp 7")
|
||||
|
||||
# Function shorthand
|
||||
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
|
||||
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
|
||||
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
|
||||
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
|
||||
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
|
||||
(assert (= (|4) 4) "function shorthand 6")
|
||||
(assert (= (((|||4))) 4) "function shorthand 7")
|
||||
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
|
||||
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
|
||||
(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
|
||||
|
||||
# Simple function break
|
||||
(debug/fbreak map 1)
|
||||
(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
|
||||
(resume f)
|
||||
(assert (= :debug (fiber/status f)) "debug/fbreak")
|
||||
(debug/unfbreak map 1)
|
||||
(map inc [1 2 3])
|
||||
|
||||
(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
|
||||
|
||||
# Simple take, drop, etc. tests.
|
||||
(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
|
||||
(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
|
||||
|
||||
# Printing to buffers
|
||||
(def out-buf @"")
|
||||
(def err-buf @"")
|
||||
(with-dyns [:out out-buf :err err-buf]
|
||||
(print "Hello")
|
||||
(prin "hi")
|
||||
(eprint "Sup")
|
||||
(eprin "not much."))
|
||||
|
||||
(assert (= (string out-buf) "Hello\nhi") "print and prin to buffer 1")
|
||||
(assert (= (string err-buf) "Sup\nnot much.") "eprint and eprin to buffer 1")
|
||||
|
||||
(assert (= (string '()) (string [])) "empty bracket tuple literal")
|
||||
|
||||
# with-vars
|
||||
(var abc 123)
|
||||
(assert (= 356 (with-vars [abc 456] (- abc 100))) "with-vars 1")
|
||||
(assert-error "with-vars 2" (with-vars [abc 456] (error :oops)))
|
||||
(assert (= abc 123) "with-vars 3")
|
||||
|
||||
# Trim empty string
|
||||
(assert (= "" (string/trim " ")) "string/trim regression")
|
||||
|
||||
# RNGs
|
||||
|
||||
(defn test-rng
|
||||
[rng]
|
||||
(assert (all identity (seq [i :range [0 1000]]
|
||||
(<= (math/rng-int rng i) i))) "math/rng-int test")
|
||||
(assert (all identity (seq [i :range [0 1000]]
|
||||
(def x (math/rng-uniform rng))
|
||||
(and (>= x 0) (< x 1))))
|
||||
"math/rng-uniform test"))
|
||||
|
||||
(def seedrng (math/rng 123))
|
||||
(for i 0 75
|
||||
(test-rng (math/rng (:int seedrng))))
|
||||
|
||||
# OS Date test
|
||||
|
||||
(assert (deep= {:year-day 0
|
||||
:minutes 30
|
||||
:month 0
|
||||
:dst false
|
||||
:seconds 0
|
||||
:year 2014
|
||||
:month-day 0
|
||||
:hours 20
|
||||
:week-day 3}
|
||||
(os/date 1388608200)) "os/date")
|
||||
|
||||
(end-suite)
|
||||
|
||||
0
tools/.keep
Normal file
0
tools/.keep
Normal file
@@ -1,14 +1,16 @@
|
||||
# Creates an amalgamated janet.c
|
||||
|
||||
# Head
|
||||
(def {:year YY :month MM :month-day DD} (os/date))
|
||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||
(print "/* Generated " YY "-" (inc MM) "-" (inc DD)
|
||||
" with janet version " janet/version "-" janet/build " */")
|
||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||
(print ```#define JANET_AMALG```)
|
||||
(print ```#include "janet.h"```)
|
||||
|
||||
# Body
|
||||
(each path (tuple/slice process/args 2)
|
||||
(each path (tuple/slice (dyn :args) 1)
|
||||
(print "\n/* " path " */\n")
|
||||
(print (slurp path)))
|
||||
|
||||
# maybe will help
|
||||
(:flush stdout)
|
||||
|
||||
@@ -1,4 +1,4 @@
|
||||
@echo off
|
||||
@rem Wrapper around jpm
|
||||
|
||||
janet %~dp0\jpm.janet %*
|
||||
janet "%~dp0\jpm.janet" %*
|
||||
|
||||
BIN
tools/nsis-3.04-strlen_8192.zip
Normal file
BIN
tools/nsis-3.04-strlen_8192.zip
Normal file
Binary file not shown.
7
tools/removecr.janet
Normal file
7
tools/removecr.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
# Remove carriage returns from file. Since piping things on
|
||||
# windows may add bad line endings, we can just force removal
|
||||
# with this script.
|
||||
(def fname ((dyn :args) 1))
|
||||
(def source (slurp fname))
|
||||
(def new-source (string/replace-all "\r" "" source))
|
||||
(spit fname new-source :wb)
|
||||
@@ -44,8 +44,7 @@ static int is_symbol_char_gen(uint8_t c) {
|
||||
c == '>' ||
|
||||
c == '@' ||
|
||||
c == '^' ||
|
||||
c == '_' ||
|
||||
c == '|');
|
||||
c == '_');
|
||||
}
|
||||
|
||||
int main() {
|
||||
|
||||
Reference in New Issue
Block a user