1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-24 11:14:48 +00:00

Compare commits

..

1 Commits
v1.4.0 ... jpm

Author SHA1 Message Date
Calvin Rose
be89d10004 Update NSIS installer. 2019-05-29 12:51:50 -04:00
76 changed files with 1648 additions and 4863 deletions

2
.gitattributes vendored
View File

@@ -0,0 +1,2 @@
# Use an approximate language for syntax highlighting (clojure is pretty close)
*.janet linguist-language=clojure

3
.gitignore vendored
View File

@@ -20,9 +20,6 @@ dist
.project .project
.cproject .cproject
# Gnome Builder
.buildconfig
# Local directory for testing # Local directory for testing
local local

View File

@@ -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.

View File

@@ -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

View File

@@ -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">

View File

@@ -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

View File

@@ -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)))))

View File

@@ -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

View File

@@ -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

View File

@@ -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
View File

@@ -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>

View File

@@ -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)

View File

@@ -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: '')

View File

@@ -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();

View File

@@ -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"

View File

@@ -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));
}

View File

@@ -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}

View File

@@ -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;

View File

@@ -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.")

View File

@@ -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, */

View File

@@ -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) {

View File

@@ -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) {

View File

@@ -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));
} }

View File

@@ -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);

View File

@@ -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."));

View File

@@ -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.")
}, },
{ {

View File

@@ -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,

View File

@@ -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");
}

View File

@@ -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 "

View File

@@ -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.")

View File

@@ -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,

View File

@@ -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}
}; };

View File

@@ -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,

View File

@@ -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 */

View File

@@ -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: {

View File

@@ -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;

View File

@@ -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;

View File

@@ -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 */

View File

@@ -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.")
}, },

View File

@@ -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}
}; };

View File

@@ -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}
}; };

View File

@@ -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);

View File

@@ -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

View File

@@ -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);

View File

@@ -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) */

View File

@@ -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

View File

@@ -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));

View File

@@ -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

View File

@@ -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);

View File

@@ -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 */

View File

@@ -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)))

View File

@@ -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();
} }

View File

@@ -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);

View File

@@ -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))))

View File

@@ -1,4 +1 @@
/build /build
.cache
.manifest
json.*

View File

@@ -5,6 +5,3 @@
:name "testmod" :name "testmod"
:source @["testmod.c"]) :source @["testmod.c"])
(declare-executable
:name "testexec"
:entry "testexec.janet")

View File

@@ -1,5 +0,0 @@
(use build/testmod)
(defn main [&]
(print "Hello from executable!")
(print (get5)))

View File

@@ -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)

View File

@@ -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")

View File

@@ -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")

View File

@@ -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)

View File

@@ -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

View File

@@ -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")

View File

@@ -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)

View File

@@ -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)

View File

@@ -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
View 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
View 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.")))

View File

@@ -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
View 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 "&amp;"
60 "&lt;"
62 "&gt;"
34 "&quot;"
39 "&#39;"
47 "&#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
View 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))

View File

@@ -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.

View File

@@ -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))

View File

@@ -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() {

View File

@@ -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) `\-`