mirror of
https://github.com/janet-lang/janet
synced 2025-11-24 11:14:48 +00:00
Compare commits
1 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
be89d10004 |
2
.gitattributes
vendored
2
.gitattributes
vendored
@@ -0,0 +1,2 @@
|
|||||||
|
# Use an approximate language for syntax highlighting (clojure is pretty close)
|
||||||
|
*.janet linguist-language=clojure
|
||||||
|
|||||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -20,9 +20,6 @@ dist
|
|||||||
.project
|
.project
|
||||||
.cproject
|
.cproject
|
||||||
|
|
||||||
# Gnome Builder
|
|
||||||
.buildconfig
|
|
||||||
|
|
||||||
# Local directory for testing
|
# Local directory for testing
|
||||||
local
|
local
|
||||||
|
|
||||||
|
|||||||
111
CHANGELOG.md
111
CHANGELOG.md
@@ -1,115 +1,8 @@
|
|||||||
# Changelog
|
# Changelog
|
||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## 1.4.0 - 2019-10-14
|
## 0.6.0 - ??
|
||||||
- Add `quit` function to exit from a repl, but not always exit the entire
|
|
||||||
application.
|
|
||||||
- Add `update-pkgs` to jpm.
|
|
||||||
- Integrate jpm with https://github.com/janet-lang/pkgs.git. jpm can now
|
|
||||||
install packages based on their short names in the package listing, which
|
|
||||||
can be customized via an env variable.
|
|
||||||
- Add `varfn` macro
|
|
||||||
- Add compile time arity checking when function in function call is known.
|
|
||||||
- Added `slice` to the core library.
|
|
||||||
- The `*/slice` family of functions now can take nil as start or end to get
|
|
||||||
the same behavior as the defaults (0 and -1) for those parameters.
|
|
||||||
- `string/` functions that take a pattern to search for will throw an error
|
|
||||||
when receiving the empty string.
|
|
||||||
- Replace (start:end) style stacktrace source position information with
|
|
||||||
line, column. This should be more readable for humans. Also, range information
|
|
||||||
can be recovered by re-parsing source.
|
|
||||||
|
|
||||||
## 1.3.1 - 2019-09-21
|
|
||||||
- Fix some linking issues when creating executables with native dependencies.
|
|
||||||
- jpm now runs each test script in a new interpreter.
|
|
||||||
- Fix an issue that prevent some valid programs from compiling.
|
|
||||||
- Add `mean` to core.
|
|
||||||
- Abstract types that implement the `:+`, `:-`, `:*`, `:/`, `:>`, `:==`, `:<`,
|
|
||||||
`:<=`, and `:>=` methods will work with the corresponding built-in
|
|
||||||
arithmetic functions. This means built-in integer types can now be used as
|
|
||||||
normal number values in many contexts.
|
|
||||||
- Allow (length x) on typed arrays an other abstract types that implement
|
|
||||||
the :length method.
|
|
||||||
|
|
||||||
## 1.3.0 - 2019-09-05
|
|
||||||
- Add `get-in`, `put-in`, `update-in`, and `freeze` to core.
|
|
||||||
- Add `jpm run rule` and `jpm rules` to jpm to improve utility and discoverability of jpm.
|
|
||||||
- Remove `cook` module and move `path` module to https://github.com/janet-lang/path.git.
|
|
||||||
The functionality in `cook` is now bundled directly in the `jpm` script.
|
|
||||||
- Add `buffer/format` and `string/format` format flags `Q` and `q` to print colored and
|
|
||||||
non-colored single-line values, similar to `P` and `p`.
|
|
||||||
- Change default repl to print long sequences on one line and color stacktraces if color is enabled.
|
|
||||||
- Add `backmatch` pattern for PEGs.
|
|
||||||
- jpm detects if not in a Developer Command prompt on windows for a better error message.
|
|
||||||
- jpm install git submodules in dependencies
|
|
||||||
- Change default fiber stack limit to the maximum value of a 32 bit signed integer.
|
|
||||||
- Some bug fixes with `jpm`
|
|
||||||
- Fix bugs with pegs.
|
|
||||||
- Add `os/arch` to get ISA that janet was compiled for
|
|
||||||
- Add color to stacktraces via `(dyn :err-color)`
|
|
||||||
|
|
||||||
## 1.2.0 - 2019-08-08
|
|
||||||
- Add `take` and `drop` functions that are easier to use compared to the
|
|
||||||
existing slice functions.
|
|
||||||
- Add optional default value to `get`.
|
|
||||||
- Add function literal short-hand via `|` reader macro, which maps to the
|
|
||||||
`short-fn` macro.
|
|
||||||
- Add `int?` and `nat?` functions to the core.
|
|
||||||
- Add `(dyn :executable)` at top level to get what used to be
|
|
||||||
`(process/args 0)`.
|
|
||||||
- Add `:linux` to platforms returned by `(os/which)`.
|
|
||||||
- Update jpm to build standalone executables. Use `declare-executable` for this.
|
|
||||||
- Add `use` macro.
|
|
||||||
- Remove `process/args` in favor of `(dyn :args)`.
|
|
||||||
- Fix bug with Nanbox implementation allowing users to created
|
|
||||||
custom values of any type with typed array and marshal modules, which
|
|
||||||
was unsafe.
|
|
||||||
- Add `janet_wrap_number_safe` to API, for converting numbers to Janets
|
|
||||||
where the number could be any 64 bit, user provided bit pattern. Certain
|
|
||||||
NaN values (which a machine will never generate as a result of a floating
|
|
||||||
point operation) are guarded against and converted to a default NaN value.
|
|
||||||
|
|
||||||
## 1.1.0 - 2019-07-08
|
|
||||||
- Change semantics of `-l` flag to be import rather than dofile.
|
|
||||||
- Fix compiler regression in top level defs with destructuring.
|
|
||||||
- Add `table/clone`.
|
|
||||||
- Improve `jpm` tool with git and dependency capabilities, as well as better
|
|
||||||
module uninstalls.
|
|
||||||
|
|
||||||
## 1.0.0 - 2019-07-01
|
|
||||||
- Add `with` macro for resource handling.
|
|
||||||
- Add `propagate` function so we can "rethrow" signals after they are
|
|
||||||
intercepted. This makes signals even more flexible.
|
|
||||||
- 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.
|
- Add `jpm` tool for building and managing projects.
|
||||||
- Change interface to `cook` tool.
|
- Change interface to `cook` tool.
|
||||||
- Add optional filters to `module/paths` to further refine import methods.
|
- Add optional filters to `module/paths` to further refine import methods.
|
||||||
@@ -188,7 +81,7 @@ All notable changes to this project will be documented in this file.
|
|||||||
- Disallow NaNs as table or struct keys
|
- Disallow NaNs as table or struct keys
|
||||||
- Update module resolution paths and format
|
- Update module resolution paths and format
|
||||||
|
|
||||||
## 0.3.0 - 2019-01-26
|
## 0.3.0 - 2019-26-01
|
||||||
- Add amalgamated build to janet for easier embedding.
|
- Add amalgamated build to janet for easier embedding.
|
||||||
- Add os/date function
|
- Add os/date function
|
||||||
- Add slurp and spit to core library.
|
- Add slurp and spit to core library.
|
||||||
|
|||||||
92
Makefile
92
Makefile
@@ -24,37 +24,32 @@
|
|||||||
|
|
||||||
PREFIX?=/usr/local
|
PREFIX?=/usr/local
|
||||||
|
|
||||||
INCLUDEDIR?=$(PREFIX)/include
|
INCLUDEDIR=$(PREFIX)/include
|
||||||
BINDIR?=$(PREFIX)/bin
|
BINDIR=$(PREFIX)/bin
|
||||||
LIBDIR?=$(PREFIX)/lib
|
LIBDIR=$(PREFIX)/lib
|
||||||
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
JANET_BUILD?="\"$(shell git log --pretty=format:'%h' -n 1)\""
|
||||||
CLIBS=-lm
|
CLIBS=-lm
|
||||||
JANET_TARGET=build/janet
|
JANET_TARGET=build/janet
|
||||||
JANET_LIBRARY=build/libjanet.so
|
JANET_LIBRARY=build/libjanet.so
|
||||||
JANET_STATIC_LIBRARY=build/libjanet.a
|
JANET_STATIC_LIBRARY=build/libjanet.a
|
||||||
JANET_PATH?=$(LIBDIR)/janet
|
JANET_PATH?=$(PREFIX)/lib/janet
|
||||||
MANPATH?=$(PREFIX)/share/man/man1/
|
MANPATH?=$(PREFIX)/share/man/man1/
|
||||||
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
|
PKG_CONFIG_PATH?=$(PREFIX)/lib/pkgconfig
|
||||||
DEBUGGER=gdb
|
DEBUGGER=gdb
|
||||||
|
|
||||||
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden \
|
CFLAGS=-std=c99 -Wall -Wextra -Isrc/include -fpic -O2 -fvisibility=hidden \
|
||||||
-DJANET_BUILD=$(JANET_BUILD)
|
-DJANET_BUILD=$(JANET_BUILD)
|
||||||
LDFLAGS=-rdynamic
|
LDFLAGS=-rdynamic
|
||||||
|
|
||||||
# For installation
|
|
||||||
LDCONFIG:=ldconfig "$(LIBDIR)"
|
|
||||||
|
|
||||||
# Check OS
|
# Check OS
|
||||||
UNAME:=$(shell uname -s)
|
UNAME:=$(shell uname -s)
|
||||||
ifeq ($(UNAME), Darwin)
|
ifeq ($(UNAME), Darwin)
|
||||||
CLIBS:=$(CLIBS) -ldl
|
CLIBS:=$(CLIBS) -ldl
|
||||||
LDCONFIG:=
|
|
||||||
else ifeq ($(UNAME), Linux)
|
else ifeq ($(UNAME), Linux)
|
||||||
CLIBS:=$(CLIBS) -lrt -ldl
|
CLIBS:=$(CLIBS) -lrt -ldl
|
||||||
endif
|
endif
|
||||||
# For other unix likes, add flags here!
|
# For other unix likes, add flags here!
|
||||||
ifeq ($(UNAME),Haiku)
|
ifeq ($(UNAME),Haiku)
|
||||||
LDCONFIG:=
|
|
||||||
LDFLAGS=-Wl,--export-dynamic
|
LDFLAGS=-Wl,--export-dynamic
|
||||||
endif
|
endif
|
||||||
|
|
||||||
@@ -65,7 +60,7 @@ all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY)
|
|||||||
##### Name Files #####
|
##### Name Files #####
|
||||||
######################
|
######################
|
||||||
|
|
||||||
JANET_HEADERS=src/include/janet.h src/conf/janetconf.h
|
JANET_HEADERS=src/include/janet.h src/include/janetconf.h
|
||||||
|
|
||||||
JANET_LOCAL_HEADERS=src/core/util.h \
|
JANET_LOCAL_HEADERS=src/core/util.h \
|
||||||
src/core/state.h \
|
src/core/state.h \
|
||||||
@@ -140,7 +135,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
|||||||
|
|
||||||
# Now the reason we bootstrap in the first place
|
# Now the reason we bootstrap in the first place
|
||||||
build/core_image.c: build/janet_boot
|
build/core_image.c: build/janet_boot
|
||||||
build/janet_boot $@ JANET_PATH '$(JANET_PATH)' JANET_HEADERPATH '$(INCLUDEDIR)/janet'
|
build/janet_boot $@ JANET_PATH $(JANET_PATH) JANET_HEADERPATH $(INCLUDEDIR)/janet
|
||||||
|
|
||||||
##########################################################
|
##########################################################
|
||||||
##### The main interpreter program and shared object #####
|
##### The main interpreter program and shared object #####
|
||||||
@@ -170,7 +165,7 @@ $(JANET_STATIC_LIBRARY): $(JANET_CORE_OBJECTS)
|
|||||||
######################
|
######################
|
||||||
|
|
||||||
EMCC=emcc
|
EMCC=emcc
|
||||||
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -O2 \
|
EMCFLAGS=-std=c99 -Wall -Wextra -Isrc/include -O2 \
|
||||||
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
-s EXTRA_EXPORTED_RUNTIME_METHODS='["cwrap"]' \
|
||||||
-s ALLOW_MEMORY_GROWTH=1 \
|
-s ALLOW_MEMORY_GROWTH=1 \
|
||||||
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
-s AGGRESSIVE_VARIABLE_ELIMINATION=1 \
|
||||||
@@ -257,13 +252,10 @@ callgrind: $(JANET_TARGET)
|
|||||||
dist: build/janet-dist.tar.gz
|
dist: build/janet-dist.tar.gz
|
||||||
|
|
||||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||||
src/include/janet.h src/conf/janetconf.h \
|
src/include/janet.h src/include/janetconf.h \
|
||||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||||
build/doc.html README.md build/janet.c
|
build/doc.html README.md build/janet.c
|
||||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
tar -czvf $@ $^
|
||||||
mkdir -p build/$(JANET_DIST_DIR)
|
|
||||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
|
||||||
cd build && tar -czvf ../$@ $(JANET_DIST_DIR)
|
|
||||||
|
|
||||||
#########################
|
#########################
|
||||||
##### Documentation #####
|
##### Documentation #####
|
||||||
@@ -280,8 +272,9 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
|||||||
|
|
||||||
SONAME=libjanet.so.1
|
SONAME=libjanet.so.1
|
||||||
|
|
||||||
.PHONY: build/janet.pc
|
.PHONY: $(PKG_CONFIG_PATH)/janet.pc
|
||||||
build/janet.pc: $(JANET_TARGET)
|
$(PKG_CONFIG_PATH)/janet.pc: $(JANET_TARGET)
|
||||||
|
mkdir -p $(PKG_CONFIG_PATH)
|
||||||
echo 'prefix=$(PREFIX)' > $@
|
echo 'prefix=$(PREFIX)' > $@
|
||||||
echo 'exec_prefix=$${prefix}' >> $@
|
echo 'exec_prefix=$${prefix}' >> $@
|
||||||
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
echo 'includedir=$(INCLUDEDIR)/janet' >> $@
|
||||||
@@ -295,34 +288,24 @@ build/janet.pc: $(JANET_TARGET)
|
|||||||
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
echo 'Libs: -L$${libdir} -ljanet $(LDFLAGS)' >> $@
|
||||||
echo 'Libs.private: $(CLIBS)' >> $@
|
echo 'Libs.private: $(CLIBS)' >> $@
|
||||||
|
|
||||||
install: $(JANET_TARGET) build/janet.pc
|
install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
|
||||||
mkdir -p '$(BINDIR)'
|
mkdir -p $(BINDIR)
|
||||||
cp $(JANET_TARGET) '$(BINDIR)/janet'
|
cp $(JANET_TARGET) $(BINDIR)/janet
|
||||||
mkdir -p '$(INCLUDEDIR)/janet'
|
mkdir -p $(INCLUDEDIR)/janet
|
||||||
cp -rf $(JANET_HEADERS) '$(INCLUDEDIR)/janet'
|
cp -rf $(JANET_HEADERS) $(INCLUDEDIR)/janet
|
||||||
mkdir -p '$(JANET_PATH)'
|
mkdir -p $(JANET_PATH)
|
||||||
mkdir -p '$(LIBDIR)'
|
mkdir -p $(LIBDIR)
|
||||||
cp $(JANET_LIBRARY) '$(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')'
|
cp $(JANET_LIBRARY) $(LIBDIR)/libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)')
|
||||||
cp $(JANET_STATIC_LIBRARY) '$(LIBDIR)/libjanet.a'
|
cp $(JANET_STATIC_LIBRARY) $(LIBDIR)/libjanet.a
|
||||||
ln -sf $(SONAME) '$(LIBDIR)/libjanet.so'
|
ln -sf $(SONAME) $(LIBDIR)/libjanet.so
|
||||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
|
||||||
cp -rf auxbin/* '$(BINDIR)'
|
cp tools/cook.janet $(JANET_PATH)
|
||||||
mkdir -p '$(MANPATH)'
|
cp tools/jpm $(BINDIR)/jpm
|
||||||
cp janet.1 '$(MANPATH)'
|
cp tools/highlight.janet $(JANET_PATH)
|
||||||
cp jpm.1 '$(MANPATH)'
|
cp tools/bars.janet $(JANET_PATH)
|
||||||
mkdir -p '$(PKG_CONFIG_PATH)'
|
mkdir -p $(MANPATH)
|
||||||
cp build/janet.pc '$(PKG_CONFIG_PATH)/janet.pc'
|
cp janet.1 $(MANPATH)
|
||||||
-$(LDCONFIG)
|
-ldconfig $(LIBDIR)
|
||||||
|
|
||||||
uninstall:
|
|
||||||
-rm '$(BINDIR)/janet'
|
|
||||||
-rm '$(BINDIR)/jpm'
|
|
||||||
-rm -rf '$(INCLUDEDIR)/janet'
|
|
||||||
-rm -rf '$(LIBDIR)'/libjanet.*
|
|
||||||
-rm '$(PKG_CONFIG_PATH)/janet.pc'
|
|
||||||
-rm '$(MANPATH)/janet.1'
|
|
||||||
-rm '$(MANPATH)/jpm.1'
|
|
||||||
# -rm -rf '$(JANET_PATH)'/* - err on the side of correctness here
|
|
||||||
|
|
||||||
#################
|
#################
|
||||||
##### Other #####
|
##### Other #####
|
||||||
@@ -339,12 +322,7 @@ clean:
|
|||||||
-rm -rf build vgcore.* callgrind.*
|
-rm -rf build vgcore.* callgrind.*
|
||||||
|
|
||||||
test-install:
|
test-install:
|
||||||
cd test/install \
|
cd test/install && rm -rf build && jpm build && jpm test
|
||||||
&& rm -rf build .cache .manifests \
|
|
||||||
&& jpm --verbose build \
|
|
||||||
&& jpm --verbose test \
|
|
||||||
&& build/testexec \
|
|
||||||
&& jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
|
|
||||||
|
|
||||||
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
build/embed_janet.o: build/janet.c $(JANET_HEADERS)
|
||||||
$(CC) $(CFLAGS) -c $< -o $@
|
$(CC) $(CFLAGS) -c $< -o $@
|
||||||
@@ -356,5 +334,9 @@ build/embed_test: build/embed_janet.o build/embed_main.o
|
|||||||
test-amalg: build/embed_test
|
test-amalg: build/embed_test
|
||||||
./build/embed_test
|
./build/embed_test
|
||||||
|
|
||||||
|
uninstall:
|
||||||
|
-rm $(BINDIR)/../$(JANET_TARGET)
|
||||||
|
-rm -rf $(INCLUDEDIR)
|
||||||
|
|
||||||
.PHONY: clean install repl debug valgrind test amalg \
|
.PHONY: clean install repl debug valgrind test amalg \
|
||||||
valtest emscripten dist uninstall docs grammar format
|
valtest emscripten dist uninstall docs grammar format
|
||||||
|
|||||||
40
README.md
40
README.md
@@ -61,7 +61,7 @@ documentation for symbols in the core library. For example,
|
|||||||
Shows documentation for the doc macro.
|
Shows documentation for the doc macro.
|
||||||
|
|
||||||
To get a list of all bindings in the default
|
To get a list of all bindings in the default
|
||||||
environment, use the `(all-bindings)` function.
|
environment, use the `(all-symbols)` function.
|
||||||
|
|
||||||
## Source
|
## Source
|
||||||
|
|
||||||
@@ -73,8 +73,6 @@ the SourceHut mirror is actively maintained.
|
|||||||
|
|
||||||
### macos and Unix-like
|
### macos and Unix-like
|
||||||
|
|
||||||
The Makefile is non-portable and requires GNU-flavored make.
|
|
||||||
|
|
||||||
```
|
```
|
||||||
cd somewhere/my/projects/janet
|
cd somewhere/my/projects/janet
|
||||||
make
|
make
|
||||||
@@ -126,41 +124,12 @@ Building with emscripten on windows is currently unsupported.
|
|||||||
### Meson
|
### Meson
|
||||||
|
|
||||||
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
Janet also has a build file for [Meson](https://mesonbuild.com/), a cross platform build
|
||||||
system. Although Meson has a python dependency, Meson is a very complete build system that
|
system. This is not currently the main supported build system, but should work on any
|
||||||
is maybe more convenient and flexible for integrating into existing pipelines.
|
system that supports meson. Meson also provides much better IDE integration than Make or batch files.
|
||||||
Meson also provides much better IDE integration than Make or batch files, as well as support
|
|
||||||
for cross compilation.
|
|
||||||
|
|
||||||
For the impatient, building with Meson is as simple as follows. The options provided to
|
|
||||||
`meson setup` below emulate Janet's Makefile.
|
|
||||||
|
|
||||||
```sh
|
|
||||||
git clone https://github.com/janet-lang/janet.git
|
|
||||||
cd janet
|
|
||||||
meson setup build \
|
|
||||||
--buildtype release \
|
|
||||||
--optimization 2 \
|
|
||||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
|
||||||
ninja -C build
|
|
||||||
|
|
||||||
# Run the binary
|
|
||||||
build/janet
|
|
||||||
|
|
||||||
# Installation
|
|
||||||
ninja -C build install
|
|
||||||
```
|
|
||||||
|
|
||||||
## Development
|
|
||||||
|
|
||||||
Janet can be hacked on with pretty much any environment you like, but for IDE
|
|
||||||
lovers, [Gnome Builder](https://wiki.gnome.org/Apps/Builder) is probably the
|
|
||||||
best option, as it has excellent meson integration. It also offers code completion
|
|
||||||
for Janet's C API right out of the box, which is very useful for exploring.
|
|
||||||
|
|
||||||
## Installation
|
## Installation
|
||||||
|
|
||||||
See [the Introduction](https://janet-lang.org/introduction.html) for more details. If you just want
|
See [the Introduction](https://janet-lang.org/introduction.html) for more details.
|
||||||
to try out the language, you don't need to install anything. You can also simply move the `janet` executable wherever you want on your system and run it.
|
|
||||||
|
|
||||||
## Usage
|
## Usage
|
||||||
|
|
||||||
@@ -232,3 +201,4 @@ ensue.
|
|||||||
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
Janet is named after the almost omniscient and friendly artificial being in [The Good Place](https://en.wikipedia.org/wiki/The_Good_Place).
|
||||||
|
|
||||||
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-the-good-place.gif" alt="Janet logo" width="115px" align="left">
|
||||||
|
|
||||||
|
|||||||
43
appveyor.yml
43
appveyor.yml
@@ -1,7 +1,7 @@
|
|||||||
version: build-{build}
|
version: build-{build}
|
||||||
clone_folder: c:\projects\janet
|
clone_folder: c:\projects\janet
|
||||||
image:
|
image:
|
||||||
- Visual Studio 2019
|
- Visual Studio 2017
|
||||||
configuration:
|
configuration:
|
||||||
- Release
|
- Release
|
||||||
- Debug
|
- Debug
|
||||||
@@ -15,38 +15,25 @@ matrix:
|
|||||||
|
|
||||||
# skip unsupported combinations
|
# skip unsupported combinations
|
||||||
init:
|
init:
|
||||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars32.bat"
|
- call "C:\Program Files (x86)\Microsoft Visual Studio\2017\Community\VC\Auxiliary\Build\vcvars64.bat"
|
||||||
|
|
||||||
install:
|
install:
|
||||||
- set JANET_BUILD=%appveyor_repo_commit:~0,7%
|
- build_win
|
||||||
|
- build_win test
|
||||||
- choco install nsis -y -pre
|
- choco install nsis -y -pre
|
||||||
# Replace makensis.exe and files with special long string build. This should
|
- build_win dist
|
||||||
# prevent issues when setting PATH during installation.
|
- call "C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
||||||
- 7z e "tools\nsis-3.04-strlen_8192.zip" -o"C:\Program Files (x86)\NSIS\" -y
|
|
||||||
- build_win all
|
|
||||||
- refreshenv
|
|
||||||
# We need to reload vcvars after refreshing
|
|
||||||
- call "C:\Program Files (x86)\Microsoft Visual Studio\2019\Community\VC\Auxiliary\Build\vcvars32.bat"
|
|
||||||
- build_win test-install
|
|
||||||
- set janet_outname=%appveyor_repo_tag_name%
|
|
||||||
- if "%janet_outname%"=="" set janet_outname=v1.4.0
|
|
||||||
build: off
|
build: off
|
||||||
|
|
||||||
|
only_commits:
|
||||||
|
files:
|
||||||
|
- appveyor.yml
|
||||||
|
- src/
|
||||||
|
|
||||||
artifacts:
|
artifacts:
|
||||||
- name: janet.c
|
- path: janet-installer.exe
|
||||||
path: dist\janet.c
|
name: janet-windows-installer.exe
|
||||||
type: File
|
|
||||||
- name: janet.h
|
|
||||||
path: dist\janet.h
|
|
||||||
type: File
|
|
||||||
- name: janetconf.h
|
|
||||||
path: dist\janetconf.h
|
|
||||||
type: File
|
|
||||||
- name: "janet-$(janet_outname)-windows"
|
|
||||||
path: dist
|
|
||||||
type: Zip
|
|
||||||
- path: "janet-$(janet_outname)-windows-installer.exe"
|
|
||||||
name: "janet-$(janet_outname)-windows-installer.exe"
|
|
||||||
type: File
|
type: File
|
||||||
|
|
||||||
deploy:
|
deploy:
|
||||||
@@ -54,7 +41,7 @@ deploy:
|
|||||||
provider: GitHub
|
provider: GitHub
|
||||||
auth_token:
|
auth_token:
|
||||||
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
|
secure: lwEXy09qhj2jSH9s1C/KvCkAUqJSma8phFR+0kbsfUc3rVxpNK5uD3z9Md0SjYRx
|
||||||
artifact: /janet.*/
|
artifact: janet-windows
|
||||||
draft: true
|
draft: true
|
||||||
on:
|
on:
|
||||||
APPVEYOR_REPO_TAG: true
|
APPVEYOR_REPO_TAG: true
|
||||||
|
|||||||
939
auxbin/jpm
939
auxbin/jpm
@@ -1,939 +0,0 @@
|
|||||||
#!/usr/bin/env janet
|
|
||||||
|
|
||||||
# CLI tool for building janet projects.
|
|
||||||
|
|
||||||
#
|
|
||||||
# Basic Path Settings
|
|
||||||
#
|
|
||||||
|
|
||||||
# Windows is the OS outlier
|
|
||||||
(def- is-win (= (os/which) :windows))
|
|
||||||
(def- is-mac (= (os/which) :macos))
|
|
||||||
(def- sep (if is-win "\\" "/"))
|
|
||||||
(def- objext (if is-win ".obj" ".o"))
|
|
||||||
(def- modext (if is-win ".dll" ".so"))
|
|
||||||
(def- statext (if is-win ".static.lib" ".a"))
|
|
||||||
(def- absprefix (if is-win "C:\\" "/"))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Rule Engine
|
|
||||||
#
|
|
||||||
|
|
||||||
(defn- getrules []
|
|
||||||
(if-let [rules (dyn :rules)] rules (setdyn :rules @{})))
|
|
||||||
|
|
||||||
(defn- gettarget [target]
|
|
||||||
(def item ((getrules) target))
|
|
||||||
(unless item (error (string "No rule for target " target)))
|
|
||||||
item)
|
|
||||||
|
|
||||||
(defn- rule-impl
|
|
||||||
[target deps thunk &opt phony]
|
|
||||||
(put (getrules) target @[(array/slice deps) thunk phony]))
|
|
||||||
|
|
||||||
(defmacro rule
|
|
||||||
"Add a rule to the rule graph."
|
|
||||||
[target deps & body]
|
|
||||||
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
|
||||||
|
|
||||||
(defmacro phony
|
|
||||||
"Add a phony rule to the rule graph. A phony rule will run every time
|
|
||||||
(it is always considered out of date). Phony rules are good for defining
|
|
||||||
user facing tasks."
|
|
||||||
[target deps & body]
|
|
||||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
|
||||||
|
|
||||||
(defn add-dep
|
|
||||||
"Add a dependency to an existing rule. Useful for extending phony
|
|
||||||
rules or extending the dependency graph of existing rules."
|
|
||||||
[target dep]
|
|
||||||
(def [deps] (gettarget target))
|
|
||||||
(array/push deps dep))
|
|
||||||
|
|
||||||
(defn- add-thunk
|
|
||||||
[target more]
|
|
||||||
(def item (gettarget target))
|
|
||||||
(def [_ thunk] item)
|
|
||||||
(put item 1 (fn [] (more) (thunk))))
|
|
||||||
|
|
||||||
(defmacro add-body
|
|
||||||
"Add recipe code to an existing rule. This makes existing rules do more but
|
|
||||||
does not modify the dependency graph."
|
|
||||||
[target & body]
|
|
||||||
~(,add-thunk ,target (fn [] ,;body)))
|
|
||||||
|
|
||||||
(defn- needs-build
|
|
||||||
[dest src]
|
|
||||||
(let [mod-dest (os/stat dest :modified)
|
|
||||||
mod-src (os/stat src :modified)]
|
|
||||||
(< mod-dest mod-src)))
|
|
||||||
|
|
||||||
(defn- needs-build-some
|
|
||||||
[dest sources]
|
|
||||||
(def f (file/open dest))
|
|
||||||
(if (not f) (break true))
|
|
||||||
(file/close f)
|
|
||||||
(some (partial needs-build dest) sources))
|
|
||||||
|
|
||||||
(defn do-rule
|
|
||||||
"Evaluate a given rule."
|
|
||||||
[target]
|
|
||||||
(def item ((getrules) target))
|
|
||||||
(unless item
|
|
||||||
(if (os/stat target :mode)
|
|
||||||
(break target)
|
|
||||||
(error (string "No rule for file " target " found."))))
|
|
||||||
(def [deps thunk phony] item)
|
|
||||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
|
||||||
(when (or phony (needs-build-some target realdeps))
|
|
||||||
(thunk))
|
|
||||||
(unless phony target))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Configuration
|
|
||||||
#
|
|
||||||
|
|
||||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
|
||||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
|
||||||
(if-let [j (dyn :syspath)]
|
|
||||||
(string j "/../../include/janet"))))
|
|
||||||
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
|
||||||
(if-let [j (dyn :syspath)]
|
|
||||||
(string j "/../../bin"))))
|
|
||||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
|
||||||
(if-let [j (dyn :syspath)]
|
|
||||||
(string j "/.."))))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Compilation Defaults
|
|
||||||
#
|
|
||||||
|
|
||||||
(def default-compiler (if is-win "cl" "cc"))
|
|
||||||
(def default-linker (if is-win "link" "cc"))
|
|
||||||
(def default-archiver (if is-win "lib" "ar"))
|
|
||||||
|
|
||||||
# Default flags for natives, but not required
|
|
||||||
(def default-lflags (if is-win ["/nologo"] []))
|
|
||||||
(def default-cflags
|
|
||||||
(if is-win
|
|
||||||
["/nologo"]
|
|
||||||
["-std=c99" "-Wall" "-Wextra"]))
|
|
||||||
|
|
||||||
# Required flags for dynamic libraries. These
|
|
||||||
# are used no matter what for dynamic libraries.
|
|
||||||
(def- dynamic-cflags
|
|
||||||
(if is-win
|
|
||||||
[]
|
|
||||||
["-fPIC"]))
|
|
||||||
(def- dynamic-lflags
|
|
||||||
(if is-win
|
|
||||||
["/DLL"]
|
|
||||||
(if is-mac
|
|
||||||
["-shared" "-undefined" "dynamic_lookup"]
|
|
||||||
["-shared"])))
|
|
||||||
|
|
||||||
(defn- opt
|
|
||||||
"Get an option, allowing overrides via dynamic bindings AND some
|
|
||||||
default value dflt if no dynamic binding is set."
|
|
||||||
[opts key dflt]
|
|
||||||
(def ret (or (opts key) (dyn key dflt)))
|
|
||||||
(if (= nil ret)
|
|
||||||
(error (string "option :" key " not set")))
|
|
||||||
ret)
|
|
||||||
|
|
||||||
(defn check-cc
|
|
||||||
"Ensure we have a c compiler"
|
|
||||||
[]
|
|
||||||
(if is-win
|
|
||||||
(do
|
|
||||||
(if (os/getenv "INCLUDE") (break))
|
|
||||||
(error "Run jpm inside a Developer Command Prompt.
|
|
||||||
jpm needs a c compiler to compile natives. You can install the MSVC compiler from
|
|
||||||
microsoft.com"))
|
|
||||||
(do)))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Importing a file
|
|
||||||
#
|
|
||||||
|
|
||||||
(def- _env (fiber/getenv (fiber/current)))
|
|
||||||
|
|
||||||
(defn- proto-flatten
|
|
||||||
[into x]
|
|
||||||
(when x
|
|
||||||
(proto-flatten into (table/getproto x))
|
|
||||||
(loop [k :keys x]
|
|
||||||
(put into k (x k))))
|
|
||||||
into)
|
|
||||||
|
|
||||||
(defn import-rules
|
|
||||||
"Import another file that defines more rules. This ruleset
|
|
||||||
is merged into the current ruleset."
|
|
||||||
[path]
|
|
||||||
(def env (make-env))
|
|
||||||
(unless (os/stat path :mode)
|
|
||||||
(error (string "cannot open " path)))
|
|
||||||
(loop [k :keys _env :when (symbol? k)]
|
|
||||||
(unless ((_env k) :private) (put env k (_env k))))
|
|
||||||
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
|
|
||||||
(loop [k :keys currenv :when (keyword? k)]
|
|
||||||
(put env k (currenv k)))
|
|
||||||
(dofile path :env env :exit true)
|
|
||||||
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
|
||||||
|
|
||||||
#
|
|
||||||
# OS and shell helpers
|
|
||||||
#
|
|
||||||
|
|
||||||
(def- path-splitter
|
|
||||||
"split paths on / and \\."
|
|
||||||
(peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1)))))
|
|
||||||
|
|
||||||
(def- filepath-replacer
|
|
||||||
"Convert url with potential bad characters into a file path element."
|
|
||||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
|
||||||
|
|
||||||
(defn filepath-replace
|
|
||||||
"Remove special characters from a string or path
|
|
||||||
to make it into a path segment."
|
|
||||||
[repo]
|
|
||||||
(get (peg/match filepath-replacer repo) 0))
|
|
||||||
|
|
||||||
(defn shell
|
|
||||||
"Do a shell command"
|
|
||||||
[& args]
|
|
||||||
(if (dyn :verbose)
|
|
||||||
(print ;(interpose " " args)))
|
|
||||||
(def res (os/execute args :p))
|
|
||||||
(unless (zero? res)
|
|
||||||
(error (string "command exited with status " res))))
|
|
||||||
|
|
||||||
(defn rm
|
|
||||||
"Remove a directory and all sub directories."
|
|
||||||
[path]
|
|
||||||
(if (= (os/stat path :mode) :directory)
|
|
||||||
(do
|
|
||||||
(each subpath (os/dir path)
|
|
||||||
(rm (string path sep subpath)))
|
|
||||||
(os/rmdir path))
|
|
||||||
(os/rm path)))
|
|
||||||
|
|
||||||
(defn copy
|
|
||||||
"Copy a file or directory recursively from one location to another."
|
|
||||||
[src dest]
|
|
||||||
(print "copying " src " to " dest "...")
|
|
||||||
(if is-win
|
|
||||||
(shell "xcopy" src dest "/y" "/s" "/e")
|
|
||||||
(shell "cp" "-rf" src dest)))
|
|
||||||
|
|
||||||
#
|
|
||||||
# C Compilation
|
|
||||||
#
|
|
||||||
|
|
||||||
(defn- embed-name
|
|
||||||
"Rename a janet symbol for embedding."
|
|
||||||
[path]
|
|
||||||
(->> path
|
|
||||||
(string/replace-all "\\" "___")
|
|
||||||
(string/replace-all "/" "___")
|
|
||||||
(string/replace-all ".janet" "")))
|
|
||||||
|
|
||||||
(defn- out-path
|
|
||||||
"Take a source file path and convert it to an output path."
|
|
||||||
[path from-ext to-ext]
|
|
||||||
(->> path
|
|
||||||
(string/replace-all "\\" "___")
|
|
||||||
(string/replace-all "/" "___")
|
|
||||||
(string/replace-all from-ext to-ext)
|
|
||||||
(string "build" sep)))
|
|
||||||
|
|
||||||
(defn- make-define
|
|
||||||
"Generate strings for adding custom defines to the compiler."
|
|
||||||
[define value]
|
|
||||||
(if value
|
|
||||||
(string (if is-win "/D" "-D") define "=" value)
|
|
||||||
(string (if is-win "/D" "-D") define)))
|
|
||||||
|
|
||||||
(defn- make-defines
|
|
||||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
|
||||||
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
|
||||||
[defines]
|
|
||||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
|
||||||
|
|
||||||
(defn- getcflags
|
|
||||||
"Generate the c flags from the input options."
|
|
||||||
[opts]
|
|
||||||
@[;(opt opts :cflags default-cflags)
|
|
||||||
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
|
|
||||||
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
|
|
||||||
|
|
||||||
(defn- entry-name
|
|
||||||
"Name of symbol that enters static compilation of a module."
|
|
||||||
[name]
|
|
||||||
(string "janet_module_entry_" (filepath-replace name)))
|
|
||||||
|
|
||||||
(defn- compile-c
|
|
||||||
"Compile a C file into an object file."
|
|
||||||
[opts src dest &opt static?]
|
|
||||||
(def cc (opt opts :compiler default-compiler))
|
|
||||||
(def cflags [;(getcflags opts) ;(if static? [] dynamic-cflags)])
|
|
||||||
(def entry-defines (if-let [n (opts :entry-name)]
|
|
||||||
[(make-define "JANET_ENTRY_NAME" n)]
|
|
||||||
[]))
|
|
||||||
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
|
|
||||||
(def headers (or (opts :headers) []))
|
|
||||||
(rule dest [src ;headers]
|
|
||||||
(check-cc)
|
|
||||||
(print "compiling " dest "...")
|
|
||||||
(if is-win
|
|
||||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
|
||||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
|
||||||
|
|
||||||
(defn- libjanet
|
|
||||||
"Find libjanet.a (or libjanet.lib on windows) at compile time"
|
|
||||||
[]
|
|
||||||
(def libpath (dyn :libpath JANET_LIBPATH))
|
|
||||||
(unless libpath
|
|
||||||
(error "cannot find libpath: provide --libpath or JANET_LIBPATH"))
|
|
||||||
(string (dyn :libpath JANET_LIBPATH)
|
|
||||||
sep
|
|
||||||
(if is-win "libjanet.lib" "libjanet.a")))
|
|
||||||
|
|
||||||
(defn- win-import-library
|
|
||||||
"On windows, an import library is needed to link to a dll statically."
|
|
||||||
[]
|
|
||||||
(def hpath (dyn :headerpath JANET_HEADERPATH))
|
|
||||||
(unless hpath
|
|
||||||
(error "cannot find headerpath: provide --headerpath or JANET_HEADERPATH"))
|
|
||||||
(string hpath `\\janet.lib`))
|
|
||||||
|
|
||||||
(defn- link-c
|
|
||||||
"Link object files together to make a native module."
|
|
||||||
[opts target & objects]
|
|
||||||
(def ld (opt opts :linker default-linker))
|
|
||||||
(def cflags (getcflags opts))
|
|
||||||
(def lflags [;(opt opts :lflags default-lflags)
|
|
||||||
;(if (opts :static) [] dynamic-lflags)])
|
|
||||||
(rule target objects
|
|
||||||
(check-cc)
|
|
||||||
(print "linking " target "...")
|
|
||||||
(if is-win
|
|
||||||
(shell ld ;lflags (string "/OUT:" target) ;objects (win-import-library))
|
|
||||||
(shell ld ;cflags `-o` target ;objects ;lflags))))
|
|
||||||
|
|
||||||
(defn- archive-c
|
|
||||||
"Link object files together to make a static library."
|
|
||||||
[opts target & objects]
|
|
||||||
(def ar (opt opts :archiver default-archiver))
|
|
||||||
(rule target objects
|
|
||||||
(check-cc)
|
|
||||||
(print "creating static library " target "...")
|
|
||||||
(if is-win
|
|
||||||
(shell ar "/nologo" (string "/out:" target) ;objects)
|
|
||||||
(shell ar "rcs" target ;objects))))
|
|
||||||
|
|
||||||
(defn- create-buffer-c-impl
|
|
||||||
[bytes dest name]
|
|
||||||
(def out (file/open dest :w))
|
|
||||||
(def chunks (seq [b :in bytes] (string b)))
|
|
||||||
(file/write out
|
|
||||||
"#include <janet.h>\n"
|
|
||||||
"static const unsigned char bytes[] = {"
|
|
||||||
(string/join (interpose ", " chunks))
|
|
||||||
"};\n\n"
|
|
||||||
"const unsigned char *" name "_embed = bytes;\n"
|
|
||||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
|
||||||
(file/close out))
|
|
||||||
|
|
||||||
(defn- create-buffer-c
|
|
||||||
"Inline raw byte file as a c file."
|
|
||||||
[source dest name]
|
|
||||||
(rule dest [source]
|
|
||||||
(print "generating " dest "...")
|
|
||||||
(with [f (file/open source :r)]
|
|
||||||
(create-buffer-c-impl (:read f :all) dest name))))
|
|
||||||
|
|
||||||
(def- root-env (table/getproto (fiber/getenv (fiber/current))))
|
|
||||||
|
|
||||||
(defn- modpath-to-meta
|
|
||||||
"Get the meta file path (.meta.janet) corresponding to a native module path (.so)."
|
|
||||||
[path]
|
|
||||||
(string (string/slice path 0 (- (length modext))) "meta.janet"))
|
|
||||||
|
|
||||||
(defn- modpath-to-static
|
|
||||||
"Get the static library (.a) path corresponding to a native module path (.so)."
|
|
||||||
[path]
|
|
||||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
|
||||||
|
|
||||||
(defn- create-executable
|
|
||||||
"Links an image with libjanet.a (or .lib) to produce an
|
|
||||||
executable. Also will try to link native modules into the
|
|
||||||
final executable as well."
|
|
||||||
[opts source dest]
|
|
||||||
|
|
||||||
# Create executable's janet image
|
|
||||||
(def cimage_dest (string dest ".c"))
|
|
||||||
(rule dest [source]
|
|
||||||
(check-cc)
|
|
||||||
(print "generating executable c source...")
|
|
||||||
# Load entry environment and get main function.
|
|
||||||
(def entry-env (dofile source))
|
|
||||||
(def main ((entry-env 'main) :value))
|
|
||||||
(def dep-lflags @[])
|
|
||||||
|
|
||||||
# Create marshalling dictionary
|
|
||||||
(def mdict (invert (env-lookup root-env)))
|
|
||||||
# Load all native modules
|
|
||||||
(def prefixes @{})
|
|
||||||
(def static-libs @[])
|
|
||||||
(loop [[name m] :pairs module/cache
|
|
||||||
:let [n (m :native)]
|
|
||||||
:when n
|
|
||||||
:let [prefix (gensym)]]
|
|
||||||
(print "found native " n "...")
|
|
||||||
(put prefixes prefix n)
|
|
||||||
(array/push static-libs (modpath-to-static n))
|
|
||||||
(def oldproto (table/getproto m))
|
|
||||||
(table/setproto m nil)
|
|
||||||
(loop [[sym value] :pairs (env-lookup m)]
|
|
||||||
(put mdict value (symbol prefix sym)))
|
|
||||||
(table/setproto m oldproto))
|
|
||||||
|
|
||||||
# Find static modules
|
|
||||||
(def declarations @"")
|
|
||||||
(def lookup-into-invocations @"")
|
|
||||||
(loop [[prefix name] :pairs prefixes]
|
|
||||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
|
||||||
(buffer/push-string lookup-into-invocations
|
|
||||||
" temptab = janet_table(0);\n"
|
|
||||||
" temptab->proto = env;\n"
|
|
||||||
" " (meta :static-entry) "(temptab);\n"
|
|
||||||
" janet_env_lookup_into(lookup, temptab, \""
|
|
||||||
prefix
|
|
||||||
"\", 0);\n\n")
|
|
||||||
(when-let [lfs (meta :lflags)]
|
|
||||||
(array/concat dep-lflags lfs))
|
|
||||||
(buffer/push-string declarations
|
|
||||||
"extern void "
|
|
||||||
(meta :static-entry)
|
|
||||||
"(JanetTable *);\n"))
|
|
||||||
|
|
||||||
|
|
||||||
# Build image
|
|
||||||
(def image (marshal main mdict))
|
|
||||||
# Make image byte buffer
|
|
||||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
|
||||||
# Append main function
|
|
||||||
(spit cimage_dest (string
|
|
||||||
"\n"
|
|
||||||
declarations
|
|
||||||
```
|
|
||||||
|
|
||||||
int main(int argc, const char **argv) {
|
|
||||||
janet_init();
|
|
||||||
|
|
||||||
/* Get core env */
|
|
||||||
JanetTable *env = janet_core_env(NULL);
|
|
||||||
JanetTable *lookup = janet_env_lookup(env);
|
|
||||||
JanetTable *temptab;
|
|
||||||
int handle = janet_gclock();
|
|
||||||
|
|
||||||
/* Load natives into unmarshalling dictionary */
|
|
||||||
|
|
||||||
```
|
|
||||||
lookup-into-invocations
|
|
||||||
```
|
|
||||||
/* Unmarshal bytecode */
|
|
||||||
Janet marsh_out = janet_unmarshal(
|
|
||||||
janet_payload_image_embed,
|
|
||||||
janet_payload_image_embed_size,
|
|
||||||
0,
|
|
||||||
lookup,
|
|
||||||
NULL);
|
|
||||||
|
|
||||||
/* Verify the marshalled object is a function */
|
|
||||||
if (!janet_checktype(marsh_out, JANET_FUNCTION)) {
|
|
||||||
fprintf(stderr, "invalid bytecode image - expected function.");
|
|
||||||
return 1;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Collect command line arguments */
|
|
||||||
JanetArray *args = janet_array(argc);
|
|
||||||
for (int i = 0; i < argc; i++) {
|
|
||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Create enviornment */
|
|
||||||
JanetTable *runtimeEnv = janet_table(0);
|
|
||||||
runtimeEnv->proto = env;
|
|
||||||
janet_table_put(runtimeEnv, janet_ckeywordv("args"), janet_wrap_array(args));
|
|
||||||
janet_gcroot(janet_wrap_table(runtimeEnv));
|
|
||||||
|
|
||||||
/* Unlock GC */
|
|
||||||
janet_gcunlock(handle);
|
|
||||||
|
|
||||||
/* Run everything */
|
|
||||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(marsh_out), 64, argc, args->data);
|
|
||||||
fiber->env = runtimeEnv;
|
|
||||||
Janet out;
|
|
||||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
|
||||||
if (result) {
|
|
||||||
janet_stacktrace(fiber, out);
|
|
||||||
janet_deinit();
|
|
||||||
return result;
|
|
||||||
}
|
|
||||||
janet_deinit();
|
|
||||||
return 0;
|
|
||||||
}
|
|
||||||
|
|
||||||
```) :ab)
|
|
||||||
|
|
||||||
# Compile and link final exectable
|
|
||||||
(do
|
|
||||||
(def extra-lflags (case (os/which)
|
|
||||||
:macos ["-ldl" "-lm"]
|
|
||||||
:windows []
|
|
||||||
:linux ["-lm" "-ldl" "-lrt"]
|
|
||||||
#default
|
|
||||||
["-lm"]))
|
|
||||||
(def cc (opt opts :compiler default-compiler))
|
|
||||||
(def lflags [;dep-lflags ;(opt opts :lflags default-lflags) ;extra-lflags])
|
|
||||||
(def cflags (getcflags opts))
|
|
||||||
(def defines (make-defines (opt opts :defines {})))
|
|
||||||
(print "compiling and linking " dest "...")
|
|
||||||
(if is-win
|
|
||||||
(shell cc ;cflags cimage_dest ;static-libs (libjanet) ;lflags `/link` (string "/OUT:" dest))
|
|
||||||
(shell cc ;cflags `-o` dest cimage_dest ;static-libs (libjanet) ;lflags)))))
|
|
||||||
|
|
||||||
(defn- abspath
|
|
||||||
"Create an absolute path. Does not resolve . and .. (useful for
|
|
||||||
generating entries in install manifest file)."
|
|
||||||
[path]
|
|
||||||
(if (if is-win
|
|
||||||
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
|
|
||||||
(string/has-prefix? "/" path))
|
|
||||||
path
|
|
||||||
(string (os/cwd) sep path)))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Public utilities
|
|
||||||
#
|
|
||||||
|
|
||||||
(defn find-manifest-dir
|
|
||||||
"Get the path to the directory containing manifests for installed
|
|
||||||
packages."
|
|
||||||
[]
|
|
||||||
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
|
|
||||||
|
|
||||||
(defn find-manifest
|
|
||||||
"Get the full path of a manifest file given a package name."
|
|
||||||
[name]
|
|
||||||
(string (find-manifest-dir) sep name ".txt"))
|
|
||||||
|
|
||||||
(defn find-cache
|
|
||||||
"Return the path to the global cache."
|
|
||||||
[]
|
|
||||||
(def path (dyn :modpath JANET_MODPATH))
|
|
||||||
(string path sep ".cache"))
|
|
||||||
|
|
||||||
(defn uninstall
|
|
||||||
"Uninstall bundle named name"
|
|
||||||
[name]
|
|
||||||
(def manifest (find-manifest name))
|
|
||||||
(def f (file/open manifest :r))
|
|
||||||
(unless f (print manifest " does not exist") (break))
|
|
||||||
(loop [line :iterate (:read f :line)]
|
|
||||||
(def path ((string/split "\n" line) 0))
|
|
||||||
(def path ((string/split "\r" path) 0))
|
|
||||||
(print "removing " path)
|
|
||||||
(try (rm path) ([err]
|
|
||||||
(unless (= err "No such file or directory")
|
|
||||||
(error err)))))
|
|
||||||
(:close f)
|
|
||||||
(print "removing " manifest)
|
|
||||||
(rm manifest)
|
|
||||||
(print "Uninstalled."))
|
|
||||||
|
|
||||||
(defn clear-cache
|
|
||||||
"Clear the global git cache."
|
|
||||||
[]
|
|
||||||
(def cache (find-cache))
|
|
||||||
(print "clearing " cache "...")
|
|
||||||
(if is-win
|
|
||||||
# Git for windows decided that .git should be hidden and everything in it read-only.
|
|
||||||
# This means we can't delete things easily.
|
|
||||||
(os/shell (string `rmdir /S /Q "` cache `"`))
|
|
||||||
(rm cache)))
|
|
||||||
|
|
||||||
(def- default-pkglist (or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
|
||||||
|
|
||||||
(defn install-git
|
|
||||||
"Install a bundle from git. If the bundle is already installed, the bundle
|
|
||||||
is reinistalled (but not rebuilt if artifacts are cached)."
|
|
||||||
[repotab &opt recurse]
|
|
||||||
(def repo (if (string? repotab) repotab (repotab :repo)))
|
|
||||||
(def tag (unless (string? repotab) (repotab :tag)))
|
|
||||||
# prevent infinite recursion (very unlikely, but consider
|
|
||||||
# 'my-package "my-package" in the package listing)
|
|
||||||
(when (> (or recurse 0) 100)
|
|
||||||
(error "too many references resolving package url"))
|
|
||||||
# Handle short names
|
|
||||||
(unless (string/find ":" repo)
|
|
||||||
(def pkgs
|
|
||||||
(try (require "pkgs")
|
|
||||||
([err f]
|
|
||||||
(install-git (dyn :pkglist default-pkglist))
|
|
||||||
(require "pkgs"))))
|
|
||||||
(def next-repo (get-in pkgs ['packages :value (symbol repo)]))
|
|
||||||
(unless next-repo
|
|
||||||
(error (string "package " repo " not found.")))
|
|
||||||
(unless (or (string? next-repo) (dictionary? next-repo))
|
|
||||||
(error (string "expected string or table for repository, got " next-repo)))
|
|
||||||
(break (install-git next-repo (if recurse (inc recurse) 0))))
|
|
||||||
(def cache (find-cache))
|
|
||||||
(os/mkdir cache)
|
|
||||||
(def id (filepath-replace repo))
|
|
||||||
(def module-dir (string cache sep id))
|
|
||||||
(var fresh false)
|
|
||||||
(when (os/mkdir module-dir)
|
|
||||||
(set fresh true)
|
|
||||||
(os/execute ["git" "clone" repo module-dir] :p))
|
|
||||||
(def olddir (os/cwd))
|
|
||||||
(try
|
|
||||||
(with-dyns [:rules @{}
|
|
||||||
:modpath (abspath (dyn :modpath JANET_MODPATH))
|
|
||||||
:headerpath (abspath (dyn :headerpath JANET_HEADERPATH))
|
|
||||||
:libpath (abspath (dyn :libpath JANET_LIBPATH))
|
|
||||||
:binpath (abspath (dyn :binpath JANET_BINPATH))]
|
|
||||||
(os/cd module-dir)
|
|
||||||
(unless fresh
|
|
||||||
(os/execute ["git" "pull" "origin" "master"] :p))
|
|
||||||
(when tag
|
|
||||||
(os/execute ["git" "reset" "--hard" tag] :p))
|
|
||||||
(os/execute ["git" "submodule" "update" "--init" "--recursive"] :p)
|
|
||||||
(import-rules "./project.janet")
|
|
||||||
(do-rule "install-deps")
|
|
||||||
(do-rule "build")
|
|
||||||
(do-rule "install"))
|
|
||||||
([err] (print "Error building git repository dependency: " err)))
|
|
||||||
(os/cd olddir))
|
|
||||||
|
|
||||||
(defn install-rule
|
|
||||||
"Add install and uninstall rule for moving file from src into destdir."
|
|
||||||
[src destdir]
|
|
||||||
(def parts (peg/match path-splitter src))
|
|
||||||
(def name (last parts))
|
|
||||||
(def path (string destdir sep name))
|
|
||||||
(array/push (dyn :installed-files) path)
|
|
||||||
(add-body "install"
|
|
||||||
(os/mkdir destdir)
|
|
||||||
(copy src destdir)))
|
|
||||||
|
|
||||||
#
|
|
||||||
# Declaring Artifacts - used in project.janet, targets specifically
|
|
||||||
# tailored for janet.
|
|
||||||
#
|
|
||||||
|
|
||||||
(defn declare-native
|
|
||||||
"Declare a native module. This is a shared library that can be loaded
|
|
||||||
dynamically by a janet runtime. This also builds a static libary that
|
|
||||||
can be used to bundle janet code and native into a single executable."
|
|
||||||
[&keys opts]
|
|
||||||
(def sources (opts :source))
|
|
||||||
(def name (opts :name))
|
|
||||||
(def path (dyn :modpath JANET_MODPATH))
|
|
||||||
|
|
||||||
# Make dynamic module
|
|
||||||
(def lname (string "build" sep name modext))
|
|
||||||
(loop [src :in sources]
|
|
||||||
(compile-c opts src (out-path src ".c" objext)))
|
|
||||||
(def objects (map (fn [path] (out-path path ".c" objext)) sources))
|
|
||||||
(when-let [embedded (opts :embedded)]
|
|
||||||
(loop [src :in embedded]
|
|
||||||
(def c-src (out-path src ".janet" ".janet.c"))
|
|
||||||
(def o-src (out-path src ".janet" (if is-win ".janet.obj" ".janet.o")))
|
|
||||||
(array/push objects o-src)
|
|
||||||
(create-buffer-c src c-src (embed-name src))
|
|
||||||
(compile-c opts c-src o-src)))
|
|
||||||
(link-c opts lname ;objects)
|
|
||||||
(add-dep "build" lname)
|
|
||||||
(install-rule lname path)
|
|
||||||
|
|
||||||
# Add meta file
|
|
||||||
(def metaname (modpath-to-meta lname))
|
|
||||||
(def ename (entry-name name))
|
|
||||||
(rule metaname []
|
|
||||||
(print "generating meta file " metaname "...")
|
|
||||||
(spit metaname (string/format
|
|
||||||
"# Metadata for static library %s\n\n%.20p"
|
|
||||||
(string name statext)
|
|
||||||
{:static-entry ename
|
|
||||||
:lflags (opts :lflags)})))
|
|
||||||
(add-dep "build" metaname)
|
|
||||||
(install-rule metaname path)
|
|
||||||
|
|
||||||
# Make static module
|
|
||||||
(unless (dyn :nostatic)
|
|
||||||
(def sname (string "build" sep name statext))
|
|
||||||
(def opts (merge @{:entry-name ename} opts))
|
|
||||||
(def sobjext (string ".static" objext))
|
|
||||||
(def sjobjext (string ".janet" sobjext))
|
|
||||||
(loop [src :in sources]
|
|
||||||
(compile-c opts src (out-path src ".c" sobjext) true))
|
|
||||||
(def sobjects (map (fn [path] (out-path path ".c" sobjext)) sources))
|
|
||||||
(when-let [embedded (opts :embedded)]
|
|
||||||
(loop [src :in embedded]
|
|
||||||
(def c-src (out-path src ".janet" ".janet.c"))
|
|
||||||
(def o-src (out-path src ".janet" sjobjext))
|
|
||||||
(array/push sobjects o-src)
|
|
||||||
# Buffer c-src is already declared by dynamic module
|
|
||||||
(compile-c opts c-src o-src true)))
|
|
||||||
(archive-c opts sname ;sobjects)
|
|
||||||
(add-dep "build" sname)
|
|
||||||
(install-rule sname path)))
|
|
||||||
|
|
||||||
(defn declare-source
|
|
||||||
"Create a Janet modules. This does not actually build the module(s),
|
|
||||||
but registers it for packaging and installation."
|
|
||||||
[&keys {:source sources}]
|
|
||||||
(def path (dyn :modpath JANET_MODPATH))
|
|
||||||
(if (bytes? sources)
|
|
||||||
(install-rule sources path)
|
|
||||||
(each s sources
|
|
||||||
(install-rule s path))))
|
|
||||||
|
|
||||||
(defn declare-bin
|
|
||||||
"Declare a generic file to be installed as an executable."
|
|
||||||
[&keys {:main main}]
|
|
||||||
(install-rule main (dyn :binpath JANET_BINPATH)))
|
|
||||||
|
|
||||||
(defn declare-executable
|
|
||||||
"Declare a janet file to be the entry of a standalone executable program. The entry
|
|
||||||
file is evaluated and a main function is looked for in the entry file. This function
|
|
||||||
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
|
|
||||||
This executable can be installed as well to the --binpath given."
|
|
||||||
[&keys {:install install :name name :entry entry :headers headers}]
|
|
||||||
(def name (if is-win (string name ".exe") name))
|
|
||||||
(def dest (string "build" sep name))
|
|
||||||
(create-executable @{} entry dest)
|
|
||||||
(add-dep "build" dest)
|
|
||||||
(when headers
|
|
||||||
(each h headers (add-dep dest h)))
|
|
||||||
(when install
|
|
||||||
(install-rule dest (dyn :binpath JANET_BINPATH))))
|
|
||||||
|
|
||||||
(defn declare-binscript
|
|
||||||
"Declare a janet file to be installed as an executable script. Creates
|
|
||||||
a shim on windows."
|
|
||||||
[&keys opts]
|
|
||||||
(def main (opts :main))
|
|
||||||
(def binpath (dyn :binpath JANET_BINPATH))
|
|
||||||
(install-rule main binpath)
|
|
||||||
# Create a dud batch file when on windows.
|
|
||||||
(when is-win
|
|
||||||
(def name (last (peg/match path-splitter main)))
|
|
||||||
(def fullname (string binpath sep name))
|
|
||||||
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
|
|
||||||
(def newname (string binpath sep name ".bat"))
|
|
||||||
(array/push (dyn :installed-files) newname)
|
|
||||||
(add-body "install"
|
|
||||||
(spit newname bat))))
|
|
||||||
|
|
||||||
(defn declare-archive
|
|
||||||
"Build a janet archive. This is a file that bundles together many janet
|
|
||||||
scripts into a janet image. This file can the be moved to any machine with
|
|
||||||
a janet vm and the required dependencies and run there."
|
|
||||||
[&keys opts]
|
|
||||||
(def entry (opts :entry))
|
|
||||||
(def name (opts :name))
|
|
||||||
(def iname (string "build" sep name ".jimage"))
|
|
||||||
(rule iname (or (opts :deps) [])
|
|
||||||
(spit iname (make-image (require entry))))
|
|
||||||
(def path (dyn :modpath JANET_MODPATH))
|
|
||||||
(add-dep "build" iname)
|
|
||||||
(install-rule iname path))
|
|
||||||
|
|
||||||
(defn declare-project
|
|
||||||
"Define your project metadata. This should
|
|
||||||
be the first declaration in a project.janet file.
|
|
||||||
Also sets up basic phony targets like clean, build, test, etc."
|
|
||||||
[&keys meta]
|
|
||||||
(setdyn :project meta)
|
|
||||||
|
|
||||||
(def installed-files @[])
|
|
||||||
(def manifests (find-manifest-dir))
|
|
||||||
(def manifest (find-manifest (meta :name)))
|
|
||||||
(setdyn :manifest manifest)
|
|
||||||
(setdyn :manifest-dir manifests)
|
|
||||||
(setdyn :installed-files installed-files)
|
|
||||||
|
|
||||||
(rule "./build" [] (os/mkdir "build"))
|
|
||||||
(phony "build" ["./build"])
|
|
||||||
|
|
||||||
(phony "manifest" []
|
|
||||||
(print "generating " manifest "...")
|
|
||||||
(os/mkdir manifests)
|
|
||||||
(spit manifest (string (string/join installed-files "\n") "\n")))
|
|
||||||
(phony "install" ["uninstall" "build" "manifest"]
|
|
||||||
(print "Installed as '" (meta :name) "'."))
|
|
||||||
|
|
||||||
(phony "install-deps" []
|
|
||||||
(if-let [deps (meta :dependencies)]
|
|
||||||
(each dep deps
|
|
||||||
(install-git dep))
|
|
||||||
(print "no dependencies found")))
|
|
||||||
|
|
||||||
(phony "uninstall" []
|
|
||||||
(uninstall (meta :name)))
|
|
||||||
|
|
||||||
(phony "clean" []
|
|
||||||
(when (os/stat "./build" :mode)
|
|
||||||
(rm "build")
|
|
||||||
(print "Deleted build directory.")))
|
|
||||||
|
|
||||||
(phony "test" ["build"]
|
|
||||||
(defn dodir
|
|
||||||
[dir]
|
|
||||||
(each sub (sort (os/dir dir))
|
|
||||||
(def ndir (string dir sep sub))
|
|
||||||
(case (os/stat ndir :mode)
|
|
||||||
:file (when (string/has-suffix? ".janet" ndir)
|
|
||||||
(print "running " ndir " ...")
|
|
||||||
(def result (os/execute [(dyn :executable "janet") ndir] :p))
|
|
||||||
(when (not= 0 result)
|
|
||||||
(os/exit result)))
|
|
||||||
:directory (dodir ndir))))
|
|
||||||
(dodir "test")
|
|
||||||
(print "All tests passed.")))
|
|
||||||
|
|
||||||
#
|
|
||||||
# CLI
|
|
||||||
#
|
|
||||||
|
|
||||||
(def- argpeg
|
|
||||||
(peg/compile
|
|
||||||
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
|
|
||||||
|
|
||||||
(defn- local-rule
|
|
||||||
[rule]
|
|
||||||
(import-rules "./project.janet")
|
|
||||||
(do-rule rule))
|
|
||||||
|
|
||||||
(defn- help
|
|
||||||
[]
|
|
||||||
(print `
|
|
||||||
usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
|
|
||||||
|
|
||||||
Run from a directory containing a project.janet file to perform operations
|
|
||||||
on a project, or from anywhere to do operations on the global module cache (modpath).
|
|
||||||
|
|
||||||
Subcommands are:
|
|
||||||
build : build all artifacts
|
|
||||||
help : show this help text
|
|
||||||
install (repo or name) : install artifacts. If a repo is given, install the contents of that
|
|
||||||
git repository, assuming that the repository is a jpm project. If not, build
|
|
||||||
and install the current project.
|
|
||||||
uninstall (module) : uninstall a module. If no module is given, uninstall the module
|
|
||||||
defined by the current directory.
|
|
||||||
clean : remove any generated files or artifacts
|
|
||||||
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
|
|
||||||
deps : install dependencies for the current project.
|
|
||||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
|
||||||
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
|
|
||||||
or (rule "ouput.file" [deps...] ...).
|
|
||||||
rules : list rules available with run.
|
|
||||||
update-pkgs : Update the current package listing from the remote git repository selected.
|
|
||||||
|
|
||||||
Keys are:
|
|
||||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
|
|
||||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
|
|
||||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
|
||||||
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
|
|
||||||
--compiler : C compiler to use for natives. Defaults to cc (cl on windows).
|
|
||||||
--archiver : C compiler to use for static libraries. Defaults to ar (lib on windows).
|
|
||||||
--linker : C linker to use for linking natives. Defaults to cc (link on windows).
|
|
||||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
|
||||||
|
|
||||||
Flags are:
|
|
||||||
--verbose : Print shell commands as they are executed.
|
|
||||||
`))
|
|
||||||
|
|
||||||
(defn- show-help
|
|
||||||
[]
|
|
||||||
(print help))
|
|
||||||
|
|
||||||
(defn- build
|
|
||||||
[]
|
|
||||||
(local-rule "build"))
|
|
||||||
|
|
||||||
(defn- clean
|
|
||||||
[]
|
|
||||||
(local-rule "clean"))
|
|
||||||
|
|
||||||
(defn- install
|
|
||||||
[&opt repo]
|
|
||||||
(if repo
|
|
||||||
(install-git repo)
|
|
||||||
(local-rule "install")))
|
|
||||||
|
|
||||||
(defn- test
|
|
||||||
[]
|
|
||||||
(local-rule "test"))
|
|
||||||
|
|
||||||
(defn- uninstall-cmd
|
|
||||||
[&opt what]
|
|
||||||
(if what
|
|
||||||
(uninstall what)
|
|
||||||
(local-rule "uninstall")))
|
|
||||||
|
|
||||||
(defn- deps
|
|
||||||
[]
|
|
||||||
(local-rule "install-deps"))
|
|
||||||
|
|
||||||
(defn- list-rules
|
|
||||||
[]
|
|
||||||
(import-rules "./project.janet")
|
|
||||||
(def ks (sort (seq [k :keys (dyn :rules)] k)))
|
|
||||||
(each k ks (print k)))
|
|
||||||
|
|
||||||
(defn- update-pkgs
|
|
||||||
[]
|
|
||||||
(install-git (dyn :pkglist default-pkglist)))
|
|
||||||
|
|
||||||
(def- subcommands
|
|
||||||
{"build" build
|
|
||||||
"clean" clean
|
|
||||||
"help" show-help
|
|
||||||
"install" install
|
|
||||||
"test" test
|
|
||||||
"help" help
|
|
||||||
"deps" deps
|
|
||||||
"clear-cache" clear-cache
|
|
||||||
"run" local-rule
|
|
||||||
"rules" list-rules
|
|
||||||
"update-pkgs" update-pkgs
|
|
||||||
"uninstall" uninstall-cmd})
|
|
||||||
|
|
||||||
(def- args (tuple/slice (dyn :args) 1))
|
|
||||||
(def- len (length args))
|
|
||||||
(var i :private 0)
|
|
||||||
|
|
||||||
# Get flags
|
|
||||||
(while (< i len)
|
|
||||||
(if-let [m (peg/match argpeg (args i))]
|
|
||||||
(if (= 2 (length m))
|
|
||||||
(let [[key value] m]
|
|
||||||
(setdyn (keyword key) value))
|
|
||||||
(setdyn (keyword (m 0)) true))
|
|
||||||
(break))
|
|
||||||
(++ i))
|
|
||||||
|
|
||||||
# Run subcommand
|
|
||||||
(if (= i len)
|
|
||||||
(help)
|
|
||||||
(do
|
|
||||||
(if-let [com (subcommands (args i))]
|
|
||||||
(com ;(tuple/slice args (+ i 1)))
|
|
||||||
(do
|
|
||||||
(print "invalid command " (args i))
|
|
||||||
(help)))))
|
|
||||||
@@ -13,20 +13,11 @@
|
|||||||
@if "%1"=="clean" goto CLEAN
|
@if "%1"=="clean" goto CLEAN
|
||||||
@if "%1"=="test" goto TEST
|
@if "%1"=="test" goto TEST
|
||||||
@if "%1"=="dist" goto DIST
|
@if "%1"=="dist" goto DIST
|
||||||
@if "%1"=="install" goto INSTALL
|
|
||||||
@if "%1"=="test-install" goto TESTINSTALL
|
|
||||||
@if "%1"=="all" goto ALL
|
|
||||||
|
|
||||||
@rem Set compile and link options here
|
@rem Set compile and link options here
|
||||||
@setlocal
|
@setlocal
|
||||||
@set JANET_COMPILE=cl /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS
|
@set JANET_COMPILE=cl /nologo /Isrc\include /c /O2 /W3 /LD /D_CRT_SECURE_NO_WARNINGS
|
||||||
@set JANET_LINK=link /nologo
|
@set JANET_LINK=link /nologo
|
||||||
@set JANET_LINK_STATIC=lib /nologo
|
|
||||||
|
|
||||||
@rem Add janet build tag
|
|
||||||
if not "%JANET_BUILD%" == "" (
|
|
||||||
@set JANET_COMPILE=%JANET_COMPILE% /DJANET_BUILD="\"%JANET_BUILD%\""
|
|
||||||
)
|
|
||||||
|
|
||||||
mkdir build
|
mkdir build
|
||||||
mkdir build\core
|
mkdir build\core
|
||||||
@@ -34,30 +25,30 @@ mkdir build\mainclient
|
|||||||
mkdir build\boot
|
mkdir build\boot
|
||||||
|
|
||||||
@rem Build the xxd tool for generating sources
|
@rem Build the xxd tool for generating sources
|
||||||
cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
@cl /nologo /c tools/xxd.c /Fobuild\xxd.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
link /nologo /out:build\xxd.exe build\xxd.obj
|
@link /nologo /out:build\xxd.exe build\xxd.obj
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Generate the embedded sources
|
@rem Generate the embedded sources
|
||||||
build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
@build\xxd.exe src\mainclient\init.janet build\init.gen.c janet_gen_init
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
@build\xxd.exe src\boot\boot.janet build\boot.gen.c janet_gen_boot
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the generated sources
|
@rem Build the generated sources
|
||||||
%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
@%JANET_COMPILE% /Fobuild\mainclient\init.gen.obj build\init.gen.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
@%JANET_COMPILE% /Fobuild\boot\boot.gen.obj build\boot.gen.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the bootstrap interpreter
|
@rem Build the bootstrap interpretter
|
||||||
for %%f in (src\core\*.c) do (
|
for %%f in (src\core\*.c) do (
|
||||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
for %%f in (src\boot\*.c) do (
|
for %%f in (src\boot\*.c) do (
|
||||||
%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
@%JANET_COMPILE% /DJANET_BOOTSTRAP /Fobuild\boot\%%~nf.obj %%f
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||||
@@ -65,12 +56,12 @@ for %%f in (src\boot\*.c) do (
|
|||||||
build\janet_boot build\core_image.c
|
build\janet_boot build\core_image.c
|
||||||
|
|
||||||
@rem Build the core image
|
@rem Build the core image
|
||||||
%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
@%JANET_COMPILE% /Fobuild\core_image.obj build\core_image.c
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build the sources
|
@rem Build the sources
|
||||||
for %%f in (src\core\*.c) do (
|
for %%f in (src\core\*.c) do (
|
||||||
%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
@%JANET_COMPILE% /Fobuild\core\%%~nf.obj %%f
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -79,7 +70,7 @@ rc /nologo /fobuild\janet_win.res janet_win.rc
|
|||||||
|
|
||||||
@rem Build the main client
|
@rem Build the main client
|
||||||
for %%f in (src\mainclient\*.c) do (
|
for %%f in (src\mainclient\*.c) do (
|
||||||
%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
@%JANET_COMPILE% /Fobuild\mainclient\%%~nf.obj %%f
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -87,10 +78,6 @@ for %%f in (src\mainclient\*.c) do (
|
|||||||
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
%JANET_LINK% /out:janet.exe build\core\*.obj build\mainclient\*.obj build\core_image.obj build\janet_win.res
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
@if errorlevel 1 goto :BUILDFAIL
|
||||||
|
|
||||||
@rem Build static library (libjanet.a)
|
|
||||||
%JANET_LINK_STATIC% /out:build\libjanet.lib build\core\*.obj build\core_image.obj
|
|
||||||
@if errorlevel 1 goto :BUILDFAIL
|
|
||||||
|
|
||||||
@rem Gen amlag
|
@rem Gen amlag
|
||||||
setlocal enabledelayedexpansion
|
setlocal enabledelayedexpansion
|
||||||
set "amalg_files="
|
set "amalg_files="
|
||||||
@@ -98,7 +85,6 @@ for %%f in (src\core\*.c) do (
|
|||||||
set "amalg_files=!amalg_files! %%f"
|
set "amalg_files=!amalg_files! %%f"
|
||||||
)
|
)
|
||||||
janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
janet.exe tools\amalg.janet src\core\util.h src\core\state.h src\core\gc.h src\core\vector.h src\core\fiber.h src\core\regalloc.h src\core\compile.h src\core\emit.h src\core\symcache.h %amalg_files% build\core_image.c > build\janet.c
|
||||||
janet.exe tools\removecr.janet build\janet.c
|
|
||||||
|
|
||||||
echo === Successfully built janet.exe for Windows ===
|
echo === Successfully built janet.exe for Windows ===
|
||||||
echo === Run 'build_win test' to run tests. ==
|
echo === Run 'build_win test' to run tests. ==
|
||||||
@@ -121,16 +107,15 @@ exit /b 0
|
|||||||
|
|
||||||
@rem Clean build artifacts
|
@rem Clean build artifacts
|
||||||
:CLEAN
|
:CLEAN
|
||||||
del *.exe *.lib *.exp
|
del janet.exe janet.exp janet.lib
|
||||||
rd /s /q build
|
rd /s /q build
|
||||||
rd /s /q dist
|
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
@rem Run tests
|
@rem Run tests
|
||||||
:TEST
|
:TEST
|
||||||
for %%f in (test/suite*.janet) do (
|
for %%f in (test/suite*.janet) do (
|
||||||
janet.exe test\%%f
|
janet.exe test\%%f
|
||||||
@if errorlevel 1 goto TESTFAIL
|
@if errorlevel 1 goto :TESTFAIL
|
||||||
)
|
)
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
@@ -138,60 +123,19 @@ exit /b 0
|
|||||||
:DIST
|
:DIST
|
||||||
mkdir dist
|
mkdir dist
|
||||||
janet.exe tools\gendoc.janet > dist\doc.html
|
janet.exe tools\gendoc.janet > dist\doc.html
|
||||||
janet.exe tools\removecr.janet dist\doc.html
|
|
||||||
|
|
||||||
copy build\janet.c dist\janet.c
|
copy build\janet.c dist\janet.c
|
||||||
copy janet.exe dist\janet.exe
|
copy janet.exe dist\janet.exe
|
||||||
copy LICENSE dist\LICENSE
|
copy LICENSE dist\LICENSE
|
||||||
copy README.md dist\README.md
|
copy README.md dist\README.md
|
||||||
|
|
||||||
copy janet.lib dist\janet.lib
|
copy janet.lib dist\janet.lib
|
||||||
copy janet.exp dist\janet.exp
|
copy janet.exp dist\janet.exp
|
||||||
|
|
||||||
copy src\include\janet.h dist\janet.h
|
copy src\include\janet.h dist\janet.h
|
||||||
copy src\conf\janetconf.h dist\janetconf.h
|
copy src\include\janetconf.h dist\janetconf.h
|
||||||
copy build\libjanet.lib dist\libjanet.lib
|
copy tools\cook.janet dist\cook.janet
|
||||||
|
copy tools\highlight.janet dist\highlight.janet
|
||||||
copy auxbin\jpm dist\jpm
|
copy tools\jpm dist\jpm
|
||||||
copy tools\jpm.bat dist\jpm.bat
|
copy tools\jpm.bat dist\jpm.bat
|
||||||
|
|
||||||
@rem Create installer
|
|
||||||
"C:\Program Files (x86)\NSIS\makensis.exe" janet-installer.nsi
|
|
||||||
exit /b 0
|
|
||||||
|
|
||||||
@rem Run the installer. (Installs to the local user with default settings)
|
|
||||||
:INSTALL
|
|
||||||
@echo Running Installer...
|
|
||||||
FOR %%a in (janet-*-windows-installer.exe) DO (
|
|
||||||
%%a /S /CurrentUser
|
|
||||||
)
|
|
||||||
exit /b 0
|
|
||||||
|
|
||||||
@rem Test the installation.
|
|
||||||
:TESTINSTALL
|
|
||||||
pushd test\install
|
|
||||||
call jpm clean
|
|
||||||
@if errorlevel 1 goto :TESTFAIL
|
|
||||||
call jpm test
|
|
||||||
@if errorlevel 1 goto :TESTFAIL
|
|
||||||
call jpm --verbose --modpath=. install https://github.com/janet-lang/json.git
|
|
||||||
@if errorlevel 1 goto :TESTFAIL
|
|
||||||
call build\testexec
|
|
||||||
@if errorlevel 1 goto :TESTFAIL
|
|
||||||
popd
|
|
||||||
exit /b 0
|
|
||||||
|
|
||||||
@rem build, test, dist, install. Useful for local dev.
|
|
||||||
:ALL
|
|
||||||
call %0 build
|
|
||||||
@if errorlevel 1 exit /b 1
|
|
||||||
call %0 test
|
|
||||||
@if errorlevel 1 exit /b 1
|
|
||||||
call %0 dist
|
|
||||||
@if errorlevel 1 exit /b 1
|
|
||||||
call %0 install
|
|
||||||
@if errorlevel 1 exit /b 1
|
|
||||||
@echo Done!
|
|
||||||
exit /b 0
|
exit /b 0
|
||||||
|
|
||||||
:TESTFAIL
|
:TESTFAIL
|
||||||
|
|||||||
@@ -1,66 +1,20 @@
|
|||||||
# Version
|
|
||||||
!define VERSION "1.4.0"
|
|
||||||
!define PRODUCT_VERSION "${VERSION}.0"
|
|
||||||
VIProductVersion "${PRODUCT_VERSION}"
|
|
||||||
VIFileVersion "${PRODUCT_VERSION}"
|
|
||||||
|
|
||||||
# Use the modern UI
|
# Use the modern UI
|
||||||
!define MULTIUSER_EXECUTIONLEVEL Highest
|
!define MULTIUSER_EXECUTIONLEVEL Highest
|
||||||
!define MULTIUSER_MUI
|
!define MULTIUSER_MUI
|
||||||
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
!define MULTIUSER_INSTALLMODE_COMMANDLINE
|
||||||
!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}"
|
|
||||||
|
|
||||||
# For now, use 32 bit folder as build is 32 bit
|
|
||||||
# !define MULTIUSER_USE_PROGRAMFILES64
|
|
||||||
|
|
||||||
# Includes
|
|
||||||
!include "MultiUser.nsh"
|
!include "MultiUser.nsh"
|
||||||
!include "MUI2.nsh"
|
!include "MUI2.nsh"
|
||||||
!include ".\tools\EnvVarUpdate.nsh"
|
!include ".\tools\EnvVarUpdate.nsh"
|
||||||
!include "LogicLib.nsh"
|
|
||||||
|
|
||||||
# Basics
|
# Basics
|
||||||
Name "Janet"
|
Name "Janet"
|
||||||
|
OutFile "janet-installer.exe"
|
||||||
# Do some NSIS-fu to figure out at compile time if we are in appveyor
|
|
||||||
!define OUTNAME $%APPVEYOR_REPO_TAG_NAME%
|
|
||||||
!define "CHECK_${OUTNAME}"
|
|
||||||
!define DOLLAR "$"
|
|
||||||
!ifdef CHECK_${DOLLAR}%APPVEYOR_REPO_TAG_NAME%
|
|
||||||
# We are not in the appveyor environment, use version name
|
|
||||||
!define OUTNAME_PART v${VERSION}
|
|
||||||
!else
|
|
||||||
# We are in appveyor, use git tag name for installer
|
|
||||||
!define OUTNAME_PART ${OUTNAME}
|
|
||||||
!endif
|
|
||||||
OutFile "janet-${OUTNAME_PART}-windows-installer.exe"
|
|
||||||
|
|
||||||
# Some Configuration
|
# Some Configuration
|
||||||
!define APPNAME "Janet"
|
!define APPNAME "Janet"
|
||||||
!define DESCRIPTION "The Janet Programming Language"
|
!define DESCRIPTION "The Janet Programming Language"
|
||||||
!define HELPURL "http://janet-lang.org"
|
!define HELPURL "http://janet-lang.org"
|
||||||
BrandingText "The Janet Programming Language"
|
BrandingText "Janet Installer"
|
||||||
|
|
||||||
# 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
|
# MUI Configuration
|
||||||
!define MUI_ICON "assets\icon.ico"
|
!define MUI_ICON "assets\icon.ico"
|
||||||
@@ -68,55 +22,45 @@ BrandingText "The Janet Programming Language"
|
|||||||
!define MUI_HEADERIMAGE
|
!define MUI_HEADERIMAGE
|
||||||
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
!define MUI_HEADERIMAGE_BITMAP "assets\janet-w200.png"
|
||||||
!define MUI_HEADERIMAGE_RIGHT
|
!define MUI_HEADERIMAGE_RIGHT
|
||||||
!define MUI_ABORTWARNING
|
|
||||||
|
|
||||||
# Show a welcome page first
|
# Show a welcome page first
|
||||||
!insertmacro MUI_PAGE_WELCOME
|
!insertmacro MUI_PAGE_WELCOME
|
||||||
|
|
||||||
|
# License page
|
||||||
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
!insertmacro MUI_PAGE_LICENSE "LICENSE"
|
||||||
|
|
||||||
# Pick Install Directory
|
# Pick Install Directory
|
||||||
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
!insertmacro MULTIUSER_PAGE_INSTALLMODE
|
||||||
!insertmacro MUI_PAGE_DIRECTORY
|
!insertmacro MUI_PAGE_DIRECTORY
|
||||||
!insertmacro MUI_PAGE_INSTFILES
|
|
||||||
|
|
||||||
# Done
|
page instfiles
|
||||||
!insertmacro MUI_PAGE_FINISH
|
|
||||||
|
|
||||||
# Need to set a language.
|
# Need to set a language.
|
||||||
!insertmacro MUI_LANGUAGE "English"
|
!insertmacro MUI_LANGUAGE "English"
|
||||||
|
|
||||||
function .onInit
|
function .onInit
|
||||||
!insertmacro MULTIUSER_INIT
|
setShellVarContext all
|
||||||
functionEnd
|
functionEnd
|
||||||
|
|
||||||
section "Janet" BfWSection
|
section "install"
|
||||||
|
|
||||||
createDirectory "$INSTDIR\Library"
|
createDirectory "$INSTDIR\Library"
|
||||||
createDirectory "$INSTDIR\C"
|
createDirectory "$INSTDIR\C"
|
||||||
createDirectory "$INSTDIR\bin"
|
createDirectory "$INSTDIR\bin"
|
||||||
createDirectory "$INSTDIR\docs"
|
setOutPath $INSTDIR
|
||||||
setOutPath "$INSTDIR"
|
|
||||||
|
|
||||||
# Bin files
|
|
||||||
file /oname=bin\janet.exe dist\janet.exe
|
file /oname=bin\janet.exe dist\janet.exe
|
||||||
file /oname=logo.ico assets\icon.ico
|
file /oname=logo.ico assets\icon.ico
|
||||||
file /oname=bin\jpm.janet auxbin\jpm
|
|
||||||
file /oname=bin\jpm.bat tools\jpm.bat
|
|
||||||
|
|
||||||
# C headers and library files
|
file /oname=Library\cook.janet dist\cook.janet
|
||||||
|
|
||||||
file /oname=C\janet.h dist\janet.h
|
file /oname=C\janet.h dist\janet.h
|
||||||
file /oname=C\janetconf.h dist\janetconf.h
|
file /oname=C\janetconf.h dist\janetconf.h
|
||||||
file /oname=C\janet.lib dist\janet.lib
|
file /oname=C\janet.lib dist\janet.lib
|
||||||
file /oname=C\janet.exp dist\janet.exp
|
file /oname=C\janet.exp dist\janet.exp
|
||||||
file /oname=C\janet.c dist\janet.c
|
file /oname=C\janet.c dist\janet.c
|
||||||
file /oname=C\libjanet.lib dist\libjanet.lib
|
|
||||||
|
|
||||||
# Documentation
|
file /oname=bin\jpm.janet dist\jpm
|
||||||
file /oname=docs\docs.html dist\doc.html
|
file /oname=bin\jpm.bat dist\jpm.bat
|
||||||
|
|
||||||
# Other
|
|
||||||
file README.md
|
|
||||||
file LICENSE
|
|
||||||
|
|
||||||
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
# Uninstaller - See function un.onInit and section "uninstall" for configuration
|
||||||
writeUninstaller "$INSTDIR\uninstall.exe"
|
writeUninstaller "$INSTDIR\uninstall.exe"
|
||||||
@@ -124,43 +68,50 @@ section "Janet" BfWSection
|
|||||||
# Start Menu
|
# Start Menu
|
||||||
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
createShortCut "$SMPROGRAMS\Janet.lnk" "$INSTDIR\bin\janet.exe" "" "$INSTDIR\logo.ico"
|
||||||
|
|
||||||
# Set up Environment variables
|
# HKLM (all users) vs HKCU (current user)
|
||||||
!insertmacro WriteEnv JANET_PATH "$INSTDIR\Library"
|
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH "$INSTDIR\Library"
|
||||||
!insertmacro WriteEnv JANET_HEADERPATH "$INSTDIR\C"
|
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH "$INSTDIR\C"
|
||||||
!insertmacro WriteEnv JANET_LIBPATH "$INSTDIR\C"
|
WriteRegExpandStr HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINDIR "$INSTDIR\bin"
|
||||||
!insertmacro WriteEnv JANET_BINPATH "$INSTDIR\bin"
|
|
||||||
|
WriteRegExpandStr HKCU "Environment" JANET_PATH "$INSTDIR\Library"
|
||||||
|
WriteRegExpandStr HKCU "Environment" JANET_HEADERPATH "$INSTDIR\C"
|
||||||
|
WriteRegExpandStr HKCU "Environment" JANET_BINDIR "$INSTDIR\bin"
|
||||||
|
|
||||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||||
|
|
||||||
# Update path
|
# Update path
|
||||||
${If} $MultiUser.InstallMode == "AllUsers"
|
|
||||||
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
|
||||||
${Else}
|
|
||||||
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
${EnvVarUpdate} $0 "PATH" "A" "HKCU" "$INSTDIR\bin" ; Append
|
||||||
${EndIf}
|
${EnvVarUpdate} $0 "PATH" "A" "HKLM" "$INSTDIR\bin" ; Append
|
||||||
|
|
||||||
# Registry information for add/remove programs
|
# Registry information for add/remove programs
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayName" "Janet"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayName" "Janet"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "InstallLocation" "$INSTDIR"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "UninstallString" "$INSTDIR\uninstall.exe"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayIcon" "$INSTDIR\logo.ico"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "QuietUninstallString" "$INSTDIR\uninstall.exe /S"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "Publisher" "Janet-Lang.org"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "InstallLocation" "$INSTDIR"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "HelpLink" "${HELPURL}"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayIcon" "$INSTDIR\logo.ico"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLUpdateInfo" "${HELPURL}"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "Publisher" "Janet-Lang.org"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "URLInfoAbout" "${HELPURL}"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "HelpLink" "${HELPURL}"
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "DisplayVersion" "${VERSION}"
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLUpdateInfo" "${HELPURL}"
|
||||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoModify" 1
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "URLInfoAbout" "${HELPURL}"
|
||||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "NoRepair" 1
|
WriteRegStr HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "DisplayVersion" "0.6.0"
|
||||||
WriteRegDWORD SHCTX "${UNINST_KEY}" "EstimatedSize" 1000
|
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMajor" 0
|
||||||
# Add uninstall
|
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "VersionMinor" 6
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "UninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode"
|
# There is no option for modifying or repairing the install
|
||||||
WriteRegStr SHCTX "${UNINST_KEY}" "QuietUninstallString" "$\"$INSTDIR\uninstall.exe$\" /$MultiUser.InstallMode /S"
|
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoModify" 1
|
||||||
|
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "NoRepair" 1
|
||||||
|
# Set the INSTALLSIZE constant (!defined at the top of this script) so Add/Remove Programs can accurately report the size
|
||||||
|
WriteRegDWORD HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet" "EstimatedSize" 1000
|
||||||
sectionEnd
|
sectionEnd
|
||||||
|
|
||||||
# Uninstaller
|
# Uninstaller
|
||||||
|
|
||||||
function un.onInit
|
function un.onInit
|
||||||
!insertmacro MULTIUSER_UNINIT
|
SetShellVarContext all
|
||||||
|
|
||||||
|
#Verify the uninstaller - last chance to back out
|
||||||
|
MessageBox MB_OKCANCEL "Permanantly remove Janet?" IDOK next
|
||||||
|
Abort
|
||||||
|
next:
|
||||||
functionEnd
|
functionEnd
|
||||||
|
|
||||||
section "uninstall"
|
section "uninstall"
|
||||||
@@ -169,34 +120,44 @@ section "uninstall"
|
|||||||
delete "$SMPROGRAMS\Janet.lnk"
|
delete "$SMPROGRAMS\Janet.lnk"
|
||||||
|
|
||||||
# Remove files
|
# Remove files
|
||||||
delete "$INSTDIR\logo.ico"
|
delete $INSTDIR\logo.ico
|
||||||
delete "$INSTDIR\README.md"
|
|
||||||
delete "$INSTDIR\LICENSE"
|
delete $INSTDIR\C\janet.c
|
||||||
rmdir /r "$INSTDIR\Library"
|
delete $INSTDIR\C\janet.h
|
||||||
rmdir /r "$INSTDIR\bin"
|
delete $INSTDIR\C\janet.lib
|
||||||
rmdir /r "$INSTDIR\C"
|
delete $INSTDIR\C\janet.exp
|
||||||
rmdir /r "$INSTDIR\docs"
|
delete $INSTDIR\C\janetconf.h
|
||||||
|
|
||||||
|
delete $INSTDIR\bin\jpm.janet
|
||||||
|
delete $INSTDIR\bin\jpm.bat
|
||||||
|
delete $INSTDIR\bin\janet.exe
|
||||||
|
|
||||||
|
delete $INSTDIR\Library\cook.janet
|
||||||
|
|
||||||
# Remove env vars
|
# Remove env vars
|
||||||
!insertmacro DelEnv JANET_PATH
|
|
||||||
!insertmacro DelEnv JANET_HEADERPATH
|
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_PATH
|
||||||
!insertmacro DelEnv JANET_LIBPATH
|
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_HEADERPATH
|
||||||
!insertmacro DelEnv JANET_BINPATH
|
DeleteRegValue HKLM "SYSTEM\CurrentControlSet\Control\Session Manager\Environment" JANET_BINDIR
|
||||||
|
|
||||||
|
DeleteRegValue HKCU "Environment" JANET_PATH
|
||||||
|
DeleteRegValue HKCU "Environment" JANET_HEADERPATH
|
||||||
|
DeleteRegValue HKCU "Environment" JANET_BINDIR
|
||||||
|
|
||||||
# Unset PATH
|
# Unset PATH
|
||||||
${If} $MultiUser.InstallMode == "AllUsers"
|
|
||||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
|
||||||
${Else}
|
|
||||||
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
${un.EnvVarUpdate} $0 "PATH" "R" "HKCU" "$INSTDIR\bin" ; Remove
|
||||||
${EndIf}
|
${un.EnvVarUpdate} $0 "PATH" "R" "HKLM" "$INSTDIR\bin" ; Remove
|
||||||
|
|
||||||
# make sure windows knows about the change
|
# make sure windows knows about the change
|
||||||
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
SendMessage ${HWND_BROADCAST} ${WM_WININICHANGE} 0 "STR:Environment" /TIMEOUT=5000
|
||||||
|
|
||||||
# Always delete uninstaller as the last action
|
# Always delete uninstaller as the last action
|
||||||
delete "$INSTDIR\uninstall.exe"
|
delete $INSTDIR\uninstall.exe
|
||||||
|
|
||||||
|
rmDir "$INSTDIR\Library"
|
||||||
|
rmDir "$INSTDIR\C"
|
||||||
|
rmDir "$INSTDIR\bin"
|
||||||
|
|
||||||
# Remove uninstaller information from the registry
|
# Remove uninstaller information from the registry
|
||||||
DeleteRegKey SHCTX "${UNINST_KEY}"
|
DeleteRegKey HKLM "Software\Microsoft\Windows\CurrentVersion\Uninstall\Janet"
|
||||||
|
|
||||||
sectionEnd
|
sectionEnd
|
||||||
4
janet.1
4
janet.1
@@ -14,7 +14,7 @@ janet \- run the Janet language abstract machine
|
|||||||
.SH DESCRIPTION
|
.SH DESCRIPTION
|
||||||
Janet is a functional and imperative programming language and bytecode interpreter.
|
Janet is a functional and imperative programming language and bytecode interpreter.
|
||||||
It is a modern lisp, but lists are replaced by other data structures with better utility
|
It is a modern lisp, but lists are replaced by other data structures with better utility
|
||||||
and performance (arrays, tables, structs, tuples). The language also features bridging
|
and performance (arrays, tables, structs, tuples). The language also bridging bridging
|
||||||
to native code written in C, meta-programming with macros, and bytecode assembly.
|
to native code written in C, meta-programming with macros, and bytecode assembly.
|
||||||
|
|
||||||
There is a repl for trying out the language, as well as the ability to run script files.
|
There is a repl for trying out the language, as well as the ability to run script files.
|
||||||
@@ -73,7 +73,7 @@ Don't execute a script, only compile it to check for errors. Useful for linting
|
|||||||
|
|
||||||
.TP
|
.TP
|
||||||
.BR \-m\ syspath
|
.BR \-m\ syspath
|
||||||
Set the dynamic binding :syspath to the string syspath so that Janet will load system modules
|
Set the variable module/*syspath* to the string syspath so that Janet will load system modules
|
||||||
from a directory different than the default. The default is set when Janet is built, and defaults to
|
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.
|
/usr/local/lib/janet on Linux/Posix, and C:/Janet/Library on Windows. This option supersedes JANET_PATH.
|
||||||
|
|
||||||
|
|||||||
190
jpm.1
190
jpm.1
@@ -1,190 +0,0 @@
|
|||||||
.TH JPM 1
|
|
||||||
.SH NAME
|
|
||||||
jpm \- the Janet Project Manager, a build tool for Janet
|
|
||||||
.SH SYNOPSIS
|
|
||||||
.B jpm
|
|
||||||
[\fB\-\-flag ...\fR]
|
|
||||||
[\fB\-\-option=value ...\fR]
|
|
||||||
.IR command
|
|
||||||
.IR args ...
|
|
||||||
.SH DESCRIPTION
|
|
||||||
jpm is the build tool that ships with a standard Janet install. It is
|
|
||||||
used for building Janet projects, installing dependencies, installing
|
|
||||||
projects, building native modules, and exporting your Janet project to a
|
|
||||||
standalone executable. Although not required for working with Janet, it
|
|
||||||
removes much of the boilerplate with installing dependencies and
|
|
||||||
building native modules. jpm requires only Janet to run, and uses git
|
|
||||||
to install dependencies (jpm will work without git installed).
|
|
||||||
.SH DOCUMENTATION
|
|
||||||
|
|
||||||
jpm has several subcommands, each used for managing either a single Janet project or
|
|
||||||
all Janet modules installed on the system. Global commands, those that manage modules
|
|
||||||
at the system level, do things like install and uninstall packages, as well as clear the cache.
|
|
||||||
More interesting are the local commands. For more information on jpm usage, see https://janet-lang.org/docs/index.html
|
|
||||||
|
|
||||||
.SH FLAGS
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-verbose
|
|
||||||
Print detailed messages of what jpm is doing, including compilation commands and other shell commands.
|
|
||||||
|
|
||||||
.SH OPTIONS
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-modpath=/some/path
|
|
||||||
Set the path to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath) in that order.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-headerpath=/some/path
|
|
||||||
Set the path the jpm will include when building C source code. This lets
|
|
||||||
you specify the location of janet.h and janetconf.h on your system. On a
|
|
||||||
normal install, this option is not needed.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-binpath=/some/path
|
|
||||||
Set the path that jpm will install scripts and standalone executables to. Executables
|
|
||||||
defined via declare-execuatble or scripts declared via declare-binscript will be installed
|
|
||||||
here when jpm install is run. Defaults to $JANET_BINPATH, or a reasonable default for the system.
|
|
||||||
See JANET_BINPATH for more.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-libpath=/some/path
|
|
||||||
Sets the path jpm will use to look for libjanet.a for building standalone executables. libjanet.so
|
|
||||||
is \fBnot\fR used for building native modules or standalone executables, only
|
|
||||||
for linking into applications that want to embed janet as a dynamic module.
|
|
||||||
Linking statically might be a better idea, even in that case. Defaults to
|
|
||||||
$JANET_LIBPATH, or a reasonable default. See JANET_LIBPATH for more.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-compiler=cc
|
|
||||||
Sets the compiler used for compiling native modules and standalone executables. Defaults
|
|
||||||
to cc.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-linker=ld
|
|
||||||
Sets the linker used to create native modules and executables.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-pkglist=https://github.com/janet-lang/pkgs.git
|
|
||||||
Sets the git repository for the package listing used to resolve shorthand package names.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR \-\-archiver=ar
|
|
||||||
Sets the command used for creating static libraries, use for linking into the standalone executable.
|
|
||||||
Native modules are compiled twice, once a normal native module (shared object), and once as an
|
|
||||||
archive.
|
|
||||||
|
|
||||||
.SH COMMANDS
|
|
||||||
.TP
|
|
||||||
.BR help
|
|
||||||
Shows the usage text and exits immediately.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR build
|
|
||||||
Builds all artifacts specified in the project.janet file in the current directory. Artifacts will
|
|
||||||
be created in the ./build/ directory.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR install\ [\fBrepo\fR]
|
|
||||||
|
|
||||||
When run with no arguments, installs all installable artifacts in the current project to
|
|
||||||
the current JANET_MODPATH for modules and JANET_BINPATH for executables and scripts. Can also
|
|
||||||
take an optional git repository URL and will install all artifacts in that repository instead.
|
|
||||||
When run with an argument, install does not need to be run from a jpm project directory.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR uninstall\ [\fBname\fR]
|
|
||||||
Uninstall a project installed with install. uninstall expects the name of the project, not the
|
|
||||||
repository url, path to installed file or executable name. The name of the project must be specified
|
|
||||||
at the top of the project.janet file in the declare-project form. If no name is given, uninstalls
|
|
||||||
the current project if installed.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR clean
|
|
||||||
Remove all artifacts created by jpm. This just deletes the build folder.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR test
|
|
||||||
Runs jpm tests. jpm will run all janet source files in the test directory as tests. A test
|
|
||||||
is considered failing if it exits with a non-zero exit code.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR deps
|
|
||||||
Install all dependencies that this project requires recursively. jpm does not
|
|
||||||
resolve dependency issues, like conflicting versions of the same module are required, or
|
|
||||||
different modules with the same name. Dependencies are installed with git, so deps requires
|
|
||||||
git to be on the PATH.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR clear-cache
|
|
||||||
jpm caches git repositories that are needed to install modules from a remote
|
|
||||||
source in a global cache ($JANET_PATH/.cache). If these dependencies are out of
|
|
||||||
date or too large, clear-cache will remove the cache and jpm will rebuild it
|
|
||||||
when needed. clear-cache is a global command, so a project.janet is not
|
|
||||||
required.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR run\ [\fBrule\fR]
|
|
||||||
Run a given rule defined in project.janet. Project definitions files (project.janet) usually
|
|
||||||
contain a few artifact declarations, which set up rules that jpm can then resolve, or execute.
|
|
||||||
A project.janet can also create custom rules to create arbitrary files or run arbitrary code, much
|
|
||||||
like make. run will run a single rule or build a single file.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR rules
|
|
||||||
List all rules that can be run via run. This is useful for exploring rules in the project.
|
|
||||||
|
|
||||||
.TP
|
|
||||||
.BR update-pkgs
|
|
||||||
Update the package listing by installing the 'pkgs' package. Same as jpm install pkgs
|
|
||||||
|
|
||||||
.SH ENVIRONMENT
|
|
||||||
|
|
||||||
.B JANET_PATH
|
|
||||||
.RS
|
|
||||||
The location to look for Janet libraries. This is the only environment variable Janet needs to
|
|
||||||
find native and source code modules. If no JANET_PATH is set, Janet will look in
|
|
||||||
the default location set at compile time, which can be determined with (dyn :syspath)
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.B JANET_MODPATH
|
|
||||||
.RS
|
|
||||||
The location that jpm will use to install libraries to. Defaults to JANET_PATH, but you could
|
|
||||||
set this to a different directory if you want to. Doing so would let you import Janet modules
|
|
||||||
on the normal system path (JANET_PATH or (dyn :syspath)), but install to a different directory. It is also a more reliable way to install
|
|
||||||
This variable is overwritten by the --modpath=/some/path if it is provided.
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.B JANET_HEADERPATH
|
|
||||||
.RS
|
|
||||||
The location that jpm will look for janet header files (janet.h and janetconf.h) that are used
|
|
||||||
to build native modules and standalone executables. If janet.h and janetconf.h are available as
|
|
||||||
default includes on your system, this value is not required. If not provided, will default to
|
|
||||||
(dyn :syspath)/../../include/janet. The --headerpath=/some/path will override this variable.
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.B JANET_LIBPATH
|
|
||||||
.RS
|
|
||||||
Similar to JANET_HEADERPATH, this path is where jpm will look for
|
|
||||||
libjanet.a for creating standalong executables. This does not need to be
|
|
||||||
set on a normal install.
|
|
||||||
If not provided, this will default to (dyn :syspath)/../../lib.
|
|
||||||
The --libpath=/some/path will override this variable.
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.B JANET_BINPATH
|
|
||||||
.RS
|
|
||||||
The directory where jpm will install binary scripts and executables to.
|
|
||||||
Defaults to
|
|
||||||
(dyn :syspath)/../../lib.
|
|
||||||
The --binpath=/some/path will override this variable.
|
|
||||||
.RE
|
|
||||||
|
|
||||||
.B JANET_PKGLIST
|
|
||||||
.RS
|
|
||||||
The git repository URL that contains a listing of packages. This allows installing packages with shortnames, which
|
|
||||||
is mostly a convenience. However, package dependencies can use short names, package listings
|
|
||||||
can be used to choose a particular set of dependency versions for a whole project.
|
|
||||||
|
|
||||||
.SH AUTHOR
|
|
||||||
Written by Calvin Rose <calsrose@gmail.com>
|
|
||||||
109
meson.build
109
meson.build
@@ -18,9 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
project('janet', 'c',
|
project('janet', 'c', default_options : ['c_std=c99'])
|
||||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
|
||||||
version : '1.4.0')
|
|
||||||
|
|
||||||
# Global settings
|
# Global settings
|
||||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||||
@@ -31,54 +29,14 @@ cc = meson.get_compiler('c')
|
|||||||
m_dep = cc.find_library('m', required : false)
|
m_dep = cc.find_library('m', required : false)
|
||||||
dl_dep = cc.find_library('dl', required : false)
|
dl_dep = cc.find_library('dl', required : false)
|
||||||
|
|
||||||
# Link options
|
# Some options
|
||||||
if build_machine.system() != 'windows'
|
|
||||||
add_project_link_arguments('-rdynamic', language : 'c')
|
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', 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_REDUCED_OS', get_option('reduced_os'))
|
|
||||||
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'))
|
|
||||||
if get_option('os_name') != ''
|
|
||||||
conf.set('JANET_OS_NAME', get_option('os_name'))
|
|
||||||
endif
|
|
||||||
if get_option('arch_name') != ''
|
|
||||||
conf.set('JANET_ARCH_NAME', get_option('arch_name'))
|
|
||||||
endif
|
|
||||||
jconf = configure_file(output : 'janetconf.h',
|
|
||||||
configuration : conf)
|
|
||||||
|
|
||||||
# Include directories
|
# Include directories
|
||||||
incdir = include_directories(['src/include', '.'])
|
incdir = include_directories('src/include')
|
||||||
|
|
||||||
# Building generated sources
|
# Building generated sources
|
||||||
xxd = executable('xxd', 'tools/xxd.c', native : true)
|
xxd = executable('xxd', 'tools/xxd.c')
|
||||||
gen = generator(xxd,
|
gen = generator(xxd,
|
||||||
output : '@BASENAME@.gen.c',
|
output : '@BASENAME@.gen.c',
|
||||||
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
arguments : ['@INPUT@', '@OUTPUT@', '@EXTRA_ARGS@'])
|
||||||
@@ -156,8 +114,7 @@ mainclient_src = [
|
|||||||
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
janet_boot = executable('janet-boot', core_src, boot_src, boot_gen,
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
c_args : '-DJANET_BOOTSTRAP',
|
c_args : '-DJANET_BOOTSTRAP',
|
||||||
dependencies : [m_dep, dl_dep],
|
dependencies : [m_dep, dl_dep])
|
||||||
native : true)
|
|
||||||
|
|
||||||
# Build core image
|
# Build core image
|
||||||
core_image = custom_target('core_image',
|
core_image = custom_target('core_image',
|
||||||
@@ -165,55 +122,29 @@ core_image = custom_target('core_image',
|
|||||||
output : 'core_image.gen.c',
|
output : 'core_image.gen.c',
|
||||||
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
command : [janet_boot, '@OUTPUT@', 'JANET_PATH', janet_path, 'JANET_HEADERPATH', header_path])
|
||||||
|
|
||||||
libjanet = library('janet', core_src, core_image,
|
libjanet = shared_library('janet', core_src, core_image,
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
dependencies : [m_dep, dl_dep],
|
dependencies : [m_dep, dl_dep],
|
||||||
install : true)
|
install : true)
|
||||||
|
|
||||||
# Extra c flags - adding -fvisibility=hidden matches the Makefile and
|
|
||||||
# shaves off about 10k on linux x64, likely similar on other platforms.
|
|
||||||
native_cc = meson.get_compiler('c', native: true)
|
|
||||||
cross_cc = meson.get_compiler('c', native: false)
|
|
||||||
if native_cc.has_argument('-fvisibility=hidden')
|
|
||||||
extra_native_cflags = ['-fvisibility=hidden']
|
|
||||||
else
|
|
||||||
extra_native_cflags = []
|
|
||||||
endif
|
|
||||||
if cross_cc.has_argument('-fvisibility=hidden')
|
|
||||||
extra_cross_cflags = ['-fvisibility=hidden']
|
|
||||||
else
|
|
||||||
extra_cross_cflags = []
|
|
||||||
endif
|
|
||||||
|
|
||||||
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclient_src,
|
||||||
include_directories : incdir,
|
include_directories : incdir,
|
||||||
dependencies : [m_dep, dl_dep],
|
dependencies : [m_dep, dl_dep],
|
||||||
c_args : extra_native_cflags,
|
|
||||||
install : true)
|
install : true)
|
||||||
|
janet_jpm = install_data('tools/jpm', install_dir : 'bin')
|
||||||
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],
|
|
||||||
c_args : extra_cross_cflags,
|
|
||||||
native : true)
|
|
||||||
else
|
|
||||||
janet_nativeclient = janet_mainclient
|
|
||||||
endif
|
|
||||||
|
|
||||||
# Documentation
|
# Documentation
|
||||||
docs = custom_target('docs',
|
docs = custom_target('docs',
|
||||||
input : ['tools/gendoc.janet'],
|
input : ['tools/gendoc.janet'],
|
||||||
output : ['doc.html'],
|
output : ['doc.html'],
|
||||||
capture : true,
|
capture : true,
|
||||||
command : [janet_nativeclient, '@INPUT@'])
|
command : [janet_mainclient, '@INPUT@'])
|
||||||
|
|
||||||
# Amalgamated source
|
# Amalgamated source
|
||||||
amalg = custom_target('amalg',
|
amalg = custom_target('amalg',
|
||||||
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
input : ['tools/amalg.janet', core_headers, core_src, core_image],
|
||||||
output : ['janet.c'],
|
output : ['janet.c'],
|
||||||
capture : true,
|
capture : true,
|
||||||
command : [janet_nativeclient, '@INPUT@'])
|
command : [janet_mainclient, '@INPUT@'])
|
||||||
|
|
||||||
# Amalgamated client
|
# Amalgamated client
|
||||||
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
janet_amalgclient = executable('janet-amalg', amalg, init_gen, mainclient_src,
|
||||||
@@ -229,25 +160,21 @@ test_files = [
|
|||||||
'test/suite3.janet',
|
'test/suite3.janet',
|
||||||
'test/suite4.janet',
|
'test/suite4.janet',
|
||||||
'test/suite5.janet',
|
'test/suite5.janet',
|
||||||
'test/suite6.janet',
|
'test/suite6.janet'
|
||||||
'test/suite7.janet'
|
|
||||||
]
|
]
|
||||||
foreach t : test_files
|
foreach t : test_files
|
||||||
test(t, janet_nativeclient, args : files([t]), workdir : meson.current_source_dir())
|
test(t, janet_mainclient, args : files([t]), workdir : meson.current_source_dir())
|
||||||
endforeach
|
endforeach
|
||||||
|
|
||||||
# Repl
|
# Repl
|
||||||
run_target('repl', command : [janet_nativeclient])
|
run_target('repl', command : [janet_mainclient])
|
||||||
|
|
||||||
# For use as meson subproject (wrap)
|
|
||||||
janet_dep = declare_dependency(include_directories : incdir,
|
|
||||||
link_with : libjanet)
|
|
||||||
|
|
||||||
# Installation
|
# Installation
|
||||||
install_man('janet.1')
|
install_man('janet.1')
|
||||||
install_man('jpm.1')
|
install_headers('src/include/janet.h', 'src/include/janetconf.h', subdir: 'janet')
|
||||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
janet_libs = [
|
||||||
janet_binscripts = [
|
'tools/bars.janet',
|
||||||
'auxbin/jpm'
|
'tools/cook.janet',
|
||||||
|
'tools/highlight.janet'
|
||||||
]
|
]
|
||||||
install_data(sources : janet_binscripts, install_dir : 'bin')
|
install_data(sources : janet_libs, install_dir : janet_path)
|
||||||
|
|||||||
@@ -1,20 +0,0 @@
|
|||||||
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 : false)
|
|
||||||
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 : 0x7fffffff, value : 0x7fffffff)
|
|
||||||
|
|
||||||
option('arch_name', type : 'string', value: '')
|
|
||||||
option('os_name', type : 'string', value: '')
|
|
||||||
@@ -50,26 +50,10 @@ int main(int argc, const char **argv) {
|
|||||||
JanetArray *args = janet_array(argc);
|
JanetArray *args = janet_array(argc);
|
||||||
for (int i = 0; i < argc; i++)
|
for (int i = 0; i < argc; i++)
|
||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
janet_def(env, "boot/args", janet_wrap_array(args), "Command line arguments.");
|
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, "boot/config", janet_wrap_table(opts), "Boot options");
|
|
||||||
|
|
||||||
/* Run bootstrap script to generate core image */
|
/* Run bootstrap script to generate core image */
|
||||||
const char *boot_file;
|
status = janet_dobytes(env, janet_gen_boot, janet_gen_boot_size, "boot.janet", NULL);
|
||||||
#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 */
|
/* Deinitialize vm */
|
||||||
janet_deinit();
|
janet_deinit();
|
||||||
|
|||||||
@@ -8,7 +8,7 @@
|
|||||||
###
|
###
|
||||||
|
|
||||||
(def defn :macro
|
(def defn :macro
|
||||||
"(defn name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
"(def name & more)\n\nDefine a function. Equivalent to (def name (fn name [args] ...))."
|
||||||
(fn defn [name & more]
|
(fn defn [name & more]
|
||||||
(def len (length more))
|
(def len (length more))
|
||||||
(def modifiers @[])
|
(def modifiers @[])
|
||||||
@@ -106,7 +106,6 @@
|
|||||||
(defn false? "Check if x is false." [x] (= x false))
|
(defn false? "Check if x is false." [x] (= x false))
|
||||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||||
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
|
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
|
||||||
|
|
||||||
(def idempotent?
|
(def idempotent?
|
||||||
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
|
||||||
(do
|
(do
|
||||||
@@ -264,21 +263,6 @@
|
|||||||
(++ i))
|
(++ i))
|
||||||
~(let (,;accum) ,;body))
|
~(let (,;accum) ,;body))
|
||||||
|
|
||||||
(defmacro with
|
|
||||||
"Evaluate body with some resource, which will be automatically cleaned up
|
|
||||||
if there is an error in body. binding is bound to the expression ctor, and
|
|
||||||
dtor is a function or callable that is passed the binding. If no destructor
|
|
||||||
(dtor) is given, will call :close on the resource."
|
|
||||||
[[binding ctor dtor] & body]
|
|
||||||
(with-syms [res f]
|
|
||||||
~(let [,binding ,ctor
|
|
||||||
,f (,fiber/new (fn [] ,;body) :ie)
|
|
||||||
,res (,resume ,f)]
|
|
||||||
(,(or dtor :close) ,binding)
|
|
||||||
(if (,= (,fiber/status ,f) :error)
|
|
||||||
(,propagate ,res ,f)
|
|
||||||
,res))))
|
|
||||||
|
|
||||||
(defn- for-template
|
(defn- for-template
|
||||||
[binding start stop step comparison delta body]
|
[binding start stop step comparison delta body]
|
||||||
(with-syms [i s]
|
(with-syms [i s]
|
||||||
@@ -341,7 +325,6 @@
|
|||||||
(keyword? binding)
|
(keyword? binding)
|
||||||
(let [rest (loop1 body head (+ i 2))]
|
(let [rest (loop1 body head (+ i 2))]
|
||||||
(case binding
|
(case binding
|
||||||
:until ~(do (if ,verb (break) nil) ,rest)
|
|
||||||
:while ~(do (if ,verb nil (break)) ,rest)
|
:while ~(do (if ,verb nil (break)) ,rest)
|
||||||
:let ~(let ,verb (do ,rest))
|
:let ~(let ,verb (do ,rest))
|
||||||
:after ~(do ,rest ,verb nil)
|
:after ~(do ,rest ,verb nil)
|
||||||
@@ -391,7 +374,7 @@
|
|||||||
and object is any janet expression. The available verbs are:\n\n
|
and object is any janet expression. The available verbs are:\n\n
|
||||||
\t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
|
\t:iterate - repeatedly evaluate and bind to the expression while it is truthy.\n
|
||||||
\t:range - loop over a range. The object should be two element tuple with a start
|
\t:range - loop over a range. The object should be two element tuple with a start
|
||||||
and end value, and an optional positive step. The range is half open, [start, end).\n
|
and end value, and an optional postive step. The range is half open, [start, end).\n
|
||||||
\t:down - Same as range, but loops in reverse.\n
|
\t:down - Same as range, but loops in reverse.\n
|
||||||
\t:keys - Iterate over the keys in a data structure.\n
|
\t:keys - Iterate over the keys in a data structure.\n
|
||||||
\t:pairs - Iterate over the keys value pairs in a data structure.\n
|
\t:pairs - Iterate over the keys value pairs in a data structure.\n
|
||||||
@@ -404,7 +387,6 @@
|
|||||||
where :modifier is one of a set of keywords, and argument is keyword dependent.
|
where :modifier is one of a set of keywords, and argument is keyword dependent.
|
||||||
:modifier can be one of:\n\n
|
:modifier can be one of:\n\n
|
||||||
\t:while expression - breaks from the loop if expression is falsey.\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: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: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
|
\t:after form - same as :before, but the side effect happens after the next inner loop.\n
|
||||||
@@ -445,11 +427,6 @@
|
|||||||
(each x xs (+= accum x))
|
(each x xs (+= accum x))
|
||||||
accum)
|
accum)
|
||||||
|
|
||||||
(defn mean
|
|
||||||
"Returns the mean of xs. If empty, returns NaN."
|
|
||||||
[xs]
|
|
||||||
(/ (sum xs) (length xs)))
|
|
||||||
|
|
||||||
(defn product
|
(defn product
|
||||||
"Returns the product of xs. If xs is empty, returns 1."
|
"Returns the product of xs. If xs is empty, returns 1."
|
||||||
[xs]
|
[xs]
|
||||||
@@ -500,12 +477,12 @@
|
|||||||
(case (length functions)
|
(case (length functions)
|
||||||
0 nil
|
0 nil
|
||||||
1 (get functions 0)
|
1 (get functions 0)
|
||||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
2 (let [[f g] functions] (fn [x] (f (g x))))
|
||||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
3 (let [[f g h] functions] (fn [x] (f (g (h x)))))
|
||||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
4 (let [[f g h i] functions] (fn [x] (f (g (h (i x))))))
|
||||||
(let [[f g h i] functions]
|
(let [[f g h i j] functions]
|
||||||
(comp (fn [x] (f (g (h (i x)))))
|
(comp (fn [x] (f (g (h (i (j x))))))
|
||||||
;(tuple/slice functions 4 -1)))))
|
;(tuple/slice functions 5 -1)))))
|
||||||
|
|
||||||
(defn identity
|
(defn identity
|
||||||
"A function that returns its first argument."
|
"A function that returns its first argument."
|
||||||
@@ -564,7 +541,7 @@
|
|||||||
"(sort xs [, by])\n\nSort an array in-place. Uses quick-sort and is not a stable sort."
|
"(sort xs [, by])\n\nSort an array in-place. Uses quick-sort and is not a stable sort."
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(defn part
|
(defn partition
|
||||||
[a lo hi by]
|
[a lo hi by]
|
||||||
(def pivot (get a hi))
|
(def pivot (get a hi))
|
||||||
(var i lo)
|
(var i lo)
|
||||||
@@ -582,7 +559,7 @@
|
|||||||
(defn sort-help
|
(defn sort-help
|
||||||
[a lo hi by]
|
[a lo hi by]
|
||||||
(when (> hi lo)
|
(when (> hi lo)
|
||||||
(def piv (part a lo hi by))
|
(def piv (partition a lo hi by))
|
||||||
(sort-help a lo (- piv 1) by)
|
(sort-help a lo (- piv 1) by)
|
||||||
(sort-help a (+ piv 1) hi by))
|
(sort-help a (+ piv 1) hi by))
|
||||||
a)
|
a)
|
||||||
@@ -707,54 +684,32 @@
|
|||||||
(def i (find-index pred ind))
|
(def i (find-index pred ind))
|
||||||
(if (= i nil) nil (get ind i)))
|
(if (= i nil) nil (get ind i)))
|
||||||
|
|
||||||
(defn take
|
|
||||||
"Take first n elements in an indexed type. Returns new indexed instance."
|
|
||||||
[n ind]
|
|
||||||
(def use-str (bytes? ind))
|
|
||||||
(def f (if use-str string/slice tuple/slice))
|
|
||||||
# make sure end is in [0, len]
|
|
||||||
(def end (max 0 (min n (length ind))))
|
|
||||||
(f ind 0 end))
|
|
||||||
|
|
||||||
(defn take-until
|
(defn take-until
|
||||||
"Same as (take-while (complement pred) ind)."
|
|
||||||
[pred ind]
|
|
||||||
(def use-str (bytes? ind))
|
|
||||||
(def f (if use-str string/slice tuple/slice))
|
|
||||||
(def len (length ind))
|
|
||||||
(def i (find-index pred ind))
|
|
||||||
(def end (if (nil? i) len i))
|
|
||||||
(f ind 0 end))
|
|
||||||
|
|
||||||
(defn take-while
|
|
||||||
"Given a predicate, take only elements from an indexed type that satisfy
|
"Given a predicate, take only elements from an indexed type that satisfy
|
||||||
the predicate, and abort on first failure. Returns a new array."
|
the predicate, and abort on first failure. Returns a new array."
|
||||||
[pred ind]
|
[pred ind]
|
||||||
|
(def i (find-index pred ind))
|
||||||
|
(if i
|
||||||
|
(array/slice ind 0 i)
|
||||||
|
ind))
|
||||||
|
|
||||||
|
(defn take-while
|
||||||
|
"Same as (take-until (complement pred) ind)."
|
||||||
|
[pred ind]
|
||||||
(take-until (complement pred) ind))
|
(take-until (complement pred) ind))
|
||||||
|
|
||||||
(defn drop
|
|
||||||
"Drop first n elements in an indexed type. Returns new indexed instance."
|
|
||||||
[n ind]
|
|
||||||
(def use-str (bytes? ind))
|
|
||||||
(def f (if use-str string/slice tuple/slice))
|
|
||||||
# make sure start is in [0, len]
|
|
||||||
(def start (max 0 (min n (length ind))))
|
|
||||||
(f ind start -1))
|
|
||||||
|
|
||||||
(defn drop-until
|
(defn drop-until
|
||||||
"Same as (drop-while (complement pred) ind)."
|
|
||||||
[pred ind]
|
|
||||||
(def use-str (bytes? ind))
|
|
||||||
(def f (if use-str string/slice tuple/slice))
|
|
||||||
(def i (find-index pred ind))
|
|
||||||
(def len (length ind))
|
|
||||||
(def start (if (nil? i) len i))
|
|
||||||
(f ind start))
|
|
||||||
|
|
||||||
(defn drop-while
|
|
||||||
"Given a predicate, remove elements from an indexed type that satisfy
|
"Given a predicate, remove elements from an indexed type that satisfy
|
||||||
the predicate, and abort on first failure. Returns a new array."
|
the predicate, and abort on first failure. Returns a new array."
|
||||||
[pred ind]
|
[pred ind]
|
||||||
|
(def i (find-index pred ind))
|
||||||
|
(if i
|
||||||
|
(array/slice ind i)
|
||||||
|
@[]))
|
||||||
|
|
||||||
|
(defn drop-while
|
||||||
|
"Same as (drop-until (complement pred) ind)."
|
||||||
|
[pred ind]
|
||||||
(drop-until (complement pred) ind))
|
(drop-until (complement pred) ind))
|
||||||
|
|
||||||
(defn juxt*
|
(defn juxt*
|
||||||
@@ -904,10 +859,12 @@
|
|||||||
or signals, but the dynamic bindings will be properly
|
or signals, but the dynamic bindings will be properly
|
||||||
unset, as dynamic bindings are fiber local."
|
unset, as dynamic bindings are fiber local."
|
||||||
[bindings & body]
|
[bindings & body]
|
||||||
(def dyn-forms
|
(with-syms [currenv env fib]
|
||||||
(seq [i :range [0 (length bindings) 2]]
|
~(let [,currenv (,fiber/getenv (,fiber/current))
|
||||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
,env (,table/setproto (,table ,;bindings) ,currenv)
|
||||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
,fib (,fiber/new (fn [] ,;body) :)]
|
||||||
|
(,fiber/setenv ,fib ,env)
|
||||||
|
(,resume ,fib))))
|
||||||
|
|
||||||
(defn partial
|
(defn partial
|
||||||
"Partial function application."
|
"Partial function application."
|
||||||
@@ -957,58 +914,6 @@
|
|||||||
(put res (get keys i) (get vals i)))
|
(put res (get keys i) (get vals i)))
|
||||||
res)
|
res)
|
||||||
|
|
||||||
(defn get-in
|
|
||||||
"Access a value in a nested data structure. Looks into the data structure via
|
|
||||||
a sequence of keys."
|
|
||||||
[ds ks &opt dflt]
|
|
||||||
(var d ds)
|
|
||||||
(loop [k :in ks :while d] (set d (get d k)))
|
|
||||||
(or d dflt))
|
|
||||||
|
|
||||||
(defn update-in
|
|
||||||
"Update a value in a nested data structure by applying f to the current value.
|
|
||||||
Looks into the data structure via
|
|
||||||
a sequence of keys. Missing data structures will be replaced with tables. Returns
|
|
||||||
the modified, original data structure."
|
|
||||||
[ds ks f & args]
|
|
||||||
(var d ds)
|
|
||||||
(def len-1 (- (length ks) 1))
|
|
||||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
|
||||||
(for i 0 len-1
|
|
||||||
(def k (get ks i))
|
|
||||||
(def v (get d k))
|
|
||||||
(if (= nil v)
|
|
||||||
(let [newv (table)]
|
|
||||||
(put d k newv)
|
|
||||||
(set d newv))
|
|
||||||
(set d v)))
|
|
||||||
(def last-key (get ks len-1))
|
|
||||||
(def last-val (get d last-key))
|
|
||||||
(put d last-key (f last-val ;args))
|
|
||||||
ds)
|
|
||||||
|
|
||||||
(defn put-in
|
|
||||||
"Put a value into a nested data structure.
|
|
||||||
Looks into the data structure via
|
|
||||||
a sequence of keys. Missing data structures will be replaced with tables. Returns
|
|
||||||
the modified, original data structure."
|
|
||||||
[ds ks v]
|
|
||||||
(var d ds)
|
|
||||||
(def len-1 (- (length ks) 1))
|
|
||||||
(if (< len-1 0) (error "expected at least 1 key in ks"))
|
|
||||||
(for i 0 len-1
|
|
||||||
(def k (get ks i))
|
|
||||||
(def v (get d k))
|
|
||||||
(if (= nil v)
|
|
||||||
(let [newv (table)]
|
|
||||||
(put d k newv)
|
|
||||||
(set d newv))
|
|
||||||
(set d v)))
|
|
||||||
(def last-key (get ks len-1))
|
|
||||||
(def last-val (get d last-key))
|
|
||||||
(put d last-key v)
|
|
||||||
ds)
|
|
||||||
|
|
||||||
(defn update
|
(defn update
|
||||||
"Accepts a key argument and passes its associated value to a function.
|
"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
|
The key is the re-associated to the function's return value. Returns the updated
|
||||||
@@ -1150,11 +1055,6 @@
|
|||||||
(if (not= i len) (array/push ret (slicer ind i)))
|
(if (not= i len) (array/push ret (slicer ind i)))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
(defn slice
|
|
||||||
"Extract a sub-range of an indexed data strutrue or byte sequence."
|
|
||||||
[ind &opt start end]
|
|
||||||
((if (bytes? ind) string/slice tuple/slice) ind start end))
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### IO Helpers
|
### IO Helpers
|
||||||
@@ -1165,7 +1065,7 @@
|
|||||||
"Read all data from a file with name path
|
"Read all data from a file with name path
|
||||||
and then close the file."
|
and then close the file."
|
||||||
[path]
|
[path]
|
||||||
(def f (file/open path :rb))
|
(def f (file/open path :r))
|
||||||
(if-not f (error (string "could not open file " path)))
|
(if-not f (error (string "could not open file " path)))
|
||||||
(def contents (file/read f :all))
|
(def contents (file/read f :all))
|
||||||
(file/close f)
|
(file/close f)
|
||||||
@@ -1175,7 +1075,7 @@
|
|||||||
"Write contents to a file at path.
|
"Write contents to a file at path.
|
||||||
Can optionally append to the file."
|
Can optionally append to the file."
|
||||||
[path contents &opt mode]
|
[path contents &opt mode]
|
||||||
(default mode :wb)
|
(default mode :w)
|
||||||
(def f (file/open path mode))
|
(def f (file/open path mode))
|
||||||
(if-not f (error (string "could not open file " path " with mode " mode)))
|
(if-not f (error (string "could not open file " path " with mode " mode)))
|
||||||
(file/write f contents)
|
(file/write f contents)
|
||||||
@@ -1188,12 +1088,6 @@
|
|||||||
[f & args]
|
[f & args]
|
||||||
(file/write stdout (buffer/format @"" f ;args)))
|
(file/write stdout (buffer/format @"" f ;args)))
|
||||||
|
|
||||||
(defn pp
|
|
||||||
"Pretty print to stdout."
|
|
||||||
[x]
|
|
||||||
(print (buffer/format @"" (dyn :pretty-format "%q") x)))
|
|
||||||
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### Pattern Matching
|
### Pattern Matching
|
||||||
@@ -1232,8 +1126,8 @@
|
|||||||
(put seen pattern true)
|
(put seen pattern true)
|
||||||
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
|
~(if (= nil (def ,pattern ,expr)) ,sentinel ,(onmatch))))
|
||||||
|
|
||||||
(and (tuple? pattern) (= :parens (tuple/type pattern)))
|
(tuple? pattern)
|
||||||
(if (and (= (pattern 0) '@) (symbol? (pattern 1)))
|
(if (and (= (pattern 0) 'quote) (symbol? (pattern 1)))
|
||||||
# Unification with external values
|
# Unification with external values
|
||||||
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
|
~(if (= ,(pattern 1) ,expr) ,(onmatch) ,sentinel)
|
||||||
(match-1
|
(match-1
|
||||||
@@ -1241,7 +1135,7 @@
|
|||||||
(fn []
|
(fn []
|
||||||
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
|
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
|
||||||
|
|
||||||
(indexed? pattern)
|
(array? pattern)
|
||||||
(do
|
(do
|
||||||
(def len (length pattern))
|
(def len (length pattern))
|
||||||
(var i -1)
|
(var i -1)
|
||||||
@@ -1358,8 +1252,7 @@
|
|||||||
(def d (x :doc))
|
(def d (x :doc))
|
||||||
(print "\n\n"
|
(print "\n\n"
|
||||||
(if d bind-type "")
|
(if d bind-type "")
|
||||||
(if-let [[path line col] sm]
|
(if-let [[path start end] sm] (string " " path " (" start ":" end ")\n") "")
|
||||||
(string " " path " on line " line ", column " col "\n") "")
|
|
||||||
(if (or d sm) "\n" "")
|
(if (or d sm) "\n" "")
|
||||||
(if d (doc-format d) "no documentation found.")
|
(if d (doc-format d) "no documentation found.")
|
||||||
"\n\n"))))
|
"\n\n"))))
|
||||||
@@ -1376,21 +1269,14 @@
|
|||||||
###
|
###
|
||||||
|
|
||||||
(defn macex1
|
(defn macex1
|
||||||
"Expand macros in a form, but do not recursively expand macros.
|
"Expand macros in a form, but do not recursively expand macros."
|
||||||
See macex docs for info on on-binding."
|
[x]
|
||||||
[x &opt on-binding]
|
|
||||||
|
|
||||||
(when on-binding
|
|
||||||
(when (symbol? x)
|
|
||||||
(break (on-binding x))))
|
|
||||||
|
|
||||||
(defn recur [y] (macex1 y on-binding))
|
|
||||||
|
|
||||||
(defn dotable [t on-value]
|
(defn dotable [t on-value]
|
||||||
(def newt @{})
|
(def newt @{})
|
||||||
(var key (next t nil))
|
(var key (next t nil))
|
||||||
(while (not= nil key)
|
(while (not= nil key)
|
||||||
(put newt (recur key) (on-value (get t key)))
|
(put newt (macex1 key) (on-value (get t key)))
|
||||||
(set key (next t key)))
|
(set key (next t key)))
|
||||||
newt)
|
newt)
|
||||||
|
|
||||||
@@ -1400,7 +1286,7 @@
|
|||||||
:tuple (tuple/slice (map expand-bindings x))
|
:tuple (tuple/slice (map expand-bindings x))
|
||||||
:table (dotable x expand-bindings)
|
:table (dotable x expand-bindings)
|
||||||
:struct (table/to-struct (dotable x expand-bindings))
|
:struct (table/to-struct (dotable x expand-bindings))
|
||||||
(recur x)))
|
(macex1 x)))
|
||||||
|
|
||||||
(defn expanddef [t]
|
(defn expanddef [t]
|
||||||
(def last (get t (- (length t) 1)))
|
(def last (get t (- (length t) 1)))
|
||||||
@@ -1409,20 +1295,20 @@
|
|||||||
(array/concat
|
(array/concat
|
||||||
@[(get t 0) (expand-bindings bound)]
|
@[(get t 0) (expand-bindings bound)]
|
||||||
(tuple/slice t 2 -2)
|
(tuple/slice t 2 -2)
|
||||||
@[(recur last)])))
|
@[(macex1 last)])))
|
||||||
|
|
||||||
(defn expandall [t]
|
(defn expandall [t]
|
||||||
(def args (map recur (tuple/slice t 1)))
|
(def args (map macex1 (tuple/slice t 1)))
|
||||||
(tuple (get t 0) ;args))
|
(tuple (get t 0) ;args))
|
||||||
|
|
||||||
(defn expandfn [t]
|
(defn expandfn [t]
|
||||||
(def t1 (get t 1))
|
(def t1 (get t 1))
|
||||||
(if (symbol? t1)
|
(if (symbol? t1)
|
||||||
(do
|
(do
|
||||||
(def args (map recur (tuple/slice t 3)))
|
(def args (map macex1 (tuple/slice t 3)))
|
||||||
(tuple 'fn t1 (get t 2) ;args))
|
(tuple 'fn t1 (get t 2) ;args))
|
||||||
(do
|
(do
|
||||||
(def args (map recur (tuple/slice t 2)))
|
(def args (map macex1 (tuple/slice t 2)))
|
||||||
(tuple 'fn t1 ;args))))
|
(tuple 'fn t1 ;args))))
|
||||||
|
|
||||||
(defn expandqq [t]
|
(defn expandqq [t]
|
||||||
@@ -1431,7 +1317,7 @@
|
|||||||
:tuple (do
|
:tuple (do
|
||||||
(def x0 (get x 0))
|
(def x0 (get x 0))
|
||||||
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
|
(if (or (= 'unquote x0) (= 'unquote-splicing x0))
|
||||||
(tuple x0 (recur (get x 1)))
|
(tuple x0 (macex1 (get x 1)))
|
||||||
(tuple/slice (map qq x))))
|
(tuple/slice (map qq x))))
|
||||||
:array (map qq x)
|
:array (map qq x)
|
||||||
:table (table (map qq (kvs x)))
|
:table (table (map qq (kvs x)))
|
||||||
@@ -1459,16 +1345,16 @@
|
|||||||
(cond
|
(cond
|
||||||
s (s t)
|
s (s t)
|
||||||
m? (m ;(tuple/slice t 1))
|
m? (m ;(tuple/slice t 1))
|
||||||
(tuple/slice (map recur t))))
|
(tuple/slice (map macex1 t))))
|
||||||
|
|
||||||
(def ret
|
(def ret
|
||||||
(case (type x)
|
(case (type x)
|
||||||
:tuple (if (= (tuple/type x) :brackets)
|
:tuple (if (= (tuple/type x) :brackets)
|
||||||
(tuple/brackets ;(map recur x))
|
(tuple/brackets ;(map macex1 x))
|
||||||
(dotup x))
|
(dotup x))
|
||||||
:array (map recur x)
|
:array (map macex1 x)
|
||||||
:struct (table/to-struct (dotable x recur))
|
:struct (table/to-struct (dotable x macex1))
|
||||||
:table (dotable x recur)
|
:table (dotable x macex1)
|
||||||
x))
|
x))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
@@ -1507,103 +1393,23 @@
|
|||||||
[x y]
|
[x y]
|
||||||
(not (deep-not= x y)))
|
(not (deep-not= x y)))
|
||||||
|
|
||||||
(defn freeze
|
|
||||||
"Freeze an object (make it immutable) and do a deep copy, making
|
|
||||||
child values also immutable. Closures, fibers, and abstract types
|
|
||||||
will not be recursively frozen, but all other types will."
|
|
||||||
[x]
|
|
||||||
(case (type x)
|
|
||||||
:array (tuple/slice (map freeze x))
|
|
||||||
:tuple (tuple/slice (map freeze x))
|
|
||||||
:table (if-let [p (table/getproto x)]
|
|
||||||
(freeze (merge (table/clone p) x))
|
|
||||||
(struct ;(map freeze (kvs x))))
|
|
||||||
:struct (struct ;(map freeze (kvs x)))
|
|
||||||
:buffer (string x)
|
|
||||||
x))
|
|
||||||
|
|
||||||
(defn macex
|
(defn macex
|
||||||
"Expand macros completely.
|
"Expand macros completely."
|
||||||
on-binding is an optional callback whenever a normal symbolic binding
|
[x]
|
||||||
is encounter. This allows macros to easily see all bindings use by their
|
|
||||||
arguments by calling macex on their contents. The binding itself is also
|
|
||||||
replaced by the value returned by on-binding within the expand macro."
|
|
||||||
[x &opt on-binding]
|
|
||||||
(var previous x)
|
(var previous x)
|
||||||
(var current (macex1 x on-binding))
|
(var current (macex1 x))
|
||||||
(var counter 0)
|
(var counter 0)
|
||||||
(while (deep-not= current previous)
|
(while (deep-not= current previous)
|
||||||
(if (> (++ counter) 200)
|
(if (> (++ counter) 200)
|
||||||
(error "macro expansion too nested"))
|
(error "macro expansion too nested"))
|
||||||
(set previous current)
|
(set previous current)
|
||||||
(set current (macex1 current on-binding)))
|
(set current (macex1 current)))
|
||||||
current)
|
current)
|
||||||
|
|
||||||
(defmacro varfn
|
(defn pp
|
||||||
"Create a function that can be rebound. varfn has the same signature
|
"Pretty print to stdout."
|
||||||
as defn, but defines functions in the environment as vars. If a var 'name'
|
|
||||||
already exists in the environment, it is rebound to the new function. Returns
|
|
||||||
a function."
|
|
||||||
[name & body]
|
|
||||||
(def expansion (apply defn name body))
|
|
||||||
(def fbody (last expansion))
|
|
||||||
(def modifiers (tuple/slice expansion 2 -2))
|
|
||||||
(def metadata @{})
|
|
||||||
(each m modifiers
|
|
||||||
(cond
|
|
||||||
(keyword? m) (put metadata m true)
|
|
||||||
(string? m) (put metadata :doc m)
|
|
||||||
(error (string "invalid metadata " m))))
|
|
||||||
(with-syms [entry old-entry f]
|
|
||||||
~(let [,old-entry (,dyn ',name)]
|
|
||||||
(def ,entry (or ,old-entry @{:ref @[nil]}))
|
|
||||||
(,setdyn ',name ,entry)
|
|
||||||
(def ,f ,fbody)
|
|
||||||
(,put-in ,entry [:ref 0] ,f)
|
|
||||||
(,merge-into ,entry ',metadata)
|
|
||||||
,f)))
|
|
||||||
|
|
||||||
###
|
|
||||||
###
|
|
||||||
### Function shorthand
|
|
||||||
###
|
|
||||||
###
|
|
||||||
|
|
||||||
(defmacro short-fn
|
|
||||||
"fn shorthand.\n\n
|
|
||||||
usage:\n\n
|
|
||||||
\t(short-fn (+ $ $)) - A function that double's its arguments.\n
|
|
||||||
\t(short-fn (string $0 $1)) - accepting multiple args\n
|
|
||||||
\t|(+ $ $) - use pipe reader macro for terse function literals\n
|
|
||||||
\t|(+ $&) - variadic functions"
|
|
||||||
[arg]
|
|
||||||
(var max-param-seen -1)
|
|
||||||
(var vararg false)
|
|
||||||
(defn saw-special-arg
|
|
||||||
[num]
|
|
||||||
(set max-param-seen (max max-param-seen num)))
|
|
||||||
(defn on-binding
|
|
||||||
[x]
|
[x]
|
||||||
(if (string/has-prefix? '$ x)
|
(print (buffer/format @"" (dyn :pretty-format "%p") x)))
|
||||||
(cond
|
|
||||||
(= '$ x)
|
|
||||||
(do
|
|
||||||
(saw-special-arg 0)
|
|
||||||
'$0)
|
|
||||||
(= '$& x)
|
|
||||||
(do
|
|
||||||
(set vararg true)
|
|
||||||
x)
|
|
||||||
:else
|
|
||||||
(do
|
|
||||||
(def num (scan-number (string/slice x 1)))
|
|
||||||
(if (nat? num)
|
|
||||||
(saw-special-arg num))
|
|
||||||
x))
|
|
||||||
x))
|
|
||||||
(def expanded (macex arg on-binding))
|
|
||||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol '$ i)))
|
|
||||||
~(fn [,;fn-args ,;(if vararg ['& '$&] [])] ,expanded))
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@@ -1611,10 +1417,10 @@
|
|||||||
###
|
###
|
||||||
###
|
###
|
||||||
|
|
||||||
# Get boot options
|
# Get process options
|
||||||
(def- boot/opts @{})
|
(def- process/opts @{})
|
||||||
(each [k v] (partition 2 (tuple/slice boot/args 2))
|
(each [k v] (partition 2 (tuple/slice process/args 2))
|
||||||
(put boot/opts k v))
|
(put process/opts k v))
|
||||||
|
|
||||||
(defn make-env
|
(defn make-env
|
||||||
"Create a new environment table. The new environment
|
"Create a new environment table. The new environment
|
||||||
@@ -1628,33 +1434,19 @@
|
|||||||
(defn bad-parse
|
(defn bad-parse
|
||||||
"Default handler for a parse error."
|
"Default handler for a parse error."
|
||||||
[p where]
|
[p where]
|
||||||
(def ec (dyn :err-color))
|
|
||||||
(def [line col] (parser/where p))
|
|
||||||
(file/write stderr
|
(file/write stderr
|
||||||
(if ec "\e[31m" "")
|
|
||||||
"parse error in "
|
"parse error in "
|
||||||
where
|
where
|
||||||
" around line "
|
" around byte "
|
||||||
(string line)
|
(string (parser/where p))
|
||||||
", column "
|
|
||||||
(string col)
|
|
||||||
": "
|
": "
|
||||||
(parser/error p)
|
(parser/error p)
|
||||||
(if ec "\e[0m" "")
|
|
||||||
"\n"))
|
"\n"))
|
||||||
|
|
||||||
(defn bad-compile
|
(defn bad-compile
|
||||||
"Default handler for a compile error."
|
"Default handler for a compile error."
|
||||||
[msg macrof where]
|
[msg macrof where]
|
||||||
(def ec (dyn :err-color))
|
(file/write stderr "compile error: " msg " while compiling " where "\n")
|
||||||
(file/write stderr
|
|
||||||
(if ec "\e[31m" "")
|
|
||||||
"compile error: "
|
|
||||||
msg
|
|
||||||
" while compiling "
|
|
||||||
where
|
|
||||||
(if ec "\e[0m" "")
|
|
||||||
"\n")
|
|
||||||
(when macrof (debug/stacktrace macrof)))
|
(when macrof (debug/stacktrace macrof)))
|
||||||
|
|
||||||
(defn run-context
|
(defn run-context
|
||||||
@@ -1666,10 +1458,9 @@
|
|||||||
:env - the environment to compile against - default is the current 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
|
: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
|
:on-compile-error - callback when compilation fails - default is bad-compile\n\t
|
||||||
:compile-only - only compile the source, do not execute it - default is false\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
|
: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 :ia.\n\t
|
:fiber-flags - what flags to wrap the compilation fiber with. Default is :ia."
|
||||||
:expander - an optional function that is called on each top level form before being compiled."
|
|
||||||
[opts]
|
[opts]
|
||||||
|
|
||||||
(def {:env env
|
(def {:env env
|
||||||
@@ -1679,8 +1470,7 @@
|
|||||||
:on-parse-error on-parse-error
|
:on-parse-error on-parse-error
|
||||||
:fiber-flags guard
|
:fiber-flags guard
|
||||||
:compile-only compile-only
|
:compile-only compile-only
|
||||||
:source where
|
:source where} opts)
|
||||||
:expander expand} opts)
|
|
||||||
(default env (fiber/getenv (fiber/current)))
|
(default env (fiber/getenv (fiber/current)))
|
||||||
(default chunks (fn [buf p] (getline "" buf)))
|
(default chunks (fn [buf p] (getline "" buf)))
|
||||||
(default compile-only false)
|
(default compile-only false)
|
||||||
@@ -1697,7 +1487,6 @@
|
|||||||
|
|
||||||
# Evaluate 1 source form in a protected manner
|
# Evaluate 1 source form in a protected manner
|
||||||
(defn eval1 [source]
|
(defn eval1 [source]
|
||||||
(def source (if expand (expand source) source))
|
|
||||||
(var good true)
|
(var good true)
|
||||||
(def f
|
(def f
|
||||||
(fiber/new
|
(fiber/new
|
||||||
@@ -1707,10 +1496,10 @@
|
|||||||
(unless compile-only (res))
|
(unless compile-only (res))
|
||||||
(do
|
(do
|
||||||
(set good false)
|
(set good false)
|
||||||
(def {:error err :line line :column column :fiber errf} res)
|
(def {:error err :start start :end end :fiber errf} res)
|
||||||
(def msg
|
(def msg
|
||||||
(if (<= 0 line)
|
(if (<= 0 start)
|
||||||
(string err " on line " line ", column " column)
|
(string err " at (" start ":" end ")")
|
||||||
err))
|
err))
|
||||||
(on-compile-error msg errf where))))
|
(on-compile-error msg errf where))))
|
||||||
(or guard :a)))
|
(or guard :a)))
|
||||||
@@ -1721,7 +1510,6 @@
|
|||||||
# Loop
|
# Loop
|
||||||
(def buf @"")
|
(def buf @"")
|
||||||
(while going
|
(while going
|
||||||
(if (env :exit) (break))
|
|
||||||
(buffer/clear buf)
|
(buffer/clear buf)
|
||||||
(chunks buf p)
|
(chunks buf p)
|
||||||
(var pindex 0)
|
(var pindex 0)
|
||||||
@@ -1744,13 +1532,6 @@
|
|||||||
|
|
||||||
env)
|
env)
|
||||||
|
|
||||||
(defn quit
|
|
||||||
"Tries to exit from the current repl or context. Does not always exit the application.
|
|
||||||
Works by setting the :exit dynamic binding to true."
|
|
||||||
[]
|
|
||||||
(setdyn :exit true)
|
|
||||||
"Bye!")
|
|
||||||
|
|
||||||
(defn eval-string
|
(defn eval-string
|
||||||
"Evaluates a string in the current environment. If more control over the
|
"Evaluates a string in the current environment. If more control over the
|
||||||
environment is needed, use run-context."
|
environment is needed, use run-context."
|
||||||
@@ -1796,39 +1577,42 @@
|
|||||||
[image]
|
[image]
|
||||||
(unmarshal image (env-lookup _env)))
|
(unmarshal image (env-lookup _env)))
|
||||||
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(def module/paths
|
(def module/paths
|
||||||
"The list of paths to look for modules, templated for module/expand-path.
|
"The list of paths to look for modules. The following
|
||||||
Each element is a two element tuple, containing the path
|
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
|
template and a keyword :source, :native, or :image indicating how
|
||||||
require should load files found at these paths.\n\nA tuple can also
|
require should load files found at these paths.\n\nA tuple can also
|
||||||
contain a third element, specifying a filter that prevents module/find
|
contain a third element, specifying a filter that prevents module/find
|
||||||
from searching that path template if the filter doesn't match the input
|
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
|
path. The filter is often a file extension, including the period."
|
||||||
is often a file extension, including the period."
|
@[[":all:" :native (if (= (os/which) :windows) ".dll" ".so")]
|
||||||
@[# Relative to (dyn :current-file "./."). Path must start with .
|
[":all:" :image ".jimage"]
|
||||||
[":cur:/:all:.jimage" :image check-.]
|
[":all:" :source]
|
||||||
[":cur:/:all:.janet" :source check-.]
|
["./:all:.janet" :source]
|
||||||
[":cur:/:all:/init.janet" :source check-.]
|
["./:all:/init.janet" :source]
|
||||||
[(string ":cur:/:all:" nati) :native check-.]
|
[":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]])
|
||||||
|
|
||||||
# As a path from (os/cwd)
|
(var module/*syspath*
|
||||||
[":all:.jimage" :image not-check-.]
|
"The path where globally installed libraries are located.
|
||||||
[":all:.janet" :source not-check-.]
|
The default is set at build time and is /usr/local/lib/janet on linux/posix, and
|
||||||
[":all:/init.janet" :source not-check-.]
|
on Windows is the empty string."
|
||||||
[(string ":all:" nati) :native not-check-.]
|
(or (process/opts "JANET_PATH") ""))
|
||||||
|
|
||||||
# System paths
|
(var module/*headerpath*
|
||||||
[":sys:/:all:.jimage" :image not-check-.]
|
"The path where the janet headers are installed. Useful for building
|
||||||
[":sys:/:all:.janet" :source not-check-.]
|
native modules or compiling code at runtime. Default on linux/posix is
|
||||||
[":sys:/:all:/init.janet" :source not-check-.]
|
/usr/local/include/janet, and on Windows is the empty string."
|
||||||
[(string ":sys:/:all:" nati) :native not-check-.]])
|
(or (process/opts "JANET_HEADERPATH") ""))
|
||||||
|
|
||||||
(setdyn :syspath (boot/opts "JANET_PATH"))
|
|
||||||
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
|
|
||||||
|
|
||||||
# Version of fexists that works even with a reduced OS
|
# Version of fexists that works even with a reduced OS
|
||||||
(if-let [has-stat (_env 'os/stat)]
|
(if-let [has-stat (_env 'os/stat)]
|
||||||
@@ -1836,7 +1620,7 @@
|
|||||||
(defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
|
(defglobal "fexists" (fn fexists [path] (= :file (stat path :mode)))))
|
||||||
(defglobal "fexists"
|
(defglobal "fexists"
|
||||||
(fn fexists [path]
|
(fn fexists [path]
|
||||||
(def f (file/open path :rb))
|
(def f (file/open path))
|
||||||
(when f
|
(when f
|
||||||
(def res
|
(def res
|
||||||
(try (do (file/read f 1) true)
|
(try (do (file/read f 1) true)
|
||||||
@@ -1844,6 +1628,14 @@
|
|||||||
(file/close f)
|
(file/close f)
|
||||||
res))))
|
res))))
|
||||||
|
|
||||||
|
(def nati (if (= :windows (os/which)) "dll" "so"))
|
||||||
|
(defn- expand-path-name
|
||||||
|
[template name path]
|
||||||
|
(->> template
|
||||||
|
(string/replace ":name:" name)
|
||||||
|
(string/replace ":sys:" module/*syspath*)
|
||||||
|
(string/replace ":native:" nati)
|
||||||
|
(string/replace ":all:" path)))
|
||||||
(defn- mod-filter
|
(defn- mod-filter
|
||||||
[x path]
|
[x path]
|
||||||
(case (type x)
|
(case (type x)
|
||||||
@@ -1857,6 +1649,8 @@
|
|||||||
or image if the module is found, otherwise a tuple with nil followed by
|
or image if the module is found, otherwise a tuple with nil followed by
|
||||||
an error message."
|
an error message."
|
||||||
[path]
|
[path]
|
||||||
|
(def parts (string/split "/" path))
|
||||||
|
(def name (last parts))
|
||||||
(var ret nil)
|
(var ret nil)
|
||||||
(each [p mod-kind checker] module/paths
|
(each [p mod-kind checker] module/paths
|
||||||
(when (mod-filter checker path)
|
(when (mod-filter checker path)
|
||||||
@@ -1865,7 +1659,7 @@
|
|||||||
(set ret [res mod-kind])
|
(set ret [res mod-kind])
|
||||||
(break))
|
(break))
|
||||||
(do
|
(do
|
||||||
(def fullpath (string (module/expand-path path p)))
|
(def fullpath (expand-path-name p name path))
|
||||||
(when (fexists fullpath)
|
(when (fexists fullpath)
|
||||||
(set ret [fullpath mod-kind])
|
(set ret [fullpath mod-kind])
|
||||||
(break))))))
|
(break))))))
|
||||||
@@ -1873,16 +1667,15 @@
|
|||||||
(let [expander (fn [[t _ chk]]
|
(let [expander (fn [[t _ chk]]
|
||||||
(when (string? t)
|
(when (string? t)
|
||||||
(when (mod-filter chk path)
|
(when (mod-filter chk path)
|
||||||
(module/expand-path path t))))
|
(expand-path-name t name path))))
|
||||||
paths (filter identity (map expander module/paths))
|
paths (filter identity (map expander module/paths))
|
||||||
str-parts (interpose "\n " paths)]
|
str-parts (interpose "\n " paths)]
|
||||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||||
|
|
||||||
(put _env 'fexists nil)
|
(put _env 'fexists nil)
|
||||||
(put _env 'nati nil)
|
(put _env 'nati nil)
|
||||||
|
(put _env 'expand-path-name nil)
|
||||||
(put _env 'mod-filter nil)
|
(put _env 'mod-filter nil)
|
||||||
(put _env 'check-. nil)
|
|
||||||
(put _env 'not-check-. nil)
|
|
||||||
|
|
||||||
(def module/cache
|
(def module/cache
|
||||||
"Table mapping loaded module identifiers to their environments."
|
"Table mapping loaded module identifiers to their environments."
|
||||||
@@ -1902,9 +1695,8 @@
|
|||||||
:compile-only compile-only} (table ;args))
|
:compile-only compile-only} (table ;args))
|
||||||
(def f (if (= (type path) :core/file)
|
(def f (if (= (type path) :core/file)
|
||||||
path
|
path
|
||||||
(file/open path :rb)))
|
(file/open path)))
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(put env :current-file (string path))
|
|
||||||
(defn chunks [buf _] (file/read f 2048 buf))
|
(defn chunks [buf _] (file/read f 2048 buf))
|
||||||
(defn bp [&opt x y]
|
(defn bp [&opt x y]
|
||||||
(def ret (bad-parse x y))
|
(def ret (bad-parse x y))
|
||||||
@@ -1935,7 +1727,6 @@
|
|||||||
:source (fn [path args]
|
:source (fn [path args]
|
||||||
(put module/loading path true)
|
(put module/loading path true)
|
||||||
(def newenv (dofile path ;args))
|
(def newenv (dofile path ;args))
|
||||||
(put newenv :source path)
|
|
||||||
(put module/loading path nil)
|
(put module/loading path nil)
|
||||||
newenv)
|
newenv)
|
||||||
:image (fn [path &] (load-image (slurp path)))})
|
:image (fn [path &] (load-image (slurp path)))})
|
||||||
@@ -1945,15 +1736,16 @@
|
|||||||
module/paths, then the path as a raw file path. Returns the new environment
|
module/paths, then the path as a raw file path. Returns the new environment
|
||||||
returned from compiling and running the file."
|
returned from compiling and running the file."
|
||||||
[path & args]
|
[path & args]
|
||||||
(def [fullpath mod-kind] (module/find path))
|
(if-let [check (get module/cache path)]
|
||||||
(unless fullpath (error mod-kind))
|
|
||||||
(if-let [check (get module/cache fullpath)]
|
|
||||||
check
|
check
|
||||||
(do
|
(do
|
||||||
|
(def [fullpath mod-kind] (module/find path))
|
||||||
|
(unless fullpath (error mod-kind))
|
||||||
(def loader (module/loaders mod-kind))
|
(def loader (module/loaders mod-kind))
|
||||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||||
(def env (loader fullpath args))
|
(def env (loader fullpath args))
|
||||||
(put module/cache fullpath env)
|
(put module/cache fullpath env)
|
||||||
|
(put module/cache path env)
|
||||||
env)))
|
env)))
|
||||||
|
|
||||||
(defn import*
|
(defn import*
|
||||||
@@ -1986,12 +1778,6 @@
|
|||||||
args))
|
args))
|
||||||
(tuple import* (string path) ;argm))
|
(tuple import* (string path) ;argm))
|
||||||
|
|
||||||
(defmacro use
|
|
||||||
"Similar to import, but imported bindings are not prefixed with a namespace
|
|
||||||
identifier. Can also import multiple modules in one shot."
|
|
||||||
[& modules]
|
|
||||||
~(do ,;(map (fn [x] ~(,import* ,(string x) :prefix "")) modules)))
|
|
||||||
|
|
||||||
(defn repl
|
(defn repl
|
||||||
"Run a repl. The first parameter is an optional function to call to
|
"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.
|
get a chunk of source code that should return nil for end of file.
|
||||||
@@ -2001,9 +1787,9 @@
|
|||||||
(def level (+ (dyn :debug-level 0) 1))
|
(def level (+ (dyn :debug-level 0) 1))
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(default chunks (fn [buf p] (getline (string "repl:"
|
(default chunks (fn [buf p] (getline (string "repl:"
|
||||||
((parser/where p) 0)
|
(parser/where p)
|
||||||
":"
|
":"
|
||||||
(parser/state p :delimiters) "> ")
|
(parser/state p) "> ")
|
||||||
buf)))
|
buf)))
|
||||||
(default onsignal (fn [f x]
|
(default onsignal (fn [f x]
|
||||||
(case (fiber/status f)
|
(case (fiber/status f)
|
||||||
@@ -2016,13 +1802,13 @@
|
|||||||
(debug/stacktrace f x)
|
(debug/stacktrace f x)
|
||||||
(print ```
|
(print ```
|
||||||
|
|
||||||
entering debugger - (quit) or Ctrl-D to exit
|
entering debugger - Ctrl-D to exit
|
||||||
_fiber is bound to the suspended fiber
|
_fiber is bound to the suspended fiber
|
||||||
|
|
||||||
```)
|
```)
|
||||||
(repl (fn [buf p]
|
(repl (fn [buf p]
|
||||||
(def status (parser/state p :delimiters))
|
(def status (parser/state p))
|
||||||
(def c ((parser/where p) 0))
|
(def c (parser/where p))
|
||||||
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
(def prompt (string "debug[" level "]:" c ":" status "> "))
|
||||||
(getline prompt buf))
|
(getline prompt buf))
|
||||||
onsignal nextenv))
|
onsignal nextenv))
|
||||||
@@ -2033,8 +1819,8 @@ _fiber is bound to the suspended fiber
|
|||||||
:source "repl"}))
|
:source "repl"}))
|
||||||
|
|
||||||
(defn- env-walk
|
(defn- env-walk
|
||||||
[pred &opt env]
|
[pred]
|
||||||
(default env (fiber/getenv (fiber/current)))
|
(def env (fiber/getenv (fiber/current)))
|
||||||
(def envs @[])
|
(def envs @[])
|
||||||
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
(do (var e env) (while e (array/push envs e) (set e (table/getproto e))))
|
||||||
(def ret-set @{})
|
(def ret-set @{})
|
||||||
@@ -2045,19 +1831,17 @@ _fiber is bound to the suspended fiber
|
|||||||
(sort (keys ret-set)))
|
(sort (keys ret-set)))
|
||||||
|
|
||||||
(defn all-bindings
|
(defn all-bindings
|
||||||
"Get all symbols available in an enviroment. Defaults to the current
|
"Get all symbols available in the current environment."
|
||||||
fiber's environment."
|
[]
|
||||||
[&opt env]
|
(env-walk symbol?))
|
||||||
(env-walk symbol? env))
|
|
||||||
|
|
||||||
(defn all-dynamics
|
(defn all-dynamics
|
||||||
"Get all dynamic bindings in an environment. Defaults to the current
|
"Get all dynamic bindings in the current fiber."
|
||||||
fiber's environment."
|
[]
|
||||||
[&opt env]
|
(env-walk keyword?))
|
||||||
(env-walk keyword? env))
|
|
||||||
|
|
||||||
# Clean up some extra defs
|
# Clean up some extra defs
|
||||||
(put _env 'boot/opts nil)
|
(put _env 'process/opts nil)
|
||||||
(put _env 'env-walk nil)
|
(put _env 'env-walk nil)
|
||||||
(put _env '_env nil)
|
(put _env '_env nil)
|
||||||
|
|
||||||
@@ -2068,30 +1852,7 @@ _fiber is bound to the suspended fiber
|
|||||||
###
|
###
|
||||||
|
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(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)))
|
(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 (boot/config :no-docstrings)
|
|
||||||
(put flat :doc nil))
|
|
||||||
(when (boot/config :no-sourcemaps)
|
|
||||||
(put flat :source-map nil))
|
|
||||||
(put env k flat))
|
|
||||||
|
|
||||||
(put env 'boot/config nil)
|
|
||||||
(put env 'boot/args nil)
|
|
||||||
(def image (let [env-pairs (pairs (env-lookup env))
|
(def image (let [env-pairs (pairs (env-lookup env))
|
||||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||||
lookup (table ;(mapcat identity essential-pairs))
|
lookup (table ;(mapcat identity essential-pairs))
|
||||||
@@ -2102,7 +1863,7 @@ _fiber is bound to the suspended fiber
|
|||||||
# can be compiled and linked statically into the main janet library
|
# can be compiled and linked statically into the main janet library
|
||||||
# and example client.
|
# and example client.
|
||||||
(def chunks (string/bytes image))
|
(def chunks (string/bytes image))
|
||||||
(def image-file (file/open (boot/args 1) :wb))
|
(def image-file (file/open (process/args 1) :w))
|
||||||
(file/write image-file
|
(file/write image-file
|
||||||
"#ifndef JANET_AMALG\n"
|
"#ifndef JANET_AMALG\n"
|
||||||
"#include <janet.h>\n"
|
"#include <janet.h>\n"
|
||||||
|
|||||||
@@ -26,19 +26,10 @@
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Create new userdata */
|
/* Create new userdata */
|
||||||
void *janet_abstract_begin(const JanetAbstractType *atype, size_t size) {
|
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
||||||
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_NONE,
|
JanetAbstractHead *header = janet_gcalloc(JANET_MEMORY_ABSTRACT,
|
||||||
sizeof(JanetAbstractHead) + size);
|
sizeof(JanetAbstractHead) + size);
|
||||||
header->size = size;
|
header->size = size;
|
||||||
header->type = atype;
|
header->type = atype;
|
||||||
return (void *) & (header->data);
|
return (void *) & (header->data);
|
||||||
}
|
}
|
||||||
|
|
||||||
void *janet_abstract_end(void *x) {
|
|
||||||
janet_gc_settype((void *)(janet_abstract_head(x)), JANET_MEMORY_ABSTRACT);
|
|
||||||
return x;
|
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_abstract(const JanetAbstractType *atype, size_t size) {
|
|
||||||
return janet_abstract_end(janet_abstract_begin(atype, size));
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -24,17 +24,14 @@
|
|||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#include <string.h>
|
#include <string.h>
|
||||||
|
|
||||||
/* Creates a new array */
|
/* Initializes an array */
|
||||||
JanetArray *janet_array(int32_t capacity) {
|
JanetArray *janet_array_init(JanetArray *array, int32_t capacity) {
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
|
||||||
Janet *data = NULL;
|
Janet *data = NULL;
|
||||||
if (capacity > 0) {
|
if (capacity > 0) {
|
||||||
janet_vm_next_collection += capacity * sizeof(Janet);
|
|
||||||
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
data = (Janet *) malloc(sizeof(Janet) * capacity);
|
||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -46,6 +43,16 @@ JanetArray *janet_array(int32_t capacity) {
|
|||||||
return array;
|
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. */
|
/* Creates a new array from n elements. */
|
||||||
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
JanetArray *janet_array_n(const Janet *elements, int32_t n) {
|
||||||
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
JanetArray *array = janet_gcalloc(JANET_MEMORY_ARRAY, sizeof(JanetArray));
|
||||||
@@ -64,14 +71,11 @@ void janet_array_ensure(JanetArray *array, int32_t capacity, int32_t growth) {
|
|||||||
Janet *newData;
|
Janet *newData;
|
||||||
Janet *old = array->data;
|
Janet *old = array->data;
|
||||||
if (capacity <= array->capacity) return;
|
if (capacity <= array->capacity) return;
|
||||||
int64_t new_capacity = ((int64_t) capacity) * growth;
|
capacity *= growth;
|
||||||
if (new_capacity > INT32_MAX) new_capacity = INT32_MAX;
|
|
||||||
capacity = (int32_t) new_capacity;
|
|
||||||
newData = realloc(old, capacity * sizeof(Janet));
|
newData = realloc(old, capacity * sizeof(Janet));
|
||||||
if (NULL == newData) {
|
if (NULL == newData) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm_next_collection += (capacity - array->capacity) * sizeof(Janet);
|
|
||||||
array->data = newData;
|
array->data = newData;
|
||||||
array->capacity = capacity;
|
array->capacity = capacity;
|
||||||
}
|
}
|
||||||
@@ -269,7 +273,7 @@ static const JanetReg array_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"array/slice", cfun_array_slice,
|
"array/slice", cfun_array_slice,
|
||||||
JDOC("(array/slice arrtup &opt start end)\n\n"
|
JDOC("(array/slice arrtup [, start=0 [, end=(length arrtup)]])\n\n"
|
||||||
"Takes a slice of array or tuple from start to end. The range is half open, "
|
"Takes a slice of array or tuple from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the array. "
|
"end of the array. By default, start is 0 and end is the length of the array. "
|
||||||
@@ -293,10 +297,9 @@ static const JanetReg array_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"array/remove", cfun_array_remove,
|
"array/remove", cfun_array_remove,
|
||||||
JDOC("(array/remove arr at &opt n)\n\n"
|
JDOC("(array/remove arr at [, n=1])\n\n"
|
||||||
"Remove up to n elements starting at index at in array arr. at can index from "
|
"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. "
|
"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.")
|
"Returns the array.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
|
|||||||
@@ -112,7 +112,6 @@ static const JanetInstructionDef janet_ops[] = {
|
|||||||
{"mul", JOP_MULTIPLY},
|
{"mul", JOP_MULTIPLY},
|
||||||
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
{"mulim", JOP_MULTIPLY_IMMEDIATE},
|
||||||
{"noop", JOP_NOOP},
|
{"noop", JOP_NOOP},
|
||||||
{"prop", JOP_PROPAGATE},
|
|
||||||
{"push", JOP_PUSH},
|
{"push", JOP_PUSH},
|
||||||
{"push2", JOP_PUSH_2},
|
{"push2", JOP_PUSH_2},
|
||||||
{"push3", JOP_PUSH_3},
|
{"push3", JOP_PUSH_3},
|
||||||
@@ -705,8 +704,8 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
|||||||
if (!janet_checkint(tup[1])) {
|
if (!janet_checkint(tup[1])) {
|
||||||
janet_asm_error(&a, "expected integer");
|
janet_asm_error(&a, "expected integer");
|
||||||
}
|
}
|
||||||
mapping.line = janet_unwrap_integer(tup[0]);
|
mapping.start = janet_unwrap_integer(tup[0]);
|
||||||
mapping.column = janet_unwrap_integer(tup[1]);
|
mapping.end = janet_unwrap_integer(tup[1]);
|
||||||
def->sourcemap[i] = mapping;
|
def->sourcemap[i] = mapping;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -749,31 +748,31 @@ static const JanetInstructionDef *janet_asm_reverse_lookup(uint32_t instr) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
/* Create some constant sized tuples */
|
/* Create some constant sized tuples */
|
||||||
static const Janet *tup1(Janet x) {
|
static Janet tup1(Janet x) {
|
||||||
Janet *tup = janet_tuple_begin(1);
|
Janet *tup = janet_tuple_begin(1);
|
||||||
tup[0] = x;
|
tup[0] = x;
|
||||||
return janet_tuple_end(tup);
|
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
}
|
}
|
||||||
static const Janet *tup2(Janet x, Janet y) {
|
static Janet tup2(Janet x, Janet y) {
|
||||||
Janet *tup = janet_tuple_begin(2);
|
Janet *tup = janet_tuple_begin(2);
|
||||||
tup[0] = x;
|
tup[0] = x;
|
||||||
tup[1] = y;
|
tup[1] = y;
|
||||||
return janet_tuple_end(tup);
|
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
}
|
}
|
||||||
static const Janet *tup3(Janet x, Janet y, Janet z) {
|
static Janet tup3(Janet x, Janet y, Janet z) {
|
||||||
Janet *tup = janet_tuple_begin(3);
|
Janet *tup = janet_tuple_begin(3);
|
||||||
tup[0] = x;
|
tup[0] = x;
|
||||||
tup[1] = y;
|
tup[1] = y;
|
||||||
tup[2] = z;
|
tup[2] = z;
|
||||||
return janet_tuple_end(tup);
|
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
}
|
}
|
||||||
static const Janet *tup4(Janet w, Janet x, Janet y, Janet z) {
|
static Janet tup4(Janet w, Janet x, Janet y, Janet z) {
|
||||||
Janet *tup = janet_tuple_begin(4);
|
Janet *tup = janet_tuple_begin(4);
|
||||||
tup[0] = w;
|
tup[0] = w;
|
||||||
tup[1] = x;
|
tup[1] = x;
|
||||||
tup[2] = y;
|
tup[2] = y;
|
||||||
tup[3] = z;
|
tup[3] = z;
|
||||||
return janet_tuple_end(tup);
|
return janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Given an argument, convert it to the appropriate integer or symbol */
|
/* Given an argument, convert it to the appropriate integer or symbol */
|
||||||
@@ -784,56 +783,41 @@ Janet janet_asm_decode_instruction(uint32_t instr) {
|
|||||||
return janet_wrap_integer((int32_t)instr);
|
return janet_wrap_integer((int32_t)instr);
|
||||||
}
|
}
|
||||||
name = janet_csymbolv(def->name);
|
name = janet_csymbolv(def->name);
|
||||||
const Janet *ret = NULL;
|
|
||||||
#define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask))
|
#define oparg(shift, mask) ((instr >> ((shift) << 3)) & (mask))
|
||||||
switch (janet_instructions[def->opcode]) {
|
switch (janet_instructions[def->opcode]) {
|
||||||
case JINT_0:
|
case JINT_0:
|
||||||
ret = tup1(name);
|
return tup1(name);
|
||||||
break;
|
|
||||||
case JINT_S:
|
case JINT_S:
|
||||||
ret = tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF)));
|
return tup2(name, janet_wrap_integer(oparg(1, 0xFFFFFF)));
|
||||||
break;
|
|
||||||
case JINT_L:
|
case JINT_L:
|
||||||
ret = tup2(name, janet_wrap_integer((int32_t)instr >> 8));
|
return tup2(name, janet_wrap_integer((int32_t)instr >> 8));
|
||||||
break;
|
|
||||||
case JINT_SS:
|
case JINT_SS:
|
||||||
case JINT_ST:
|
case JINT_ST:
|
||||||
case JINT_SC:
|
case JINT_SC:
|
||||||
case JINT_SU:
|
case JINT_SU:
|
||||||
case JINT_SD:
|
case JINT_SD:
|
||||||
ret = tup3(name,
|
return tup3(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFFFF)));
|
janet_wrap_integer(oparg(2, 0xFFFF)));
|
||||||
break;
|
|
||||||
case JINT_SI:
|
case JINT_SI:
|
||||||
case JINT_SL:
|
case JINT_SL:
|
||||||
ret = tup3(name,
|
return tup3(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer((int32_t)instr >> 16));
|
janet_wrap_integer((int32_t)instr >> 16));
|
||||||
break;
|
|
||||||
case JINT_SSS:
|
case JINT_SSS:
|
||||||
case JINT_SES:
|
case JINT_SES:
|
||||||
case JINT_SSU:
|
case JINT_SSU:
|
||||||
ret = tup4(name,
|
return tup4(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFF)),
|
janet_wrap_integer(oparg(2, 0xFF)),
|
||||||
janet_wrap_integer(oparg(3, 0xFF)));
|
janet_wrap_integer(oparg(3, 0xFF)));
|
||||||
break;
|
|
||||||
case JINT_SSI:
|
case JINT_SSI:
|
||||||
ret = tup4(name,
|
return tup4(name,
|
||||||
janet_wrap_integer(oparg(1, 0xFF)),
|
janet_wrap_integer(oparg(1, 0xFF)),
|
||||||
janet_wrap_integer(oparg(2, 0xFF)),
|
janet_wrap_integer(oparg(2, 0xFF)),
|
||||||
janet_wrap_integer((int32_t)instr >> 24));
|
janet_wrap_integer((int32_t)instr >> 24));
|
||||||
break;
|
|
||||||
}
|
}
|
||||||
#undef oparg
|
#undef oparg
|
||||||
if (ret) {
|
|
||||||
/* Check if break point set */
|
|
||||||
if (instr & 0x80) {
|
|
||||||
janet_tuple_flag(ret) |= JANET_TUPLE_FLAG_BRACKETCTOR;
|
|
||||||
}
|
|
||||||
return janet_wrap_tuple(ret);
|
|
||||||
}
|
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -864,7 +848,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
Janet src = def->constants[i];
|
Janet src = def->constants[i];
|
||||||
Janet dest;
|
Janet dest;
|
||||||
if (janet_checktype(src, JANET_TUPLE)) {
|
if (janet_checktype(src, JANET_TUPLE)) {
|
||||||
dest = janet_wrap_tuple(tup2(janet_csymbolv("quote"), src));
|
dest = tup2(janet_csymbolv("quote"), src);
|
||||||
} else {
|
} else {
|
||||||
dest = src;
|
dest = src;
|
||||||
}
|
}
|
||||||
@@ -885,8 +869,8 @@ Janet janet_disasm(JanetFuncDef *def) {
|
|||||||
for (i = 0; i < def->bytecode_length; i++) {
|
for (i = 0; i < def->bytecode_length; i++) {
|
||||||
Janet *t = janet_tuple_begin(2);
|
Janet *t = janet_tuple_begin(2);
|
||||||
JanetSourceMapping mapping = def->sourcemap[i];
|
JanetSourceMapping mapping = def->sourcemap[i];
|
||||||
t[0] = janet_wrap_integer(mapping.line);
|
t[0] = janet_wrap_integer(mapping.start);
|
||||||
t[1] = janet_wrap_integer(mapping.column);
|
t[1] = janet_wrap_integer(mapping.end);
|
||||||
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
sourcemap->data[i] = janet_wrap_tuple(janet_tuple_end(t));
|
||||||
}
|
}
|
||||||
sourcemap->count = def->bytecode_length;
|
sourcemap->count = def->bytecode_length;
|
||||||
|
|||||||
@@ -24,14 +24,12 @@
|
|||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "gc.h"
|
#include "gc.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Initialize a buffer */
|
/* Initialize a buffer */
|
||||||
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
|
||||||
uint8_t *data = NULL;
|
uint8_t *data = NULL;
|
||||||
if (capacity > 0) {
|
if (capacity > 0) {
|
||||||
janet_vm_next_collection += capacity;
|
|
||||||
data = malloc(sizeof(uint8_t) * capacity);
|
data = malloc(sizeof(uint8_t) * capacity);
|
||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -59,9 +57,8 @@ void janet_buffer_ensure(JanetBuffer *buffer, int32_t capacity, int32_t growth)
|
|||||||
uint8_t *new_data;
|
uint8_t *new_data;
|
||||||
uint8_t *old = buffer->data;
|
uint8_t *old = buffer->data;
|
||||||
if (capacity <= buffer->capacity) return;
|
if (capacity <= buffer->capacity) return;
|
||||||
int64_t big_capacity = ((int64_t) capacity) * growth;
|
int64_t big_capacity = capacity * growth;
|
||||||
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
capacity = big_capacity > INT32_MAX ? INT32_MAX : (int32_t) big_capacity;
|
||||||
janet_vm_next_collection += capacity - buffer->capacity;
|
|
||||||
new_data = realloc(old, capacity * sizeof(uint8_t));
|
new_data = realloc(old, capacity * sizeof(uint8_t));
|
||||||
if (NULL == new_data) {
|
if (NULL == new_data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
@@ -93,7 +90,6 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
|||||||
if (new_size > buffer->capacity) {
|
if (new_size > buffer->capacity) {
|
||||||
int32_t new_capacity = new_size * 2;
|
int32_t new_capacity = new_size * 2;
|
||||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||||
janet_vm_next_collection += new_capacity - buffer->capacity;
|
|
||||||
if (NULL == new_data) {
|
if (NULL == new_data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -350,8 +346,8 @@ static const JanetReg buffer_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"buffer/new-filled", cfun_buffer_new_filled,
|
"buffer/new-filled", cfun_buffer_new_filled,
|
||||||
JDOC("(buffer/new-filled count &opt byte)\n\n"
|
JDOC("(buffer/new-filled count [, byte=0])\n\n"
|
||||||
"Creates a new buffer of length count filled with byte. By default, byte is 0. "
|
"Creates a new buffer of length count filled with byte. "
|
||||||
"Returns the new buffer.")
|
"Returns the new buffer.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
@@ -387,7 +383,7 @@ static const JanetReg buffer_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"buffer/slice", cfun_buffer_slice,
|
"buffer/slice", cfun_buffer_slice,
|
||||||
JDOC("(buffer/slice bytes &opt start end)\n\n"
|
JDOC("(buffer/slice bytes [, start=0 [, end=(length bytes)]])\n\n"
|
||||||
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
"Takes a slice of a byte sequence from start to end. The range is half open, "
|
||||||
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
"[start, end). Indexes can also be negative, indicating indexing from the end of the "
|
||||||
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
"end of the array. By default, start is 0 and end is the length of the buffer. "
|
||||||
@@ -415,7 +411,7 @@ static const JanetReg buffer_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"buffer/blit", cfun_buffer_blit,
|
"buffer/blit", cfun_buffer_blit,
|
||||||
JDOC("(buffer/blit dest src & opt dest-start src-start src-end)\n\n"
|
JDOC("(buffer/blit dest src [, dest-start=0 [, src-start=0 [, src-end=-1]]])\n\n"
|
||||||
"Insert the contents of src into dest. Can optionally take indices that "
|
"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 "
|
"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.")
|
"negative to index from the end of src or dest. Returns dest.")
|
||||||
|
|||||||
@@ -79,7 +79,6 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
|||||||
JINT_S, /* JOP_TAILCALL, */
|
JINT_S, /* JOP_TAILCALL, */
|
||||||
JINT_SSS, /* JOP_RESUME, */
|
JINT_SSS, /* JOP_RESUME, */
|
||||||
JINT_SSU, /* JOP_SIGNAL, */
|
JINT_SSU, /* JOP_SIGNAL, */
|
||||||
JINT_SSS, /* JOP_PROPAGATE */
|
|
||||||
JINT_SSS, /* JOP_GET, */
|
JINT_SSS, /* JOP_GET, */
|
||||||
JINT_SSS, /* JOP_PUT, */
|
JINT_SSS, /* JOP_PUT, */
|
||||||
JINT_SSU, /* JOP_GET_INDEX, */
|
JINT_SSU, /* JOP_GET_INDEX, */
|
||||||
|
|||||||
@@ -60,7 +60,7 @@ void janet_printf(const char *format, ...) {
|
|||||||
va_start(args, format);
|
va_start(args, format);
|
||||||
janet_formatb(&buffer, format, args);
|
janet_formatb(&buffer, format, args);
|
||||||
va_end(args);
|
va_end(args);
|
||||||
fwrite(buffer.data, buffer.count, 1, janet_dynfile("out", stdout));
|
fwrite(buffer.data, buffer.count, 1, stdout);
|
||||||
janet_buffer_deinit(&buffer);
|
janet_buffer_deinit(&buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -99,11 +99,6 @@ type janet_get##name(const Janet *argv, int32_t n) { \
|
|||||||
janet_panic_type(x, n, JANET_TFLAG_##NAME); \
|
janet_panic_type(x, n, JANET_TFLAG_##NAME); \
|
||||||
} \
|
} \
|
||||||
return janet_unwrap_##name(x); \
|
return janet_unwrap_##name(x); \
|
||||||
} \
|
|
||||||
type janet_opt##name(const Janet *argv, int32_t argc, int32_t n, type dflt) { \
|
|
||||||
if (argc >= n) return dflt; \
|
|
||||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt; \
|
|
||||||
return janet_get##name(argv, n); \
|
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
||||||
@@ -112,6 +107,7 @@ Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods) {
|
|||||||
return janet_wrap_cfunction(methods->cfun);
|
return janet_wrap_cfunction(methods->cfun);
|
||||||
methods++;
|
methods++;
|
||||||
}
|
}
|
||||||
|
janet_panicf("unknown method %S invoked", method);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -226,17 +222,11 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
|
|||||||
range.start = 0;
|
range.start = 0;
|
||||||
range.end = length;
|
range.end = length;
|
||||||
} else if (argc == 2) {
|
} else if (argc == 2) {
|
||||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
? 0
|
|
||||||
: janet_gethalfrange(argv, 1, length, "start");
|
|
||||||
range.end = length;
|
range.end = length;
|
||||||
} else {
|
} else {
|
||||||
range.start = janet_checktype(argv[1], JANET_NIL)
|
range.start = janet_gethalfrange(argv, 1, length, "start");
|
||||||
? 0
|
range.end = janet_gethalfrange(argv, 2, length, "end");
|
||||||
: janet_gethalfrange(argv, 1, length, "start");
|
|
||||||
range.end = janet_checktype(argv[2], JANET_NIL)
|
|
||||||
? length
|
|
||||||
: janet_gethalfrange(argv, 2, length, "end");
|
|
||||||
if (range.end < range.start)
|
if (range.end < range.start)
|
||||||
range.end = range.start;
|
range.end = range.start;
|
||||||
}
|
}
|
||||||
@@ -260,52 +250,6 @@ void janet_setdyn(const char *name, Janet value) {
|
|||||||
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
|
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;
|
|
||||||
}
|
|
||||||
|
|
||||||
int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt) {
|
|
||||||
if (argc <= n) return dflt;
|
|
||||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
|
||||||
return janet_getinteger(argv, n);
|
|
||||||
}
|
|
||||||
|
|
||||||
int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt) {
|
|
||||||
if (argc <= n) return dflt;
|
|
||||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
|
||||||
return janet_getinteger64(argv, n);
|
|
||||||
}
|
|
||||||
|
|
||||||
size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt) {
|
|
||||||
if (argc <= n) return dflt;
|
|
||||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
|
||||||
return janet_getsize(argv, n);
|
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt) {
|
|
||||||
if (argc <= n) return dflt;
|
|
||||||
if (janet_checktype(argv[n], JANET_NIL)) return dflt;
|
|
||||||
return janet_getabstract(argv, n, at);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Some definitions for function-like macros */
|
/* Some definitions for function-like macros */
|
||||||
|
|
||||||
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
|
||||||
|
|||||||
@@ -35,10 +35,6 @@ static int fixarity1(JanetFopts opts, JanetSlot *args) {
|
|||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) == 1;
|
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) {
|
static int minarity2(JanetFopts opts, JanetSlot *args) {
|
||||||
(void) opts;
|
(void) opts;
|
||||||
return janet_v_count(args) >= 2;
|
return janet_v_count(args) >= 2;
|
||||||
@@ -92,9 +88,6 @@ static JanetSlot opreduce(
|
|||||||
|
|
||||||
/* Function optimizers */
|
/* Function optimizers */
|
||||||
|
|
||||||
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
|
|
||||||
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
|
|
||||||
}
|
|
||||||
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
|
||||||
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
@@ -122,12 +115,8 @@ static JanetSlot do_length(JanetFopts opts, JanetSlot *args) {
|
|||||||
return genericSS(opts, JOP_LENGTH, args[0]);
|
return genericSS(opts, JOP_LENGTH, args[0]);
|
||||||
}
|
}
|
||||||
static JanetSlot do_yield(JanetFopts opts, JanetSlot *args) {
|
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);
|
return genericSSI(opts, JOP_SIGNAL, args[0], 3);
|
||||||
}
|
}
|
||||||
}
|
|
||||||
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
static JanetSlot do_resume(JanetFopts opts, JanetSlot *args) {
|
||||||
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
return opreduce(opts, args, JOP_RESUME, janet_wrap_nil());
|
||||||
}
|
}
|
||||||
@@ -273,7 +262,7 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{fixarity0, do_debug},
|
{fixarity0, do_debug},
|
||||||
{fixarity1, do_error},
|
{fixarity1, do_error},
|
||||||
{minarity2, do_apply},
|
{minarity2, do_apply},
|
||||||
{maxarity1, do_yield},
|
{fixarity1, do_yield},
|
||||||
{fixarity2, do_resume},
|
{fixarity2, do_resume},
|
||||||
{fixarity2, do_get},
|
{fixarity2, do_get},
|
||||||
{fixarity3, do_put},
|
{fixarity3, do_put},
|
||||||
@@ -300,8 +289,7 @@ static const JanetFunOptimizer optimizers[] = {
|
|||||||
{NULL, do_gte},
|
{NULL, do_gte},
|
||||||
{NULL, do_lte},
|
{NULL, do_lte},
|
||||||
{NULL, do_eq},
|
{NULL, do_eq},
|
||||||
{NULL, do_neq},
|
{NULL, do_neq}
|
||||||
{fixarity2, do_propagate}
|
|
||||||
};
|
};
|
||||||
|
|
||||||
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {
|
||||||
|
|||||||
@@ -320,46 +320,33 @@ JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push slots loaded via janetc_toslots. Return the minimum number of slots pushed,
|
/* Push slots load via janetc_toslots. */
|
||||||
* or -1 - min_arity if there is a splice. (if there is no splice, min_arity is also
|
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
||||||
* the maximum possible arity). */
|
|
||||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots) {
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
int32_t count = janet_v_count(slots);
|
int32_t count = janet_v_count(slots);
|
||||||
int32_t min_arity = 0;
|
|
||||||
int has_splice = 0;
|
|
||||||
for (i = 0; i < count;) {
|
for (i = 0; i < count;) {
|
||||||
if (slots[i].flags & JANET_SLOT_SPLICED) {
|
if (slots[i].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i], 0);
|
||||||
i++;
|
i++;
|
||||||
has_splice = 1;
|
|
||||||
} else if (i + 1 == count) {
|
} else if (i + 1 == count) {
|
||||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||||
i++;
|
i++;
|
||||||
min_arity++;
|
|
||||||
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 1].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
janetc_emit_s(c, JOP_PUSH, slots[i], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
min_arity++;
|
|
||||||
has_splice = 1;
|
|
||||||
} else if (i + 2 == count) {
|
} else if (i + 2 == count) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
i += 2;
|
i += 2;
|
||||||
min_arity += 2;
|
|
||||||
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
} else if (slots[i + 2].flags & JANET_SLOT_SPLICED) {
|
||||||
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
janetc_emit_ss(c, JOP_PUSH_2, slots[i], slots[i + 1], 0);
|
||||||
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
|
janetc_emit_s(c, JOP_PUSH_ARRAY, slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
min_arity += 2;
|
|
||||||
has_splice = 1;
|
|
||||||
} else {
|
} else {
|
||||||
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
|
janetc_emit_sss(c, JOP_PUSH_3, slots[i], slots[i + 1], slots[i + 2], 0);
|
||||||
i += 3;
|
i += 3;
|
||||||
min_arity += 3;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
return has_splice ? (-1 - min_arity) : min_arity;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Check if a list of slots has any spliced slots */
|
/* Check if a list of slots has any spliced slots */
|
||||||
@@ -416,67 +403,7 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
|||||||
/* TODO janet function inlining (no c functions)*/
|
/* TODO janet function inlining (no c functions)*/
|
||||||
}
|
}
|
||||||
if (!specialized) {
|
if (!specialized) {
|
||||||
int32_t min_arity = janetc_pushslots(c, slots);
|
janetc_pushslots(c, slots);
|
||||||
/* Check for provably incorrect function calls */
|
|
||||||
if (fun.flags & JANET_SLOT_CONSTANT) {
|
|
||||||
|
|
||||||
/* Check for bad arity type if fun is a constant */
|
|
||||||
switch (janet_type(fun.constant)) {
|
|
||||||
case JANET_FUNCTION: {
|
|
||||||
JanetFunction *f = janet_unwrap_function(fun.constant);
|
|
||||||
int32_t min = f->def->min_arity;
|
|
||||||
int32_t max = f->def->max_arity;
|
|
||||||
if (min_arity < 0) {
|
|
||||||
/* Call has splices */
|
|
||||||
min_arity = -1 - min_arity;
|
|
||||||
if (min_arity > max && max >= 0) {
|
|
||||||
const uint8_t *es = janet_formatc(
|
|
||||||
"%v expects at most %d argument, got at least %d",
|
|
||||||
fun.constant, max, min_arity);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
/* Call has no splices */
|
|
||||||
if (min_arity > max && max >= 0) {
|
|
||||||
const uint8_t *es = janet_formatc(
|
|
||||||
"%v expects at most %d argument, got %d",
|
|
||||||
fun.constant, max, min_arity);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
if (min_arity < min) {
|
|
||||||
const uint8_t *es = janet_formatc(
|
|
||||||
"%v expects at least %d argument, got %d",
|
|
||||||
fun.constant, min, min_arity);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
case JANET_CFUNCTION:
|
|
||||||
case JANET_ABSTRACT:
|
|
||||||
break;
|
|
||||||
case JANET_KEYWORD:
|
|
||||||
if (min_arity == 0) {
|
|
||||||
const uint8_t *es = janet_formatc("%v expects at least 1 argument, got 0",
|
|
||||||
fun.constant);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
default:
|
|
||||||
if (min_arity > 1 || min_arity == 0) {
|
|
||||||
const uint8_t *es = janet_formatc("%v expects 1 argument, got %d",
|
|
||||||
fun.constant, min_arity);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
if (min_arity < -2) {
|
|
||||||
const uint8_t *es = janet_formatc("%v expects 1 argument, got at least %d",
|
|
||||||
fun.constant, -1 - min_arity);
|
|
||||||
janetc_error(c, es);
|
|
||||||
}
|
|
||||||
break;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
if ((opts.flags & JANET_FOPTS_TAIL) &&
|
if ((opts.flags & JANET_FOPTS_TAIL) &&
|
||||||
/* Prevent top level tail calls for better errors */
|
/* Prevent top level tail calls for better errors */
|
||||||
!(c->scope->flags & JANET_SCOPE_TOP)) {
|
!(c->scope->flags & JANET_SCOPE_TOP)) {
|
||||||
@@ -547,9 +474,9 @@ static int macroexpand1(
|
|||||||
if (janet_tuple_length(form) == 0)
|
if (janet_tuple_length(form) == 0)
|
||||||
return 0;
|
return 0;
|
||||||
/* Source map - only set when we get a tuple */
|
/* Source map - only set when we get a tuple */
|
||||||
if (janet_tuple_sm_line(form) >= 0) {
|
if (janet_tuple_sm_start(form) >= 0) {
|
||||||
c->current_mapping.line = janet_tuple_sm_line(form);
|
c->current_mapping.start = janet_tuple_sm_start(form);
|
||||||
c->current_mapping.column = janet_tuple_sm_column(form);
|
c->current_mapping.end = janet_tuple_sm_end(form);
|
||||||
}
|
}
|
||||||
/* Bracketed tuples are not specials or macros! */
|
/* Bracketed tuples are not specials or macros! */
|
||||||
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
if (janet_tuple_flag(form) & JANET_TUPLE_FLAG_BRACKETCTOR)
|
||||||
@@ -702,7 +629,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
}
|
}
|
||||||
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
memcpy(def->bytecode, c->buffer + scope->bytecode_start, s);
|
||||||
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
janet_v__cnt(c->buffer) = scope->bytecode_start;
|
||||||
if (NULL != c->mapbuffer && c->source) {
|
if (NULL != c->mapbuffer) {
|
||||||
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
size_t s = sizeof(JanetSourceMapping) * def->bytecode_length;
|
||||||
def->sourcemap = malloc(s);
|
def->sourcemap = malloc(s);
|
||||||
if (NULL == def->sourcemap) {
|
if (NULL == def->sourcemap) {
|
||||||
@@ -737,15 +664,15 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where)
|
|||||||
c->recursion_guard = JANET_RECURSION_GUARD;
|
c->recursion_guard = JANET_RECURSION_GUARD;
|
||||||
c->env = env;
|
c->env = env;
|
||||||
c->source = where;
|
c->source = where;
|
||||||
c->current_mapping.line = -1;
|
c->current_mapping.start = -1;
|
||||||
c->current_mapping.column = -1;
|
c->current_mapping.end = -1;
|
||||||
/* Init result */
|
/* Init result */
|
||||||
c->result.error = NULL;
|
c->result.error = NULL;
|
||||||
c->result.status = JANET_COMPILE_OK;
|
c->result.status = JANET_COMPILE_OK;
|
||||||
c->result.funcdef = NULL;
|
c->result.funcdef = NULL;
|
||||||
c->result.macrofiber = NULL;
|
c->result.macrofiber = NULL;
|
||||||
c->result.error_mapping.line = -1;
|
c->result.error_mapping.start = -1;
|
||||||
c->result.error_mapping.column = -1;
|
c->result.error_mapping.end = -1;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Deinitialize a compiler struct */
|
/* Deinitialize a compiler struct */
|
||||||
@@ -806,8 +733,8 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
|||||||
} else {
|
} else {
|
||||||
JanetTable *t = janet_table(4);
|
JanetTable *t = janet_table(4);
|
||||||
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
janet_table_put(t, janet_ckeywordv("start"), janet_wrap_integer(res.error_mapping.start));
|
||||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
janet_table_put(t, janet_ckeywordv("end"), janet_wrap_integer(res.error_mapping.end));
|
||||||
if (res.macrofiber) {
|
if (res.macrofiber) {
|
||||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -60,7 +60,6 @@
|
|||||||
#define JANET_FUN_LTE 29
|
#define JANET_FUN_LTE 29
|
||||||
#define JANET_FUN_EQ 30
|
#define JANET_FUN_EQ 30
|
||||||
#define JANET_FUN_NEQ 31
|
#define JANET_FUN_NEQ 31
|
||||||
#define JANET_FUN_PROP 32
|
|
||||||
|
|
||||||
/* Compiler typedefs */
|
/* Compiler typedefs */
|
||||||
typedef struct JanetCompiler JanetCompiler;
|
typedef struct JanetCompiler JanetCompiler;
|
||||||
@@ -214,7 +213,7 @@ JanetSlot *janetc_toslots(JanetCompiler *c, const Janet *vals, int32_t len);
|
|||||||
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
JanetSlot *janetc_toslotskv(JanetCompiler *c, Janet ds);
|
||||||
|
|
||||||
/* Push slots load via janetc_toslots. */
|
/* Push slots load via janetc_toslots. */
|
||||||
int32_t janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
void janetc_pushslots(JanetCompiler *c, JanetSlot *slots);
|
||||||
|
|
||||||
/* Free slots loaded via janetc_toslots */
|
/* Free slots loaded via janetc_toslots */
|
||||||
void janetc_freeslots(JanetCompiler *c, JanetSlot *slots);
|
void janetc_freeslots(JanetCompiler *c, JanetSlot *slots);
|
||||||
|
|||||||
@@ -22,7 +22,6 @@
|
|||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include <math.h>
|
|
||||||
#include "compile.h"
|
#include "compile.h"
|
||||||
#include "state.h"
|
#include "state.h"
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
@@ -46,14 +45,7 @@ typedef int Clib;
|
|||||||
typedef HINSTANCE Clib;
|
typedef HINSTANCE Clib;
|
||||||
#define load_clib(name) LoadLibrary((name))
|
#define load_clib(name) LoadLibrary((name))
|
||||||
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
#define symbol_clib(lib, sym) GetProcAddress((lib), (sym))
|
||||||
static char error_clib_buf[256];
|
#define error_clib() "could not load dynamic library"
|
||||||
static char *error_clib(void) {
|
|
||||||
FormatMessageA(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
|
||||||
NULL, GetLastError(), MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
|
||||||
error_clib_buf, sizeof(error_clib_buf), NULL);
|
|
||||||
error_clib_buf[strlen(error_clib_buf) - 1] = '\0';
|
|
||||||
return error_clib_buf;
|
|
||||||
}
|
|
||||||
#else
|
#else
|
||||||
#include <dlfcn.h>
|
#include <dlfcn.h>
|
||||||
typedef void *Clib;
|
typedef void *Clib;
|
||||||
@@ -65,180 +57,18 @@ typedef void *Clib;
|
|||||||
JanetModule janet_native(const char *name, const uint8_t **error) {
|
JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||||
Clib lib = load_clib(name);
|
Clib lib = load_clib(name);
|
||||||
JanetModule init;
|
JanetModule init;
|
||||||
JanetModconf getter;
|
|
||||||
if (!lib) {
|
if (!lib) {
|
||||||
*error = janet_cstring(error_clib());
|
*error = janet_cstring(error_clib());
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
init = (JanetModule) symbol_clib(lib, "_janet_init");
|
||||||
if (!init) {
|
if (!init) {
|
||||||
*error = janet_cstring("could not find the _janet_init symbol");
|
*error = janet_cstring("could not find _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 NULL;
|
||||||
}
|
}
|
||||||
return init;
|
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 {
|
|
||||||
while (dot_count > 0) {
|
|
||||||
--dot_count;
|
|
||||||
*print++ = '.';
|
|
||||||
}
|
|
||||||
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) {
|
static Janet janet_core_dyn(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 2);
|
janet_arity(argc, 1, 2);
|
||||||
Janet value;
|
Janet value;
|
||||||
@@ -278,7 +108,6 @@ static Janet janet_core_native(int32_t argc, Janet *argv) {
|
|||||||
janet_panicf("could not load native %S: %S", path, error);
|
janet_panicf("could not load native %S: %S", path, error);
|
||||||
}
|
}
|
||||||
init(env);
|
init(env);
|
||||||
janet_table_put(env, janet_ckeywordv("native"), argv[0]);
|
|
||||||
return janet_wrap_table(env);
|
return janet_wrap_table(env);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -422,21 +251,19 @@ static Janet janet_core_hash(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_getline(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);
|
janet_arity(argc, 0, 2);
|
||||||
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
JanetBuffer *buf = (argc >= 2) ? janet_getbuffer(argv, 1) : janet_buffer(10);
|
||||||
if (argc >= 1) {
|
if (argc >= 1) {
|
||||||
const char *prompt = (const char *) janet_getstring(argv, 0);
|
const char *prompt = (const char *) janet_getstring(argv, 0);
|
||||||
fprintf(out, "%s", prompt);
|
printf("%s", prompt);
|
||||||
fflush(out);
|
fflush(stdout);
|
||||||
}
|
}
|
||||||
{
|
{
|
||||||
buf->count = 0;
|
buf->count = 0;
|
||||||
int c;
|
int c;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
c = fgetc(in);
|
c = fgetc(stdin);
|
||||||
if (feof(in) || c < 0) {
|
if (feof(stdin) || c < 0) {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
janet_buffer_push_u8(buf, (uint8_t) c);
|
janet_buffer_push_u8(buf, (uint8_t) c);
|
||||||
@@ -460,28 +287,10 @@ static Janet janet_core_untrace(int32_t argc, Janet *argv) {
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_core_check_int(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
|
||||||
double num = janet_unwrap_number(argv[0]);
|
|
||||||
return janet_wrap_boolean(num == (double)((int32_t)num));
|
|
||||||
ret_false:
|
|
||||||
return janet_wrap_false();
|
|
||||||
}
|
|
||||||
|
|
||||||
static Janet janet_core_check_nat(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
if (!janet_checktype(argv[0], JANET_NUMBER)) goto ret_false;
|
|
||||||
double num = janet_unwrap_number(argv[0]);
|
|
||||||
return janet_wrap_boolean(num >= 0 && (num == (double)((int32_t)num)));
|
|
||||||
ret_false:
|
|
||||||
return janet_wrap_false();
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetReg corelib_cfuns[] = {
|
static const JanetReg corelib_cfuns[] = {
|
||||||
{
|
{
|
||||||
"native", janet_core_native,
|
"native", janet_core_native,
|
||||||
JDOC("(native path &opt env)\n\n"
|
JDOC("(native path [,env])\n\n"
|
||||||
"Load a native module from the given path. The path "
|
"Load a native module from the given path. The path "
|
||||||
"must be an absolute or relative path on the file system, and is "
|
"must be an absolute or relative path on the file system, and is "
|
||||||
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
"usually a .so file on Unix systems, and a .dll file on Windows. "
|
||||||
@@ -607,7 +416,7 @@ static const JanetReg corelib_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"next", janet_core_next,
|
"next", janet_core_next,
|
||||||
JDOC("(next dict &opt key)\n\n"
|
JDOC("(next dict key)\n\n"
|
||||||
"Gets the next key in a struct or table. Can be used to iterate through "
|
"Gets the next key in a struct or table. Can be used to iterate through "
|
||||||
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
"the keys of a data structure in an unspecified order. Keys are guaranteed "
|
||||||
"to be seen only once per iteration if they data structure is not mutated "
|
"to be seen only once per iteration if they data structure is not mutated "
|
||||||
@@ -623,14 +432,14 @@ static const JanetReg corelib_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"getline", janet_core_getline,
|
"getline", janet_core_getline,
|
||||||
JDOC("(getline &opt prompt buf)\n\n"
|
JDOC("(getline [, prompt=\"\" [, buffer=@\"\"]])\n\n"
|
||||||
"Reads a line of input into a buffer, including the newline character, using a prompt. Returns the modified buffer. "
|
"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.")
|
"Use this function to implement a simple interface for a terminal program.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"dyn", janet_core_dyn,
|
"dyn", janet_core_dyn,
|
||||||
JDOC("(dyn key &opt default)\n\n"
|
JDOC("(dyn key [, default=nil])\n\n"
|
||||||
"Get a dynamic binding. Returns the default value (or nil) if no binding found.")
|
"Get a dynamic binding. Returns the default value if no binding found.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"setdyn", janet_core_setdyn,
|
"setdyn", janet_core_setdyn,
|
||||||
@@ -647,24 +456,6 @@ static const JanetReg corelib_cfuns[] = {
|
|||||||
JDOC("(untrace func)\n\n"
|
JDOC("(untrace func)\n\n"
|
||||||
"Disables tracing on a function. Returns the function.")
|
"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.")
|
|
||||||
},
|
|
||||||
{
|
|
||||||
"int?", janet_core_check_int,
|
|
||||||
JDOC("(int? x)\n\n"
|
|
||||||
"Check if x can be exactly represented as a 32 bit signed two's complement integer.")
|
|
||||||
},
|
|
||||||
{
|
|
||||||
"nat?", janet_core_check_nat,
|
|
||||||
JDOC("(nat? x)\n\n"
|
|
||||||
"Check if x can be exactly represented as a non-negative 32 bit signed two's complement integer.")
|
|
||||||
},
|
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -882,11 +673,7 @@ static const uint32_t resume_asm[] = {
|
|||||||
};
|
};
|
||||||
static const uint32_t get_asm[] = {
|
static const uint32_t get_asm[] = {
|
||||||
JOP_GET | (1 << 24),
|
JOP_GET | (1 << 24),
|
||||||
JOP_LOAD_NIL | (3 << 8),
|
JOP_RETURN
|
||||||
JOP_EQUALS | (3 << 8) | (3 << 24),
|
|
||||||
JOP_JUMP_IF | (3 << 8) | (2 << 16),
|
|
||||||
JOP_RETURN,
|
|
||||||
JOP_RETURN | (2 << 8)
|
|
||||||
};
|
};
|
||||||
static const uint32_t put_asm[] = {
|
static const uint32_t put_asm[] = {
|
||||||
JOP_PUT | (1 << 16) | (2 << 24),
|
JOP_PUT | (1 << 16) | (2 << 24),
|
||||||
@@ -900,10 +687,6 @@ static const uint32_t bnot_asm[] = {
|
|||||||
JOP_BNOT,
|
JOP_BNOT,
|
||||||
JOP_RETURN
|
JOP_RETURN
|
||||||
};
|
};
|
||||||
static const uint32_t propagate_asm[] = {
|
|
||||||
JOP_PROPAGATE | (1 << 24),
|
|
||||||
JOP_RETURN
|
|
||||||
};
|
|
||||||
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
#endif /* ifndef JANET_NO_BOOTSTRAP */
|
||||||
|
|
||||||
JanetTable *janet_core_env(JanetTable *replacements) {
|
JanetTable *janet_core_env(JanetTable *replacements) {
|
||||||
@@ -911,13 +694,6 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||||||
janet_core_cfuns(env, NULL, corelib_cfuns);
|
janet_core_cfuns(env, NULL, corelib_cfuns);
|
||||||
|
|
||||||
#ifdef JANET_BOOTSTRAP
|
#ifdef JANET_BOOTSTRAP
|
||||||
janet_quick_asm(env, JANET_FUN_PROP,
|
|
||||||
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
|
|
||||||
JDOC("(propagate x fiber)\n\n"
|
|
||||||
"Propagate a signal from a fiber to the current fiber. The resulting "
|
|
||||||
"stack trace from the current fiber will include frames from fiber. If "
|
|
||||||
"fiber is in a state that can be resumed, resuming the current fiber will "
|
|
||||||
"first resume fiber."));
|
|
||||||
janet_quick_asm(env, JANET_FUN_DEBUG,
|
janet_quick_asm(env, JANET_FUN_DEBUG,
|
||||||
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
"debug", 0, 0, 0, 1, debug_asm, sizeof(debug_asm),
|
||||||
JDOC("(debug)\n\n"
|
JDOC("(debug)\n\n"
|
||||||
@@ -941,14 +717,13 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||||||
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
"the dispatch function in the case of a new fiber. Returns either the return result of "
|
||||||
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
"the fiber's dispatch function, or the value from the next yield call in fiber."));
|
||||||
janet_quick_asm(env, JANET_FUN_GET,
|
janet_quick_asm(env, JANET_FUN_GET,
|
||||||
"get", 3, 2, 3, 4, get_asm, sizeof(get_asm),
|
"get", 2, 2, 2, 2, get_asm, sizeof(get_asm),
|
||||||
JDOC("(get ds key &opt dflt)\n\n"
|
JDOC("(get ds key)\n\n"
|
||||||
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
"Get a value from any associative data structure. Arrays, tuples, tables, structs, strings, "
|
||||||
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
"symbols, and buffers are all associative and can be used with get. Order structures, name "
|
||||||
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
"arrays, tuples, strings, buffers, and symbols must use integer keys. Structs and tables can "
|
||||||
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
"take any value as a key except nil and return a value except nil. Byte sequences will return "
|
||||||
"integer representations of bytes as result of a get call. If no values is found, will return "
|
"integer representations of bytes as result of a get call."));
|
||||||
"dflt or nil if no default is provided."));
|
|
||||||
janet_quick_asm(env, JANET_FUN_PUT,
|
janet_quick_asm(env, JANET_FUN_PUT,
|
||||||
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
|
||||||
JDOC("(put ds key value)\n\n"
|
JDOC("(put ds key value)\n\n"
|
||||||
@@ -1055,9 +830,6 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
|||||||
JDOC("The version number of the running janet program."));
|
JDOC("The version number of the running janet program."));
|
||||||
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
janet_def(env, "janet/build", janet_cstringv(JANET_BUILD),
|
||||||
JDOC("The build identifier of the running janet program."));
|
JDOC("The build identifier of the running janet program."));
|
||||||
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 */
|
/* Allow references to the environment */
|
||||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||||
|
|||||||
@@ -52,47 +52,40 @@ void janet_debug_unbreak(JanetFuncDef *def, int32_t pc) {
|
|||||||
*/
|
*/
|
||||||
void janet_debug_find(
|
void janet_debug_find(
|
||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t sourceLine, int32_t sourceColumn) {
|
const uint8_t *source, int32_t offset) {
|
||||||
/* Scan the heap for right func def */
|
/* Scan the heap for right func def */
|
||||||
JanetGCObject *current = janet_vm_blocks;
|
JanetGCObject *current = janet_vm_blocks;
|
||||||
/* Keep track of the best source mapping we have seen so far */
|
/* Keep track of the best source mapping we have seen so far */
|
||||||
int32_t besti = -1;
|
int32_t besti = -1;
|
||||||
int32_t best_line = -1;
|
int32_t best_range = INT32_MAX;
|
||||||
int32_t best_column = -1;
|
|
||||||
JanetFuncDef *best_def = NULL;
|
JanetFuncDef *best_def = NULL;
|
||||||
while (NULL != current) {
|
while (NULL != current) {
|
||||||
if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) {
|
if ((current->flags & JANET_MEM_TYPEBITS) == JANET_MEMORY_FUNCDEF) {
|
||||||
JanetFuncDef *def = (JanetFuncDef *)(current);
|
JanetFuncDef *def = (JanetFuncDef *)(current + 1);
|
||||||
if (def->sourcemap &&
|
if (def->sourcemap &&
|
||||||
def->source &&
|
def->source &&
|
||||||
!janet_string_compare(source, def->source)) {
|
!janet_string_compare(source, def->source)) {
|
||||||
/* Correct source file, check mappings. The chosen
|
/* Correct source file, check mappings. The chosen
|
||||||
* pc index is the instruction closest to the given line column, but
|
* pc index is the first match with the smallest range. */
|
||||||
* not after. */
|
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 0; i < def->bytecode_length; i++) {
|
for (i = 0; i < def->bytecode_length; i++) {
|
||||||
int32_t line = def->sourcemap[i].line;
|
int32_t start = def->sourcemap[i].start;
|
||||||
int32_t column = def->sourcemap[i].column;
|
int32_t end = def->sourcemap[i].end;
|
||||||
if (line <= sourceLine && line >= best_line) {
|
if (end - start < best_range &&
|
||||||
if (column <= sourceColumn &&
|
start <= offset &&
|
||||||
(line > best_line || column > best_column)) {
|
end >= offset) {
|
||||||
best_line = line;
|
best_range = end - start;
|
||||||
best_column = column;
|
|
||||||
besti = i;
|
besti = i;
|
||||||
best_def = def;
|
best_def = def;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
|
||||||
current = current->next;
|
current = current->next;
|
||||||
}
|
}
|
||||||
if (best_def) {
|
if (best_def) {
|
||||||
*def_out = best_def;
|
*def_out = best_def;
|
||||||
*pc_out = besti;
|
*pc_out = besti;
|
||||||
if (best_def->name) {
|
|
||||||
janet_printf("name: %S\n", best_def->name);
|
|
||||||
}
|
|
||||||
} else {
|
} else {
|
||||||
janet_panic("could not find breakpoint");
|
janet_panic("could not find breakpoint");
|
||||||
}
|
}
|
||||||
@@ -107,9 +100,6 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|||||||
JanetFiber **fibers = NULL;
|
JanetFiber **fibers = NULL;
|
||||||
int wrote_error = 0;
|
int wrote_error = 0;
|
||||||
|
|
||||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
|
||||||
if (print_color) fprintf(out, "\x1b[31m");
|
|
||||||
|
|
||||||
while (fiber) {
|
while (fiber) {
|
||||||
janet_v_push(fibers, fiber);
|
janet_v_push(fibers, fiber);
|
||||||
fiber = fiber->child;
|
fiber = fiber->child;
|
||||||
@@ -158,7 +148,7 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|||||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
fprintf(out, " on line %d, column %d", mapping.line, mapping.column);
|
fprintf(out, " at (%d:%d)", mapping.start, mapping.end);
|
||||||
} else {
|
} else {
|
||||||
fprintf(out, " pc=%d", off);
|
fprintf(out, " pc=%d", off);
|
||||||
}
|
}
|
||||||
@@ -167,8 +157,6 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
if (print_color) fprintf(out, "\x1b[0m");
|
|
||||||
|
|
||||||
janet_v_free(fibers);
|
janet_v_free(fibers);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -179,11 +167,10 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
|||||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||||
* Takes a source file name and byte offset. */
|
* Takes a source file name and byte offset. */
|
||||||
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
static void helper_find(int32_t argc, Janet *argv, JanetFuncDef **def, int32_t *bytecode_offset) {
|
||||||
janet_fixarity(argc, 3);
|
janet_fixarity(argc, 2);
|
||||||
const uint8_t *source = janet_getstring(argv, 0);
|
const uint8_t *source = janet_getstring(argv, 0);
|
||||||
int32_t line = janet_getinteger(argv, 1);
|
int32_t source_offset = janet_getinteger(argv, 1);
|
||||||
int32_t col = janet_getinteger(argv, 2);
|
janet_debug_find(def, bytecode_offset, source, source_offset);
|
||||||
janet_debug_find(def, bytecode_offset, source, line, col);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
/* Helper to find funcdef and bytecode offset to insert or remove breakpoints.
|
||||||
@@ -270,8 +257,8 @@ static Janet doframe(JanetStackFrame *frame) {
|
|||||||
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
janet_table_put(t, janet_ckeywordv("pc"), janet_wrap_integer(off));
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
JanetSourceMapping mapping = def->sourcemap[off];
|
JanetSourceMapping mapping = def->sourcemap[off];
|
||||||
janet_table_put(t, janet_ckeywordv("source-line"), janet_wrap_integer(mapping.line));
|
janet_table_put(t, janet_ckeywordv("source-start"), janet_wrap_integer(mapping.start));
|
||||||
janet_table_put(t, janet_ckeywordv("source-column"), janet_wrap_integer(mapping.column));
|
janet_table_put(t, janet_ckeywordv("source-end"), janet_wrap_integer(mapping.end));
|
||||||
}
|
}
|
||||||
if (def->source) {
|
if (def->source) {
|
||||||
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
janet_table_put(t, janet_ckeywordv("source"), janet_wrap_string(def->source));
|
||||||
@@ -321,29 +308,29 @@ static const JanetReg debug_cfuns[] = {
|
|||||||
{
|
{
|
||||||
"debug/break", cfun_debug_break,
|
"debug/break", cfun_debug_break,
|
||||||
JDOC("(debug/break source byte-offset)\n\n"
|
JDOC("(debug/break source byte-offset)\n\n"
|
||||||
"Sets a breakpoint with source a key at a given line and column. "
|
"Sets a breakpoint with source a key at a given byte offset. An offset "
|
||||||
"Will throw an error if the breakpoint location "
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint location "
|
||||||
"cannot be found. For example\n\n"
|
"cannot be found. For example\n\n"
|
||||||
"\t(debug/break \"core.janet\" 1000)\n\n"
|
"\t(debug/break \"core.janet\" 1000)\n\n"
|
||||||
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
"wil set a breakpoint at the 1000th byte of the file core.janet.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/unbreak", cfun_debug_unbreak,
|
"debug/unbreak", cfun_debug_unbreak,
|
||||||
JDOC("(debug/unbreak source line column)\n\n"
|
JDOC("(debug/unbreak source byte-offset)\n\n"
|
||||||
"Remove a breakpoint with a source key at a given line and column. "
|
"Remove a breakpoint with a source key at a given byte offset. An offset "
|
||||||
"Will throw an error if the breakpoint "
|
"of 0 is the first byte in a file. Will throw an error if the breakpoint "
|
||||||
"cannot be found.")
|
"cannot be found.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/fbreak", cfun_debug_fbreak,
|
"debug/fbreak", cfun_debug_fbreak,
|
||||||
JDOC("(debug/fbreak fun &opt pc)\n\n"
|
JDOC("(debug/fbreak fun [,pc=0])\n\n"
|
||||||
"Set a breakpoint in a given function. pc is an optional offset, which "
|
"Set a breakpoint in a given function. pc is an optional offset, which "
|
||||||
"is in bytecode instructions. fun is a function value. Will throw an error "
|
"is in bytecode instructions. fun is a function value. Will throw an error "
|
||||||
"if the offset is too large or negative.")
|
"if the offset is too large or negative.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"debug/unfbreak", cfun_debug_unfbreak,
|
"debug/unfbreak", cfun_debug_unfbreak,
|
||||||
JDOC("(debug/unfbreak fun &opt pc)\n\n"
|
JDOC("(debug/unfbreak fun [,pc=0])\n\n"
|
||||||
"Unset a breakpoint set with debug/fbreak.")
|
"Unset a breakpoint set with debug/fbreak.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
|
|||||||
@@ -50,7 +50,6 @@ static JanetFiber *fiber_alloc(int32_t capacity) {
|
|||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
janet_vm_next_collection += sizeof(Janet) * capacity;
|
|
||||||
fiber->data = data;
|
fiber->data = data;
|
||||||
return fiber;
|
return fiber;
|
||||||
}
|
}
|
||||||
@@ -87,27 +86,19 @@ void janet_fiber_setcapacity(JanetFiber *fiber, int32_t n) {
|
|||||||
fiber->capacity = n;
|
fiber->capacity = n;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Grow fiber if needed */
|
|
||||||
static void janet_fiber_grow(JanetFiber *fiber, int32_t needed) {
|
|
||||||
int32_t cap = needed > (INT32_MAX / 2) ? INT32_MAX : 2 * needed;
|
|
||||||
janet_fiber_setcapacity(fiber, cap);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Push a value on the next stack frame */
|
/* Push a value on the next stack frame */
|
||||||
void janet_fiber_push(JanetFiber *fiber, Janet x) {
|
void janet_fiber_push(JanetFiber *fiber, Janet x) {
|
||||||
if (fiber->stacktop == INT32_MAX) janet_panic("stack overflow");
|
|
||||||
if (fiber->stacktop >= fiber->capacity) {
|
if (fiber->stacktop >= fiber->capacity) {
|
||||||
janet_fiber_grow(fiber, fiber->stacktop);
|
janet_fiber_setcapacity(fiber, 2 * fiber->stacktop);
|
||||||
}
|
}
|
||||||
fiber->data[fiber->stacktop++] = x;
|
fiber->data[fiber->stacktop++] = x;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Push 2 values on the next stack frame */
|
/* Push 2 values on the next stack frame */
|
||||||
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
|
void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
|
||||||
if (fiber->stacktop >= INT32_MAX - 1) janet_panic("stack overflow");
|
|
||||||
int32_t newtop = fiber->stacktop + 2;
|
int32_t newtop = fiber->stacktop + 2;
|
||||||
if (newtop > fiber->capacity) {
|
if (newtop > fiber->capacity) {
|
||||||
janet_fiber_grow(fiber, newtop);
|
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||||
}
|
}
|
||||||
fiber->data[fiber->stacktop] = x;
|
fiber->data[fiber->stacktop] = x;
|
||||||
fiber->data[fiber->stacktop + 1] = y;
|
fiber->data[fiber->stacktop + 1] = y;
|
||||||
@@ -116,10 +107,9 @@ void janet_fiber_push2(JanetFiber *fiber, Janet x, Janet y) {
|
|||||||
|
|
||||||
/* Push 3 values on the next stack frame */
|
/* Push 3 values on the next stack frame */
|
||||||
void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
|
void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
|
||||||
if (fiber->stacktop >= INT32_MAX - 2) janet_panic("stack overflow");
|
|
||||||
int32_t newtop = fiber->stacktop + 3;
|
int32_t newtop = fiber->stacktop + 3;
|
||||||
if (newtop > fiber->capacity) {
|
if (newtop > fiber->capacity) {
|
||||||
janet_fiber_grow(fiber, newtop);
|
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||||
}
|
}
|
||||||
fiber->data[fiber->stacktop] = x;
|
fiber->data[fiber->stacktop] = x;
|
||||||
fiber->data[fiber->stacktop + 1] = y;
|
fiber->data[fiber->stacktop + 1] = y;
|
||||||
@@ -129,10 +119,9 @@ void janet_fiber_push3(JanetFiber *fiber, Janet x, Janet y, Janet z) {
|
|||||||
|
|
||||||
/* Push an array on the next stack frame */
|
/* Push an array on the next stack frame */
|
||||||
void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
void janet_fiber_pushn(JanetFiber *fiber, const Janet *arr, int32_t n) {
|
||||||
if (fiber->stacktop > INT32_MAX - n) janet_panic("stack overflow");
|
|
||||||
int32_t newtop = fiber->stacktop + n;
|
int32_t newtop = fiber->stacktop + n;
|
||||||
if (newtop > fiber->capacity) {
|
if (newtop > fiber->capacity) {
|
||||||
janet_fiber_grow(fiber, newtop);
|
janet_fiber_setcapacity(fiber, 2 * newtop);
|
||||||
}
|
}
|
||||||
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
memcpy(fiber->data + fiber->stacktop, arr, n * sizeof(Janet));
|
||||||
fiber->stacktop = newtop;
|
fiber->stacktop = newtop;
|
||||||
@@ -212,7 +201,6 @@ static void janet_env_detach(JanetFuncEnv *env) {
|
|||||||
if (env) {
|
if (env) {
|
||||||
size_t s = sizeof(Janet) * env->length;
|
size_t s = sizeof(Janet) * env->length;
|
||||||
Janet *vmem = malloc(s);
|
Janet *vmem = malloc(s);
|
||||||
janet_vm_next_collection += (uint32_t) s;
|
|
||||||
if (NULL == vmem) {
|
if (NULL == vmem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -403,13 +391,6 @@ static Janet cfun_fiber_new(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
fiber->env = janet_vm_fiber->env;
|
fiber->env = janet_vm_fiber->env;
|
||||||
break;
|
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;
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -450,7 +431,7 @@ static Janet cfun_fiber_setmaxstack(int32_t argc, Janet *argv) {
|
|||||||
static const JanetReg fiber_cfuns[] = {
|
static const JanetReg fiber_cfuns[] = {
|
||||||
{
|
{
|
||||||
"fiber/new", cfun_fiber_new,
|
"fiber/new", cfun_fiber_new,
|
||||||
JDOC("(fiber/new func &opt sigmask)\n\n"
|
JDOC("(fiber/new func [,sigmask])\n\n"
|
||||||
"Create a new fiber with function body func. Can optionally "
|
"Create a new fiber with function body func. Can optionally "
|
||||||
"take a set of signals to block from the current parent fiber "
|
"take a set of signals to block from the current parent fiber "
|
||||||
"when called. The mask is specified as a keyword where each character "
|
"when called. The mask is specified as a keyword where each character "
|
||||||
@@ -464,11 +445,8 @@ static const JanetReg fiber_cfuns[] = {
|
|||||||
"\te - block error signals\n"
|
"\te - block error signals\n"
|
||||||
"\tu - block user signals\n"
|
"\tu - block user signals\n"
|
||||||
"\ty - block yield signals\n"
|
"\ty - block yield signals\n"
|
||||||
"\t0-9 - block a specific user signal\n\n"
|
"\t0-9 - block a specific user signal\n"
|
||||||
"The sigmask argument also can take environment flags. If any mutually "
|
"\ti - inherit the environment from the current fiber (not related to signals)")
|
||||||
"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,
|
"fiber/status", cfun_fiber_status,
|
||||||
|
|||||||
@@ -39,11 +39,6 @@ JANET_THREAD_LOCAL Janet *janet_vm_roots;
|
|||||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
JANET_THREAD_LOCAL uint32_t janet_vm_root_count;
|
||||||
JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
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 */
|
/* Helpers for marking the various gc types */
|
||||||
static void janet_mark_funcenv(JanetFuncEnv *env);
|
static void janet_mark_funcenv(JanetFuncEnv *env);
|
||||||
static void janet_mark_funcdef(JanetFuncDef *def);
|
static void janet_mark_funcdef(JanetFuncDef *def);
|
||||||
@@ -262,10 +257,10 @@ static void janet_deinit_block(JanetGCObject *mem) {
|
|||||||
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
janet_symbol_deinit(((JanetStringHead *) mem)->data);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_ARRAY:
|
case JANET_MEMORY_ARRAY:
|
||||||
free(((JanetArray *) mem)->data);
|
janet_array_deinit((JanetArray *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_TABLE:
|
case JANET_MEMORY_TABLE:
|
||||||
free(((JanetTable *) mem)->data);
|
janet_table_deinit((JanetTable *) mem);
|
||||||
break;
|
break;
|
||||||
case JANET_MEMORY_FIBER:
|
case JANET_MEMORY_FIBER:
|
||||||
free(((JanetFiber *)mem)->data);
|
free(((JanetFiber *)mem)->data);
|
||||||
@@ -347,13 +342,6 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
|
|||||||
return (void *)mem;
|
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 */
|
/* Run garbage collection */
|
||||||
void janet_collect(void) {
|
void janet_collect(void) {
|
||||||
uint32_t i;
|
uint32_t i;
|
||||||
@@ -368,7 +356,6 @@ void janet_collect(void) {
|
|||||||
}
|
}
|
||||||
janet_sweep();
|
janet_sweep();
|
||||||
janet_vm_next_collection = 0;
|
janet_vm_next_collection = 0;
|
||||||
janet_free_all_scratch();
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Add a root value to the GC. This prevents the GC from removing a value
|
/* Add a root value to the GC. This prevents the GC from removing a value
|
||||||
@@ -442,8 +429,6 @@ void janet_clear_memory(void) {
|
|||||||
current = next;
|
current = next;
|
||||||
}
|
}
|
||||||
janet_vm_blocks = NULL;
|
janet_vm_blocks = NULL;
|
||||||
janet_free_all_scratch();
|
|
||||||
free(janet_scratch_mem);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Primitives for suspending GC. */
|
/* Primitives for suspending GC. */
|
||||||
@@ -453,56 +438,3 @@ int janet_gclock(void) {
|
|||||||
void janet_gcunlock(int handle) {
|
void janet_gcunlock(int handle) {
|
||||||
janet_vm_gc_suspend = 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");
|
|
||||||
}
|
|
||||||
|
|||||||
@@ -32,10 +32,6 @@
|
|||||||
#include "util.h"
|
#include "util.h"
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#ifndef JANET_WINDOWS
|
|
||||||
#include <sys/wait.h>
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#define IO_WRITE 1
|
#define IO_WRITE 1
|
||||||
#define IO_READ 2
|
#define IO_READ 2
|
||||||
#define IO_APPEND 4
|
#define IO_APPEND 4
|
||||||
@@ -164,36 +160,6 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
|
|||||||
return f ? makef(f, flags) : janet_wrap_nil();
|
return f ? makef(f, flags) : janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
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. */
|
/* Read up to n bytes into buffer. */
|
||||||
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
static void read_chunk(IOFile *iof, JanetBuffer *buffer, int32_t nBytesMax) {
|
||||||
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
if (!(iof->flags & (IO_READ | IO_UPDATE)))
|
||||||
@@ -319,17 +285,13 @@ static Janet cfun_io_fclose(int32_t argc, Janet *argv) {
|
|||||||
if (iof->flags & IO_PIPED) {
|
if (iof->flags & IO_PIPED) {
|
||||||
#ifdef JANET_WINDOWS
|
#ifdef JANET_WINDOWS
|
||||||
#define pclose _pclose
|
#define pclose _pclose
|
||||||
#define WEXITSTATUS(x) x
|
|
||||||
#endif
|
#endif
|
||||||
int status = pclose(iof->file);
|
if (pclose(iof->file)) janet_panic("could not close file");
|
||||||
iof->flags |= IO_CLOSED;
|
|
||||||
if (status == -1) janet_panic("could not close file");
|
|
||||||
return janet_wrap_integer(WEXITSTATUS(status));
|
|
||||||
} else {
|
} else {
|
||||||
if (fclose(iof->file)) janet_panic("could not close file");
|
if (fclose(iof->file)) janet_panic("could not close file");
|
||||||
iof->flags |= IO_CLOSED;
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
}
|
||||||
|
iof->flags |= IO_CLOSED;
|
||||||
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Seek a file */
|
/* Seek a file */
|
||||||
@@ -408,7 +370,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/open", cfun_io_fopen,
|
"file/open", cfun_io_fopen,
|
||||||
JDOC("(file/open path &opt mode)\n\n"
|
JDOC("(file/open path [,mode])\n\n"
|
||||||
"Open a file. path is an absolute or relative path, and "
|
"Open a file. path is an absolute or relative path, and "
|
||||||
"mode is a set of flags indicating the mode to open the file in. "
|
"mode is a set of flags indicating the mode to open the file in. "
|
||||||
"mode is a keyword where each character represents a flag. If the file "
|
"mode is a keyword where each character represents a flag. If the file "
|
||||||
@@ -420,26 +382,6 @@ static const JanetReg io_cfuns[] = {
|
|||||||
"\tb - open the file in binary mode (rather than text mode)\n"
|
"\tb - open the file in binary mode (rather than text mode)\n"
|
||||||
"\t+ - append to the file instead of overwriting it")
|
"\t+ - append to the file instead of overwriting it")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"file/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,
|
"file/close", cfun_io_fclose,
|
||||||
JDOC("(file/close f)\n\n"
|
JDOC("(file/close f)\n\n"
|
||||||
@@ -449,7 +391,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/read", cfun_io_fread,
|
"file/read", cfun_io_fread,
|
||||||
JDOC("(file/read f what &opt buf)\n\n"
|
JDOC("(file/read f what [,buf])\n\n"
|
||||||
"Read a number of bytes from a file into a buffer. A buffer can "
|
"Read a number of bytes from a file into a buffer. A buffer can "
|
||||||
"be provided as an optional fourth argument, otherwise a new buffer "
|
"be provided as an optional fourth argument, otherwise a new buffer "
|
||||||
"is created. 'what' can either be an integer or a keyword. Returns the "
|
"is created. 'what' can either be an integer or a keyword. Returns the "
|
||||||
@@ -473,7 +415,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/seek", cfun_io_fseek,
|
"file/seek", cfun_io_fseek,
|
||||||
JDOC("(file/seek f &opt whence n)\n\n"
|
JDOC("(file/seek f [,whence [,n]])\n\n"
|
||||||
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
"Jump to a relative location in the file. 'whence' must be one of\n\n"
|
||||||
"\t:cur - jump relative to the current file location\n"
|
"\t:cur - jump relative to the current file location\n"
|
||||||
"\t:set - jump relative to the beginning of the file\n"
|
"\t:set - jump relative to the beginning of the file\n"
|
||||||
@@ -484,7 +426,7 @@ static const JanetReg io_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"file/popen", cfun_io_popen,
|
"file/popen", cfun_io_popen,
|
||||||
JDOC("(file/popen path &opt mode)\n\n"
|
JDOC("(file/popen path [,mode])\n\n"
|
||||||
"Open a file that is backed by a process. The file must be opened in either "
|
"Open a file that is backed by a process. The file must be opened in either "
|
||||||
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
|
||||||
"process can be read from the file. In :w mode, the stdin of the process "
|
"process can be read from the file. In :w mode, the stdin of the process "
|
||||||
|
|||||||
@@ -84,36 +84,19 @@ static Janet entry_getval(Janet env_entry) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Merge values from an environment into an existing lookup table. */
|
/* Make a forward lookup table from an environment (for unmarshaling) */
|
||||||
void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse) {
|
JanetTable *janet_env_lookup(JanetTable *env) {
|
||||||
|
JanetTable *renv = janet_table(env->count);
|
||||||
while (env) {
|
while (env) {
|
||||||
for (int32_t i = 0; i < env->capacity; i++) {
|
for (int32_t i = 0; i < env->capacity; i++) {
|
||||||
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
|
if (janet_checktype(env->data[i].key, JANET_SYMBOL)) {
|
||||||
if (prefix) {
|
|
||||||
int32_t prelen = (int32_t) strlen(prefix);
|
|
||||||
const uint8_t *oldsym = janet_unwrap_symbol(env->data[i].key);
|
|
||||||
int32_t oldlen = janet_string_length(oldsym);
|
|
||||||
uint8_t *symbuf = janet_smalloc(prelen + oldlen);
|
|
||||||
memcpy(symbuf, prefix, prelen);
|
|
||||||
memcpy(symbuf + prelen, oldsym, oldlen);
|
|
||||||
Janet s = janet_symbolv(symbuf, prelen + oldlen);
|
|
||||||
janet_sfree(symbuf);
|
|
||||||
janet_table_put(renv, s, entry_getval(env->data[i].value));
|
|
||||||
} else {
|
|
||||||
janet_table_put(renv,
|
janet_table_put(renv,
|
||||||
env->data[i].key,
|
env->data[i].key,
|
||||||
entry_getval(env->data[i].value));
|
entry_getval(env->data[i].value));
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
env = env->proto;
|
||||||
}
|
}
|
||||||
env = recurse ? env->proto : NULL;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Make a forward lookup table from an environment (for unmarshaling) */
|
|
||||||
JanetTable *janet_env_lookup(JanetTable *env) {
|
|
||||||
JanetTable *renv = janet_table(env->count);
|
|
||||||
janet_env_lookup_into(renv, env, NULL, 1);
|
|
||||||
return renv;
|
return renv;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -258,9 +241,9 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
|||||||
int32_t current = 0;
|
int32_t current = 0;
|
||||||
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
for (int32_t i = 0; i < def->bytecode_length; i++) {
|
||||||
JanetSourceMapping map = def->sourcemap[i];
|
JanetSourceMapping map = def->sourcemap[i];
|
||||||
pushint(st, map.line - current);
|
pushint(st, map.start - current);
|
||||||
pushint(st, map.column);
|
pushint(st, map.end - map.start);
|
||||||
current = map.line;
|
current = map.end;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -345,11 +328,11 @@ static void marshal_one_abstract(MarshalState *st, Janet x, int flags) {
|
|||||||
void *abstract = janet_unwrap_abstract(x);
|
void *abstract = janet_unwrap_abstract(x);
|
||||||
const JanetAbstractType *at = janet_abstract_type(abstract);
|
const JanetAbstractType *at = janet_abstract_type(abstract);
|
||||||
if (at->marshal) {
|
if (at->marshal) {
|
||||||
|
MARK_SEEN();
|
||||||
JanetMarshalContext context = {st, NULL, flags, NULL};
|
JanetMarshalContext context = {st, NULL, flags, NULL};
|
||||||
pushbyte(st, LB_ABSTRACT);
|
pushbyte(st, LB_ABSTRACT);
|
||||||
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
marshal_one(st, janet_csymbolv(at->name), flags + 1);
|
||||||
push64(st, (uint64_t) janet_abstract_size(abstract));
|
push64(st, (uint64_t) janet_abstract_size(abstract));
|
||||||
MARK_SEEN();
|
|
||||||
at->marshal(abstract, &context);
|
at->marshal(abstract, &context);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
janet_panicf("try to marshal unregistered abstract type, cannot marshal %p", x);
|
||||||
@@ -552,6 +535,7 @@ void janet_marshal(
|
|||||||
st.rreg = rreg;
|
st.rreg = rreg;
|
||||||
janet_table_init(&st.seen, 0);
|
janet_table_init(&st.seen, 0);
|
||||||
marshal_one(&st, x, flags);
|
marshal_one(&st, x, flags);
|
||||||
|
/* Clean up. See comment in janet_unmarshal about autoreleasing memory on panics.*/
|
||||||
janet_table_deinit(&st.seen);
|
janet_table_deinit(&st.seen);
|
||||||
janet_v_free(st.seen_envs);
|
janet_v_free(st.seen_envs);
|
||||||
janet_v_free(st.seen_defs);
|
janet_v_free(st.seen_defs);
|
||||||
@@ -559,7 +543,7 @@ void janet_marshal(
|
|||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
jmp_buf err;
|
jmp_buf err;
|
||||||
Janet *lookup;
|
JanetArray lookup;
|
||||||
JanetTable *reg;
|
JanetTable *reg;
|
||||||
JanetFuncEnv **lookup_envs;
|
JanetFuncEnv **lookup_envs;
|
||||||
JanetFuncDef **lookup_defs;
|
JanetFuncDef **lookup_defs;
|
||||||
@@ -827,8 +811,9 @@ static const uint8_t *unmarshal_one_def(
|
|||||||
}
|
}
|
||||||
for (int32_t i = 0; i < bytecode_length; i++) {
|
for (int32_t i = 0; i < bytecode_length; i++) {
|
||||||
current += readint(st, &data);
|
current += readint(st, &data);
|
||||||
def->sourcemap[i].line = current;
|
def->sourcemap[i].start = current;
|
||||||
def->sourcemap[i].column = readint(st, &data);
|
current += readint(st, &data);
|
||||||
|
def->sourcemap[i].end = current;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
def->sourcemap = NULL;
|
def->sourcemap = NULL;
|
||||||
@@ -864,7 +849,7 @@ static const uint8_t *unmarshal_one_fiber(
|
|||||||
fiber->env = NULL;
|
fiber->env = NULL;
|
||||||
|
|
||||||
/* Push fiber to seen stack */
|
/* Push fiber to seen stack */
|
||||||
janet_v_push(st->lookup, janet_wrap_fiber(fiber));
|
janet_array_push(&st->lookup, janet_wrap_fiber(fiber));
|
||||||
|
|
||||||
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
/* Set frame later so fiber can be GCed at anytime if unmarshalling fails */
|
||||||
int32_t frame = 0;
|
int32_t frame = 0;
|
||||||
@@ -1024,11 +1009,10 @@ static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *
|
|||||||
if (at == NULL) return NULL;
|
if (at == NULL) return NULL;
|
||||||
if (at->unmarshal) {
|
if (at->unmarshal) {
|
||||||
void *p = janet_abstract(at, (size_t) read64(st, &data));
|
void *p = janet_abstract(at, (size_t) read64(st, &data));
|
||||||
*out = janet_wrap_abstract(p);
|
|
||||||
JanetMarshalContext context = {NULL, st, flags, data};
|
JanetMarshalContext context = {NULL, st, flags, data};
|
||||||
janet_v_push(st->lookup, *out);
|
|
||||||
at->unmarshal(p, &context);
|
at->unmarshal(p, &context);
|
||||||
return context.data;
|
*out = janet_wrap_abstract(p);
|
||||||
|
return data;
|
||||||
}
|
}
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
@@ -1086,8 +1070,8 @@ static const uint8_t *unmarshal_one(
|
|||||||
#else
|
#else
|
||||||
memcpy(&u.bytes, data + 1, sizeof(double));
|
memcpy(&u.bytes, data + 1, sizeof(double));
|
||||||
#endif
|
#endif
|
||||||
*out = janet_wrap_number_safe(u.d);
|
*out = janet_wrap_number(u.d);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
return data + 9;
|
return data + 9;
|
||||||
}
|
}
|
||||||
case LB_STRING:
|
case LB_STRING:
|
||||||
@@ -1120,7 +1104,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
memcpy(buffer->data, data, len);
|
memcpy(buffer->data, data, len);
|
||||||
*out = janet_wrap_buffer(buffer);
|
*out = janet_wrap_buffer(buffer);
|
||||||
}
|
}
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
return data + len;
|
return data + len;
|
||||||
}
|
}
|
||||||
case LB_FIBER: {
|
case LB_FIBER: {
|
||||||
@@ -1137,7 +1121,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
def->environments_length * sizeof(JanetFuncEnv));
|
def->environments_length * sizeof(JanetFuncEnv));
|
||||||
func->def = def;
|
func->def = def;
|
||||||
*out = janet_wrap_function(func);
|
*out = janet_wrap_function(func);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
for (int32_t i = 0; i < def->environments_length; i++) {
|
for (int32_t i = 0; i < def->environments_length; i++) {
|
||||||
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
|
||||||
}
|
}
|
||||||
@@ -1162,7 +1146,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
JanetArray *array = janet_array(len);
|
JanetArray *array = janet_array(len);
|
||||||
array->count = len;
|
array->count = len;
|
||||||
*out = janet_wrap_array(array);
|
*out = janet_wrap_array(array);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
for (int32_t i = 0; i < len; i++) {
|
for (int32_t i = 0; i < len; i++) {
|
||||||
data = unmarshal_one(st, data, array->data + i, flags + 1);
|
data = unmarshal_one(st, data, array->data + i, flags + 1);
|
||||||
}
|
}
|
||||||
@@ -1175,7 +1159,7 @@ static const uint8_t *unmarshal_one(
|
|||||||
data = unmarshal_one(st, data, tup + i, flags + 1);
|
data = unmarshal_one(st, data, tup + i, flags + 1);
|
||||||
}
|
}
|
||||||
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
*out = janet_wrap_tuple(janet_tuple_end(tup));
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
} else if (lead == LB_STRUCT) {
|
} else if (lead == LB_STRUCT) {
|
||||||
/* Struct */
|
/* Struct */
|
||||||
JanetKV *struct_ = janet_struct_begin(len);
|
JanetKV *struct_ = janet_struct_begin(len);
|
||||||
@@ -1186,16 +1170,16 @@ static const uint8_t *unmarshal_one(
|
|||||||
janet_struct_put(struct_, key, value);
|
janet_struct_put(struct_, key, value);
|
||||||
}
|
}
|
||||||
*out = janet_wrap_struct(janet_struct_end(struct_));
|
*out = janet_wrap_struct(janet_struct_end(struct_));
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
} else if (lead == LB_REFERENCE) {
|
} else if (lead == LB_REFERENCE) {
|
||||||
if (len < 0 || len >= janet_v_count(st->lookup))
|
if (len < 0 || len >= st->lookup.count)
|
||||||
janet_panicf("invalid reference %d", len);
|
janet_panicf("invalid reference %d", len);
|
||||||
*out = st->lookup[len];
|
*out = st->lookup.data[len];
|
||||||
} else {
|
} else {
|
||||||
/* Table */
|
/* Table */
|
||||||
JanetTable *t = janet_table(len);
|
JanetTable *t = janet_table(len);
|
||||||
*out = janet_wrap_table(t);
|
*out = janet_wrap_table(t);
|
||||||
janet_v_push(st->lookup, *out);
|
janet_array_push(&st->lookup, *out);
|
||||||
if (lead == LB_TABLE_PROTO) {
|
if (lead == LB_TABLE_PROTO) {
|
||||||
Janet proto;
|
Janet proto;
|
||||||
data = unmarshal_one(st, data, &proto, flags + 1);
|
data = unmarshal_one(st, data, &proto, flags + 1);
|
||||||
@@ -1232,14 +1216,17 @@ Janet janet_unmarshal(
|
|||||||
st.end = bytes + len;
|
st.end = bytes + len;
|
||||||
st.lookup_defs = NULL;
|
st.lookup_defs = NULL;
|
||||||
st.lookup_envs = NULL;
|
st.lookup_envs = NULL;
|
||||||
st.lookup = NULL;
|
|
||||||
st.reg = reg;
|
st.reg = reg;
|
||||||
|
janet_array_init(&st.lookup, 0);
|
||||||
Janet out;
|
Janet out;
|
||||||
const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
|
const uint8_t *nextbytes = unmarshal_one(&st, bytes, &out, flags);
|
||||||
if (next) *next = nextbytes;
|
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_defs);
|
||||||
janet_v_free(st.lookup_envs);
|
janet_v_free(st.lookup_envs);
|
||||||
janet_v_free(st.lookup);
|
|
||||||
return out;
|
return out;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1280,7 +1267,7 @@ static Janet cfun_unmarshal(int32_t argc, Janet *argv) {
|
|||||||
static const JanetReg marsh_cfuns[] = {
|
static const JanetReg marsh_cfuns[] = {
|
||||||
{
|
{
|
||||||
"marshal", cfun_marshal,
|
"marshal", cfun_marshal,
|
||||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
JDOC("(marshal x [,reverse-lookup [,buffer]])\n\n"
|
||||||
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
"Marshal a janet value into a buffer and return the buffer. The buffer "
|
||||||
"can the later be unmarshalled to reconstruct the initial value. "
|
"can the later be unmarshalled to reconstruct the initial value. "
|
||||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||||
@@ -1290,7 +1277,7 @@ static const JanetReg marsh_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"unmarshal", cfun_unmarshal,
|
"unmarshal", cfun_unmarshal,
|
||||||
JDOC("(unmarshal buffer &opt lookup)\n\n"
|
JDOC("(unmarshal buffer [,lookup])\n\n"
|
||||||
"Unmarshal a janet value from a buffer. An optional lookup table "
|
"Unmarshal a janet value from a buffer. An optional lookup table "
|
||||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||||
"unmarshalled from the buffer.")
|
"unmarshalled from the buffer.")
|
||||||
|
|||||||
@@ -149,7 +149,7 @@ static const JanetReg math_cfuns[] = {
|
|||||||
{
|
{
|
||||||
"math/log", janet_log,
|
"math/log", janet_log,
|
||||||
JDOC("(math/log x)\n\n"
|
JDOC("(math/log x)\n\n"
|
||||||
"Returns log base natural number of x.")
|
"Returns log base 2 of x.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"math/log10", janet_log10,
|
"math/log10", janet_log10,
|
||||||
|
|||||||
395
src/core/os.c
395
src/core/os.c
@@ -41,15 +41,12 @@
|
|||||||
#include <direct.h>
|
#include <direct.h>
|
||||||
#include <sys/utime.h>
|
#include <sys/utime.h>
|
||||||
#include <io.h>
|
#include <io.h>
|
||||||
#include <process.h>
|
|
||||||
#else
|
#else
|
||||||
#include <spawn.h>
|
|
||||||
#include <utime.h>
|
#include <utime.h>
|
||||||
#include <unistd.h>
|
#include <unistd.h>
|
||||||
#include <dirent.h>
|
#include <dirent.h>
|
||||||
#include <sys/types.h>
|
#include <sys/types.h>
|
||||||
#include <sys/wait.h>
|
#include <sys/wait.h>
|
||||||
extern char **environ;
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* For macos */
|
/* For macos */
|
||||||
@@ -64,60 +61,20 @@ extern char **environ;
|
|||||||
|
|
||||||
/* Full OS functions */
|
/* Full OS functions */
|
||||||
|
|
||||||
#define janet_stringify1(x) #x
|
|
||||||
#define janet_stringify(x) janet_stringify1(x)
|
|
||||||
|
|
||||||
static Janet os_which(int32_t argc, Janet *argv) {
|
static Janet os_which(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 0);
|
janet_fixarity(argc, 0);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
#if defined(JANET_OS_NAME)
|
#ifdef JANET_WINDOWS
|
||||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
|
||||||
#elif defined(JANET_WINDOWS)
|
|
||||||
return janet_ckeywordv("windows");
|
return janet_ckeywordv("windows");
|
||||||
#elif defined(__APPLE__)
|
#elif __APPLE__
|
||||||
return janet_ckeywordv("macos");
|
return janet_ckeywordv("macos");
|
||||||
#elif defined(__EMSCRIPTEN__)
|
#elif defined(__EMSCRIPTEN__)
|
||||||
return janet_ckeywordv("web");
|
return janet_ckeywordv("web");
|
||||||
#elif defined(__linux__)
|
|
||||||
return janet_ckeywordv("linux");
|
|
||||||
#elif defined(__FreeBSD__)
|
|
||||||
return janet_ckeywordv("freebsd");
|
|
||||||
#elif defined(__NetBSD__)
|
|
||||||
return janet_ckeywordv("netbsd");
|
|
||||||
#elif defined(__OpenBSD__)
|
|
||||||
return janet_ckeywordv("openbsd");
|
|
||||||
#else
|
#else
|
||||||
return janet_ckeywordv("posix");
|
return janet_ckeywordv("posix");
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Detect the ISA we are compiled for */
|
|
||||||
static Janet os_arch(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 0);
|
|
||||||
(void) argv;
|
|
||||||
/* Check 64-bit vs 32-bit */
|
|
||||||
#if defined(JANET_ARCH_NAME)
|
|
||||||
return janet_ckeywordv(janet_stringify(JANET_ARCH_NAME));
|
|
||||||
#elif defined(__EMSCRIPTEN__)
|
|
||||||
return janet_ckeywordv("wasm");
|
|
||||||
#elif (defined(__x86_64__) || defined(_M_X64))
|
|
||||||
return janet_ckeywordv("x86-64");
|
|
||||||
#elif defined(__i386) || defined(_M_IX86)
|
|
||||||
return janet_ckeywordv("x86");
|
|
||||||
#elif defined(_M_ARM64) || defined(__aarch64__)
|
|
||||||
return janet_ckeywordv("aarch64");
|
|
||||||
#elif defined(_M_ARM) || defined(__arm__)
|
|
||||||
return janet_ckeywordv("arm");
|
|
||||||
#elif (defined(__sparc__))
|
|
||||||
return janet_ckeywordv("sparc");
|
|
||||||
#else
|
|
||||||
return janet_ckeywordv("unknown");
|
|
||||||
#endif
|
|
||||||
}
|
|
||||||
|
|
||||||
#undef janet_stringify1
|
|
||||||
#undef janet_stringify
|
|
||||||
|
|
||||||
static Janet os_exit(int32_t argc, Janet *argv) {
|
static Janet os_exit(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
if (argc == 0) {
|
if (argc == 0) {
|
||||||
@@ -131,7 +88,7 @@ static Janet os_exit(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#ifdef JANET_REDUCED_OS
|
#ifdef JANET_REDUCED_OS
|
||||||
/* Provide a dud os/getenv so boot.janet and init.janet work, but nothing else */
|
/* Provide a dud os/getenv so init.janet works, but nothing else */
|
||||||
|
|
||||||
static Janet os_getenv(int32_t argc, Janet *argv) {
|
static Janet os_getenv(int32_t argc, Janet *argv) {
|
||||||
(void) argv;
|
(void) argv;
|
||||||
@@ -142,224 +99,97 @@ static Janet os_getenv(int32_t argc, Janet *argv) {
|
|||||||
#else
|
#else
|
||||||
/* Provide full os functionality */
|
/* 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
|
#ifdef JANET_WINDOWS
|
||||||
(void) child_argv;
|
|
||||||
#else
|
|
||||||
janet_sfree((void *)child_argv);
|
|
||||||
#endif
|
|
||||||
if (NULL != envp) {
|
|
||||||
char **envitem = envp;
|
|
||||||
while (*envitem != NULL) {
|
|
||||||
janet_sfree(*envitem);
|
|
||||||
envitem++;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_sfree(envp);
|
|
||||||
}
|
|
||||||
|
|
||||||
#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) {
|
static Janet os_execute(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 1, 3);
|
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);
|
||||||
|
|
||||||
/* Get flags */
|
/* Convert to wide chars */
|
||||||
uint64_t flags = 0;
|
wchar_t *sys_str = malloc(buffer->count * sizeof(wchar_t));
|
||||||
if (argc > 1) {
|
if (NULL == sys_str) {
|
||||||
flags = janet_getflags(argv, 1, "ep");
|
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");
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get environment */
|
STARTUPINFO si;
|
||||||
char **envp = os_execute_env(argc, argv);
|
PROCESS_INFORMATION pi;
|
||||||
|
|
||||||
/* Get arguments */
|
ZeroMemory(&si, sizeof(si));
|
||||||
JanetView exargs = janet_getindexed(argv, 0);
|
si.cb = sizeof(si);
|
||||||
if (exargs.len < 1) {
|
ZeroMemory(&pi, sizeof(pi));
|
||||||
janet_panic("expected at least 1 command line argument");
|
|
||||||
|
// 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);
|
||||||
|
|
||||||
/* Result */
|
// Wait until child process exits.
|
||||||
int status = 0;
|
WaitForSingleObject(pi.hProcess, INFINITE);
|
||||||
|
|
||||||
#ifdef JANET_WINDOWS
|
|
||||||
|
|
||||||
JanetBuffer *buf = os_exec_escape(exargs);
|
|
||||||
if (buf->count > 8191) {
|
|
||||||
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));
|
|
||||||
}
|
|
||||||
|
|
||||||
|
// Close process and thread handles.
|
||||||
|
WORD status;
|
||||||
|
GetExitCodeProcess(pi.hProcess, (LPDWORD)&status);
|
||||||
|
CloseHandle(pi.hProcess);
|
||||||
|
CloseHandle(pi.hThread);
|
||||||
return janet_wrap_integer(status);
|
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);
|
|
||||||
}
|
}
|
||||||
|
#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;
|
||||||
|
}
|
||||||
|
for (int32_t i = 0; i < argc; i++) {
|
||||||
|
child_argv[i] = janet_getcstring(argv, i);
|
||||||
|
}
|
||||||
|
child_argv[argc] = NULL;
|
||||||
|
|
||||||
/* Wait for child */
|
/* Fork child process */
|
||||||
if (status) {
|
pid_t pid = fork();
|
||||||
os_execute_cleanup(envp, child_argv);
|
if (pid < 0) {
|
||||||
janet_panic(strerror(status));
|
janet_panic("failed to execute");
|
||||||
|
} else if (pid == 0) {
|
||||||
|
if (-1 == execve(child_argv[0], (char **)child_argv, NULL)) {
|
||||||
|
exit(1);
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
waitpid(pid, &status, 0);
|
waitpid(pid, &status, 0);
|
||||||
}
|
}
|
||||||
|
free(child_argv);
|
||||||
os_execute_cleanup(envp, child_argv);
|
return janet_wrap_integer(status);
|
||||||
return janet_wrap_integer(WEXITSTATUS(status));
|
|
||||||
#endif
|
|
||||||
}
|
}
|
||||||
|
#endif
|
||||||
|
|
||||||
static Janet os_shell(int32_t argc, Janet *argv) {
|
static Janet os_shell(int32_t argc, Janet *argv) {
|
||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
@@ -477,19 +307,13 @@ static Janet os_date(int32_t argc, Janet *argv) {
|
|||||||
janet_arity(argc, 0, 1);
|
janet_arity(argc, 0, 1);
|
||||||
(void) argv;
|
(void) argv;
|
||||||
time_t t;
|
time_t t;
|
||||||
struct tm t_infos;
|
|
||||||
struct tm *t_info;
|
struct tm *t_info;
|
||||||
if (argc) {
|
if (argc) {
|
||||||
t = (time_t) janet_getinteger64(argv, 0);
|
t = (time_t) janet_getinteger64(argv, 0);
|
||||||
} else {
|
} else {
|
||||||
time(&t);
|
time(&t);
|
||||||
}
|
}
|
||||||
#ifdef JANET_WINDOWS
|
t_info = localtime(&t);
|
||||||
localtime_s(&t_infos, &t);
|
|
||||||
t_info = &t_infos;
|
|
||||||
#else
|
|
||||||
t_info = localtime_r(&t, &t_infos);
|
|
||||||
#endif
|
|
||||||
JanetKV *st = janet_struct_begin(9);
|
JanetKV *st = janet_struct_begin(9);
|
||||||
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
|
janet_struct_put(st, janet_ckeywordv("seconds"), janet_wrap_number(t_info->tm_sec));
|
||||||
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
|
janet_struct_put(st, janet_ckeywordv("minutes"), janet_wrap_number(t_info->tm_min));
|
||||||
@@ -783,23 +607,12 @@ static Janet os_dir(int32_t argc, Janet *argv) {
|
|||||||
return janet_wrap_array(paths);
|
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 */
|
#endif /* JANET_REDUCED_OS */
|
||||||
|
|
||||||
static const JanetReg os_cfuns[] = {
|
static const JanetReg os_cfuns[] = {
|
||||||
{
|
{
|
||||||
"os/exit", os_exit,
|
"os/exit", os_exit,
|
||||||
JDOC("(os/exit &opt x)\n\n"
|
JDOC("(os/exit x)\n\n"
|
||||||
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
"Exit from janet with an exit code equal to x. If x is not an integer, "
|
||||||
"the exit with status equal the hash of x.")
|
"the exit with status equal the hash of x.")
|
||||||
},
|
},
|
||||||
@@ -807,13 +620,8 @@ static const JanetReg os_cfuns[] = {
|
|||||||
"os/which", os_which,
|
"os/which", os_which,
|
||||||
JDOC("(os/which)\n\n"
|
JDOC("(os/which)\n\n"
|
||||||
"Check the current operating system. Returns one of:\n\n"
|
"Check the current operating system. Returns one of:\n\n"
|
||||||
"\t:windows\n"
|
"\t:windows - Microsoft Windows\n"
|
||||||
"\t:macos\n"
|
"\t:macos - Apple macos\n"
|
||||||
"\t:web - Web assembly (emscripten)\n"
|
|
||||||
"\t:linux\n"
|
|
||||||
"\t:freebsd\n"
|
|
||||||
"\t:openbsd\n"
|
|
||||||
"\t:netbsd\n"
|
|
||||||
"\t:posix - A POSIX compatible system (default)")
|
"\t:posix - A POSIX compatible system (default)")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
@@ -821,28 +629,16 @@ static const JanetReg os_cfuns[] = {
|
|||||||
JDOC("(os/getenv variable)\n\n"
|
JDOC("(os/getenv variable)\n\n"
|
||||||
"Get the string value of an environment variable.")
|
"Get the string value of an environment variable.")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"os/arch", os_arch,
|
|
||||||
JDOC("(os/arch)\n\n"
|
|
||||||
"Check the ISA that janet was compiled for. Returns one of:\n\n"
|
|
||||||
"\t:x86\n"
|
|
||||||
"\t:x86-64\n"
|
|
||||||
"\t:arm\n"
|
|
||||||
"\t:aarch64\n"
|
|
||||||
"\t:sparc\n"
|
|
||||||
"\t:wasm\n"
|
|
||||||
"\t:unknown\n")
|
|
||||||
},
|
|
||||||
#ifndef JANET_REDUCED_OS
|
#ifndef JANET_REDUCED_OS
|
||||||
{
|
{
|
||||||
"os/dir", os_dir,
|
"os/dir", os_dir,
|
||||||
JDOC("(os/dir dir &opt array)\n\n"
|
JDOC("(os/dir dir [, array])\n\n"
|
||||||
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
"Iterate over files and subdirectories in a directory. Returns an array of paths parts, "
|
||||||
"with only the filename or directory name and no prefix.")
|
"with only the filename or directory name and no prefix.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/stat", os_stat,
|
"os/stat", os_stat,
|
||||||
JDOC("(os/stat path &opt tab|key)\n\n"
|
JDOC("(os/stat path [, tab|key])\n\n"
|
||||||
"Gets information about a file or directory. Returns a table If the third argument is a keyword, returns "
|
"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"
|
" only that information from stat. If the file or directory does not exist, returns nil. The keys are\n\n"
|
||||||
"\t:dev - the device that the file is on\n"
|
"\t:dev - the device that the file is on\n"
|
||||||
@@ -861,7 +657,7 @@ static const JanetReg os_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/touch", os_touch,
|
"os/touch", os_touch,
|
||||||
JDOC("(os/touch path &opt actime modtime)\n\n"
|
JDOC("(os/touch path [, actime [, modtime]])\n\n"
|
||||||
"Update the access time and modification times for a file. By default, sets "
|
"Update the access time and modification times for a file. By default, sets "
|
||||||
"times to the current time.")
|
"times to the current time.")
|
||||||
},
|
},
|
||||||
@@ -888,21 +684,15 @@ static const JanetReg os_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/link", os_link,
|
"os/link", os_link,
|
||||||
JDOC("(os/link oldpath newpath &opt symlink)\n\n"
|
JDOC("(os/link oldpath newpath [, symlink])\n\n"
|
||||||
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
"Create a symlink from oldpath to newpath. The 3 optional paramater "
|
||||||
"enables a hard link over a soft link. Does not work on Windows.")
|
"enables a hard link over a soft link. Does not work on Windows.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/execute", os_execute,
|
"os/execute", os_execute,
|
||||||
JDOC("(os/execute args &opts flags env)\n\n"
|
JDOC("(os/execute program & args)\n\n"
|
||||||
"Execute a program on the system and pass it string arguments. Flags "
|
"Execute a program on the system and pass it string arguments. Returns "
|
||||||
"is a keyword that modifies how the program will execute.\n\n"
|
"the exit status of the program.")
|
||||||
"\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,
|
"os/shell", os_shell,
|
||||||
@@ -939,7 +729,7 @@ static const JanetReg os_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"os/date", os_date,
|
"os/date", os_date,
|
||||||
JDOC("(os/date &opt time)\n\n"
|
JDOC("(os/date [,time])\n\n"
|
||||||
"Returns the given time as a date struct, or the current time if no time is given. "
|
"Returns the given time as a date struct, or the current time if no time is given. "
|
||||||
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
"Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||||
"\t:seconds - number of seconds [0-61]\n"
|
"\t:seconds - number of seconds [0-61]\n"
|
||||||
@@ -952,11 +742,6 @@ static const JanetReg os_cfuns[] = {
|
|||||||
"\t:year-day - day of the year [0-365]\n"
|
"\t:year-day - day of the year [0-365]\n"
|
||||||
"\t:dst - If Day Light Savings is in effect")
|
"\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
|
#endif
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|||||||
295
src/core/parse.c
295
src/core/parse.c
@@ -42,7 +42,7 @@ static int is_whitespace(uint8_t c) {
|
|||||||
* if not. The upper characters are also considered symbol
|
* if not. The upper characters are also considered symbol
|
||||||
* chars and are then checked for utf-8 compliance. */
|
* chars and are then checked for utf-8 compliance. */
|
||||||
static const uint32_t symchars[8] = {
|
static const uint32_t symchars[8] = {
|
||||||
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x07fffffe,
|
0x00000000, 0xf7ffec72, 0xc7ffffff, 0x17fffffe,
|
||||||
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
|
0xffffffff, 0xffffffff, 0xffffffff, 0xffffffff
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -106,8 +106,7 @@ struct JanetParseState {
|
|||||||
int32_t counter;
|
int32_t counter;
|
||||||
int32_t argn;
|
int32_t argn;
|
||||||
int flags;
|
int flags;
|
||||||
size_t line;
|
size_t start;
|
||||||
size_t column;
|
|
||||||
Consumer consumer;
|
Consumer consumer;
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -145,8 +144,6 @@ DEF_PARSER_STACK(_pushstate, JanetParseState, states, statecount, statecap)
|
|||||||
#define PFLAG_LONGSTRING 0x4000
|
#define PFLAG_LONGSTRING 0x4000
|
||||||
#define PFLAG_READERMAC 0x8000
|
#define PFLAG_READERMAC 0x8000
|
||||||
#define PFLAG_ATSYM 0x10000
|
#define PFLAG_ATSYM 0x10000
|
||||||
#define PFLAG_COMMENT 0x20000
|
|
||||||
#define PFLAG_TOKEN 0x40000
|
|
||||||
|
|
||||||
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
||||||
JanetParseState s;
|
JanetParseState s;
|
||||||
@@ -154,8 +151,7 @@ static void pushstate(JanetParser *p, Consumer consumer, int flags) {
|
|||||||
s.argn = 0;
|
s.argn = 0;
|
||||||
s.flags = flags;
|
s.flags = flags;
|
||||||
s.consumer = consumer;
|
s.consumer = consumer;
|
||||||
s.line = p->line;
|
s.start = p->offset;
|
||||||
s.column = p->column;
|
|
||||||
_pushstate(p, s);
|
_pushstate(p, s);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -166,8 +162,8 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
if (newtop->flags & PFLAG_CONTAINER) {
|
if (newtop->flags & PFLAG_CONTAINER) {
|
||||||
/* Source mapping info */
|
/* Source mapping info */
|
||||||
if (janet_checktype(val, JANET_TUPLE)) {
|
if (janet_checktype(val, JANET_TUPLE)) {
|
||||||
janet_tuple_sm_line(janet_unwrap_tuple(val)) = (int32_t) top.line;
|
janet_tuple_sm_start(janet_unwrap_tuple(val)) = (int32_t) top.start;
|
||||||
janet_tuple_sm_column(janet_unwrap_tuple(val)) = (int32_t) top.column;
|
janet_tuple_sm_end(janet_unwrap_tuple(val)) = (int32_t) p->offset;
|
||||||
}
|
}
|
||||||
newtop->argn++;
|
newtop->argn++;
|
||||||
/* Keep track of number of values in the root state */
|
/* Keep track of number of values in the root state */
|
||||||
@@ -181,13 +177,12 @@ static void popstate(JanetParser *p, Janet val) {
|
|||||||
(c == '\'') ? "quote" :
|
(c == '\'') ? "quote" :
|
||||||
(c == ',') ? "unquote" :
|
(c == ',') ? "unquote" :
|
||||||
(c == ';') ? "splice" :
|
(c == ';') ? "splice" :
|
||||||
(c == '|') ? "short-fn" :
|
|
||||||
(c == '~') ? "quasiquote" : "<unknown>";
|
(c == '~') ? "quasiquote" : "<unknown>";
|
||||||
t[0] = janet_csymbolv(which);
|
t[0] = janet_csymbolv(which);
|
||||||
t[1] = val;
|
t[1] = val;
|
||||||
/* Quote source mapping info */
|
/* Quote source mapping info */
|
||||||
janet_tuple_sm_line(t) = (int32_t) newtop->line;
|
janet_tuple_sm_start(t) = (int32_t) newtop->start;
|
||||||
janet_tuple_sm_column(t) = (int32_t) newtop->column;
|
janet_tuple_sm_end(t) = (int32_t) p->offset;
|
||||||
val = janet_wrap_tuple(janet_tuple_end(t));
|
val = janet_wrap_tuple(janet_tuple_end(t));
|
||||||
} else {
|
} else {
|
||||||
return;
|
return;
|
||||||
@@ -297,7 +292,7 @@ static int stringchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
return stringend(p, state);
|
return stringend(p, state);
|
||||||
}
|
}
|
||||||
/* normal char */
|
/* normal char */
|
||||||
if (c != '\n' && c != '\r')
|
if (c != '\n')
|
||||||
push_buf(p, c);
|
push_buf(p, c);
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
@@ -362,12 +357,7 @@ static int tokenchar(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int comment(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
(void) state;
|
||||||
if (c == '\n') {
|
if (c == '\n') p->statecount--;
|
||||||
p->statecount--;
|
|
||||||
p->bufcount = 0;
|
|
||||||
} else {
|
|
||||||
push_buf(p, c);
|
|
||||||
}
|
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -453,7 +443,7 @@ static int longstring(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
|
|
||||||
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
static int root(JanetParser *p, JanetParseState *state, uint8_t c);
|
||||||
|
|
||||||
static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
|
static int ampersand(JanetParser *p, JanetParseState *state, uint8_t c) {
|
||||||
(void) state;
|
(void) state;
|
||||||
p->statecount--;
|
p->statecount--;
|
||||||
switch (c) {
|
switch (c) {
|
||||||
@@ -475,8 +465,8 @@ static int atsign(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
pushstate(p, tokenchar, PFLAG_TOKEN);
|
pushstate(p, tokenchar, 0);
|
||||||
push_buf(p, '@'); /* Push the leading at-sign that was dropped */
|
push_buf(p, '@'); /* Push the leading ampersand that was dropped */
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -489,23 +479,22 @@ static int root(JanetParser *p, JanetParseState *state, uint8_t c) {
|
|||||||
p->error = "unexpected character";
|
p->error = "unexpected character";
|
||||||
return 1;
|
return 1;
|
||||||
}
|
}
|
||||||
pushstate(p, tokenchar, PFLAG_TOKEN);
|
pushstate(p, tokenchar, 0);
|
||||||
return 0;
|
return 0;
|
||||||
case '\'':
|
case '\'':
|
||||||
case ',':
|
case ',':
|
||||||
case ';':
|
case ';':
|
||||||
case '~':
|
case '~':
|
||||||
case '|':
|
|
||||||
pushstate(p, root, PFLAG_READERMAC | c);
|
pushstate(p, root, PFLAG_READERMAC | c);
|
||||||
return 1;
|
return 1;
|
||||||
case '"':
|
case '"':
|
||||||
pushstate(p, stringchar, PFLAG_STRING);
|
pushstate(p, stringchar, PFLAG_STRING);
|
||||||
return 1;
|
return 1;
|
||||||
case '#':
|
case '#':
|
||||||
pushstate(p, comment, PFLAG_COMMENT);
|
pushstate(p, comment, 0);
|
||||||
return 1;
|
return 1;
|
||||||
case '@':
|
case '@':
|
||||||
pushstate(p, atsign, PFLAG_ATSYM);
|
pushstate(p, ampersand, 0);
|
||||||
return 1;
|
return 1;
|
||||||
case '`':
|
case '`':
|
||||||
pushstate(p, longstring, PFLAG_LONGSTRING);
|
pushstate(p, longstring, PFLAG_LONGSTRING);
|
||||||
@@ -564,16 +553,7 @@ static void janet_parser_checkdead(JanetParser *parser) {
|
|||||||
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
||||||
int consumed = 0;
|
int consumed = 0;
|
||||||
janet_parser_checkdead(parser);
|
janet_parser_checkdead(parser);
|
||||||
if (c == '\r') {
|
parser->offset++;
|
||||||
parser->line++;
|
|
||||||
parser->column = 0;
|
|
||||||
} else if (c == '\n') {
|
|
||||||
parser->column = 0;
|
|
||||||
if (parser->lookback != '\r')
|
|
||||||
parser->line++;
|
|
||||||
} else {
|
|
||||||
parser->column++;
|
|
||||||
}
|
|
||||||
while (!consumed && !parser->error) {
|
while (!consumed && !parser->error) {
|
||||||
JanetParseState *state = parser->states + parser->statecount - 1;
|
JanetParseState *state = parser->states + parser->statecount - 1;
|
||||||
consumed = state->consumer(parser, state, c);
|
consumed = state->consumer(parser, state, c);
|
||||||
@@ -583,14 +563,11 @@ void janet_parser_consume(JanetParser *parser, uint8_t c) {
|
|||||||
|
|
||||||
void janet_parser_eof(JanetParser *parser) {
|
void janet_parser_eof(JanetParser *parser) {
|
||||||
janet_parser_checkdead(parser);
|
janet_parser_checkdead(parser);
|
||||||
size_t oldcolumn = parser->column;
|
|
||||||
size_t oldline = parser->line;
|
|
||||||
janet_parser_consume(parser, '\n');
|
janet_parser_consume(parser, '\n');
|
||||||
if (parser->statecount > 1) {
|
if (parser->statecount > 1) {
|
||||||
parser->error = "unexpected end of source";
|
parser->error = "unexpected end of source";
|
||||||
}
|
}
|
||||||
parser->line = oldline;
|
parser->offset--;
|
||||||
parser->column = oldcolumn;
|
|
||||||
parser->flag = 1;
|
parser->flag = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -644,8 +621,7 @@ void janet_parser_init(JanetParser *parser) {
|
|||||||
parser->statecap = 0;
|
parser->statecap = 0;
|
||||||
parser->error = NULL;
|
parser->error = NULL;
|
||||||
parser->lookback = -1;
|
parser->lookback = -1;
|
||||||
parser->line = 1;
|
parser->offset = 0;
|
||||||
parser->column = 0;
|
|
||||||
parser->pending = 0;
|
parser->pending = 0;
|
||||||
parser->flag = 0;
|
parser->flag = 0;
|
||||||
|
|
||||||
@@ -658,52 +634,6 @@ void janet_parser_deinit(JanetParser *parser) {
|
|||||||
free(parser->states);
|
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->line = src->line;
|
|
||||||
dest->column = src->column;
|
|
||||||
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) {
|
int janet_parser_has_more(JanetParser *parser) {
|
||||||
return !!parser->pending;
|
return !!parser->pending;
|
||||||
}
|
}
|
||||||
@@ -787,7 +717,7 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
|||||||
JanetParseState *s = p->states + p->statecount - 1;
|
JanetParseState *s = p->states + p->statecount - 1;
|
||||||
if (s->consumer == tokenchar) {
|
if (s->consumer == tokenchar) {
|
||||||
janet_parser_consume(p, ' ');
|
janet_parser_consume(p, ' ');
|
||||||
p->column--;
|
p->offset--;
|
||||||
s = p->states + p->statecount - 1;
|
s = p->states + p->statecount - 1;
|
||||||
}
|
}
|
||||||
if (s->flags & PFLAG_CONTAINER) {
|
if (s->flags & PFLAG_CONTAINER) {
|
||||||
@@ -873,174 +803,41 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
|||||||
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
static Janet cfun_parse_where(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
Janet *tup = janet_tuple_begin(2);
|
return janet_wrap_integer(p->offset);
|
||||||
tup[0] = janet_wrap_integer(p->line);
|
|
||||||
tup[1] = janet_wrap_integer(p->column);
|
|
||||||
return janet_wrap_tuple(janet_tuple_end(tup));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet janet_wrap_parse_state(JanetParseState *s, Janet *args,
|
static Janet cfun_parse_state(int32_t argc, Janet *argv) {
|
||||||
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("line"), janet_wrap_integer(s->line));
|
|
||||||
janet_table_put(state, janet_ckeywordv("column"), janet_wrap_integer(s->column));
|
|
||||||
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;
|
size_t i;
|
||||||
const uint8_t *str;
|
const uint8_t *str;
|
||||||
size_t oldcount;
|
size_t oldcount;
|
||||||
oldcount = clone->bufcount;
|
janet_fixarity(argc, 1);
|
||||||
for (i = 0; i < clone->statecount; i++) {
|
JanetParser *p = janet_getabstract(argv, 0, &janet_parse_parsertype);
|
||||||
JanetParseState *s = clone->states + i;
|
oldcount = p->bufcount;
|
||||||
|
for (i = 0; i < p->statecount; i++) {
|
||||||
|
JanetParseState *s = p->states + i;
|
||||||
if (s->flags & PFLAG_PARENS) {
|
if (s->flags & PFLAG_PARENS) {
|
||||||
push_buf(clone, '(');
|
push_buf(p, '(');
|
||||||
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
} else if (s->flags & PFLAG_SQRBRACKETS) {
|
||||||
push_buf(clone, '[');
|
push_buf(p, '[');
|
||||||
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
} else if (s->flags & PFLAG_CURLYBRACKETS) {
|
||||||
push_buf(clone, '{');
|
push_buf(p, '{');
|
||||||
} else if (s->flags & PFLAG_STRING) {
|
} else if (s->flags & PFLAG_STRING) {
|
||||||
push_buf(clone, '"');
|
push_buf(p, '"');
|
||||||
} else if (s->flags & PFLAG_LONGSTRING) {
|
} else if (s->flags & PFLAG_LONGSTRING) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
for (i = 0; i < s->argn; i++) {
|
for (i = 0; i < s->argn; i++) {
|
||||||
push_buf(clone, '`');
|
push_buf(p, '`');
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
str = janet_string(clone->buf + oldcount, (int32_t)(clone->bufcount - oldcount));
|
str = janet_string(p->buf + oldcount, (int32_t)(p->bufcount - oldcount));
|
||||||
clone->bufcount = oldcount;
|
p->bufcount = oldcount;
|
||||||
return janet_wrap_string(str);
|
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[] = {
|
static const JanetMethod parser_methods[] = {
|
||||||
{"byte", cfun_parse_byte},
|
{"byte", cfun_parse_byte},
|
||||||
{"clone", cfun_parse_clone},
|
|
||||||
{"consume", cfun_parse_consume},
|
{"consume", cfun_parse_consume},
|
||||||
{"eof", cfun_parse_eof},
|
|
||||||
{"error", cfun_parse_error},
|
{"error", cfun_parse_error},
|
||||||
{"flush", cfun_parse_flush},
|
{"flush", cfun_parse_flush},
|
||||||
{"has-more", cfun_parse_has_more},
|
{"has-more", cfun_parse_has_more},
|
||||||
@@ -1049,6 +846,7 @@ static const JanetMethod parser_methods[] = {
|
|||||||
{"state", cfun_parse_state},
|
{"state", cfun_parse_state},
|
||||||
{"status", cfun_parse_status},
|
{"status", cfun_parse_status},
|
||||||
{"where", cfun_parse_where},
|
{"where", cfun_parse_where},
|
||||||
|
{"eof", cfun_parse_eof},
|
||||||
{NULL, NULL}
|
{NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -1065,13 +863,6 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
"Creates and returns a new parser object. Parsers are state machines "
|
"Creates and returns a new parser object. Parsers are state machines "
|
||||||
"that can receive bytes, and generate a stream of janet values. ")
|
"that can receive bytes, and generate a stream of janet values. ")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"parser/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,
|
"parser/has-more", cfun_parse_has_more,
|
||||||
JDOC("(parser/has-more parser)\n\n"
|
JDOC("(parser/has-more parser)\n\n"
|
||||||
@@ -1086,7 +877,7 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/consume", cfun_parse_consume,
|
"parser/consume", cfun_parse_consume,
|
||||||
JDOC("(parser/consume parser bytes &opt index)\n\n"
|
JDOC("(parser/consume parser bytes [, index])\n\n"
|
||||||
"Input bytes into the parser and parse them. Will not throw errors "
|
"Input bytes into the parser and parse them. Will not throw errors "
|
||||||
"if there is a parse error. Starts at the byte index given by index. Returns "
|
"if there is a parse error. Starts at the byte index given by index. Returns "
|
||||||
"the number of bytes read.")
|
"the number of bytes read.")
|
||||||
@@ -1122,20 +913,18 @@ static const JanetReg parse_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/state", cfun_parse_state,
|
"parser/state", cfun_parse_state,
|
||||||
JDOC("(parser/state parser &opt key)\n\n"
|
JDOC("(parser/state parser)\n\n"
|
||||||
"Returns a representation of the internal state of the parser. If a key is passed, "
|
"Returns a string representation of the internal state of the parser. "
|
||||||
"only that information about the state is returned. Allowed keys are:\n\n"
|
"Each byte in the string represents a nested data structure. For example, "
|
||||||
"\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 "
|
"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,
|
"parser/where", cfun_parse_where,
|
||||||
JDOC("(parser/where parser)\n\n"
|
JDOC("(parser/where parser)\n\n"
|
||||||
"Returns the current line number and column of the parser's internal state.")
|
"Returns the current line number and column number of the parser's location "
|
||||||
|
"in the byte stream as a tuple (line, column). Lines and columns are counted from "
|
||||||
|
"1, (the first byte is line 1, column 1) and a newline is considered ASCII 0x0A.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"parser/eof", cfun_parse_eof,
|
"parser/eof", cfun_parse_eof,
|
||||||
|
|||||||
301
src/core/peg.c
301
src/core/peg.c
@@ -59,7 +59,6 @@ typedef enum {
|
|||||||
RULE_MATCHTIME, /* [rule, constant, tag] */
|
RULE_MATCHTIME, /* [rule, constant, tag] */
|
||||||
RULE_ERROR, /* [rule] */
|
RULE_ERROR, /* [rule] */
|
||||||
RULE_DROP, /* [rule] */
|
RULE_DROP, /* [rule] */
|
||||||
RULE_BACKMATCH, /* [tag] */
|
|
||||||
} Opcode;
|
} Opcode;
|
||||||
|
|
||||||
/* Hold captured patterns and match state */
|
/* Hold captured patterns and match state */
|
||||||
@@ -418,24 +417,6 @@ tail:
|
|||||||
}
|
}
|
||||||
return NULL;
|
return NULL;
|
||||||
}
|
}
|
||||||
|
|
||||||
case RULE_BACKMATCH: {
|
|
||||||
uint32_t search = rule[1];
|
|
||||||
for (int32_t i = s->tags->count - 1; i >= 0; i--) {
|
|
||||||
if (s->tags->data[i] == search) {
|
|
||||||
Janet capture = s->captures->data[i];
|
|
||||||
if (!janet_checktype(capture, JANET_STRING))
|
|
||||||
return NULL;
|
|
||||||
const uint8_t *bytes = janet_unwrap_string(capture);
|
|
||||||
int32_t len = janet_string_length(bytes);
|
|
||||||
if (text + len > s->text_end)
|
|
||||||
return NULL;
|
|
||||||
return memcmp(text, bytes, len) ? NULL : text + len;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return NULL;
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -445,6 +426,7 @@ tail:
|
|||||||
|
|
||||||
typedef struct {
|
typedef struct {
|
||||||
JanetTable *grammar;
|
JanetTable *grammar;
|
||||||
|
JanetTable *memoized;
|
||||||
JanetTable *tags;
|
JanetTable *tags;
|
||||||
Janet *constants;
|
Janet *constants;
|
||||||
uint32_t *bytecode;
|
uint32_t *bytecode;
|
||||||
@@ -465,7 +447,7 @@ static void builder_cleanup(Builder *b) {
|
|||||||
janet_v_free(b->bytecode);
|
janet_v_free(b->bytecode);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_NO_RETURN static void peg_panic(Builder *b, const char *msg) {
|
static void peg_panic(Builder *b, const char *msg) {
|
||||||
builder_cleanup(b);
|
builder_cleanup(b);
|
||||||
janet_panicf("grammar error in %p, %s", b->form, msg);
|
janet_panicf("grammar error in %p, %s", b->form, msg);
|
||||||
}
|
}
|
||||||
@@ -772,20 +754,12 @@ static void spec_reference(Builder *b, int32_t argc, const Janet *argv) {
|
|||||||
emit_2(r, RULE_GETTAG, search, tag);
|
emit_2(r, RULE_GETTAG, search, tag);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void spec_tag1(Builder *b, int32_t argc, const Janet *argv, uint32_t op) {
|
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
peg_arity(b, argc, 0, 1);
|
peg_arity(b, argc, 0, 1);
|
||||||
Reserve r = reserve(b, 2);
|
Reserve r = reserve(b, 2);
|
||||||
uint32_t tag = (argc) ? emit_tag(b, argv[0]) : 0;
|
uint32_t tag = (argc) ? emit_tag(b, argv[0]) : 0;
|
||||||
(void) argv;
|
(void) argv;
|
||||||
emit_1(r, op, tag);
|
emit_1(r, RULE_POSITION, tag);
|
||||||
}
|
|
||||||
|
|
||||||
static void spec_position(Builder *b, int32_t argc, const Janet *argv) {
|
|
||||||
spec_tag1(b, argc, argv, RULE_POSITION);
|
|
||||||
}
|
|
||||||
|
|
||||||
static void spec_backmatch(Builder *b, int32_t argc, const Janet *argv) {
|
|
||||||
spec_tag1(b, argc, argv, RULE_BACKMATCH);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void spec_argument(Builder *b, int32_t argc, const Janet *argv) {
|
static void spec_argument(Builder *b, int32_t argc, const Janet *argv) {
|
||||||
@@ -850,7 +824,6 @@ static const SpecialPair peg_specials[] = {
|
|||||||
{"argument", spec_argument},
|
{"argument", spec_argument},
|
||||||
{"at-least", spec_atleast},
|
{"at-least", spec_atleast},
|
||||||
{"at-most", spec_atmost},
|
{"at-most", spec_atmost},
|
||||||
{"backmatch", spec_backmatch},
|
|
||||||
{"backref", spec_reference},
|
{"backref", spec_reference},
|
||||||
{"between", spec_between},
|
{"between", spec_between},
|
||||||
{"capture", spec_capture},
|
{"capture", spec_capture},
|
||||||
@@ -877,54 +850,27 @@ static const SpecialPair peg_specials[] = {
|
|||||||
/* Compile a janet value into a rule and return the rule index. */
|
/* Compile a janet value into a rule and return the rule index. */
|
||||||
static uint32_t peg_compile1(Builder *b, Janet peg) {
|
static uint32_t peg_compile1(Builder *b, Janet peg) {
|
||||||
|
|
||||||
|
/* Check for already compiled rules */
|
||||||
|
Janet check = janet_table_get(b->memoized, peg);
|
||||||
|
if (!janet_checktype(check, JANET_NIL)) {
|
||||||
|
uint32_t rule = (uint32_t) janet_unwrap_number(check);
|
||||||
|
return rule;
|
||||||
|
}
|
||||||
|
|
||||||
/* Keep track of the form being compiled for error purposes */
|
/* Keep track of the form being compiled for error purposes */
|
||||||
Janet old_form = b->form;
|
Janet old_form = b->form;
|
||||||
JanetTable *old_grammar = b->grammar;
|
|
||||||
b->form = peg;
|
b->form = peg;
|
||||||
|
|
||||||
/* Resolve keyword references */
|
|
||||||
int i = JANET_RECURSION_GUARD;
|
|
||||||
JanetTable *grammar = old_grammar;
|
|
||||||
for (; i > 0 && janet_checktype(peg, JANET_KEYWORD); --i) {
|
|
||||||
peg = janet_table_get_ex(grammar, peg, &grammar);
|
|
||||||
if (!grammar || janet_checktype(peg, JANET_NIL))
|
|
||||||
peg_panic(b, "unkown rule");
|
|
||||||
b->form = peg;
|
|
||||||
b->grammar = grammar;
|
|
||||||
}
|
|
||||||
if (i == 0)
|
|
||||||
peg_panic(b, "reference chain too deep");
|
|
||||||
|
|
||||||
/* Check cache - for tuples we check only the local cache, as
|
|
||||||
* in a different grammar, the same tuple can compile to a different
|
|
||||||
* rule - for example, (+ :a :b) depends on whatever :a and :b are bound to. */
|
|
||||||
Janet check = janet_checktype(peg, JANET_TUPLE)
|
|
||||||
? janet_table_rawget(grammar, peg)
|
|
||||||
: janet_table_get(grammar, peg);
|
|
||||||
if (!janet_checktype(check, JANET_NIL)) {
|
|
||||||
b->form = old_form;
|
|
||||||
b->grammar = old_grammar;
|
|
||||||
return (uint32_t) janet_unwrap_number(check);
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Check depth */
|
/* Check depth */
|
||||||
if (b->depth-- == 0)
|
if (b->depth-- == 0) {
|
||||||
peg_panic(b, "peg grammar recursed too deeply");
|
peg_panic(b, "peg grammar recursed too deeply");
|
||||||
|
}
|
||||||
|
|
||||||
/* The final rule to return */
|
/* The final rule to return */
|
||||||
uint32_t rule = janet_v_count(b->bytecode);
|
uint32_t rule = janet_v_count(b->bytecode);
|
||||||
|
if (!janet_checktype(peg, JANET_KEYWORD) &&
|
||||||
/* Add to cache. Do not cache structs, as we don't yet know
|
!janet_checktype(peg, JANET_STRUCT)) {
|
||||||
* what rule they will return! We can just as effectively cache
|
janet_table_put(b->memoized, peg, janet_wrap_number(rule));
|
||||||
* the structs main rule. */
|
|
||||||
if (!janet_checktype(peg, JANET_STRUCT)) {
|
|
||||||
JanetTable *which_grammar = grammar;
|
|
||||||
/* If we are a primitive pattern, add to the global cache (root grammar table) */
|
|
||||||
if (!janet_checktype(peg, JANET_TUPLE)) {
|
|
||||||
while (which_grammar->proto)
|
|
||||||
which_grammar = which_grammar->proto;
|
|
||||||
}
|
|
||||||
janet_table_put(which_grammar, peg, janet_wrap_number(rule));
|
|
||||||
}
|
}
|
||||||
|
|
||||||
switch (janet_type(peg)) {
|
switch (janet_type(peg)) {
|
||||||
@@ -947,22 +893,22 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
|||||||
emit_bytes(b, RULE_LITERAL, len, str);
|
emit_bytes(b, RULE_LITERAL, len, str);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
|
case JANET_KEYWORD: {
|
||||||
|
Janet check = janet_table_get(b->grammar, peg);
|
||||||
|
if (janet_checktype(check, JANET_NIL))
|
||||||
|
peg_panic(b, "unknown rule");
|
||||||
|
rule = peg_compile1(b, check);
|
||||||
|
break;
|
||||||
|
}
|
||||||
case JANET_STRUCT: {
|
case JANET_STRUCT: {
|
||||||
/* Build grammar table */
|
JanetTable *grammar = janet_struct_to_table(janet_unwrap_struct(peg));
|
||||||
const JanetKV *st = janet_unwrap_struct(peg);
|
grammar->proto = b->grammar;
|
||||||
JanetTable *new_grammar = janet_table(2 * janet_struct_capacity(st));
|
b->grammar = grammar;
|
||||||
for (int32_t i = 0; i < janet_struct_capacity(st); i++) {
|
Janet main_rule = janet_table_get(grammar, janet_ckeywordv("main"));
|
||||||
if (janet_checktype(st[i].key, JANET_KEYWORD)) {
|
|
||||||
janet_table_put(new_grammar, st[i].key, st[i].value);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
new_grammar->proto = grammar;
|
|
||||||
b->grammar = grammar = new_grammar;
|
|
||||||
/* Run the main rule */
|
|
||||||
Janet main_rule = janet_table_rawget(grammar, janet_ckeywordv("main"));
|
|
||||||
if (janet_checktype(main_rule, JANET_NIL))
|
if (janet_checktype(main_rule, JANET_NIL))
|
||||||
peg_panic(b, "grammar requires :main rule");
|
peg_panic(b, "grammar requires :main rule");
|
||||||
rule = peg_compile1(b, main_rule);
|
rule = peg_compile1(b, main_rule);
|
||||||
|
b->grammar = grammar->proto;
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case JANET_TUPLE: {
|
case JANET_TUPLE: {
|
||||||
@@ -989,7 +935,6 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
|||||||
/* Increase depth again */
|
/* Increase depth again */
|
||||||
b->depth++;
|
b->depth++;
|
||||||
b->form = old_form;
|
b->form = old_form;
|
||||||
b->grammar = old_grammar;
|
|
||||||
return rule;
|
return rule;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1000,28 +945,27 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
|
|||||||
typedef struct {
|
typedef struct {
|
||||||
uint32_t *bytecode;
|
uint32_t *bytecode;
|
||||||
Janet *constants;
|
Janet *constants;
|
||||||
size_t bytecode_len;
|
|
||||||
uint32_t num_constants;
|
uint32_t num_constants;
|
||||||
} Peg;
|
} Peg;
|
||||||
|
|
||||||
static int peg_mark(void *p, size_t size) {
|
static int peg_mark(void *p, size_t size) {
|
||||||
(void) size;
|
(void) size;
|
||||||
Peg *peg = (Peg *)p;
|
Peg *peg = (Peg *)p;
|
||||||
if (NULL != peg->constants)
|
|
||||||
for (uint32_t i = 0; i < peg->num_constants; i++)
|
for (uint32_t i = 0; i < peg->num_constants; i++)
|
||||||
janet_mark(peg->constants[i]);
|
janet_mark(peg->constants[i]);
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void peg_marshal(void *p, JanetMarshalContext *ctx) {
|
static JanetAbstractType peg_type = {
|
||||||
Peg *peg = (Peg *)p;
|
"core/peg",
|
||||||
janet_marshal_size(ctx, peg->bytecode_len);
|
NULL,
|
||||||
janet_marshal_int(ctx, (int32_t)peg->num_constants);
|
peg_mark,
|
||||||
for (size_t i = 0; i < peg->bytecode_len; i++)
|
NULL,
|
||||||
janet_marshal_int(ctx, (int32_t) peg->bytecode[i]);
|
NULL,
|
||||||
for (uint32_t j = 0; j < peg->num_constants; j++)
|
NULL,
|
||||||
janet_marshal_janet(ctx, peg->constants[j]);
|
NULL,
|
||||||
}
|
NULL
|
||||||
|
};
|
||||||
|
|
||||||
/* Used to ensure that if we place several arrays in one memory chunk, each
|
/* Used to ensure that if we place several arrays in one memory chunk, each
|
||||||
* array will be correctly aligned */
|
* array will be correctly aligned */
|
||||||
@@ -1030,170 +974,6 @@ static size_t size_padded(size_t offset, size_t size) {
|
|||||||
return x - (x % 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:
|
|
||||||
case RULE_BACKMATCH:
|
|
||||||
/* [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) */
|
/* Convert Builder to Peg (Janet Abstract Value) */
|
||||||
static Peg *make_peg(Builder *b) {
|
static Peg *make_peg(Builder *b) {
|
||||||
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
size_t bytecode_start = size_padded(sizeof(Peg), sizeof(uint32_t));
|
||||||
@@ -1208,7 +988,6 @@ static Peg *make_peg(Builder *b) {
|
|||||||
peg->num_constants = janet_v_count(b->constants);
|
peg->num_constants = janet_v_count(b->constants);
|
||||||
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
memcpy(peg->bytecode, b->bytecode, bytecode_size);
|
||||||
memcpy(peg->constants, b->constants, constants_size);
|
memcpy(peg->constants, b->constants, constants_size);
|
||||||
peg->bytecode_len = janet_v_count(b->bytecode);
|
|
||||||
return peg;
|
return peg;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -1216,6 +995,7 @@ static Peg *make_peg(Builder *b) {
|
|||||||
static Peg *compile_peg(Janet x) {
|
static Peg *compile_peg(Janet x) {
|
||||||
Builder builder;
|
Builder builder;
|
||||||
builder.grammar = janet_table(0);
|
builder.grammar = janet_table(0);
|
||||||
|
builder.memoized = janet_table(0);
|
||||||
builder.tags = janet_table(0);
|
builder.tags = janet_table(0);
|
||||||
builder.constants = NULL;
|
builder.constants = NULL;
|
||||||
builder.bytecode = NULL;
|
builder.bytecode = NULL;
|
||||||
@@ -1281,7 +1061,7 @@ static const JanetReg peg_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"peg/match", cfun_peg_match,
|
"peg/match", cfun_peg_match,
|
||||||
JDOC("(peg/match peg text &opt start & args)\n\n"
|
JDOC("(peg/match peg text [,start=0])\n\n"
|
||||||
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
|
"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 "
|
"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.")
|
"similar to those defined by LPeg, and have similar capabilities.")
|
||||||
@@ -1292,7 +1072,6 @@ static const JanetReg peg_cfuns[] = {
|
|||||||
/* Load the peg module */
|
/* Load the peg module */
|
||||||
void janet_lib_peg(JanetTable *env) {
|
void janet_lib_peg(JanetTable *env) {
|
||||||
janet_core_cfuns(env, NULL, peg_cfuns);
|
janet_core_cfuns(env, NULL, peg_cfuns);
|
||||||
janet_register_abstract_type(&peg_type);
|
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif /* ifdef JANET_PEG */
|
#endif /* ifdef JANET_PEG */
|
||||||
|
|||||||
@@ -30,7 +30,7 @@
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Implements a pretty printer for Janet. The pretty printer
|
/* Implements a pretty printer for Janet. The pretty printer
|
||||||
* is simple and not that flexible, but fast. */
|
* is farily simple and not that flexible, but fast. */
|
||||||
|
|
||||||
/* Temporary buffer size */
|
/* Temporary buffer size */
|
||||||
#define BUFSIZE 64
|
#define BUFSIZE 64
|
||||||
@@ -310,7 +310,7 @@ struct pretty {
|
|||||||
|
|
||||||
static void print_newline(struct pretty *S, int just_a_space) {
|
static void print_newline(struct pretty *S, int just_a_space) {
|
||||||
int i;
|
int i;
|
||||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
if (just_a_space) {
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
@@ -406,7 +406,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
|||||||
if (S->depth == 0) {
|
if (S->depth == 0) {
|
||||||
janet_buffer_push_cstring(S->buffer, "...");
|
janet_buffer_push_cstring(S->buffer, "...");
|
||||||
} else {
|
} else {
|
||||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
if (!isarray && len >= JANET_PRETTY_IND_ONELINE)
|
||||||
janet_buffer_push_u8(S->buffer, ' ');
|
janet_buffer_push_u8(S->buffer, ' ');
|
||||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||||
for (i = 0; i < len; i++) {
|
for (i = 0; i < len; i++) {
|
||||||
@@ -725,20 +725,12 @@ void janet_buffer_format(
|
|||||||
janet_description_b(b, argv[arg]);
|
janet_description_b(b, argv[arg]);
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
case 'Q':
|
|
||||||
case 'q':
|
|
||||||
case 'P':
|
case 'P':
|
||||||
case 'p': { /* janet pretty , precision = depth */
|
case 'p': { /* janet pretty , precision = depth */
|
||||||
int depth = atoi(precision);
|
int depth = atoi(precision);
|
||||||
if (depth < 1)
|
if (depth < 1)
|
||||||
depth = 4;
|
depth = 4;
|
||||||
char c = strfrmt[-1];
|
janet_pretty_(b, depth, (strfrmt[-1] == 'P') ? JANET_PRETTY_COLOR : 0, argv[arg], startlen);
|
||||||
int has_color = (c == 'P') || (c == 'Q');
|
|
||||||
int has_oneline = (c == 'Q') || (c == 'q');
|
|
||||||
int flags = 0;
|
|
||||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
|
||||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
|
||||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
default: {
|
default: {
|
||||||
|
|||||||
@@ -28,7 +28,6 @@
|
|||||||
/* Run a string */
|
/* Run a string */
|
||||||
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
|
||||||
JanetParser parser;
|
JanetParser parser;
|
||||||
FILE *errf = janet_dynfile("err", stderr);
|
|
||||||
int errflags = 0, done = 0;
|
int errflags = 0, done = 0;
|
||||||
int32_t index = 0;
|
int32_t index = 0;
|
||||||
Janet ret = janet_wrap_nil();
|
Janet ret = janet_wrap_nil();
|
||||||
@@ -56,7 +55,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
done = 1;
|
done = 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
fprintf(errf, "compile error in %s: %s\n", sourcePath,
|
fprintf(stderr, "compile error in %s: %s\n", sourcePath,
|
||||||
(const char *)cres.error);
|
(const char *)cres.error);
|
||||||
errflags |= 0x02;
|
errflags |= 0x02;
|
||||||
done = 1;
|
done = 1;
|
||||||
@@ -70,7 +69,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
|
|||||||
break;
|
break;
|
||||||
case JANET_PARSE_ERROR:
|
case JANET_PARSE_ERROR:
|
||||||
errflags |= 0x04;
|
errflags |= 0x04;
|
||||||
fprintf(errf, "parse error in %s: %s\n",
|
fprintf(stderr, "parse error in %s: %s\n",
|
||||||
sourcePath, janet_parser_error(&parser));
|
sourcePath, janet_parser_error(&parser));
|
||||||
done = 1;
|
done = 1;
|
||||||
break;
|
break;
|
||||||
|
|||||||
@@ -116,7 +116,7 @@ static JanetSlot janetc_unquote(JanetFopts opts, int32_t argn, const Janet *argv
|
|||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Perform destructuring. Be careful to
|
/* Preform destructuring. Be careful to
|
||||||
* keep the order registers are freed.
|
* keep the order registers are freed.
|
||||||
* Returns if the slot 'right' can be freed. */
|
* Returns if the slot 'right' can be freed. */
|
||||||
static int destructure(JanetCompiler *c,
|
static int destructure(JanetCompiler *c,
|
||||||
@@ -175,8 +175,8 @@ static int destructure(JanetCompiler *c,
|
|||||||
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
static const Janet *janetc_make_sourcemap(JanetCompiler *c) {
|
||||||
Janet *tup = janet_tuple_begin(3);
|
Janet *tup = janet_tuple_begin(3);
|
||||||
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
tup[0] = c->source ? janet_wrap_string(c->source) : janet_wrap_nil();
|
||||||
tup[1] = janet_wrap_integer(c->current_mapping.line);
|
tup[1] = janet_wrap_integer(c->current_mapping.start);
|
||||||
tup[2] = janet_wrap_integer(c->current_mapping.column);
|
tup[2] = janet_wrap_integer(c->current_mapping.end);
|
||||||
return janet_tuple_end(tup);
|
return janet_tuple_end(tup);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -278,17 +278,18 @@ static int varleaf(
|
|||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *reftab) {
|
JanetTable *attr) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
/* Global var, generate var */
|
/* Global var, generate var */
|
||||||
JanetSlot refslot;
|
JanetSlot refslot;
|
||||||
JanetTable *entry = janet_table_clone(reftab);
|
JanetTable *reftab = janet_table(1);
|
||||||
|
reftab->proto = attr;
|
||||||
JanetArray *ref = janet_array(1);
|
JanetArray *ref = janet_array(1);
|
||||||
janet_array_push(ref, janet_wrap_nil());
|
janet_array_push(ref, janet_wrap_nil());
|
||||||
janet_table_put(entry, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
janet_table_put(reftab, janet_ckeywordv("ref"), janet_wrap_array(ref));
|
||||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
janet_table_put(reftab, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(reftab));
|
||||||
refslot = janetc_cslot(janet_wrap_array(ref));
|
refslot = janetc_cslot(janet_wrap_array(ref));
|
||||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
||||||
return 1;
|
return 1;
|
||||||
@@ -311,16 +312,17 @@ static int defleaf(
|
|||||||
JanetCompiler *c,
|
JanetCompiler *c,
|
||||||
const uint8_t *sym,
|
const uint8_t *sym,
|
||||||
JanetSlot s,
|
JanetSlot s,
|
||||||
JanetTable *tab) {
|
JanetTable *attr) {
|
||||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||||
JanetTable *entry = janet_table_clone(tab);
|
JanetTable *tab = janet_table(2);
|
||||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
janet_table_put(tab, janet_ckeywordv("source-map"),
|
||||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||||
|
tab->proto = attr;
|
||||||
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
JanetSlot valsym = janetc_cslot(janet_ckeywordv("value"));
|
||||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
JanetSlot tabslot = janetc_cslot(janet_wrap_table(tab));
|
||||||
|
|
||||||
/* Add env entry to env */
|
/* Add env entry to env */
|
||||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(tab));
|
||||||
|
|
||||||
/* Put value in table when evaulated */
|
/* Put value in table when evaulated */
|
||||||
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
||||||
@@ -602,7 +604,6 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
|
int32_t tempself = janetc_regalloc_temp(&tempscope.ra, JANETC_REGTEMP_0);
|
||||||
janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
|
janetc_emit(c, JOP_LOAD_SELF | (tempself << 8));
|
||||||
janetc_emit(c, JOP_TAILCALL | (tempself << 8));
|
janetc_emit(c, JOP_TAILCALL | (tempself << 8));
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, tempself, JANETC_REGTEMP_0);
|
|
||||||
/* Compile function */
|
/* Compile function */
|
||||||
JanetFuncDef *def = janetc_pop_funcdef(c);
|
JanetFuncDef *def = janetc_pop_funcdef(c);
|
||||||
def->name = janet_cstring("_while");
|
def->name = janet_cstring("_while");
|
||||||
@@ -611,7 +612,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
|
|||||||
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
|
||||||
janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
|
janetc_emit(c, JOP_CLOSURE | (cloreg << 8) | (defindex << 16));
|
||||||
janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
|
janetc_emit(c, JOP_CALL | (cloreg << 8) | (cloreg << 16));
|
||||||
janetc_regalloc_freetemp(&c->scope->ra, cloreg, JANETC_REGTEMP_0);
|
janetc_regalloc_free(&c->scope->ra, cloreg);
|
||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
return janetc_cslot(janet_wrap_nil());
|
return janetc_cslot(janet_wrap_nil());
|
||||||
}
|
}
|
||||||
@@ -661,8 +662,8 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
c->scope->flags |= JANET_SCOPE_CLOSURE;
|
||||||
janetc_scope(&fnscope, c, JANET_SCOPE_FUNCTION, "function");
|
janetc_scope(&fnscope, c, JANET_SCOPE_FUNCTION, "function");
|
||||||
|
|
||||||
if (argn == 0) {
|
if (argn < 2) {
|
||||||
errmsg = "expected at least 1 argument to function literal";
|
errmsg = "expected at least 2 arguments to function literal";
|
||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -678,9 +679,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
goto error;
|
goto error;
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Keep track of destructured parameters */
|
|
||||||
JanetSlot *destructed_params = NULL;
|
|
||||||
|
|
||||||
/* Compile function parameters */
|
/* Compile function parameters */
|
||||||
params = janet_unwrap_tuple(argv[parami]);
|
params = janet_unwrap_tuple(argv[parami]);
|
||||||
paramcount = janet_tuple_length(params);
|
paramcount = janet_tuple_length(params);
|
||||||
@@ -732,22 +730,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
janetc_nameslot(c, janet_unwrap_symbol(param), janetc_farslot(c));
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
janet_v_push(destructed_params, janetc_farslot(c));
|
destructure(c, param, janetc_farslot(c), defleaf, NULL);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Compile destructed params */
|
|
||||||
int32_t j = 0;
|
|
||||||
for (i = 0; i < paramcount; i++) {
|
|
||||||
Janet param = params[i];
|
|
||||||
if (!janet_checktype(param, JANET_SYMBOL)) {
|
|
||||||
JanetSlot reg = destructed_params[j++];
|
|
||||||
destructure(c, param, reg, defleaf, NULL);
|
|
||||||
janetc_freeslot(c, reg);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
janet_v_free(destructed_params);
|
|
||||||
|
|
||||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||||
if (!seenopt) min_arity = arity;
|
if (!seenopt) min_arity = arity;
|
||||||
|
|
||||||
|
|||||||
@@ -65,9 +65,4 @@ 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_count;
|
||||||
extern JANET_THREAD_LOCAL uint32_t janet_vm_root_capacity;
|
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 */
|
#endif /* JANET_STATE_H_defined */
|
||||||
|
|||||||
@@ -108,9 +108,6 @@ static void kmp_init(
|
|||||||
if (!lookup) {
|
if (!lookup) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
if (patlen == 0) {
|
|
||||||
janet_panic("expected non-empty pattern");
|
|
||||||
}
|
|
||||||
s->lookup = lookup;
|
s->lookup = lookup;
|
||||||
s->i = 0;
|
s->i = 0;
|
||||||
s->j = 0;
|
s->j = 0;
|
||||||
@@ -381,33 +378,40 @@ static Janet cfun_string_split(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
findsetup(argc, argv, &state, 1);
|
findsetup(argc, argv, &state, 1);
|
||||||
array = janet_array(0);
|
array = janet_array(0);
|
||||||
while ((result = kmp_next(&state)) >= 0 && --limit) {
|
while ((result = kmp_next(&state)) >= 0 && limit--) {
|
||||||
const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex);
|
const uint8_t *slice = janet_string(state.text + lastindex, result - lastindex);
|
||||||
janet_array_push(array, janet_wrap_string(slice));
|
janet_array_push(array, janet_wrap_string(slice));
|
||||||
lastindex = result + state.patlen;
|
lastindex = result + state.patlen;
|
||||||
}
|
}
|
||||||
|
{
|
||||||
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
|
const uint8_t *slice = janet_string(state.text + lastindex, state.textlen - lastindex);
|
||||||
janet_array_push(array, janet_wrap_string(slice));
|
janet_array_push(array, janet_wrap_string(slice));
|
||||||
|
}
|
||||||
kmp_deinit(&state);
|
kmp_deinit(&state);
|
||||||
return janet_wrap_array(array);
|
return janet_wrap_array(array);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_string_checkset(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};
|
uint32_t bitset[8] = {0, 0, 0, 0, 0, 0, 0, 0};
|
||||||
janet_fixarity(argc, 2);
|
janet_arity(argc, 2, 3);
|
||||||
JanetByteView set = janet_getbytes(argv, 0);
|
JanetByteView set = janet_getbytes(argv, 0);
|
||||||
JanetByteView str = janet_getbytes(argv, 1);
|
JanetByteView str = janet_getbytes(argv, 1);
|
||||||
/* Populate set */
|
/* Populate set */
|
||||||
for (int32_t i = 0; i < set.len; i++) {
|
for (int32_t i = 0; i < set.len; i++) {
|
||||||
int index = set.bytes[i] >> 5;
|
int index = set.bytes[i] >> 5;
|
||||||
uint32_t mask = 1 << (set.bytes[i] & 0x1F);
|
uint32_t mask = 1 << (set.bytes[i] & 7);
|
||||||
bitset[index] |= mask;
|
bitset[index] |= mask;
|
||||||
}
|
}
|
||||||
|
if (argc == 3) {
|
||||||
|
if (janet_getboolean(argv, 2)) {
|
||||||
|
for (int i = 0; i < 8; i++)
|
||||||
|
bitset[i] = ~bitset[i];
|
||||||
|
}
|
||||||
|
}
|
||||||
/* Check set */
|
/* Check set */
|
||||||
if (str.len == 0) return janet_wrap_false();
|
|
||||||
for (int32_t i = 0; i < str.len; i++) {
|
for (int32_t i = 0; i < str.len; i++) {
|
||||||
int index = str.bytes[i] >> 5;
|
int index = str.bytes[i] >> 5;
|
||||||
uint32_t mask = 1 << (str.bytes[i] & 0x1F);
|
uint32_t mask = 1 << (str.bytes[i] & 7);
|
||||||
if (!(bitset[index] & mask)) {
|
if (!(bitset[index] & mask)) {
|
||||||
return janet_wrap_false();
|
return janet_wrap_false();
|
||||||
}
|
}
|
||||||
@@ -520,7 +524,7 @@ static Janet cfun_string_trimr(int32_t argc, Janet *argv) {
|
|||||||
static const JanetReg string_cfuns[] = {
|
static const JanetReg string_cfuns[] = {
|
||||||
{
|
{
|
||||||
"string/slice", cfun_string_slice,
|
"string/slice", cfun_string_slice,
|
||||||
JDOC("(string/slice bytes &opt start end)\n\n"
|
JDOC("(string/slice bytes [,start=0 [,end=(length str)]])\n\n"
|
||||||
"Returns a substring from a byte sequence. The substring is from "
|
"Returns a substring from a byte sequence. The substring is from "
|
||||||
"index start inclusive to index end exclusive. All indexing "
|
"index start inclusive to index end exclusive. All indexing "
|
||||||
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
"is from 0. 'start' and 'end' can also be negative to indicate indexing "
|
||||||
@@ -601,12 +605,10 @@ static const JanetReg string_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/split", cfun_string_split,
|
"string/split", cfun_string_split,
|
||||||
JDOC("(string/split delim str &opt start limit)\n\n"
|
JDOC("(string/split delim str)\n\n"
|
||||||
"Splits a string str with delimiter delim and returns an array of "
|
"Splits a string str with delimiter delim and returns an array of "
|
||||||
"substrings. The substrings will not contain the delimiter delim. If delim "
|
"substrings. The substrings will not contain the delimiter delim. If delim "
|
||||||
"is not found, the returned array will have one element. Will start searching "
|
"is not found, the returned array will have one element.")
|
||||||
"for delim at the index start (if provided), and return up to a maximum "
|
|
||||||
"of limit results (if provided).")
|
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/check-set", cfun_string_checkset,
|
"string/check-set", cfun_string_checkset,
|
||||||
@@ -616,7 +618,7 @@ static const JanetReg string_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/join", cfun_string_join,
|
"string/join", cfun_string_join,
|
||||||
JDOC("(string/join parts &opt sep)\n\n"
|
JDOC("(string/join parts [,sep])\n\n"
|
||||||
"Joins an array of strings into one string, optionally separated by "
|
"Joins an array of strings into one string, optionally separated by "
|
||||||
"a separator string sep.")
|
"a separator string sep.")
|
||||||
},
|
},
|
||||||
@@ -628,19 +630,19 @@ static const JanetReg string_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/trim", cfun_string_trim,
|
"string/trim", cfun_string_trim,
|
||||||
JDOC("(string/trim str &opt set)\n\n"
|
JDOC("(string/trim str [,set])\n\n"
|
||||||
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
"Trim leading and trailing whitespace from a byte sequence. If the argument "
|
||||||
"set is provided, consider only characters in set to be whitespace.")
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/triml", cfun_string_triml,
|
"string/triml", cfun_string_triml,
|
||||||
JDOC("(string/triml str &opt set)\n\n"
|
JDOC("(string/triml str [,set])\n\n"
|
||||||
"Trim leading whitespace from a byte sequence. If the argument "
|
"Trim leading whitespace from a byte sequence. If the argument "
|
||||||
"set is provided, consider only characters in set to be whitespace.")
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"string/trimr", cfun_string_trimr,
|
"string/trimr", cfun_string_trimr,
|
||||||
JDOC("(string/trimr str &opt set)\n\n"
|
JDOC("(string/trimr str [,set])\n\n"
|
||||||
"Trim trailing whitespace from a byte sequence. If the argument "
|
"Trim trailing whitespace from a byte sequence. If the argument "
|
||||||
"set is provided, consider only characters in set to be whitespace.")
|
"set is provided, consider only characters in set to be whitespace.")
|
||||||
},
|
},
|
||||||
|
|||||||
@@ -27,33 +27,15 @@
|
|||||||
#include <math.h>
|
#include <math.h>
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
#define JANET_TABLE_FLAG_STACK 0x10000
|
/* Initialize a table */
|
||||||
|
JanetTable *janet_table_init(JanetTable *table, int32_t capacity) {
|
||||||
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;
|
JanetKV *data;
|
||||||
capacity = janet_tablen(capacity);
|
capacity = janet_tablen(capacity);
|
||||||
if (stackalloc) table->gc.flags = JANET_TABLE_FLAG_STACK;
|
|
||||||
if (capacity) {
|
if (capacity) {
|
||||||
if (stackalloc) {
|
|
||||||
data = janet_memalloc_empty_local(capacity);
|
|
||||||
} else {
|
|
||||||
data = (JanetKV *) janet_memalloc_empty(capacity);
|
data = (JanetKV *) janet_memalloc_empty(capacity);
|
||||||
if (NULL == data) {
|
if (NULL == data) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
table->data = data;
|
table->data = data;
|
||||||
table->capacity = capacity;
|
table->capacity = capacity;
|
||||||
} else {
|
} else {
|
||||||
@@ -66,20 +48,15 @@ static JanetTable *janet_table_init_impl(JanetTable *table, int32_t capacity, in
|
|||||||
return table;
|
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 */
|
/* Deinitialize a table */
|
||||||
void janet_table_deinit(JanetTable *table) {
|
void janet_table_deinit(JanetTable *table) {
|
||||||
janet_sfree(table->data);
|
free(table->data);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Create a new table */
|
/* Create a new table */
|
||||||
JanetTable *janet_table(int32_t capacity) {
|
JanetTable *janet_table(int32_t capacity) {
|
||||||
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
JanetTable *table = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
||||||
return janet_table_init_impl(table, capacity, 0);
|
return janet_table_init(table, capacity);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Find the bucket that contains the given key. Will also return
|
/* Find the bucket that contains the given key. Will also return
|
||||||
@@ -91,16 +68,10 @@ JanetKV *janet_table_find(JanetTable *t, Janet key) {
|
|||||||
/* Resize the dictionary table. */
|
/* Resize the dictionary table. */
|
||||||
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
static void janet_table_rehash(JanetTable *t, int32_t size) {
|
||||||
JanetKV *olddata = t->data;
|
JanetKV *olddata = t->data;
|
||||||
JanetKV *newdata;
|
JanetKV *newdata = (JanetKV *) janet_memalloc_empty(size);
|
||||||
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) {
|
if (NULL == newdata) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
}
|
|
||||||
int32_t i, oldcapacity;
|
int32_t i, oldcapacity;
|
||||||
oldcapacity = t->capacity;
|
oldcapacity = t->capacity;
|
||||||
t->data = newdata;
|
t->data = newdata;
|
||||||
@@ -113,12 +84,8 @@ static void janet_table_rehash(JanetTable *t, int32_t size) {
|
|||||||
*newkv = *kv;
|
*newkv = *kv;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (islocal) {
|
|
||||||
janet_sfree(olddata);
|
|
||||||
} else {
|
|
||||||
free(olddata);
|
free(olddata);
|
||||||
}
|
}
|
||||||
}
|
|
||||||
|
|
||||||
/* Get a value out of the table */
|
/* Get a value out of the table */
|
||||||
Janet janet_table_get(JanetTable *t, Janet key) {
|
Janet janet_table_get(JanetTable *t, Janet key) {
|
||||||
@@ -137,27 +104,6 @@ Janet janet_table_get(JanetTable *t, Janet key) {
|
|||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get a value out of the table, and record which prototype it was from. */
|
|
||||||
Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which) {
|
|
||||||
JanetKV *bucket = janet_table_find(t, key);
|
|
||||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
|
||||||
*which = t;
|
|
||||||
return bucket->value;
|
|
||||||
}
|
|
||||||
/* Check prototypes */
|
|
||||||
{
|
|
||||||
int i;
|
|
||||||
for (i = JANET_MAX_PROTO_DEPTH, t = t->proto; t && i; t = t->proto, --i) {
|
|
||||||
bucket = janet_table_find(t, key);
|
|
||||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
|
|
||||||
*which = t;
|
|
||||||
return bucket->value;
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return janet_wrap_nil();
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Get a value out of the table. Don't check prototype tables. */
|
/* Get a value out of the table. Don't check prototype tables. */
|
||||||
Janet janet_table_rawget(JanetTable *t, Janet key) {
|
Janet janet_table_rawget(JanetTable *t, Janet key) {
|
||||||
JanetKV *bucket = janet_table_find(t, key);
|
JanetKV *bucket = janet_table_find(t, key);
|
||||||
@@ -229,21 +175,6 @@ const JanetKV *janet_table_to_struct(JanetTable *t) {
|
|||||||
return janet_struct_end(st);
|
return janet_struct_end(st);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Clone a table. */
|
|
||||||
JanetTable *janet_table_clone(JanetTable *table) {
|
|
||||||
JanetTable *newTable = janet_gcalloc(JANET_MEMORY_TABLE, sizeof(JanetTable));
|
|
||||||
newTable->count = table->count;
|
|
||||||
newTable->capacity = table->capacity;
|
|
||||||
newTable->deleted = table->deleted;
|
|
||||||
newTable->proto = table->proto;
|
|
||||||
newTable->data = malloc(newTable->capacity * sizeof(JanetKV));
|
|
||||||
if (NULL == newTable->data) {
|
|
||||||
JANET_OUT_OF_MEMORY;
|
|
||||||
}
|
|
||||||
memcpy(newTable->data, table->data, table->capacity * sizeof(JanetKV));
|
|
||||||
return newTable;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Merge a table or struct into a table */
|
/* Merge a table or struct into a table */
|
||||||
static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t cap) {
|
static void janet_table_mergekv(JanetTable *table, const JanetKV *kvs, int32_t cap) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
@@ -304,12 +235,6 @@ static Janet cfun_table_rawget(int32_t argc, Janet *argv) {
|
|||||||
return janet_table_rawget(table, argv[1]);
|
return janet_table_rawget(table, argv[1]);
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_table_clone(int32_t argc, Janet *argv) {
|
|
||||||
janet_fixarity(argc, 1);
|
|
||||||
JanetTable *table = janet_gettable(argv, 0);
|
|
||||||
return janet_wrap_table(janet_table_clone(table));
|
|
||||||
}
|
|
||||||
|
|
||||||
static const JanetReg table_cfuns[] = {
|
static const JanetReg table_cfuns[] = {
|
||||||
{
|
{
|
||||||
"table/new", cfun_table_new,
|
"table/new", cfun_table_new,
|
||||||
@@ -343,12 +268,6 @@ static const JanetReg table_cfuns[] = {
|
|||||||
"If a table tab does not contain t directly, the function will return "
|
"If a table tab does not contain t directly, the function will return "
|
||||||
"nil without checking the prototype. Returns the value in the table.")
|
"nil without checking the prototype. Returns the value in the table.")
|
||||||
},
|
},
|
||||||
{
|
|
||||||
"table/clone", cfun_table_clone,
|
|
||||||
JDOC("(table/clone tab)\n\n"
|
|
||||||
"Create a copy of a table. Updates to the new table will not change the old table, "
|
|
||||||
"and vice versa.")
|
|
||||||
},
|
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
|
|||||||
@@ -33,8 +33,8 @@
|
|||||||
Janet *janet_tuple_begin(int32_t length) {
|
Janet *janet_tuple_begin(int32_t length) {
|
||||||
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
size_t size = sizeof(JanetTupleHead) + (length * sizeof(Janet));
|
||||||
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
JanetTupleHead *head = janet_gcalloc(JANET_MEMORY_TUPLE, size);
|
||||||
head->sm_line = -1;
|
head->sm_start = -1;
|
||||||
head->sm_column = -1;
|
head->sm_end = -1;
|
||||||
head->length = length;
|
head->length = length;
|
||||||
return (Janet *)(head->data);
|
return (Janet *)(head->data);
|
||||||
}
|
}
|
||||||
@@ -119,16 +119,16 @@ static Janet cfun_tuple_sourcemap(int32_t argc, Janet *argv) {
|
|||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
const Janet *tup = janet_gettuple(argv, 0);
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
Janet contents[2];
|
Janet contents[2];
|
||||||
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_line);
|
contents[0] = janet_wrap_integer(janet_tuple_head(tup)->sm_start);
|
||||||
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_column);
|
contents[1] = janet_wrap_integer(janet_tuple_head(tup)->sm_end);
|
||||||
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
return janet_wrap_tuple(janet_tuple_n(contents, 2));
|
||||||
}
|
}
|
||||||
|
|
||||||
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
static Janet cfun_tuple_setmap(int32_t argc, Janet *argv) {
|
||||||
janet_fixarity(argc, 3);
|
janet_fixarity(argc, 3);
|
||||||
const Janet *tup = janet_gettuple(argv, 0);
|
const Janet *tup = janet_gettuple(argv, 0);
|
||||||
janet_tuple_head(tup)->sm_line = janet_getinteger(argv, 1);
|
janet_tuple_head(tup)->sm_start = janet_getinteger(argv, 1);
|
||||||
janet_tuple_head(tup)->sm_column = janet_getinteger(argv, 2);
|
janet_tuple_head(tup)->sm_end = janet_getinteger(argv, 2);
|
||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -158,14 +158,16 @@ static const JanetReg tuple_cfuns[] = {
|
|||||||
{
|
{
|
||||||
"tuple/sourcemap", cfun_tuple_sourcemap,
|
"tuple/sourcemap", cfun_tuple_sourcemap,
|
||||||
JDOC("(tuple/sourcemap tup)\n\n"
|
JDOC("(tuple/sourcemap tup)\n\n"
|
||||||
"Returns the sourcemap metadata attached to a tuple, "
|
"Returns the sourcemap metadata attached to a tuple. "
|
||||||
" which is another tuple (line, column).")
|
"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,
|
"tuple/setmap", cfun_tuple_setmap,
|
||||||
JDOC("(tuple/setmap tup line column)\n\n"
|
JDOC("(tuple/setmap tup start end)\n\n"
|
||||||
"Set the sourcemap metadata on a tuple. line and column indicate "
|
"Set the sourcemap metadata on a tuple. start and end should "
|
||||||
"should be integers.")
|
"be integers representing byte offsets into the file. Returns tup.")
|
||||||
},
|
},
|
||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|||||||
@@ -159,14 +159,10 @@ static void ta_view_unmarshal(void *p, JanetMarshalContext *ctx) {
|
|||||||
view->as.u8 = view->buffer->data + offset;
|
view->as.u8 = view->buffer->data + offset;
|
||||||
}
|
}
|
||||||
|
|
||||||
static JanetMethod tarray_view_methods[6];
|
|
||||||
|
|
||||||
static Janet ta_getter(void *p, Janet key) {
|
static Janet ta_getter(void *p, Janet key) {
|
||||||
Janet value;
|
Janet value;
|
||||||
size_t index, i;
|
size_t index, i;
|
||||||
JanetTArrayView *array = p;
|
JanetTArrayView *array = p;
|
||||||
if (janet_checktype(key, JANET_KEYWORD))
|
|
||||||
return janet_getmethod(janet_unwrap_keyword(key), tarray_view_methods);
|
|
||||||
if (!janet_checksize(key)) janet_panic("expected size as key");
|
if (!janet_checksize(key)) janet_panic("expected size as key");
|
||||||
index = (size_t) janet_unwrap_number(key);
|
index = (size_t) janet_unwrap_number(key);
|
||||||
i = index * array->stride;
|
i = index * array->stride;
|
||||||
@@ -201,10 +197,10 @@ static Janet ta_getter(void *p, Janet key) {
|
|||||||
break;
|
break;
|
||||||
#endif
|
#endif
|
||||||
case JANET_TARRAY_TYPE_F32:
|
case JANET_TARRAY_TYPE_F32:
|
||||||
value = janet_wrap_number_safe(array->as.f32[i]);
|
value = janet_wrap_number(array->as.f32[i]);
|
||||||
break;
|
break;
|
||||||
case JANET_TARRAY_TYPE_F64:
|
case JANET_TARRAY_TYPE_F64:
|
||||||
value = janet_wrap_number_safe(array->as.f64[i]);
|
value = janet_wrap_number(array->as.f64[i]);
|
||||||
break;
|
break;
|
||||||
default:
|
default:
|
||||||
janet_panicf("cannot get from typed array of type %s",
|
janet_panicf("cannot get from typed array of type %s",
|
||||||
@@ -512,17 +508,17 @@ static Janet cfun_typed_array_swap_bytes(int32_t argc, Janet *argv) {
|
|||||||
static const JanetReg ta_cfuns[] = {
|
static const JanetReg ta_cfuns[] = {
|
||||||
{
|
{
|
||||||
"tarray/new", cfun_typed_array_new,
|
"tarray/new", cfun_typed_array_new,
|
||||||
JDOC("(tarray/new type size &opt stride offset tarray|buffer)\n\n"
|
JDOC("(tarray/new type size [stride = 1 [offset = 0 [tarray | buffer]]] )\n\n"
|
||||||
"Create new typed array.")
|
"Create new typed array.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tarray/buffer", cfun_typed_array_buffer,
|
"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.")
|
"Return typed array buffer or create a new buffer.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tarray/length", cfun_typed_array_size,
|
"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.")
|
"Return typed array or buffer size.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
@@ -532,21 +528,21 @@ static const JanetReg ta_cfuns[] = {
|
|||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
"tarray/copy-bytes", cfun_typed_array_copy_bytes,
|
||||||
JDOC("(tarray/copy-bytes src sindex dst dindex &opt count)\n\n"
|
JDOC("(tarray/copy-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
"Copy count elements (default 1) of src array from index sindex "
|
"Copy count elements of src array from index sindex "
|
||||||
"to dst array at position dindex "
|
"to dst array at position dindex "
|
||||||
"memory can overlap.")
|
"memory can overlap.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
"tarray/swap-bytes", cfun_typed_array_swap_bytes,
|
||||||
JDOC("(tarray/swap-bytes src sindex dst dindex &opt count)\n\n"
|
JDOC("(tarray/swap-bytes src sindex dst dindex [count=1])\n\n"
|
||||||
"Swap count elements (default 1) between src array from index sindex "
|
"Swap count elements between src array from index sindex "
|
||||||
"and dst array at position dindex "
|
"and dst array at position dindex "
|
||||||
"memory can overlap.")
|
"memory can overlap.")
|
||||||
},
|
},
|
||||||
{
|
{
|
||||||
"tarray/slice", cfun_typed_array_slice,
|
"tarray/slice", cfun_typed_array_slice,
|
||||||
JDOC("(tarray/slice tarr &opt start end)\n\n"
|
JDOC("(tarray/slice tarr [, start=0 [, end=(size tarr)]])\n\n"
|
||||||
"Takes a slice of a typed array from start to end. The range is half "
|
"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 "
|
"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 "
|
"from the end of the end of the typed array. By default, start is 0 and end is "
|
||||||
@@ -555,15 +551,6 @@ static const JanetReg ta_cfuns[] = {
|
|||||||
{NULL, NULL, NULL}
|
{NULL, NULL, NULL}
|
||||||
};
|
};
|
||||||
|
|
||||||
static JanetMethod tarray_view_methods[] = {
|
|
||||||
{"length", cfun_typed_array_size},
|
|
||||||
{"properties", cfun_typed_array_properties},
|
|
||||||
{"copy-bytes", cfun_typed_array_copy_bytes},
|
|
||||||
{"swap-bytes", cfun_typed_array_swap_bytes},
|
|
||||||
{"slice", cfun_typed_array_slice},
|
|
||||||
{NULL, NULL}
|
|
||||||
};
|
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_typed_array(JanetTable *env) {
|
void janet_lib_typed_array(JanetTable *env) {
|
||||||
janet_core_cfuns(env, NULL, ta_cfuns);
|
janet_core_cfuns(env, NULL, ta_cfuns);
|
||||||
|
|||||||
@@ -23,9 +23,6 @@
|
|||||||
#ifndef JANET_UTIL_H_defined
|
#ifndef JANET_UTIL_H_defined
|
||||||
#define JANET_UTIL_H_defined
|
#define JANET_UTIL_H_defined
|
||||||
|
|
||||||
#include <stdio.h>
|
|
||||||
#include <errno.h>
|
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
@@ -151,6 +151,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
break;
|
break;
|
||||||
case JANET_STRUCT:
|
case JANET_STRUCT:
|
||||||
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
value = janet_struct_get(janet_unwrap_struct(ds), key);
|
||||||
@@ -218,6 +219,7 @@ Janet janet_get(Janet ds, Janet key) {
|
|||||||
value = (type->get)(janet_unwrap_abstract(ds), key);
|
value = (type->get)(janet_unwrap_abstract(ds), key);
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no getter for %v ", ds);
|
janet_panicf("no getter for %v ", ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -231,6 +233,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
|||||||
switch (janet_type(ds)) {
|
switch (janet_type(ds)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
break;
|
break;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
@@ -274,6 +277,7 @@ Janet janet_getindex(Janet ds, int32_t index) {
|
|||||||
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
value = (type->get)(janet_unwrap_abstract(ds), janet_wrap_integer(index));
|
||||||
} else {
|
} else {
|
||||||
janet_panicf("no getter for %v ", ds);
|
janet_panicf("no getter for %v ", ds);
|
||||||
|
value = janet_wrap_nil();
|
||||||
}
|
}
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -285,6 +289,7 @@ int32_t janet_length(Janet x) {
|
|||||||
switch (janet_type(x)) {
|
switch (janet_type(x)) {
|
||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
||||||
|
return 0;
|
||||||
case JANET_STRING:
|
case JANET_STRING:
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
@@ -299,38 +304,6 @@ int32_t janet_length(Janet x) {
|
|||||||
return janet_struct_length(janet_unwrap_struct(x));
|
return janet_struct_length(janet_unwrap_struct(x));
|
||||||
case JANET_TABLE:
|
case JANET_TABLE:
|
||||||
return janet_unwrap_table(x)->count;
|
return janet_unwrap_table(x)->count;
|
||||||
case JANET_ABSTRACT: {
|
|
||||||
Janet argv[1] = { x };
|
|
||||||
Janet len = janet_mcall("length", 1, argv);
|
|
||||||
if (!janet_checkint(len))
|
|
||||||
janet_panicf("invalid integer length %v", len);
|
|
||||||
return janet_unwrap_integer(len);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
Janet janet_lengthv(Janet x) {
|
|
||||||
switch (janet_type(x)) {
|
|
||||||
default:
|
|
||||||
janet_panicf("expected %T, got %v", JANET_TFLAG_LENGTHABLE, x);
|
|
||||||
case JANET_STRING:
|
|
||||||
case JANET_SYMBOL:
|
|
||||||
case JANET_KEYWORD:
|
|
||||||
return janet_wrap_integer(janet_string_length(janet_unwrap_string(x)));
|
|
||||||
case JANET_ARRAY:
|
|
||||||
return janet_wrap_integer(janet_unwrap_array(x)->count);
|
|
||||||
case JANET_BUFFER:
|
|
||||||
return janet_wrap_integer(janet_unwrap_buffer(x)->count);
|
|
||||||
case JANET_TUPLE:
|
|
||||||
return janet_wrap_integer(janet_tuple_length(janet_unwrap_tuple(x)));
|
|
||||||
case JANET_STRUCT:
|
|
||||||
return janet_wrap_integer(janet_struct_length(janet_unwrap_struct(x)));
|
|
||||||
case JANET_TABLE:
|
|
||||||
return janet_wrap_integer(janet_unwrap_table(x)->count);
|
|
||||||
case JANET_ABSTRACT: {
|
|
||||||
Janet argv[1] = { x };
|
|
||||||
return janet_mcall("length", 1, argv);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -339,6 +312,7 @@ void janet_putindex(Janet ds, int32_t index, Janet value) {
|
|||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
|
break;
|
||||||
case JANET_ARRAY: {
|
case JANET_ARRAY: {
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
if (index >= array->count) {
|
if (index >= array->count) {
|
||||||
@@ -381,6 +355,7 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
|||||||
default:
|
default:
|
||||||
janet_panicf("expected %T, got %v",
|
janet_panicf("expected %T, got %v",
|
||||||
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
JANET_TFLAG_ARRAY | JANET_TFLAG_BUFFER | JANET_TFLAG_TABLE, ds);
|
||||||
|
break;
|
||||||
case JANET_ARRAY: {
|
case JANET_ARRAY: {
|
||||||
int32_t index;
|
int32_t index;
|
||||||
JanetArray *array = janet_unwrap_array(ds);
|
JanetArray *array = janet_unwrap_array(ds);
|
||||||
|
|||||||
@@ -30,11 +30,17 @@ void *janet_v_grow(void *v, int32_t increment, int32_t itemsize) {
|
|||||||
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
int32_t dbl_cur = (NULL != v) ? 2 * janet_v__cap(v) : 0;
|
||||||
int32_t min_needed = janet_v_count(v) + increment;
|
int32_t min_needed = janet_v_count(v) + increment;
|
||||||
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
int32_t m = dbl_cur > min_needed ? dbl_cur : min_needed;
|
||||||
size_t newsize = ((size_t) itemsize) * m + sizeof(int32_t) * 2;
|
int32_t *p = (int32_t *) realloc(v ? janet_v__raw(v) : 0, itemsize * m + sizeof(int32_t) * 2);
|
||||||
int32_t *p = (int32_t *) janet_srealloc(v ? janet_v__raw(v) : 0, newsize);
|
if (NULL != p) {
|
||||||
if (!v) p[1] = 0;
|
if (!v) p[1] = 0;
|
||||||
p[0] = m;
|
p[0] = m;
|
||||||
return p + 2;
|
return p + 2;
|
||||||
|
} else {
|
||||||
|
{
|
||||||
|
JANET_OUT_OF_MEMORY;
|
||||||
|
}
|
||||||
|
return (void *)(2 * sizeof(int32_t));
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Convert a buffer to normal allocated memory (forget capacity) */
|
/* Convert a buffer to normal allocated memory (forget capacity) */
|
||||||
|
|||||||
@@ -33,15 +33,16 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
/* This is mainly used code such as the assembler or compiler, which
|
/* This is mainly used code such as the assembler or compiler, which
|
||||||
* need vector like data structures that are only garbage collected in case
|
* need vector like data structures that are not garbage collected
|
||||||
* of an error, and normally rely on malloc/free. */
|
* and used only from C */
|
||||||
|
|
||||||
#define janet_v_free(v) (((v) != NULL) ? (janet_sfree(janet_v__raw(v)), 0) : 0)
|
#define janet_v_free(v) (((v) != NULL) ? (free(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_push(v, x) (janet_v__maybegrow(v, 1), (v)[janet_v__cnt(v)++] = (x))
|
||||||
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
#define janet_v_pop(v) (janet_v_count(v) ? janet_v__cnt(v)-- : 0)
|
||||||
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
#define janet_v_count(v) (((v) != NULL) ? janet_v__cnt(v) : 0)
|
||||||
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
#define janet_v_last(v) ((v)[janet_v__cnt(v) - 1])
|
||||||
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
#define janet_v_empty(v) (((v) != NULL) ? (janet_v__cnt(v) = 0) : 0)
|
||||||
|
#define janet_v_copy(v) (janet_v_copymem((v), sizeof(*(v))))
|
||||||
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
|
#define janet_v_flatten(v) (janet_v_flattenmem((v), sizeof(*(v))))
|
||||||
|
|
||||||
#define janet_v__raw(v) ((int32_t *)(v) - 2)
|
#define janet_v__raw(v) ((int32_t *)(v) - 2)
|
||||||
@@ -54,6 +55,7 @@
|
|||||||
|
|
||||||
/* Actual functions defined in vector.c */
|
/* Actual functions defined in vector.c */
|
||||||
void *janet_v_grow(void *v, int32_t increment, int32_t itemsize);
|
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);
|
void *janet_v_flattenmem(void *v, int32_t itemsize);
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|||||||
284
src/core/vm.c
284
src/core/vm.c
@@ -57,11 +57,7 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||||||
/* How we dispatch instructions. By default, we use
|
/* How we dispatch instructions. By default, we use
|
||||||
* a switch inside an infinite loop. For GCC/clang, we use
|
* a switch inside an infinite loop. For GCC/clang, we use
|
||||||
* computed gotos. */
|
* computed gotos. */
|
||||||
#if defined(__GNUC__) && !defined(__EMSCRIPTEN__)
|
#ifdef __GNUC__
|
||||||
#define JANET_USE_COMPUTED_GOTOS
|
|
||||||
#endif
|
|
||||||
|
|
||||||
#ifdef JANET_USE_COMPUTED_GOTOS
|
|
||||||
#define VM_START() { goto *op_lookup[first_opcode];
|
#define VM_START() { goto *op_lookup[first_opcode];
|
||||||
#define VM_END() }
|
#define VM_END() }
|
||||||
#define VM_OP(op) label_##op :
|
#define VM_OP(op) label_##op :
|
||||||
@@ -117,16 +113,9 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||||||
{\
|
{\
|
||||||
Janet op1 = stack[B];\
|
Janet op1 = stack[B];\
|
||||||
vm_assert_type(op1, JANET_NUMBER);\
|
vm_assert_type(op1, JANET_NUMBER);\
|
||||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
|
||||||
vm_commit();\
|
|
||||||
Janet _argv[2] = { op1, janet_wrap_number(CS) };\
|
|
||||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
|
||||||
vm_pcnext();\
|
|
||||||
} else {\
|
|
||||||
double x1 = janet_unwrap_number(op1);\
|
double x1 = janet_unwrap_number(op1);\
|
||||||
stack[A] = janet_wrap_number(x1 op CS);\
|
stack[A] = janet_wrap_number(x1 op CS);\
|
||||||
vm_pcnext();\
|
vm_pcnext();\
|
||||||
}\
|
|
||||||
}
|
}
|
||||||
#define _vm_bitop_immediate(op, type1)\
|
#define _vm_bitop_immediate(op, type1)\
|
||||||
{\
|
{\
|
||||||
@@ -142,19 +131,12 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
|||||||
{\
|
{\
|
||||||
Janet op1 = stack[B];\
|
Janet op1 = stack[B];\
|
||||||
Janet op2 = stack[C];\
|
Janet op2 = stack[C];\
|
||||||
if (!janet_checktype(op1, JANET_NUMBER)) {\
|
|
||||||
vm_commit();\
|
|
||||||
Janet _argv[2] = { op1, op2 };\
|
|
||||||
stack[A] = janet_mcall(#op, 2, _argv);\
|
|
||||||
vm_pcnext();\
|
|
||||||
} else {\
|
|
||||||
vm_assert_type(op1, JANET_NUMBER);\
|
vm_assert_type(op1, JANET_NUMBER);\
|
||||||
vm_assert_type(op2, JANET_NUMBER);\
|
vm_assert_type(op2, JANET_NUMBER);\
|
||||||
double x1 = janet_unwrap_number(op1);\
|
double x1 = janet_unwrap_number(op1);\
|
||||||
double x2 = janet_unwrap_number(op2);\
|
double x2 = janet_unwrap_number(op2);\
|
||||||
stack[A] = wrap(x1 op x2);\
|
stack[A] = wrap(x1 op x2);\
|
||||||
vm_pcnext();\
|
vm_pcnext();\
|
||||||
}\
|
|
||||||
}
|
}
|
||||||
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
#define vm_binop(op) _vm_binop(op, janet_wrap_number)
|
||||||
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
|
#define vm_numcomp(op) _vm_binop(op, janet_wrap_boolean)
|
||||||
@@ -193,7 +175,7 @@ static void vm_do_trace(JanetFunction *func) {
|
|||||||
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
||||||
int32_t argn = fiber->stacktop - fiber->stackstart;
|
int32_t argn = fiber->stacktop - fiber->stackstart;
|
||||||
Janet ds, key;
|
Janet ds, key;
|
||||||
if (argn != 1) janet_panicf("%v called with %d arguments, possibly expected 1", callee, argn);
|
if (argn != 1) janet_panicf("%v called with arity %d, expected 1", callee, argn);
|
||||||
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
if (janet_checktypes(callee, JANET_TFLAG_INDEXED | JANET_TFLAG_DICTIONARY |
|
||||||
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
JANET_TFLAG_STRING | JANET_TFLAG_BUFFER | JANET_TFLAG_ABSTRACT)) {
|
||||||
ds = callee;
|
ds = callee;
|
||||||
@@ -206,21 +188,11 @@ static Janet call_nonfn(JanetFiber *fiber, Janet callee) {
|
|||||||
return janet_get(ds, key);
|
return janet_get(ds, key);
|
||||||
}
|
}
|
||||||
|
|
||||||
/* Get a callable from a keyword method name and check ensure that it is valid. */
|
|
||||||
static Janet resolve_method(Janet name, JanetFiber *fiber) {
|
|
||||||
int32_t argc = fiber->stacktop - fiber->stackstart;
|
|
||||||
if (argc < 1) janet_panicf("method call (%v) takes at least 1 argument, got 0", name);
|
|
||||||
Janet callee = janet_get(fiber->data[fiber->stackstart], name);
|
|
||||||
if (janet_checktype(callee, JANET_NIL))
|
|
||||||
janet_panicf("unknown method %v invoked on %v", name, fiber->data[fiber->stackstart]);
|
|
||||||
return callee;
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Interpreter main loop */
|
/* Interpreter main loop */
|
||||||
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status) {
|
||||||
|
|
||||||
/* opcode -> label lookup if using clang/GCC */
|
/* opcode -> label lookup if using clang/GCC */
|
||||||
#ifdef JANET_USE_COMPUTED_GOTOS
|
#ifdef __GNUC__
|
||||||
static void *op_lookup[255] = {
|
static void *op_lookup[255] = {
|
||||||
&&label_JOP_NOOP,
|
&&label_JOP_NOOP,
|
||||||
&&label_JOP_ERROR,
|
&&label_JOP_ERROR,
|
||||||
@@ -273,7 +245,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
&&label_JOP_TAILCALL,
|
&&label_JOP_TAILCALL,
|
||||||
&&label_JOP_RESUME,
|
&&label_JOP_RESUME,
|
||||||
&&label_JOP_SIGNAL,
|
&&label_JOP_SIGNAL,
|
||||||
&&label_JOP_PROPAGATE,
|
|
||||||
&&label_JOP_GET,
|
&&label_JOP_GET,
|
||||||
&&label_JOP_PUT,
|
&&label_JOP_PUT,
|
||||||
&&label_JOP_GET_INDEX,
|
&&label_JOP_GET_INDEX,
|
||||||
@@ -291,191 +262,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
&&label_JOP_NUMERIC_GREATER_THAN,
|
&&label_JOP_NUMERIC_GREATER_THAN,
|
||||||
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
&&label_JOP_NUMERIC_GREATER_THAN_EQUAL,
|
||||||
&&label_JOP_NUMERIC_EQUAL,
|
&&label_JOP_NUMERIC_EQUAL,
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op,
|
|
||||||
&&label_unknown_op
|
&&label_unknown_op
|
||||||
};
|
};
|
||||||
#endif
|
#endif
|
||||||
@@ -491,9 +277,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
* DO NOT use input when resuming a fiber that has been interrupted at a
|
* DO NOT use input when resuming a fiber that has been interrupted at a
|
||||||
* breakpoint. */
|
* breakpoint. */
|
||||||
if (status != JANET_STATUS_NEW &&
|
if (status != JANET_STATUS_NEW &&
|
||||||
((*pc & 0xFF) == JOP_SIGNAL ||
|
((*pc & 0xFF) == JOP_SIGNAL || (*pc & 0xFF) == JOP_RESUME)) {
|
||||||
(*pc & 0xFF) == JOP_PROPAGATE ||
|
|
||||||
(*pc & 0xFF) == JOP_RESUME)) {
|
|
||||||
stack[A] = in;
|
stack[A] = in;
|
||||||
pc++;
|
pc++;
|
||||||
}
|
}
|
||||||
@@ -795,7 +579,9 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
}
|
}
|
||||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||||
vm_commit();
|
vm_commit();
|
||||||
callee = resolve_method(callee, fiber);
|
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||||
|
if (argc < 1) janet_panicf("method call takes at least 1 argument, got %d", argc);
|
||||||
|
callee = janet_get(fiber->data[fiber->stackstart], callee);
|
||||||
}
|
}
|
||||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||||
func = janet_unwrap_function(callee);
|
func = janet_unwrap_function(callee);
|
||||||
@@ -827,12 +613,11 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
|
|
||||||
VM_OP(JOP_TAILCALL) {
|
VM_OP(JOP_TAILCALL) {
|
||||||
Janet callee = stack[D];
|
Janet callee = stack[D];
|
||||||
if (fiber->stacktop > fiber->maxstack) {
|
|
||||||
vm_throw("stack overflow");
|
|
||||||
}
|
|
||||||
if (janet_checktype(callee, JANET_KEYWORD)) {
|
if (janet_checktype(callee, JANET_KEYWORD)) {
|
||||||
vm_commit();
|
vm_commit();
|
||||||
callee = resolve_method(callee, fiber);
|
int32_t argc = fiber->stacktop - fiber->stackstart;
|
||||||
|
if (argc < 1) janet_panicf("method call takes at least 1 argument, got %d", argc);
|
||||||
|
callee = janet_get(fiber->data[fiber->stackstart], callee);
|
||||||
}
|
}
|
||||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||||
func = janet_unwrap_function(callee);
|
func = janet_unwrap_function(callee);
|
||||||
@@ -888,18 +673,6 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
vm_return(s, stack[B]);
|
vm_return(s, stack[B]);
|
||||||
}
|
}
|
||||||
|
|
||||||
VM_OP(JOP_PROPAGATE) {
|
|
||||||
Janet fv = stack[C];
|
|
||||||
vm_assert_type(fv, JANET_FIBER);
|
|
||||||
JanetFiber *f = janet_unwrap_fiber(fv);
|
|
||||||
JanetFiberStatus sub_status = janet_fiber_status(f);
|
|
||||||
if (sub_status > JANET_STATUS_USER9) {
|
|
||||||
vm_throw("cannot propagate from new or alive fiber");
|
|
||||||
}
|
|
||||||
janet_vm_fiber->child = f;
|
|
||||||
vm_return((int) sub_status, stack[B]);
|
|
||||||
}
|
|
||||||
|
|
||||||
VM_OP(JOP_PUT)
|
VM_OP(JOP_PUT)
|
||||||
vm_commit();
|
vm_commit();
|
||||||
janet_put(stack[A], stack[B], stack[C]);
|
janet_put(stack[A], stack[B], stack[C]);
|
||||||
@@ -922,7 +695,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in, JanetFiberStatus status)
|
|||||||
|
|
||||||
VM_OP(JOP_LENGTH)
|
VM_OP(JOP_LENGTH)
|
||||||
vm_commit();
|
vm_commit();
|
||||||
stack[A] = janet_lengthv(stack[E]);
|
stack[A] = janet_wrap_integer(janet_length(stack[E]));
|
||||||
vm_pcnext();
|
vm_pcnext();
|
||||||
|
|
||||||
VM_OP(JOP_MAKE_ARRAY) {
|
VM_OP(JOP_MAKE_ARRAY) {
|
||||||
@@ -1118,37 +891,6 @@ JanetSignal janet_pcall(
|
|||||||
return janet_continue(fiber, janet_wrap_nil(), out);
|
return janet_continue(fiber, janet_wrap_nil(), out);
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_mcall(const char *name, int32_t argc, Janet *argv) {
|
|
||||||
/* At least 1 argument */
|
|
||||||
if (argc < 1) janet_panicf("method :%s expected at least 1 argument");
|
|
||||||
/* Find method */
|
|
||||||
Janet method;
|
|
||||||
if (janet_checktype(argv[0], JANET_ABSTRACT)) {
|
|
||||||
void *abst = janet_unwrap_abstract(argv[0]);
|
|
||||||
JanetAbstractType *type = (JanetAbstractType *)janet_abstract_type(abst);
|
|
||||||
if (!type->get)
|
|
||||||
janet_panicf("abstract value %v does not implement :%s", argv[0], name);
|
|
||||||
method = (type->get)(abst, janet_ckeywordv(name));
|
|
||||||
} else if (janet_checktype(argv[0], JANET_TABLE)) {
|
|
||||||
JanetTable *table = janet_unwrap_table(argv[0]);
|
|
||||||
method = janet_table_get(table, janet_ckeywordv(name));
|
|
||||||
} else if (janet_checktype(argv[0], JANET_STRUCT)) {
|
|
||||||
const JanetKV *st = janet_unwrap_struct(argv[0]);
|
|
||||||
method = janet_struct_get(st, janet_ckeywordv(name));
|
|
||||||
} else {
|
|
||||||
janet_panicf("could not find method :%s for %v", name, argv[0]);
|
|
||||||
}
|
|
||||||
/* Invoke method */
|
|
||||||
if (janet_checktype(method, JANET_CFUNCTION)) {
|
|
||||||
return (janet_unwrap_cfunction(method))(argc, argv);
|
|
||||||
} else if (janet_checktype(method, JANET_FUNCTION)) {
|
|
||||||
JanetFunction *fun = janet_unwrap_function(method);
|
|
||||||
return janet_call(fun, argc, argv);
|
|
||||||
} else {
|
|
||||||
janet_panicf("method %s has unexpected value %v", name, method);
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
/* Setup VM */
|
/* Setup VM */
|
||||||
int janet_init(void) {
|
int janet_init(void) {
|
||||||
/* Garbage collection */
|
/* Garbage collection */
|
||||||
@@ -1164,10 +906,6 @@ int janet_init(void) {
|
|||||||
janet_vm_roots = NULL;
|
janet_vm_roots = NULL;
|
||||||
janet_vm_root_count = 0;
|
janet_vm_root_count = 0;
|
||||||
janet_vm_root_capacity = 0;
|
janet_vm_root_capacity = 0;
|
||||||
/* Scratch memory */
|
|
||||||
janet_scratch_mem = NULL;
|
|
||||||
janet_scratch_len = 0;
|
|
||||||
janet_scratch_cap = 0;
|
|
||||||
/* Initialize registry */
|
/* Initialize registry */
|
||||||
janet_vm_registry = janet_table(0);
|
janet_vm_registry = janet_table(0);
|
||||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||||
|
|||||||
@@ -21,10 +21,8 @@
|
|||||||
*/
|
*/
|
||||||
|
|
||||||
#ifndef JANET_AMALG
|
#ifndef JANET_AMALG
|
||||||
#include <math.h>
|
|
||||||
#include <janet.h>
|
#include <janet.h>
|
||||||
#include "util.h"
|
#include "util.h"
|
||||||
#include "state.h"
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Macro fills */
|
/* Macro fills */
|
||||||
@@ -162,7 +160,6 @@ Janet(janet_wrap_number)(double x) {
|
|||||||
void *janet_memalloc_empty(int32_t count) {
|
void *janet_memalloc_empty(int32_t count) {
|
||||||
int32_t i;
|
int32_t i;
|
||||||
void *mem = malloc(count * sizeof(JanetKV));
|
void *mem = malloc(count * sizeof(JanetKV));
|
||||||
janet_vm_next_collection += count * sizeof(JanetKV);
|
|
||||||
if (NULL == mem) {
|
if (NULL == mem) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@@ -185,12 +182,6 @@ void janet_memempty(JanetKV *mem, int32_t count) {
|
|||||||
|
|
||||||
#ifdef JANET_NANBOX_64
|
#ifdef JANET_NANBOX_64
|
||||||
|
|
||||||
Janet janet_wrap_number_safe(double d) {
|
|
||||||
Janet ret;
|
|
||||||
ret.number = isnan(d) ? NAN : d;
|
|
||||||
return ret;
|
|
||||||
}
|
|
||||||
|
|
||||||
void *janet_nanbox_to_pointer(Janet x) {
|
void *janet_nanbox_to_pointer(Janet x) {
|
||||||
x.i64 &= JANET_NANBOX_PAYLOADBITS;
|
x.i64 &= JANET_NANBOX_PAYLOADBITS;
|
||||||
return x.pointer;
|
return x.pointer;
|
||||||
@@ -231,11 +222,6 @@ Janet janet_wrap_number(double x) {
|
|||||||
return ret;
|
return ret;
|
||||||
}
|
}
|
||||||
|
|
||||||
Janet janet_wrap_number_safe(double d) {
|
|
||||||
double x = isnan(d) ? NAN : d;
|
|
||||||
return janet_wrap_number(x);
|
|
||||||
}
|
|
||||||
|
|
||||||
Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer) {
|
Janet janet_nanbox32_from_tagi(uint32_t tag, int32_t integer) {
|
||||||
Janet ret;
|
Janet ret;
|
||||||
ret.tagged.type = tag;
|
ret.tagged.type = tag;
|
||||||
@@ -257,10 +243,6 @@ double janet_unwrap_number(Janet x) {
|
|||||||
|
|
||||||
#else
|
#else
|
||||||
|
|
||||||
Janet janet_wrap_number_safe(double d) {
|
|
||||||
return janet_wrap_number(d);
|
|
||||||
}
|
|
||||||
|
|
||||||
Janet janet_wrap_nil(void) {
|
Janet janet_wrap_nil(void) {
|
||||||
Janet y;
|
Janet y;
|
||||||
y.type = JANET_NIL;
|
y.type = JANET_NIL;
|
||||||
@@ -316,4 +298,3 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
|
|||||||
#undef JANET_WRAP_DEFINE
|
#undef JANET_WRAP_DEFINE
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
|||||||
@@ -152,15 +152,6 @@ extern "C" {
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* 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
|
|
||||||
#endif
|
|
||||||
|
|
||||||
/* Prevent some recursive functions from recursing too deeply
|
/* Prevent some recursive functions from recursing too deeply
|
||||||
* ands crashing (the parser). Instead, error out. */
|
* ands crashing (the parser). Instead, error out. */
|
||||||
#define JANET_RECURSION_GUARD 1024
|
#define JANET_RECURSION_GUARD 1024
|
||||||
@@ -171,10 +162,11 @@ extern "C" {
|
|||||||
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
/* Maximum depth to follow table prototypes before giving up and returning nil. */
|
||||||
#define JANET_MAX_MACRO_EXPAND 200
|
#define JANET_MAX_MACRO_EXPAND 200
|
||||||
|
|
||||||
/* Define default max stack size for stacks before raising a stack overflow error.
|
/* Define max stack size for stacks before raising a stack overflow error.
|
||||||
* This can also be set on a per fiber basis. */
|
* If this is not defined, fiber stacks can grow without limit (until memory
|
||||||
|
* runs out) */
|
||||||
#ifndef JANET_STACK_MAX
|
#ifndef JANET_STACK_MAX
|
||||||
#define JANET_STACK_MAX 0x7fffffff
|
#define JANET_STACK_MAX 16384
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
/* Use nanboxed values - uses 8 bytes per value instead of 12 or 16.
|
||||||
@@ -192,38 +184,6 @@ extern "C" {
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Runtime config constants */
|
|
||||||
#ifdef JANET_NO_NANBOX
|
|
||||||
#define JANET_NANBOX_BIT 0
|
|
||||||
#else
|
|
||||||
#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 *****/
|
/***** END SECTION CONFIG *****/
|
||||||
|
|
||||||
/***** START SECTION TYPES *****/
|
/***** START SECTION TYPES *****/
|
||||||
@@ -237,9 +197,9 @@ typedef struct {
|
|||||||
#include <stdio.h>
|
#include <stdio.h>
|
||||||
|
|
||||||
/* Names of all of the types */
|
/* Names of all of the types */
|
||||||
JANET_API extern const char *const janet_type_names[16];
|
extern const char *const janet_type_names[16];
|
||||||
JANET_API extern const char *const janet_signal_names[14];
|
extern const char *const janet_signal_names[14];
|
||||||
JANET_API extern const char *const janet_status_names[16];
|
extern const char *const janet_status_names[16];
|
||||||
|
|
||||||
/* Fiber signals */
|
/* Fiber signals */
|
||||||
typedef enum {
|
typedef enum {
|
||||||
@@ -755,8 +715,8 @@ struct JanetTupleHead {
|
|||||||
JanetGCObject gc;
|
JanetGCObject gc;
|
||||||
int32_t length;
|
int32_t length;
|
||||||
int32_t hash;
|
int32_t hash;
|
||||||
int32_t sm_line;
|
int32_t sm_start;
|
||||||
int32_t sm_column;
|
int32_t sm_end;
|
||||||
const Janet data[];
|
const Janet data[];
|
||||||
};
|
};
|
||||||
|
|
||||||
@@ -798,8 +758,8 @@ struct JanetAbstractHead {
|
|||||||
|
|
||||||
/* Source mapping structure for a bytecode instruction */
|
/* Source mapping structure for a bytecode instruction */
|
||||||
struct JanetSourceMapping {
|
struct JanetSourceMapping {
|
||||||
int32_t line;
|
int32_t start;
|
||||||
int32_t column;
|
int32_t end;
|
||||||
};
|
};
|
||||||
|
|
||||||
/* A function definition. Contains information needed to instantiate closures. */
|
/* A function definition. Contains information needed to instantiate closures. */
|
||||||
@@ -869,8 +829,7 @@ struct JanetParser {
|
|||||||
size_t statecap;
|
size_t statecap;
|
||||||
size_t bufcount;
|
size_t bufcount;
|
||||||
size_t bufcap;
|
size_t bufcap;
|
||||||
size_t line;
|
size_t offset;
|
||||||
size_t column;
|
|
||||||
size_t pending;
|
size_t pending;
|
||||||
int lookback;
|
int lookback;
|
||||||
int flag;
|
int flag;
|
||||||
@@ -1014,7 +973,6 @@ enum JanetOpCode {
|
|||||||
JOP_TAILCALL,
|
JOP_TAILCALL,
|
||||||
JOP_RESUME,
|
JOP_RESUME,
|
||||||
JOP_SIGNAL,
|
JOP_SIGNAL,
|
||||||
JOP_PROPAGATE,
|
|
||||||
JOP_GET,
|
JOP_GET,
|
||||||
JOP_PUT,
|
JOP_PUT,
|
||||||
JOP_GET_INDEX,
|
JOP_GET_INDEX,
|
||||||
@@ -1101,11 +1059,13 @@ JANET_API void janet_debug_break(JanetFuncDef *def, int32_t pc);
|
|||||||
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
JANET_API void janet_debug_unbreak(JanetFuncDef *def, int32_t pc);
|
||||||
JANET_API void janet_debug_find(
|
JANET_API void janet_debug_find(
|
||||||
JanetFuncDef **def_out, int32_t *pc_out,
|
JanetFuncDef **def_out, int32_t *pc_out,
|
||||||
const uint8_t *source, int32_t line, int32_t column);
|
const uint8_t *source, int32_t offset);
|
||||||
|
|
||||||
/* Array functions */
|
/* Array functions */
|
||||||
JANET_API JanetArray *janet_array(int32_t capacity);
|
JANET_API JanetArray *janet_array(int32_t capacity);
|
||||||
JANET_API JanetArray *janet_array_n(const Janet *elements, int32_t n);
|
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_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_setcount(JanetArray *array, int32_t count);
|
||||||
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
JANET_API void janet_array_push(JanetArray *array, Janet x);
|
||||||
@@ -1134,8 +1094,8 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
|
|||||||
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
|
||||||
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
|
||||||
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
|
||||||
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
|
#define janet_tuple_sm_start(t) (janet_tuple_head(t)->sm_start)
|
||||||
#define janet_tuple_sm_column(t) (janet_tuple_head(t)->sm_column)
|
#define janet_tuple_sm_end(t) (janet_tuple_head(t)->sm_end)
|
||||||
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
#define janet_tuple_flag(t) (janet_tuple_head(t)->gc.flags)
|
||||||
JANET_API Janet *janet_tuple_begin(int32_t length);
|
JANET_API Janet *janet_tuple_begin(int32_t length);
|
||||||
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
JANET_API const Janet *janet_tuple_end(Janet *tuple);
|
||||||
@@ -1195,7 +1155,6 @@ JANET_API JanetTable *janet_table(int32_t capacity);
|
|||||||
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
|
JANET_API JanetTable *janet_table_init(JanetTable *table, int32_t capacity);
|
||||||
JANET_API void janet_table_deinit(JanetTable *table);
|
JANET_API void janet_table_deinit(JanetTable *table);
|
||||||
JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
JANET_API Janet janet_table_get(JanetTable *t, Janet key);
|
||||||
JANET_API Janet janet_table_get_ex(JanetTable *t, Janet key, JanetTable **which);
|
|
||||||
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
|
JANET_API Janet janet_table_rawget(JanetTable *t, Janet key);
|
||||||
JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
|
JANET_API Janet janet_table_remove(JanetTable *t, Janet key);
|
||||||
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);
|
JANET_API void janet_table_put(JanetTable *t, Janet key, Janet value);
|
||||||
@@ -1203,7 +1162,6 @@ JANET_API const JanetKV *janet_table_to_struct(JanetTable *t);
|
|||||||
JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
|
||||||
JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other);
|
JANET_API void janet_table_merge_struct(JanetTable *table, const JanetKV *other);
|
||||||
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
|
||||||
JANET_API JanetTable *janet_table_clone(JanetTable *table);
|
|
||||||
|
|
||||||
/* Fiber */
|
/* Fiber */
|
||||||
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
|
||||||
@@ -1222,13 +1180,10 @@ JANET_API const JanetKV *janet_dictionary_next(const JanetKV *kvs, int32_t cap,
|
|||||||
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
#define janet_abstract_head(u) ((JanetAbstractHead *)((char *)u - offsetof(JanetAbstractHead, data)))
|
||||||
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
#define janet_abstract_type(u) (janet_abstract_head(u)->type)
|
||||||
#define janet_abstract_size(u) (janet_abstract_head(u)->size)
|
#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(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 */
|
/* Native */
|
||||||
typedef void (*JanetModule)(JanetTable *);
|
typedef void (*JanetModule)(JanetTable *);
|
||||||
typedef JanetBuildConfig(*JanetModconf)(void);
|
|
||||||
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
JANET_API JanetModule janet_native(const char *name, const uint8_t **error);
|
||||||
|
|
||||||
/* Marshaling */
|
/* Marshaling */
|
||||||
@@ -1244,7 +1199,6 @@ JANET_API Janet janet_unmarshal(
|
|||||||
JanetTable *reg,
|
JanetTable *reg,
|
||||||
const uint8_t **next);
|
const uint8_t **next);
|
||||||
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
||||||
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
|
|
||||||
|
|
||||||
/* GC */
|
/* GC */
|
||||||
JANET_API void janet_mark(Janet x);
|
JANET_API void janet_mark(Janet x);
|
||||||
@@ -1264,7 +1218,6 @@ JANET_API int janet_verify(JanetFuncDef *def);
|
|||||||
|
|
||||||
/* Pretty printing */
|
/* Pretty printing */
|
||||||
#define JANET_PRETTY_COLOR 1
|
#define JANET_PRETTY_COLOR 1
|
||||||
#define JANET_PRETTY_ONELINE 2
|
|
||||||
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
JANET_API JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x);
|
||||||
|
|
||||||
/* Misc */
|
/* Misc */
|
||||||
@@ -1275,12 +1228,8 @@ JANET_API int janet_cstrcmp(const uint8_t *str, const char *other);
|
|||||||
JANET_API Janet janet_get(Janet ds, Janet key);
|
JANET_API Janet janet_get(Janet ds, Janet key);
|
||||||
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
JANET_API Janet janet_getindex(Janet ds, int32_t index);
|
||||||
JANET_API int32_t janet_length(Janet x);
|
JANET_API int32_t janet_length(Janet x);
|
||||||
JANET_API Janet janet_lengthv(Janet x);
|
|
||||||
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
JANET_API void janet_put(Janet ds, Janet key, Janet value);
|
||||||
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
JANET_API void janet_putindex(Janet ds, int32_t index, Janet value);
|
||||||
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
|
|
||||||
#define janet_flag_at(F, I) ((F) & ((1ULL) << (I)))
|
|
||||||
JANET_API Janet janet_wrap_number_safe(double x);
|
|
||||||
|
|
||||||
/* VM functions */
|
/* VM functions */
|
||||||
JANET_API int janet_init(void);
|
JANET_API int janet_init(void);
|
||||||
@@ -1288,14 +1237,8 @@ JANET_API void janet_deinit(void);
|
|||||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||||
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
JANET_API Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv);
|
||||||
JANET_API Janet janet_mcall(const char *name, int32_t argc, Janet *argv);
|
|
||||||
JANET_API void janet_stacktrace(JanetFiber *fiber, Janet err);
|
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 */
|
/* C Library helpers */
|
||||||
typedef enum {
|
typedef enum {
|
||||||
JANET_BINDING_NONE,
|
JANET_BINDING_NONE,
|
||||||
@@ -1311,29 +1254,18 @@ JANET_API void janet_register(const char *name, JanetCFunction cfun);
|
|||||||
|
|
||||||
/* New C API */
|
/* New C API */
|
||||||
|
|
||||||
/* Allow setting entry name for static libraries */
|
#define JANET_MODULE_ENTRY JANET_API void _janet_init
|
||||||
#ifndef JANET_ENTRY_NAME
|
JANET_API void janet_panicv(Janet message);
|
||||||
#define JANET_ENTRY_NAME _janet_init
|
JANET_API void janet_panic(const char *message);
|
||||||
#endif
|
JANET_API void janet_panics(const uint8_t *message);
|
||||||
|
JANET_API void janet_panicf(const char *format, ...);
|
||||||
#define JANET_MODULE_ENTRY \
|
|
||||||
JANET_API JanetBuildConfig _janet_mod_config(void) { \
|
|
||||||
return janet_config_current(); \
|
|
||||||
} \
|
|
||||||
JANET_API void JANET_ENTRY_NAME
|
|
||||||
|
|
||||||
JANET_NO_RETURN JANET_API void janet_panicv(Janet message);
|
|
||||||
JANET_NO_RETURN JANET_API void janet_panic(const char *message);
|
|
||||||
JANET_NO_RETURN JANET_API void janet_panics(const uint8_t *message);
|
|
||||||
JANET_NO_RETURN JANET_API void janet_panicf(const char *format, ...);
|
|
||||||
JANET_API void janet_printf(const char *format, ...);
|
JANET_API void janet_printf(const char *format, ...);
|
||||||
JANET_NO_RETURN JANET_API void janet_panic_type(Janet x, int32_t n, int expected);
|
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_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_arity(int32_t arity, int32_t min, int32_t max);
|
||||||
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
JANET_API void janet_fixarity(int32_t arity, int32_t fix);
|
||||||
|
|
||||||
JANET_API Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods);
|
JANET_API Janet janet_getmethod(const uint8_t *method, const JanetMethod *methods);
|
||||||
|
|
||||||
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
JANET_API double janet_getnumber(const Janet *argv, int32_t n);
|
||||||
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
JANET_API JanetArray *janet_getarray(const Janet *argv, int32_t n);
|
||||||
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
JANET_API const Janet *janet_gettuple(const Janet *argv, int32_t n);
|
||||||
@@ -1361,27 +1293,6 @@ 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_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 int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
|
||||||
|
|
||||||
/* Optionals */
|
|
||||||
JANET_API double janet_optnumber(const Janet *argv, int32_t argc, int32_t n, double dflt);
|
|
||||||
JANET_API JanetArray *janet_optarray(const Janet *argv, int32_t argc, int32_t n, JanetArray *dflt);
|
|
||||||
JANET_API const Janet *janet_opttuple(const Janet *argv, int32_t argc, int32_t n, const Janet *dflt);
|
|
||||||
JANET_API JanetTable *janet_opttable(const Janet *argv, int32_t argc, int32_t n, JanetTable *dflt);
|
|
||||||
JANET_API const JanetKV *janet_optstruct(const Janet *argv, int32_t argc, int32_t n, const JanetKV *dflt);
|
|
||||||
JANET_API const uint8_t *janet_optstring(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
|
||||||
JANET_API const char *janet_optcstring(const Janet *argv, int32_t argc, int32_t n, const char *dflt);
|
|
||||||
JANET_API const uint8_t *janet_optsymbol(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
|
||||||
JANET_API const uint8_t *janet_optkeyword(const Janet *argv, int32_t argc, int32_t n, const uint8_t *dflt);
|
|
||||||
JANET_API JanetBuffer *janet_optbuffer(const Janet *argv, int32_t argc, int32_t n, JanetBuffer *dflt);
|
|
||||||
JANET_API JanetFiber *janet_optfiber(const Janet *argv, int32_t argc, int32_t n, JanetFiber *dflt);
|
|
||||||
JANET_API JanetFunction *janet_optfunction(const Janet *argv, int32_t argc, int32_t n, JanetFunction *dflt);
|
|
||||||
JANET_API JanetCFunction janet_optcfunction(const Janet *argv, int32_t argc, int32_t n, JanetCFunction dflt);
|
|
||||||
JANET_API int janet_optboolean(const Janet *argv, int32_t argc, int32_t n, int dflt);
|
|
||||||
JANET_API void *janet_optpointer(const Janet *argv, int32_t argc, int32_t n, void *dflt);
|
|
||||||
JANET_API int32_t janet_optinteger(const Janet *argv, int32_t argc, int32_t n, int32_t dflt);
|
|
||||||
JANET_API int64_t janet_optinteger64(const Janet *argv, int32_t argc, int32_t n, int64_t dflt);
|
|
||||||
JANET_API size_t janet_optsize(const Janet *argv, int32_t argc, int32_t n, size_t dflt);
|
|
||||||
JANET_API void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetAbstractType *at, void *dflt);
|
|
||||||
|
|
||||||
JANET_API Janet janet_dyn(const char *name);
|
JANET_API Janet janet_dyn(const char *name);
|
||||||
JANET_API void janet_setdyn(const char *name, Janet value);
|
JANET_API void janet_setdyn(const char *name, Janet value);
|
||||||
|
|
||||||
|
|||||||
@@ -20,17 +20,12 @@
|
|||||||
* IN THE SOFTWARE.
|
* IN THE SOFTWARE.
|
||||||
*/
|
*/
|
||||||
|
|
||||||
/* This is an example janetconf.h file. This will be usually generated
|
/* Configure Janet. Edit this file to customize the build */
|
||||||
* by the build system. */
|
|
||||||
|
|
||||||
#ifndef JANETCONF_H
|
#ifndef JANETCONF_H
|
||||||
#define JANETCONF_H
|
#define JANETCONF_H
|
||||||
|
|
||||||
#define JANET_VERSION_MAJOR 1
|
#define JANET_VERSION "0.6.0"
|
||||||
#define JANET_VERSION_MINOR 4
|
|
||||||
#define JANET_VERSION_PATCH 0
|
|
||||||
#define JANET_VERSION_EXTRA ""
|
|
||||||
#define JANET_VERSION "1.4.0"
|
|
||||||
|
|
||||||
/* #define JANET_BUILD "local" */
|
/* #define JANET_BUILD "local" */
|
||||||
|
|
||||||
@@ -40,23 +35,15 @@
|
|||||||
/* #define JANET_NO_NANBOX */
|
/* #define JANET_NO_NANBOX */
|
||||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
/* #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_ASSEMBLER */
|
||||||
/* #define JANET_NO_PEG */
|
/* #define JANET_NO_PEG */
|
||||||
/* #define JANET_NO_TYPED_ARRAY */
|
/* #define JANET_NO_TYPED_ARRAY */
|
||||||
/* #define JANET_NO_INT_TYPES */
|
/* #define JANET_NO_INT_TYPES */
|
||||||
|
/* #define JANET_REDUCED_OS */
|
||||||
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
|
||||||
/* #define JANET_RECURSION_GUARD 1024 */
|
/* #define JANET_RECURSION_GUARD 1024 */
|
||||||
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
/* #define JANET_MAX_PROTO_DEPTH 200 */
|
||||||
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
/* #define JANET_MAX_MACRO_EXPAND 200 */
|
||||||
/* #define JANET_STACK_MAX 16384 */
|
/* #define JANET_STACK_MAX 16384 */
|
||||||
/* #define JANET_OS_NAME my-custom-os */
|
|
||||||
/* #define JANET_ARCH_NAME pdp-8 */
|
|
||||||
|
|
||||||
#endif /* end of include guard: JANETCONF_H */
|
#endif /* end of include guard: JANETCONF_H */
|
||||||
@@ -11,14 +11,13 @@
|
|||||||
(var *colorize* true)
|
(var *colorize* true)
|
||||||
(var *compile-only* false)
|
(var *compile-only* false)
|
||||||
|
|
||||||
(if-let [jp (os/getenv "JANET_PATH")] (setdyn :syspath jp))
|
(if-let [jp (os/getenv "JANET_PATH")] (set module/*syspath* jp))
|
||||||
(if-let [jp (os/getenv "JANET_HEADERPATH")] (setdyn :headerpath jp))
|
(if-let [jp (os/getenv "JANET_HEADERPATH")] (set module/*headerpath* jp))
|
||||||
(def args (dyn :args))
|
|
||||||
|
|
||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers :private
|
(def handlers :private
|
||||||
{"h" (fn [&]
|
{"h" (fn [&]
|
||||||
(print "usage: " (get args 0) " [options] script args...")
|
(print "usage: " (get process/args 0) " [options] script args...")
|
||||||
(print
|
(print
|
||||||
`Options are:
|
`Options are:
|
||||||
-h : Show this help
|
-h : Show this help
|
||||||
@@ -43,20 +42,20 @@
|
|||||||
"q" (fn [&] (set *quiet* true) 1)
|
"q" (fn [&] (set *quiet* true) 1)
|
||||||
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
|
||||||
"n" (fn [&] (set *colorize* false) 1)
|
"n" (fn [&] (set *colorize* false) 1)
|
||||||
"m" (fn [i &] (setdyn :syspath (get args (+ i 1))) 2)
|
"m" (fn [i &] (set module/*syspath* (get process/args (+ i 1))) 2)
|
||||||
"c" (fn [i &]
|
"c" (fn [i &]
|
||||||
(def e (dofile (get args (+ i 1))))
|
(def e (require (get process/args (+ i 1))))
|
||||||
(spit (get args (+ i 2)) (make-image e))
|
(spit (get process/args (+ i 2)) (make-image e))
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
3)
|
3)
|
||||||
"-" (fn [&] (set *handleopts* false) 1)
|
"-" (fn [&] (set *handleopts* false) 1)
|
||||||
"l" (fn [i &]
|
"l" (fn [i &]
|
||||||
(import* (get args (+ i 1))
|
(import* (get process/args (+ i 1))
|
||||||
:prefix "" :exit *exit-on-error*)
|
:prefix "" :exit *exit-on-error*)
|
||||||
2)
|
2)
|
||||||
"e" (fn [i &]
|
"e" (fn [i &]
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
(eval-string (get args (+ i 1)))
|
(eval-string (get process/args (+ i 1)))
|
||||||
2)})
|
2)})
|
||||||
|
|
||||||
(defn- dohandler [n i &]
|
(defn- dohandler [n i &]
|
||||||
@@ -64,15 +63,15 @@
|
|||||||
(if h (h i) (do (print "unknown flag -" n) ((get handlers "h")))))
|
(if h (h i) (do (print "unknown flag -" n) ((get handlers "h")))))
|
||||||
|
|
||||||
# Process arguments
|
# Process arguments
|
||||||
(var i 0)
|
(var i 1)
|
||||||
(def lenargs (length args))
|
(def lenargs (length process/args))
|
||||||
(while (< i lenargs)
|
(while (< i lenargs)
|
||||||
(def arg (get args i))
|
(def arg (get process/args i))
|
||||||
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
(if (and *handleopts* (= "-" (string/slice arg 0 1)))
|
||||||
(+= i (dohandler (string/slice arg 1 2) i))
|
(+= i (dohandler (string/slice arg 1 2) i))
|
||||||
(do
|
(do
|
||||||
(set *no-file* false)
|
(set *no-file* false)
|
||||||
(dofile arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
(import* arg :prefix "" :exit *exit-on-error* :compile-only *compile-only*)
|
||||||
(set i lenargs))))
|
(set i lenargs))))
|
||||||
|
|
||||||
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
(when (and (not *compile-only*) (or *should-repl* *no-file*))
|
||||||
@@ -80,8 +79,8 @@
|
|||||||
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2019 Calvin Rose"))
|
||||||
(defn noprompt [_] "")
|
(defn noprompt [_] "")
|
||||||
(defn getprompt [p]
|
(defn getprompt [p]
|
||||||
(def [line] (parser/where p))
|
(def offset (parser/where p))
|
||||||
(string "janet:" line ":" (parser/state p :delimiters) "> "))
|
(string "janet:" offset ":" (parser/state p) "> "))
|
||||||
(def prompter (if *quiet* noprompt getprompt))
|
(def prompter (if *quiet* noprompt getprompt))
|
||||||
(defn getstdin [prompt buf]
|
(defn getstdin [prompt buf]
|
||||||
(file/write stdout prompt)
|
(file/write stdout prompt)
|
||||||
@@ -91,6 +90,5 @@
|
|||||||
(defn getchunk [buf p]
|
(defn getchunk [buf p]
|
||||||
(getter (prompter p) buf))
|
(getter (prompter p) buf))
|
||||||
(def onsig (if *quiet* (fn [x &] x) nil))
|
(def onsig (if *quiet* (fn [x &] x) nil))
|
||||||
(setdyn :pretty-format (if *colorize* "%.20Q" "%.20q"))
|
(setdyn :pretty-format (if *colorize* "%.20P" "%.20p"))
|
||||||
(setdyn :err-color (if *colorize* true))
|
|
||||||
(repl getchunk onsig)))
|
(repl getchunk onsig)))
|
||||||
|
|||||||
@@ -32,12 +32,11 @@ Janet janet_line_getter(int32_t argc, Janet *argv) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void simpleline(JanetBuffer *buffer) {
|
static void simpleline(JanetBuffer *buffer) {
|
||||||
FILE *in = janet_dynfile("in", stdin);
|
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
int c;
|
int c;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
c = fgetc(in);
|
c = fgetc(stdin);
|
||||||
if (feof(in) || c < 0) {
|
if (feof(stdin) || c < 0) {
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
janet_buffer_push_u8(buffer, (uint8_t) c);
|
janet_buffer_push_u8(buffer, (uint8_t) c);
|
||||||
@@ -57,9 +56,7 @@ void janet_line_deinit() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
FILE *out = janet_dynfile("out", stdout);
|
fputs(p, stdout);
|
||||||
fputs(p, out);
|
|
||||||
fflush(out);
|
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -87,18 +84,18 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
|
|||||||
/* static state */
|
/* static state */
|
||||||
#define JANET_LINE_MAX 1024
|
#define JANET_LINE_MAX 1024
|
||||||
#define JANET_HISTORY_MAX 100
|
#define JANET_HISTORY_MAX 100
|
||||||
static int gbl_israwmode = 0;
|
static int israwmode = 0;
|
||||||
static const char *gbl_prompt = "> ";
|
static const char *prompt = "> ";
|
||||||
static int gbl_plen = 2;
|
static int plen = 2;
|
||||||
static char gbl_buf[JANET_LINE_MAX];
|
static char buf[JANET_LINE_MAX];
|
||||||
static int gbl_len = 0;
|
static int len = 0;
|
||||||
static int gbl_pos = 0;
|
static int pos = 0;
|
||||||
static int gbl_cols = 80;
|
static int cols = 80;
|
||||||
static char *gbl_history[JANET_HISTORY_MAX];
|
static char *history[JANET_HISTORY_MAX];
|
||||||
static int gbl_history_count = 0;
|
static int history_count = 0;
|
||||||
static int gbl_historyi = 0;
|
static int historyi = 0;
|
||||||
static int gbl_sigint_flag = 0;
|
static int sigint_flag = 0;
|
||||||
static struct termios gbl_termios_start;
|
static struct termios termios_start;
|
||||||
|
|
||||||
/* Unsupported terminal list from linenoise */
|
/* Unsupported terminal list from linenoise */
|
||||||
static const char *badterms[] = {
|
static const char *badterms[] = {
|
||||||
@@ -121,8 +118,8 @@ static char *sdup(const char *s) {
|
|||||||
static int rawmode() {
|
static int rawmode() {
|
||||||
struct termios t;
|
struct termios t;
|
||||||
if (!isatty(STDIN_FILENO)) goto fatal;
|
if (!isatty(STDIN_FILENO)) goto fatal;
|
||||||
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
|
if (tcgetattr(STDIN_FILENO, &termios_start) == -1) goto fatal;
|
||||||
t = gbl_termios_start;
|
t = termios_start;
|
||||||
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
t.c_iflag &= ~(BRKINT | ICRNL | INPCK | ISTRIP | IXON);
|
||||||
t.c_oflag &= ~(OPOST);
|
t.c_oflag &= ~(OPOST);
|
||||||
t.c_cflag |= (CS8);
|
t.c_cflag |= (CS8);
|
||||||
@@ -130,7 +127,7 @@ static int rawmode() {
|
|||||||
t.c_cc[VMIN] = 1;
|
t.c_cc[VMIN] = 1;
|
||||||
t.c_cc[VTIME] = 0;
|
t.c_cc[VTIME] = 0;
|
||||||
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
if (tcsetattr(STDIN_FILENO, TCSAFLUSH, &t) < 0) goto fatal;
|
||||||
gbl_israwmode = 1;
|
israwmode = 1;
|
||||||
return 0;
|
return 0;
|
||||||
fatal:
|
fatal:
|
||||||
errno = ENOTTY;
|
errno = ENOTTY;
|
||||||
@@ -139,8 +136,8 @@ fatal:
|
|||||||
|
|
||||||
/* Disable raw mode */
|
/* Disable raw mode */
|
||||||
static void norawmode() {
|
static void norawmode() {
|
||||||
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
|
if (israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &termios_start) != -1)
|
||||||
gbl_israwmode = 0;
|
israwmode = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int curpos() {
|
static int curpos() {
|
||||||
@@ -171,9 +168,7 @@ static int getcols() {
|
|||||||
if (cols > start) {
|
if (cols > start) {
|
||||||
char seq[32];
|
char seq[32];
|
||||||
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
snprintf(seq, 32, "\x1b[%dD", cols - start);
|
||||||
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {
|
if (write(STDOUT_FILENO, seq, strlen(seq)) == -1) {}
|
||||||
exit(1);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
return cols;
|
return cols;
|
||||||
} else {
|
} else {
|
||||||
@@ -184,9 +179,7 @@ failed:
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void clear() {
|
static void clear() {
|
||||||
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {
|
if (write(STDOUT_FILENO, "\x1b[H\x1b[2J", 7) <= 0) {}
|
||||||
exit(1);
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
static void refresh() {
|
static void refresh() {
|
||||||
@@ -194,40 +187,38 @@ static void refresh() {
|
|||||||
JanetBuffer b;
|
JanetBuffer b;
|
||||||
|
|
||||||
/* Keep cursor position on screen */
|
/* Keep cursor position on screen */
|
||||||
char *_buf = gbl_buf;
|
char *_buf = buf;
|
||||||
int _len = gbl_len;
|
int _len = len;
|
||||||
int _pos = gbl_pos;
|
int _pos = pos;
|
||||||
while ((gbl_plen + _pos) >= gbl_cols) {
|
while ((plen + _pos) >= cols) {
|
||||||
_buf++;
|
_buf++;
|
||||||
_len--;
|
_len--;
|
||||||
_pos--;
|
_pos--;
|
||||||
}
|
}
|
||||||
while ((gbl_plen + _len) > gbl_cols) {
|
while ((plen + _len) > cols) {
|
||||||
_len--;
|
_len--;
|
||||||
}
|
}
|
||||||
|
|
||||||
janet_buffer_init(&b, 0);
|
janet_buffer_init(&b, 0);
|
||||||
/* Cursor to left edge, gbl_prompt and buffer */
|
/* Cursor to left edge, prompt and buffer */
|
||||||
janet_buffer_push_u8(&b, '\r');
|
janet_buffer_push_u8(&b, '\r');
|
||||||
janet_buffer_push_cstring(&b, gbl_prompt);
|
janet_buffer_push_cstring(&b, prompt);
|
||||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||||
/* Erase to right */
|
/* Erase to right */
|
||||||
janet_buffer_push_cstring(&b, "\x1b[0K");
|
janet_buffer_push_cstring(&b, "\x1b[0K");
|
||||||
/* Move cursor to original position. */
|
/* Move cursor to original position. */
|
||||||
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + gbl_plen));
|
snprintf(seq, 64, "\r\x1b[%dC", (int)(_pos + plen));
|
||||||
janet_buffer_push_cstring(&b, seq);
|
janet_buffer_push_cstring(&b, seq);
|
||||||
if (write(STDOUT_FILENO, b.data, b.count) == -1) {
|
if (write(STDOUT_FILENO, b.data, b.count) == -1) {}
|
||||||
exit(1);
|
|
||||||
}
|
|
||||||
janet_buffer_deinit(&b);
|
janet_buffer_deinit(&b);
|
||||||
}
|
}
|
||||||
|
|
||||||
static int insert(char c) {
|
static int insert(char c) {
|
||||||
if (gbl_len < JANET_LINE_MAX - 1) {
|
if (len < JANET_LINE_MAX - 1) {
|
||||||
if (gbl_len == gbl_pos) {
|
if (len == pos) {
|
||||||
gbl_buf[gbl_pos++] = c;
|
buf[pos++] = c;
|
||||||
gbl_buf[++gbl_len] = '\0';
|
buf[++len] = '\0';
|
||||||
if (gbl_plen + gbl_len < gbl_cols) {
|
if (plen + len < cols) {
|
||||||
/* Avoid a full update of the line in the
|
/* Avoid a full update of the line in the
|
||||||
* trivial case. */
|
* trivial case. */
|
||||||
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
if (write(STDOUT_FILENO, &c, 1) == -1) return -1;
|
||||||
@@ -235,9 +226,9 @@ static int insert(char c) {
|
|||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
memmove(gbl_buf + gbl_pos + 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
memmove(buf + pos + 1, buf + pos, len - pos);
|
||||||
gbl_buf[gbl_pos++] = c;
|
buf[pos++] = c;
|
||||||
gbl_buf[++gbl_len] = '\0';
|
buf[++len] = '\0';
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
@@ -245,21 +236,21 @@ static int insert(char c) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
static void historymove(int delta) {
|
static void historymove(int delta) {
|
||||||
if (gbl_history_count > 1) {
|
if (history_count > 1) {
|
||||||
free(gbl_history[gbl_historyi]);
|
free(history[historyi]);
|
||||||
gbl_history[gbl_historyi] = sdup(gbl_buf);
|
history[historyi] = sdup(buf);
|
||||||
|
|
||||||
gbl_historyi += delta;
|
historyi += delta;
|
||||||
if (gbl_historyi < 0) {
|
if (historyi < 0) {
|
||||||
gbl_historyi = 0;
|
historyi = 0;
|
||||||
return;
|
return;
|
||||||
} else if (gbl_historyi >= gbl_history_count) {
|
} else if (historyi >= history_count) {
|
||||||
gbl_historyi = gbl_history_count - 1;
|
historyi = history_count - 1;
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
strncpy(buf, history[historyi], JANET_LINE_MAX - 1);
|
||||||
gbl_pos = gbl_len = strlen(gbl_buf);
|
pos = len = strlen(buf);
|
||||||
gbl_buf[gbl_len] = '\0';
|
buf[len] = '\0';
|
||||||
|
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
@@ -267,62 +258,62 @@ static void historymove(int delta) {
|
|||||||
|
|
||||||
static void addhistory() {
|
static void addhistory() {
|
||||||
int i, len;
|
int i, len;
|
||||||
char *newline = sdup(gbl_buf);
|
char *newline = sdup(buf);
|
||||||
if (!newline) return;
|
if (!newline) return;
|
||||||
len = gbl_history_count;
|
len = history_count;
|
||||||
if (len < JANET_HISTORY_MAX) {
|
if (len < JANET_HISTORY_MAX) {
|
||||||
gbl_history[gbl_history_count++] = newline;
|
history[history_count++] = newline;
|
||||||
len++;
|
len++;
|
||||||
} else {
|
} else {
|
||||||
free(gbl_history[JANET_HISTORY_MAX - 1]);
|
free(history[JANET_HISTORY_MAX - 1]);
|
||||||
}
|
}
|
||||||
for (i = len - 1; i > 0; i--) {
|
for (i = len - 1; i > 0; i--) {
|
||||||
gbl_history[i] = gbl_history[i - 1];
|
history[i] = history[i - 1];
|
||||||
}
|
}
|
||||||
gbl_history[0] = newline;
|
history[0] = newline;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void replacehistory() {
|
static void replacehistory() {
|
||||||
char *newline = sdup(gbl_buf);
|
char *newline = sdup(buf);
|
||||||
if (!newline) return;
|
if (!newline) return;
|
||||||
free(gbl_history[0]);
|
free(history[0]);
|
||||||
gbl_history[0] = newline;
|
history[0] = newline;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void kleft() {
|
static void kleft() {
|
||||||
if (gbl_pos > 0) {
|
if (pos > 0) {
|
||||||
gbl_pos--;
|
pos--;
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void kright() {
|
static void kright() {
|
||||||
if (gbl_pos != gbl_len) {
|
if (pos != len) {
|
||||||
gbl_pos++;
|
pos++;
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static void kbackspace() {
|
static void kbackspace() {
|
||||||
if (gbl_pos > 0) {
|
if (pos > 0) {
|
||||||
memmove(gbl_buf + gbl_pos - 1, gbl_buf + gbl_pos, gbl_len - gbl_pos);
|
memmove(buf + pos - 1, buf + pos, len - pos);
|
||||||
gbl_pos--;
|
pos--;
|
||||||
gbl_buf[--gbl_len] = '\0';
|
buf[--len] = '\0';
|
||||||
refresh();
|
refresh();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
static int line() {
|
static int line() {
|
||||||
gbl_cols = getcols();
|
cols = getcols();
|
||||||
gbl_plen = 0;
|
plen = 0;
|
||||||
gbl_len = 0;
|
len = 0;
|
||||||
gbl_pos = 0;
|
pos = 0;
|
||||||
while (gbl_prompt[gbl_plen]) gbl_plen++;
|
while (prompt[plen]) plen++;
|
||||||
gbl_buf[0] = '\0';
|
buf[0] = '\0';
|
||||||
|
|
||||||
addhistory();
|
addhistory();
|
||||||
|
|
||||||
if (write(STDOUT_FILENO, gbl_prompt, gbl_plen) == -1) return -1;
|
if (write(STDOUT_FILENO, prompt, plen) == -1) return -1;
|
||||||
for (;;) {
|
for (;;) {
|
||||||
char c;
|
char c;
|
||||||
int nread;
|
int nread;
|
||||||
@@ -343,7 +334,7 @@ static int line() {
|
|||||||
return 0;
|
return 0;
|
||||||
case 3: /* ctrl-c */
|
case 3: /* ctrl-c */
|
||||||
errno = EAGAIN;
|
errno = EAGAIN;
|
||||||
gbl_sigint_flag = 1;
|
sigint_flag = 1;
|
||||||
return -1;
|
return -1;
|
||||||
case 127: /* backspace */
|
case 127: /* backspace */
|
||||||
case 8: /* ctrl-h */
|
case 8: /* ctrl-h */
|
||||||
@@ -358,8 +349,8 @@ static int line() {
|
|||||||
kright();
|
kright();
|
||||||
break;
|
break;
|
||||||
case 21:
|
case 21:
|
||||||
gbl_buf[0] = '\0';
|
buf[0] = '\0';
|
||||||
gbl_pos = gbl_len = 0;
|
pos = len = 0;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 26: /* ctrl-z */
|
case 26: /* ctrl-z */
|
||||||
@@ -405,11 +396,11 @@ static int line() {
|
|||||||
kleft();
|
kleft();
|
||||||
break;
|
break;
|
||||||
case 'H':
|
case 'H':
|
||||||
gbl_pos = 0;
|
pos = 0;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 'F':
|
case 'F':
|
||||||
gbl_pos = gbl_len;
|
pos = len;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -419,11 +410,11 @@ static int line() {
|
|||||||
default:
|
default:
|
||||||
break;
|
break;
|
||||||
case 'H':
|
case 'H':
|
||||||
gbl_pos = 0;
|
pos = 0;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
case 'F':
|
case 'F':
|
||||||
gbl_pos = gbl_len;
|
pos = len;
|
||||||
refresh();
|
refresh();
|
||||||
break;
|
break;
|
||||||
}
|
}
|
||||||
@@ -441,9 +432,9 @@ void janet_line_init() {
|
|||||||
void janet_line_deinit() {
|
void janet_line_deinit() {
|
||||||
int i;
|
int i;
|
||||||
norawmode();
|
norawmode();
|
||||||
for (i = 0; i < gbl_history_count; i++)
|
for (i = 0; i < history_count; i++)
|
||||||
free(gbl_history[i]);
|
free(history[i]);
|
||||||
gbl_historyi = 0;
|
historyi = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static int checktermsupport() {
|
static int checktermsupport() {
|
||||||
@@ -456,10 +447,9 @@ static int checktermsupport() {
|
|||||||
}
|
}
|
||||||
|
|
||||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||||
gbl_prompt = p;
|
prompt = p;
|
||||||
buffer->count = 0;
|
buffer->count = 0;
|
||||||
gbl_historyi = 0;
|
historyi = 0;
|
||||||
FILE *out = janet_dynfile("out", stdout);
|
|
||||||
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
if (!isatty(STDIN_FILENO) || !checktermsupport()) {
|
||||||
simpleline(buffer);
|
simpleline(buffer);
|
||||||
return;
|
return;
|
||||||
@@ -470,19 +460,19 @@ void janet_line_get(const char *p, JanetBuffer *buffer) {
|
|||||||
}
|
}
|
||||||
if (line()) {
|
if (line()) {
|
||||||
norawmode();
|
norawmode();
|
||||||
if (gbl_sigint_flag) {
|
if (sigint_flag) {
|
||||||
raise(SIGINT);
|
raise(SIGINT);
|
||||||
} else {
|
} else {
|
||||||
fputc('\n', out);
|
fputc('\n', stdout);
|
||||||
}
|
}
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
norawmode();
|
norawmode();
|
||||||
fputc('\n', out);
|
fputc('\n', stdout);
|
||||||
janet_buffer_ensure(buffer, gbl_len + 1, 2);
|
janet_buffer_ensure(buffer, len + 1, 2);
|
||||||
memcpy(buffer->data, gbl_buf, gbl_len);
|
memcpy(buffer->data, buf, len);
|
||||||
buffer->data[gbl_len] = '\n';
|
buffer->data[len] = '\n';
|
||||||
buffer->count = gbl_len + 1;
|
buffer->count = len + 1;
|
||||||
replacehistory();
|
replacehistory();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -25,7 +25,6 @@
|
|||||||
|
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
#include <windows.h>
|
#include <windows.h>
|
||||||
#include <shlwapi.h>
|
|
||||||
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
#ifndef ENABLE_VIRTUAL_TERMINAL_PROCESSING
|
||||||
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
#define ENABLE_VIRTUAL_TERMINAL_PROCESSING 0x0004
|
||||||
#endif
|
#endif
|
||||||
@@ -39,33 +38,13 @@ int main(int argc, char **argv) {
|
|||||||
JanetArray *args;
|
JanetArray *args;
|
||||||
JanetTable *env;
|
JanetTable *env;
|
||||||
|
|
||||||
|
/* Enable color console on windows 10 console. */
|
||||||
#ifdef _WIN32
|
#ifdef _WIN32
|
||||||
/* Enable color console on windows 10 console and utf8 output. */
|
|
||||||
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
HANDLE hOut = GetStdHandle(STD_OUTPUT_HANDLE);
|
||||||
DWORD dwMode = 0;
|
DWORD dwMode = 0;
|
||||||
GetConsoleMode(hOut, &dwMode);
|
GetConsoleMode(hOut, &dwMode);
|
||||||
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
dwMode |= ENABLE_VIRTUAL_TERMINAL_PROCESSING;
|
||||||
SetConsoleMode(hOut, dwMode);
|
SetConsoleMode(hOut, dwMode);
|
||||||
SetConsoleOutputCP(65001);
|
|
||||||
|
|
||||||
/* Add directory containing janet.exe as DLL search path for
|
|
||||||
dynamic modules on windows. This is needed because dynamic modules reference
|
|
||||||
janet.exe for symbols. Otherwise, janet.exe would have to be in the current directory
|
|
||||||
to load natives correctly. */
|
|
||||||
#ifndef JANET_NO_DYNAMIC_MODULES
|
|
||||||
{
|
|
||||||
SetDefaultDllDirectories(LOAD_LIBRARY_SEARCH_USER_DIRS);
|
|
||||||
HMODULE hModule = GetModuleHandleW(NULL);
|
|
||||||
wchar_t path[MAX_PATH];
|
|
||||||
GetModuleFileNameW(hModule, path, MAX_PATH);
|
|
||||||
size_t i = wcsnlen(path, MAX_PATH);
|
|
||||||
while (i > 0 && path[i] != '\\')
|
|
||||||
path[i--] = '\0';
|
|
||||||
if (i) AddDllDirectory(path);
|
|
||||||
GetCurrentDirectoryW(MAX_PATH, path);
|
|
||||||
AddDllDirectory(path);
|
|
||||||
}
|
|
||||||
#endif
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* Set up VM */
|
/* Set up VM */
|
||||||
@@ -81,12 +60,9 @@ int main(int argc, char **argv) {
|
|||||||
|
|
||||||
/* Create args tuple */
|
/* Create args tuple */
|
||||||
args = janet_array(argc);
|
args = janet_array(argc);
|
||||||
for (i = 1; i < argc; i++)
|
for (i = 0; i < argc; i++)
|
||||||
janet_array_push(args, janet_cstringv(argv[i]));
|
janet_array_push(args, janet_cstringv(argv[i]));
|
||||||
janet_table_put(env, janet_ckeywordv("args"), janet_wrap_array(args));
|
janet_def(env, "process/args", janet_wrap_array(args), "Command line arguments.");
|
||||||
|
|
||||||
/* Save current executable path to (dyn :executable) */
|
|
||||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
|
||||||
|
|
||||||
/* Run startup script */
|
/* Run startup script */
|
||||||
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
status = janet_dobytes(env, janet_gen_init, janet_gen_init_size, "init.janet", NULL);
|
||||||
|
|||||||
@@ -6,7 +6,7 @@
|
|||||||
(setdyn :pretty-format "%.20P")
|
(setdyn :pretty-format "%.20P")
|
||||||
(repl (fn get-line [buf p]
|
(repl (fn get-line [buf p]
|
||||||
(def offset (parser/where p))
|
(def offset (parser/where p))
|
||||||
(def prompt (string "janet:" offset ":" (parser/state p :delimiters) "> "))
|
(def prompt (string "janet:" offset ":" (parser/state p) "> "))
|
||||||
(repl-yield prompt buf)
|
(repl-yield prompt buf)
|
||||||
(yield)
|
(yield)
|
||||||
buf))))
|
buf))))
|
||||||
|
|||||||
3
test/install/.gitignore
vendored
3
test/install/.gitignore
vendored
@@ -1,4 +1 @@
|
|||||||
/build
|
/build
|
||||||
.cache
|
|
||||||
.manifest
|
|
||||||
json.*
|
|
||||||
|
|||||||
@@ -5,6 +5,3 @@
|
|||||||
:name "testmod"
|
:name "testmod"
|
||||||
:source @["testmod.c"])
|
:source @["testmod.c"])
|
||||||
|
|
||||||
(declare-executable
|
|
||||||
:name "testexec"
|
|
||||||
:entry "testexec.janet")
|
|
||||||
|
|||||||
@@ -1,5 +0,0 @@
|
|||||||
(use build/testmod)
|
|
||||||
|
|
||||||
(defn main [&]
|
|
||||||
(print "Hello from executable!")
|
|
||||||
(print (get5)))
|
|
||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 0)
|
(start-suite 0)
|
||||||
|
|
||||||
(assert (= 10 (+ 1 2 3 4)) "addition")
|
(assert (= 10 (+ 1 2 3 4)) "addition")
|
||||||
@@ -303,16 +303,5 @@
|
|||||||
# Regression Test
|
# Regression Test
|
||||||
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
(assert (= 1 (((compile '(fn [] 1) @{})))) "regression test")
|
||||||
|
|
||||||
# Regression Test #137
|
|
||||||
(def [a b c] (range 10))
|
|
||||||
(assert (= a 0) "regression #137 (1)")
|
|
||||||
(assert (= b 1) "regression #137 (2)")
|
|
||||||
(assert (= c 2) "regression #137 (3)")
|
|
||||||
|
|
||||||
(var [x y z] (range 10))
|
|
||||||
(assert (= x 0) "regression #137 (4)")
|
|
||||||
(assert (= y 1) "regression #137 (5)")
|
|
||||||
(assert (= z 2) "regression #137 (6)")
|
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 1)
|
(start-suite 1)
|
||||||
|
|
||||||
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
(assert (= 400 (math/sqrt 160000)) "sqrt(160000)=400")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 2)
|
(start-suite 2)
|
||||||
|
|
||||||
# Buffer stuff
|
# Buffer stuff
|
||||||
@@ -62,7 +62,8 @@
|
|||||||
|
|
||||||
# String functions
|
# String functions
|
||||||
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
(assert (= 3 (string/find "abc" " abcdefghijklmnop")) "string/find 1")
|
||||||
(assert (= 0 (string/find "A" "A")) "string/find 2")
|
(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? "" "foo") "string/has-prefix? 1")
|
||||||
(assert (string/has-prefix? "fo" "foo") "string/has-prefix? 2")
|
(assert (string/has-prefix? "fo" "foo") "string/has-prefix? 2")
|
||||||
(assert (not (string/has-prefix? "o" "foo")) "string/has-prefix? 3")
|
(assert (not (string/has-prefix? "o" "foo")) "string/has-prefix? 3")
|
||||||
@@ -97,12 +98,6 @@
|
|||||||
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
(assert (deep= (string/find-all "e" "onetwothree") @[2 9 10]) "string/find-all 1")
|
||||||
(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
|
(assert (deep= (string/find-all "," "onetwothree") @[]) "string/find-all 2")
|
||||||
|
|
||||||
(assert-error "string/find error 1" (string/find "" "abcd"))
|
|
||||||
(assert-error "string/split error 1" (string/split "" "abcd"))
|
|
||||||
(assert-error "string/replace error 1" (string/replace "" "." "abcd"))
|
|
||||||
(assert-error "string/replace-all error 1" (string/replace-all "" "." "abcdabcd"))
|
|
||||||
(assert-error "string/find-all error 1" (string/find-all "" "abcd"))
|
|
||||||
|
|
||||||
# Check if abstract test works
|
# Check if abstract test works
|
||||||
(assert (abstract? stdout) "abstract? stdout")
|
(assert (abstract? stdout) "abstract? stdout")
|
||||||
(assert (abstract? stdin) "abstract? stdin")
|
(assert (abstract? stdin) "abstract? stdin")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 3)
|
(start-suite 3)
|
||||||
|
|
||||||
(assert (= (length (range 10)) 10) "(range 10)")
|
(assert (= (length (range 10)) 10) "(range 10)")
|
||||||
@@ -78,15 +78,11 @@
|
|||||||
|
|
||||||
# Another regression test - no segfaults
|
# Another regression test - no segfaults
|
||||||
(defn afn [x] x)
|
(defn afn [x] x)
|
||||||
(var afn-var afn)
|
(assert (= 1 (try (afn) ([err] 1))) "bad arity 1")
|
||||||
(var identity-var identity)
|
|
||||||
(var map-var map)
|
|
||||||
(var not-var not)
|
|
||||||
(assert (= 1 (try (afn-var) ([err] 1))) "bad arity 1")
|
|
||||||
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
(assert (= 4 (try ((fn [x y] (+ x y)) 1) ([_] 4))) "bad arity 2")
|
||||||
(assert (= 1 (try (identity-var) ([err] 1))) "bad arity 3")
|
(assert (= 1 (try (identity) ([err] 1))) "bad arity 3")
|
||||||
(assert (= 1 (try (map-var) ([err] 1))) "bad arity 4")
|
(assert (= 1 (try (map) ([err] 1))) "bad arity 4")
|
||||||
(assert (= 1 (try (not-var) ([err] 1))) "bad arity 5")
|
(assert (= 1 (try (not) ([err] 1))) "bad arity 5")
|
||||||
|
|
||||||
# Assembly test
|
# Assembly test
|
||||||
# Fibonacci sequence, implemented with naive recursion.
|
# Fibonacci sequence, implemented with naive recursion.
|
||||||
@@ -117,9 +113,9 @@
|
|||||||
|
|
||||||
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
(assert (= 1 ({:ok 1} :ok)) "calling struct")
|
||||||
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
(assert (= 2 (@{:ok 2} :ok)) "calling table")
|
||||||
(assert (= :bad (try ((identity @{:ok 2}) :ok :no) ([err] :bad))) "calling table too many arguments")
|
(assert (= :bad (try (@{:ok 2} :ok :no) ([err] :bad))) "calling table too many arguments")
|
||||||
(assert (= :bad (try ((identity :ok) @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
(assert (= :bad (try (:ok @{:ok 2} :no) ([err] :bad))) "calling keyword too many arguments")
|
||||||
(assert (= :oops (try ((+ 2 -1) 1) ([err] :oops))) "calling number fails")
|
(assert (= :oops (try (1 1) ([err] :oops))) "calling number fails")
|
||||||
|
|
||||||
# Method test
|
# Method test
|
||||||
|
|
||||||
@@ -360,38 +356,6 @@
|
|||||||
(check-match janet-longstring "``` `` ```" true)
|
(check-match janet-longstring "``` `` ```" true)
|
||||||
(check-match janet-longstring "`` ```" false)
|
(check-match janet-longstring "`` ```" false)
|
||||||
|
|
||||||
# Backmatch
|
|
||||||
|
|
||||||
(def backmatcher-1 '(* (capture (any "x") :1) "y" (backmatch :1) -1))
|
|
||||||
|
|
||||||
(check-match backmatcher-1 "y" true)
|
|
||||||
(check-match backmatcher-1 "xyx" true)
|
|
||||||
(check-match backmatcher-1 "xxxxxxxyxxxxxxx" true)
|
|
||||||
(check-match backmatcher-1 "xyxx" false)
|
|
||||||
(check-match backmatcher-1 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
|
||||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y") false)
|
|
||||||
(check-match backmatcher-1 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
|
||||||
|
|
||||||
(def backmatcher-2 '(* '(any "x") "y" (backmatch) -1))
|
|
||||||
|
|
||||||
(check-match backmatcher-2 "y" true)
|
|
||||||
(check-match backmatcher-2 "xyx" true)
|
|
||||||
(check-match backmatcher-2 "xxxxxxxyxxxxxxx" true)
|
|
||||||
(check-match backmatcher-2 "xyxx" false)
|
|
||||||
(check-match backmatcher-2 "xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxy" false)
|
|
||||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y") false)
|
|
||||||
(check-match backmatcher-2 (string (string/repeat "x" 10000) "y" (string/repeat "x" 10000)) true)
|
|
||||||
|
|
||||||
(def longstring-2 '(* '(some "`") (some (if-not (backmatch) 1)) (backmatch) -1))
|
|
||||||
|
|
||||||
(check-match longstring-2 "`john" false)
|
|
||||||
(check-match longstring-2 "abc" false)
|
|
||||||
(check-match longstring-2 "` `" true)
|
|
||||||
(check-match longstring-2 "` `" true)
|
|
||||||
(check-match longstring-2 "`` ``" true)
|
|
||||||
(check-match longstring-2 "``` `` ```" true)
|
|
||||||
(check-match longstring-2 "`` ```" false)
|
|
||||||
|
|
||||||
# Optional
|
# Optional
|
||||||
|
|
||||||
(check-match '(* (opt "hi") -1) "" true)
|
(check-match '(* (opt "hi") -1) "" true)
|
||||||
@@ -425,22 +389,4 @@
|
|||||||
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
|
(assert (= (tuple/type (-> '(1 2 3) marshal unmarshal)) :parens) "normal tuple marshalled/unmarshalled")
|
||||||
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
|
(assert (= (tuple/type (-> '[1 2 3] marshal unmarshal)) :brackets) "normal tuple marshalled/unmarshalled")
|
||||||
|
|
||||||
# Check for bad memoization (+ :a) should mean different things in different contexts.
|
|
||||||
(def redef-a
|
|
||||||
~{:a "abc"
|
|
||||||
:c (+ :a)
|
|
||||||
:main (* :c {:a "def" :main (+ :a)} -1)})
|
|
||||||
|
|
||||||
(check-match redef-a "abcdef" true)
|
|
||||||
(check-match redef-a "abcabc" false)
|
|
||||||
(check-match redef-a "defdef" false)
|
|
||||||
|
|
||||||
(def redef-b
|
|
||||||
~{:pork {:pork "beef" :main (+ -1 (* 1 :pork))}
|
|
||||||
:main :pork})
|
|
||||||
|
|
||||||
(check-match redef-b "abeef" true)
|
|
||||||
(check-match redef-b "aabeef" false)
|
|
||||||
(check-match redef-b "aaaaaa" false)
|
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 4)
|
(start-suite 4)
|
||||||
# some tests for string/format and buffer/format
|
# 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
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 5)
|
(start-suite 5)
|
||||||
|
|
||||||
# some tests typed array
|
# some tests typed array
|
||||||
@@ -54,7 +54,6 @@
|
|||||||
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
(assert (= (a 2) (b 1) ) "tarray views pointing same buffer")
|
||||||
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
(assert (= ((tarray/slice b) 3) (b 3) (a 6) 6) "tarray slice")
|
||||||
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
(assert (= ((tarray/slice b 1) 2) (b 3) (a 6) 6) "tarray slice")
|
||||||
(assert (= (:length a) (length a)) "length method and function")
|
|
||||||
|
|
||||||
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
(assert (= ((unmarshal (marshal b)) 3) (b 3)) "marshal")
|
||||||
|
|
||||||
@@ -81,49 +80,13 @@
|
|||||||
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
(assert-no-error "break 3" (for i 0 10 (if (> i 8) (break i))))
|
||||||
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
(assert-no-error "break 4" ((fn [i] (if (> i 8) (break i))) 100))
|
||||||
|
|
||||||
# take
|
|
||||||
|
|
||||||
(assert (deep= (take 0 []) []) "take 1")
|
|
||||||
(assert (deep= (take 10 []) []) "take 2")
|
|
||||||
(assert (deep= (take 0 [1 2 3 4 5]) []) "take 3")
|
|
||||||
(assert (deep= (take 10 [1 2 3]) [1 2 3]) "take 4")
|
|
||||||
(assert (deep= (take -1 [:a :b :c]) []) "take 5")
|
|
||||||
(assert-error :invalid-type (take 3 {}) "take 6")
|
|
||||||
|
|
||||||
# take-until
|
|
||||||
|
|
||||||
(assert (deep= (take-until pos? @[]) []) "take-until 1")
|
|
||||||
(assert (deep= (take-until pos? @[1 2 3]) []) "take-until 2")
|
|
||||||
(assert (deep= (take-until pos? @[-1 -2 -3]) [-1 -2 -3]) "take-until 3")
|
|
||||||
(assert (deep= (take-until pos? @[-1 -2 3]) [-1 -2]) "take-until 4")
|
|
||||||
(assert (deep= (take-until pos? @[-1 1 -2]) [-1]) "take-until 5")
|
|
||||||
(assert (deep= (take-until |(= $ 115) "books") "book") "take-until 6")
|
|
||||||
|
|
||||||
# take-while
|
|
||||||
|
|
||||||
(assert (deep= (take-while neg? @[]) []) "take-while 1")
|
|
||||||
(assert (deep= (take-while neg? @[1 2 3]) []) "take-while 2")
|
|
||||||
(assert (deep= (take-while neg? @[-1 -2 -3]) [-1 -2 -3]) "take-while 3")
|
|
||||||
(assert (deep= (take-while neg? @[-1 -2 3]) [-1 -2]) "take-while 4")
|
|
||||||
(assert (deep= (take-while neg? @[-1 1 -2]) [-1]) "take-while 5")
|
|
||||||
|
|
||||||
# drop
|
|
||||||
|
|
||||||
(assert (deep= (drop 0 []) []) "drop 1")
|
|
||||||
(assert (deep= (drop 10 []) []) "drop 2")
|
|
||||||
(assert (deep= (drop 0 [1 2 3 4 5]) [1 2 3 4 5]) "drop 3")
|
|
||||||
(assert (deep= (drop 10 [1 2 3]) []) "drop 4")
|
|
||||||
(assert (deep= (drop -2 [:a :b :c]) [:a :b :c]) "drop 5")
|
|
||||||
(assert-error :invalid-type (drop 3 {}) "drop 6")
|
|
||||||
|
|
||||||
# drop-until
|
# drop-until
|
||||||
|
|
||||||
(assert (deep= (drop-until pos? @[]) []) "drop-until 1")
|
(assert (deep= (drop-until pos? @[]) @[]) "drop-until 1")
|
||||||
(assert (deep= (drop-until pos? @[1 2 3]) [1 2 3]) "drop-until 2")
|
(assert (deep= (drop-until pos? @[1 2 3]) @[1 2 3]) "drop-until 2")
|
||||||
(assert (deep= (drop-until pos? @[-1 -2 -3]) []) "drop-until 3")
|
(assert (deep= (drop-until pos? @[-1 -2 -3]) @[]) "drop-until 3")
|
||||||
(assert (deep= (drop-until pos? @[-1 -2 3]) [3]) "drop-until 4")
|
(assert (deep= (drop-until pos? @[-1 -2 3]) @[3]) "drop-until 4")
|
||||||
(assert (deep= (drop-until pos? @[-1 1 -2]) [1 -2]) "drop-until 5")
|
(assert (deep= (drop-until pos? @[-1 1 -2]) @[1 -2]) "drop-until 5")
|
||||||
(assert (deep= (drop-until |(= $ 115) "books") "s") "drop-until 6")
|
|
||||||
|
|
||||||
# Quasiquote bracketed tuples
|
# Quasiquote bracketed tuples
|
||||||
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
|
(assert (= (tuple/type ~[1 2 3]) (tuple/type '[1 2 3])) "quasiquote bracket tuples")
|
||||||
|
|||||||
@@ -18,7 +18,7 @@
|
|||||||
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||||
# IN THE SOFTWARE.
|
# IN THE SOFTWARE.
|
||||||
|
|
||||||
(import ./helper :prefix "" :exit true)
|
(import test/helper :prefix "" :exit true)
|
||||||
(start-suite 6)
|
(start-suite 6)
|
||||||
|
|
||||||
# some tests for bigint
|
# some tests for bigint
|
||||||
@@ -109,57 +109,4 @@
|
|||||||
(comment 1 2 3)
|
(comment 1 2 3)
|
||||||
(comment 1 2 3 4)
|
(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)
|
(end-suite)
|
||||||
|
|||||||
@@ -1,173 +0,0 @@
|
|||||||
# 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")
|
|
||||||
|
|
||||||
#
|
|
||||||
# fn compilation special
|
|
||||||
#
|
|
||||||
(defn myfn1 [[x y z] & more]
|
|
||||||
more)
|
|
||||||
(defn myfn2 [head & more]
|
|
||||||
more)
|
|
||||||
(assert (= (myfn1 [1 2 3] 4 5 6) (myfn2 [:a :b :c] 4 5 6)) "destructuring and varargs")
|
|
||||||
|
|
||||||
#
|
|
||||||
# Test propagation of signals via fibers
|
|
||||||
#
|
|
||||||
|
|
||||||
(def f (fiber/new (fn [] (error :abc) 1) :ei))
|
|
||||||
(def res (resume f))
|
|
||||||
(assert-error :abc (propagate res f) "propagate 1")
|
|
||||||
|
|
||||||
# table/clone
|
|
||||||
|
|
||||||
(defn check-table-clone [x msg]
|
|
||||||
(assert (= (table/to-struct x) (table/to-struct (table/clone x))) msg))
|
|
||||||
|
|
||||||
(check-table-clone @{:a 123 :b 34 :c :hello : 945 0 1 2 3 4 5} "table/clone 1")
|
|
||||||
(check-table-clone @{} "table/clone 1")
|
|
||||||
|
|
||||||
# Issue #142
|
|
||||||
|
|
||||||
(def buffer (tarray/buffer 8))
|
|
||||||
(def buffer-float64-view (tarray/new :float64 1 1 0 buffer))
|
|
||||||
(def buffer-uint32-view (tarray/new :uint32 2 1 0 buffer))
|
|
||||||
|
|
||||||
(set (buffer-uint32-view 1) 0xfffe9234)
|
|
||||||
(set (buffer-uint32-view 0) 0x56789abc)
|
|
||||||
|
|
||||||
(assert (buffer-float64-view 0) "issue #142 nanbox hijack 1")
|
|
||||||
(assert (= (type (buffer-float64-view 0)) :number) "issue #142 nanbox hijack 2")
|
|
||||||
(assert (= (type (unmarshal @"\xC8\xbc\x9axV4\x92\xfe\xff")) :number) "issue #142 nanbox hijack 3")
|
|
||||||
|
|
||||||
# Make sure Carriage Returns don't end up in doc strings.
|
|
||||||
|
|
||||||
(assert (not (string/find "\r" (get ((fiber/getenv (fiber/current)) 'cond) :doc))) "no \\r in doc strings")
|
|
||||||
|
|
||||||
# module/expand-path regression
|
|
||||||
(with-dyns [:syspath ".janet/.janet"]
|
|
||||||
(assert (= (string (module/expand-path "hello" ":sys:/:all:.janet"))
|
|
||||||
".janet/.janet/hello.janet") "module/expand-path 1"))
|
|
||||||
|
|
||||||
# comp should be variadic
|
|
||||||
(assert (= 10 ((comp +) 1 2 3 4)) "variadic comp 1")
|
|
||||||
(assert (= 11 ((comp inc +) 1 2 3 4)) "variadic comp 2")
|
|
||||||
(assert (= 12 ((comp inc inc +) 1 2 3 4)) "variadic comp 3")
|
|
||||||
(assert (= 13 ((comp inc inc inc +) 1 2 3 4)) "variadic comp 4")
|
|
||||||
(assert (= 14 ((comp inc inc inc inc +) 1 2 3 4)) "variadic comp 5")
|
|
||||||
(assert (= 15 ((comp inc inc inc inc inc +) 1 2 3 4)) "variadic comp 6")
|
|
||||||
(assert (= 16 ((comp inc inc inc inc inc inc +) 1 2 3 4)) "variadic comp 7")
|
|
||||||
|
|
||||||
# Function shorthand
|
|
||||||
(assert (= (|(+ 1 2 3)) 6) "function shorthand 1")
|
|
||||||
(assert (= (|(+ 1 2 3 $) 4) 10) "function shorthand 2")
|
|
||||||
(assert (= (|(+ 1 2 3 $0) 4) 10) "function shorthand 3")
|
|
||||||
(assert (= (|(+ $0 $0 $0 $0) 4) 16) "function shorthand 4")
|
|
||||||
(assert (= (|(+ $ $ $ $) 4) 16) "function shorthand 5")
|
|
||||||
(assert (= (|4) 4) "function shorthand 6")
|
|
||||||
(assert (= (((|||4))) 4) "function shorthand 7")
|
|
||||||
(assert (= (|(+ $1 $1 $1 $1) 2 4) 16) "function shorthand 8")
|
|
||||||
(assert (= (|(+ $0 $1 $3 $2 $6) 0 1 2 3 4 5 6) 12) "function shorthand 9")
|
|
||||||
(assert (= (|(+ $0 $99) ;(range 100)) 99) "function shorthand 10")
|
|
||||||
|
|
||||||
# Simple function break
|
|
||||||
(debug/fbreak map 1)
|
|
||||||
(def f (fiber/new (fn [] (map inc [1 2 3])) :a))
|
|
||||||
(resume f)
|
|
||||||
(assert (= :debug (fiber/status f)) "debug/fbreak")
|
|
||||||
(debug/unfbreak map 1)
|
|
||||||
(map inc [1 2 3])
|
|
||||||
|
|
||||||
(defn idx= [x y] (= (tuple/slice x) (tuple/slice y)))
|
|
||||||
|
|
||||||
# Simple take, drop, etc. tests.
|
|
||||||
(assert (idx= (take 10 (range 100)) (range 10)) "take 10")
|
|
||||||
(assert (idx= (drop 10 (range 100)) (range 10 100)) "drop 10")
|
|
||||||
|
|
||||||
(end-suite)
|
|
||||||
@@ -1,12 +1,14 @@
|
|||||||
# Creates an amalgamated janet.c
|
# Creates an amalgamated janet.c
|
||||||
|
|
||||||
# Head
|
# Head
|
||||||
|
(def {:year YY :month MM :month-day DD} (os/date))
|
||||||
(print "/* Amalgamated build - DO NOT EDIT */")
|
(print "/* Amalgamated build - DO NOT EDIT */")
|
||||||
(print "/* Generated from janet version " janet/version "-" janet/build " */")
|
(print "/* Generated " YY "-" (inc MM) "-" (inc DD)
|
||||||
|
" with janet version " janet/version "-" janet/build " */")
|
||||||
(print "#define JANET_BUILD \"" janet/build "\"")
|
(print "#define JANET_BUILD \"" janet/build "\"")
|
||||||
(print ```#define JANET_AMALG```)
|
(print ```#define JANET_AMALG```)
|
||||||
(print ```#include "janet.h"```)
|
(print ```#include "janet.h"```)
|
||||||
|
|
||||||
# Body
|
# Body
|
||||||
(each path (tuple/slice (dyn :args) 1)
|
(each path (tuple/slice process/args 2)
|
||||||
(print (slurp path)))
|
(print (slurp path)))
|
||||||
|
|||||||
55
tools/bars.janet
Normal file
55
tools/bars.janet
Normal file
@@ -0,0 +1,55 @@
|
|||||||
|
# A flexible templater for janet. Compiles
|
||||||
|
# templates to janet functions that produce buffers.
|
||||||
|
|
||||||
|
(defn template
|
||||||
|
"Compile a template string into a function"
|
||||||
|
[source]
|
||||||
|
|
||||||
|
# State for compilation machine
|
||||||
|
(def p (parser/new))
|
||||||
|
(def forms @[])
|
||||||
|
|
||||||
|
(defn parse-chunk
|
||||||
|
"Parse a string and push produced values to forms."
|
||||||
|
[chunk]
|
||||||
|
(parser/consume p chunk)
|
||||||
|
(while (parser/has-more p)
|
||||||
|
(array/push forms (parser/produce p)))
|
||||||
|
(if (= :error (parser/status p))
|
||||||
|
(error (parser/error p))))
|
||||||
|
|
||||||
|
(defn code-chunk
|
||||||
|
"Parse all the forms in str and return them
|
||||||
|
in a tuple prefixed with 'do."
|
||||||
|
[str]
|
||||||
|
(parse-chunk str)
|
||||||
|
true)
|
||||||
|
|
||||||
|
(defn string-chunk
|
||||||
|
"Insert string chunk into parser"
|
||||||
|
[str]
|
||||||
|
(parser/insert p str)
|
||||||
|
(parse-chunk "")
|
||||||
|
true)
|
||||||
|
|
||||||
|
# Run peg
|
||||||
|
(def grammar
|
||||||
|
~{:code-chunk (* "{%" (drop (cmt '(any (if-not "%}" 1)) ,code-chunk)) "%}")
|
||||||
|
:main-chunk (drop (cmt '(any (if-not "{%" 1)) ,string-chunk))
|
||||||
|
:main (any (+ :code-chunk :main-chunk (error "")))})
|
||||||
|
(def parts (peg/match grammar source))
|
||||||
|
|
||||||
|
# Check errors in template and parser
|
||||||
|
(unless parts (error "invalid template syntax"))
|
||||||
|
(parse-chunk "\n")
|
||||||
|
(case (parser/status p)
|
||||||
|
:pending (error (string "unfinished parser state " (parser/state p)))
|
||||||
|
:error (error (parser/error p)))
|
||||||
|
|
||||||
|
# Make ast from forms
|
||||||
|
(def ast ~(fn [&opt params] (default params @{}) (,buffer ,;forms)))
|
||||||
|
|
||||||
|
(def ctor (compile ast (fiber/getenv (fiber/current)) source))
|
||||||
|
(if-not (function? ctor)
|
||||||
|
(error (string "could not compile template")))
|
||||||
|
(ctor))
|
||||||
363
tools/cook.janet
Normal file
363
tools/cook.janet
Normal file
@@ -0,0 +1,363 @@
|
|||||||
|
### 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*
|
||||||
|
[path & args]
|
||||||
|
(def [realpath] (module/find path))
|
||||||
|
(def env (make-env))
|
||||||
|
(loop [k :keys _env :when (symbol? k)]
|
||||||
|
(unless ((_env k) :private) (put env k (_env k))))
|
||||||
|
(require path :env env ;args)
|
||||||
|
(when-let [rules (env :rules)] (merge-into (getrules) rules)))
|
||||||
|
|
||||||
|
(defmacro import-rules
|
||||||
|
"Import another file that defines more cook rules. This ruleset
|
||||||
|
is merged into the current ruleset."
|
||||||
|
[path & args]
|
||||||
|
~(,import-rules* ,(string path) ,;args))
|
||||||
|
|
||||||
|
#
|
||||||
|
# Configuration
|
||||||
|
#
|
||||||
|
|
||||||
|
# Installation settings
|
||||||
|
(def BINDIR (os/getenv "JANET_BINDIR"))
|
||||||
|
(def LIBDIR (or (os/getenv "JANET_PATH") module/*syspath*))
|
||||||
|
(def INCLUDEDIR (or (os/getenv "JANET_HEADERPATH") module/*headerpath*))
|
||||||
|
|
||||||
|
# Compilation settings
|
||||||
|
(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||||
|
(def CC (or (os/getenv "CC") (if is-win "cl" "cc")))
|
||||||
|
(def LD (or (os/getenv "LINKER") (if is-win "link" CC)))
|
||||||
|
(def LDFLAGS (or (os/getenv "LFLAGS")
|
||||||
|
(if is-win " /nologo"
|
||||||
|
(string " -shared"
|
||||||
|
(if is-mac " -undefined dynamic_lookup" "")))))
|
||||||
|
(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic")))
|
||||||
|
|
||||||
|
(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 cmd (string/join args))
|
||||||
|
(print cmd)
|
||||||
|
(def res (os/shell cmd))
|
||||||
|
(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]
|
||||||
|
(shell (if is-win "xcopy " "cp -rf ") src " " dest (if is-win " /h /y /t /e" "")))
|
||||||
|
|
||||||
|
#
|
||||||
|
# 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]
|
||||||
|
(string (opt opts :cflags CFLAGS)
|
||||||
|
(if is-win " /I" " -I")
|
||||||
|
(opt opts :includedir INCLUDEDIR)
|
||||||
|
(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 CC))
|
||||||
|
(def cflags (getcflags opts))
|
||||||
|
(def defines (interpose " " (make-defines (opt opts :defines {}))))
|
||||||
|
(rule 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 (opt opts :linker LD))
|
||||||
|
(def cflags (getcflags opts))
|
||||||
|
(def lflags (opt opts :lflags LDFLAGS))
|
||||||
|
(def olist (string/join objects " "))
|
||||||
|
(rule target objects
|
||||||
|
(if is-win
|
||||||
|
(shell ld " " lflags " /DLL /OUT:" target " " olist " " (opt opts :includedir INCLUDEDIR) "\\janet.lib")
|
||||||
|
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||||
|
|
||||||
|
(defn- create-buffer-c
|
||||||
|
"Inline raw byte file as a c file."
|
||||||
|
[source dest name]
|
||||||
|
(rule 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.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 libdir (opt opts :libdir LIBDIR))
|
||||||
|
(install-rule lname LIBDIR))
|
||||||
|
|
||||||
|
(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 libdir (opt opts :libdir LIBDIR))
|
||||||
|
(each s sources
|
||||||
|
(install-rule s libdir)))
|
||||||
|
|
||||||
|
(defn declare-binscript
|
||||||
|
"Declare a janet file to be installed as an executable script."
|
||||||
|
[&keys opts]
|
||||||
|
(def main (opts :main))
|
||||||
|
(def bindir (opt opts :bindir BINDIR))
|
||||||
|
(install-rule main bindir))
|
||||||
|
|
||||||
|
(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 libdir (opt opts :libdir LIBDIR))
|
||||||
|
(install-rule iname libdir))
|
||||||
|
|
||||||
|
(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.")))
|
||||||
@@ -104,7 +104,6 @@
|
|||||||
# Generate parts and print them to stdout
|
# Generate parts and print them to stdout
|
||||||
(def parts (seq [[k entry]
|
(def parts (seq [[k entry]
|
||||||
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
|
:in (sort (pairs (table/getproto (fiber/getenv (fiber/current)))))
|
||||||
:when (symbol? k)
|
|
||||||
:when (and (get entry :doc) (not (get entry :private)))]
|
:when (and (get entry :doc) (not (get entry :private)))]
|
||||||
(emit-item k entry)))
|
(emit-item k entry)))
|
||||||
(print
|
(print
|
||||||
|
|||||||
198
tools/highlight.janet
Normal file
198
tools/highlight.janet
Normal file
@@ -0,0 +1,198 @@
|
|||||||
|
# Copyright (C) Calvin Rose 2019
|
||||||
|
#
|
||||||
|
# Takes in a janet string and colorizes for multiple
|
||||||
|
# output formats.
|
||||||
|
|
||||||
|
# Constants for checking if symbols should be
|
||||||
|
# highlighted.
|
||||||
|
(def- core-env (table/getproto *env*))
|
||||||
|
(def- specials {'fn true
|
||||||
|
'var true
|
||||||
|
'do true
|
||||||
|
'while true
|
||||||
|
'def true
|
||||||
|
'splice true
|
||||||
|
'set true
|
||||||
|
'break true
|
||||||
|
'unquote true
|
||||||
|
'quasiquote true
|
||||||
|
'quote true
|
||||||
|
'if true})
|
||||||
|
|
||||||
|
(defn check-number [text] (and (scan-number text) text))
|
||||||
|
|
||||||
|
(defn- make-grammar
|
||||||
|
"Creates the grammar based on the paint function, which
|
||||||
|
colorizes fragments of text."
|
||||||
|
[paint]
|
||||||
|
|
||||||
|
(defn <-c
|
||||||
|
"Peg rule for capturing and coloring a rule."
|
||||||
|
[color what]
|
||||||
|
~(/ (<- ,what) ,(partial paint color)))
|
||||||
|
|
||||||
|
(defn color-symbol
|
||||||
|
"Color a symbol only if it is a core library binding or special."
|
||||||
|
[text]
|
||||||
|
(def sym (symbol text))
|
||||||
|
(def should-color (or (specials sym) (core-env sym)))
|
||||||
|
(paint (if should-color :coresym :symbol) text))
|
||||||
|
|
||||||
|
~{:ws (set " \t\r\f\n\v\0")
|
||||||
|
:readermac (set "';~,")
|
||||||
|
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") (set "!$%&*+-./:<?=>@^_|"))
|
||||||
|
:token (some :symchars)
|
||||||
|
:hex (range "09" "af" "AF")
|
||||||
|
:escape (* "\\" (+ (set "ntrvzf0\"\\e")
|
||||||
|
(* "x" :hex :hex)
|
||||||
|
(error (constant "bad hex escape"))))
|
||||||
|
|
||||||
|
:comment ,(<-c :comment ~(* "#" (any (if-not (+ "\n" -1) 1))))
|
||||||
|
|
||||||
|
:symbol (/ ':token ,color-symbol)
|
||||||
|
:keyword ,(<-c :keyword ~(* ":" (any :symchars)))
|
||||||
|
:constant ,(<-c :constant ~(+ "true" "false" "nil"))
|
||||||
|
:bytes (* "\"" (any (+ :escape (if-not "\"" 1))) "\"")
|
||||||
|
:string ,(<-c :string :bytes)
|
||||||
|
:buffer ,(<-c :string ~(* "@" :bytes))
|
||||||
|
:long-bytes {:delim (some "`")
|
||||||
|
:open (capture :delim :n)
|
||||||
|
:close (cmt (* (not (> -1 "`")) (-> :n) ':delim) ,=)
|
||||||
|
:main (drop (* :open (any (if-not :close 1)) :close))}
|
||||||
|
:long-string ,(<-c :string :long-bytes)
|
||||||
|
:long-buffer ,(<-c :string ~(* "@" :long-bytes))
|
||||||
|
:number (/ (cmt ':token ,check-number) ,(partial paint :number))
|
||||||
|
|
||||||
|
:raw-value (+ :comment :constant :number :keyword
|
||||||
|
:string :buffer :long-string :long-buffer
|
||||||
|
:parray :barray :ptuple :btuple :struct :dict :symbol)
|
||||||
|
|
||||||
|
:value (* (? '(some (+ :ws :readermac))) :raw-value '(any :ws))
|
||||||
|
:root (any :value)
|
||||||
|
:root2 (any (* :value :value))
|
||||||
|
:ptuple (* '"(" :root (+ '")" (error "")))
|
||||||
|
:btuple (* '"[" :root (+ '"]" (error "")))
|
||||||
|
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||||
|
:parray (* '"@" :ptuple)
|
||||||
|
:barray (* '"@" :btuple)
|
||||||
|
:dict (* '"@" :struct)
|
||||||
|
|
||||||
|
:main (+ (% :root) (error ""))})
|
||||||
|
|
||||||
|
# Terminal syntax highlighting
|
||||||
|
|
||||||
|
(def- terminal-colors
|
||||||
|
{:number 32
|
||||||
|
:keyword 33
|
||||||
|
:string 35
|
||||||
|
:coresym 31
|
||||||
|
:constant 34
|
||||||
|
:comment 36})
|
||||||
|
|
||||||
|
(defn- terminal-paint
|
||||||
|
"Paint colors for ansi terminals"
|
||||||
|
[what str]
|
||||||
|
(def code (get terminal-colors what))
|
||||||
|
(if code (string "\e[" code "m" str "\e[0m") str))
|
||||||
|
|
||||||
|
# HTML syntax highlighting
|
||||||
|
|
||||||
|
(def- html-colors
|
||||||
|
{:number "j-number"
|
||||||
|
:keyword "j-keyword"
|
||||||
|
:string "j-string"
|
||||||
|
:coresym "j-coresym"
|
||||||
|
:constant "j-constant"
|
||||||
|
:comment "j-comment"
|
||||||
|
:line "j-line"})
|
||||||
|
|
||||||
|
(def- escapes
|
||||||
|
{38 "&"
|
||||||
|
60 "<"
|
||||||
|
62 ">"
|
||||||
|
34 """
|
||||||
|
39 "'"
|
||||||
|
47 "/"})
|
||||||
|
|
||||||
|
(def html-style
|
||||||
|
"Style tag to add to a page to highlight janet code"
|
||||||
|
```
|
||||||
|
<style type="text/css">
|
||||||
|
.j-main { color: white; background: #111; font-size: 1.4em; }
|
||||||
|
.j-number { color: #89dc76; }
|
||||||
|
.j-keyword { color: #ffd866; }
|
||||||
|
.j-string { color: #ab90f2; }
|
||||||
|
.j-coresym { color: #ff6188; }
|
||||||
|
.j-constant { color: #fc9867; }
|
||||||
|
.j-comment { color: darkgray; }
|
||||||
|
.j-line { color: gray; }
|
||||||
|
</style>
|
||||||
|
```)
|
||||||
|
|
||||||
|
(defn html-escape
|
||||||
|
"Escape special characters for HTML encoding."
|
||||||
|
[str]
|
||||||
|
(def buf @"")
|
||||||
|
(loop [byte :in str]
|
||||||
|
(if-let [rep (get escapes byte)]
|
||||||
|
(buffer/push-string buf rep)
|
||||||
|
(buffer/push-byte buf byte)))
|
||||||
|
buf)
|
||||||
|
|
||||||
|
(defn- html-paint
|
||||||
|
"Paint colors for HTML"
|
||||||
|
[what str]
|
||||||
|
(def color (get html-colors what))
|
||||||
|
(def escaped (html-escape str))
|
||||||
|
(if color
|
||||||
|
(string "<span class=\"" color "\">" escaped "</span>")
|
||||||
|
escaped))
|
||||||
|
|
||||||
|
# Create Pegs
|
||||||
|
|
||||||
|
(def- terminal-grammar (peg/compile (make-grammar terminal-paint)))
|
||||||
|
(def- html-grammar (peg/compile (make-grammar html-paint)))
|
||||||
|
|
||||||
|
# API
|
||||||
|
|
||||||
|
(defn ansi
|
||||||
|
"Highlight janet source code ANSI Termianl escape colors."
|
||||||
|
[source]
|
||||||
|
(0 (peg/match terminal-grammar source)))
|
||||||
|
|
||||||
|
(defn html
|
||||||
|
"Highlight janet source code and output HTML."
|
||||||
|
[source]
|
||||||
|
(string "<pre class=\"j-main\"><code>"
|
||||||
|
(0 (peg/match html-grammar source))
|
||||||
|
"</code></pre>"))
|
||||||
|
|
||||||
|
(defn html-file
|
||||||
|
"Highlight a janet file and print out a highlighted HTML version
|
||||||
|
of the file. Must provide a default title when creating the file."
|
||||||
|
[in-path out-path title &]
|
||||||
|
(default title in-path)
|
||||||
|
(def f (file/open in-path :r))
|
||||||
|
(def source (file/read f :all))
|
||||||
|
(file/close f)
|
||||||
|
(def markup (0 (peg/match html-grammar source)))
|
||||||
|
(def out (file/open out-path :w))
|
||||||
|
(file/write out
|
||||||
|
"<!doctype html><html><head><meta charset=\"UTF-8\">"
|
||||||
|
html-style
|
||||||
|
"<title>"
|
||||||
|
title
|
||||||
|
"</title></head>"
|
||||||
|
"<body class=\"j-main\"><pre>"
|
||||||
|
markup
|
||||||
|
"</pre></body></html>")
|
||||||
|
(file/close out))
|
||||||
|
|
||||||
|
(defn ansi-file
|
||||||
|
"Highlight a janet file and print the highlighted output to stdout."
|
||||||
|
[in-path]
|
||||||
|
(def f (file/open in-path :r))
|
||||||
|
(def source (file/read f :all))
|
||||||
|
(file/close f)
|
||||||
|
(def markup (0 (peg/match terminal-grammar source)))
|
||||||
|
(print markup))
|
||||||
39
tools/jpm
Executable file
39
tools/jpm
Executable file
@@ -0,0 +1,39 @@
|
|||||||
|
#!/usr/bin/env janet
|
||||||
|
|
||||||
|
# CLI tool for building janet projects. Wraps cook.
|
||||||
|
|
||||||
|
(import cook :prefix "")
|
||||||
|
|
||||||
|
(import-rules "./project.janet")
|
||||||
|
|
||||||
|
(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:
|
||||||
|
--libdir : The directory to install modules to. Defaults to $JANET_PATH or module/*syspath*
|
||||||
|
--includedir : The directory containing janet headers. Defaults to $JANET_HEADERPATH or module/*headerpath*
|
||||||
|
--bindir : The directory to install binaries and scripts. Defaults to $JANET_BINDIR.
|
||||||
|
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
|
||||||
|
--compiler : C compiler to use for natives. Defaults to $CC 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))
|
||||||
|
(each arg args
|
||||||
|
(if (string/has-prefix? "--" arg)
|
||||||
|
(let [[key value] (peg/match argpeg arg)]
|
||||||
|
(setdyn (keyword key) value))
|
||||||
|
(do-rule arg)))
|
||||||
|
|
||||||
|
(if (empty? args) (help))
|
||||||
@@ -1,4 +1,4 @@
|
|||||||
@echo off
|
@echo off
|
||||||
@rem Wrapper around jpm
|
@rem Wrapper arounf jpm
|
||||||
|
|
||||||
janet "%~dp0\jpm.janet" %*
|
janet %~dp0\jpm.janet %*
|
||||||
|
|||||||
Binary file not shown.
@@ -1,9 +0,0 @@
|
|||||||
# Remove carriage returns from file. Since piping things on
|
|
||||||
# windows may add bad line endings, we can just force removal
|
|
||||||
# with this script.
|
|
||||||
(def fname ((dyn :args) 1))
|
|
||||||
(with [f (file/open fname :rb+)]
|
|
||||||
(def source (:read f :all))
|
|
||||||
(def new-source (string/replace-all "\r" "" source))
|
|
||||||
(:seek f :set 0)
|
|
||||||
(:write f new-source))
|
|
||||||
@@ -44,7 +44,8 @@ static int is_symbol_char_gen(uint8_t c) {
|
|||||||
c == '>' ||
|
c == '>' ||
|
||||||
c == '@' ||
|
c == '@' ||
|
||||||
c == '^' ||
|
c == '^' ||
|
||||||
c == '_');
|
c == '_' ||
|
||||||
|
c == '|');
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int main() {
|
||||||
|
|||||||
@@ -2,25 +2,6 @@
|
|||||||
# Used to help build the tmLanguage grammar. Emits
|
# Used to help build the tmLanguage grammar. Emits
|
||||||
# the entire .tmLanguage file for janet.
|
# 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
|
(def grammar-template
|
||||||
`````
|
`````
|
||||||
<?xml version="1.0" encoding="UTF-8"?>
|
<?xml version="1.0" encoding="UTF-8"?>
|
||||||
@@ -362,6 +343,22 @@
|
|||||||
|
|
||||||
# Now we generate the bindings in the language.
|
# 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
|
(def- escapes
|
||||||
{(get "|" 0) `\|`
|
{(get "|" 0) `\|`
|
||||||
(get "-" 0) `\-`
|
(get "-" 0) `\-`
|
||||||
|
|||||||
Reference in New Issue
Block a user