mirror of
https://github.com/janet-lang/janet
synced 2025-11-22 10:14:49 +00:00
Compare commits
201 Commits
v0.4.1
...
meson-only
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
bedd9ccaa1 | ||
|
|
a29e717fd7 | ||
|
|
522545287e | ||
|
|
4b4fe80404 | ||
|
|
cf05ff610f | ||
|
|
300124961f | ||
|
|
7eb78c8028 | ||
|
|
1a7691dade | ||
|
|
3b51501847 | ||
|
|
fc46030e7d | ||
|
|
ff3bb66272 | ||
|
|
1ceaceada4 | ||
|
|
19a0444f41 | ||
|
|
0102a72538 | ||
|
|
9943bdd907 | ||
|
|
264c5bc02b | ||
|
|
9ba8728176 | ||
|
|
8839731951 | ||
|
|
e88a9af2f6 | ||
|
|
a5e50a0f65 | ||
|
|
7c35acca75 | ||
|
|
4bb57550c8 | ||
|
|
446ab037b0 | ||
|
|
4adfb9f2d3 | ||
|
|
9c89d1c658 | ||
|
|
3598f056bb | ||
|
|
779fcf2d54 | ||
|
|
3bbc121c6a | ||
|
|
82edc19137 | ||
|
|
5689ef1af1 | ||
|
|
b4e25e5597 | ||
|
|
647139cdf9 | ||
|
|
6225f8d334 | ||
|
|
95eb54045f | ||
|
|
43520ac67d | ||
|
|
802a2d6b71 | ||
|
|
d9a4ef05ac | ||
|
|
f00a2770ef | ||
|
|
b83fe146fa | ||
|
|
6249f03367 | ||
|
|
bfc00b67bd | ||
|
|
2b7428ed2b | ||
|
|
64a80c57e3 | ||
|
|
efb2ab06cb | ||
|
|
b082c8123e | ||
|
|
cc1ff9125a | ||
|
|
5734e02034 | ||
|
|
6e8beff0a0 | ||
|
|
c21eaa5474 | ||
|
|
13667292c6 | ||
|
|
22eb8372dd | ||
|
|
1b7a9def25 | ||
|
|
d7954e6fe3 | ||
|
|
c20c9cd5d7 | ||
|
|
46531d9a60 | ||
|
|
d9a366fbed | ||
|
|
64bf52372a | ||
|
|
0a9715a94c | ||
|
|
c82aac1365 | ||
|
|
e697cc3811 | ||
|
|
c150f2f2c1 | ||
|
|
0a54e1ed62 | ||
|
|
b9daf41327 | ||
|
|
2d2bc436e6 | ||
|
|
3d76d988c3 | ||
|
|
bea6dbbf3d | ||
|
|
e1bd24c2ab | ||
|
|
1f30ea66e9 | ||
|
|
c43aaf8986 | ||
|
|
2acc81d1c5 | ||
|
|
26513a7a16 | ||
|
|
d005ac6888 | ||
|
|
7fdb098a20 | ||
|
|
a4a200e037 | ||
|
|
15d95d8803 | ||
|
|
46950a8cb3 | ||
|
|
4867cab569 | ||
|
|
c8cf7c2445 | ||
|
|
1b63215aad | ||
|
|
bcbe42ab23 | ||
|
|
c8c6419013 | ||
|
|
e8516c29e0 | ||
|
|
12247bd958 | ||
|
|
9d30d5f6e3 | ||
|
|
ba0956488d | ||
|
|
31f502b508 | ||
|
|
efaaead378 | ||
|
|
4d47d92a4a | ||
|
|
b39ad97a87 | ||
|
|
af23040d9c | ||
|
|
fd2d706e33 | ||
|
|
178d175bcf | ||
|
|
7a7f586094 | ||
|
|
5124587c96 | ||
|
|
6c897b1a37 | ||
|
|
c6ac53f4be | ||
|
|
2d7812a06c | ||
|
|
db55277b58 | ||
|
|
75818217a6 | ||
|
|
486b80fa7b | ||
|
|
873054d055 | ||
|
|
f12f896020 | ||
|
|
09ab391d13 | ||
|
|
7569930b0c | ||
|
|
e7189438dd | ||
|
|
3c304ddc35 | ||
|
|
1696de233c | ||
|
|
ce9cd4fcef | ||
|
|
698e89aba4 | ||
|
|
4c8dd4b96c | ||
|
|
11998b3913 | ||
|
|
840610facf | ||
|
|
0280deccae | ||
|
|
4d5a95784a | ||
|
|
b43d93cf55 | ||
|
|
3f137ed0b1 | ||
|
|
5deb13d73e | ||
|
|
82a1c8635e | ||
|
|
010e2e4652 | ||
|
|
ddedae6831 | ||
|
|
6c63c4f129 | ||
|
|
802686e3df | ||
|
|
3be79e8735 | ||
|
|
a303704a7d | ||
|
|
b5e6c0b8fc | ||
|
|
98c46fcfb1 | ||
|
|
409da697dd | ||
|
|
91c3685705 | ||
|
|
411fc77ecf | ||
|
|
0378ba78cc | ||
|
|
55d8e8b56b | ||
|
|
97ad4c4f89 | ||
|
|
8de999c8f7 | ||
|
|
f444bd25ef | ||
|
|
43c0db4b0e | ||
|
|
8f168c600d | ||
|
|
ec43afb426 | ||
|
|
880049c0ee | ||
|
|
2b7ac16784 | ||
|
|
56d903d75b | ||
|
|
7054e878fb | ||
|
|
dde5351d11 | ||
|
|
7d49e3e6f1 | ||
|
|
30cb01e2f0 | ||
|
|
018e836ef5 | ||
|
|
7b25125431 | ||
|
|
0aa2f68793 | ||
|
|
516e031f67 | ||
|
|
3331f2fa02 | ||
|
|
dd1a199ebd | ||
|
|
f35b5765d6 | ||
|
|
8359044408 | ||
|
|
9f3dde3cc7 | ||
|
|
ad0f7d9b0d | ||
|
|
f647ac5631 | ||
|
|
e4c5eb4c76 | ||
|
|
dc9fc9c3f5 | ||
|
|
3b6a51df24 | ||
|
|
f2313b9959 | ||
|
|
805b3bbb88 | ||
|
|
232ea22dc5 | ||
|
|
3388acd2db | ||
|
|
52ab9fb475 | ||
|
|
c7dc3611bc | ||
|
|
7a313f6038 | ||
|
|
bbcfaf1289 | ||
|
|
bfb0cb331e | ||
|
|
1759252071 | ||
|
|
fff60b053b | ||
|
|
65ac17986a | ||
|
|
ff720f1320 | ||
|
|
5a28d8d1fa | ||
|
|
ea25766374 | ||
|
|
88b8418253 | ||
|
|
4fa1b28cad | ||
|
|
c70d59edee | ||
|
|
5694998382 | ||
|
|
1cfc7b3b0d | ||
|
|
03e3ecb0a1 | ||
|
|
f8935b0692 | ||
|
|
702b50b7a1 | ||
|
|
e7baa2ae3d | ||
|
|
bfb354b469 | ||
|
|
3c0f12ea4d | ||
|
|
25a93ac4a6 | ||
|
|
0bad523913 | ||
|
|
5b36199aea | ||
|
|
a474a640be | ||
|
|
f10028d41a | ||
|
|
eb4684a64d | ||
|
|
73b81e0253 | ||
|
|
027f106a56 | ||
|
|
20e94adb61 | ||
|
|
9100794cea | ||
|
|
4ddf90e301 | ||
|
|
d1eca1cf52 | ||
|
|
7918add47d | ||
|
|
513d551df6 | ||
|
|
ddaa5e34e6 | ||
|
|
208eb7520a | ||
|
|
2d7df6b78e |
@@ -1,11 +1,11 @@
|
||||
image: freebsd/latest
|
||||
packages:
|
||||
- gmake
|
||||
- gcc
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake CC=gcc
|
||||
gmake test CC=gcc
|
||||
sudo gmake install CC=gcc
|
||||
gmake test-install CC=gcc
|
||||
gmake
|
||||
gmake test
|
||||
sudo gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
|
||||
11
.builds/.openbsd.yaml
Normal file
11
.builds/.openbsd.yaml
Normal file
@@ -0,0 +1,11 @@
|
||||
image: openbsd/6.5
|
||||
packages:
|
||||
- gmake
|
||||
tasks:
|
||||
- build: |
|
||||
cd janet
|
||||
gmake
|
||||
gmake test
|
||||
doas gmake install
|
||||
gmake test-install
|
||||
gmake test-amalg
|
||||
@@ -4,6 +4,7 @@ script:
|
||||
- make test
|
||||
- sudo make install
|
||||
- make test-install
|
||||
- make test-amalg
|
||||
- make build/janet-${TRAVIS_TAG}-${TRAVIS_OS_NAME}.tar.gz
|
||||
compiler:
|
||||
- clang
|
||||
|
||||
68
CHANGELOG.md
68
CHANGELOG.md
@@ -1,6 +1,72 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased
|
||||
- Add `JANET_NO_DOCSTRINGS` and `JANET_NO_SOURCEMAPS` defines in janetconf.h
|
||||
for shrinking binary size.
|
||||
This seems to save about 50kB in most builds, so it's not usually worth it.
|
||||
- Update module system to allow relative imports. The `:cur:` pattern
|
||||
in `module/expand-path` will expand to the directory part of the current file, or
|
||||
whatever the value of `(dyn :current-file)` is. The `:dir:` pattern gets
|
||||
the directory part of the input path name.
|
||||
- Remove `:native:` pattern in `module/paths`.
|
||||
- Add `module/expand-path`
|
||||
- Remove `module/*syspath*` and `module/*headerpath*` in favor of dynamic
|
||||
bindings `:syspath` and `:headerpath`.
|
||||
- Compiled PEGs can now be marshaled and unmarshaled.
|
||||
- Change signature to `parser/state`
|
||||
- Add `:until` verb to loop.
|
||||
- Add `:p` flag to `fiber/new`.
|
||||
- Add `file/{fdopen,fileno}` functions.
|
||||
- Add `parser/clone` function.
|
||||
- Add optional argument to `parser/where` to set parser byte index.
|
||||
- Add optional `env` argument to `all-bindings` and `all-dynamics`.
|
||||
- Add scratch memory C API functions for auto-released memory on next gc.
|
||||
Scratch memory differs from normal GCed memory as it can also be freed normally
|
||||
for better performance.
|
||||
- Add API compatibility checking for modules. This will let native modules not load
|
||||
when the host program is not of a compatible version or configuration.
|
||||
- Change signature of `os/execute` to be much more flexible.
|
||||
|
||||
## 0.6.0 - 2019-05-29
|
||||
- `file/close` returns exit code when closing file opened with `file/popen`.
|
||||
- Add `os/rename`
|
||||
- Update windows installer to include tools like `jpm`.
|
||||
- Add `jpm` tool for building and managing projects.
|
||||
- Change interface to `cook` tool.
|
||||
- Add optional filters to `module/paths` to further refine import methods.
|
||||
- Add keyword arguments via `&keys` in parameter list.
|
||||
- Add `-k` flag for flychecking source.
|
||||
- Change signature to `compile` function.
|
||||
- Add `module/loaders` for custom loading functions.
|
||||
- Add external unification to `match` macro.
|
||||
- Add static library to main build.
|
||||
- Add `janet/*headerpath*` and change location of installed headers.
|
||||
- Let `partition` take strings.
|
||||
- Haiku OS support
|
||||
- Add `string/trim`, `string/trimr`, and `string/triml`.
|
||||
- Add `dofile` function.
|
||||
- Numbers require at least 1 significant digit.
|
||||
- `file/read` will return nil on end of file.
|
||||
- Fix various bugs.
|
||||
|
||||
## 0.5.0 - 2019-05-09
|
||||
- Fix some bugs with buffers.
|
||||
- Add `trace` and `untrace` to the core library.
|
||||
- Add `string/has-prefix?` and `string/has-suffix?` to string module.
|
||||
- Add simple debugger to repl that activates on errors or debug signal
|
||||
- Remove `*env*` and `*doc-width*`.
|
||||
- Add `fiber/getenv`, `fiber/setenv`, and `dyn`, and `setdyn`.
|
||||
- Add support for dynamic bindings (via the `dyn` and `setdyn` functions).
|
||||
- Change signatures of some functions like `eval` which no longer takes
|
||||
an optional environment.
|
||||
- Add printf function
|
||||
- Make `pp` configurable with dynamic binding `:pretty-format`.
|
||||
- Remove the `meta` function.
|
||||
- Add `with-dyns` for blocks with dynamic bindings assigned.
|
||||
- Allow leading and trailing newlines in backtick-delimited string (long strings).
|
||||
These newlines will not be included in the actual string value.
|
||||
|
||||
## 0.4.1 - 2019-04-14
|
||||
- Squash some bugs
|
||||
- Peg patterns can now make captures in any position in a grammar.
|
||||
@@ -44,7 +110,7 @@ All notable changes to this project will be documented in this file.
|
||||
- Disallow NaNs as table or struct keys
|
||||
- Update module resolution paths and format
|
||||
|
||||
## 0.3.0 - 2019-26-01
|
||||
## 0.3.0 - 2019-01-26
|
||||
- Add amalgamated build to janet for easier embedding.
|
||||
- Add os/date function
|
||||
- Add slurp and spit to core library.
|
||||
|
||||
87
Makefile
87
Makefile
@@ -26,15 +26,18 @@ PREFIX?=/usr/local
|
||||
|
||||
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
|
||||
MANPATH?=$(PREFIX)/share/man/man1/
|
||||
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||
DEBUGGER=gdb
|
||||
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fpic -O2 -fvisibility=hidden \
|
||||
-DJANET_BUILD=$(JANET_BUILD)
|
||||
LDFLAGS=-rdynamic
|
||||
|
||||
@@ -46,15 +49,18 @@ else ifeq ($(UNAME), Linux)
|
||||
CLIBS:=$(CLIBS) -lrt -ldl
|
||||
endif
|
||||
# For other unix likes, add flags here!
|
||||
ifeq ($(UNAME),Haiku)
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
||||
|
||||
######################
|
||||
##### Name Files #####
|
||||
######################
|
||||
|
||||
JANET_HEADERS=src/include/janet.h src/include/janetconf.h
|
||||
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
||||
|
||||
JANET_LOCAL_HEADERS=src/core/util.h \
|
||||
src/core/state.h \
|
||||
@@ -129,7 +135,7 @@ 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)
|
||||
build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet
|
||||
|
||||
##########################################################
|
||||
##### The main interpreter program and shared object #####
|
||||
@@ -151,6 +157,9 @@ $(JANET_TARGET): $(JANET_CORE_OBJECTS) $(JANET_MAINCLIENT_OBJECTS)
|
||||
$(JANET_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -shared -o $@ $^ $(CLIBS)
|
||||
|
||||
$(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
||||
$(AR) rcs $@ $^
|
||||
|
||||
######################
|
||||
##### Emscripten #####
|
||||
######################
|
||||
@@ -243,8 +252,8 @@ callgrind: $(JANET_TARGET)
|
||||
dist: build/janet-dist.tar.gz
|
||||
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
src/include/janet.h src/include/janetconf.h \
|
||||
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) \
|
||||
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 $@ $^
|
||||
|
||||
@@ -257,6 +266,45 @@ docs: build/doc.html
|
||||
build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
$(JANET_TARGET) tools/gendoc.janet > build/doc.html
|
||||
|
||||
########################
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1
|
||||
|
||||
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||
mkdir -p $(PKG_CONFIG_PATH)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
echo 'exec_prefix=$${prefix}' >> $@
|
||||
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||
echo 'libdir=$(LIBDIR)' >> $@
|
||||
echo "" >> $@
|
||||
echo "Name: janet" >> $@
|
||||
echo "Url: https://janet-lang.org" >> $@
|
||||
echo "Description: Library for the Janet programming language." >> $@
|
||||
$(JANET_TARGET) -e '(print "Version: " janet/version)' >> $@
|
||||
echo 'Cflags: -I$${includedir}' >> $@
|
||||
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
|
||||
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)
|
||||
|
||||
#################
|
||||
##### Other #####
|
||||
#################
|
||||
@@ -271,23 +319,18 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
|
||||
clean:
|
||||
-rm -rf build vgcore.* callgrind.*
|
||||
|
||||
install: $(JANET_TARGET)
|
||||
mkdir -p $(BINDIR)
|
||||
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||
mkdir -p $(INCLUDEDIR)
|
||||
cp $(JANET_HEADERS) $(INCLUDEDIR)
|
||||
mkdir -p $(INCLUDEDIR)/janet
|
||||
mkdir -p $(JANET_PATH)
|
||||
ln -sf $(INCLUDEDIR)/janet.h $(JANET_PATH)/janet.h
|
||||
ln -sf $(INCLUDEDIR)/janetconf.h $(JANET_PATH)/janetconf.h
|
||||
cp tools/cook.janet $(JANET_PATH)
|
||||
cp tools/highlight.janet $(JANET_PATH)
|
||||
cp tools/bars.janet $(JANET_PATH)
|
||||
mkdir -p $(MANPATH)
|
||||
cp janet.1 $(MANPATH)
|
||||
|
||||
test-install:
|
||||
cd test/install && rm -rf build && janet build && janet build
|
||||
cd test/install && rm -rf build && jpm build && jpm test
|
||||
|
||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_main.o: test/amalg/main.c $(JANET_HEADERS)
|
||||
$(CC) $(CFLAGS) -c $< -o $@
|
||||
build/embed_test: build/embed_janet.o build/embed_main.o
|
||||
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
|
||||
|
||||
test-amalg: build/embed_test
|
||||
./build/embed_test
|
||||
|
||||
uninstall:
|
||||
-rm $(BINDIR)/../$(JANET_TARGET)
|
||||
|
||||
45
README.md
45
README.md
@@ -3,6 +3,7 @@
|
||||
[](https://ci.appveyor.com/project/bakpakin/janet/branch/master)
|
||||
[](https://travis-ci.org/janet-lang/janet)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.freebsd.yaml?)
|
||||
[](https://builds.sr.ht/~bakpakin/janet/.openbsd.yaml?)
|
||||
|
||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">
|
||||
|
||||
@@ -48,9 +49,8 @@ Janet makes a good system scripting language, or a language to embed in other pr
|
||||
|
||||
## Documentation
|
||||
|
||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/introduction.html) for more details.
|
||||
* For an overview of functions in the core library, see [the function index](https://janet-lang.org/funcindex.html).
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/doc.html)
|
||||
* For a quick tutorial, see [the introduction](https://janet-lang.org/docs/index.html) for more details.
|
||||
* For the full API for all functions in the core library, see [the core API doc](https://janet-lang.org/api/index.html)
|
||||
|
||||
Documentation is also available locally in the repl.
|
||||
Use the `(doc symbol-name)` macro to get API
|
||||
@@ -63,6 +63,12 @@ Shows documentation for the doc macro.
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-symbols)` function.
|
||||
|
||||
## Source
|
||||
|
||||
You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
||||
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||
the SourceHut mirror is actively maintained.
|
||||
|
||||
## Building
|
||||
|
||||
### macos and Unix-like
|
||||
@@ -74,15 +80,28 @@ make test
|
||||
make repl
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
### 32-bit Haiku
|
||||
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
but you need `gmake` and `gcc` to compile.
|
||||
32-bit Haiku build instructions are the same as the unix-like build instructions,
|
||||
but you need to specify an alternative compiler, such as `gcc-x86`.
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
gmake CC=gcc
|
||||
gmake test CC=gcc
|
||||
make CC=gcc-x86
|
||||
make test
|
||||
make repl
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
|
||||
FreeBSD build instructions are the same as the unix-like build instuctions,
|
||||
but you need `gmake` to compile. Alternatively, install directly from
|
||||
packages, using `pkg install lang/janet`.
|
||||
|
||||
```
|
||||
cd somewhere/my/projects/janet
|
||||
gmake
|
||||
gmake test
|
||||
gmake repl
|
||||
```
|
||||
|
||||
@@ -167,6 +186,16 @@ See the examples directory for some example janet code.
|
||||
Feel free to ask questions and join discussion on the [Janet Gitter Channel](https://gitter.im/janet-language/community).
|
||||
Alternatively, check out [the #janet channel on Freenode](https://webchat.freenode.net/)
|
||||
|
||||
## FAQ
|
||||
|
||||
### Why is my terminal is spitting out junk when I run the repl?
|
||||
|
||||
Make sure your terminal supports ANSI escape codes. Most modern terminals will
|
||||
support these, but some older terminals, windows consoles, or embedded terminals
|
||||
will not. If your terminal does not support ANSI escape codes, run the repl with
|
||||
the `-n` flag, which disables color output. You can also try the `-s` if further issues
|
||||
ensue.
|
||||
|
||||
## Why Janet
|
||||
|
||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||
|
||||
@@ -21,9 +21,8 @@ install:
|
||||
- build_win
|
||||
- build_win test
|
||||
- choco install nsis -y -pre
|
||||
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
- build_win dist
|
||||
- copy janet-install.exe dist\install.exe
|
||||
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||
|
||||
build: off
|
||||
|
||||
@@ -33,9 +32,9 @@ only_commits:
|
||||
- src/
|
||||
|
||||
artifacts:
|
||||
- path: dist
|
||||
name: janet-windows
|
||||
type: Zip
|
||||
- path: janet-installer.exe
|
||||
name: janet-windows-installer.exe
|
||||
type: File
|
||||
|
||||
deploy:
|
||||
description: 'The Janet Programming Language.'
|
||||
|
||||
BIN
assets/icon.ico
Normal file
BIN
assets/icon.ico
Normal file
Binary file not shown.
|
After Width: | Height: | Size: 100 KiB |
11
assets/icon_svg.svg
Normal file
11
assets/icon_svg.svg
Normal file
@@ -0,0 +1,11 @@
|
||||
<!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 20010904//EN" "http://www.w3.org/TR/2001/REC-SVG-20010904/DTD/svg10.dtd">
|
||||
<svg version="1.0" xmlns="http://www.w3.org/2000/svg" width="64px" height="64px" viewBox="0 0 640 640" preserveAspectRatio="xMidYMid meet">
|
||||
<g id="layer101" fill="#d45500" stroke="none">
|
||||
<path d="M145 531 c-46 -31 -58 -75 -30 -118 21 -32 30 -22 44 47 7 30 19 62 27 71 26 29 1 29 -41 0z"/>
|
||||
<path d="M341 534 c-23 -29 -26 -50 -11 -88 10 -28 64 -60 86 -52 12 5 12 2 0 -22 -24 -47 -51 -64 -116 -71 -51 -6 -65 -12 -85 -37 -14 -16 -24 -32 -25 -36 0 -12 -35 -9 -48 4 -7 7 -12 24 -12 38 0 41 -11 43 -47 8 -47 -46 -46 -90 5 -138 20 -19 49 -51 63 -70 l27 -35 88 0 c49 0 106 4 127 8 46 10 106 62 143 125 25 42 28 58 30 142 0 52 4 103 9 113 11 27 -14 75 -49 93 -41 21 -115 44 -143 44 -12 0 -31 -12 -42 -26z m89 -119 c0 -3 -2 -5 -5 -5 -3 0 -5 2 -5 5 0 3 2 5 5 5 3 0 5 -2 5 -5z"/>
|
||||
</g>
|
||||
<g id="layer102" fill="#deaa87" stroke="none">
|
||||
<path d="M186 549 c-33 -31 -38 -43 -56 -137 -26 -135 -26 -163 3 -190 33 -31 49 -28 85 17 28 35 36 39 87 43 46 4 61 10 90 38 18 18 39 46 46 62 10 25 9 32 -5 46 -17 16 -19 16 -29 1 -8 -14 -15 -15 -34 -6 -27 12 -40 65 -24 96 10 17 8 23 -12 36 -13 8 -44 18 -69 21 -42 6 -49 4 -82 -27z"/>
|
||||
</g>
|
||||
|
||||
</svg>
|
||||
|
After Width: | Height: | Size: 1.2 KiB |
43
auxbin/jpm
Executable file
43
auxbin/jpm
Executable file
@@ -0,0 +1,43 @@
|
||||
#!/usr/bin/env janet
|
||||
|
||||
# CLI tool for building janet projects. Wraps cook.
|
||||
|
||||
(import cook)
|
||||
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
|
||||
|
||||
(defn- help
|
||||
[]
|
||||
(print "usage: jpm [targets]... --key=value ...")
|
||||
(print "Available targets are:")
|
||||
(each k (sort (keys (dyn :rules @{})))
|
||||
(print " " k))
|
||||
(print `
|
||||
|
||||
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)
|
||||
--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.
|
||||
`))
|
||||
|
||||
(def args (tuple/slice process/args 2))
|
||||
(def todo @[])
|
||||
(each arg args
|
||||
(if (string/has-prefix? "--" arg)
|
||||
(if-let [m (peg/match argpeg arg)]
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(print "invalid argument " arg))
|
||||
(array/push todo arg)))
|
||||
|
||||
(cook/import-rules "./project.janet")
|
||||
|
||||
(if (empty? todo) (help))
|
||||
(each rule todo (cook/do-rule rule))
|
||||
397
auxlib/cook.janet
Normal file
397
auxlib/cook.janet
Normal file
@@ -0,0 +1,397 @@
|
||||
### 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"))
|
||||
|
||||
#
|
||||
# Rule Engine
|
||||
#
|
||||
|
||||
(defn- getrules []
|
||||
(def rules (dyn :rules))
|
||||
(if 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)))
|
||||
|
||||
#
|
||||
# Declaring Artifacts - used in project.janet, targets specifically
|
||||
# tailored for janet.
|
||||
#
|
||||
|
||||
(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))
|
||||
(add-body "install"
|
||||
(try (os/mkdir destdir) ([err] nil))
|
||||
(copy src destdir))
|
||||
(add-body "uninstall"
|
||||
(def path (string destdir sep name))
|
||||
(print "removing " path)
|
||||
(try (rm path) ([err]
|
||||
(unless (= err "No such file or directory")
|
||||
(error err))))))
|
||||
|
||||
(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)
|
||||
(try (os/mkdir "build") ([err] nil))
|
||||
(phony "build" [])
|
||||
(phony "install" ["build"] (print "Installed."))
|
||||
(phony "uninstall" [] (print "Uninstalled."))
|
||||
(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.")))
|
||||
149
auxlib/path.janet
Normal file
149
auxlib/path.janet
Normal file
@@ -0,0 +1,149 @@
|
||||
### 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)))
|
||||
@@ -16,7 +16,7 @@
|
||||
|
||||
@rem Set compile and link options here
|
||||
@setlocal
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
||||
@set JANET_LINK=link /nologo
|
||||
|
||||
mkdir build
|
||||
@@ -53,7 +53,7 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot build\core_image.c JANET_PATH "C:/Janet/Library"
|
||||
build\janet_boot build\core_image.c
|
||||
|
||||
@rem Build the core image
|
||||
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||
@@ -65,6 +65,9 @@ for %%f in (src\core\*.c) do (
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
)
|
||||
|
||||
@rem Build the resources
|
||||
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
|
||||
@@ -72,9 +75,17 @@ for %%f in (src\mainclient\*.c) do (
|
||||
)
|
||||
|
||||
@rem Link everything to main client
|
||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj
|
||||
%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 Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
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
|
||||
|
||||
echo === Successfully built janet.exe for Windows ===
|
||||
echo === Run 'build_win test' to run tests. ==
|
||||
echo === Run 'build_win clean' to delete build artifacts. ===
|
||||
@@ -113,22 +124,20 @@ exit /b 0
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
|
||||
@rem Gen amlag
|
||||
setlocal enabledelayedexpansion
|
||||
set "amalg_files="
|
||||
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 > dist\janet.c
|
||||
copy build\janet.c dist\janet.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
copy README.md dist\README.md
|
||||
|
||||
copy janet.lib dist\janet.lib
|
||||
copy janet.exp dist\janet.exp
|
||||
copy src\include\janet.h dist\janet.h
|
||||
copy src\include\janetconf.h dist\janetconf.h
|
||||
copy tools\cook.janet dist\cook.janet
|
||||
copy tools\highlight.janet dist\highlight.janet
|
||||
copy src\conf\janetconf.h dist\janetconf.h
|
||||
|
||||
copy auxlib\cook.janet dist\cook.janet
|
||||
|
||||
copy auxbin\jpm dist\jpm
|
||||
copy tools\jpm.bat dist\jpm.bat
|
||||
exit /b 0
|
||||
|
||||
:TESTFAIL
|
||||
|
||||
@@ -14,5 +14,5 @@
|
||||
(map keys (keys solutions)))
|
||||
|
||||
(def arr @[2 4 1 3 8 7 -3 -1 12 -5 -8])
|
||||
(print "3sum of " (string/pretty arr) ":")
|
||||
(print (string/pretty (sum3 arr)))
|
||||
(printf "3sum of %P: " arr)
|
||||
(printf "%P\n" (sum3 arr))
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
:name "numarray"
|
||||
:source @["numarray.c"])
|
||||
|
||||
(import build/numarray :prefix "")
|
||||
(import build/numarray :as numarray)
|
||||
|
||||
(def a (numarray/new 30))
|
||||
(print (get a 20))
|
||||
|
||||
@@ -100,12 +100,12 @@ Janet num_array_get(void *p, Janet key) {
|
||||
|
||||
static const JanetReg cfuns[] = {
|
||||
{
|
||||
"numarray/new", num_array_new,
|
||||
"new", num_array_new,
|
||||
"(numarray/new size)\n\n"
|
||||
"Create new numarray"
|
||||
},
|
||||
{
|
||||
"numarray/scale", num_array_scale,
|
||||
"scale", num_array_scale,
|
||||
"(numarray/scale numarray factor)\n\n"
|
||||
"scale numarray by factor"
|
||||
},
|
||||
|
||||
@@ -13,4 +13,4 @@
|
||||
(if isprime? (array/push list i)))
|
||||
list)
|
||||
|
||||
(print (string/pretty (primes 100)))
|
||||
(pp (primes 100))
|
||||
|
||||
29
examples/urlloader.janet
Normal file
29
examples/urlloader.janet
Normal file
@@ -0,0 +1,29 @@
|
||||
# An example of using Janet's extensible module system
|
||||
# to import files from URL. To try this, run `janet -l examples/urlloader.janet`
|
||||
# from the repl, and then:
|
||||
#
|
||||
# (import https://raw.githubusercontent.com/janet-lang/janet/master/examples/colors.janet :as c)
|
||||
#
|
||||
# This will import a file using curl. You can then try
|
||||
#
|
||||
# (print (c/color :green "Hello!"))
|
||||
#
|
||||
# This is a bit of a toy example (it just shells out to curl), but it is very
|
||||
# powerful and will work well in many cases.
|
||||
|
||||
(defn- load-url
|
||||
[url args]
|
||||
(def f (file/popen (string "curl " url)))
|
||||
(def res (dofile f :source url ;args))
|
||||
(try (file/close f) ([err] nil))
|
||||
res)
|
||||
|
||||
(defn- check-http-url
|
||||
[path]
|
||||
(if (or (string/has-prefix? "http://" path)
|
||||
(string/has-prefix? "https://" path))
|
||||
path))
|
||||
|
||||
# Add the module loader and path tuple to right places
|
||||
(array/push module/paths [check-http-url :janet-http])
|
||||
(put module/loaders :janet-http load-url)
|
||||
@@ -1,55 +1,182 @@
|
||||
# Version
|
||||
!define VERSION "1.0.0"
|
||||
!define PRODUCT_VERSION "${VERSION}.0"
|
||||
VIProductVersion "${PRODUCT_VERSION}"
|
||||
VIFileVersion "${PRODUCT_VERSION}"
|
||||
|
||||
# Use the modern UI
|
||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||
!define MULTIUSER_MUI
|
||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "janet"
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_DEFAULT_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_KEY "Software\Janet\${VERSION}"
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR_REGISTRY_VALUENAME ""
|
||||
!define MULTIUSER_INSTALLMODE_INSTDIR "Janet-${VERSION}"
|
||||
|
||||
# Includes
|
||||
!include "MultiUser.nsh"
|
||||
!include "MUI2.nsh"
|
||||
!include ".\tools\EnvVarUpdate.nsh"
|
||||
!include "LogicLib.nsh"
|
||||
|
||||
# Basics
|
||||
Name "Janet"
|
||||
OutFile "janet-install.exe"
|
||||
OutFile "janet-v${VERSION}-windows-installer.exe"
|
||||
|
||||
# Some Configuration
|
||||
!define APPNAME "Janet"
|
||||
!define DESCRIPTION "The Janet Programming Language"
|
||||
!define HELPURL "http://janet-lang.org"
|
||||
BrandingText "The Janet Programming Language"
|
||||
|
||||
# Macros for setting registry values
|
||||
!define UNINST_KEY "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet-${VERSION}"
|
||||
!macro WriteEnv key value
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}" "${value}"
|
||||
${Else}
|
||||
WriteRegExpandStr HKCU "Environment" "${key}" "${value}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
!macro DelEnv key
|
||||
${If} $MultiUser.InstallMode == "AllUsers"
|
||||
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" "${key}"
|
||||
${Else}
|
||||
DeleteRegValue HKCU "Environment" "${key}"
|
||||
${EndIf}
|
||||
!macroend
|
||||
|
||||
# MUI Configuration
|
||||
!define MUI_ICON "assets\icon.ico"
|
||||
!define MUI_UNICON "assets\icon.ico"
|
||||
!define MUI_HEADERIMAGE
|
||||
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||
!define MUI_HEADERIMAGE_RIGHT
|
||||
!define MUI_ABORTWARNING
|
||||
|
||||
# Show a welcome page first
|
||||
!insertmacro MUI_PAGE_WELCOME
|
||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||
!insertmacro MUI_PAGE_COMPONENTS
|
||||
|
||||
# Pick Install Directory
|
||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||
!insertmacro MUI_PAGE_DIRECTORY
|
||||
|
||||
!insertmacro MUI_PAGE_INSTFILES
|
||||
|
||||
# Done
|
||||
!insertmacro MUI_PAGE_FINISH
|
||||
|
||||
!insertmacro MUI_UNPAGE_CONFIRM
|
||||
!insertmacro MUI_UNPAGE_INSTFILES
|
||||
|
||||
# Need to set a language.
|
||||
!insertmacro MUI_LANGUAGE "English"
|
||||
|
||||
Section "Janet" BfWSection
|
||||
SetOutPath $INSTDIR
|
||||
File "janet.exe"
|
||||
WriteUninstaller "$INSTDIR\janet-uninstall.exe"
|
||||
function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
functionEnd
|
||||
|
||||
section "Janet" BfWSection
|
||||
createDirectory "$INSTDIR\Library"
|
||||
createDirectory "$INSTDIR\C"
|
||||
createDirectory "$INSTDIR\bin"
|
||||
createDirectory "$INSTDIR\docs"
|
||||
setOutPath "$INSTDIR"
|
||||
|
||||
# Bin files
|
||||
file /oname=bin\janet.exe dist\janet.exe
|
||||
file /oname=logo.ico assets\icon.ico
|
||||
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
|
||||
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
|
||||
|
||||
# Documentation
|
||||
file /oname=docs\docs.html dist\doc.html
|
||||
|
||||
# Other
|
||||
file README.md
|
||||
file LICENSE
|
||||
|
||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||
|
||||
# Start Menu
|
||||
CreateShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\janet.exe" "" ""
|
||||
SectionEnd
|
||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||
|
||||
Function .onInit
|
||||
!insertmacro MULTIUSER_INIT
|
||||
!insertmacro MUI_LANGDLL_DISPLAY
|
||||
FunctionEnd
|
||||
# Set up Environment variables
|
||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
||||
|
||||
!insertmacro MUI_FUNCTION_DESCRIPTION_BEGIN
|
||||
!insertmacro MUI_DESCRIPTION_TEXT ${BfWSection} "The Janet programming language."
|
||||
!insertmacro MUI_FUNCTION_DESCRIPTION_END
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
Section "Uninstall"
|
||||
Delete "$INSTDIR\janet.exe"
|
||||
Delete "$INSTDIR\janet-uninstall.exe"
|
||||
RMDir "$INSTDIR"
|
||||
SectionEnd
|
||||
# Update path
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||
|
||||
Function un.onInit
|
||||
# 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" "0.6.0"
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMajor" 0
|
||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "VersionMinor" 6
|
||||
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
|
||||
|
||||
function un.onInit
|
||||
!insertmacro MULTIUSER_UNINIT
|
||||
!insertmacro MUI_UNGETLANGUAGE
|
||||
FunctionEnd
|
||||
functionEnd
|
||||
|
||||
section "uninstall"
|
||||
|
||||
# Remove Start Menu launcher
|
||||
delete "$SMPROGRAMS\Janet.lnk"
|
||||
|
||||
# Remove files
|
||||
delete "$INSTDIR\logo.ico"
|
||||
delete "$INSTDIR\README.md"
|
||||
delete "$INSTDIR\LICENSE"
|
||||
rmdir /r "$INSTDIR\Library"
|
||||
rmdir /r "$INSTDIR\bin"
|
||||
rmdir /r "$INSTDIR\C"
|
||||
rmdir /r "$INSTDIR\docs"
|
||||
|
||||
# Remove env vars
|
||||
!insertmacro DelEnv JANET_PATH
|
||||
!insertmacro DelEnv JANET_HEADERPATH
|
||||
!insertmacro DelEnv JANET_BINPATH
|
||||
|
||||
# Unset PATH
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||
|
||||
# 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"
|
||||
|
||||
# Remove uninstaller information from the registry
|
||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
||||
sectionEnd
|
||||
|
||||
8
janet.1
8
janet.1
@@ -3,7 +3,7 @@
|
||||
janet \- run the Janet language abstract machine
|
||||
.SH SYNOPSIS
|
||||
.B janet
|
||||
[\fB\-hvsrpnq\fR]
|
||||
[\fB\-hvsrpnqk\fR]
|
||||
[\fB\-e\fR \fISOURCE\fR]
|
||||
[\fB\-l\fR \fIMODULE\fR]
|
||||
[\fB\-m\fR \fIPATH\fR]
|
||||
@@ -67,9 +67,13 @@ after an error. Persistent mode can be good for debugging and testing.
|
||||
.BR \-q
|
||||
Quiet output. Don't print a repl prompt or expression results to stdout.
|
||||
|
||||
.TP
|
||||
.BR \-k
|
||||
Don't execute a script, only compile it to check for errors. Useful for linting scripts.
|
||||
|
||||
.TP
|
||||
.BR \-m\ syspath
|
||||
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
|
||||
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
|
||||
from a directory different than the default. The default is set when Janet is built, and defaults to
|
||||
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||
|
||||
|
||||
1
janet_win.rc
Normal file
1
janet_win.rc
Normal file
@@ -0,0 +1 @@
|
||||
IDI_MYICON ICON "assets\icon.ico"
|
||||
88
meson.build
88
meson.build
@@ -18,24 +18,60 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
project('janet', 'c', default_options : ['c_std=c99'])
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.0.0-dev')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
|
||||
|
||||
# Link math library on all systems
|
||||
cc = meson.get_compiler('c')
|
||||
m_dep = cc.find_library('m', required : false)
|
||||
dl_dep = cc.find_library('dl', required : false)
|
||||
|
||||
# Some options
|
||||
add_project_arguments('-DJANET_BUILD="meson"', language : 'c')
|
||||
# Link options
|
||||
if build_machine.system() != 'windows'
|
||||
add_project_link_arguments('-rdynamic', language : 'c')
|
||||
endif
|
||||
|
||||
# Generate custom janetconf.h
|
||||
conf = configuration_data()
|
||||
version_parts = meson.project_version().split('.')
|
||||
last_parts = version_parts[2].split('-')
|
||||
if last_parts.length() > 1
|
||||
conf.set_quoted('JANET_VERSION_EXTRA', '-' + last_parts[1])
|
||||
else
|
||||
conf.set_quoted('JANET_VERSION_EXTRA', '')
|
||||
endif
|
||||
conf.set('JANET_VERSION_MAJOR', version_parts[0].to_int())
|
||||
conf.set('JANET_VERSION_MINOR', version_parts[1].to_int())
|
||||
conf.set('JANET_VERSION_PATCH', last_parts[0].to_int())
|
||||
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_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'))
|
||||
conf.set('JANET_NO_ASSEMBLER', not get_option('assembler'))
|
||||
conf.set('JANET_NO_PEG', not get_option('peg'))
|
||||
conf.set('JANET_NO_TYPED_ARRAY', not get_option('typed_array'))
|
||||
conf.set('JANET_NO_INT_TYPES', not get_option('int_types'))
|
||||
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'))
|
||||
jconf = configure_file(output : 'janetconf.h',
|
||||
configuration : conf)
|
||||
|
||||
# Include directories
|
||||
incdir = include_directories('src/include')
|
||||
incdir = include_directories(['src/include', '.'])
|
||||
|
||||
# Building generated sources
|
||||
xxd = executable('xxd', 'tools/xxd.c')
|
||||
xxd = executable('xxd', 'tools/xxd.c', native : true)
|
||||
gen = generator(xxd,
|
||||
output : '@BASENAME@.gen.c',
|
||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||
@@ -113,36 +149,47 @@ mainclient_src = [
|
||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||
include_directories : incdir,
|
||||
c_args : '-DJANET_BOOTSTRAP',
|
||||
dependencies : [m_dep, dl_dep])
|
||||
dependencies : [m_dep, dl_dep],
|
||||
native : true)
|
||||
|
||||
# Build core image
|
||||
core_image = custom_target('core_image',
|
||||
input : [janet_boot],
|
||||
output : 'core_image.gen.c',
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path])
|
||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||
|
||||
libjanet = shared_library('janet', core_src, core_image,
|
||||
libjanet = library('janet', core_src, core_image,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
|
||||
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
install : true)
|
||||
|
||||
if meson.is_cross_build()
|
||||
janet_nativeclient = executable('janet-native', core_src, core_image, init_gen, mainclient_src,
|
||||
include_directories : incdir,
|
||||
dependencies : [m_dep, dl_dep],
|
||||
native : true)
|
||||
else
|
||||
janet_nativeclient = janet_mainclient
|
||||
endif
|
||||
|
||||
# Documentation
|
||||
docs = custom_target('docs',
|
||||
input : ['tools/gendoc.janet'],
|
||||
output : ['doc.html'],
|
||||
capture : true,
|
||||
command : [janet_mainclient, '@INPUT@'])
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated source
|
||||
amalg = custom_target('amalg',
|
||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||
output : ['janet.c'],
|
||||
capture : true,
|
||||
command : [janet_mainclient, '@INPUT@'])
|
||||
command : [janet_nativeclient, '@INPUT@'])
|
||||
|
||||
# Amalgamated client
|
||||
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||
@@ -161,20 +208,25 @@ test_files = [
|
||||
'test/suite6.janet'
|
||||
]
|
||||
foreach t : test_files
|
||||
test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
||||
endforeach
|
||||
|
||||
# Repl
|
||||
run_target('repl', command : [janet_mainclient])
|
||||
run_target('repl', command : [janet_nativeclient])
|
||||
|
||||
# For use as meson subproject (wrap)
|
||||
janet_dep = declare_dependency(include_directories : incdir,
|
||||
link_with : libjanet)
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_headers('src/include/janet.h', 'src/include/janetconf.h')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
janet_libs = [
|
||||
'src/include/janet.h',
|
||||
'src/include/janetconf.h',
|
||||
'tools/bars.janet',
|
||||
'tools/cook.janet',
|
||||
'tools/highlight.janet'
|
||||
'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')
|
||||
|
||||
17
meson_options.txt
Normal file
17
meson_options.txt
Normal file
@@ -0,0 +1,17 @@
|
||||
option('git_hash', type : 'string', value : 'meson')
|
||||
|
||||
option('single_threaded', type : 'boolean', value : false)
|
||||
option('nanbox', type : 'boolean', value : true)
|
||||
option('dynamic_modules', type : 'boolean', value : true)
|
||||
option('docstrings', type : 'boolean', value : true)
|
||||
option('sourcemaps', type : 'boolean', value : true)
|
||||
option('reduced_os', type : 'boolean', value : true)
|
||||
option('assembler', type : 'boolean', value : true)
|
||||
option('peg', type : 'boolean', value : true)
|
||||
option('typed_array', type : 'boolean', value : true)
|
||||
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)
|
||||
@@ -52,8 +52,24 @@ int main(int argc, const char **argv) {
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
janet_def(env, "process/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);
|
||||
#ifdef JANET_NO_DOCSTRINGS
|
||||
janet_table_put(opts, janet_ckeywordv("no-docstrings"), janet_wrap_true());
|
||||
#endif
|
||||
#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");
|
||||
|
||||
/* Run bootstrap script to generate core image */
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||
const char *boot_file;
|
||||
#ifdef JANET_NO_SOURCEMAPS
|
||||
boot_file = NULL;
|
||||
#else
|
||||
boot_file = "boot.janet";
|
||||
#endif
|
||||
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, boot_file, NULL);
|
||||
|
||||
/* Deinitialize vm */
|
||||
janet_deinit();
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2019 (C) Calvin Rose
|
||||
# Copyright 2019 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -7,10 +7,8 @@
|
||||
###
|
||||
###
|
||||
|
||||
(var *env* "The current environment." _env)
|
||||
|
||||
(def defn :macro
|
||||
"(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
||||
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
||||
(fn defn [name & more]
|
||||
(def len (length more))
|
||||
(def modifiers @[])
|
||||
@@ -64,14 +62,14 @@
|
||||
"Dynamically create a global def."
|
||||
[name value]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:value value})
|
||||
(setdyn name* @{:value value})
|
||||
nil)
|
||||
|
||||
(defn varglobal
|
||||
"Dynamically create a global var."
|
||||
[name init]
|
||||
(def name* (symbol name))
|
||||
(put *env* name* @{:ref @[init]})
|
||||
(setdyn name* @{:ref @[init]})
|
||||
nil)
|
||||
|
||||
# Basic predicates
|
||||
@@ -138,12 +136,12 @@
|
||||
|
||||
(defmacro comment
|
||||
"Ignores the body of the comment."
|
||||
[])
|
||||
[&])
|
||||
|
||||
(defmacro if-not
|
||||
"Shorthand for (if (not ... "
|
||||
[condition exp-1 &opt exp-2]
|
||||
~(if ,condition ,exp-2 ,exp-1))
|
||||
"Shorthand for (if (not condition) else then)."
|
||||
[condition then &opt else]
|
||||
~(if ,condition ,else ,then))
|
||||
|
||||
(defmacro when
|
||||
"Evaluates the body when the condition is true. Otherwise returns nil."
|
||||
@@ -151,7 +149,7 @@
|
||||
~(if ,condition (do ,;body)))
|
||||
|
||||
(defmacro unless
|
||||
"Shorthand for (when (not ... "
|
||||
"Shorthand for (when (not condition) ;body). "
|
||||
[condition & body]
|
||||
~(if ,condition nil (do ,;body)))
|
||||
|
||||
@@ -173,7 +171,7 @@
|
||||
(defmacro case
|
||||
"Select the body that equals the dispatch value. When pairs
|
||||
has an odd number of arguments, the last is the default expression.
|
||||
If no match is found, returns nil"
|
||||
If no match is found, returns nil."
|
||||
[dispatch & pairs]
|
||||
(def atm (idempotent? dispatch))
|
||||
(def sym (if atm dispatch (gensym)))
|
||||
@@ -216,7 +214,7 @@
|
||||
(let [[[err fib]] catch
|
||||
f (gensym)
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,body) :e)
|
||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
||||
,r (resume ,f)]
|
||||
(if (= (,fiber/status ,f) :error)
|
||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||
@@ -307,6 +305,7 @@
|
||||
~(do
|
||||
(var ,i nil)
|
||||
(while (set ,i ,expr)
|
||||
(def ,binding ,i)
|
||||
,body))))
|
||||
|
||||
(defn- loop1
|
||||
@@ -326,6 +325,7 @@
|
||||
(keyword? binding)
|
||||
(let [rest (loop1 body head (+ i 2))]
|
||||
(case binding
|
||||
:until ~(do (if ,verb (break) nil) ,rest)
|
||||
:while ~(do (if ,verb nil (break)) ,rest)
|
||||
:let ~(let ,verb (do ,rest))
|
||||
:after ~(do ,rest ,verb nil)
|
||||
@@ -388,6 +388,7 @@
|
||||
where :modifier is one of a set of keywords, and argument is keyword dependent.
|
||||
:modifier can be one of:\n\n
|
||||
\t:while expression - breaks from the loop if expression is falsey.\n
|
||||
\t:until expression - breaks from the loop if expression is truthy.\n
|
||||
\t:let bindings - defines bindings inside the loop as passed to the let macro.\n
|
||||
\t:before form - evaluates a form for a side effect before of the next inner loop.\n
|
||||
\t:after form - same as :before, but the side effect happens after the next inner loop.\n
|
||||
@@ -414,12 +415,12 @@
|
||||
"Create a generator expression using the loop syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See loop for details."
|
||||
[head & body]
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body))))))
|
||||
~(fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ...body))."
|
||||
"A wrapper for making fibers. Same as (fiber/new (fn [] ;body) :yi)."
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body)))
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
@@ -679,7 +680,7 @@
|
||||
|
||||
(defn find
|
||||
"Find the first value in an indexed collection that satisfies a predicate. Returns
|
||||
nil if not found. Note their is no way to differentiate a nil from the indexed collection
|
||||
nil if not found. Note there is no way to differentiate a nil from the indexed collection
|
||||
and a not found. Consider find-index if this is an issue."
|
||||
[pred ind]
|
||||
(def i (find-index pred ind))
|
||||
@@ -715,7 +716,7 @@
|
||||
|
||||
(defn juxt*
|
||||
"Returns the juxtaposition of functions. In other words,
|
||||
((juxt* a b c) x) evaluates to ((a x) (b x) (c x))."
|
||||
((juxt* a b c) x) evaluates to [(a x) (b x) (c x)]."
|
||||
[& funs]
|
||||
(fn [& args]
|
||||
(def ret @[])
|
||||
@@ -854,6 +855,17 @@
|
||||
(set prev ~(if-let [,sym ,prev] ,next-prev)))
|
||||
prev)
|
||||
|
||||
(defmacro with-dyns
|
||||
"Run a block of code in a new fiber that has some
|
||||
dynamic bindings set. The fiber will not mask errors
|
||||
or signals, but the dynamic bindings will be properly
|
||||
unset, as dynamic bindings are fiber local."
|
||||
[bindings & body]
|
||||
(def dyn-forms
|
||||
(seq [i :range [0 (length bindings) 2]]
|
||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
||||
|
||||
(defn partial
|
||||
"Partial function application."
|
||||
[f & more]
|
||||
@@ -903,8 +915,9 @@
|
||||
res)
|
||||
|
||||
(defn update
|
||||
"Accepts a key argument and passes its' associated value to a function.
|
||||
The key then, is associated to the function's return value"
|
||||
"Accepts a key argument and passes its associated value to a function.
|
||||
The key is the re-associated to the function's return value. Returns the updated
|
||||
data structure ds."
|
||||
[ds key func & args]
|
||||
(def old (get ds key))
|
||||
(set (ds key) (func old ;args)))
|
||||
@@ -1034,11 +1047,12 @@
|
||||
(var i 0) (var nextn n)
|
||||
(def len (length ind))
|
||||
(def ret (array/new (math/ceil (/ len n))))
|
||||
(def slicer (if (bytes? ind) string/slice tuple/slice))
|
||||
(while (<= nextn len)
|
||||
(array/push ret (tuple/slice ind i nextn))
|
||||
(array/push ret (slicer ind i nextn))
|
||||
(set i nextn)
|
||||
(+= nextn n))
|
||||
(if (not= i len) (array/push ret (tuple/slice ind i)))
|
||||
(if (not= i len) (array/push ret (slicer ind i)))
|
||||
ret)
|
||||
|
||||
###
|
||||
@@ -1068,6 +1082,18 @@
|
||||
(file/close f)
|
||||
nil)
|
||||
|
||||
(defn printf
|
||||
"Print formatted strings to stdout, followed by
|
||||
a new line."
|
||||
[f & args]
|
||||
(file/write stdout (buffer/format @"" f ;args)))
|
||||
|
||||
(defn pp
|
||||
"Pretty print to stdout."
|
||||
[x]
|
||||
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
### Pattern Matching
|
||||
@@ -1106,13 +1132,16 @@
|
||||
(put seen pattern true)
|
||||
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
|
||||
|
||||
(tuple? pattern)
|
||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
||||
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
|
||||
# Unification with external values
|
||||
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||
(match-1
|
||||
(get pattern 0) expr
|
||||
(fn []
|
||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen)
|
||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
|
||||
|
||||
(array? pattern)
|
||||
(indexed? pattern)
|
||||
(do
|
||||
(def len (length pattern))
|
||||
(var i -1)
|
||||
@@ -1173,15 +1202,11 @@
|
||||
###
|
||||
###
|
||||
|
||||
(var *doc-width*
|
||||
"Width in columns to print documentation."
|
||||
80)
|
||||
|
||||
(defn doc-format
|
||||
"Reformat text to wrap at a given line."
|
||||
[text]
|
||||
|
||||
(def maxcol (- *doc-width* 8))
|
||||
(def maxcol (- (dyn :doc-width 80) 8))
|
||||
(var buf @" ")
|
||||
(var word @"")
|
||||
(var current 0)
|
||||
@@ -1217,8 +1242,8 @@
|
||||
|
||||
(defn doc*
|
||||
"Get the documentation for a symbol in a given environment."
|
||||
[env sym]
|
||||
(def x (get env sym))
|
||||
[sym]
|
||||
(def x (dyn sym))
|
||||
(if (not x)
|
||||
(print "symbol " sym " not found.")
|
||||
(do
|
||||
@@ -1241,7 +1266,7 @@
|
||||
(defmacro doc
|
||||
"Shows documentation for the given symbol."
|
||||
[sym]
|
||||
~(,doc* *env* ',sym))
|
||||
~(,doc* ',sym))
|
||||
|
||||
###
|
||||
###
|
||||
@@ -1320,7 +1345,7 @@
|
||||
(defn dotup [t]
|
||||
(def h (get t 0))
|
||||
(def s (get specs h))
|
||||
(def entry (or (get *env* h) {}))
|
||||
(def entry (or (dyn h) {}))
|
||||
(def m (entry :value))
|
||||
(def m? (entry :macro))
|
||||
(cond
|
||||
@@ -1387,11 +1412,6 @@
|
||||
(set current (macex1 current)))
|
||||
current)
|
||||
|
||||
(defn pp
|
||||
"Pretty print to stdout."
|
||||
[x]
|
||||
(print (buffer/format @"" "%p" x)))
|
||||
|
||||
###
|
||||
###
|
||||
### Evaluation and Compilation
|
||||
@@ -1436,11 +1456,12 @@
|
||||
opts is a table or struct of options. The options are as follows:\n\n\t
|
||||
:chunks - callback to read into a buffer - default is getline\n\t
|
||||
:on-parse-error - callback when parsing fails - default is bad-parse\n\t
|
||||
:env - the environment to compile against - default is *env*\n\t
|
||||
:env - the environment to compile against - default is the current env\n\t
|
||||
:source - string path of source for better errors - default is \"<anonymous>\"\n\t
|
||||
:on-compile-error - callback when compilation fails - default is bad-compile\n\t
|
||||
:compile-only - only compile the souce, do not execute it - default is false\n\t
|
||||
:on-status - callback when a value is evaluated - default is debug/stacktrace\n\t
|
||||
:fiber-flags - what flags to wrap the compilation fiber with. Default is :a."
|
||||
:fiber-flags - what flags to wrap the compilation fiber with. Default is :ia."
|
||||
[opts]
|
||||
|
||||
(def {:env env
|
||||
@@ -1449,9 +1470,11 @@
|
||||
:on-compile-error on-compile-error
|
||||
:on-parse-error on-parse-error
|
||||
:fiber-flags guard
|
||||
:compile-only compile-only
|
||||
:source where} opts)
|
||||
(default env *env*)
|
||||
(default chunks getline)
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(default chunks (fn [buf p] (getline "" buf)))
|
||||
(default compile-only false)
|
||||
(default onstatus debug/stacktrace)
|
||||
(default on-compile-error bad-compile)
|
||||
(default on-parse-error bad-parse)
|
||||
@@ -1463,7 +1486,7 @@
|
||||
# The parser object
|
||||
(def p (parser/new))
|
||||
|
||||
# Evaluate 1 source form
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(defn eval1 [source]
|
||||
(var good true)
|
||||
(def f
|
||||
@@ -1471,7 +1494,7 @@
|
||||
(fn []
|
||||
(def res (compile source env where))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(unless compile-only (res))
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :start start :end end :fiber errf} res)
|
||||
@@ -1481,13 +1504,11 @@
|
||||
err))
|
||||
(on-compile-error msg errf where))))
|
||||
(or guard :a)))
|
||||
(fiber/setenv f env)
|
||||
(def res (resume f nil))
|
||||
(when good (if going (onstatus f res))))
|
||||
|
||||
(def oldenv *env*)
|
||||
(set *env* env)
|
||||
|
||||
# Run loop
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(while going
|
||||
(buffer/clear buf)
|
||||
@@ -1504,21 +1525,18 @@
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))))
|
||||
|
||||
# Check final parser state
|
||||
(while (parser/has-more p)
|
||||
(eval1 (parser/produce p)))
|
||||
(when (= (parser/status p) :error)
|
||||
(on-parse-error p where))
|
||||
|
||||
(set *env* oldenv)
|
||||
|
||||
env)
|
||||
|
||||
(defn eval-string
|
||||
"Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[str &opt env]
|
||||
[str]
|
||||
(var state (string str))
|
||||
(defn chunks [buf _]
|
||||
(def ret state)
|
||||
@@ -1527,26 +1545,24 @@
|
||||
(buffer/push-string buf str)
|
||||
(buffer/push-string buf "\n")))
|
||||
(var returnval nil)
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
(run-context {:chunks chunks
|
||||
:on-compile-error (fn [msg errf &]
|
||||
(error (string "compile error: " msg)))
|
||||
:on-parse-error (fn [p x]
|
||||
(error (string "parse error: " (parser/error p))))
|
||||
:fiber-flags :
|
||||
:fiber-flags :i
|
||||
:on-status (fn [f val]
|
||||
(if-not (= (fiber/status f) :dead)
|
||||
(error val))
|
||||
(set returnval val))
|
||||
:source "eval"})
|
||||
:source "eval-string"})
|
||||
returnval)
|
||||
|
||||
(defn eval
|
||||
"Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use run-context."
|
||||
[form &opt env]
|
||||
(default env *env*)
|
||||
(def res (compile form env "eval"))
|
||||
[form]
|
||||
(def res (compile form (fiber/getenv (fiber/current)) "eval"))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error (res :error))))
|
||||
@@ -1562,31 +1578,39 @@
|
||||
[image]
|
||||
(unmarshal image (env-lookup _env)))
|
||||
|
||||
(def module/paths
|
||||
"The list of paths to look for modules. The following
|
||||
substitutions are preformed on each path. :sys: becomes
|
||||
module/*syspath*, :name: becomes the last part of the module
|
||||
name after the last /, and :all: is the module name literally.
|
||||
:native: becomes the dynamic library file extension, usually dll
|
||||
or so. Each element is a two element tuple, containing the path
|
||||
template and a keyword :source, :native, or :image indicating how
|
||||
require should load files found at these paths."
|
||||
@[[":all:" :source]
|
||||
["./:all:.janet" :source]
|
||||
["./:all:/init.janet" :source]
|
||||
[":sys:/:all:.janet" :source]
|
||||
[":sys:/:all:/init.janet" :source]
|
||||
["./:all:.:native:" :native]
|
||||
["./:all:/:name:.:native:" :native]
|
||||
[":sys:/:all:.:native:" :native]
|
||||
["./:all:.jimage" :image]
|
||||
[":sys:/:all:.jimage" :image]])
|
||||
(def- nati (if (= :windows (os/which)) ".dll" ".so"))
|
||||
(defn- check-. [x] (if (string/has-prefix? "." x) x))
|
||||
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x))
|
||||
|
||||
(var module/*syspath*
|
||||
"The path where globally installed libraries are located.
|
||||
The default is set at build time and is /usr/local/lib/janet on linux/posix, and
|
||||
on Windows is C:/Janet/Library."
|
||||
(or (process/opts "JANET_PATH") ""))
|
||||
(def module/paths
|
||||
"The list of paths to look for modules, templated for module/expand-path.
|
||||
Each element is a two element tuple, containing the path
|
||||
template and a keyword :source, :native, or :image indicating how
|
||||
require should load files found at these paths.\n\nA tuple can also
|
||||
contain a third element, specifying a filter that prevents module/find
|
||||
from searching that path template if the filter doesn't match the input
|
||||
path. The filter can be a string or a predicate function, and
|
||||
is often a file extension, including the period."
|
||||
@[# Relative to (dyn :current-file "./."). Path must start with .
|
||||
[":cur:/:all:.jimage" :image check-.]
|
||||
[":cur:/:all:.janet" :source check-.]
|
||||
[":cur:/:all:/init.janet" :source check-.]
|
||||
[(string ":cur:/:all:" nati) :native check-.]
|
||||
|
||||
# As a path from (os/cwd)
|
||||
[":all:.jimage" :image not-check-.]
|
||||
[":all:.janet" :source not-check-.]
|
||||
[":all:/init.janet" :source not-check-.]
|
||||
[(string ":all:" nati) :native not-check-.]
|
||||
|
||||
# System paths
|
||||
[":sys:/:all:.jimage" :image not-check-.]
|
||||
[":sys:/:all:.janet" :source not-check-.]
|
||||
[":sys:/:all:/init.janet" :source not-check-.]
|
||||
[(string ":sys:/:all:" nati) :native not-check-.]])
|
||||
|
||||
(setdyn :syspath (process/opts "JANET_PATH"))
|
||||
(setdyn :headerpath (process/opts "JANET_HEADERPATH"))
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(if-let [has-stat (_env 'os/stat)]
|
||||
@@ -1602,32 +1626,45 @@
|
||||
(file/close f)
|
||||
res))))
|
||||
|
||||
(defn- mod-filter
|
||||
[x path]
|
||||
(case (type x)
|
||||
:nil path
|
||||
:string (string/has-suffix? x path)
|
||||
(x path)))
|
||||
|
||||
(defn module/find
|
||||
"Try to match a module or path name from the patterns in module/paths.
|
||||
Returns a tuple (fullpath kind) where the kind is one of :source, :native,
|
||||
or image if the module is found, otherise a tuple with nil followed by
|
||||
or image if the module is found, otherwise a tuple with nil followed by
|
||||
an error message."
|
||||
[path]
|
||||
(def parts (string/split "/" path))
|
||||
(def name (get parts (- (length parts) 1)))
|
||||
(def nati (if (= :windows (os/which)) "dll" "so"))
|
||||
(defn make-full
|
||||
[[p mod-kind]]
|
||||
(def fullpath (->> p
|
||||
(string/replace ":name:" name)
|
||||
(string/replace ":sys:" module/*syspath*)
|
||||
(string/replace ":native:" nati)
|
||||
(string/replace ":all:" path)))
|
||||
[fullpath mod-kind])
|
||||
(defn check-path [x] (if (fexists (x 0)) x))
|
||||
(def paths (map make-full module/paths))
|
||||
(def res (find check-path paths))
|
||||
(if res res [nil (string "could not find module "
|
||||
path
|
||||
":\n "
|
||||
;(interpose "\n " (map 0 paths)))]))
|
||||
(var ret nil)
|
||||
(each [p mod-kind checker] module/paths
|
||||
(when (mod-filter checker path)
|
||||
(if (function? p)
|
||||
(when-let [res (p path)]
|
||||
(set ret [res mod-kind])
|
||||
(break))
|
||||
(do
|
||||
(def fullpath (string (module/expand-path path p)))
|
||||
(when (fexists fullpath)
|
||||
(set ret [fullpath mod-kind])
|
||||
(break))))))
|
||||
(if ret ret
|
||||
(let [expander (fn [[t _ chk]]
|
||||
(when (string? t)
|
||||
(when (mod-filter chk path)
|
||||
(module/expand-path path t))))
|
||||
paths (filter identity (map expander module/paths))
|
||||
str-parts (interpose "\n " paths)]
|
||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||
|
||||
(put _env 'fexists nil)
|
||||
(put _env 'nati nil)
|
||||
(put _env 'mod-filter nil)
|
||||
(put _env 'check-. nil)
|
||||
(put _env 'not-check-. nil)
|
||||
|
||||
(def module/cache
|
||||
"Table mapping loaded module identifiers to their environments."
|
||||
@@ -1638,24 +1675,18 @@
|
||||
circular dependencies."
|
||||
@{})
|
||||
|
||||
(defn require
|
||||
"Require a module with the given name. Will search all of the paths in
|
||||
module/paths, then the path as a raw file path. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
(defn dofile
|
||||
"Evaluate a file and return the resulting environment."
|
||||
[path & args]
|
||||
(def {:exit exit-on-error} (table ;args))
|
||||
(if-let [check (get module/cache path)]
|
||||
check
|
||||
(do
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(def env
|
||||
(case mod-kind
|
||||
:source (do
|
||||
# Normal janet module
|
||||
(def f (file/open fullpath))
|
||||
(def newenv (make-env))
|
||||
(put module/loading fullpath true)
|
||||
(def {:exit exit-on-error
|
||||
:source source
|
||||
:env env
|
||||
:compile-only compile-only} (table ;args))
|
||||
(def f (if (= (type path) :core/file)
|
||||
path
|
||||
(file/open path)))
|
||||
(default env (make-env))
|
||||
(put env :current-file (string path))
|
||||
(defn chunks [buf _] (file/read f 2048 buf))
|
||||
(defn bp [&opt x y]
|
||||
(def ret (bad-parse x y))
|
||||
@@ -1665,7 +1696,7 @@
|
||||
(def ret (bad-compile x y z))
|
||||
(if exit-on-error (os/exit 1))
|
||||
ret)
|
||||
(run-context {:env newenv
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-parse-error bp
|
||||
:on-compile-error bc
|
||||
@@ -1673,27 +1704,50 @@
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(debug/stacktrace f x)
|
||||
(if exit-on-error (os/exit 1))))
|
||||
:source fullpath})
|
||||
(file/close f)
|
||||
(put module/loading fullpath nil)
|
||||
(table/setproto newenv nil))
|
||||
:native (native fullpath (make-env))
|
||||
:image (load-image (slurp fullpath))))
|
||||
:compile-only compile-only
|
||||
:source (or source (if (= f path) "<anonymous>" path))})
|
||||
(when (not= f path) (file/close f))
|
||||
env)
|
||||
|
||||
(def module/loaders
|
||||
"A table of loading method names to loading functions.
|
||||
This table lets require and import load many different kinds
|
||||
of files as module."
|
||||
@{:native (fn [path &] (native path (make-env)))
|
||||
:source (fn [path args]
|
||||
(put module/loading path true)
|
||||
(def newenv (dofile path ;args))
|
||||
(put module/loading path nil)
|
||||
newenv)
|
||||
:image (fn [path &] (load-image (slurp path)))})
|
||||
|
||||
(defn require
|
||||
"Require a module with the given name. Will search all of the paths in
|
||||
module/paths, then the path as a raw file path. Returns the new environment
|
||||
returned from compiling and running the file."
|
||||
[path & args]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
(if-let [check (get module/cache fullpath)]
|
||||
check
|
||||
(do
|
||||
(def loader (module/loaders mod-kind))
|
||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||
(def env (loader fullpath args))
|
||||
(put module/cache fullpath env)
|
||||
(put module/cache path env)
|
||||
env)))
|
||||
|
||||
(defn import*
|
||||
"Import a module into a given environment table. This is the
|
||||
functional form of (import ...) that expects and explicit environment
|
||||
table."
|
||||
[env path & args]
|
||||
"Function form of import. Same parameters, but the path
|
||||
and other symbol parameters should be strings instead."
|
||||
[path & args]
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def {:as as
|
||||
:prefix prefix
|
||||
:export ep} (table ;args))
|
||||
(def newenv (require path ;args))
|
||||
(def prefix (or (and as (string as "/")) prefix (string path "/")))
|
||||
(loop [[k v] :pairs newenv :when (not (v :private))]
|
||||
(loop [[k v] :pairs newenv :when (symbol? k) :when (not (v :private))]
|
||||
(def newv (table/setproto @{:private (not ep)} v))
|
||||
(put env (symbol prefix k) newv)))
|
||||
|
||||
@@ -1702,57 +1756,84 @@
|
||||
symbols into the current environment, prepending a given prefix as needed.
|
||||
(use the :as or :prefix option to set a prefix). If no prefix is provided,
|
||||
use the name of the module as a prefix. One can also use :export true
|
||||
to re-export the imported symbols."
|
||||
to re-export the imported symbols. If :exit true is given as an argument,
|
||||
any errors encountered at the top level in the module will cause (os/exit 1)
|
||||
to be called."
|
||||
[path & args]
|
||||
(def argm (map (fn [x]
|
||||
(if (keyword? x)
|
||||
x
|
||||
(string x)))
|
||||
args))
|
||||
(tuple import* '*env* (string path) ;argm))
|
||||
(tuple import* (string path) ;argm))
|
||||
|
||||
(defn repl
|
||||
"Run a repl. The first parameter is an optional function to call to
|
||||
get a chunk of source code that should return nil for end of file.
|
||||
The second parameter is a function that is called when a signal is
|
||||
caught. fmt is a format string used to print results, and defaults to
|
||||
\"%.20P\""
|
||||
[&opt chunks onsignal fmt]
|
||||
(def newenv (make-env))
|
||||
(default fmt "%.20P")
|
||||
caught."
|
||||
[&opt chunks onsignal env]
|
||||
(def level (+ (dyn :debug-level 0) 1))
|
||||
(default env (make-env))
|
||||
(default chunks (fn [buf p] (getline (string "repl:"
|
||||
(parser/where p)
|
||||
":"
|
||||
(parser/state p :delimiters) "> ")
|
||||
buf)))
|
||||
(default onsignal (fn [f x]
|
||||
(case (fiber/status f)
|
||||
:dead (do
|
||||
(put newenv '_ @{:value x})
|
||||
(print (buffer/format @"" fmt x)))
|
||||
(pp x)
|
||||
(put env '_ @{:value x}))
|
||||
:debug (let [nextenv (make-env env)]
|
||||
(put nextenv '_fiber @{:value f})
|
||||
(setdyn :debug-level level)
|
||||
(debug/stacktrace f x)
|
||||
(print ```
|
||||
|
||||
entering debugger - Ctrl-D to exit
|
||||
_fiber is bound to the suspended fiber
|
||||
|
||||
```)
|
||||
(repl (fn [buf p]
|
||||
(def status (parser/state p :delimiters))
|
||||
(def c (parser/where p))
|
||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||
(getline prompt buf))
|
||||
onsignal nextenv))
|
||||
(debug/stacktrace f x))))
|
||||
(run-context {:env newenv
|
||||
(run-context {:env env
|
||||
:chunks chunks
|
||||
:on-status onsignal
|
||||
:source "repl"}))
|
||||
|
||||
(defmacro meta
|
||||
"Add metadata to the current environment."
|
||||
[& args]
|
||||
(def opts (table ;args))
|
||||
(loop [[k v] :pairs opts]
|
||||
(put *env* k v)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in the current environment."
|
||||
[&opt env]
|
||||
(default env *env*)
|
||||
(defn- env-walk
|
||||
[pred &opt env]
|
||||
(default env (fiber/getenv (fiber/current)))
|
||||
(def envs @[])
|
||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||
(def symbol-set @{})
|
||||
(def ret-set @{})
|
||||
(loop [envi :in envs
|
||||
k :keys envi
|
||||
:when (symbol? k)]
|
||||
(put symbol-set k true))
|
||||
(sort (keys symbol-set)))
|
||||
:when (pred k)]
|
||||
(put ret-set k true))
|
||||
(sort (keys ret-set)))
|
||||
|
||||
(defn all-bindings
|
||||
"Get all symbols available in an enviroment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk symbol? env))
|
||||
|
||||
(defn all-dynamics
|
||||
"Get all dynamic bindings in an environment. Defaults to the current
|
||||
fiber's environment."
|
||||
[&opt env]
|
||||
(env-walk keyword? env))
|
||||
|
||||
# Clean up some extra defs
|
||||
(put _env 'process/opts nil)
|
||||
(put _env 'env-walk nil)
|
||||
(put _env '_env nil)
|
||||
|
||||
###
|
||||
@@ -1763,11 +1844,33 @@
|
||||
|
||||
(do
|
||||
|
||||
(def image (let [env-pairs (pairs (env-lookup *env*))
|
||||
(defn proto-flatten
|
||||
"Flatten a table and it's prototypes into a single table."
|
||||
[into x]
|
||||
(when x
|
||||
(proto-flatten into (table/getproto x))
|
||||
(loop [k :keys x]
|
||||
(put into k (x k))))
|
||||
into)
|
||||
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
|
||||
# Modify env based on some options.
|
||||
(loop [[k v] :pairs env
|
||||
:when (symbol? k)]
|
||||
(def flat (proto-flatten @{} v))
|
||||
(when (process/config :no-docstrings)
|
||||
(put flat :doc nil))
|
||||
(when (process/config :no-sourcemaps)
|
||||
(put flat :source-map nil))
|
||||
(put env k flat))
|
||||
|
||||
(put env 'process/config nil)
|
||||
(def image (let [env-pairs (pairs (env-lookup env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
(marshal *env* reverse-lookup)))
|
||||
(marshal env reverse-lookup)))
|
||||
|
||||
# Create C source file that contains images a uint8_t buffer. This
|
||||
# can be compiled and linked statically into the main janet library
|
||||
|
||||
@@ -45,6 +45,8 @@ int system_test() {
|
||||
assert(janet_equals(janet_wrap_number(1.4), janet_wrap_number(1.4)));
|
||||
assert(janet_equals(janet_wrap_number(3.14159265), janet_wrap_number(3.14159265)));
|
||||
|
||||
assert(NULL != &janet_wrap_nil);
|
||||
|
||||
assert(janet_equals(janet_cstringv("a string."), janet_cstringv("a string.")));
|
||||
assert(janet_equals(janet_csymbolv("sym"), janet_csymbolv("sym")));
|
||||
|
||||
|
||||
@@ -20,28 +20,41 @@
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* Configure Janet. Edit this file to customize the build */
|
||||
/* This is an example janetconf.h file. This will be usually generated
|
||||
* by the build system. */
|
||||
|
||||
#ifndef JANETCONF_H
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION "0.4.1"
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 0
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.0.0-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
/* These settings all affect linking, so use cautiously. */
|
||||
/* #define JANET_SINGLE_THREADED */
|
||||
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
* built. */
|
||||
/* #define JANET_NO_DOCSTRINGS */
|
||||
/* #define JANET_NO_SOURCEMAPS */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
|
||||
/* Other settings */
|
||||
/* #define JANET_NO_ASSEMBLER */
|
||||
/* #define JANET_NO_PEG */
|
||||
/* #define JANET_NO_TYPED_ARRAY */
|
||||
/* #define JANET_NO_INT_TYPES */
|
||||
/* #define JANET_REDUCED_OS */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||
/* #define JANET_RECURSION_GUARD 1024 */
|
||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||
/* #define JANET_STACK_MAX 16384 */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
/* #define JANET_WALIGN 8 */
|
||||
|
||||
#endif /* end of include guard: JANETCONF_H */
|
||||
@@ -26,10 +26,19 @@
|
||||
#endif
|
||||
|
||||
/* Create new userdata */
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
|
||||
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
||||
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
|
||||
sizeof(JanetAbstractHead) + size);
|
||||
header->size = size;
|
||||
header->type = atype;
|
||||
return (void *) & (header->data);
|
||||
}
|
||||
|
||||
void *janet_abstract_end(void *x) {
|
||||
janet_gc_settype((void *)(janet_gc_header(x)), JANET_MEMORY_ABSTRACT);
|
||||
return x;
|
||||
}
|
||||
|
||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||
return janet_abstract_end(janet_abstract_begin(atype, size));
|
||||
}
|
||||
|
||||
@@ -28,8 +28,9 @@
|
||||
|
||||
#include <string.h>
|
||||
|
||||
/* Initializes an array */
|
||||
JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
Janet *data = NULL;
|
||||
if (capacity > 0) {
|
||||
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
||||
@@ -43,16 +44,6 @@ JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
|
||||
return array;
|
||||
}
|
||||
|
||||
void janet_array_deinit(JanetArray *array) {
|
||||
free(array->data);
|
||||
}
|
||||
|
||||
/* Creates a new array */
|
||||
JanetArray *janet_array(int32_t capacity) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
return janet_array_init(array, capacity);
|
||||
}
|
||||
|
||||
/* Creates a new array from n elements. */
|
||||
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||
@@ -266,14 +257,14 @@ static const JanetReg array_cfuns[] = {
|
||||
{
|
||||
"array/ensure", cfun_array_ensure,
|
||||
JDOC("(array/ensure arr capacity)\n\n"
|
||||
"Ensures that the memory backing the array has enough memory for capacity "
|
||||
"Ensures that the memory backing the array is large enough for capacity "
|
||||
"items. Capacity must be an integer. If the backing capacity is already enough, "
|
||||
"then this function does nothing. Otherwise, the backing memory will be reallocated "
|
||||
"so that there is enough space.")
|
||||
},
|
||||
{
|
||||
"array/slice", cfun_array_slice,
|
||||
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||
JDOC("(array/slice arrtup &opt start end)\n\n"
|
||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||
@@ -297,9 +288,10 @@ static const JanetReg array_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"array/remove", cfun_array_remove,
|
||||
JDOC("(array/remove arr at [, n=1])\n\n"
|
||||
JDOC("(array/remove arr at &opt n)\n\n"
|
||||
"Remove up to n elements starting at index at in array arr. at can index from "
|
||||
"the end of the array with a negative index, and n must be a non-negative integer. "
|
||||
"By default, n is 1. "
|
||||
"Returns the array.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
|
||||
@@ -208,6 +208,10 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||
for (i = 1; i < argc; i++) {
|
||||
JanetByteView view = janet_getbytes(argv, i);
|
||||
if (view.bytes == buffer->data) {
|
||||
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
|
||||
view.bytes = buffer->data;
|
||||
}
|
||||
janet_buffer_push_bytes(buffer, view.bytes, view.len);
|
||||
}
|
||||
return argv[0];
|
||||
@@ -296,6 +300,7 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 5);
|
||||
JanetBuffer *dest = janet_getbuffer(argv, 0);
|
||||
JanetByteView src = janet_getbytes(argv, 1);
|
||||
int same_buf = src.bytes == dest->data;
|
||||
int32_t offset_dest = 0;
|
||||
int32_t offset_src = 0;
|
||||
if (argc > 2)
|
||||
@@ -315,7 +320,12 @@ static Janet cfun_buffer_blit(int32_t argc, Janet *argv) {
|
||||
janet_panic("buffer blit out of range");
|
||||
janet_buffer_ensure(dest, (int32_t) last, 2);
|
||||
if (last > dest->count) dest->count = (int32_t) last;
|
||||
if (same_buf) {
|
||||
src.bytes = dest->data;
|
||||
memmove(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
} else {
|
||||
memcpy(dest->data + offset_dest, src.bytes + offset_src, length_src);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
@@ -336,8 +346,8 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/new-filled", cfun_buffer_new_filled,
|
||||
JDOC("(buffer/new-filled count [, byte=0])\n\n"
|
||||
"Creates a new buffer of length count filled with byte. "
|
||||
JDOC("(buffer/new-filled count &opt byte)\n\n"
|
||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
||||
"Returns the new buffer.")
|
||||
},
|
||||
{
|
||||
@@ -373,7 +383,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/slice", cfun_buffer_slice,
|
||||
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||
JDOC("(buffer/slice bytes &opt start end)\n\n"
|
||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||
@@ -401,7 +411,7 @@ static const JanetReg buffer_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"buffer/blit", cfun_buffer_blit,
|
||||
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n"
|
||||
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
|
||||
"Insert the contents of src into dest. Can optionally take indices that "
|
||||
"indicate which part of src to copy into which part of dest. Indices can be "
|
||||
"negative to index from the end of src or dest. Returns dest.")
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Look up table for instructions */
|
||||
|
||||
@@ -36,6 +36,34 @@ void janet_panicv(Janet message) {
|
||||
}
|
||||
}
|
||||
|
||||
void janet_panicf(const char *format, ...) {
|
||||
va_list args;
|
||||
const uint8_t *ret;
|
||||
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);
|
||||
ret = janet_string(buffer.data, buffer.count);
|
||||
janet_buffer_deinit(&buffer);
|
||||
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));
|
||||
}
|
||||
@@ -204,3 +232,60 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
||||
}
|
||||
return range;
|
||||
}
|
||||
|
||||
Janet janet_dyn(const char *name) {
|
||||
if (!janet_vm_fiber) return janet_wrap_nil();
|
||||
if (janet_vm_fiber->env) {
|
||||
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
void janet_setdyn(const char *name, Janet value) {
|
||||
if (!janet_vm_fiber) return;
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(1);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
||||
}
|
||||
|
||||
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {
|
||||
uint64_t ret = 0;
|
||||
const uint8_t *keyw = janet_getkeyword(argv, n);
|
||||
int32_t klen = janet_string_length(keyw);
|
||||
int32_t flen = (int32_t) strlen(flags);
|
||||
if (flen > 64) {
|
||||
flen = 64;
|
||||
}
|
||||
for (int32_t j = 0; j < klen; j++) {
|
||||
for (int32_t i = 0; i < flen; i++) {
|
||||
if (((uint8_t) flags[i]) == keyw[j]) {
|
||||
ret |= 1ULL << i;
|
||||
goto found;
|
||||
}
|
||||
}
|
||||
janet_panicf("unexpected flag %c, expected one of \"%s\"", (char) keyw[j], flags);
|
||||
found:
|
||||
;
|
||||
}
|
||||
return ret;
|
||||
}
|
||||
|
||||
/* Some definitions for function-like macros */
|
||||
|
||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||
return janet_struct_head(st);
|
||||
}
|
||||
|
||||
JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
|
||||
return janet_abstract_head(abstract);
|
||||
}
|
||||
|
||||
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
|
||||
return janet_string_head(s);
|
||||
}
|
||||
|
||||
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
|
||||
return janet_tuple_head(tuple);
|
||||
}
|
||||
|
||||
@@ -35,6 +35,10 @@ static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) == 1;
|
||||
}
|
||||
static int maxarity1(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) <= 1;
|
||||
}
|
||||
static int minarity2(JanetFopts opts, JanetSlot *args) {
|
||||
(void) opts;
|
||||
return janet_v_count(args) >= 2;
|
||||
@@ -115,8 +119,12 @@ static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||
}
|
||||
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
||||
if (janet_v_count(args) == 0) {
|
||||
return genericSSI(opts, JOP_SIGNAL, janetc_cslot(janet_wrap_nil()), 3);
|
||||
} else {
|
||||
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
|
||||
}
|
||||
}
|
||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||
}
|
||||
@@ -262,7 +270,7 @@ static const JanetFunOptimizer optimizers[] = {
|
||||
{fixarity0, do_debug},
|
||||
{fixarity1, do_error},
|
||||
{minarity2, do_apply},
|
||||
{fixarity1, do_yield},
|
||||
{maxarity1, do_yield},
|
||||
{fixarity2, do_resume},
|
||||
{fixarity2, do_get},
|
||||
{fixarity3, do_put},
|
||||
|
||||
@@ -26,6 +26,7 @@
|
||||
#include "emit.h"
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#include "state.h"
|
||||
#endif
|
||||
|
||||
JanetFopts janetc_fopts_default(JanetCompiler *c) {
|
||||
@@ -628,7 +629,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
}
|
||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||
if (NULL != c->mapbuffer) {
|
||||
if (NULL != c->mapbuffer && c->source) {
|
||||
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
||||
def->sourcemap = malloc(s);
|
||||
if (NULL == def->sourcemap) {
|
||||
@@ -716,8 +717,12 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
|
||||
|
||||
/* C Function for compiling */
|
||||
static Janet cfun(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 2, 3);
|
||||
JanetTable *env = janet_gettable(argv, 1);
|
||||
janet_arity(argc, 1, 3);
|
||||
JanetTable *env = argc > 1 ? janet_gettable(argv, 1) : janet_vm_fiber->env;
|
||||
if (NULL == env) {
|
||||
env = janet_table(0);
|
||||
janet_vm_fiber->env = env;
|
||||
}
|
||||
const uint8_t *source = NULL;
|
||||
if (argc == 3) {
|
||||
source = janet_getstring(argv, 2);
|
||||
@@ -740,7 +745,7 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
static const JanetReg compile_cfuns[] = {
|
||||
{
|
||||
"compile", cfun,
|
||||
JDOC("(compile ast env [, source])\n\n"
|
||||
JDOC("(compile ast &opt env source)\n\n"
|
||||
"Compiles an Abstract Syntax Tree (ast) into a janet function. "
|
||||
"Pair the compile function with parsing functionality to implement "
|
||||
"eval. Returns a janet function and does not modify ast. Throws an "
|
||||
|
||||
@@ -57,18 +57,199 @@ typedef void *Clib;
|
||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
Clib lib = load_clib(name);
|
||||
JanetModule init;
|
||||
JanetModconf getter;
|
||||
if (!lib) {
|
||||
*error = janet_cstring(error_clib());
|
||||
return NULL;
|
||||
}
|
||||
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
||||
if (!init) {
|
||||
*error = janet_cstring("could not find _janet_init symbol");
|
||||
*error = janet_cstring("could not find the _janet_init symbol");
|
||||
return NULL;
|
||||
}
|
||||
getter = (JanetModconf) symbol_clib(lib, "_janet_mod_config");
|
||||
if (!getter) {
|
||||
*error = janet_cstring("could not find the _janet_mod_config symbol");
|
||||
return NULL;
|
||||
}
|
||||
JanetBuildConfig modconf = getter();
|
||||
JanetBuildConfig host = janet_config_current();
|
||||
if (host.major != modconf.major ||
|
||||
host.minor < modconf.minor ||
|
||||
host.bits != modconf.bits) {
|
||||
char errbuf[128];
|
||||
sprintf(errbuf, "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
host.major,
|
||||
host.minor,
|
||||
host.patch,
|
||||
host.bits,
|
||||
modconf.major,
|
||||
modconf.minor,
|
||||
modconf.patch,
|
||||
modconf.bits);
|
||||
*error = janet_cstring(errbuf);
|
||||
return NULL;
|
||||
}
|
||||
return init;
|
||||
}
|
||||
|
||||
static const char *janet_dyncstring(const char *name, const char *dflt) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (janet_checktype(x, JANET_NIL)) return dflt;
|
||||
if (!janet_checktype(x, JANET_STRING)) {
|
||||
janet_panicf("expected string, got %v", x);
|
||||
}
|
||||
const uint8_t *jstr = janet_unwrap_string(x);
|
||||
const char *cstr = (const char *)jstr;
|
||||
if (strlen(cstr) != (size_t) janet_string_length(jstr)) {
|
||||
janet_panicf("string %v contains embedded 0s");
|
||||
}
|
||||
return cstr;
|
||||
}
|
||||
|
||||
static int is_path_sep(char c) {
|
||||
#ifdef JANET_WINDOWS
|
||||
if (c == '\\') return 1;
|
||||
#endif
|
||||
return c == '/';
|
||||
}
|
||||
|
||||
/* Used for module system. */
|
||||
static Janet janet_core_expand_path(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *input = janet_getcstring(argv, 0);
|
||||
const char *template = janet_getcstring(argv, 1);
|
||||
const char *curfile = janet_dyncstring("current-file", "");
|
||||
const char *syspath = janet_dyncstring("syspath", "");
|
||||
JanetBuffer *out = janet_buffer(0);
|
||||
size_t tlen = strlen(template);
|
||||
|
||||
/* Calculate name */
|
||||
const char *name = input + strlen(input);
|
||||
while (name > input) {
|
||||
if (is_path_sep(*(name - 1))) break;
|
||||
name--;
|
||||
}
|
||||
|
||||
/* Calculate dirpath from current file */
|
||||
const char *curname = curfile + strlen(curfile);
|
||||
while (curname > curfile) {
|
||||
if (is_path_sep(*curname)) break;
|
||||
curname--;
|
||||
}
|
||||
const char *curdir;
|
||||
int32_t curlen;
|
||||
if (curname == curfile) {
|
||||
/* Current file has one or zero path segments, so
|
||||
* we are in the . directory. */
|
||||
curdir = ".";
|
||||
curlen = 1;
|
||||
} else {
|
||||
/* Current file has 2 or more segments, so we
|
||||
* can cut off the last segment. */
|
||||
curdir = curfile;
|
||||
curlen = (int32_t)(curname - curfile);
|
||||
}
|
||||
|
||||
for (size_t i = 0; i < tlen; i++) {
|
||||
if (template[i] == ':') {
|
||||
if (strncmp(template + i, ":all:", 5) == 0) {
|
||||
janet_buffer_push_cstring(out, input);
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":cur:", 5) == 0) {
|
||||
janet_buffer_push_bytes(out, (const uint8_t *)curdir, curlen);
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":dir:", 5) == 0) {
|
||||
janet_buffer_push_bytes(out, (const uint8_t *)input,
|
||||
(int32_t)(name - input));
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":sys:", 5) == 0) {
|
||||
janet_buffer_push_cstring(out, syspath);
|
||||
i += 4;
|
||||
} else if (strncmp(template + i, ":name:", 6) == 0) {
|
||||
janet_buffer_push_cstring(out, name);
|
||||
i += 5;
|
||||
} else {
|
||||
janet_buffer_push_u8(out, (uint8_t) template[i]);
|
||||
}
|
||||
} else {
|
||||
janet_buffer_push_u8(out, (uint8_t) template[i]);
|
||||
}
|
||||
}
|
||||
|
||||
/* Normalize */
|
||||
uint8_t *scan = out->data;
|
||||
uint8_t *print = scan;
|
||||
uint8_t *scanend = scan + out->count;
|
||||
int normal_section_count = 0;
|
||||
int dot_count = 0;
|
||||
while (scan < scanend) {
|
||||
if (*scan == '.') {
|
||||
if (dot_count >= 0) {
|
||||
dot_count++;
|
||||
} else {
|
||||
*print++ = '.';
|
||||
}
|
||||
} else if (is_path_sep(*scan)) {
|
||||
if (dot_count == 1) {
|
||||
;
|
||||
} else if (dot_count == 2) {
|
||||
if (normal_section_count > 0) {
|
||||
/* unprint last separator */
|
||||
print--;
|
||||
/* unprint last section */
|
||||
while (print > out->data && !is_path_sep(*(print - 1)))
|
||||
print--;
|
||||
normal_section_count--;
|
||||
} else {
|
||||
*print++ = '.';
|
||||
*print++ = '.';
|
||||
*print++ = '/';
|
||||
}
|
||||
} else if (scan == out->data || dot_count != 0) {
|
||||
while (dot_count > 0) {
|
||||
--dot_count;
|
||||
*print++ = '.';
|
||||
}
|
||||
if (scan > out->data) {
|
||||
normal_section_count++;
|
||||
}
|
||||
*print++ = '/';
|
||||
}
|
||||
dot_count = 0;
|
||||
} else {
|
||||
dot_count = -1;
|
||||
*print++ = *scan;
|
||||
}
|
||||
scan++;
|
||||
}
|
||||
out->count = (int32_t)(print - out->data);
|
||||
return janet_wrap_buffer(out);
|
||||
}
|
||||
|
||||
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
Janet value;
|
||||
if (janet_vm_fiber->env) {
|
||||
value = janet_table_get(janet_vm_fiber->env, argv[0]);
|
||||
} else {
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
if (argc == 2 && janet_checktype(value, JANET_NIL)) {
|
||||
return argv[1];
|
||||
}
|
||||
return value;
|
||||
}
|
||||
|
||||
static Janet janet_core_setdyn(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(2);
|
||||
}
|
||||
janet_table_put(janet_vm_fiber->env, argv[0], argv[1]);
|
||||
return argv[1];
|
||||
}
|
||||
|
||||
static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
JanetModule init;
|
||||
janet_arity(argc, 1, 2);
|
||||
@@ -88,19 +269,6 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_table(env);
|
||||
}
|
||||
|
||||
static Janet janet_core_print(int32_t argc, Janet *argv) {
|
||||
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], stdout);
|
||||
}
|
||||
}
|
||||
putc('\n', stdout);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet janet_core_describe(int32_t argc, Janet *argv) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < argc; ++i)
|
||||
@@ -241,19 +409,21 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
janet_arity(argc, 0, 2);
|
||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||
if (argc >= 1) {
|
||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||
printf("%s", prompt);
|
||||
fflush(stdout);
|
||||
fprintf(out, "%s", prompt);
|
||||
fflush(out);
|
||||
}
|
||||
{
|
||||
buf->count = 0;
|
||||
int c;
|
||||
for (;;) {
|
||||
c = fgetc(stdin);
|
||||
if (feof(stdin) || c < 0) {
|
||||
c = fgetc(in);
|
||||
if (feof(in) || c < 0) {
|
||||
break;
|
||||
}
|
||||
janet_buffer_push_u8(buf, (uint8_t) c);
|
||||
@@ -263,23 +433,30 @@ static Janet janet_core_getline(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_buffer(buf);
|
||||
}
|
||||
|
||||
static Janet janet_core_trace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags |= JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
func->gc.flags &= ~JANET_FUNCFLAG_TRACE;
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg corelib_cfuns[] = {
|
||||
{
|
||||
"native", janet_core_native,
|
||||
JDOC("(native path [,env])\n\n"
|
||||
JDOC("(native path &opt env)\n\n"
|
||||
"Load a native module from the given path. The path "
|
||||
"must be an absolute or relative path on the file system, and is "
|
||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||
"Returns an environment table that contains functions and other values "
|
||||
"from the native module.")
|
||||
},
|
||||
{
|
||||
"print", janet_core_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.")
|
||||
},
|
||||
{
|
||||
"describe", janet_core_describe,
|
||||
JDOC("(describe x)\n\n"
|
||||
@@ -399,7 +576,7 @@ static const JanetReg corelib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"next", janet_core_next,
|
||||
JDOC("(next dict key)\n\n"
|
||||
JDOC("(next dict &opt key)\n\n"
|
||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||
"to be seen only once per iteration if they data structure is not mutated "
|
||||
@@ -415,10 +592,38 @@ static const JanetReg corelib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"getline", janet_core_getline,
|
||||
JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n"
|
||||
JDOC("(getline &opt prompt buf)\n\n"
|
||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
||||
"Use this function to implement a simple interface for a terminal program.")
|
||||
},
|
||||
{
|
||||
"dyn", janet_core_dyn,
|
||||
JDOC("(dyn key &opt default)\n\n"
|
||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
|
||||
},
|
||||
{
|
||||
"setdyn", janet_core_setdyn,
|
||||
JDOC("(setdyn key value)\n\n"
|
||||
"Set a dynamic binding. Returns value.")
|
||||
},
|
||||
{
|
||||
"trace", janet_core_trace,
|
||||
JDOC("(trace func)\n\n"
|
||||
"Enable tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"untrace", janet_core_untrace,
|
||||
JDOC("(untrace func)\n\n"
|
||||
"Disables tracing on a function. Returns the function.")
|
||||
},
|
||||
{
|
||||
"module/expand-path", janet_core_expand_path,
|
||||
JDOC("(module/expand-path path template)\n\n"
|
||||
"Expands a path template as found in module/paths for module/find. "
|
||||
"This takes in a path (the argument to require) and a template string, template, "
|
||||
"to expand the path to a path that can be "
|
||||
"used for importing files.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -616,7 +821,7 @@ static void make_apply(JanetTable *env) {
|
||||
"be an array-like. Each element in this last argument is then also pushed as an argument to "
|
||||
"f. For example:\n\n"
|
||||
"\t(apply + 1000 (range 10))\n\n"
|
||||
"sums the first 10 integers and 1000.)"));
|
||||
"sums the first 10 integers and 1000."));
|
||||
}
|
||||
|
||||
static const uint32_t error_asm[] = {
|
||||
@@ -793,6 +998,9 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
JDOC("The version number of the running janet program."));
|
||||
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
||||
JDOC("The build identifier of the running janet program."));
|
||||
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
|
||||
JDOC("The flag set of config options from janetconf.h which is used to check "
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||
|
||||
@@ -95,6 +95,7 @@ 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;
|
||||
@@ -116,43 +117,43 @@ 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(stderr, "%s%s: %s\n",
|
||||
fprintf(out, "%s%s: %s\n",
|
||||
prefix,
|
||||
janet_status_names[status],
|
||||
errstr);
|
||||
wrote_error = 1;
|
||||
}
|
||||
|
||||
fprintf(stderr, " in");
|
||||
fprintf(out, " in");
|
||||
|
||||
if (frame->func) {
|
||||
def = frame->func->def;
|
||||
fprintf(stderr, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
fprintf(out, " %s", def->name ? (const char *)def->name : "<anonymous>");
|
||||
if (def->source) {
|
||||
fprintf(stderr, " [%s]", (const char *)def->source);
|
||||
fprintf(out, " [%s]", (const char *)def->source);
|
||||
}
|
||||
} else {
|
||||
JanetCFunction cfun = (JanetCFunction)(frame->pc);
|
||||
if (cfun) {
|
||||
Janet name = janet_table_get(janet_vm_registry, janet_wrap_cfunction(cfun));
|
||||
if (!janet_checktype(name, JANET_NIL))
|
||||
fprintf(stderr, " %s", (const char *)janet_to_string(name));
|
||||
fprintf(out, " %s", (const char *)janet_to_string(name));
|
||||
else
|
||||
fprintf(stderr, " <cfunction>");
|
||||
fprintf(out, " <cfunction>");
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
fprintf(stderr, " (tailcall)");
|
||||
fprintf(out, " (tailcall)");
|
||||
if (frame->func && frame->pc) {
|
||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||
if (def->sourcemap) {
|
||||
JanetSourceMapping mapping = def->sourcemap[off];
|
||||
fprintf(stderr, " at (%d:%d)", mapping.start, mapping.end);
|
||||
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||
} else {
|
||||
fprintf(stderr, " pc=%d", off);
|
||||
fprintf(out, " pc=%d", off);
|
||||
}
|
||||
}
|
||||
fprintf(stderr, "\n");
|
||||
fprintf(out, "\n");
|
||||
}
|
||||
}
|
||||
|
||||
@@ -322,14 +323,14 @@ static const JanetReg debug_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"debug/fbreak", cfun_debug_fbreak,
|
||||
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||
JDOC("(debug/fbreak fun &opt pc)\n\n"
|
||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||
"if the offset is too large or negative.")
|
||||
},
|
||||
{
|
||||
"debug/unfbreak", cfun_debug_unfbreak,
|
||||
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||
JDOC("(debug/unfbreak fun &opt pc)\n\n"
|
||||
"Unset a breakpoint set with debug/fbreak.")
|
||||
},
|
||||
{
|
||||
|
||||
@@ -239,11 +239,11 @@ void janetc_copy(
|
||||
return;
|
||||
}
|
||||
/* Process: src -> near -> dest */
|
||||
int32_t near = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||
janetc_movenear(c, near, src);
|
||||
janetc_moveback(c, dest, near);
|
||||
int32_t nearreg = janetc_allocnear(c, JANETC_REGTEMP_3);
|
||||
janetc_movenear(c, nearreg, src);
|
||||
janetc_moveback(c, dest, nearreg);
|
||||
/* Cleanup */
|
||||
janetc_regalloc_freetemp(&c->scope->ra, near, JANETC_REGTEMP_3);
|
||||
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
|
||||
|
||||
}
|
||||
/* Instruction templated emitters */
|
||||
|
||||
@@ -35,6 +35,7 @@ static void fiber_reset(JanetFiber *fiber) {
|
||||
fiber->stacktop = JANET_FRAME_SIZE;
|
||||
fiber->child = NULL;
|
||||
fiber->flags = JANET_FIBER_MASK_YIELD;
|
||||
fiber->env = NULL;
|
||||
janet_fiber_set_status(fiber, JANET_STATUS_NEW);
|
||||
}
|
||||
|
||||
@@ -126,6 +127,16 @@ void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||
fiber->stacktop = newtop;
|
||||
}
|
||||
|
||||
/* Create a struct with n values. If n is odd, the last value is ignored. */
|
||||
static Janet make_struct_n(const Janet *args, int32_t n) {
|
||||
int32_t i = 0;
|
||||
JanetKV *st = janet_struct_begin(n & (~1));
|
||||
for (; i < n; i += 2) {
|
||||
janet_struct_put(st, args[i], args[i + 1]);
|
||||
}
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
/* Push a stack frame to a fiber */
|
||||
int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
JanetStackFrame *newframe;
|
||||
@@ -163,10 +174,17 @@ int janet_fiber_funcframe(JanetFiber *fiber, JanetFunction *func) {
|
||||
/* Check varargs */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
int32_t tuplehead = fiber->frame + func->def->arity;
|
||||
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
if (tuplehead >= oldtop) {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(NULL, 0)
|
||||
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
} else {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
oldtop - tuplehead));
|
||||
}
|
||||
@@ -219,12 +237,19 @@ int janet_fiber_funcframe_tail(JanetFiber *fiber, JanetFunction *func) {
|
||||
/* Check varargs */
|
||||
if (func->def->flags & JANET_FUNCDEF_FLAG_VARARG) {
|
||||
int32_t tuplehead = fiber->stackstart + func->def->arity;
|
||||
int st = func->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
if (tuplehead >= fiber->stacktop) {
|
||||
if (tuplehead >= fiber->capacity) janet_fiber_setcapacity(fiber, 2 * (tuplehead + 1));
|
||||
for (i = fiber->stacktop; i < tuplehead; ++i) fiber->data[i] = janet_wrap_nil();
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(NULL, 0)
|
||||
: janet_wrap_tuple(janet_tuple_n(NULL, 0));
|
||||
} else {
|
||||
fiber->data[tuplehead] = janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data[tuplehead] = st
|
||||
? make_struct_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead)
|
||||
: janet_wrap_tuple(janet_tuple_n(
|
||||
fiber->data + tuplehead,
|
||||
fiber->stacktop - tuplehead));
|
||||
}
|
||||
@@ -291,8 +316,35 @@ void janet_fiber_popframe(JanetFiber *fiber) {
|
||||
fiber->frame = frame->prevframe;
|
||||
}
|
||||
|
||||
JanetFiberStatus janet_fiber_status(JanetFiber *f) {
|
||||
return ((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET;
|
||||
}
|
||||
|
||||
JanetFiber *janet_current_fiber(void) {
|
||||
return janet_vm_fiber;
|
||||
}
|
||||
|
||||
/* CFuns */
|
||||
|
||||
static Janet cfun_fiber_getenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
return fiber->env ?
|
||||
janet_wrap_table(fiber->env) :
|
||||
janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_setenv(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
if (janet_checktype(argv[1], JANET_NIL)) {
|
||||
fiber->env = NULL;
|
||||
} else {
|
||||
fiber->env = janet_gettable(argv, 1);
|
||||
}
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *func = janet_getfunction(argv, 0);
|
||||
@@ -333,6 +385,19 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
case 'y':
|
||||
fiber->flags |= JANET_FIBER_MASK_YIELD;
|
||||
break;
|
||||
case 'i':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_vm_fiber->env;
|
||||
break;
|
||||
case 'p':
|
||||
if (!janet_vm_fiber->env) {
|
||||
janet_vm_fiber->env = janet_table(0);
|
||||
}
|
||||
fiber->env = janet_table(0);
|
||||
fiber->env->proto = janet_vm_fiber->env;
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
@@ -343,8 +408,7 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
||||
static Janet cfun_fiber_status(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
uint32_t s = (fiber->flags & JANET_FIBER_STATUS_MASK) >>
|
||||
JANET_FIBER_STATUS_OFFSET;
|
||||
uint32_t s = janet_fiber_status(fiber);
|
||||
return janet_ckeywordv(janet_status_names[s]);
|
||||
}
|
||||
|
||||
@@ -374,7 +438,7 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
||||
static const JanetReg fiber_cfuns[] = {
|
||||
{
|
||||
"fiber/new", cfun_fiber_new,
|
||||
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||
JDOC("(fiber/new func &opt sigmask)\n\n"
|
||||
"Create a new fiber with function body func. Can optionally "
|
||||
"take a set of signals to block from the current parent fiber "
|
||||
"when called. The mask is specified as a keyword where each character "
|
||||
@@ -388,7 +452,11 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"\te - block error signals\n"
|
||||
"\tu - block user signals\n"
|
||||
"\ty - block yield signals\n"
|
||||
"\t0-9 - block a specific user signal")
|
||||
"\t0-9 - block a specific user signal\n\n"
|
||||
"The sigmask argument also can take environment flags. If any mutually "
|
||||
"exclusive flags are present, the last flag takes precedence.\n\n"
|
||||
"\ti - inherit the environment from the current fiber\n"
|
||||
"\tp - the environment table's prototype is the current environment table")
|
||||
},
|
||||
{
|
||||
"fiber/status", cfun_fiber_status,
|
||||
@@ -420,6 +488,18 @@ static const JanetReg fiber_cfuns[] = {
|
||||
"Sets the maximum stack size in janet values for a fiber. By default, the "
|
||||
"maximum stack size is usually 8192.")
|
||||
},
|
||||
{
|
||||
"fiber/getenv", cfun_fiber_getenv,
|
||||
JDOC("(fiber/getenv fiber)\n\n"
|
||||
"Gets the environment for a fiber. Returns nil if no such table is "
|
||||
"set yet.")
|
||||
},
|
||||
{
|
||||
"fiber/setenv", cfun_fiber_setenv,
|
||||
JDOC("(fiber/setenv fiber table)\n\n"
|
||||
"Sets the environment table for a fiber. Set to nil to remove the current "
|
||||
"environment.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -25,6 +25,7 @@
|
||||
#include "state.h"
|
||||
#include "symcache.h"
|
||||
#include "gc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* GC State */
|
||||
@@ -38,6 +39,11 @@ JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch Memory */
|
||||
JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
/* Helpers for marking the various gc types */
|
||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||
@@ -107,11 +113,11 @@ static void janet_mark_buffer(JanetBuffer *buffer) {
|
||||
}
|
||||
|
||||
static void janet_mark_abstract(void *adata) {
|
||||
if (janet_gc_reachable(janet_abstract_header(adata)))
|
||||
if (janet_gc_reachable(janet_abstract_head(adata)))
|
||||
return;
|
||||
janet_gc_mark(janet_abstract_header(adata));
|
||||
if (janet_abstract_header(adata)->type->gcmark) {
|
||||
janet_abstract_header(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||
janet_gc_mark(janet_abstract_head(adata));
|
||||
if (janet_abstract_head(adata)->type->gcmark) {
|
||||
janet_abstract_head(adata)->type->gcmark(adata, janet_abstract_size(adata));
|
||||
}
|
||||
}
|
||||
|
||||
@@ -236,6 +242,9 @@ recur:
|
||||
i = frame->prevframe;
|
||||
}
|
||||
|
||||
if (fiber->env)
|
||||
janet_mark_table(fiber->env);
|
||||
|
||||
/* Explicit tail recursion */
|
||||
if (fiber->child) {
|
||||
fiber = fiber->child;
|
||||
@@ -253,10 +262,10 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_ARRAY:
|
||||
janet_array_deinit((JanetArray *) mem);
|
||||
free(((JanetArray *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_TABLE:
|
||||
janet_table_deinit((JanetTable *) mem);
|
||||
free(((JanetTable *) mem)->data);
|
||||
break;
|
||||
case JANET_MEMORY_FIBER:
|
||||
free(((JanetFiber *)mem)->data);
|
||||
@@ -338,6 +347,13 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
||||
return (void *)mem;
|
||||
}
|
||||
|
||||
/* Free all allocated scratch memory */
|
||||
static void janet_free_all_scratch(void) {
|
||||
for (size_t i = 0; i < janet_scratch_len; i++)
|
||||
free(janet_scratch_mem[i]);
|
||||
janet_scratch_len = 0;
|
||||
}
|
||||
|
||||
/* Run garbage collection */
|
||||
void janet_collect(void) {
|
||||
uint32_t i;
|
||||
@@ -352,6 +368,7 @@ void janet_collect(void) {
|
||||
}
|
||||
janet_sweep();
|
||||
janet_vm_next_collection = 0;
|
||||
janet_free_all_scratch();
|
||||
}
|
||||
|
||||
/* Add a root value to the GC. This prevents the GC from removing a value
|
||||
@@ -425,6 +442,8 @@ void janet_clear_memory(void) {
|
||||
current = next;
|
||||
}
|
||||
janet_vm_blocks = NULL;
|
||||
janet_free_all_scratch();
|
||||
free(janet_scratch_mem);
|
||||
}
|
||||
|
||||
/* Primitives for suspending GC. */
|
||||
@@ -434,3 +453,56 @@ int janet_gclock(void) {
|
||||
void janet_gcunlock(int handle) {
|
||||
janet_vm_gc_suspend = handle;
|
||||
}
|
||||
|
||||
/* Scratch memory API */
|
||||
|
||||
void *janet_smalloc(size_t size) {
|
||||
void *mem = malloc(size);
|
||||
if (NULL == mem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
if (janet_scratch_len == janet_scratch_cap) {
|
||||
size_t newcap = 2 * janet_scratch_cap + 2;
|
||||
void **newmem = (void **) realloc(janet_scratch_mem, newcap * sizeof(void *));
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_cap = newcap;
|
||||
janet_scratch_mem = newmem;
|
||||
}
|
||||
janet_scratch_mem[janet_scratch_len++] = mem;
|
||||
return mem;
|
||||
}
|
||||
|
||||
void *janet_srealloc(void *mem, size_t size) {
|
||||
if (NULL == mem) return janet_smalloc(size);
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
void *newmem = realloc(mem, size);
|
||||
if (NULL == newmem) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
janet_scratch_mem[i] = newmem;
|
||||
return newmem;
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_srealloc");
|
||||
}
|
||||
|
||||
void janet_sfree(void *mem) {
|
||||
if (NULL == mem) return;
|
||||
if (janet_scratch_len) {
|
||||
for (size_t i = janet_scratch_len - 1; ; i--) {
|
||||
if (janet_scratch_mem[i] == mem) {
|
||||
janet_scratch_mem[i] = janet_scratch_mem[--janet_scratch_len];
|
||||
free(mem);
|
||||
return;
|
||||
}
|
||||
if (i == 0) break;
|
||||
}
|
||||
}
|
||||
janet_exit("invalid janet_sfree");
|
||||
}
|
||||
|
||||
@@ -83,6 +83,8 @@ static const JanetAbstractType it_u64_type = {
|
||||
|
||||
int64_t janet_unwrap_s64(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if (fabs(dbl) <= MAX_INT_IN_DBL)
|
||||
@@ -110,6 +112,8 @@ int64_t janet_unwrap_s64(Janet x) {
|
||||
|
||||
uint64_t janet_unwrap_u64(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
break;
|
||||
case JANET_NUMBER : {
|
||||
double dbl = janet_unwrap_number(x);
|
||||
if ((dbl >= 0) && (dbl <= MAX_INT_IN_DBL))
|
||||
|
||||
108
src/core/io.c
108
src/core/io.c
@@ -32,6 +32,10 @@
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
#ifndef JANET_WINDOWS
|
||||
#include <sys/wait.h>
|
||||
#endif
|
||||
|
||||
#define IO_WRITE 1
|
||||
#define IO_READ 2
|
||||
#define IO_APPEND 4
|
||||
@@ -160,7 +164,37 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. Return error string if error. */
|
||||
static Janet cfun_io_fdopen(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const int fd = janet_getinteger(argv, 0);
|
||||
const uint8_t *fmode;
|
||||
int flags;
|
||||
if (argc == 2) {
|
||||
fmode = janet_getkeyword(argv, 1);
|
||||
flags = checkflags(fmode);
|
||||
} else {
|
||||
fmode = (const uint8_t *)"r";
|
||||
flags = IO_READ;
|
||||
}
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fdopen _fdopen
|
||||
#endif
|
||||
FILE *f = fdopen(fd, (const char *)fmode);
|
||||
return f ? makef(f, flags) : janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_io_fileno(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
IOFile *iof = janet_getabstract(argv, 0, &cfun_io_filetype);
|
||||
if (iof->flags & IO_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
#define fileno _fileno
|
||||
#endif
|
||||
return janet_wrap_integer(fileno(iof->file));
|
||||
}
|
||||
|
||||
/* Read up to n bytes into buffer. */
|
||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||
janet_panic("file is not readable");
|
||||
@@ -183,6 +217,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
buffer = janet_getbuffer(argv, 2);
|
||||
}
|
||||
int32_t bufstart = buffer->count;
|
||||
if (janet_checktype(argv[1], JANET_KEYWORD)) {
|
||||
const uint8_t *sym = janet_unwrap_keyword(argv[1]);
|
||||
if (!janet_cstrcmp(sym, "all")) {
|
||||
@@ -207,6 +242,8 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
fseek(iof->file, 0, SEEK_SET);
|
||||
read_chunk(iof, buffer, (int32_t) fsize);
|
||||
}
|
||||
/* Never return nil for :all */
|
||||
return janet_wrap_buffer(buffer);
|
||||
} else if (!janet_cstrcmp(sym, "line")) {
|
||||
for (;;) {
|
||||
int x = fgetc(iof->file);
|
||||
@@ -221,6 +258,7 @@ static Janet cfun_io_fread(int32_t argc, Janet *argv) {
|
||||
if (len < 0) janet_panic("expected positive integer");
|
||||
read_chunk(iof, buffer, len);
|
||||
}
|
||||
if (bufstart == buffer->count) return janet_wrap_nil();
|
||||
return janet_wrap_buffer(buffer);
|
||||
}
|
||||
|
||||
@@ -281,13 +319,17 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
||||
if (iof->flags & IO_PIPED) {
|
||||
#ifdef JANET_WINDOWS
|
||||
#define pclose _pclose
|
||||
#define WEXITSTATUS(x) x
|
||||
#endif
|
||||
if (pclose(iof->file)) janet_panic("could not close file");
|
||||
int status = pclose(iof->file);
|
||||
iof->flags |= IO_CLOSED;
|
||||
if (status == -1) janet_panic("could not close file");
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
} else {
|
||||
if (fclose(iof->file)) janet_panic("could not close file");
|
||||
}
|
||||
iof->flags |= IO_CLOSED;
|
||||
return argv[0];
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
/* Seek a file */
|
||||
@@ -333,10 +375,40 @@ static Janet io_file_get(void *p, Janet key) {
|
||||
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods);
|
||||
}
|
||||
|
||||
FILE *janet_dynfile(const char *name, FILE *def) {
|
||||
Janet x = janet_dyn(name);
|
||||
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
if (janet_abstract_type(abstract) != &cfun_io_filetype) return def;
|
||||
IOFile *iofile = abstract;
|
||||
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);
|
||||
}
|
||||
}
|
||||
putc('\n', f);
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
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.")
|
||||
},
|
||||
{
|
||||
"file/open", cfun_io_fopen,
|
||||
JDOC("(file/open path [,mode])\n\n"
|
||||
JDOC("(file/open path &opt mode)\n\n"
|
||||
"Open a file. path is an absolute or relative path, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
@@ -348,6 +420,26 @@ static const JanetReg io_cfuns[] = {
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fdopen", cfun_io_fdopen,
|
||||
JDOC("(file/fdopen fd &opt mode)\n\n"
|
||||
"Create a file from an fd. fd is a platform specific file descriptor, and "
|
||||
"mode is a set of flags indicating the mode to open the file in. "
|
||||
"mode is a keyword where each character represents a flag. If the file "
|
||||
"cannot be opened, returns nil, otherwise returns the new file handle. "
|
||||
"Mode flags:\n\n"
|
||||
"\tr - allow reading from the file\n"
|
||||
"\tw - allow writing to the file\n"
|
||||
"\ta - append to the file\n"
|
||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||
"\t+ - append to the file instead of overwriting it")
|
||||
},
|
||||
{
|
||||
"file/fileno", cfun_io_fileno,
|
||||
JDOC("(file/fileno f)\n\n"
|
||||
"Return the underlying file descriptor for the file as a number."
|
||||
"The meaning of this number is platform specific.")
|
||||
},
|
||||
{
|
||||
"file/close", cfun_io_fclose,
|
||||
JDOC("(file/close f)\n\n"
|
||||
@@ -357,7 +449,7 @@ static const JanetReg io_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"file/read", cfun_io_fread,
|
||||
JDOC("(file/read f what [,buf])\n\n"
|
||||
JDOC("(file/read f what &opt buf)\n\n"
|
||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||
@@ -381,7 +473,7 @@ static const JanetReg io_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"file/seek", cfun_io_fseek,
|
||||
JDOC("(file/seek f [,whence [,n]])\n\n"
|
||||
JDOC("(file/seek f &opt whence n)\n\n"
|
||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||
"\t:cur - jump relative to the current file location\n"
|
||||
"\t:set - jump relative to the beginning of the file\n"
|
||||
@@ -392,7 +484,7 @@ static const JanetReg io_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"file/popen", cfun_io_popen,
|
||||
JDOC("(file/popen path [,mode])\n\n"
|
||||
JDOC("(file/popen path &opt mode)\n\n"
|
||||
"Open a file that is backed by a process. The file must be opened in either "
|
||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||
"process can be read from the file. In :w mode, the stdin of the process "
|
||||
|
||||
@@ -249,6 +249,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
}
|
||||
|
||||
#define JANET_FIBER_FLAG_HASCHILD (1 << 29)
|
||||
#define JANET_FIBER_FLAG_HASENV (1 << 28)
|
||||
#define JANET_STACKFRAME_HASENV (1 << 30)
|
||||
|
||||
/* Marshal a fiber */
|
||||
@@ -256,6 +257,7 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
MARSH_STACKCHECK;
|
||||
int32_t fflags = fiber->flags;
|
||||
if (fiber->child) fflags |= JANET_FIBER_FLAG_HASCHILD;
|
||||
if (fiber->env) fflags |= JANET_FIBER_FLAG_HASENV;
|
||||
if (janet_fiber_status(fiber) == JANET_STATUS_ALIVE)
|
||||
janet_panic("cannot marshal alive fiber");
|
||||
pushint(st, fflags);
|
||||
@@ -282,24 +284,31 @@ static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
|
||||
j = i - JANET_FRAME_SIZE;
|
||||
i = frame->prevframe;
|
||||
}
|
||||
if (fiber->env) {
|
||||
marshal_one(st, janet_wrap_table(fiber->env), flags + 1);
|
||||
}
|
||||
if (fiber->child)
|
||||
marshal_one(st, janet_wrap_fiber(fiber->child), flags + 1);
|
||||
}
|
||||
|
||||
void janet_marshal_size(JanetMarshalContext *ctx, size_t value) {
|
||||
janet_marshal_int64(ctx, (int64_t) value);
|
||||
}
|
||||
|
||||
void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
push64(st, (uint64_t) value);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_marshal_int(JanetMarshalContext *ctx, int32_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushint(st, value);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
pushbyte(st, value);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len) {
|
||||
MarshalState *st = (MarshalState *)(ctx->m_state);
|
||||
@@ -319,11 +328,11 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
||||
void *abstract = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(abstract);
|
||||
if (at->marshal) {
|
||||
MARK_SEEN();
|
||||
JanetMarshalContext context = {st, NULL, flags, NULL};
|
||||
pushbyte(st, LB_ABSTRACT);
|
||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||
push64(st, (uint64_t) janet_abstract_size(abstract));
|
||||
MARK_SEEN();
|
||||
at->marshal(abstract, &context);
|
||||
} else {
|
||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||
@@ -526,7 +535,6 @@ void janet_marshal(
|
||||
st.rreg = rreg;
|
||||
janet_table_init(&st.seen, 0);
|
||||
marshal_one(&st, x, flags);
|
||||
/* Clean up. See comment in janet_unmarshal about autoreleasing memory on panics.*/
|
||||
janet_table_deinit(&st.seen);
|
||||
janet_v_free(st.seen_envs);
|
||||
janet_v_free(st.seen_defs);
|
||||
@@ -534,7 +542,7 @@ void janet_marshal(
|
||||
|
||||
typedef struct {
|
||||
jmp_buf err;
|
||||
JanetArray lookup;
|
||||
Janet *lookup;
|
||||
JanetTable *reg;
|
||||
JanetFuncEnv **lookup_envs;
|
||||
JanetFuncDef **lookup_defs;
|
||||
@@ -837,9 +845,10 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
fiber->maxstack = 0;
|
||||
fiber->data = NULL;
|
||||
fiber->child = NULL;
|
||||
fiber->env = NULL;
|
||||
|
||||
/* Push fiber to seen stack */
|
||||
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
|
||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
||||
|
||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||
int32_t frame = 0;
|
||||
@@ -934,6 +943,15 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
janet_panic("fiber has too many stackframes");
|
||||
}
|
||||
|
||||
/* Check for fiber env */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASENV) {
|
||||
Janet envv;
|
||||
fiber->flags &= ~JANET_FIBER_FLAG_HASENV;
|
||||
data = unmarshal_one(st, data, &envv, flags + 1);
|
||||
janet_asserttype(envv, JANET_TABLE);
|
||||
fiber->env = janet_unwrap_table(envv);
|
||||
}
|
||||
|
||||
/* Check for child fiber */
|
||||
if (fiber->flags & JANET_FIBER_FLAG_HASCHILD) {
|
||||
Janet fiberv;
|
||||
@@ -952,18 +970,22 @@ static const uint8_t *unmarshal_one_fiber(
|
||||
int32_t janet_unmarshal_int(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
return readint(st, &(ctx->data));
|
||||
};
|
||||
}
|
||||
|
||||
size_t janet_unmarshal_size(JanetMarshalContext *ctx) {
|
||||
return (size_t) janet_unmarshal_int64(ctx);
|
||||
}
|
||||
|
||||
int64_t janet_unmarshal_int64(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
return read64(st, &(ctx->data));
|
||||
};
|
||||
}
|
||||
|
||||
uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
MARSH_EOS(st, ctx->data);
|
||||
return *(ctx->data++);
|
||||
};
|
||||
}
|
||||
|
||||
void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len) {
|
||||
UnmarshalState *st = (UnmarshalState *)(ctx->u_state);
|
||||
@@ -986,10 +1008,11 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
||||
if (at == NULL) return NULL;
|
||||
if (at->unmarshal) {
|
||||
void *p = janet_abstract(at, (size_t) read64(st, &data));
|
||||
JanetMarshalContext context = {NULL, st, flags, data};
|
||||
at->unmarshal(p, &context);
|
||||
*out = janet_wrap_abstract(p);
|
||||
return data;
|
||||
JanetMarshalContext context = {NULL, st, flags, data};
|
||||
janet_v_push(st->lookup, *out);
|
||||
at->unmarshal(p, &context);
|
||||
return context.data;
|
||||
}
|
||||
return NULL;
|
||||
}
|
||||
@@ -1048,7 +1071,7 @@ static const uint8_t *unmarshal_one(
|
||||
memcpy(&u.bytes, data + 1, sizeof(double));
|
||||
#endif
|
||||
*out = janet_wrap_number(u.d);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data + 9;
|
||||
}
|
||||
case LB_STRING:
|
||||
@@ -1081,7 +1104,7 @@ static const uint8_t *unmarshal_one(
|
||||
memcpy(buffer->data, data, len);
|
||||
*out = janet_wrap_buffer(buffer);
|
||||
}
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
return data + len;
|
||||
}
|
||||
case LB_FIBER: {
|
||||
@@ -1098,7 +1121,7 @@ static const uint8_t *unmarshal_one(
|
||||
def->environments_length * sizeof(JanetFuncEnv));
|
||||
func->def = def;
|
||||
*out = janet_wrap_function(func);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
||||
}
|
||||
@@ -1123,7 +1146,7 @@ static const uint8_t *unmarshal_one(
|
||||
JanetArray *array = janet_array(len);
|
||||
array->count = len;
|
||||
*out = janet_wrap_array(array);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
data = unmarshal_one(st, data, array->data + i, flags + 1);
|
||||
}
|
||||
@@ -1136,7 +1159,7 @@ static const uint8_t *unmarshal_one(
|
||||
data = unmarshal_one(st, data, tup + i, flags + 1);
|
||||
}
|
||||
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_STRUCT) {
|
||||
/* Struct */
|
||||
JanetKV *struct_ = janet_struct_begin(len);
|
||||
@@ -1147,16 +1170,16 @@ static const uint8_t *unmarshal_one(
|
||||
janet_struct_put(struct_, key, value);
|
||||
}
|
||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
} else if (lead == LB_REFERENCE) {
|
||||
if (len < 0 || len >= st->lookup.count)
|
||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
||||
janet_panicf("invalid reference %d", len);
|
||||
*out = st->lookup.data[len];
|
||||
*out = st->lookup[len];
|
||||
} else {
|
||||
/* Table */
|
||||
JanetTable *t = janet_table(len);
|
||||
*out = janet_wrap_table(t);
|
||||
janet_array_push(&st->lookup, *out);
|
||||
janet_v_push(st->lookup, *out);
|
||||
if (lead == LB_TABLE_PROTO) {
|
||||
Janet proto;
|
||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||
@@ -1193,17 +1216,14 @@ Janet janet_unmarshal(
|
||||
st.end = bytes + len;
|
||||
st.lookup_defs = NULL;
|
||||
st.lookup_envs = NULL;
|
||||
st.lookup = NULL;
|
||||
st.reg = reg;
|
||||
janet_array_init(&st.lookup, 0);
|
||||
Janet out;
|
||||
const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
|
||||
if (next) *next = nextbytes;
|
||||
/* Clean up - this should be auto released on panics, TODO. We should
|
||||
* change the vector implementation to track allocations for auto release, and
|
||||
* make st.lookup auto release as well, or move to heap. */
|
||||
janet_array_deinit(&st.lookup);
|
||||
janet_v_free(st.lookup_defs);
|
||||
janet_v_free(st.lookup_envs);
|
||||
janet_v_free(st.lookup);
|
||||
return out;
|
||||
}
|
||||
|
||||
@@ -1244,7 +1264,7 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
||||
static const JanetReg marsh_cfuns[] = {
|
||||
{
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
@@ -1254,7 +1274,7 @@ static const JanetReg marsh_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"unmarshal", cfun_unmarshal,
|
||||
JDOC("(unmarshal buffer [,lookup])\n\n"
|
||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.")
|
||||
|
||||
336
src/core/os.c
336
src/core/os.c
@@ -41,12 +41,15 @@
|
||||
#include <direct.h>
|
||||
#include <sys/utime.h>
|
||||
#include <io.h>
|
||||
#include <process.h>
|
||||
#else
|
||||
#include <spawn.h>
|
||||
#include <utime.h>
|
||||
#include <unistd.h>
|
||||
#include <dirent.h>
|
||||
#include <sys/types.h>
|
||||
#include <sys/wait.h>
|
||||
extern char **environ;
|
||||
#endif
|
||||
|
||||
/* For macos */
|
||||
@@ -88,7 +91,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
#ifdef JANET_REDUCED_OS
|
||||
/* Provide a dud os/getenv so init.janet works, but nothing else */
|
||||
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
|
||||
|
||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
@@ -99,97 +102,224 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||
#else
|
||||
/* Provide full os functionality */
|
||||
|
||||
/* Get env for os_execute */
|
||||
static char **os_execute_env(int32_t argc, const Janet *argv) {
|
||||
char **envp = NULL;
|
||||
if (argc > 2) {
|
||||
JanetDictView dict = janet_getdictionary(argv, 2);
|
||||
envp = janet_smalloc(sizeof(char *) * (dict.len + 1));
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < dict.cap; i++) {
|
||||
const JanetKV *kv = dict.kvs + i;
|
||||
if (!janet_checktype(kv->key, JANET_STRING)) continue;
|
||||
if (!janet_checktype(kv->value, JANET_STRING)) continue;
|
||||
const uint8_t *keys = janet_unwrap_string(kv->key);
|
||||
const uint8_t *vals = janet_unwrap_string(kv->value);
|
||||
int32_t klen = janet_string_length(keys);
|
||||
int32_t vlen = janet_string_length(vals);
|
||||
/* Check keys has no embedded 0s or =s. */
|
||||
int skip = 0;
|
||||
for (int32_t k = 0; k < klen; k++) {
|
||||
if (keys[k] == '\0' || keys[k] == '=') {
|
||||
skip = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
if (skip) continue;
|
||||
char *envitem = janet_smalloc(klen + vlen + 2);
|
||||
memcpy(envitem, keys, klen);
|
||||
envitem[klen] = '=';
|
||||
memcpy(envitem + klen + 1, vals, vlen);
|
||||
envitem[klen + vlen + 1] = 0;
|
||||
envp[j++] = envitem;
|
||||
}
|
||||
envp[j] = NULL;
|
||||
}
|
||||
return envp;
|
||||
}
|
||||
|
||||
/* Free memory from os_execute */
|
||||
static void os_execute_cleanup(char **envp, const char **child_argv) {
|
||||
#ifdef JANET_WINDOWS
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
JanetBuffer *buffer = janet_buffer(10);
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
const uint8_t *argstring = janet_getstring(argv, i);
|
||||
janet_buffer_push_bytes(buffer, argstring, janet_string_length(argstring));
|
||||
if (i != argc - 1) {
|
||||
janet_buffer_push_u8(buffer, ' ');
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(buffer, 0);
|
||||
|
||||
/* Convert to wide chars */
|
||||
wchar_t *sys_str = malloc(buffer->count * sizeof(wchar_t));
|
||||
if (NULL == sys_str) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
int nwritten = MultiByteToWideChar(
|
||||
CP_UTF8,
|
||||
MB_PRECOMPOSED,
|
||||
buffer->data,
|
||||
buffer->count,
|
||||
sys_str,
|
||||
buffer->count);
|
||||
if (nwritten == 0) {
|
||||
free(sys_str);
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
|
||||
STARTUPINFO si;
|
||||
PROCESS_INFORMATION pi;
|
||||
|
||||
ZeroMemory(&si, sizeof(si));
|
||||
si.cb = sizeof(si);
|
||||
ZeroMemory(&pi, sizeof(pi));
|
||||
|
||||
// Start the child process.
|
||||
if (!CreateProcess(NULL,
|
||||
(LPSTR) sys_str,
|
||||
NULL,
|
||||
NULL,
|
||||
FALSE,
|
||||
0,
|
||||
NULL,
|
||||
NULL,
|
||||
&si,
|
||||
&pi)) {
|
||||
free(sys_str);
|
||||
janet_panic("could not create process");
|
||||
}
|
||||
free(sys_str);
|
||||
|
||||
// Wait until child process exits.
|
||||
WaitForSingleObject(pi.hProcess, INFINITE);
|
||||
|
||||
// Close process and thread handles.
|
||||
WORD status;
|
||||
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
||||
CloseHandle(pi.hProcess);
|
||||
CloseHandle(pi.hThread);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
(void) child_argv;
|
||||
#else
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, -1);
|
||||
const char **child_argv = malloc(sizeof(char *) * (argc + 1));
|
||||
int status = 0;
|
||||
if (NULL == child_argv) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
janet_sfree((void *)child_argv);
|
||||
#endif
|
||||
if (NULL != envp) {
|
||||
char **envitem = envp;
|
||||
while (*envitem != NULL) {
|
||||
janet_sfree(*envitem);
|
||||
envitem++;
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
child_argv[i] = janet_getcstring(argv, i);
|
||||
}
|
||||
child_argv[argc] = NULL;
|
||||
janet_sfree(envp);
|
||||
}
|
||||
|
||||
/* Fork child process */
|
||||
pid_t pid = fork();
|
||||
if (pid < 0) {
|
||||
janet_panic("failed to execute");
|
||||
} else if (pid == 0) {
|
||||
if (-1 == execve(child_argv[0], (char **)child_argv, NULL)) {
|
||||
exit(1);
|
||||
#ifdef JANET_WINDOWS
|
||||
/* Windows processes created via CreateProcess get only one command line argument string, and
|
||||
* must parse this themselves. Each processes is free to do this however they like, but the
|
||||
* standard parsing method is CommandLineToArgvW. We need to properly escape arguments into
|
||||
* a single string of this format. Returns a buffer that can be cast into a c string. */
|
||||
static JanetBuffer *os_exec_escape(JanetView args) {
|
||||
JanetBuffer *b = janet_buffer(0);
|
||||
for (int32_t i = 0; i < args.len; i++) {
|
||||
const char *arg = janet_getcstring(args.items, i);
|
||||
|
||||
/* Push leading space if not first */
|
||||
if (i) janet_buffer_push_u8(b, ' ');
|
||||
|
||||
/* Find first special character */
|
||||
const char *first_spec = arg;
|
||||
while (*first_spec) {
|
||||
switch (*first_spec) {
|
||||
case ' ':
|
||||
case '\t':
|
||||
case '\v':
|
||||
case '\n':
|
||||
case '"':
|
||||
goto found;
|
||||
case '\0':
|
||||
janet_panic("embedded 0 not allowed in command line string");
|
||||
default:
|
||||
first_spec++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
found:
|
||||
|
||||
/* Check if needs escape */
|
||||
if (*first_spec == '\0') {
|
||||
/* No escape needed */
|
||||
janet_buffer_push_cstring(b, arg);
|
||||
} else {
|
||||
/* Escape */
|
||||
janet_buffer_push_u8(b, '"');
|
||||
for (const char *c = arg; ; c++) {
|
||||
unsigned numBackSlashes = 0;
|
||||
while (*c == '\\') {
|
||||
c++;
|
||||
numBackSlashes++;
|
||||
}
|
||||
if (*c == '"') {
|
||||
/* Escape all backslashes and double quote mark */
|
||||
int32_t n = 2 * numBackSlashes + 1;
|
||||
janet_buffer_extra(b, n + 1);
|
||||
memset(b->data + b->count, '\\', n);
|
||||
b->count += n;
|
||||
janet_buffer_push_u8(b, '"');
|
||||
} else if (*c) {
|
||||
/* Don't escape backslashes. */
|
||||
int32_t n = numBackSlashes;
|
||||
janet_buffer_extra(b, n + 1);
|
||||
memset(b->data + b->count, '\\', n);
|
||||
b->count += n;
|
||||
janet_buffer_push_u8(b, *c);
|
||||
} else {
|
||||
/* we finished Escape all backslashes */
|
||||
int32_t n = 2 * numBackSlashes;
|
||||
janet_buffer_extra(b, n + 1);
|
||||
memset(b->data + b->count, '\\', n);
|
||||
b->count += n;
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(b, '"');
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(b, 0);
|
||||
return b;
|
||||
}
|
||||
#endif
|
||||
|
||||
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 3);
|
||||
|
||||
/* Get flags */
|
||||
uint64_t flags = 0;
|
||||
if (argc > 1) {
|
||||
flags = janet_getflags(argv, 1, "ep");
|
||||
}
|
||||
|
||||
/* Get environment */
|
||||
char **envp = os_execute_env(argc, argv);
|
||||
|
||||
/* Get arguments */
|
||||
JanetView exargs = janet_getindexed(argv, 0);
|
||||
if (exargs.len < 1) {
|
||||
janet_panic("expected at least 1 command line argument");
|
||||
}
|
||||
|
||||
/* Result */
|
||||
int status = 0;
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
|
||||
JanetBuffer *buf = os_exec_escape(exargs);
|
||||
if (buf->count > 1025) {
|
||||
janet_panic("command line string too long");
|
||||
}
|
||||
const char *path = (const char *) janet_unwrap_string(exargs.items[0]);
|
||||
char *cargv[2] = {(char *) buf->data, NULL};
|
||||
|
||||
/* Use _spawn family of functions. */
|
||||
/* Windows docs say do this before any spawns. */
|
||||
_flushall();
|
||||
|
||||
/* Use an empty env instead when envp is NULL to be consistent with other implementation. */
|
||||
char *empty_env[1] = {NULL};
|
||||
char **envp1 = (NULL == envp) ? empty_env : envp;
|
||||
|
||||
if (janet_flag_at(flags, 1) && janet_flag_at(flags, 0)) {
|
||||
status = (int) _spawnvpe(_P_WAIT, path, cargv, envp1);
|
||||
} else if (janet_flag_at(flags, 1)) {
|
||||
status = (int) _spawnvp(_P_WAIT, path, cargv);
|
||||
} else if (janet_flag_at(flags, 0)) {
|
||||
status = (int) _spawnve(_P_WAIT, path, cargv, envp1);
|
||||
} else {
|
||||
status = (int) _spawnv(_P_WAIT, path, cargv);
|
||||
}
|
||||
os_execute_cleanup(envp, NULL);
|
||||
|
||||
/* Check error */
|
||||
if (-1 == status) {
|
||||
janet_panic(strerror(errno));
|
||||
}
|
||||
|
||||
return janet_wrap_integer(status);
|
||||
#else
|
||||
|
||||
const char **child_argv = janet_smalloc(sizeof(char *) * (exargs.len + 1));
|
||||
for (int32_t i = 0; i < exargs.len; i++)
|
||||
child_argv[i] = janet_getcstring(exargs.items, i);
|
||||
child_argv[exargs.len] = NULL;
|
||||
/* Coerce to form that works for spawn. I'm fairly confident no implementation
|
||||
* of posix_spawn would modify the argv array passed in. */
|
||||
char *const *cargv = (char *const *)child_argv;
|
||||
|
||||
/* Use posix_spawn to spawn new process */
|
||||
pid_t pid;
|
||||
if (janet_flag_at(flags, 1)) {
|
||||
status = posix_spawnp(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
} else {
|
||||
status = posix_spawn(&pid,
|
||||
child_argv[0], NULL, NULL, cargv,
|
||||
janet_flag_at(flags, 0) ? envp : environ);
|
||||
}
|
||||
|
||||
/* Wait for child */
|
||||
if (status) {
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
janet_panic(strerror(status));
|
||||
} else {
|
||||
waitpid(pid, &status, 0);
|
||||
}
|
||||
free(child_argv);
|
||||
return janet_wrap_integer(status);
|
||||
}
|
||||
|
||||
os_execute_cleanup(envp, child_argv);
|
||||
return janet_wrap_integer(WEXITSTATUS(status));
|
||||
#endif
|
||||
}
|
||||
|
||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 0, 1);
|
||||
@@ -607,12 +737,23 @@ static Janet os_dir(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_array(paths);
|
||||
}
|
||||
|
||||
static Janet os_rename(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
const char *src = janet_getcstring(argv, 0);
|
||||
const char *dest = janet_getcstring(argv, 1);
|
||||
int status = rename(src, dest);
|
||||
if (status) {
|
||||
janet_panic(strerror(errno));
|
||||
}
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
#endif /* JANET_REDUCED_OS */
|
||||
|
||||
static const JanetReg os_cfuns[] = {
|
||||
{
|
||||
"os/exit", os_exit,
|
||||
JDOC("(os/exit x)\n\n"
|
||||
JDOC("(os/exit &opt x)\n\n"
|
||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||
"the exit with status equal the hash of x.")
|
||||
},
|
||||
@@ -632,13 +773,13 @@ static const JanetReg os_cfuns[] = {
|
||||
#ifndef JANET_REDUCED_OS
|
||||
{
|
||||
"os/dir", os_dir,
|
||||
JDOC("(os/stat dir [, array])\n\n"
|
||||
JDOC("(os/dir dir &opt array)\n\n"
|
||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||
"with only the filename or directory name and no prefix.")
|
||||
},
|
||||
{
|
||||
"os/stat", os_stat,
|
||||
JDOC("(os/stat path [, tab|key])\n\n"
|
||||
JDOC("(os/stat path &opt tab|key)\n\n"
|
||||
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
||||
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||
"\t:dev - the device that the file is on\n"
|
||||
@@ -657,7 +798,7 @@ static const JanetReg os_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"os/touch", os_touch,
|
||||
JDOC("(os/touch path [, actime [, modtime]])\n\n"
|
||||
JDOC("(os/touch path &opt actime modtime)\n\n"
|
||||
"Update the access time and modification times for a file. By default, sets "
|
||||
"times to the current time.")
|
||||
},
|
||||
@@ -684,15 +825,21 @@ static const JanetReg os_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"os/link", os_link,
|
||||
JDOC("(os/link oldpath newpath [, symlink])\n\n"
|
||||
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
|
||||
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
||||
"enables a hard link over a soft link. Does not work on Windows.")
|
||||
},
|
||||
{
|
||||
"os/execute", os_execute,
|
||||
JDOC("(os/execute program & args)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Returns "
|
||||
"the exit status of the program.")
|
||||
JDOC("(os/execute args &opts flags env)\n\n"
|
||||
"Execute a program on the system and pass it string arguments. Flags "
|
||||
"is a keyword that modifies how the program will execute.\n\n"
|
||||
"\t:e - enables passing an environment to the program. Without :e, the "
|
||||
"current environment is inherited.\n"
|
||||
"\t:p - allows searching the current PATH for the binary to execute. "
|
||||
"Without this flag, binaries must use absolute paths.\n\n"
|
||||
"env is a table or struct mapping environment variables to values. "
|
||||
"Returns the exit status of the program.")
|
||||
},
|
||||
{
|
||||
"os/shell", os_shell,
|
||||
@@ -729,12 +876,12 @@ static const JanetReg os_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"os/date", os_date,
|
||||
JDOC("(os/date [,time])\n\n"
|
||||
JDOC("(os/date &opt time)\n\n"
|
||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||
"\t:seconds - number of seconds [0-61]\n"
|
||||
"\t:minutes - number of minutes [0-59]\n"
|
||||
"\t:seconds - number of hours [0-23]\n"
|
||||
"\t:hours - number of hours [0-23]\n"
|
||||
"\t:month-day - day of month [0-30]\n"
|
||||
"\t:month - month of year [0, 11]\n"
|
||||
"\t:year - years since year 0 (e.g. 2019)\n"
|
||||
@@ -742,6 +889,11 @@ static const JanetReg os_cfuns[] = {
|
||||
"\t:year-day - day of the year [0-365]\n"
|
||||
"\t:dst - If Day Light Savings is in effect")
|
||||
},
|
||||
{
|
||||
"os/rename", os_rename,
|
||||
JDOC("(os/rename oldname newname)\n\n"
|
||||
"Rename a file on disk to a new path. Returns nil.")
|
||||
},
|
||||
#endif
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
282
src/core/parse.c
282
src/core/parse.c
@@ -144,6 +144,8 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
||||
#define PFLAG_LONGSTRING 0x4000
|
||||
#define PFLAG_READERMAC 0x8000
|
||||
#define PFLAG_ATSYM 0x10000
|
||||
#define PFLAG_COMMENT 0x20000
|
||||
#define PFLAG_TOKEN 0x40000
|
||||
|
||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||
JanetParseState s;
|
||||
@@ -257,12 +259,24 @@ static int escape1(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
static int stringend(JanetParser *p, JanetParseState *state) {
|
||||
Janet ret;
|
||||
uint8_t *bufstart = p->buf;
|
||||
int32_t buflen = (int32_t) p->bufcount;
|
||||
if (state->flags & PFLAG_LONGSTRING) {
|
||||
/* Check for leading newline character so we can remove it */
|
||||
if (bufstart[0] == '\n') {
|
||||
bufstart++;
|
||||
buflen--;
|
||||
}
|
||||
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
|
||||
buflen--;
|
||||
}
|
||||
}
|
||||
if (state->flags & PFLAG_BUFFER) {
|
||||
JanetBuffer *b = janet_buffer((int32_t)p->bufcount);
|
||||
janet_buffer_push_bytes(b, p->buf, (int32_t)p->bufcount);
|
||||
JanetBuffer *b = janet_buffer(buflen);
|
||||
janet_buffer_push_bytes(b, bufstart, buflen);
|
||||
ret = janet_wrap_buffer(b);
|
||||
} else {
|
||||
ret = janet_wrap_string(janet_string(p->buf, (int32_t)p->bufcount));
|
||||
ret = janet_wrap_string(janet_string(bufstart, buflen));
|
||||
}
|
||||
p->bufcount = 0;
|
||||
popstate(p, ret);
|
||||
@@ -345,7 +359,12 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
if (c == '\n') p->statecount--;
|
||||
if (c == '\n') {
|
||||
p->statecount--;
|
||||
p->bufcount = 0;
|
||||
} else {
|
||||
push_buf(p, c);
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
@@ -431,7 +450,7 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
|
||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||
|
||||
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
(void) state;
|
||||
p->statecount--;
|
||||
switch (c) {
|
||||
@@ -453,8 +472,8 @@ static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
default:
|
||||
break;
|
||||
}
|
||||
pushstate(p, tokenchar, 0);
|
||||
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
|
||||
pushstate(p, tokenchar, PFLAG_TOKEN);
|
||||
push_buf(p, '@'); /* Push the leading at-sign that was dropped */
|
||||
return 0;
|
||||
}
|
||||
|
||||
@@ -467,7 +486,7 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
p->error = "unexpected character";
|
||||
return 1;
|
||||
}
|
||||
pushstate(p, tokenchar, 0);
|
||||
pushstate(p, tokenchar, PFLAG_TOKEN);
|
||||
return 0;
|
||||
case '\'':
|
||||
case ',':
|
||||
@@ -479,10 +498,10 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||
pushstate(p, stringchar, PFLAG_STRING);
|
||||
return 1;
|
||||
case '#':
|
||||
pushstate(p, comment, 0);
|
||||
pushstate(p, comment, PFLAG_COMMENT);
|
||||
return 1;
|
||||
case '@':
|
||||
pushstate(p, ampersand, 0);
|
||||
pushstate(p, atsign, PFLAG_ATSYM);
|
||||
return 1;
|
||||
case '`':
|
||||
pushstate(p, longstring, PFLAG_LONGSTRING);
|
||||
@@ -622,6 +641,55 @@ void janet_parser_deinit(JanetParser *parser) {
|
||||
free(parser->states);
|
||||
}
|
||||
|
||||
void janet_parser_clone(const JanetParser *src, JanetParser *dest) {
|
||||
/* Misc fields */
|
||||
dest->flag = src->flag;
|
||||
dest->pending = src->pending;
|
||||
dest->lookback = src->lookback;
|
||||
dest->offset = src->offset;
|
||||
dest->error = src->error;
|
||||
|
||||
/* Keep counts */
|
||||
dest->argcount = src->argcount;
|
||||
dest->bufcount = src->bufcount;
|
||||
dest->statecount = src->statecount;
|
||||
|
||||
/* Capacities are equal to counts */
|
||||
dest->bufcap = dest->bufcount;
|
||||
dest->statecap = dest->statecount;
|
||||
dest->argcap = dest->argcount;
|
||||
|
||||
/* Deep cloned fields */
|
||||
dest->args = NULL;
|
||||
dest->states = NULL;
|
||||
dest->buf = NULL;
|
||||
if (dest->bufcap) {
|
||||
dest->buf = malloc(dest->bufcap);
|
||||
if (!dest->buf) goto nomem;
|
||||
}
|
||||
if (dest->argcap) {
|
||||
dest->args = malloc(sizeof(Janet) * dest->argcap);
|
||||
if (!dest->args) goto nomem;
|
||||
}
|
||||
if (dest->statecap) {
|
||||
dest->states = malloc(sizeof(JanetParseState) * dest->statecap);
|
||||
if (!dest->states) goto nomem;
|
||||
}
|
||||
|
||||
memcpy(dest->buf, src->buf, dest->bufcap);
|
||||
memcpy(dest->args, src->args, dest->argcap * sizeof(Janet));
|
||||
memcpy(dest->states, src->states, dest->statecap * sizeof(JanetParseState));
|
||||
|
||||
return;
|
||||
|
||||
nomem:
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
int janet_parser_has_more(JanetParser *parser) {
|
||||
return !!parser->pending;
|
||||
}
|
||||
|
||||
/* C functions */
|
||||
|
||||
static int parsermark(void *p, size_t size) {
|
||||
@@ -785,43 +853,179 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
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);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
||||
uint8_t *buff, uint32_t bufcount) {
|
||||
JanetTable *state = janet_table(0);
|
||||
const uint8_t *buffer;
|
||||
int add_buffer = 0;
|
||||
const char *type = NULL;
|
||||
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
JanetArray *container_args = janet_array(s->argn);
|
||||
container_args->count = s->argn;
|
||||
memcpy(container_args->data, args, sizeof(args[0])*s->argn);
|
||||
janet_table_put(state, janet_ckeywordv("args"),
|
||||
janet_wrap_array(container_args));
|
||||
}
|
||||
|
||||
if (s->flags & PFLAG_PARENS || s->flags & PFLAG_SQRBRACKETS) {
|
||||
if (s->flags & PFLAG_ATSYM) {
|
||||
type = "array";
|
||||
} else {
|
||||
type = "tuple";
|
||||
}
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
if (s->flags & PFLAG_ATSYM) {
|
||||
type = "table";
|
||||
} else {
|
||||
type = "struct";
|
||||
}
|
||||
} else if (s->flags & PFLAG_STRING || s->flags & PFLAG_LONGSTRING) {
|
||||
if (s->flags & PFLAG_BUFFER) {
|
||||
type = "buffer";
|
||||
} else {
|
||||
type = "string";
|
||||
}
|
||||
add_buffer = 1;
|
||||
} else if (s->flags & PFLAG_COMMENT) {
|
||||
type = "comment";
|
||||
add_buffer = 1;
|
||||
} else if (s->flags & PFLAG_TOKEN) {
|
||||
type = "token";
|
||||
add_buffer = 1;
|
||||
} else if (s->flags & PFLAG_ATSYM) {
|
||||
type = "at";
|
||||
} else if (s->flags & PFLAG_READERMAC) {
|
||||
int c = s->flags & 0xFF;
|
||||
type = (c == '\'') ? "quote" :
|
||||
(c == ',') ? "unquote" :
|
||||
(c == ';') ? "splice" :
|
||||
(c == '~') ? "quasiquote" : "<reader>";
|
||||
} else {
|
||||
type = "root";
|
||||
}
|
||||
|
||||
if (type) {
|
||||
janet_table_put(state, janet_ckeywordv("type"),
|
||||
janet_ckeywordv(type));
|
||||
}
|
||||
|
||||
if (add_buffer) {
|
||||
buffer = janet_string(buff, bufcount);
|
||||
janet_table_put(state, janet_ckeywordv("buffer"), janet_wrap_string(buffer));
|
||||
}
|
||||
|
||||
janet_table_put(state, janet_ckeywordv("start"),
|
||||
janet_wrap_integer(s->start));
|
||||
return janet_wrap_table(state);
|
||||
}
|
||||
|
||||
struct ParserStateGetter {
|
||||
const char *name;
|
||||
Janet(*fn)(const JanetParser *p);
|
||||
};
|
||||
|
||||
static Janet parser_state_delimiters(const JanetParser *_p) {
|
||||
JanetParser *clone = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_clone(_p, clone);
|
||||
size_t i;
|
||||
const uint8_t *str;
|
||||
size_t oldcount;
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
oldcount = p->bufcount;
|
||||
for (i = 0; i < p->statecount; i++) {
|
||||
JanetParseState *s = p->states + i;
|
||||
oldcount = clone->bufcount;
|
||||
for (i = 0; i < clone->statecount; i++) {
|
||||
JanetParseState *s = clone->states + i;
|
||||
if (s->flags & PFLAG_PARENS) {
|
||||
push_buf(p, '(');
|
||||
push_buf(clone, '(');
|
||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||
push_buf(p, '[');
|
||||
push_buf(clone, '[');
|
||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||
push_buf(p, '{');
|
||||
push_buf(clone, '{');
|
||||
} else if (s->flags & PFLAG_STRING) {
|
||||
push_buf(p, '"');
|
||||
push_buf(clone, '"');
|
||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||
int32_t i;
|
||||
for (i = 0; i < s->argn; i++) {
|
||||
push_buf(p, '`');
|
||||
push_buf(clone, '`');
|
||||
}
|
||||
}
|
||||
}
|
||||
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||
p->bufcount = oldcount;
|
||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
||||
clone->bufcount = oldcount;
|
||||
return janet_wrap_string(str);
|
||||
}
|
||||
|
||||
static Janet parser_state_frames(const JanetParser *p) {
|
||||
int32_t count = (int32_t) p->statecount;
|
||||
JanetArray *states = janet_array(count);
|
||||
states->count = count;
|
||||
uint8_t *buf = p->buf;
|
||||
Janet *args = p->args;
|
||||
for (int32_t i = count - 1; i >= 0; --i) {
|
||||
JanetParseState *s = p->states + i;
|
||||
states->data[i] = janet_wrap_parse_state(s, args, buf, (uint32_t) p->bufcount);
|
||||
args -= s->argn;
|
||||
}
|
||||
return janet_wrap_array(states);
|
||||
}
|
||||
|
||||
static const struct ParserStateGetter parser_state_getters[] = {
|
||||
{"frames", parser_state_frames},
|
||||
{"delimiters", parser_state_delimiters},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
const uint8_t *key = NULL;
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
if (argc == 2) {
|
||||
key = janet_getkeyword(argv, 1);
|
||||
}
|
||||
|
||||
if (key) {
|
||||
/* Get one result */
|
||||
for (const struct ParserStateGetter *sg = parser_state_getters;
|
||||
sg->name != NULL; sg++) {
|
||||
if (janet_cstrcmp(key, sg->name)) continue;
|
||||
return sg->fn(p);
|
||||
}
|
||||
janet_panicf("unexpected keyword %v", janet_wrap_keyword(key));
|
||||
return janet_wrap_nil();
|
||||
} else {
|
||||
/* Put results in table */
|
||||
JanetTable *tab = janet_table(0);
|
||||
for (const struct ParserStateGetter *sg = parser_state_getters;
|
||||
sg->name != NULL; sg++) {
|
||||
janet_table_put(tab, janet_ckeywordv(sg->name), sg->fn(p));
|
||||
}
|
||||
return janet_wrap_table(tab);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_clone(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetParser *src = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||
JanetParser *dest = janet_abstract(&janet_parse_parsertype, sizeof(JanetParser));
|
||||
janet_parser_clone(src, dest);
|
||||
return janet_wrap_abstract(dest);
|
||||
}
|
||||
|
||||
static const JanetMethod parser_methods[] = {
|
||||
{"byte", cfun_parse_byte},
|
||||
{"clone", cfun_parse_clone},
|
||||
{"consume", cfun_parse_consume},
|
||||
{"eof", cfun_parse_eof},
|
||||
{"error", cfun_parse_error},
|
||||
{"flush", cfun_parse_flush},
|
||||
{"has-more", cfun_parse_has_more},
|
||||
@@ -830,7 +1034,6 @@ static const JanetMethod parser_methods[] = {
|
||||
{"state", cfun_parse_state},
|
||||
{"status", cfun_parse_status},
|
||||
{"where", cfun_parse_where},
|
||||
{"eof", cfun_parse_eof},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -847,6 +1050,13 @@ static const JanetReg parse_cfuns[] = {
|
||||
"Creates and returns a new parser object. Parsers are state machines "
|
||||
"that can receive bytes, and generate a stream of janet values.")
|
||||
},
|
||||
{
|
||||
"parser/clone", cfun_parse_clone,
|
||||
JDOC("(parser/clone p)\n\n"
|
||||
"Creates a deep clone of a parser that is identical to the input parser. "
|
||||
"This cloned parser can be used to continue parsing from a good checkpoint "
|
||||
"if parsing later fails. Returns a new parser.")
|
||||
},
|
||||
{
|
||||
"parser/has-more", cfun_parse_has_more,
|
||||
JDOC("(parser/has-more parser)\n\n"
|
||||
@@ -861,7 +1071,7 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/consume", cfun_parse_consume,
|
||||
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||
JDOC("(parser/consume parser bytes &opt index)\n\n"
|
||||
"Input bytes into the parser and parse them. Will not throw errors "
|
||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||
"the number of bytes read.")
|
||||
@@ -897,22 +1107,26 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/state", cfun_parse_state,
|
||||
JDOC("(parser/state parser)\n\n"
|
||||
"Returns a string representation of the internal state of the parser. "
|
||||
"Each byte in the string represents a nested data structure. For example, "
|
||||
JDOC("(parser/state parser &opt key)\n\n"
|
||||
"Returns a representation of the internal state of the parser. If a key is passed, "
|
||||
"only that information about the state is returned. Allowed keys are:\n\n"
|
||||
"\t:delimiters - Each byte in the string represents a nested data structure. For example, "
|
||||
"if the parser state is '([\"', then the parser is in the middle of parsing a "
|
||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt.")
|
||||
"string inside of square brackets inside parentheses. Can be used to augment a REPL prompt."
|
||||
"\t:frames - Each table in the array represents a 'frame' in the parser state. Frames "
|
||||
"contain information about the start of the expression being parsed as well as the "
|
||||
"type of that expression and some type-specific information.")
|
||||
},
|
||||
{
|
||||
"parser/where", cfun_parse_where,
|
||||
JDOC("(parser/where parser)\n\n"
|
||||
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 a tuple (line, column). Lines and columns are counted from "
|
||||
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||
"in the byte stream as an index, counted from 0. "
|
||||
"If offset is supplied, then the byte offset is updated to that new value.")
|
||||
},
|
||||
{
|
||||
"parser/eof", cfun_parse_eof,
|
||||
JDOC("(parser/insert parser)\n\n"
|
||||
JDOC("(parser/eof parser)\n\n"
|
||||
"Indicate that the end of file was reached to the parser. This puts the parser in the :dead state.")
|
||||
},
|
||||
{
|
||||
|
||||
190
src/core/peg.c
190
src/core/peg.c
@@ -447,7 +447,7 @@ static void builder_cleanup(Builder *b) {
|
||||
janet_v_free(b->bytecode);
|
||||
}
|
||||
|
||||
static void peg_panic(Builder *b, const char *msg) {
|
||||
JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
|
||||
builder_cleanup(b);
|
||||
janet_panicf("grammar error in %p, %s", b->form, msg);
|
||||
}
|
||||
@@ -945,27 +945,28 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||
typedef struct {
|
||||
uint32_t *bytecode;
|
||||
Janet *constants;
|
||||
size_t bytecode_len;
|
||||
uint32_t num_constants;
|
||||
} Peg;
|
||||
|
||||
static int peg_mark(void *p, size_t size) {
|
||||
(void) size;
|
||||
Peg *peg = (Peg *)p;
|
||||
if (NULL != peg->constants)
|
||||
for (uint32_t i = 0; i < peg->num_constants; i++)
|
||||
janet_mark(peg->constants[i]);
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetAbstractType peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
};
|
||||
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
Peg *peg = (Peg *)p;
|
||||
janet_marshal_size(ctx, peg->bytecode_len);
|
||||
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
||||
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||
janet_marshal_int(ctx, (int32_t) peg->bytecode[i]);
|
||||
for (uint32_t j = 0; j < peg->num_constants; j++)
|
||||
janet_marshal_janet(ctx, peg->constants[j]);
|
||||
}
|
||||
|
||||
/* Used to ensure that if we place several arrays in one memory chunk, each
|
||||
* array will be correctly aligned */
|
||||
@@ -974,6 +975,169 @@ static size_t size_padded(size_t offset, size_t size) {
|
||||
return x - (x % size);
|
||||
}
|
||||
|
||||
static void peg_unmarshal(void *p, JanetMarshalContext *ctx) {
|
||||
char *mem = p;
|
||||
Peg *peg = (Peg *)p;
|
||||
peg->bytecode_len = janet_unmarshal_size(ctx);
|
||||
peg->num_constants = (uint32_t) janet_unmarshal_int(ctx);
|
||||
|
||||
/* Calculate offsets. Should match those in make_peg */
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
size_t bytecode_size = peg->bytecode_len * sizeof(uint32_t);
|
||||
size_t constants_start = size_padded(bytecode_start + bytecode_size, sizeof(Janet));
|
||||
uint32_t *bytecode = (uint32_t *)(mem + bytecode_start);
|
||||
Janet *constants = (Janet *)(mem + constants_start);
|
||||
peg->bytecode = NULL;
|
||||
peg->constants = NULL;
|
||||
|
||||
/* Ensure not too large */
|
||||
if (constants_start + sizeof(Janet) * peg->num_constants > janet_abstract_size(p)) {
|
||||
janet_panic("size mismatch");
|
||||
}
|
||||
|
||||
for (size_t i = 0; i < peg->bytecode_len; i++)
|
||||
bytecode[i] = (uint32_t) janet_unmarshal_int(ctx);
|
||||
for (uint32_t j = 0; j < peg->num_constants; j++)
|
||||
constants[j] = janet_unmarshal_janet(ctx);
|
||||
|
||||
/* After here, no panics except for the bad: label. */
|
||||
|
||||
/* Keep track at each index if an instruction was
|
||||
* reference (0x01) or is in a main bytecode position
|
||||
* (0x02). This lets us do a linear scan and not
|
||||
* need to a depth first traversal. It is stricter
|
||||
* than a dfs by not allowing certain kinds of unused
|
||||
* bytecode. */
|
||||
uint32_t blen = (int32_t) peg->bytecode_len;
|
||||
uint32_t clen = peg->num_constants;
|
||||
uint8_t *op_flags = calloc(1, blen);
|
||||
if (NULL == op_flags) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
|
||||
/* verify peg bytecode */
|
||||
uint32_t i = 0;
|
||||
while (i < blen) {
|
||||
uint32_t instr = bytecode[i];
|
||||
uint32_t *rule = bytecode + i;
|
||||
op_flags[i] |= 0x02;
|
||||
switch (instr & 0x1F) {
|
||||
case RULE_LITERAL:
|
||||
i += 2 + ((rule[1] + 3) >> 2);
|
||||
break;
|
||||
case RULE_NCHAR:
|
||||
case RULE_NOTNCHAR:
|
||||
case RULE_RANGE:
|
||||
case RULE_POSITION:
|
||||
/* [1 word] */
|
||||
i += 2;
|
||||
break;
|
||||
case RULE_SET:
|
||||
/* [8 words] */
|
||||
i += 9;
|
||||
break;
|
||||
case RULE_LOOK:
|
||||
/* [offset, rule] */
|
||||
if (rule[2] >= blen) goto bad;
|
||||
op_flags[rule[2]] |= 0x1;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_CHOICE:
|
||||
case RULE_SEQUENCE:
|
||||
/* [len, rules...] */
|
||||
{
|
||||
uint32_t len = rule[1];
|
||||
for (uint32_t j = 0; j < len; j++) {
|
||||
if (rule[2 + j] >= blen) goto bad;
|
||||
op_flags[rule[2 + j]] |= 0x1;
|
||||
}
|
||||
i += 2 + len;
|
||||
}
|
||||
break;
|
||||
case RULE_IF:
|
||||
case RULE_IFNOT:
|
||||
/* [rule_a, rule_b (b if not a)] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
op_flags[rule[2]] |= 0x01;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_BETWEEN:
|
||||
/* [lo, hi, rule] */
|
||||
if (rule[3] >= blen) goto bad;
|
||||
op_flags[rule[3]] |= 0x01;
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_ARGUMENT:
|
||||
case RULE_GETTAG:
|
||||
/* [searchtag, tag] */
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_CONSTANT:
|
||||
/* [constant, tag] */
|
||||
if (rule[1] >= clen) goto bad;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_ACCUMULATE:
|
||||
case RULE_GROUP:
|
||||
case RULE_CAPTURE:
|
||||
/* [rule, tag] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 3;
|
||||
break;
|
||||
case RULE_REPLACE:
|
||||
case RULE_MATCHTIME:
|
||||
/* [rule, constant, tag] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
if (rule[2] >= clen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 4;
|
||||
break;
|
||||
case RULE_ERROR:
|
||||
case RULE_DROP:
|
||||
case RULE_NOT:
|
||||
/* [rule] */
|
||||
if (rule[1] >= blen) goto bad;
|
||||
op_flags[rule[1]] |= 0x01;
|
||||
i += 2;
|
||||
break;
|
||||
default:
|
||||
goto bad;
|
||||
}
|
||||
}
|
||||
|
||||
/* last instruction cannot overflow */
|
||||
if (i != blen) goto bad;
|
||||
|
||||
/* Make sure all referenced instructions are actually
|
||||
* in instruction positions. */
|
||||
for (i = 0; i < blen; i++)
|
||||
if (op_flags[i] == 0x01) goto bad;
|
||||
|
||||
/* Good return */
|
||||
peg->bytecode = bytecode;
|
||||
peg->constants = constants;
|
||||
free(op_flags);
|
||||
return;
|
||||
|
||||
bad:
|
||||
free(op_flags);
|
||||
janet_panic("invalid peg bytecode");
|
||||
}
|
||||
|
||||
static const JanetAbstractType peg_type = {
|
||||
"core/peg",
|
||||
NULL,
|
||||
peg_mark,
|
||||
NULL,
|
||||
NULL,
|
||||
peg_marshal,
|
||||
peg_unmarshal,
|
||||
NULL
|
||||
};
|
||||
|
||||
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||
static Peg *make_peg(Builder *b) {
|
||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||
@@ -988,6 +1152,7 @@ static Peg *make_peg(Builder *b) {
|
||||
peg->num_constants = janet_v_count(b->constants);
|
||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||
memcpy(peg->constants, b->constants, constants_size);
|
||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
||||
return peg;
|
||||
}
|
||||
|
||||
@@ -1061,7 +1226,7 @@ static const JanetReg peg_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"peg/match", cfun_peg_match,
|
||||
JDOC("(peg/match peg text [,start=0])\n\n"
|
||||
JDOC("(peg/match peg text &opt start & args)\n\n"
|
||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
||||
"Returns nil if text does not match the language defined by peg. The syntax of PEGs are very "
|
||||
"similar to those defined by LPeg, and have similar capabilities.")
|
||||
@@ -1072,6 +1237,7 @@ static const JanetReg peg_cfuns[] = {
|
||||
/* Load the peg module */
|
||||
void janet_lib_peg(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||
janet_register_abstract_type(&peg_type);
|
||||
}
|
||||
|
||||
#endif /* ifdef JANET_PEG */
|
||||
|
||||
@@ -197,9 +197,15 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
|
||||
case JANET_STRING:
|
||||
janet_escape_string_b(buffer, janet_unwrap_string(x));
|
||||
return;
|
||||
case JANET_BUFFER:
|
||||
janet_escape_buffer_b(buffer, janet_unwrap_buffer(x));
|
||||
case JANET_BUFFER: {
|
||||
JanetBuffer *b = janet_unwrap_buffer(x);
|
||||
if (b == buffer) {
|
||||
/* Ensures buffer won't resize while escaping */
|
||||
janet_buffer_ensure(b, 5 * b->count + 3, 1);
|
||||
}
|
||||
janet_escape_buffer_b(buffer, b);
|
||||
return;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
void *p = janet_unwrap_abstract(x);
|
||||
const JanetAbstractType *at = janet_abstract_type(p);
|
||||
@@ -298,6 +304,7 @@ struct pretty {
|
||||
int depth;
|
||||
int indent;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
JanetTable seen;
|
||||
};
|
||||
|
||||
@@ -314,23 +321,24 @@ static void print_newline(struct pretty *S, int just_a_space) {
|
||||
}
|
||||
|
||||
/* Color coding for types */
|
||||
static const char janet_cycle_color[] = "\x1B[36m";
|
||||
static const char *janet_pretty_colors[] = {
|
||||
"\x1B[32m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
NULL,
|
||||
"\x1B[36m",
|
||||
"\x1B[35m",
|
||||
"\x1B[34m",
|
||||
"\x1B[33m",
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
"\x1B[35m",
|
||||
NULL,
|
||||
NULL,
|
||||
NULL,
|
||||
NULL
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m",
|
||||
"\x1B[36m"
|
||||
};
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
@@ -348,9 +356,15 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
default: {
|
||||
Janet seenid = janet_table_get(&S->seen, x);
|
||||
if (janet_checktype(seenid, JANET_NUMBER)) {
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||
janet_buffer_push_u8(S->buffer, '>');
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
return;
|
||||
} else {
|
||||
janet_table_put(&S->seen, x, janet_wrap_integer(S->seen.count));
|
||||
@@ -365,7 +379,13 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||
janet_buffer_push_cstring(S->buffer, color);
|
||||
}
|
||||
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
|
||||
janet_buffer_push_u8(S->buffer, '@');
|
||||
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||
} else {
|
||||
janet_description_b(S->buffer, x);
|
||||
}
|
||||
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
@@ -454,9 +474,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
return;
|
||||
}
|
||||
|
||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||
* for serialization or anything like that. */
|
||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
@@ -465,12 +483,19 @@ JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.flags = flags;
|
||||
S.bufstartlen = startlen;
|
||||
janet_table_init(&S.seen, 10);
|
||||
janet_pretty_one(&S, x, 0);
|
||||
janet_table_deinit(&S.seen);
|
||||
return S.buffer;
|
||||
}
|
||||
|
||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||
* for serialization or anything like that. */
|
||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static const char *typestr(Janet x) {
|
||||
JanetType t = janet_type(x);
|
||||
return (t == JANET_ABSTRACT)
|
||||
@@ -636,6 +661,7 @@ void janet_buffer_format(
|
||||
size_t sfl = strlen(strfrmt);
|
||||
const char *strfrmt_end = strfrmt + sfl;
|
||||
int32_t arg = argstart;
|
||||
int32_t startlen = b->count;
|
||||
while (strfrmt < strfrmt_end) {
|
||||
if (*strfrmt != '%')
|
||||
janet_buffer_push_u8(b, (uint8_t) * strfrmt++);
|
||||
@@ -704,7 +730,7 @@ void janet_buffer_format(
|
||||
int depth = atoi(precision);
|
||||
if (depth < 1)
|
||||
depth = 4;
|
||||
janet_pretty(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg]);
|
||||
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
default: {
|
||||
|
||||
@@ -23,6 +23,7 @@
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "regalloc.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
void janetc_regalloc_init(JanetcRegisterAllocator *ra) {
|
||||
|
||||
@@ -28,6 +28,7 @@
|
||||
/* 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();
|
||||
@@ -47,6 +48,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
if (cres.status == JANET_COMPILE_OK) {
|
||||
JanetFunction *f = janet_thunk(cres.funcdef);
|
||||
JanetFiber *fiber = janet_fiber(f, 64, 0, NULL);
|
||||
fiber->env = env;
|
||||
JanetSignal status = janet_continue(fiber, janet_wrap_nil(), &ret);
|
||||
if (status != JANET_SIGNAL_OK) {
|
||||
janet_stacktrace(fiber, ret);
|
||||
@@ -54,7 +56,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
done = 1;
|
||||
}
|
||||
} else {
|
||||
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
||||
fprintf(errf, "compile error in %s: %s\n", sourcePath,
|
||||
(const char *)cres.error);
|
||||
errflags |= 0x02;
|
||||
done = 1;
|
||||
@@ -68,7 +70,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
||||
break;
|
||||
case JANET_PARSE_ERROR:
|
||||
errflags |= 0x04;
|
||||
fprintf(stderr, "parse error in %s: %s\n",
|
||||
fprintf(errf, "parse error in %s: %s\n",
|
||||
sourcePath, janet_parser_error(&parser));
|
||||
done = 1;
|
||||
break;
|
||||
|
||||
@@ -174,7 +174,7 @@ static int destructure(JanetCompiler *c,
|
||||
/* Create a source map for definitions. */
|
||||
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||
Janet *tup = janet_tuple_begin(3);
|
||||
tup[0] = janet_wrap_string(c->source);
|
||||
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);
|
||||
return janet_tuple_end(tup);
|
||||
@@ -278,12 +278,10 @@ static int varleaf(
|
||||
JanetCompiler *c,
|
||||
const uint8_t *sym,
|
||||
JanetSlot s,
|
||||
JanetTable *attr) {
|
||||
JanetTable *reftab) {
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
/* Global var, generate var */
|
||||
JanetSlot refslot;
|
||||
JanetTable *reftab = janet_table(1);
|
||||
reftab->proto = attr;
|
||||
JanetArray *ref = janet_array(1);
|
||||
janet_array_push(ref, janet_wrap_nil());
|
||||
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||
@@ -312,12 +310,10 @@ static int defleaf(
|
||||
JanetCompiler *c,
|
||||
const uint8_t *sym,
|
||||
JanetSlot s,
|
||||
JanetTable *attr) {
|
||||
JanetTable *tab) {
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
JanetTable *tab = janet_table(2);
|
||||
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
tab->proto = attr;
|
||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||
|
||||
@@ -652,6 +648,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Function flags */
|
||||
int vararg = 0;
|
||||
int structarg = 0;
|
||||
int allow_extra = 0;
|
||||
int selfref = 0;
|
||||
int seenamp = 0;
|
||||
@@ -712,6 +709,19 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
min_arity = i;
|
||||
arity--;
|
||||
seenopt = 1;
|
||||
} else if (!janet_cstrcmp(janet_unwrap_symbol(param), "&keys")) {
|
||||
if (seenamp) {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
} else if (i == paramcount - 2) {
|
||||
vararg = 1;
|
||||
structarg = 1;
|
||||
arity -= 2;
|
||||
} else {
|
||||
errmsg = "&keys in unexpected location";
|
||||
goto error;
|
||||
}
|
||||
seenamp = 1;
|
||||
} else {
|
||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||
}
|
||||
@@ -749,6 +759,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
def->min_arity = min_arity;
|
||||
def->max_arity = max_arity;
|
||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
@@ -65,4 +65,9 @@ extern JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
||||
|
||||
/* Scratch memory */
|
||||
extern JANET_THREAD_LOCAL void **janet_scratch_mem;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_cap;
|
||||
extern JANET_THREAD_LOCAL size_t janet_scratch_len;
|
||||
|
||||
#endif /* JANET_STATE_H_defined */
|
||||
|
||||
@@ -274,6 +274,26 @@ static Janet cfun_string_find(int32_t argc, Janet *argv) {
|
||||
: janet_wrap_integer(result);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hasprefix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView prefix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
return str.len < prefix.len
|
||||
? janet_wrap_false()
|
||||
: janet_wrap_boolean(memcmp(prefix.bytes, str.bytes, prefix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_hassuffix(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView suffix = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
return str.len < suffix.len
|
||||
? janet_wrap_false()
|
||||
: janet_wrap_boolean(memcmp(suffix.bytes,
|
||||
str.bytes + str.len - suffix.len,
|
||||
suffix.len) == 0);
|
||||
}
|
||||
|
||||
static Janet cfun_string_findall(int32_t argc, Janet *argv) {
|
||||
int32_t result;
|
||||
struct kmp_state state;
|
||||
@@ -373,25 +393,20 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
||||
|
||||
static Janet cfun_string_checkset(int32_t argc, Janet *argv) {
|
||||
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||
janet_arity(argc, 2, 3);
|
||||
janet_fixarity(argc, 2);
|
||||
JanetByteView set = janet_getbytes(argv, 0);
|
||||
JanetByteView str = janet_getbytes(argv, 1);
|
||||
/* Populate set */
|
||||
for (int32_t i = 0; i < set.len; i++) {
|
||||
int index = set.bytes[i] >> 5;
|
||||
uint32_t mask = 1 << (set.bytes[i] & 7);
|
||||
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
|
||||
bitset[index] |= mask;
|
||||
}
|
||||
if (argc == 3) {
|
||||
if (janet_getboolean(argv, 2)) {
|
||||
for (int i = 0; i < 8; i++)
|
||||
bitset[i] = ~bitset[i];
|
||||
}
|
||||
}
|
||||
/* Check set */
|
||||
if (str.len == 0) return janet_wrap_false();
|
||||
for (int32_t i = 0; i < str.len; i++) {
|
||||
int index = str.bytes[i] >> 5;
|
||||
uint32_t mask = 1 << (str.bytes[i] & 7);
|
||||
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
|
||||
if (!(bitset[index] & mask)) {
|
||||
return janet_wrap_false();
|
||||
}
|
||||
@@ -447,10 +462,64 @@ static Janet cfun_string_format(int32_t argc, Janet *argv) {
|
||||
return janet_stringv(buffer->data, buffer->count);
|
||||
}
|
||||
|
||||
static int trim_help_checkset(JanetByteView set, uint8_t x) {
|
||||
for (int32_t j = 0; j < set.len; j++)
|
||||
if (set.bytes[j] == x)
|
||||
return 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int32_t trim_help_leftedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = 0; i < str.len; i++)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i;
|
||||
return str.len;
|
||||
}
|
||||
|
||||
static int32_t trim_help_rightedge(JanetByteView str, JanetByteView set) {
|
||||
for (int32_t i = str.len - 1; i >= 0; i--)
|
||||
if (!trim_help_checkset(set, str.bytes[i]))
|
||||
return i + 1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void trim_help_args(int32_t argc, Janet *argv, JanetByteView *str, JanetByteView *set) {
|
||||
janet_arity(argc, 1, 2);
|
||||
*str = janet_getbytes(argv, 0);
|
||||
if (argc >= 2) {
|
||||
*set = janet_getbytes(argv, 1);
|
||||
} else {
|
||||
set->bytes = (const uint8_t *)(" \t\r\n\v\f");
|
||||
set->len = 6;
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_string_trim(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
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);
|
||||
return janet_stringv(str.bytes + left_edge, right_edge - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_triml(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t left_edge = trim_help_leftedge(str, set);
|
||||
return janet_stringv(str.bytes + left_edge, str.len - left_edge);
|
||||
}
|
||||
|
||||
static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
||||
JanetByteView str, set;
|
||||
trim_help_args(argc, argv, &str, &set);
|
||||
int32_t right_edge = trim_help_rightedge(str, set);
|
||||
return janet_stringv(str.bytes, right_edge);
|
||||
}
|
||||
|
||||
static const JanetReg string_cfuns[] = {
|
||||
{
|
||||
"string/slice", cfun_string_slice,
|
||||
JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
|
||||
JDOC("(string/slice bytes &opt start end)\n\n"
|
||||
"Returns a substring from a byte sequence. The substring is from "
|
||||
"index start inclusive to index end exclusive. All indexing "
|
||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||
@@ -468,8 +537,8 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/from-bytes", cfun_string_frombytes,
|
||||
JDOC("(string/from-bytes byte-array)\n\n"
|
||||
"Creates a string from an array of integers with byte values. All integers "
|
||||
JDOC("(string/from-bytes & byte-vals)\n\n"
|
||||
"Creates a string from integer params with byte values. All integers "
|
||||
"will be coerced to the range of 1 byte 0-255.")
|
||||
},
|
||||
{
|
||||
@@ -507,6 +576,16 @@ static const JanetReg string_cfuns[] = {
|
||||
"will only contribute to finding at most on occurrence of pattern. If no "
|
||||
"occurrences are found, will return an empty array.")
|
||||
},
|
||||
{
|
||||
"string/has-prefix?", cfun_string_hasprefix,
|
||||
JDOC("(string/has-prefix? pfx str)\n\n"
|
||||
"Tests whether str starts with pfx.")
|
||||
},
|
||||
{
|
||||
"string/has-suffix?", cfun_string_hassuffix,
|
||||
JDOC("(string/has-suffix? sfx str)\n\n"
|
||||
"Tests whether str ends with sfx.")
|
||||
},
|
||||
{
|
||||
"string/replace", cfun_string_replace,
|
||||
JDOC("(string/replace patt subst str)\n\n"
|
||||
@@ -534,7 +613,7 @@ static const JanetReg string_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"string/join", cfun_string_join,
|
||||
JDOC("(string/join parts [,sep])\n\n"
|
||||
JDOC("(string/join parts &opt sep)\n\n"
|
||||
"Joins an array of strings into one string, optionally separated by "
|
||||
"a separator string sep.")
|
||||
},
|
||||
@@ -544,6 +623,24 @@ static const JanetReg string_cfuns[] = {
|
||||
"Similar to snprintf, but specialized for operating with janet. Returns "
|
||||
"a new string.")
|
||||
},
|
||||
{
|
||||
"string/trim", cfun_string_trim,
|
||||
JDOC("(string/trim str &opt set)\n\n"
|
||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/triml", cfun_string_triml,
|
||||
JDOC("(string/triml str &opt set)\n\n"
|
||||
"Trim leading whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{
|
||||
"string/trimr", cfun_string_trimr,
|
||||
JDOC("(string/trimr str &opt set)\n\n"
|
||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||
"set is provided, consider only characters in set to be whitespace.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -45,6 +45,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
@@ -290,8 +291,9 @@ int janet_scan_number(
|
||||
if (*str == '.') {
|
||||
if (seenpoint) goto error;
|
||||
seenpoint = 1;
|
||||
}
|
||||
} else {
|
||||
seenadigit = 1;
|
||||
}
|
||||
str++;
|
||||
}
|
||||
|
||||
|
||||
@@ -27,15 +27,33 @@
|
||||
#include <math.h>
|
||||
#endif
|
||||
|
||||
/* Initialize a table */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
#define JANET_TABLE_FLAG_STACK 0x10000
|
||||
|
||||
static void *janet_memalloc_empty_local(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = janet_smalloc(count * sizeof(JanetKV));
|
||||
JanetKV *mmem = (JanetKV *)mem;
|
||||
for (i = 0; i < count; i++) {
|
||||
JanetKV *kv = mmem + i;
|
||||
kv->key = janet_wrap_nil();
|
||||
kv->value = janet_wrap_nil();
|
||||
}
|
||||
return mem;
|
||||
}
|
||||
|
||||
static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, int stackalloc) {
|
||||
JanetKV *data;
|
||||
capacity = janet_tablen(capacity);
|
||||
if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK;
|
||||
if (capacity) {
|
||||
if (stackalloc) {
|
||||
data = janet_memalloc_empty_local(capacity);
|
||||
} else {
|
||||
data = (JanetKV *) janet_memalloc_empty(capacity);
|
||||
if (NULL == data) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
table->data = data;
|
||||
table->capacity = capacity;
|
||||
} else {
|
||||
@@ -48,15 +66,20 @@ JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
return table;
|
||||
}
|
||||
|
||||
/* Initialize a table */
|
||||
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||
return janet_table_init_impl(table, capacity, 1);
|
||||
}
|
||||
|
||||
/* Deinitialize a table */
|
||||
void janet_table_deinit(JanetTable *table) {
|
||||
free(table->data);
|
||||
janet_sfree(table->data);
|
||||
}
|
||||
|
||||
/* Create a new table */
|
||||
JanetTable *janet_table(int32_t capacity) {
|
||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||
return janet_table_init(table, capacity);
|
||||
return janet_table_init_impl(table, capacity, 0);
|
||||
}
|
||||
|
||||
/* Find the bucket that contains the given key. Will also return
|
||||
@@ -68,10 +91,16 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
||||
/* Resize the dictionary table. */
|
||||
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
JanetKV *olddata = t->data;
|
||||
JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size);
|
||||
JanetKV *newdata;
|
||||
int islocal = t->gc.flags & JANET_TABLE_FLAG_STACK;
|
||||
if (islocal) {
|
||||
newdata = (JanetKV *) janet_memalloc_empty_local(size);
|
||||
} else {
|
||||
newdata = (JanetKV *) janet_memalloc_empty(size);
|
||||
if (NULL == newdata) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
}
|
||||
int32_t i, oldcapacity;
|
||||
oldcapacity = t->capacity;
|
||||
t->data = newdata;
|
||||
@@ -84,8 +113,12 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||
*newkv = *kv;
|
||||
}
|
||||
}
|
||||
if (islocal) {
|
||||
janet_sfree(olddata);
|
||||
} else {
|
||||
free(olddata);
|
||||
}
|
||||
}
|
||||
|
||||
/* Get a value out of the table */
|
||||
Janet janet_table_get(JanetTable *t, Janet key) {
|
||||
|
||||
@@ -115,6 +115,23 @@ static Janet cfun_tuple_type(int32_t argc, Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
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);
|
||||
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);
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
static const JanetReg tuple_cfuns[] = {
|
||||
{
|
||||
"tuple/brackets", cfun_tuple_brackets,
|
||||
@@ -138,6 +155,20 @@ static const JanetReg tuple_cfuns[] = {
|
||||
"the time, but will print differently and be treated differently by "
|
||||
"the compiler.")
|
||||
},
|
||||
{
|
||||
"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. ")
|
||||
},
|
||||
{
|
||||
"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.")
|
||||
},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
|
||||
@@ -508,17 +508,17 @@ static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
||||
static const JanetReg ta_cfuns[] = {
|
||||
{
|
||||
"tarray/new", cfun_typed_array_new,
|
||||
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
|
||||
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
|
||||
"Create new typed array.")
|
||||
},
|
||||
{
|
||||
"tarray/buffer", cfun_typed_array_buffer,
|
||||
JDOC("(tarray/buffer (array | size) )\n\n"
|
||||
JDOC("(tarray/buffer array|size)\n\n"
|
||||
"Return typed array buffer or create a new buffer.")
|
||||
},
|
||||
{
|
||||
"tarray/length", cfun_typed_array_size,
|
||||
JDOC("(tarray/length (array | buffer) )\n\n"
|
||||
JDOC("(tarray/length array|buffer)\n\n"
|
||||
"Return typed array or buffer size.")
|
||||
},
|
||||
{
|
||||
@@ -528,21 +528,21 @@ static const JanetReg ta_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
|
||||
"Copy count elements of src array from index sindex "
|
||||
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Copy count elements (default 1) of src array from index sindex "
|
||||
"to dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
|
||||
"Swap count elements between src array from index sindex "
|
||||
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
|
||||
"Swap count elements (default 1) between src array from index sindex "
|
||||
"and dst array at position dindex "
|
||||
"memory can overlap.")
|
||||
},
|
||||
{
|
||||
"tarray/slice", cfun_typed_array_slice,
|
||||
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
|
||||
JDOC("(tarray/slice tarr &opt start end)\n\n"
|
||||
"Takes a slice of a typed array from start to end. The range is half "
|
||||
"open, [start, end). Indexes can also be negative, indicating indexing "
|
||||
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||
|
||||
@@ -23,10 +23,35 @@
|
||||
#ifndef JANET_UTIL_H_defined
|
||||
#define JANET_UTIL_H_defined
|
||||
|
||||
#include <stdio.h>
|
||||
#include <errno.h>
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
} while (0)
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Omit docstrings in some builds */
|
||||
#ifndef JANET_BOOTSTRAP
|
||||
#define JDOC(x) NULL
|
||||
|
||||
@@ -151,7 +151,6 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRUCT:
|
||||
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||
@@ -219,7 +218,6 @@ Janet janet_get(Janet ds, Janet key) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||
} else {
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -233,7 +231,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
switch (janet_type(ds)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||
value = janet_wrap_nil();
|
||||
break;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
@@ -277,7 +274,6 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
||||
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||
} else {
|
||||
janet_panicf("no getter for %v ", ds);
|
||||
value = janet_wrap_nil();
|
||||
}
|
||||
break;
|
||||
}
|
||||
@@ -289,7 +285,6 @@ int32_t janet_length(Janet x) {
|
||||
switch (janet_type(x)) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||
return 0;
|
||||
case JANET_STRING:
|
||||
case JANET_SYMBOL:
|
||||
case JANET_KEYWORD:
|
||||
@@ -312,7 +307,6 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
if (index >= array->count) {
|
||||
@@ -355,7 +349,6 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
default:
|
||||
janet_panicf("expected %T, got %v",
|
||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||
break;
|
||||
case JANET_ARRAY: {
|
||||
int32_t index;
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
|
||||
@@ -22,6 +22,7 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include "vector.h"
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Grow the buffer dynamically. Used for push operations. */
|
||||
@@ -29,17 +30,10 @@ 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 *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||
if (NULL != p) {
|
||||
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||
if (!v) p[1] = 0;
|
||||
p[0] = m;
|
||||
return p + 2;
|
||||
} else {
|
||||
{
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
return (void *)(2 * sizeof(int32_t));
|
||||
}
|
||||
}
|
||||
|
||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||
|
||||
@@ -33,16 +33,15 @@
|
||||
*/
|
||||
|
||||
/* This is mainly used code such as the assembler or compiler, which
|
||||
* need vector like data structures that are not garbage collected
|
||||
* and used only from C */
|
||||
* need vector like data structures that are only garbage collected in case
|
||||
* of an error, and normally rely on malloc/free. */
|
||||
|
||||
#define janet_v_free(v) (((v) != NULL) ? (free(janet_v__raw(v)), 0) : 0)
|
||||
#define janet_v_free(v) (((v) != NULL) ? (janet_sfree(janet_v__raw(v)), 0) : 0)
|
||||
#define janet_v_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
||||
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
||||
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
||||
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
||||
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
||||
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
|
||||
|
||||
#define janet_v__raw(v) ((int32_t *)(v) - 2)
|
||||
@@ -55,7 +54,6 @@
|
||||
|
||||
/* Actual functions defined in vector.c */
|
||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
|
||||
void *janet_v_copymem(void *v, int32_t itemsize);
|
||||
void *janet_v_flattenmem(void *v, int32_t itemsize);
|
||||
|
||||
#endif
|
||||
|
||||
172
src/core/vm.c
172
src/core/vm.c
@@ -57,83 +57,13 @@ 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__
|
||||
#ifdef __GNUC__
|
||||
#define VM_START() { goto *op_lookup[first_opcode];
|
||||
#define VM_END() }
|
||||
#define VM_OP(op) label_##op :
|
||||
#define VM_DEFAULT() label_unknown_op:
|
||||
#define vm_next() goto *op_lookup[*pc & 0xFF]
|
||||
static void *op_lookup[255] = {
|
||||
&&label_JOP_NOOP,
|
||||
&&label_JOP_ERROR,
|
||||
&&label_JOP_TYPECHECK,
|
||||
&&label_JOP_RETURN,
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
&&label_JOP_BNOT,
|
||||
&&label_JOP_SHIFT_LEFT,
|
||||
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT,
|
||||
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
||||
&&label_JOP_MOVE_FAR,
|
||||
&&label_JOP_MOVE_NEAR,
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
&&label_JOP_LESS_THAN_IMMEDIATE,
|
||||
&&label_JOP_EQUALS,
|
||||
&&label_JOP_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_COMPARE,
|
||||
&&label_JOP_LOAD_NIL,
|
||||
&&label_JOP_LOAD_TRUE,
|
||||
&&label_JOP_LOAD_FALSE,
|
||||
&&label_JOP_LOAD_INTEGER,
|
||||
&&label_JOP_LOAD_CONSTANT,
|
||||
&&label_JOP_LOAD_UPVALUE,
|
||||
&&label_JOP_LOAD_SELF,
|
||||
&&label_JOP_SET_UPVALUE,
|
||||
&&label_JOP_CLOSURE,
|
||||
&&label_JOP_PUSH,
|
||||
&&label_JOP_PUSH_2,
|
||||
&&label_JOP_PUSH_3,
|
||||
&&label_JOP_PUSH_ARRAY,
|
||||
&&label_JOP_CALL,
|
||||
&&label_JOP_TAILCALL,
|
||||
&&label_JOP_RESUME,
|
||||
&&label_JOP_SIGNAL,
|
||||
&&label_JOP_GET,
|
||||
&&label_JOP_PUT,
|
||||
&&label_JOP_GET_INDEX,
|
||||
&&label_JOP_PUT_INDEX,
|
||||
&&label_JOP_LENGTH,
|
||||
&&label_JOP_MAKE_ARRAY,
|
||||
&&label_JOP_MAKE_BUFFER,
|
||||
&&label_JOP_MAKE_STRING,
|
||||
&&label_JOP_MAKE_STRUCT,
|
||||
&&label_JOP_MAKE_TABLE,
|
||||
&&label_JOP_MAKE_TUPLE,
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_NUMERIC_LESS_THAN,
|
||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#define opcode (*pc & 0xFF)
|
||||
#else
|
||||
#define VM_START() uint8_t opcode = first_opcode; for (;;) {switch(opcode) {
|
||||
#define VM_END() }}
|
||||
@@ -224,6 +154,23 @@ static void *op_lookup[255] = {
|
||||
#define vm_bitop(op) _vm_bitop(op, int32_t)
|
||||
#define vm_bitopu(op) _vm_bitop(op, uint32_t)
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func) {
|
||||
Janet *stack = janet_vm_fiber->data + janet_vm_fiber->stackstart;
|
||||
int32_t start = janet_vm_fiber->stackstart;
|
||||
int32_t end = janet_vm_fiber->stacktop;
|
||||
int32_t argc = end - start;
|
||||
if (func->def->name) {
|
||||
janet_printf("trace (%S", func->def->name);
|
||||
} else {
|
||||
janet_printf("trace (%p", janet_wrap_function(func));
|
||||
}
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
janet_printf(" %p", stack[i]);
|
||||
}
|
||||
printf(")\n");
|
||||
}
|
||||
|
||||
/* Call a non function type */
|
||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||
@@ -244,6 +191,81 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||
/* Interpreter main loop */
|
||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||
|
||||
/* opcode -> label lookup if using clang/GCC */
|
||||
#ifdef __GNUC__
|
||||
static void *op_lookup[255] = {
|
||||
&&label_JOP_NOOP,
|
||||
&&label_JOP_ERROR,
|
||||
&&label_JOP_TYPECHECK,
|
||||
&&label_JOP_RETURN,
|
||||
&&label_JOP_RETURN_NIL,
|
||||
&&label_JOP_ADD_IMMEDIATE,
|
||||
&&label_JOP_ADD,
|
||||
&&label_JOP_SUBTRACT,
|
||||
&&label_JOP_MULTIPLY_IMMEDIATE,
|
||||
&&label_JOP_MULTIPLY,
|
||||
&&label_JOP_DIVIDE_IMMEDIATE,
|
||||
&&label_JOP_DIVIDE,
|
||||
&&label_JOP_BAND,
|
||||
&&label_JOP_BOR,
|
||||
&&label_JOP_BXOR,
|
||||
&&label_JOP_BNOT,
|
||||
&&label_JOP_SHIFT_LEFT,
|
||||
&&label_JOP_SHIFT_LEFT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT,
|
||||
&&label_JOP_SHIFT_RIGHT_IMMEDIATE,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED,
|
||||
&&label_JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE,
|
||||
&&label_JOP_MOVE_FAR,
|
||||
&&label_JOP_MOVE_NEAR,
|
||||
&&label_JOP_JUMP,
|
||||
&&label_JOP_JUMP_IF,
|
||||
&&label_JOP_JUMP_IF_NOT,
|
||||
&&label_JOP_GREATER_THAN,
|
||||
&&label_JOP_GREATER_THAN_IMMEDIATE,
|
||||
&&label_JOP_LESS_THAN,
|
||||
&&label_JOP_LESS_THAN_IMMEDIATE,
|
||||
&&label_JOP_EQUALS,
|
||||
&&label_JOP_EQUALS_IMMEDIATE,
|
||||
&&label_JOP_COMPARE,
|
||||
&&label_JOP_LOAD_NIL,
|
||||
&&label_JOP_LOAD_TRUE,
|
||||
&&label_JOP_LOAD_FALSE,
|
||||
&&label_JOP_LOAD_INTEGER,
|
||||
&&label_JOP_LOAD_CONSTANT,
|
||||
&&label_JOP_LOAD_UPVALUE,
|
||||
&&label_JOP_LOAD_SELF,
|
||||
&&label_JOP_SET_UPVALUE,
|
||||
&&label_JOP_CLOSURE,
|
||||
&&label_JOP_PUSH,
|
||||
&&label_JOP_PUSH_2,
|
||||
&&label_JOP_PUSH_3,
|
||||
&&label_JOP_PUSH_ARRAY,
|
||||
&&label_JOP_CALL,
|
||||
&&label_JOP_TAILCALL,
|
||||
&&label_JOP_RESUME,
|
||||
&&label_JOP_SIGNAL,
|
||||
&&label_JOP_GET,
|
||||
&&label_JOP_PUT,
|
||||
&&label_JOP_GET_INDEX,
|
||||
&&label_JOP_PUT_INDEX,
|
||||
&&label_JOP_LENGTH,
|
||||
&&label_JOP_MAKE_ARRAY,
|
||||
&&label_JOP_MAKE_BUFFER,
|
||||
&&label_JOP_MAKE_STRING,
|
||||
&&label_JOP_MAKE_STRUCT,
|
||||
&&label_JOP_MAKE_TABLE,
|
||||
&&label_JOP_MAKE_TUPLE,
|
||||
&&label_JOP_MAKE_BRACKET_TUPLE,
|
||||
&&label_JOP_NUMERIC_LESS_THAN,
|
||||
&&label_JOP_NUMERIC_LESS_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||
&&label_JOP_NUMERIC_EQUAL,
|
||||
&&label_unknown_op
|
||||
};
|
||||
#endif
|
||||
|
||||
/* Interpreter state */
|
||||
register Janet *stack;
|
||||
register uint32_t *pc;
|
||||
@@ -563,6 +585,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -598,6 +621,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
||||
}
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) vm_do_trace(func);
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
int32_t n = fiber->stacktop - fiber->stackstart;
|
||||
@@ -882,6 +906,10 @@ int janet_init(void) {
|
||||
janet_vm_roots = NULL;
|
||||
janet_vm_root_count = 0;
|
||||
janet_vm_root_capacity = 0;
|
||||
/* Scratch memory */
|
||||
janet_scratch_mem = NULL;
|
||||
janet_scratch_len = 0;
|
||||
janet_scratch_cap = 0;
|
||||
/* Initialize registry */
|
||||
janet_vm_registry = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
|
||||
141
src/core/wrap.c
141
src/core/wrap.c
@@ -22,8 +22,141 @@
|
||||
|
||||
#ifndef JANET_AMALG
|
||||
#include <janet.h>
|
||||
#include "util.h"
|
||||
#endif
|
||||
|
||||
/* Macro fills */
|
||||
|
||||
JanetType(janet_type)(Janet x) {
|
||||
return janet_type(x);
|
||||
}
|
||||
int (janet_checktype)(Janet x, JanetType type) {
|
||||
return janet_checktype(x, type);
|
||||
}
|
||||
int (janet_checktypes)(Janet x, int typeflags) {
|
||||
return janet_checktypes(x, typeflags);
|
||||
}
|
||||
int (janet_truthy)(Janet x) {
|
||||
return janet_truthy(x);
|
||||
}
|
||||
|
||||
const JanetKV *(janet_unwrap_struct)(Janet x) {
|
||||
return janet_unwrap_struct(x);
|
||||
}
|
||||
const Janet *(janet_unwrap_tuple)(Janet x) {
|
||||
return janet_unwrap_tuple(x);
|
||||
}
|
||||
JanetFiber *(janet_unwrap_fiber)(Janet x) {
|
||||
return janet_unwrap_fiber(x);
|
||||
}
|
||||
JanetArray *(janet_unwrap_array)(Janet x) {
|
||||
return janet_unwrap_array(x);
|
||||
}
|
||||
JanetTable *(janet_unwrap_table)(Janet x) {
|
||||
return janet_unwrap_table(x);
|
||||
}
|
||||
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
|
||||
return janet_unwrap_buffer(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_string)(Janet x) {
|
||||
return janet_unwrap_string(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_symbol)(Janet x) {
|
||||
return janet_unwrap_symbol(x);
|
||||
}
|
||||
const uint8_t *(janet_unwrap_keyword)(Janet x) {
|
||||
return janet_unwrap_keyword(x);
|
||||
}
|
||||
void *(janet_unwrap_abstract)(Janet x) {
|
||||
return janet_unwrap_abstract(x);
|
||||
}
|
||||
void *(janet_unwrap_pointer)(Janet x) {
|
||||
return janet_unwrap_pointer(x);
|
||||
}
|
||||
JanetFunction *(janet_unwrap_function)(Janet x) {
|
||||
return janet_unwrap_function(x);
|
||||
}
|
||||
JanetCFunction(janet_unwrap_cfunction)(Janet x) {
|
||||
return janet_unwrap_cfunction(x);
|
||||
}
|
||||
int (janet_unwrap_boolean)(Janet x) {
|
||||
return janet_unwrap_boolean(x);
|
||||
}
|
||||
int32_t (janet_unwrap_integer)(Janet x) {
|
||||
return janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
#if defined(JANET_NANBOX_32) || defined(JANET_NANBOX_64)
|
||||
Janet(janet_wrap_nil)(void) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
Janet(janet_wrap_true)(void) {
|
||||
return janet_wrap_true();
|
||||
}
|
||||
Janet(janet_wrap_false)(void) {
|
||||
return janet_wrap_false();
|
||||
}
|
||||
Janet(janet_wrap_boolean)(int x) {
|
||||
return janet_wrap_boolean(x);
|
||||
}
|
||||
Janet(janet_wrap_string)(const uint8_t *x) {
|
||||
return janet_wrap_string(x);
|
||||
}
|
||||
Janet(janet_wrap_symbol)(const uint8_t *x) {
|
||||
return janet_wrap_symbol(x);
|
||||
}
|
||||
Janet(janet_wrap_keyword)(const uint8_t *x) {
|
||||
return janet_wrap_keyword(x);
|
||||
}
|
||||
Janet(janet_wrap_array)(JanetArray *x) {
|
||||
return janet_wrap_array(x);
|
||||
}
|
||||
Janet(janet_wrap_tuple)(const Janet *x) {
|
||||
return janet_wrap_tuple(x);
|
||||
}
|
||||
Janet(janet_wrap_struct)(const JanetKV *x) {
|
||||
return janet_wrap_struct(x);
|
||||
}
|
||||
Janet(janet_wrap_fiber)(JanetFiber *x) {
|
||||
return janet_wrap_fiber(x);
|
||||
}
|
||||
Janet(janet_wrap_buffer)(JanetBuffer *x) {
|
||||
return janet_wrap_buffer(x);
|
||||
}
|
||||
Janet(janet_wrap_function)(JanetFunction *x) {
|
||||
return janet_wrap_function(x);
|
||||
}
|
||||
Janet(janet_wrap_cfunction)(JanetCFunction x) {
|
||||
return janet_wrap_cfunction(x);
|
||||
}
|
||||
Janet(janet_wrap_table)(JanetTable *x) {
|
||||
return janet_wrap_table(x);
|
||||
}
|
||||
Janet(janet_wrap_abstract)(void *x) {
|
||||
return janet_wrap_abstract(x);
|
||||
}
|
||||
Janet(janet_wrap_pointer)(void *x) {
|
||||
return janet_wrap_pointer(x);
|
||||
}
|
||||
Janet(janet_wrap_integer)(int32_t x) {
|
||||
return janet_wrap_integer(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NANBOX_32
|
||||
double (janet_unwrap_number)(Janet x) {
|
||||
return janet_unwrap_number(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
Janet(janet_wrap_number)(double x) {
|
||||
return janet_wrap_number(x);
|
||||
}
|
||||
#endif
|
||||
|
||||
/*****/
|
||||
|
||||
void *janet_memalloc_empty(int32_t count) {
|
||||
int32_t i;
|
||||
void *mem = malloc(count * sizeof(JanetKV));
|
||||
@@ -110,13 +243,7 @@ double janet_unwrap_number(Janet x) {
|
||||
|
||||
#else
|
||||
|
||||
/* Wrapper functions wrap a data type that is used from C into a
|
||||
* janet value, which can then be used in janet internal functions. Use
|
||||
* these functions sparingly, as these function will let the programmer
|
||||
* leak memory, where as the stack based API ensures that all values can
|
||||
* be collected by the garbage collector. */
|
||||
|
||||
Janet janet_wrap_nil() {
|
||||
Janet janet_wrap_nil(void) {
|
||||
Janet y;
|
||||
y.type = JANET_NIL;
|
||||
y.as.u64 = 0;
|
||||
|
||||
@@ -51,6 +51,7 @@ extern "C" {
|
||||
|| defined(__FreeBSD__) || defined(__DragonFly__) \
|
||||
|| defined(__FreeBSD_kernel__) \
|
||||
|| defined(__GNU__) /* GNU/Hurd */ \
|
||||
|| defined(__HAIKU__) \
|
||||
|| defined(__linux__) \
|
||||
|| defined(__NetBSD__) \
|
||||
|| defined(__OpenBSD__) \
|
||||
@@ -151,26 +152,13 @@ extern "C" {
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Handle runtime errors */
|
||||
#ifndef janet_exit
|
||||
#include <stdio.h>
|
||||
#define janet_exit(m) do { \
|
||||
printf("C runtime error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
__FILE__,\
|
||||
(m));\
|
||||
exit(1);\
|
||||
} while (0)
|
||||
/* Tell complier some functions don't return */
|
||||
#ifndef JANET_NO_RETURN
|
||||
#ifdef JANET_WINDOWS
|
||||
#define JANET_NO_RETURN __declspec(noreturn)
|
||||
#else
|
||||
#define JANET_NO_RETURN __attribute__ ((noreturn))
|
||||
#endif
|
||||
|
||||
#define janet_assert(c, m) do { \
|
||||
if (!(c)) janet_exit((m)); \
|
||||
} while (0)
|
||||
|
||||
/* What to do when out of memory */
|
||||
#ifndef JANET_OUT_OF_MEMORY
|
||||
#include <stdio.h>
|
||||
#define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0)
|
||||
#endif
|
||||
|
||||
/* Prevent some recursive functions from recursing too deeply
|
||||
@@ -197,20 +185,46 @@ extern "C" {
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#else
|
||||
#elif defined(__x86_64__) || defined(_WIN64)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* on x86. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. */
|
||||
#define JANET_NANBOX_64
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Alignment for pointers */
|
||||
#ifndef JANET_WALIGN
|
||||
#ifdef JANET_32
|
||||
#define JANET_WALIGN 4
|
||||
/* Runtime config constants */
|
||||
#ifdef JANET_NO_NANBOX
|
||||
#define JANET_NANBOX_BIT 0
|
||||
#else
|
||||
#define JANET_WALIGN 8
|
||||
#define JANET_NANBOX_BIT 0x1
|
||||
#endif
|
||||
|
||||
#ifdef JANET_SINGLE_THREADED
|
||||
#define JANET_SINGLE_THREADED_BIT 0x2
|
||||
#else
|
||||
#define JANET_SINGLE_THREADED_BIT 0
|
||||
#endif
|
||||
|
||||
#define JANET_CURRENT_CONFIG_BITS \
|
||||
(JANET_SINGLE_THREADED_BIT | \
|
||||
JANET_NANBOX_BIT)
|
||||
|
||||
/* Represents the settings used to compile Janet, as well as the version */
|
||||
typedef struct {
|
||||
unsigned major;
|
||||
unsigned minor;
|
||||
unsigned patch;
|
||||
unsigned bits;
|
||||
} JanetBuildConfig;
|
||||
|
||||
/* Get config of current compilation unit. */
|
||||
#define janet_config_current() ((JanetBuildConfig){ \
|
||||
JANET_VERSION_MAJOR, \
|
||||
JANET_VERSION_MINOR, \
|
||||
JANET_VERSION_PATCH, \
|
||||
JANET_CURRENT_CONFIG_BITS })
|
||||
|
||||
/***** END SECTION CONFIG *****/
|
||||
|
||||
/***** START SECTION TYPES *****/
|
||||
@@ -221,11 +235,12 @@ extern "C" {
|
||||
#include <stdarg.h>
|
||||
#include <setjmp.h>
|
||||
#include <stddef.h>
|
||||
#include <stdio.h>
|
||||
|
||||
/* Names of all of the types */
|
||||
extern const char *const janet_type_names[16];
|
||||
extern const char *const janet_signal_names[14];
|
||||
extern const char *const janet_status_names[16];
|
||||
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];
|
||||
|
||||
/* Fiber signals */
|
||||
typedef enum {
|
||||
@@ -344,12 +359,12 @@ typedef enum JanetType {
|
||||
#define JANET_TFLAG_ABSTRACT (1 << JANET_ABSTRACT)
|
||||
#define JANET_TFLAG_POINTER (1 << JANET_POINTER)
|
||||
|
||||
/* Some abstractions */
|
||||
#define JANET_TFLAG_BYTES (JANET_TFLAG_STRING | JANET_TFLAG_SYMBOL | JANET_TFLAG_BUFFER | JANET_TFLAG_KEYWORD)
|
||||
#define JANET_TFLAG_INDEXED (JANET_TFLAG_ARRAY | JANET_TFLAG_TUPLE)
|
||||
#define JANET_TFLAG_DICTIONARY (JANET_TFLAG_TABLE | JANET_TFLAG_STRUCT)
|
||||
#define JANET_TFLAG_LENGTHABLE (JANET_TFLAG_BYTES | JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION)
|
||||
#define JANET_TFLAG_CALLABLE (JANET_TFLAG_FUNCTION | JANET_TFLAG_CFUNCTION | \
|
||||
JANET_TFLAG_LENGTHABLE | JANET_TFLAG_ABSTRACT)
|
||||
|
||||
/* We provide three possible implementations of Janets. The preferred
|
||||
* nanboxing approach, for 32 or 64 bits, and the standard C version. Code in the rest of the
|
||||
@@ -371,6 +386,63 @@ typedef enum JanetType {
|
||||
* janet_u64(x) - get 64 bits of payload for hashing
|
||||
*/
|
||||
|
||||
/***** START SECTION NON-C API *****/
|
||||
|
||||
/* Some janet types use offset tricks to make operations easier in C. For
|
||||
* external bindings, we should prefer using the Head structs directly, and
|
||||
* use the host language to add sugar around the manipulation of the Janet types. */
|
||||
|
||||
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
|
||||
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
|
||||
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
|
||||
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
|
||||
|
||||
/* Some language bindings won't have access to the macro versions. */
|
||||
|
||||
JANET_API JanetType janet_type(Janet x);
|
||||
JANET_API int janet_checktype(Janet x, JanetType type);
|
||||
JANET_API int janet_checktypes(Janet x, int typeflags);
|
||||
JANET_API int janet_truthy(Janet x);
|
||||
|
||||
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
|
||||
JANET_API const Janet *janet_unwrap_tuple(Janet x);
|
||||
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
|
||||
JANET_API JanetArray *janet_unwrap_array(Janet x);
|
||||
JANET_API JanetTable *janet_unwrap_table(Janet x);
|
||||
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_string(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
|
||||
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
|
||||
JANET_API void *janet_unwrap_abstract(Janet x);
|
||||
JANET_API void *janet_unwrap_pointer(Janet x);
|
||||
JANET_API JanetFunction *janet_unwrap_function(Janet x);
|
||||
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
|
||||
JANET_API int janet_unwrap_boolean(Janet x);
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
JANET_API int32_t janet_unwrap_integer(Janet x);
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
JANET_API Janet janet_wrap_integer(int32_t x);
|
||||
|
||||
/***** END SECTION NON-C API *****/
|
||||
|
||||
#ifdef JANET_NANBOX_64
|
||||
|
||||
#include <math.h>
|
||||
@@ -497,7 +569,6 @@ union Janet {
|
||||
#define janet_truthy(x) \
|
||||
((x).tagged.type != JANET_NIL && ((x).tagged.type != JANET_BOOLEAN || ((x).tagged.payload.integer & 0x1)))
|
||||
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer);
|
||||
JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
|
||||
@@ -535,7 +606,6 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
|
||||
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_cfunction(x) ((JanetCFunction)(x).tagged.payload.pointer)
|
||||
#define janet_unwrap_boolean(x) ((x).tagged.payload.integer)
|
||||
JANET_API double janet_unwrap_number(Janet x);
|
||||
|
||||
#else
|
||||
|
||||
@@ -573,25 +643,6 @@ struct Janet {
|
||||
#define janet_unwrap_boolean(x) ((x).as.u64 & 0x1)
|
||||
#define janet_unwrap_number(x) ((x).as.number)
|
||||
|
||||
JANET_API Janet janet_wrap_nil(void);
|
||||
JANET_API Janet janet_wrap_number(double x);
|
||||
JANET_API Janet janet_wrap_true(void);
|
||||
JANET_API Janet janet_wrap_false(void);
|
||||
JANET_API Janet janet_wrap_boolean(int x);
|
||||
JANET_API Janet janet_wrap_string(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
|
||||
JANET_API Janet janet_wrap_array(JanetArray *x);
|
||||
JANET_API Janet janet_wrap_tuple(const Janet *x);
|
||||
JANET_API Janet janet_wrap_struct(const JanetKV *x);
|
||||
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
|
||||
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
|
||||
JANET_API Janet janet_wrap_function(JanetFunction *x);
|
||||
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
|
||||
JANET_API Janet janet_wrap_table(JanetTable *x);
|
||||
JANET_API Janet janet_wrap_abstract(void *x);
|
||||
JANET_API Janet janet_wrap_pointer(void *x);
|
||||
|
||||
/* End of tagged union implementation */
|
||||
#endif
|
||||
|
||||
@@ -645,6 +696,7 @@ struct JanetFiber {
|
||||
int32_t stacktop; /* Top of stack. Where values are pushed and popped from. */
|
||||
int32_t capacity;
|
||||
int32_t maxstack; /* Arbitrary defined limit for stack overflow */
|
||||
JanetTable *env; /* Dynamic bindings table (usually current environment). */
|
||||
Janet *data;
|
||||
JanetFiber *child; /* Keep linked list of fibers for restarting pending fibers */
|
||||
};
|
||||
@@ -742,6 +794,7 @@ struct JanetAbstractHead {
|
||||
#define JANET_FUNCDEF_FLAG_HASDEFS 0x200000
|
||||
#define JANET_FUNCDEF_FLAG_HASENVS 0x400000
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
@@ -786,6 +839,8 @@ struct JanetFuncEnv {
|
||||
environment is no longer on the stack. */
|
||||
};
|
||||
|
||||
#define JANET_FUNCFLAG_TRACE (1 << 16)
|
||||
|
||||
/* A function */
|
||||
struct JanetFunction {
|
||||
JanetGCObject gc;
|
||||
@@ -995,7 +1050,7 @@ JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||
#define janet_parser_has_more(P) ((P)->pending)
|
||||
JANET_API int janet_parser_has_more(JanetParser *parser);
|
||||
|
||||
/* Assembly */
|
||||
#ifdef JANET_ASSEMBLER
|
||||
@@ -1050,8 +1105,6 @@ JANET_API void janet_debug_find(
|
||||
/* Array functions */
|
||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
||||
JANET_API JanetArray *janet_array_init(JanetArray *array, int32_t capacity);
|
||||
JANET_API void janet_array_deinit(JanetArray *array);
|
||||
JANET_API void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth);
|
||||
JANET_API void janet_array_setcount(JanetArray *array, int32_t count);
|
||||
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
||||
@@ -1152,7 +1205,8 @@ JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||
/* Fiber */
|
||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||
JANET_API JanetFiber *janet_fiber_reset(JanetFiber *fiber, JanetFunction *callee, int32_t argc, const Janet *argv);
|
||||
#define janet_fiber_status(f) (((f)->flags & JANET_FIBER_STATUS_MASK) >> JANET_FIBER_STATUS_OFFSET)
|
||||
JANET_API JanetFiberStatus janet_fiber_status(JanetFiber *fiber);
|
||||
JANET_API JanetFiber *janet_current_fiber(void);
|
||||
|
||||
/* Treat similar types through uniform interfaces for iteration */
|
||||
JANET_API int janet_indexed_view(Janet seq, const Janet **data, int32_t *len);
|
||||
@@ -1162,13 +1216,16 @@ JANET_API Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key
|
||||
JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap, const JanetKV *kv);
|
||||
|
||||
/* Abstract */
|
||||
#define janet_abstract_header(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_header(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_header(u)->size)
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size);
|
||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
||||
JANET_API void *janet_abstract_begin(const JanetAbstractType *type, size_t size);
|
||||
JANET_API void *janet_abstract_end(void *);
|
||||
JANET_API void *janet_abstract(const JanetAbstractType *type, size_t size); /* begin and end in one call */
|
||||
|
||||
/* Native */
|
||||
typedef void (*JanetModule)(JanetTable *);
|
||||
typedef JanetBuildConfig(*JanetModconf)(void);
|
||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||
|
||||
/* Marshaling */
|
||||
@@ -1215,6 +1272,8 @@ JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||
JANET_API int32_t janet_length(Janet x);
|
||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
||||
|
||||
/* VM functions */
|
||||
JANET_API int janet_init(void);
|
||||
@@ -1224,6 +1283,11 @@ JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet
|
||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
||||
|
||||
/* Scratch Memory API */
|
||||
JANET_API void *janet_smalloc(size_t size);
|
||||
JANET_API void *janet_srealloc(void *mem, size_t size);
|
||||
JANET_API void janet_sfree(void *mem);
|
||||
|
||||
/* C Library helpers */
|
||||
typedef enum {
|
||||
JANET_BINDING_NONE,
|
||||
@@ -1239,14 +1303,19 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
||||
|
||||
/* New C API */
|
||||
|
||||
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
||||
JANET_API void janet_panicv(Janet message);
|
||||
JANET_API void janet_panic(const char *message);
|
||||
JANET_API void janet_panics(const uint8_t *message);
|
||||
#define janet_panicf(...) janet_panics(janet_formatc(__VA_ARGS__))
|
||||
#define janet_printf(...) fputs((const char *)janet_formatc(__VA_ARGS__), stdout)
|
||||
JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
||||
JANET_API void janet_panic_abstract(Janet x, int32_t n, const JanetAbstractType *at);
|
||||
#define JANET_MODULE_ENTRY \
|
||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
||||
return janet_config_current(); \
|
||||
} \
|
||||
JANET_API void _janet_init
|
||||
|
||||
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_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);
|
||||
|
||||
@@ -1278,17 +1347,21 @@ 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 Janet janet_dyn(const char *name);
|
||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||
|
||||
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
|
||||
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
|
||||
|
||||
/* Marshal API */
|
||||
#define janet_marshal_size(ctx, x) janet_marshal_int64((ctx), (int64_t) (x))
|
||||
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);
|
||||
JANET_API void janet_marshal_int(JanetMarshalContext *ctx, int32_t value);
|
||||
JANET_API void janet_marshal_int64(JanetMarshalContext *ctx, int64_t value);
|
||||
JANET_API void janet_marshal_byte(JanetMarshalContext *ctx, uint8_t value);
|
||||
JANET_API void janet_marshal_bytes(JanetMarshalContext *ctx, const uint8_t *bytes, size_t len);
|
||||
JANET_API void janet_marshal_janet(JanetMarshalContext *ctx, Janet x);
|
||||
|
||||
#define janet_unmarshal_size(ctx) ((size_t) janet_unmarshal_int64((ctx)))
|
||||
JANET_API size_t janet_unmarshal_size(JanetMarshalContext *ctx);
|
||||
JANET_API int32_t janet_unmarshal_int(JanetMarshalContext *ctx);
|
||||
JANET_API int64_t janet_unmarshal_int64(JanetMarshalContext *ctx);
|
||||
JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
|
||||
|
||||
@@ -9,8 +9,10 @@
|
||||
(var *handleopts* true)
|
||||
(var *exit-on-error* true)
|
||||
(var *colorize* true)
|
||||
(var *compile-only* false)
|
||||
|
||||
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
|
||||
(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
|
||||
@@ -25,6 +27,7 @@
|
||||
-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
|
||||
@@ -37,16 +40,17 @@
|
||||
"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 &] (set module/*syspath* (get process/args (+ i 1))) 2)
|
||||
"m" (fn [i &] (setdyn :syspath (get process/args (+ i 1))) 2)
|
||||
"c" (fn [i &]
|
||||
(def e (require (get process/args (+ i 1))))
|
||||
(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* *env* (get process/args (+ i 1))
|
||||
(dofile (get process/args (+ i 1))
|
||||
:prefix "" :exit *exit-on-error*)
|
||||
2)
|
||||
"e" (fn [i &]
|
||||
@@ -67,16 +71,16 @@
|
||||
(+= i (dohandler (string/slice arg 1 2) i))
|
||||
(do
|
||||
(set *no-file* false)
|
||||
(import* *env* arg :prefix "" :exit *exit-on-error*)
|
||||
(dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||
(set i lenargs))))
|
||||
|
||||
(when (or *should-repl* *no-file*)
|
||||
(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) "> "))
|
||||
(string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
||||
(def prompter (if *quiet* noprompt getprompt))
|
||||
(defn getstdin [prompt buf]
|
||||
(file/write stdout prompt)
|
||||
@@ -86,4 +90,5 @@
|
||||
(defn getchunk [buf p]
|
||||
(getter (prompter p) buf))
|
||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||
(repl getchunk onsig (if *colorize* "%.20P" "%.20p"))))
|
||||
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||
(repl getchunk onsig)))
|
||||
|
||||
@@ -32,11 +32,12 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static void simpleline(JanetBuffer *buffer) {
|
||||
FILE *in = janet_dynfile("in", stdin);
|
||||
buffer->count = 0;
|
||||
int c;
|
||||
for (;;) {
|
||||
c = fgetc(stdin);
|
||||
if (feof(stdin) || c < 0) {
|
||||
c = fgetc(in);
|
||||
if (feof(in) || c < 0) {
|
||||
break;
|
||||
}
|
||||
janet_buffer_push_u8(buffer, (uint8_t) c);
|
||||
@@ -56,7 +57,9 @@ void janet_line_deinit() {
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
fputs(p, stdout);
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
fputs(p, out);
|
||||
fflush(out);
|
||||
simpleline(buffer);
|
||||
}
|
||||
|
||||
@@ -94,6 +97,7 @@ 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;
|
||||
|
||||
/* Unsupported terminal list from linenoise */
|
||||
@@ -333,6 +337,7 @@ static int line() {
|
||||
return 0;
|
||||
case 3: /* ctrl-c */
|
||||
errno = EAGAIN;
|
||||
sigint_flag = 1;
|
||||
return -1;
|
||||
case 127: /* backspace */
|
||||
case 8: /* ctrl-h */
|
||||
@@ -448,6 +453,7 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
prompt = p;
|
||||
buffer->count = 0;
|
||||
historyi = 0;
|
||||
FILE *out = janet_dynfile("out", stdout);
|
||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||
simpleline(buffer);
|
||||
return;
|
||||
@@ -458,11 +464,15 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
}
|
||||
if (line()) {
|
||||
norawmode();
|
||||
fputc('\n', stdout);
|
||||
if (sigint_flag) {
|
||||
raise(SIGINT);
|
||||
} else {
|
||||
fputc('\n', out);
|
||||
}
|
||||
return;
|
||||
}
|
||||
norawmode();
|
||||
fputc('\n', stdout);
|
||||
fputc('\n', out);
|
||||
janet_buffer_ensure(buffer, len + 1, 2);
|
||||
memcpy(buffer->data, buf, len);
|
||||
buffer->data[len] = '\n';
|
||||
|
||||
@@ -23,6 +23,13 @@
|
||||
#include <janet.h>
|
||||
#include "line.h"
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.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;
|
||||
|
||||
@@ -31,6 +38,16 @@ int main(int argc, char **argv) {
|
||||
JanetArray *args;
|
||||
JanetTable *env;
|
||||
|
||||
/* Enable color console on windows 10 console and utf8 output. */
|
||||
#ifdef _WIN32
|
||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||
DWORD dwMode = 0;
|
||||
GetConsoleMode(hOut, &dwMode);
|
||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||
SetConsoleMode(hOut, dwMode);
|
||||
SetConsoleOutputCP(65001);
|
||||
#endif
|
||||
|
||||
/* Set up VM */
|
||||
janet_init();
|
||||
|
||||
|
||||
@@ -3,6 +3,7 @@
|
||||
(print (string "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||
|
||||
(fiber/new (fn webrepl []
|
||||
(setdyn :pretty-format "%.20P")
|
||||
(repl (fn get-line [buf p]
|
||||
(def offset (parser/where p))
|
||||
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||
|
||||
36
test/amalg/main.c
Normal file
36
test/amalg/main.c
Normal file
@@ -0,0 +1,36 @@
|
||||
/*
|
||||
* Copyright (c) 2019 Calvin Rose
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A simple client for checking if the amalgamated Janet source compiles
|
||||
* correctly. */
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
int main(int argc, const char *argv[]) {
|
||||
(void) argc;
|
||||
(void) argv;
|
||||
janet_init();
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
janet_dostring(env, "(print `hello, world!`)", "main", NULL);
|
||||
janet_deinit();
|
||||
return 0;
|
||||
}
|
||||
@@ -1,11 +0,0 @@
|
||||
(import cook)
|
||||
|
||||
(cook/make-native
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
(import build/testmod :as testmod)
|
||||
|
||||
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
||||
|
||||
(print "OK!")
|
||||
7
test/install/project.janet
Normal file
7
test/install/project.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(declare-project
|
||||
:name "testmod")
|
||||
|
||||
(declare-native
|
||||
:name "testmod"
|
||||
:source @["testmod.c"])
|
||||
|
||||
3
test/install/test/test1.janet
Normal file
3
test/install/test/test1.janet
Normal file
@@ -0,0 +1,3 @@
|
||||
(import build/testmod :as testmod)
|
||||
|
||||
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 0)
|
||||
|
||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||
@@ -300,5 +300,8 @@
|
||||
(assert (= (length {1 2 3 nil}) 1) "nil value struct literal")
|
||||
(assert (= (length @{1 2 3 nil}) 1) "nil value table literal")
|
||||
|
||||
# Regression Test
|
||||
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 1)
|
||||
|
||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||
@@ -140,7 +140,7 @@
|
||||
|
||||
# Marshal
|
||||
|
||||
(def um-lookup (env-lookup *env*))
|
||||
(def um-lookup (env-lookup (fiber/getenv (fiber/current))))
|
||||
(def m-lookup (invert um-lookup))
|
||||
|
||||
(defn testmarsh [x msg]
|
||||
@@ -182,7 +182,7 @@
|
||||
# Large functions
|
||||
(def manydefs (seq [i :range [0 300]] (tuple 'def (gensym) (string "value_" i))))
|
||||
(array/push manydefs (tuple * 10000 3 5 7 9))
|
||||
(def f (compile ['do ;manydefs] *env*))
|
||||
(def f (compile ['do ;manydefs] (fiber/getenv (fiber/current))))
|
||||
(assert (= (f) (* 10000 3 5 7 9)) "long function compilation")
|
||||
|
||||
# Some higher order functions and macros
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 2)
|
||||
|
||||
# Buffer stuff
|
||||
@@ -64,6 +64,12 @@
|
||||
(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 (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")
|
||||
(assert (string/has-suffix? "" "foo") "string/has-suffix? 1")
|
||||
(assert (string/has-suffix? "oo" "foo") "string/has-suffix? 2")
|
||||
(assert (not (string/has-suffix? "f" "foo")) "string/has-suffix? 3")
|
||||
(assert (= (string/replace "X" "." "XXX...XXX...XXX") ".XX...XXX...XXX") "string/replace 1")
|
||||
(assert (= (string/replace-all "X" "." "XXX...XXX...XXX") "...............") "string/replace-all 1")
|
||||
(assert (= (string/replace-all "XX" "." "XXX...XXX...XXX") ".X....X....X") "string/replace-all 2")
|
||||
@@ -77,6 +83,16 @@
|
||||
(assert (= (string/join @["one" "two" "three"] ", ") "one, two, three") "string/join 2")
|
||||
(assert (= (string/join @["one" "two" "three"]) "onetwothree") "string/join 3")
|
||||
(assert (= (string/join @[] "hi") "") "string/join 4")
|
||||
(assert (= (string/trim " abcd ") "abcd") "string/trim 1")
|
||||
(assert (= (string/trim "abcd \t\t\r\f") "abcd") "string/trim 2")
|
||||
(assert (= (string/trim "\n\n\t abcd") "abcd") "string/trim 3")
|
||||
(assert (= (string/trim "") "") "string/trim 4")
|
||||
(assert (= (string/triml " abcd ") "abcd ") "string/triml 1")
|
||||
(assert (= (string/triml "\tabcd \t\t\r\f") "abcd \t\t\r\f") "string/triml 2")
|
||||
(assert (= (string/triml "abcd ") "abcd ") "string/triml 3")
|
||||
(assert (= (string/trimr " abcd ") " abcd") "string/trimr 1")
|
||||
(assert (= (string/trimr "\tabcd \t\t\r\f") "\tabcd") "string/trimr 2")
|
||||
(assert (= (string/trimr " abcd") " abcd") "string/trimr 3")
|
||||
(assert (deep= (string/split "," "one,two,three") @["one" "two" "three"]) "string/split 1")
|
||||
(assert (deep= (string/split "," "onetwothree") @["onetwothree"]) "string/split 2")
|
||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 3)
|
||||
|
||||
(assert (= (length (range 10)) 10) "(range 10)")
|
||||
@@ -159,6 +159,14 @@
|
||||
(buffer/blit b2 "abcdefg" 5 6)
|
||||
(assert (= (string b2) "joytogjoyto") "buffer/blit 3")
|
||||
|
||||
# Buffer self blitting, check for use after free
|
||||
(def buf1 @"1234567890")
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(buffer/blit buf1 buf1 -1)
|
||||
(assert (= (string buf1) (string/repeat "1234567890" 16)) "buffer blit against self")
|
||||
|
||||
# Buffer push word
|
||||
|
||||
(def b3 @"")
|
||||
@@ -170,6 +178,22 @@
|
||||
(assert (= 8 (length b3)) "buffer/push-word 3")
|
||||
(assert (= "\xFF\xFF\xFF\xFF\0\x11\0\0" (string b3)) "buffer/push-word 4")
|
||||
|
||||
# Buffer push string
|
||||
|
||||
(def b4 (buffer/new-filled 10 0))
|
||||
(buffer/push-string b4 b4)
|
||||
(assert (= "\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0\0" (string b4)) "buffer/push-buffer 1")
|
||||
(def b5 @"123")
|
||||
(buffer/push-string b5 "456" @"789")
|
||||
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
|
||||
|
||||
# Check for bugs with printing self with buffer/format
|
||||
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp)) `abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# Peg
|
||||
|
||||
(defn check-match
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 4)
|
||||
# some tests for string/format and buffer/format
|
||||
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 5)
|
||||
|
||||
# some tests typed array
|
||||
|
||||
@@ -18,7 +18,7 @@
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import test/helper :prefix "" :exit true)
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 6)
|
||||
|
||||
# some tests for bigint
|
||||
@@ -88,4 +88,78 @@
|
||||
))
|
||||
"int64 typed arrays")
|
||||
|
||||
# Dynamic bindings
|
||||
(setdyn :a 10)
|
||||
(assert (= 40 (with-dyns [:a 25 :b 15] (+ (dyn :a) (dyn :b)))) "dyn usage 1")
|
||||
(assert (= 10 (dyn :a)) "dyn usage 2")
|
||||
(assert (= nil (dyn :b)) "dyn usage 3")
|
||||
(setdyn :a 100)
|
||||
(assert (= 100 (dyn :a)) "dyn usage 4")
|
||||
|
||||
# Keyword arguments
|
||||
(defn myfn [x y z &keys {:a a :b b :c c}]
|
||||
(+ x y z a b c))
|
||||
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 3 :b 4 :c 5)) "keyword args 1")
|
||||
(assert (= (+ ;(range 6)) (myfn 0 1 2 :a 1 :b 6 :c 5 :d 11)) "keyword args 2")
|
||||
|
||||
# Comment macro
|
||||
(comment 1)
|
||||
(comment 1 2)
|
||||
(comment 1 2 3)
|
||||
(comment 1 2 3 4)
|
||||
|
||||
# Parser clone
|
||||
(def p (parser/new))
|
||||
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p))
|
||||
(parser/consume p2 ") 1 ")
|
||||
(parser/consume p ") 1 ")
|
||||
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
|
||||
|
||||
# String check-set
|
||||
(assert (string/check-set "abc" "a") "string/check-set 1")
|
||||
(assert (not (string/check-set "abc" "z")) "string/check-set 2")
|
||||
(assert (string/check-set "abc" "abc") "string/check-set 3")
|
||||
(assert (not (string/check-set "abc" "")) "string/check-set 4")
|
||||
(assert (not (string/check-set "" "aabc")) "string/check-set 5")
|
||||
|
||||
# Marshal and unmarshal pegs
|
||||
(def p (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p "abcd") "peg marshal 1")
|
||||
(assert (peg/match p "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
|
||||
|
||||
# This should be valgrind clean.
|
||||
(var pegi 3)
|
||||
(defn marshpeg [p]
|
||||
(assert (-> p peg/compile marshal unmarshal) (string "peg marshal " (++ pegi))))
|
||||
(marshpeg '(* 1 2 (set "abcd") "asdasd" (+ "." 3)))
|
||||
(marshpeg '(% (* (+ 1 2 3) (* "drop" "bear") '"hi")))
|
||||
(marshpeg '(> 123 "abcd"))
|
||||
(marshpeg '{:main (* 1 "hello" :main)})
|
||||
(marshpeg '(range "AZ"))
|
||||
(marshpeg '(if-not "abcdf" 123))
|
||||
(marshpeg '(error ($)))
|
||||
(marshpeg '(* "abcd" (constant :hi)))
|
||||
(marshpeg ~(/ "abc" ,identity))
|
||||
(marshpeg '(if-not "abcdf" 123))
|
||||
(marshpeg ~(cmt "abcdf" ,identity))
|
||||
(marshpeg '(group "abc"))
|
||||
|
||||
# Module path expansion
|
||||
(setdyn :current-file "some-dir/some-file")
|
||||
(defn test-expand [path temp]
|
||||
(string (module/expand-path path temp)))
|
||||
|
||||
(assert (= (test-expand "abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 1")
|
||||
(assert (= (test-expand "./abc" ":cur:/:all:") "some-dir/abc") "module/expand-path 2")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:name:") "some-dir/def.txt") "module/expand-path 3")
|
||||
(assert (= (test-expand "abc/def.txt" ":cur:/:dir:/sub/:name:") "some-dir/abc/sub/def.txt") "module/expand-path 4")
|
||||
(assert (= (test-expand "/abc/../def.txt" ":all:") "/def.txt") "module/expand-path 5")
|
||||
(assert (= (test-expand "abc/../def.txt" ":all:") "def.txt") "module/expand-path 6")
|
||||
(assert (= (test-expand "../def.txt" ":all:") "../def.txt") "module/expand-path 7")
|
||||
(assert (= (test-expand "../././././abcd/../def.txt" ":all:") "../def.txt") "module/expand-path 8")
|
||||
|
||||
(end-suite)
|
||||
|
||||
91
test/suite7.janet
Normal file
91
test/suite7.janet
Normal file
@@ -0,0 +1,91 @@
|
||||
# Copyright (c) 2019 Calvin Rose & contributors
|
||||
#
|
||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
# deal in the Software without restriction, including without limitation the
|
||||
# rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
# sell copies of the Software, and to permit persons to whom the Software is
|
||||
# furnished to do so, subject to the following conditions:
|
||||
#
|
||||
# The above copyright notice and this permission notice shall be included in
|
||||
# all copies or substantial portions of the Software.
|
||||
#
|
||||
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
# IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
# FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
# AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
# LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
# IN THE SOFTWARE.
|
||||
|
||||
(import ./helper :prefix "" :exit true)
|
||||
(start-suite 7)
|
||||
|
||||
# Using a large test grammar
|
||||
|
||||
(def- core-env (table/getproto (fiber/getenv (fiber/current))))
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
'while true
|
||||
'def true
|
||||
'splice true
|
||||
'set true
|
||||
'unquote true
|
||||
'quasiquote true
|
||||
'quote true
|
||||
'if true})
|
||||
|
||||
(defn- check-number [text] (and (scan-number text) text))
|
||||
|
||||
(defn capture-sym
|
||||
[text]
|
||||
(def sym (symbol text))
|
||||
[(if (or (core-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
:readermac (set "';~,")
|
||||
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
|
||||
:token (some :symchars)
|
||||
:hex (range "09" "af" "AF")
|
||||
:escape (* "\\" (+ (set "ntrvzf0e\"\\")
|
||||
(* "x" :hex :hex)
|
||||
(error (constant "bad hex escape"))))
|
||||
:comment (/ '(* "#" (any (if-not (+ "\n" -1) 1))) (constant :comment))
|
||||
:symbol (/ ':token ,capture-sym)
|
||||
:keyword (/ '(* ":" (any :symchars)) (constant :keyword))
|
||||
:constant (/ '(+ "true" "false" "nil") (constant :constant))
|
||||
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
|
||||
:string (/ ':bytes (constant :string))
|
||||
:buffer (/ '(* "@" :bytes) (constant :string))
|
||||
:long-bytes {:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
|
||||
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||
:long-string (/ ':long-bytes (constant :string))
|
||||
:long-buffer (/ '(* "@" :long-bytes) (constant :string))
|
||||
:number (/ (cmt ':token ,check-number) (constant :number))
|
||||
:raw-value (+ :comment :constant :number :keyword
|
||||
:string :buffer :long-string :long-buffer
|
||||
:parray :barray :ptuple :btuple :struct :dict :symbol)
|
||||
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
|
||||
:root (any :value)
|
||||
:root2 (any (* :value :value))
|
||||
:ptuple (* '"(" :root (+ '")" (error "")))
|
||||
:btuple (* '"[" :root (+ '"]" (error "")))
|
||||
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||
:parray (* '"@" :ptuple)
|
||||
:barray (* '"@" :btuple)
|
||||
:dict (* '"@" :struct)
|
||||
:main (+ :root (error ""))})
|
||||
|
||||
(def p (peg/compile grammar))
|
||||
|
||||
# Just make sure is valgrind clean.
|
||||
(def p (-> p make-image load-image))
|
||||
|
||||
(assert (peg/match p "abc") "complex peg grammar 1")
|
||||
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
|
||||
|
||||
(end-suite)
|
||||
327
tools/EnvVarUpdate.nsh
Normal file
327
tools/EnvVarUpdate.nsh
Normal file
@@ -0,0 +1,327 @@
|
||||
/**
|
||||
* EnvVarUpdate.nsh
|
||||
* : Environmental Variables: append, prepend, and remove entries
|
||||
*
|
||||
* WARNING: If you use StrFunc.nsh header then include it before this file
|
||||
* with all required definitions. This is to avoid conflicts
|
||||
*
|
||||
* Usage:
|
||||
* ${EnvVarUpdate} "ResultVar" "EnvVarName" "Action" "RegLoc" "PathString"
|
||||
*
|
||||
* Credits:
|
||||
* Version 1.0
|
||||
* * Cal Turney (turnec2)
|
||||
* * Amir Szekely (KiCHiK) and e-circ for developing the forerunners of this
|
||||
* function: AddToPath, un.RemoveFromPath, AddToEnvVar, un.RemoveFromEnvVar,
|
||||
* WriteEnvStr, and un.DeleteEnvStr
|
||||
* * Diego Pedroso (deguix) for StrTok
|
||||
* * Kevin English (kenglish_hi) for StrContains
|
||||
* * Hendri Adriaens (Smile2Me), Diego Pedroso (deguix), and Dan Fuhry
|
||||
* (dandaman32) for StrReplace
|
||||
*
|
||||
* Version 1.1 (compatibility with StrFunc.nsh)
|
||||
* * techtonik
|
||||
*
|
||||
* http://nsis.sourceforge.net/Environmental_Variables:_append%2C_prepend%2C_and_remove_entries
|
||||
*
|
||||
*/
|
||||
|
||||
|
||||
!ifndef ENVVARUPDATE_FUNCTION
|
||||
!define ENVVARUPDATE_FUNCTION
|
||||
!verbose push
|
||||
!verbose 3
|
||||
!include "LogicLib.nsh"
|
||||
!include "WinMessages.NSH"
|
||||
!include "StrFunc.nsh"
|
||||
|
||||
; ---- Fix for conflict if StrFunc.nsh is already includes in main file -----------------------
|
||||
!macro _IncludeStrFunction StrFuncName
|
||||
!ifndef ${StrFuncName}_INCLUDED
|
||||
${${StrFuncName}}
|
||||
!endif
|
||||
!ifndef Un${StrFuncName}_INCLUDED
|
||||
${Un${StrFuncName}}
|
||||
!endif
|
||||
!define un.${StrFuncName} "${Un${StrFuncName}}"
|
||||
!macroend
|
||||
|
||||
!insertmacro _IncludeStrFunction StrTok
|
||||
!insertmacro _IncludeStrFunction StrStr
|
||||
!insertmacro _IncludeStrFunction StrRep
|
||||
|
||||
; ---------------------------------- Macro Definitions ----------------------------------------
|
||||
!macro _EnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
|
||||
Push "${EnvVarName}"
|
||||
Push "${Action}"
|
||||
Push "${RegLoc}"
|
||||
Push "${PathString}"
|
||||
Call EnvVarUpdate
|
||||
Pop "${ResultVar}"
|
||||
!macroend
|
||||
!define EnvVarUpdate '!insertmacro "_EnvVarUpdateConstructor"'
|
||||
|
||||
!macro _unEnvVarUpdateConstructor ResultVar EnvVarName Action Regloc PathString
|
||||
Push "${EnvVarName}"
|
||||
Push "${Action}"
|
||||
Push "${RegLoc}"
|
||||
Push "${PathString}"
|
||||
Call un.EnvVarUpdate
|
||||
Pop "${ResultVar}"
|
||||
!macroend
|
||||
!define un.EnvVarUpdate '!insertmacro "_unEnvVarUpdateConstructor"'
|
||||
; ---------------------------------- Macro Definitions end-------------------------------------
|
||||
|
||||
;----------------------------------- EnvVarUpdate start----------------------------------------
|
||||
!define hklm_all_users 'HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment"'
|
||||
!define hkcu_current_user 'HKCU "Environment"'
|
||||
|
||||
!macro EnvVarUpdate UN
|
||||
|
||||
Function ${UN}EnvVarUpdate
|
||||
|
||||
Push $0
|
||||
Exch 4
|
||||
Exch $1
|
||||
Exch 3
|
||||
Exch $2
|
||||
Exch 2
|
||||
Exch $3
|
||||
Exch
|
||||
Exch $4
|
||||
Push $5
|
||||
Push $6
|
||||
Push $7
|
||||
Push $8
|
||||
Push $9
|
||||
Push $R0
|
||||
|
||||
/* After this point:
|
||||
-------------------------
|
||||
$0 = ResultVar (returned)
|
||||
$1 = EnvVarName (input)
|
||||
$2 = Action (input)
|
||||
$3 = RegLoc (input)
|
||||
$4 = PathString (input)
|
||||
$5 = Orig EnvVar (read from registry)
|
||||
$6 = Len of $0 (temp)
|
||||
$7 = tempstr1 (temp)
|
||||
$8 = Entry counter (temp)
|
||||
$9 = tempstr2 (temp)
|
||||
$R0 = tempChar (temp) */
|
||||
|
||||
; Step 1: Read contents of EnvVarName from RegLoc
|
||||
;
|
||||
; Check for empty EnvVarName
|
||||
${If} $1 == ""
|
||||
SetErrors
|
||||
DetailPrint "ERROR: EnvVarName is blank"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Check for valid Action
|
||||
${If} $2 != "A"
|
||||
${AndIf} $2 != "P"
|
||||
${AndIf} $2 != "R"
|
||||
SetErrors
|
||||
DetailPrint "ERROR: Invalid Action - must be A, P, or R"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
${If} $3 == HKLM
|
||||
ReadRegStr $5 ${hklm_all_users} $1 ; Get EnvVarName from all users into $5
|
||||
${ElseIf} $3 == HKCU
|
||||
ReadRegStr $5 ${hkcu_current_user} $1 ; Read EnvVarName from current user into $5
|
||||
${Else}
|
||||
SetErrors
|
||||
DetailPrint 'ERROR: Action is [$3] but must be "HKLM" or HKCU"'
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Check for empty PathString
|
||||
${If} $4 == ""
|
||||
SetErrors
|
||||
DetailPrint "ERROR: PathString is blank"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Make sure we've got some work to do
|
||||
${If} $5 == ""
|
||||
${AndIf} $2 == "R"
|
||||
SetErrors
|
||||
DetailPrint "$1 is empty - Nothing to remove"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
${EndIf}
|
||||
|
||||
; Step 2: Scrub EnvVar
|
||||
;
|
||||
StrCpy $0 $5 ; Copy the contents to $0
|
||||
; Remove spaces around semicolons (NOTE: spaces before the 1st entry or
|
||||
; after the last one are not removed here but instead in Step 3)
|
||||
${If} $0 != "" ; If EnvVar is not empty ...
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 " ;"
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 " ;" ";" ; Remove '<space>;'
|
||||
${Loop}
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 "; "
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 "; " ";" ; Remove ';<space>'
|
||||
${Loop}
|
||||
${Do}
|
||||
${${UN}StrStr} $7 $0 ";;"
|
||||
${If} $7 == ""
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
${${UN}StrRep} $0 $0 ";;" ";"
|
||||
${Loop}
|
||||
|
||||
; Remove a leading or trailing semicolon from EnvVar
|
||||
StrCpy $7 $0 1 0
|
||||
${If} $7 == ";"
|
||||
StrCpy $0 $0 "" 1 ; Change ';<EnvVar>' to '<EnvVar>'
|
||||
${EndIf}
|
||||
StrLen $6 $0
|
||||
IntOp $6 $6 - 1
|
||||
StrCpy $7 $0 1 $6
|
||||
${If} $7 == ";"
|
||||
StrCpy $0 $0 $6 ; Change ';<EnvVar>' to '<EnvVar>'
|
||||
${EndIf}
|
||||
; DetailPrint "Scrubbed $1: [$0]" ; Uncomment to debug
|
||||
${EndIf}
|
||||
|
||||
/* Step 3. Remove all instances of the target path/string (even if "A" or "P")
|
||||
$6 = bool flag (1 = found and removed PathString)
|
||||
$7 = a string (e.g. path) delimited by semicolon(s)
|
||||
$8 = entry counter starting at 0
|
||||
$9 = copy of $0
|
||||
$R0 = tempChar */
|
||||
|
||||
${If} $5 != "" ; If EnvVar is not empty ...
|
||||
StrCpy $9 $0
|
||||
StrCpy $0 ""
|
||||
StrCpy $8 0
|
||||
StrCpy $6 0
|
||||
|
||||
${Do}
|
||||
${${UN}StrTok} $7 $9 ";" $8 "0" ; $7 = next entry, $8 = entry counter
|
||||
|
||||
${If} $7 == "" ; If we've run out of entries,
|
||||
${ExitDo} ; were done
|
||||
${EndIf} ;
|
||||
|
||||
; Remove leading and trailing spaces from this entry (critical step for Action=Remove)
|
||||
${Do}
|
||||
StrCpy $R0 $7 1
|
||||
${If} $R0 != " "
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
StrCpy $7 $7 "" 1 ; Remove leading space
|
||||
${Loop}
|
||||
${Do}
|
||||
StrCpy $R0 $7 1 -1
|
||||
${If} $R0 != " "
|
||||
${ExitDo}
|
||||
${EndIf}
|
||||
StrCpy $7 $7 -1 ; Remove trailing space
|
||||
${Loop}
|
||||
${If} $7 == $4 ; If string matches, remove it by not appending it
|
||||
StrCpy $6 1 ; Set 'found' flag
|
||||
${ElseIf} $7 != $4 ; If string does NOT match
|
||||
${AndIf} $0 == "" ; and the 1st string being added to $0,
|
||||
StrCpy $0 $7 ; copy it to $0 without a prepended semicolon
|
||||
${ElseIf} $7 != $4 ; If string does NOT match
|
||||
${AndIf} $0 != "" ; and this is NOT the 1st string to be added to $0,
|
||||
StrCpy $0 $0;$7 ; append path to $0 with a prepended semicolon
|
||||
${EndIf} ;
|
||||
|
||||
IntOp $8 $8 + 1 ; Bump counter
|
||||
${Loop} ; Check for duplicates until we run out of paths
|
||||
${EndIf}
|
||||
|
||||
; Step 4: Perform the requested Action
|
||||
;
|
||||
${If} $2 != "R" ; If Append or Prepend
|
||||
${If} $6 == 1 ; And if we found the target
|
||||
DetailPrint "Target is already present in $1. It will be removed and"
|
||||
${EndIf}
|
||||
${If} $0 == "" ; If EnvVar is (now) empty
|
||||
StrCpy $0 $4 ; just copy PathString to EnvVar
|
||||
${If} $6 == 0 ; If found flag is either 0
|
||||
${OrIf} $6 == "" ; or blank (if EnvVarName is empty)
|
||||
DetailPrint "$1 was empty and has been updated with the target"
|
||||
${EndIf}
|
||||
${ElseIf} $2 == "A" ; If Append (and EnvVar is not empty),
|
||||
StrCpy $0 $0;$4 ; append PathString
|
||||
${If} $6 == 1
|
||||
DetailPrint "appended to $1"
|
||||
${Else}
|
||||
DetailPrint "Target was appended to $1"
|
||||
${EndIf}
|
||||
${Else} ; If Prepend (and EnvVar is not empty),
|
||||
StrCpy $0 $4;$0 ; prepend PathString
|
||||
${If} $6 == 1
|
||||
DetailPrint "prepended to $1"
|
||||
${Else}
|
||||
DetailPrint "Target was prepended to $1"
|
||||
${EndIf}
|
||||
${EndIf}
|
||||
${Else} ; If Action = Remove
|
||||
${If} $6 == 1 ; and we found the target
|
||||
DetailPrint "Target was found and removed from $1"
|
||||
${Else}
|
||||
DetailPrint "Target was NOT found in $1 (nothing to remove)"
|
||||
${EndIf}
|
||||
${If} $0 == ""
|
||||
DetailPrint "$1 is now empty"
|
||||
${EndIf}
|
||||
${EndIf}
|
||||
|
||||
; Step 5: Update the registry at RegLoc with the updated EnvVar and announce the change
|
||||
;
|
||||
ClearErrors
|
||||
${If} $3 == HKLM
|
||||
WriteRegExpandStr ${hklm_all_users} $1 $0 ; Write it in all users section
|
||||
${ElseIf} $3 == HKCU
|
||||
WriteRegExpandStr ${hkcu_current_user} $1 $0 ; Write it to current user section
|
||||
${EndIf}
|
||||
|
||||
IfErrors 0 +4
|
||||
MessageBox MB_OK|MB_ICONEXCLAMATION "Could not write updated $1 to $3"
|
||||
DetailPrint "Could not write updated $1 to $3"
|
||||
Goto EnvVarUpdate_Restore_Vars
|
||||
|
||||
; "Export" our change
|
||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||
|
||||
EnvVarUpdate_Restore_Vars:
|
||||
;
|
||||
; Restore the user's variables and return ResultVar
|
||||
Pop $R0
|
||||
Pop $9
|
||||
Pop $8
|
||||
Pop $7
|
||||
Pop $6
|
||||
Pop $5
|
||||
Pop $4
|
||||
Pop $3
|
||||
Pop $2
|
||||
Pop $1
|
||||
Push $0 ; Push my $0 (ResultVar)
|
||||
Exch
|
||||
Pop $0 ; Restore his $0
|
||||
|
||||
FunctionEnd
|
||||
|
||||
!macroend ; EnvVarUpdate UN
|
||||
!insertmacro EnvVarUpdate ""
|
||||
!insertmacro EnvVarUpdate "un."
|
||||
;----------------------------------- EnvVarUpdate end----------------------------------------
|
||||
|
||||
!verbose pop
|
||||
!endif
|
||||
@@ -1,55 +0,0 @@
|
||||
# A flexible templater for janet. Compiles
|
||||
# templates to janet functions that produce buffers.
|
||||
|
||||
(defn template
|
||||
"Compile a template string into a function"
|
||||
[source]
|
||||
|
||||
# State for compilation machine
|
||||
(def p (parser/new))
|
||||
(def forms @[])
|
||||
|
||||
(defn parse-chunk
|
||||
"Parse a string and push produced values to forms."
|
||||
[chunk]
|
||||
(parser/consume p chunk)
|
||||
(while (parser/has-more p)
|
||||
(array/push forms (parser/produce p)))
|
||||
(if (= :error (parser/status p))
|
||||
(error (parser/error p))))
|
||||
|
||||
(defn code-chunk
|
||||
"Parse all the forms in str and return them
|
||||
in a tuple prefixed with 'do."
|
||||
[str]
|
||||
(parse-chunk str)
|
||||
true)
|
||||
|
||||
(defn string-chunk
|
||||
"Insert string chunk into parser"
|
||||
[str]
|
||||
(parser/insert p str)
|
||||
(parse-chunk "")
|
||||
true)
|
||||
|
||||
# Run peg
|
||||
(def grammar
|
||||
~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
|
||||
:main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
|
||||
:main (any (+ :code-chunk :main-chunk (error "")))})
|
||||
(def parts (peg/match grammar source))
|
||||
|
||||
# Check errors in template and parser
|
||||
(unless parts (error "invalid template syntax"))
|
||||
(parse-chunk "\n")
|
||||
(case (parser/status p)
|
||||
:pending (error (string "unfinished parser state " (parser/state p)))
|
||||
:error (error (parser/error p)))
|
||||
|
||||
# Make ast from forms
|
||||
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||
|
||||
(def ctor (compile ast *env* source))
|
||||
(if-not (function? ctor)
|
||||
(error (string "could not compile template")))
|
||||
(ctor))
|
||||
190
tools/cook.janet
190
tools/cook.janet
@@ -1,190 +0,0 @@
|
||||
# Library to help build janet natives and other
|
||||
# build artifacts.
|
||||
|
||||
# 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 prefix (or (os/getenv "PREFIX") "/usr/local"))
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(def cmd (string ;args))
|
||||
(print cmd)
|
||||
(def res (os/shell cmd))
|
||||
(unless (zero? res)
|
||||
(error "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- needs-build
|
||||
[dest src]
|
||||
"Check if dest is older than src. Used for checking if a file should be updated."
|
||||
(def f (file/open dest))
|
||||
(if (not f) (break true))
|
||||
(file/close f)
|
||||
(let [mod-dest (os/stat dest :modified)
|
||||
mod-src (os/stat src :modified)]
|
||||
(< mod-dest mod-src)))
|
||||
|
||||
(defn- needs-build-some
|
||||
[f others]
|
||||
(some (partial needs-build f) others))
|
||||
|
||||
(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 prefix (if is-win "/D" "-D"))
|
||||
(if value
|
||||
(string prefix define "=" value)
|
||||
(string prefix 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))))
|
||||
|
||||
# Defaults
|
||||
(def OPTIMIZE 2)
|
||||
(def CC (if is-win "cl" "cc"))
|
||||
(def LD (if is-win
|
||||
"link"
|
||||
(string CC
|
||||
" -shared"
|
||||
(if is-mac " -undefined dynamic_lookup" ""))))
|
||||
(def CFLAGS (string
|
||||
(if is-win "/I" "-I")
|
||||
module/*syspath*
|
||||
(if is-win " /O" " -std=c99 -Wall -Wextra -fpic -O")
|
||||
OPTIMIZE))
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest]
|
||||
(def cc (or (opts :compiler) CC))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def defines (interpose " " (make-defines (or (opts :defines) {}))))
|
||||
(if (needs-build dest src)
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /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 (or (opts :linker) LD))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def lflags (or (opts :lflags) ""))
|
||||
(def olist (string/join objects " "))
|
||||
(if (needs-build-some target objects)
|
||||
(if is-win
|
||||
(shell ld " /DLL /OUT:" target " " olist " %JANET_PATH%\\janet.lib")
|
||||
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(when (needs-build dest source)
|
||||
(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/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)))
|
||||
|
||||
# Public
|
||||
|
||||
(defn make-native
|
||||
"Build a native binary. This is a shared library that can be loaded
|
||||
dynamically by a janet runtime."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(os/mkdir "build")
|
||||
(def sources (opt-table :source))
|
||||
(def name (opt-table :name))
|
||||
(loop [src :in sources]
|
||||
(compile-c opt-table src (object-name src)))
|
||||
(def objects (map object-name sources))
|
||||
(when-let [embedded (opt-table :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 opt-table c-src o-src)))
|
||||
(link-c opt-table (lib-name name) ;objects))
|
||||
|
||||
(defn clean
|
||||
"Remove all built artifacts."
|
||||
[]
|
||||
(rm "build"))
|
||||
|
||||
(defn make-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet form. This file can the be moved to any machine with
|
||||
a janet vm and the required dependencies and run there."
|
||||
[& opts]
|
||||
(error "Not Yet Implemented."))
|
||||
|
||||
(defn make-binary
|
||||
"Make a binary executable that can be run on the current platform. This function
|
||||
generates a self contained binary that can be run of the same architecture as the
|
||||
build machine, as the current janet vm will be packaged with the output binary."
|
||||
[& opts]
|
||||
(error "Not Yet Implemented."))
|
||||
@@ -103,7 +103,8 @@
|
||||
|
||||
# Generate parts and print them to stdout
|
||||
(def parts (seq [[k entry]
|
||||
:in (sort (pairs (table/getproto *env*)))
|
||||
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
|
||||
:when (symbol? k)
|
||||
:when (and (get entry :doc) (not (get entry :private)))]
|
||||
(emit-item k entry)))
|
||||
(print
|
||||
|
||||
@@ -1,198 +0,0 @@
|
||||
# Copyright (C) Calvin Rose 2019
|
||||
#
|
||||
# Takes in a janet string and colorizes for multiple
|
||||
# output formats.
|
||||
|
||||
# Constants for checking if symbols should be
|
||||
# highlighted.
|
||||
(def- core-env (table/getproto *env*))
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
'while true
|
||||
'def true
|
||||
'splice true
|
||||
'set true
|
||||
'break true
|
||||
'unquote true
|
||||
'quasiquote true
|
||||
'quote true
|
||||
'if true})
|
||||
|
||||
(defn check-number [text] (and (scan-number text) text))
|
||||
|
||||
(defn- make-grammar
|
||||
"Creates the grammar based on the paint function, which
|
||||
colorizes fragments of text."
|
||||
[paint]
|
||||
|
||||
(defn <-c
|
||||
"Peg rule for capturing and coloring a rule."
|
||||
[color what]
|
||||
~(/ (<- ,what) ,(partial paint color)))
|
||||
|
||||
(defn color-symbol
|
||||
"Color a symbol only if it is a core library binding or special."
|
||||
[text]
|
||||
(def sym (symbol text))
|
||||
(def should-color (or (specials sym) (core-env sym)))
|
||||
(paint (if should-color :coresym :symbol) text))
|
||||
|
||||
~{:ws (set " \t\r\f\n\v\0")
|
||||
:readermac (set "';~,")
|
||||
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
|
||||
:token (some :symchars)
|
||||
:hex (range "09" "af" "AF")
|
||||
:escape (* "\\" (+ (set "ntrvzf0\"\\e")
|
||||
(* "x" :hex :hex)
|
||||
(error (constant "bad hex escape"))))
|
||||
|
||||
:comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1))))
|
||||
|
||||
:symbol (/ ':token ,color-symbol)
|
||||
:keyword ,(<-c :keyword ~(* ":" (any :symchars)))
|
||||
:constant ,(<-c :constant ~(+ "true" "false" "nil"))
|
||||
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
|
||||
:string ,(<-c :string :bytes)
|
||||
:buffer ,(<-c :string ~(* "@" :bytes))
|
||||
:long-bytes {:delim (some "`")
|
||||
:open (capture :delim :n)
|
||||
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
|
||||
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||
:long-string ,(<-c :string :long-bytes)
|
||||
:long-buffer ,(<-c :string ~(* "@" :long-bytes))
|
||||
:number (/ (cmt ':token ,check-number) ,(partial paint :number))
|
||||
|
||||
:raw-value (+ :comment :constant :number :keyword
|
||||
:string :buffer :long-string :long-buffer
|
||||
:parray :barray :ptuple :btuple :struct :dict :symbol)
|
||||
|
||||
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
|
||||
:root (any :value)
|
||||
:root2 (any (* :value :value))
|
||||
:ptuple (* '"(" :root (+ '")" (error "")))
|
||||
:btuple (* '"[" :root (+ '"]" (error "")))
|
||||
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||
:parray (* '"@" :ptuple)
|
||||
:barray (* '"@" :btuple)
|
||||
:dict (* '"@" :struct)
|
||||
|
||||
:main (+ (% :root) (error ""))})
|
||||
|
||||
# Terminal syntax highlighting
|
||||
|
||||
(def- terminal-colors
|
||||
{:number 32
|
||||
:keyword 33
|
||||
:string 35
|
||||
:coresym 31
|
||||
:constant 34
|
||||
:comment 36})
|
||||
|
||||
(defn- terminal-paint
|
||||
"Paint colors for ansi terminals"
|
||||
[what str]
|
||||
(def code (get terminal-colors what))
|
||||
(if code (string "\e[" code "m" str "\e[0m") str))
|
||||
|
||||
# HTML syntax highlighting
|
||||
|
||||
(def- html-colors
|
||||
{:number "j-number"
|
||||
:keyword "j-keyword"
|
||||
:string "j-string"
|
||||
:coresym "j-coresym"
|
||||
:constant "j-constant"
|
||||
:comment "j-comment"
|
||||
:line "j-line"})
|
||||
|
||||
(def- escapes
|
||||
{38 "&"
|
||||
60 "<"
|
||||
62 ">"
|
||||
34 """
|
||||
39 "'"
|
||||
47 "/"})
|
||||
|
||||
(def html-style
|
||||
"Style tag to add to a page to highlight janet code"
|
||||
```
|
||||
<style type="text/css">
|
||||
.j-main { color: white; background: #111; font-size: 1.4em; }
|
||||
.j-number { color: #89dc76; }
|
||||
.j-keyword { color: #ffd866; }
|
||||
.j-string { color: #ab90f2; }
|
||||
.j-coresym { color: #ff6188; }
|
||||
.j-constant { color: #fc9867; }
|
||||
.j-comment { color: darkgray; }
|
||||
.j-line { color: gray; }
|
||||
</style>
|
||||
```)
|
||||
|
||||
(defn html-escape
|
||||
"Escape special characters for HTML encoding."
|
||||
[str]
|
||||
(def buf @"")
|
||||
(loop [byte :in str]
|
||||
(if-let [rep (get escapes byte)]
|
||||
(buffer/push-string buf rep)
|
||||
(buffer/push-byte buf byte)))
|
||||
buf)
|
||||
|
||||
(defn- html-paint
|
||||
"Paint colors for HTML"
|
||||
[what str]
|
||||
(def color (get html-colors what))
|
||||
(def escaped (html-escape str))
|
||||
(if color
|
||||
(string "<span class=\"" color "\">" escaped "</span>")
|
||||
escaped))
|
||||
|
||||
# Create Pegs
|
||||
|
||||
(def- terminal-grammar (peg/compile (make-grammar terminal-paint)))
|
||||
(def- html-grammar (peg/compile (make-grammar html-paint)))
|
||||
|
||||
# API
|
||||
|
||||
(defn ansi
|
||||
"Highlight janet source code ANSI Termianl escape colors."
|
||||
[source]
|
||||
(0 (peg/match terminal-grammar source)))
|
||||
|
||||
(defn html
|
||||
"Highlight janet source code and output HTML."
|
||||
[source]
|
||||
(string "<pre class=\"j-main\"><code>"
|
||||
(0 (peg/match html-grammar source))
|
||||
"</code></pre>"))
|
||||
|
||||
(defn html-file
|
||||
"Highlight a janet file and print out a highlighted HTML version
|
||||
of the file. Must provide a default title when creating the file."
|
||||
[in-path out-path title &]
|
||||
(default title in-path)
|
||||
(def f (file/open in-path :r))
|
||||
(def source (file/read f :all))
|
||||
(file/close f)
|
||||
(def markup (0 (peg/match html-grammar source)))
|
||||
(def out (file/open out-path :w))
|
||||
(file/write out
|
||||
"<!doctype html><html><head><meta charset=\"UTF-8\">"
|
||||
html-style
|
||||
"<title>"
|
||||
title
|
||||
"</title></head>"
|
||||
"<body class=\"j-main\"><pre>"
|
||||
markup
|
||||
"</pre></body></html>")
|
||||
(file/close out))
|
||||
|
||||
(defn ansi-file
|
||||
"Highlight a janet file and print the highlighted output to stdout."
|
||||
[in-path]
|
||||
(def f (file/open in-path :r))
|
||||
(def source (file/read f :all))
|
||||
(file/close f)
|
||||
(def markup (0 (peg/match terminal-grammar source)))
|
||||
(print markup))
|
||||
4
tools/jpm.bat
Normal file
4
tools/jpm.bat
Normal file
@@ -0,0 +1,4 @@
|
||||
@echo off
|
||||
@rem Wrapper arounf jpm
|
||||
|
||||
janet %~dp0\jpm.janet %*
|
||||
@@ -2,6 +2,25 @@
|
||||
# Used to help build the tmLanguage grammar. Emits
|
||||
# the entire .tmLanguage file for janet.
|
||||
|
||||
# Use dynamic binding and make this the first
|
||||
# expression in the file to not pollute (all-bindings)
|
||||
(setdyn :allsyms
|
||||
(array/concat
|
||||
@["break"
|
||||
"def"
|
||||
"do"
|
||||
"var"
|
||||
"set"
|
||||
"fn"
|
||||
"while"
|
||||
"if"
|
||||
"quote"
|
||||
"quasiquote"
|
||||
"unquote"
|
||||
"splice"]
|
||||
(all-bindings)))
|
||||
(def allsyms (dyn :allsyms))
|
||||
|
||||
(def grammar-template
|
||||
`````
|
||||
<?xml version="1.0" encoding="UTF-8"?>
|
||||
@@ -343,22 +362,6 @@
|
||||
|
||||
# Now we generate the bindings in the language.
|
||||
|
||||
(def- specials
|
||||
@["break"
|
||||
"def"
|
||||
"do"
|
||||
"var"
|
||||
"set"
|
||||
"fn"
|
||||
"while"
|
||||
"if"
|
||||
"quote"
|
||||
"quasiquote"
|
||||
"unquote"
|
||||
"splice"])
|
||||
|
||||
(def allsyms (array/concat @[] specials (all-bindings)))
|
||||
|
||||
(def- escapes
|
||||
{(get "|" 0) `\|`
|
||||
(get "-" 0) `\-`
|
||||
|
||||
Reference in New Issue
Block a user