mirror of
https://github.com/janet-lang/janet
synced 2026-04-02 21:11:27 +00:00
Compare commits
62 Commits
socket-ext
...
make-modul
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
196f27af3d | ||
|
|
42c0096ce7 | ||
|
|
0194115412 | ||
|
|
f33697d6a0 | ||
|
|
b2bf70eace | ||
|
|
855d1f2940 | ||
|
|
416bba9bd9 | ||
|
|
517e40a17b | ||
|
|
4f9a2af357 | ||
|
|
a37752708e | ||
|
|
5042ad6d4b | ||
|
|
643c0b4976 | ||
|
|
ecb72c9c9a | ||
|
|
a95546ff16 | ||
|
|
d47f82713b | ||
|
|
497e363401 | ||
|
|
8481da18d0 | ||
|
|
8f8382eead | ||
|
|
8e2ec997f0 | ||
|
|
ea271b6d6c | ||
|
|
e1897e1865 | ||
|
|
0c1585fdfe | ||
|
|
a5c4e929e8 | ||
|
|
4c21dc3c06 | ||
|
|
d67b462023 | ||
|
|
24ca108288 | ||
|
|
7366fbed1f | ||
|
|
797643716b | ||
|
|
eda2e11d31 | ||
|
|
ae0afe6198 | ||
|
|
33f5a0b319 | ||
|
|
3ecc9bc543 | ||
|
|
339b0751c8 | ||
|
|
87b1bf1a66 | ||
|
|
41354ada96 | ||
|
|
ee8d816738 | ||
|
|
0f285855f0 | ||
|
|
c43e06672c | ||
|
|
2fabc80151 | ||
|
|
4dd08a4cde | ||
|
|
883dde4fa5 | ||
|
|
6111291ede | ||
|
|
53b8bf2684 | ||
|
|
0c402cf3d6 | ||
|
|
606a1fc11a | ||
|
|
a2db57b9dc | ||
|
|
f021bb2839 | ||
|
|
979233dee5 | ||
|
|
78a785175a | ||
|
|
268864b072 | ||
|
|
06f099d7f9 | ||
|
|
6549903c51 | ||
|
|
c1dff351d9 | ||
|
|
4aa5615a37 | ||
|
|
67932bbaed | ||
|
|
4575cefb7e | ||
|
|
d5a014baff | ||
|
|
eb825772bb | ||
|
|
ee2985f5e3 | ||
|
|
5819408715 | ||
|
|
8fe284b5eb | ||
|
|
19b5502f50 |
11
CHANGELOG.md
11
CHANGELOG.md
@@ -2,9 +2,20 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Allow overriding the loader when doing imports with the `:loader` argument.
|
||||
- Allow importing modules with a path extension to do what one would expect.
|
||||
- Add `find-all` argument to `module/find`
|
||||
- Add :threads, :unmarshal, :compiler, and :asm sandbox flags.
|
||||
- Add support for persistent REPL history with the environment variable `JANET_HISTFILE`
|
||||
- Fix a number of fuzzer-found compiler bugs
|
||||
- Fix windows processes launching bug with empty environment table that caused process-launch failures.
|
||||
- Add `:I`, `:V`, and `:N` flags to `os/open` for more control when creating streams.
|
||||
- Add `ev/go-gather` for a dynamic `ev/gather`.
|
||||
- Use color in script output if color is being used in REPL output.
|
||||
- Fix `varfn` macros handling of extra metadata.
|
||||
- Disallow certain degenerate uses of fibers with the ev/ module.
|
||||
- Add linting for unused bindings.
|
||||
- Add linting for extra or wrong parameters to &named functions.
|
||||
- Add `janet_optuinteger` and `janet_optuinteger64` to the C API.
|
||||
- Add `cms` combinator to PEGs.
|
||||
- Add `thaw-keep-keys` as a variant of thaw
|
||||
|
||||
1
Makefile
1
Makefile
@@ -58,7 +58,6 @@ LDFLAGS?=-rdynamic
|
||||
LIBJANET_LDFLAGS?=$(LDFLAGS)
|
||||
RUN:=$(RUN)
|
||||
|
||||
|
||||
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden -fPIC
|
||||
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 $(COMMON_CFLAGS) -g
|
||||
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
|
||||
|
||||
56
README.md
56
README.md
@@ -148,8 +148,40 @@ You can get the source on [GitHub](https://github.com/janet-lang/janet) or
|
||||
[SourceHut](https://git.sr.ht/~bakpakin/janet). While the GitHub repo is the official repo,
|
||||
the SourceHut mirror is actively maintained.
|
||||
|
||||
## Spork and JPM
|
||||
|
||||
Spork and JPM are two companion projects to Janet. They are optional, especially in an embedding use case.
|
||||
|
||||
Spork is a collection of common utility modules, and several packaged scripts
|
||||
like `janet-format` for code formatting, `janet-netrepl` for a socket-based
|
||||
REPL, and `janet-pm` for a comprehensive Janet project manager tool. The
|
||||
modules in `spork` are less stable than the interfaces in core Janet, although
|
||||
we try to prevent breaking changes to existing modules, with a preference to
|
||||
add new modules and functions. Spork requires a C compiler to build and install
|
||||
various extenstion components such as miniz and JSON utilities. Many spork
|
||||
sub-modules, for example spork/path, are independent and can be manually
|
||||
vendored in programmer projects without fully installing spork.
|
||||
|
||||
When install Spork, scripts will be installed to $JANET_PATH/bin/ on POSIX systems by default.
|
||||
This likely needs to be added to the path to use these scripts.
|
||||
|
||||
JPM is the older, more opinionated, project manager tool, which has it's pros
|
||||
and cons. It does not require a C compiler to build and install, but is less
|
||||
flexible and is not receiving many changes and improvements going forward. It
|
||||
may also be harder to configure correctly on new systems. In that sense, it may
|
||||
be more stable.
|
||||
|
||||
JPM will install to /usr/local/bin/ on posix systems by default, which may or
|
||||
may not be on your PATH.
|
||||
|
||||
## Building
|
||||
|
||||
When building from source, for stability, please use the latest tagged release. For
|
||||
example, run `git checkout $(git describe --tags --abbrev=0)` after cloning but
|
||||
before building. For the latest development, build directly on the master
|
||||
branch. The master branch is not-necessarily stable as most Janet development
|
||||
happens directly on the master branch.
|
||||
|
||||
### macOS and Unix-like
|
||||
|
||||
The Makefile is non-portable and requires GNU-flavored make.
|
||||
@@ -160,15 +192,18 @@ make
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
make install-spork-git # optional
|
||||
make install-jpm-git # optional
|
||||
```
|
||||
|
||||
Find out more about the available make targets by running `make help`.
|
||||
|
||||
### Alpine Linux
|
||||
|
||||
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good combination. Janet can also
|
||||
be built inside a docker container or similar in this manner.
|
||||
To build a statically-linked build of Janet, Alpine Linux + MUSL is a good
|
||||
combination. Janet can also be built inside a docker container or similar in
|
||||
this manner. This is a great way to try Janet without committing to a full
|
||||
install or needing to customize the default install.
|
||||
|
||||
```sh
|
||||
docker run -it --rm alpine /bin/ash
|
||||
@@ -178,8 +213,13 @@ $ cd janet
|
||||
$ make -j10
|
||||
$ make test
|
||||
$ make install
|
||||
$ make install-spork-git # optional
|
||||
$ make install-jpm-git # optional
|
||||
```
|
||||
|
||||
Note that for a true statically-linked binary with MUSL, one needs to add `-static` to the Makefile flags. This
|
||||
will also disable runtime loading of native modules (plugins) as well as the FFI.
|
||||
|
||||
### 32-bit Haiku
|
||||
|
||||
32-bit Haiku build instructions are the same as the UNIX-like build instructions,
|
||||
@@ -191,7 +231,8 @@ make CC=gcc-x86
|
||||
make test
|
||||
make repl
|
||||
make install
|
||||
make install-jpm-git
|
||||
make install-spork-git # optional
|
||||
make install-jpm-git # optional
|
||||
```
|
||||
|
||||
### FreeBSD
|
||||
@@ -205,7 +246,8 @@ gmake
|
||||
gmake test
|
||||
gmake repl
|
||||
gmake install
|
||||
gmake install-jpm-git
|
||||
gmake install-spork-git # optional
|
||||
gmake install-jpm-git # optional
|
||||
```
|
||||
|
||||
### NetBSD
|
||||
@@ -320,8 +362,8 @@ If installed, you can also run `man janet` to get usage information.
|
||||
## Embedding
|
||||
|
||||
Janet can be embedded in a host program very easily. The normal build
|
||||
will create a file `build/janet.c`, which is a single C file
|
||||
that contains all the source to Janet. This file, along with
|
||||
will create a file `build/c/janet.c`, a C source code file that
|
||||
that contains the amalgamated source to Janet. This file, along with
|
||||
`src/include/janet.h` and `src/conf/janetconf.h`, can be dragged into any C
|
||||
project and compiled into it. Janet should be compiled with `-std=c99`
|
||||
on most compilers, and will need to be linked to the math library, `-lm`, and
|
||||
|
||||
8
janet.1
8
janet.1
@@ -156,7 +156,7 @@ Shows the version text and exits immediately.
|
||||
|
||||
.TP
|
||||
.BR \-s
|
||||
Read raw input from stdin and forgo prompt history and other readline-like features.
|
||||
Read raw input from stdin and forgo fancy input, which includes prompt history and other readline-like features.
|
||||
|
||||
.TP
|
||||
.BR \-e\ code
|
||||
@@ -272,6 +272,12 @@ This variable does nothing in the default configuration of Janet, as PRF is disa
|
||||
cannot be defined for this variable to have an effect.
|
||||
.RE
|
||||
|
||||
.B JANET_HISTFILE
|
||||
.RS
|
||||
A file location to use for the default shell's REPL history when using fancy input. This relative path is where commands are persisted between sessions.
|
||||
If unset, no repl history well be used. Does not work with the -s flag where fancy input is disabled.
|
||||
.RE
|
||||
|
||||
.B NO_COLOR
|
||||
.RS
|
||||
Turn off color by default in the repl and in the error handler of scripts. This can be changed at runtime
|
||||
|
||||
@@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2025 © Calvin Rose
|
||||
# Copyright 2026 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@@ -105,9 +105,9 @@
|
||||
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
|
||||
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
|
||||
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
|
||||
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
|
||||
(defn table? "Check if x a table." [x] (= (type x) :table))
|
||||
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
|
||||
(defn cfunction? "Check if x is a cfunction." [x] (= (type x) :cfunction))
|
||||
(defn table? "Check if x is a table." [x] (= (type x) :table))
|
||||
(defn struct? "Check if x is a struct." [x] (= (type x) :struct))
|
||||
(defn array? "Check if x is an array." [x] (= (type x) :array))
|
||||
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
|
||||
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
|
||||
@@ -115,7 +115,7 @@
|
||||
(defn true? "Check if x is true." [x] (= x true))
|
||||
(defn false? "Check if x is false." [x] (= x false))
|
||||
(defn nil? "Check if x is nil." [x] (= x nil))
|
||||
(defn empty? "Check if xs is empty." [xs] (= nil (next xs nil)))
|
||||
(defn empty? "Check if an iterable, `iter`, is empty." [iter] (= nil (next iter nil)))
|
||||
|
||||
# For macros, we define an incomplete odd? function that will be overridden.
|
||||
(defn odd? [x] (= 1 (mod x 2)))
|
||||
@@ -370,19 +370,24 @@
|
||||
(++ i))
|
||||
~(let (,;accum) ,;body))
|
||||
|
||||
(defmacro defer
|
||||
``Run `form` unconditionally after `body`, even if the body throws an error.
|
||||
Will also run `form` if a user signal 0-4 is received.``
|
||||
[form & body]
|
||||
(defn- defer-impl
|
||||
"Defer but allow custom name for stack traces"
|
||||
[name form body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
|
||||
(def ,f (,fiber/new (fn ,name [] ,;body) :ti))
|
||||
(def ,r (,resume ,f))
|
||||
,form
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
(,propagate ,r ,f)))))
|
||||
|
||||
(defmacro defer
|
||||
``Run `form` unconditionally after `body`, even if the body throws an error.
|
||||
Will also run `form` if a user signal 0-4 is received.``
|
||||
[form & body]
|
||||
(defer-impl :defer form body))
|
||||
|
||||
(defmacro edefer
|
||||
``Run `form` after `body` in the case that body terminates abnormally (an error or user signal 0-4).
|
||||
Otherwise, return last form in `body`.``
|
||||
@@ -436,14 +441,14 @@
|
||||
[[binding ctor dtor] & body]
|
||||
~(do
|
||||
(def ,binding ,ctor)
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
,(defer-impl :with [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro when-with
|
||||
``Similar to with, but if binding is false or nil, returns
|
||||
nil without evaluating the body. Otherwise, the same as `with`.``
|
||||
[[binding ctor dtor] & body]
|
||||
~(if-let [,binding ,ctor]
|
||||
,(apply defer [(or dtor :close) binding] body)))
|
||||
,(defer-impl :when-with [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro if-with
|
||||
``Similar to `with`, but if binding is false or nil, evaluates
|
||||
@@ -451,7 +456,7 @@
|
||||
`ctor` is bound to binding.``
|
||||
[[binding ctor dtor] truthy &opt falsey]
|
||||
~(if-let [,binding ,ctor]
|
||||
,(apply defer [(or dtor :close) binding] [truthy])
|
||||
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
|
||||
(defn- for-var-template
|
||||
@@ -2168,7 +2173,7 @@
|
||||
(defn expand-bindings [x]
|
||||
(case (type x)
|
||||
:array (map expand-bindings x)
|
||||
:tuple (tuple/slice (map expand-bindings x))
|
||||
:tuple (keep-syntax! x (map expand-bindings x))
|
||||
:table (dotable x expand-bindings)
|
||||
:struct (table/to-struct (dotable x expand-bindings))
|
||||
(recur x)))
|
||||
@@ -2176,11 +2181,11 @@
|
||||
(defn expanddef [t]
|
||||
(def last (in t (- (length t) 1)))
|
||||
(def bound (in t 1))
|
||||
(tuple/slice
|
||||
(array/concat
|
||||
@[(in t 0) (expand-bindings bound)]
|
||||
(tuple/slice t 2 -2)
|
||||
@[(recur last)])))
|
||||
(keep-syntax! t
|
||||
(array/concat
|
||||
@[(in t 0) (expand-bindings bound)]
|
||||
(tuple/slice t 2 -2)
|
||||
@[(recur last)])))
|
||||
|
||||
(defn expandall [t]
|
||||
(def args (map recur (tuple/slice t 1)))
|
||||
@@ -2191,10 +2196,10 @@
|
||||
(if (symbol? t1)
|
||||
(do
|
||||
(def args (map recur (tuple/slice t 3)))
|
||||
(tuple 'fn t1 (in t 2) ;args))
|
||||
(keep-syntax t (tuple 'fn t1 (in t 2) ;args)))
|
||||
(do
|
||||
(def args (map recur (tuple/slice t 2)))
|
||||
(tuple 'fn t1 ;args))))
|
||||
(keep-syntax t (tuple 'fn t1 ;args)))))
|
||||
|
||||
(defn expandqq [t]
|
||||
(defn qq [x]
|
||||
@@ -2840,7 +2845,8 @@
|
||||
(defmacro comptime
|
||||
"Evals x at compile time and returns the result. Similar to a top level unquote."
|
||||
[x]
|
||||
(eval x))
|
||||
(def y (eval x))
|
||||
y)
|
||||
|
||||
(defmacro compif
|
||||
"Check the condition `cnd` at compile time -- if truthy, compile `tru`, else compile `fals`."
|
||||
@@ -2918,6 +2924,7 @@
|
||||
(array/insert mp sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
|
||||
(def curall-index (find-prefix ":cur:/:all:"))
|
||||
(array/insert mp curall-index [(string ":cur:/:all:" ext) loader check-relative])
|
||||
(array/insert mp 0 [":all:" loader (fn :check-ext [x] (string/has-suffix? ext x))])
|
||||
mp)
|
||||
|
||||
# Don't expose this externally yet - could break if custom module/paths is setup.
|
||||
@@ -2970,20 +2977,22 @@
|
||||
or :image if the module is found, otherwise a tuple with nil followed by
|
||||
an error message.
|
||||
```
|
||||
[path]
|
||||
[path &opt find-all]
|
||||
(var ret nil)
|
||||
(def mp (dyn *module-paths* module/paths))
|
||||
(def all-matches (if find-all @[]))
|
||||
(each [p mod-kind checker] mp
|
||||
(when (mod-filter checker path)
|
||||
(if (function? p)
|
||||
(when-let [res (p path)]
|
||||
(set ret [res mod-kind])
|
||||
(break))
|
||||
(if find-all (array/push all-matches ret) (break)))
|
||||
(do
|
||||
(def fullpath (string (module/expand-path path p)))
|
||||
(when (fexists fullpath)
|
||||
(set ret [fullpath mod-kind])
|
||||
(break))))))
|
||||
(if find-all (array/push all-matches ret) (break)))))))
|
||||
(if find-all (break all-matches))
|
||||
(if ret ret
|
||||
(let [expander (fn :expander [[t _ chk]]
|
||||
(when (string? t)
|
||||
@@ -3158,17 +3167,20 @@
|
||||
|
||||
(defn- require-1
|
||||
[path args kargs]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(def [fullpath mod-kind]
|
||||
(if-let [loader (get kargs :loader)]
|
||||
[path loader]
|
||||
(module/find path)))
|
||||
(unless fullpath (error mod-kind))
|
||||
(def mc (dyn *module-cache* module/cache))
|
||||
(def ml (dyn *module-loading* module/loading))
|
||||
(def mls (dyn *module-loaders* module/loaders))
|
||||
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
|
||||
(if-let [check (if-not (get kargs :fresh) (in mc fullpath))]
|
||||
check
|
||||
(if (ml fullpath)
|
||||
(if (get ml fullpath)
|
||||
(error (string "circular dependency " fullpath " detected"))
|
||||
(do
|
||||
(def loader (if (keyword? mod-kind) (mls mod-kind) mod-kind))
|
||||
(def loader (if (keyword? mod-kind) (get mls mod-kind) mod-kind))
|
||||
(unless loader (error (string "module type " mod-kind " unknown")))
|
||||
(def env (loader fullpath args))
|
||||
(put mc fullpath env)
|
||||
@@ -3722,7 +3734,7 @@
|
||||
(def digits (inc (math/floor (math/log10 end))))
|
||||
(def fmt-str (string "%" digits "d: %s"))
|
||||
(for i beg end
|
||||
(eprin " ") # breakpoint someday?
|
||||
(eprin " ")
|
||||
(eprin (if (= i cur) "> " " "))
|
||||
(eprintf fmt-str i (get lines i))))
|
||||
(let [[sl _] (sourcemap pc)]
|
||||
@@ -3859,13 +3871,16 @@
|
||||
(defn ev/call
|
||||
```
|
||||
Call a function asynchronously.
|
||||
Returns a fiber that is scheduled to run the function.
|
||||
Returns a task fiber that is scheduled to run the function.
|
||||
```
|
||||
[f & args]
|
||||
(ev/go (fn :call [&] (f ;args))))
|
||||
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||
``
|
||||
Run some code in a new task fiber. This is shorthand for
|
||||
`(ev/go (fn [] ;body))`."
|
||||
``
|
||||
[& body]
|
||||
~(,ev/go (fn :spawn [&] ,;body)))
|
||||
|
||||
@@ -3938,23 +3953,33 @@
|
||||
(cancel-all chan fibers "sibling canceled")
|
||||
(propagate (fiber/last-value fiber) fiber))))))
|
||||
|
||||
(defn ev/go-gather
|
||||
```
|
||||
Run a dyanmic number of fibers in parallel and resume the current fiber after they complete. Takes
|
||||
an array of functions or fibers, `thunks`, that will be run via `ev/go` in another task.
|
||||
Returns the gathered results in an array.
|
||||
```
|
||||
[thunks]
|
||||
(def fset @{})
|
||||
(def chan (ev/chan))
|
||||
(def results @[])
|
||||
(each thunk thunks
|
||||
(def ftemp (ev/go thunk nil chan))
|
||||
(array/push results ftemp)
|
||||
(put fset ftemp ftemp))
|
||||
(wait-for-fibers chan fset)
|
||||
(for i 0 (length results) # avoid extra copy from map
|
||||
(set (results i) (fiber/last-value (in results i))))
|
||||
results)
|
||||
|
||||
(defmacro ev/gather
|
||||
``
|
||||
Run a number of fibers in parallel on the event loop, and join when they complete.
|
||||
Returns the gathered results in an array.
|
||||
Create and run a number of fibers in parallel (created from `bodies`) and resume the
|
||||
current fiber after they complete. Shorthand for `ev/go-gather`. Returns the gathered results in an
|
||||
array.
|
||||
``
|
||||
[& bodies]
|
||||
(with-syms [chan res fset ftemp]
|
||||
~(do
|
||||
(def ,fset @{})
|
||||
(def ,chan (,ev/chan))
|
||||
(def ,res @[])
|
||||
,;(seq [[i body] :pairs bodies]
|
||||
~(do
|
||||
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
|
||||
(,put ,fset ,ftemp ,ftemp)))
|
||||
(,wait-for-fibers ,chan ,fset)
|
||||
,res))))
|
||||
~(,ev/go-gather ,(seq [body :in bodies] ~(fn :ev/gather [] ,body)))))
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
(defn net/server
|
||||
@@ -4266,12 +4291,12 @@
|
||||
(try
|
||||
(require (string "@syspath/bundle/" bundle-name))
|
||||
([e f]
|
||||
(def pfx "could not find module @syspath/bundle/")
|
||||
(def msg (if (and (string? e)
|
||||
(string/has-prefix? pfx e))
|
||||
"bundle must contain bundle.janet or bundle/init.janet"
|
||||
e))
|
||||
(propagate msg f))))))
|
||||
(def pfx "could not find module @syspath/bundle/")
|
||||
(def msg (if (and (string? e)
|
||||
(string/has-prefix? pfx e))
|
||||
"bundle must contain bundle.janet or bundle/init.janet"
|
||||
e))
|
||||
(propagate msg f))))))
|
||||
|
||||
(defn- do-hook
|
||||
[module bundle-name hook & args]
|
||||
@@ -4403,8 +4428,8 @@
|
||||
(def bscript-src1 (string path s "bundle" s "init.janet"))
|
||||
(def bscript-src2 (string path s "bundle.janet"))
|
||||
(def bscript-src (cond
|
||||
(fexists bscript-src1) bscript-src1
|
||||
(fexists bscript-src2) bscript-src2))
|
||||
(fexists bscript-src1) bscript-src1
|
||||
(fexists bscript-src2) bscript-src2))
|
||||
# Setup installed paths
|
||||
(prime-bundle-paths)
|
||||
(os/mkdir (bundle-dir bundle-name))
|
||||
|
||||
@@ -201,4 +201,17 @@ int32_t janet_abstract_decref(void *abst) {
|
||||
return janet_atomic_dec(&janet_abstract_head(abst)->gc.data.refcount);
|
||||
}
|
||||
|
||||
int32_t janet_abstract_decref_maybe_free(void *abst) {
|
||||
int32_t result = janet_abstract_decref(abst);
|
||||
if (0 == result) {
|
||||
JanetAbstractHead *head = janet_abstract_head(abst);
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
/* Free memory */
|
||||
janet_free(head);
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -567,6 +567,13 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
|
||||
x = janet_get1(s, janet_ckeywordv("structarg"));
|
||||
if (janet_truthy(x)) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
|
||||
/* Check namedarg */
|
||||
x = janet_get1(s, janet_ckeywordv("namedargs"));
|
||||
if (janet_checkint(x)) {
|
||||
def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||
def->named_args_count = janet_unwrap_integer(x);
|
||||
}
|
||||
|
||||
/* Check source */
|
||||
x = janet_get1(s, janet_ckeywordv("source"));
|
||||
if (janet_checktype(x, JANET_STRING)) def->source = janet_unwrap_string(x);
|
||||
@@ -982,6 +989,14 @@ static Janet janet_disasm_structarg(JanetFuncDef *def) {
|
||||
return janet_wrap_boolean(def->flags & JANET_FUNCDEF_FLAG_STRUCTARG);
|
||||
}
|
||||
|
||||
static Janet janet_disasm_namedargs(JanetFuncDef *def) {
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS) {
|
||||
return janet_wrap_integer(def->named_args_count);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
}
|
||||
|
||||
static Janet janet_disasm_constants(JanetFuncDef *def) {
|
||||
JanetArray *constants = janet_array(def->constants_length);
|
||||
for (int32_t i = 0; i < def->constants_length; i++) {
|
||||
@@ -1032,6 +1047,7 @@ Janet janet_disasm(JanetFuncDef *def) {
|
||||
janet_table_put(ret, janet_ckeywordv("source"), janet_disasm_source(def));
|
||||
janet_table_put(ret, janet_ckeywordv("vararg"), janet_disasm_vararg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("structarg"), janet_disasm_structarg(def));
|
||||
janet_table_put(ret, janet_ckeywordv("namedargs"), janet_disasm_namedargs(def));
|
||||
janet_table_put(ret, janet_ckeywordv("name"), janet_disasm_name(def));
|
||||
janet_table_put(ret, janet_ckeywordv("slotcount"), janet_disasm_slotcount(def));
|
||||
janet_table_put(ret, janet_ckeywordv("symbolmap"), janet_disasm_symbolslots(def));
|
||||
@@ -1048,6 +1064,7 @@ JANET_CORE_FN(cfun_asm,
|
||||
"The syntax for the assembly can be found on the Janet website, and should correspond\n"
|
||||
"to the return value of disasm. Will throw an\n"
|
||||
"error on invalid assembly.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ASM);
|
||||
janet_fixarity(argc, 1);
|
||||
JanetAssembleResult res;
|
||||
res = janet_asm(argv[0], 0);
|
||||
@@ -1067,6 +1084,8 @@ JANET_CORE_FN(cfun_disasm,
|
||||
"* :min-arity - minimum number of arguments function can be called with.\n"
|
||||
"* :max-arity - maximum number of arguments function can be called with.\n"
|
||||
"* :vararg - true if function can take a variable number of arguments.\n"
|
||||
"* :structarg - true if function can take a variable number of arguments using the &keys option.\n"
|
||||
"* :namedargs - if function can take a variable number of arguments using the &named option, this will be the number of named arguments.\n"
|
||||
"* :bytecode - array of parsed bytecode instructions. Each instruction is a tuple.\n"
|
||||
"* :source - name of source file that this function was compiled from.\n"
|
||||
"* :name - name of function.\n"
|
||||
@@ -1076,6 +1095,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
"* :sourcemap - a mapping of each bytecode instruction to a line and column in the source file.\n"
|
||||
"* :environments - an internal mapping of which enclosing functions are referenced for bindings.\n"
|
||||
"* :defs - other function definitions that this function may instantiate.\n") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_ASM);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFunction *f = janet_getfunction(argv, 0);
|
||||
if (argc == 2) {
|
||||
@@ -1088,6 +1108,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
if (!janet_cstrcmp(kw, "name")) return janet_disasm_name(f->def);
|
||||
if (!janet_cstrcmp(kw, "vararg")) return janet_disasm_vararg(f->def);
|
||||
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
||||
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
|
||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
|
||||
@@ -74,6 +74,7 @@ JanetBuffer *janet_pointer_buffer_unsafe(void *memory, int32_t capacity, int32_t
|
||||
void janet_buffer_deinit(JanetBuffer *buffer) {
|
||||
if (!(buffer->gc.flags & JANET_BUFFER_FLAG_NO_REALLOC)) {
|
||||
janet_free(buffer->data);
|
||||
buffer->data = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -522,6 +522,7 @@ JanetFuncDef *janet_funcdef_alloc(void) {
|
||||
def->bytecode_length = 0;
|
||||
def->environments_length = 0;
|
||||
def->symbolmap_length = 0;
|
||||
def->named_args_count = 0;
|
||||
return def;
|
||||
}
|
||||
|
||||
|
||||
@@ -460,7 +460,7 @@ Janet janet_dyn(const char *name) {
|
||||
return janet_table_get(janet_vm.top_dyns, janet_ckeywordv(name));
|
||||
}
|
||||
if (janet_vm.fiber->env) {
|
||||
return janet_table_get(janet_vm.fiber->env, janet_ckeywordv(name));
|
||||
return janet_table_get_keyword(janet_vm.fiber->env, name);
|
||||
} else {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
@@ -295,7 +295,7 @@ JanetSlot janetc_resolve(
|
||||
{
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
if (binding.type == JANET_BINDING_NONE) {
|
||||
Janet handler = janet_table_get(c->env, janet_ckeywordv("missing-symbol"));
|
||||
Janet handler = janet_table_get_keyword(c->env, "missing-symbol");
|
||||
switch (janet_type(handler)) {
|
||||
case JANET_NIL:
|
||||
break;
|
||||
@@ -536,7 +536,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
||||
JanetScope unusedScope;
|
||||
int32_t bufstart = janet_v_count(c->buffer);
|
||||
int32_t mapbufstart = janet_v_count(c->mapbuffer);
|
||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unusued");
|
||||
janetc_scope(&unusedScope, c, JANET_SCOPE_UNUSED, "unused");
|
||||
janetc_value(opts, x);
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "dead code, consider removing %.4q", x);
|
||||
janetc_popscope(c);
|
||||
@@ -548,7 +548,7 @@ void janetc_throwaway(JanetFopts opts, Janet x) {
|
||||
}
|
||||
|
||||
/* Compile a call or tailcall instruction */
|
||||
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun, const Janet *form) {
|
||||
JanetSlot retslot;
|
||||
JanetCompiler *c = opts.compiler;
|
||||
int specialized = 0;
|
||||
@@ -574,6 +574,8 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
JanetFunction *f = janet_unwrap_function(fun.constant);
|
||||
int32_t min = f->def->min_arity;
|
||||
int32_t max = f->def->max_arity;
|
||||
int structarg = f->def->flags & JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
int namedarg = f->def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||
if (min_arity < 0) {
|
||||
/* Call has splices */
|
||||
min_arity = -1 - min_arity;
|
||||
@@ -597,6 +599,47 @@ static JanetSlot janetc_call(JanetFopts opts, JanetSlot *slots, JanetSlot fun) {
|
||||
fun.constant, min, min == 1 ? "" : "s", min_arity);
|
||||
janetc_error(c, es);
|
||||
}
|
||||
if (structarg && (min_arity > f->def->arity) && ((min_arity - f->def->arity) & 1)) {
|
||||
/* If we have an odd number of variadic arguments to a `&keys` function, that is almost certainly wrong. */
|
||||
if (namedarg) {
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||
"odd number of named arguments to `&named` function %v", fun.constant);
|
||||
} else {
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||
"odd number of named arguments to `&keys` function %v", fun.constant);
|
||||
}
|
||||
}
|
||||
if (namedarg && f->def->named_args_count > 0) {
|
||||
/* For each argument passed in, check if it is one of the used named arguments
|
||||
* by checking the list defined in the function def. If not, raise a normal compiler
|
||||
* lint. We can also do a strict lint for _missing_ named arguments, although in many
|
||||
* cases those are assumed to have some kind of default, or we have dynamic keys. */
|
||||
int32_t first_arg_key_index = f->def->arity + 1;
|
||||
for (int32_t i = first_arg_key_index; i < janet_tuple_length(form); i += 2) {
|
||||
Janet argkey = form[i];
|
||||
/* Assumption: The first N constants of a function are its named argument keys. This
|
||||
* may change if the compiler changes, but is true for all Janet generated functions. */
|
||||
int found = 0;
|
||||
if (janet_checktype(argkey, JANET_KEYWORD)) {
|
||||
for (int32_t j = 0; j < f->def->named_args_count && j < f->def->constants_length; j++) {
|
||||
if (janet_equals(argkey, f->def->constants[j])) {
|
||||
found = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
} else if (janet_checktype(argkey, JANET_TUPLE)) {
|
||||
/* Possible lint : too dynamic, be dumber
|
||||
* (defn f [&named x] [x])
|
||||
* (f (if (coin-flip) :x :w) 10)
|
||||
* A tuple could be a function call the evaluates to a valid key */
|
||||
found = 1;
|
||||
}
|
||||
if (!found) {
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL,
|
||||
"unused named argument %v to function %v", argkey, fun.constant);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
@@ -831,14 +874,16 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
|
||||
} else if (janet_tuple_flag(tup) & JANET_TUPLE_FLAG_BRACKETCTOR) { /* [] tuples are not function call */
|
||||
ret = janetc_tuple(opts, x);
|
||||
} else {
|
||||
/* Function calls */
|
||||
JanetSlot head = janetc_value(subopts, tup[0]);
|
||||
subopts.flags = JANET_FUNCTION | JANET_CFUNCTION;
|
||||
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head);
|
||||
ret = janetc_call(opts, janetc_toslots(c, tup + 1, janet_tuple_length(tup) - 1), head, tup);
|
||||
janetc_freeslot(c, head);
|
||||
}
|
||||
ret.flags &= ~JANET_SLOT_SPLICED;
|
||||
}
|
||||
break;
|
||||
/* Data Constructors */
|
||||
case JANET_SYMBOL:
|
||||
ret = janetc_resolve(c, janet_unwrap_symbol(x));
|
||||
break;
|
||||
@@ -878,19 +923,21 @@ void janet_def_addflags(JanetFuncDef *def) {
|
||||
int32_t set_flags = 0;
|
||||
int32_t unset_flags = 0;
|
||||
/* pos checks */
|
||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
if (def->named_args_count) set_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||
/* negative checks */
|
||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
|
||||
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
|
||||
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
|
||||
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
|
||||
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
|
||||
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
|
||||
if (!def->named_args_count) unset_flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||
/* Update flags */
|
||||
def->flags |= set_flags;
|
||||
def->flags &= ~unset_flags;
|
||||
@@ -961,8 +1008,9 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
}
|
||||
memcpy(chunks, scope->ua.chunks, sizeof(uint32_t) * numchunks);
|
||||
/* fprintf(stderr, "slot chunks: %d, scope->ua.count: %d, numchunks: %d\n", slotchunks, scope->ua.count, numchunks); */
|
||||
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
|
||||
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
|
||||
if (scope->ua.count > 7 && slotchunks > 7) chunks[7] &= 0xFFFFU;
|
||||
def->closure_bitset = chunks;
|
||||
}
|
||||
|
||||
@@ -1108,6 +1156,7 @@ JANET_CORE_FN(cfun_compile,
|
||||
"struct with keys :line, :column, and :error if compilation fails. "
|
||||
"If a `lints` array is given, linting messages will be appended to the array. "
|
||||
"Each message will be a tuple of the form `(level line col message)`.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_COMPILE);
|
||||
janet_arity(argc, 1, 4);
|
||||
JanetTable *env = (argc > 1 && !janet_checktype(argv[1], JANET_NIL))
|
||||
? janet_gettable(argv, 1) : janet_vm.fiber->env;
|
||||
|
||||
@@ -746,7 +746,9 @@ typedef struct SandboxOption {
|
||||
|
||||
static const SandboxOption sandbox_options[] = {
|
||||
{"all", JANET_SANDBOX_ALL},
|
||||
{"asm", JANET_SANDBOX_ASM},
|
||||
{"chroot", JANET_SANDBOX_CHROOT},
|
||||
{"compile", JANET_SANDBOX_COMPILE},
|
||||
{"env", JANET_SANDBOX_ENV},
|
||||
{"ffi", JANET_SANDBOX_FFI},
|
||||
{"ffi-define", JANET_SANDBOX_FFI_DEFINE},
|
||||
@@ -764,6 +766,8 @@ static const SandboxOption sandbox_options[] = {
|
||||
{"sandbox", JANET_SANDBOX_SANDBOX},
|
||||
{"signal", JANET_SANDBOX_SIGNAL},
|
||||
{"subprocess", JANET_SANDBOX_SUBPROCESS},
|
||||
{"threads", JANET_SANDBOX_THREADS},
|
||||
{"unmarshal", JANET_SANDBOX_UNMARSHAL},
|
||||
{NULL, 0}
|
||||
};
|
||||
|
||||
@@ -772,7 +776,9 @@ JANET_CORE_FN(janet_core_sandbox,
|
||||
"Disable feature sets to prevent the interpreter from using certain system resources. "
|
||||
"Once a feature is disabled, there is no way to re-enable it. Capabilities can be:\n\n"
|
||||
"* :all - disallow all (except IO to stdout, stderr, and stdin)\n"
|
||||
"* :asm - disallow calling `asm` and `disasm` functions.\n"
|
||||
"* :chroot - disallow calling `os/posix-chroot`\n"
|
||||
"* :compile - disallow calling `compile`. This will disable a lot of functionality, such as `eval`.\n"
|
||||
"* :env - disallow reading and write env variables\n"
|
||||
"* :ffi - disallow FFI (recommended if disabling anything else)\n"
|
||||
"* :ffi-define - disallow loading new FFI modules and binding new functions\n"
|
||||
@@ -789,7 +795,9 @@ JANET_CORE_FN(janet_core_sandbox,
|
||||
"* :net-listen - disallow accepting inbound network connections\n"
|
||||
"* :sandbox - disallow calling this function\n"
|
||||
"* :signal - disallow adding or removing signal handlers\n"
|
||||
"* :subprocess - disallow running subprocesses") {
|
||||
"* :subprocess - disallow running subprocesses\n"
|
||||
"* :threads - disallow spawning threads with `ev/thread`. Certain helper threads may still be spawned.\n"
|
||||
"* :unmarshal - disallow calling the unmarshal function.\n") {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < argc; i++) {
|
||||
JanetKeyword kw = janet_getkeyword(argv, i);
|
||||
@@ -1354,12 +1362,16 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
lidv = midv = janet_wrap_nil();
|
||||
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
|
||||
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
|
||||
JanetTable *lid = janet_unwrap_table(lidv);
|
||||
JanetTable *mid = janet_unwrap_table(midv);
|
||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
||||
const JanetKV *kv = lid->data + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(mid, kv->value, kv->key);
|
||||
|
||||
/* Check that we actually got tables - if we are using a smaller corelib, may not exist */
|
||||
if (janet_checktype(lidv, JANET_TABLE) && janet_checktype(midv, JANET_TABLE)) {
|
||||
JanetTable *lid = janet_unwrap_table(lidv);
|
||||
JanetTable *mid = janet_unwrap_table(midv);
|
||||
for (int32_t i = 0; i < lid->capacity; i++) {
|
||||
const JanetKV *kv = lid->data + i;
|
||||
if (!janet_checktype(kv->key, JANET_NIL)) {
|
||||
janet_table_put(mid, kv->value, kv->key);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -539,6 +539,9 @@ void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
|
||||
}
|
||||
|
||||
void janet_cancel(JanetFiber *fiber, Janet value) {
|
||||
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
|
||||
janet_panic("cannot cancel non-task fiber");
|
||||
}
|
||||
janet_schedule_signal(fiber, value, JANET_SIGNAL_ERROR);
|
||||
}
|
||||
|
||||
@@ -1269,11 +1272,13 @@ JANET_CORE_FN(cfun_channel_choice,
|
||||
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
|
||||
/* Write */
|
||||
JanetChannel *chan = janet_getchannel(data, 0);
|
||||
janet_chan_lock(chan);
|
||||
janet_channel_push_with_lock(chan, data[1], 1);
|
||||
} else {
|
||||
/* Read */
|
||||
Janet item;
|
||||
JanetChannel *chan = janet_getchannel(argv, i);
|
||||
janet_chan_lock(chan);
|
||||
janet_channel_pop_with_lock(chan, &item, 1);
|
||||
}
|
||||
}
|
||||
@@ -1376,7 +1381,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
} else {
|
||||
if (janet_fiber_can_resume(writer.fiber)) {
|
||||
if (janet_fiber_can_resume(writer.fiber) && writer.sched_id == writer.fiber->sched_id) {
|
||||
if (writer.mode == JANET_CP_MODE_CHOICE_WRITE) {
|
||||
janet_schedule(writer.fiber, make_close_result(channel));
|
||||
} else {
|
||||
@@ -1399,7 +1404,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
janet_ev_post_event(vm, janet_thread_chan_cb, msg);
|
||||
}
|
||||
} else {
|
||||
if (janet_fiber_can_resume(reader.fiber)) {
|
||||
if (janet_fiber_can_resume(reader.fiber) && reader.sched_id == reader.fiber->sched_id) {
|
||||
if (reader.mode == JANET_CP_MODE_CHOICE_READ) {
|
||||
janet_schedule(reader.fiber, make_close_result(channel));
|
||||
} else {
|
||||
@@ -3002,12 +3007,14 @@ error:
|
||||
|
||||
JANET_CORE_FN(cfun_ev_go,
|
||||
"(ev/go fiber-or-fun &opt value supervisor)",
|
||||
"Put a fiber on the event loop to be resumed later. If a function is used, it is wrapped "
|
||||
"with `fiber/new` first. "
|
||||
"Optionally pass a value to resume with, otherwise resumes with nil. Returns the fiber. "
|
||||
"An optional `core/channel` can be provided as a supervisor. When various "
|
||||
"events occur in the newly scheduled fiber, an event will be pushed to the supervisor. "
|
||||
"If not provided, the new fiber will inherit the current supervisor.") {
|
||||
"Put a fiber on the event loop to be resumed later. If a "
|
||||
"function is used, it is wrapped with `fiber/new` first. "
|
||||
"Returns a task fiber. Optionally pass a value to resume "
|
||||
"with, otherwise resumes with nil. An optional `core/channel` "
|
||||
"can be provided as a supervisor. When various events occur "
|
||||
"in the newly scheduled fiber, an event will be pushed to the "
|
||||
"supervisor. If not provided, the new fiber will inherit the "
|
||||
"current supervisor.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
||||
void *supervisor = janet_optabstract(argv, argc, 2, &janet_channel_type, janet_vm.root_fiber->supervisor_channel);
|
||||
@@ -3033,6 +3040,9 @@ JANET_CORE_FN(cfun_ev_go,
|
||||
fiber->env->proto = janet_vm.fiber->env;
|
||||
} else {
|
||||
fiber = janet_getfiber(argv, 0);
|
||||
if (janet_fiber_status(fiber) != JANET_STATUS_NEW) {
|
||||
janet_panic("can only schedule new fibers where (= (fiber/status f) :new)");
|
||||
}
|
||||
}
|
||||
fiber->supervisor_channel = supervisor;
|
||||
janet_schedule(fiber, value);
|
||||
@@ -3168,6 +3178,7 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
"* `:t` - set the task-id of the new thread to value. The task-id is passed in messages to the supervisor channel.\n"
|
||||
"* `:a` - don't copy abstract registry to new thread (performance optimization)\n"
|
||||
"* `:c` - don't copy cfunction registry to new thread (performance optimization)") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_THREADS);
|
||||
janet_arity(argc, 1, 4);
|
||||
Janet value = argc >= 2 ? argv[1] : janet_wrap_nil();
|
||||
if (!janet_checktype(argv[0], JANET_FUNCTION)) janet_getfiber(argv, 0);
|
||||
@@ -3316,7 +3327,8 @@ JANET_CORE_FN(cfun_ev_deadline,
|
||||
|
||||
JANET_CORE_FN(cfun_ev_cancel,
|
||||
"(ev/cancel fiber err)",
|
||||
"Cancel a suspended fiber in the event loop. Differs from cancel in that it returns the canceled fiber immediately.") {
|
||||
"Cancel a suspended task fiber in the event loop. Differs from "
|
||||
"`cancel` in that it returns the canceled fiber immediately.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet err = argv[1];
|
||||
@@ -3549,7 +3561,7 @@ JANET_CORE_FN(janet_cfun_to_file,
|
||||
|
||||
JANET_CORE_FN(janet_cfun_ev_all_tasks,
|
||||
"(ev/all-tasks)",
|
||||
"Get an array of all active fibers that are being used by the scheduler.") {
|
||||
"Get an array of all active task fibers that are being used by the scheduler.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
JanetArray *array = janet_array(janet_vm.active_tasks.count);
|
||||
|
||||
@@ -610,8 +610,9 @@ JANET_CORE_FN(cfun_fiber_current,
|
||||
|
||||
JANET_CORE_FN(cfun_fiber_root,
|
||||
"(fiber/root)",
|
||||
"Returns the current root fiber. The root fiber is the oldest ancestor "
|
||||
"that does not have a parent.") {
|
||||
"Returns the current root fiber. The root fiber is the oldest "
|
||||
"ancestor that does not have a parent. Note that a root fiber "
|
||||
"is also a task fiber.") {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_fiber(janet_vm.root_fiber);
|
||||
|
||||
@@ -521,23 +521,23 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
|
||||
(void) watcher;
|
||||
(void) flags;
|
||||
(void) path;
|
||||
janet_panic("nyi");
|
||||
janet_panic("filewatch not supported on this platform");
|
||||
}
|
||||
|
||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
(void) watcher;
|
||||
(void) path;
|
||||
janet_panic("nyi");
|
||||
janet_panic("filewatch not supported on this platform");
|
||||
}
|
||||
|
||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
||||
(void) watcher;
|
||||
janet_panic("nyi");
|
||||
janet_panic("filewatch not supported on this platform");
|
||||
}
|
||||
|
||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||
(void) watcher;
|
||||
janet_panic("nyi");
|
||||
janet_panic("filewatch not supported on this platform");
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -504,14 +504,7 @@ void janet_sweep() {
|
||||
if (head->type->gcperthread) {
|
||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||
}
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
/* Run finalizer */
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
/* Free memory */
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
janet_abstract_decref_maybe_free(abst);
|
||||
|
||||
/* Mark as tombstone in place */
|
||||
items[i].key = janet_wrap_nil();
|
||||
@@ -682,12 +675,7 @@ void janet_clear_memory(void) {
|
||||
if (head->type->gcperthread) {
|
||||
janet_assert(!head->type->gcperthread(head->data, head->size), "per-thread finalizer failed");
|
||||
}
|
||||
if (0 == janet_abstract_decref(abst)) {
|
||||
if (head->type->gc) {
|
||||
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
|
||||
}
|
||||
janet_free(janet_abstract_head(abst));
|
||||
}
|
||||
janet_abstract_decref_maybe_free(abst);
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
@@ -721,8 +721,15 @@ JANET_CORE_FN(cfun_io_eflush,
|
||||
void janet_dynprintf(const char *name, FILE *dflt_file, const char *format, ...) {
|
||||
va_list args;
|
||||
va_start(args, format);
|
||||
Janet x = janet_dyn(name);
|
||||
JanetType xtype = janet_type(x);
|
||||
JanetType xtype;
|
||||
Janet x;
|
||||
if (!name || name[0] == '\0') { /* Allow NULL or empty string to just use dflt_file directly */
|
||||
x = janet_wrap_nil();
|
||||
xtype = JANET_NIL;
|
||||
} else {
|
||||
x = janet_dyn(name);
|
||||
xtype = janet_type(x);
|
||||
}
|
||||
switch (xtype) {
|
||||
default:
|
||||
/* Other values simply do nothing */
|
||||
|
||||
@@ -276,6 +276,8 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
|
||||
pushint(st, def->max_arity);
|
||||
pushint(st, def->constants_length);
|
||||
pushint(st, def->bytecode_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
|
||||
pushint(st, def->named_args_count);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
pushint(st, def->environments_length);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
@@ -914,6 +916,7 @@ static const uint8_t *unmarshal_one_def(
|
||||
def->sourcemap = NULL;
|
||||
def->symbolmap = NULL;
|
||||
def->symbolmap_length = 0;
|
||||
def->named_args_count = 0;
|
||||
janet_v_push(st->lookup_defs, def);
|
||||
|
||||
/* Set default lengths to zero */
|
||||
@@ -933,6 +936,8 @@ static const uint8_t *unmarshal_one_def(
|
||||
/* Read some lengths */
|
||||
constants_length = readnat(st, &data);
|
||||
bytecode_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_NAMEDARGS)
|
||||
def->named_args_count = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASENVS)
|
||||
environments_length = readnat(st, &data);
|
||||
if (def->flags & JANET_FUNCDEF_FLAG_HASDEFS)
|
||||
@@ -1693,6 +1698,7 @@ JANET_CORE_FN(cfun_unmarshal,
|
||||
"Unmarshal a value from a buffer. An optional lookup table "
|
||||
"can be provided to allow for aliases to be resolved. Returns the value "
|
||||
"unmarshalled from the buffer.") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_UNMARSHAL);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetByteView view = janet_getbytes(argv, 0);
|
||||
JanetTable *reg = NULL;
|
||||
|
||||
109
src/core/os.c
109
src/core/os.c
@@ -142,8 +142,8 @@ static void janet_unlock_environ(void) {
|
||||
#define janet_stringify(x) janet_stringify1(x)
|
||||
|
||||
JANET_CORE_FN(os_which,
|
||||
"(os/which)",
|
||||
"Check the current operating system. Returns one of:\n\n"
|
||||
"(os/which &opt test)",
|
||||
"Check the current operating system. If `test` is nil or unset, Returns one of:\n\n"
|
||||
"* :windows\n\n"
|
||||
"* :mingw\n\n"
|
||||
"* :cygwin\n\n"
|
||||
@@ -156,9 +156,12 @@ JANET_CORE_FN(os_which,
|
||||
"* :dragonfly\n\n"
|
||||
"* :bsd\n\n"
|
||||
"* :posix - A POSIX compatible system (default)\n\n"
|
||||
"May also return a custom keyword specified at build time.") {
|
||||
janet_fixarity(argc, 0);
|
||||
(void) argv;
|
||||
"May also return a custom keyword specified at build time. Is `test` is truthy, will check if the current operating system equals `test` and return true if they are the same, false otherwise.") {
|
||||
janet_arity(argc, 0, 1);
|
||||
if (argc == 1 && janet_truthy(argv[0])) {
|
||||
janet_getkeyword(argv, 0); /* Constrain to keywords */
|
||||
return janet_wrap_boolean(janet_equals(argv[0], os_which(0, NULL)));
|
||||
}
|
||||
#if defined(JANET_OS_NAME)
|
||||
return janet_ckeywordv(janet_stringify(JANET_OS_NAME));
|
||||
#elif defined(JANET_MINGW)
|
||||
@@ -1211,7 +1214,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
if (is_spawn && janet_keyeq(maybe_stderr, "pipe")) {
|
||||
new_err = make_pipes(&pipe_err, 0, &pipe_errflag);
|
||||
pipe_owner_flags |= JANET_PROC_OWNS_STDERR;
|
||||
} else if (is_spawn && janet_keyeq(maybe_stderr, "out")) {
|
||||
} else if (janet_keyeq(maybe_stderr, "out")) {
|
||||
stderr_is_stdout = 1;
|
||||
} else if (!janet_checktype(maybe_stderr, JANET_NIL)) {
|
||||
new_err = janet_getjstream(&maybe_stderr, 0, &orig_err);
|
||||
@@ -1297,6 +1300,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
}
|
||||
|
||||
int cp_failed = 0;
|
||||
DWORD cp_error_code = 0;
|
||||
if (!CreateProcess(janet_flag_at(flags, 1) ? NULL : path,
|
||||
(char *) buf->data, /* Single CLI argument */
|
||||
&saAttr, /* no proc inheritance */
|
||||
@@ -1308,6 +1312,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
&startupInfo,
|
||||
&processInfo)) {
|
||||
cp_failed = 1;
|
||||
cp_error_code = GetLastError();
|
||||
}
|
||||
|
||||
if (pipe_in != JANET_HANDLE_NONE) CloseHandle(pipe_in);
|
||||
@@ -1317,7 +1322,25 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
||||
os_execute_cleanup(envp, NULL);
|
||||
|
||||
if (cp_failed) {
|
||||
janet_panic("failed to create process");
|
||||
char msgbuf[256];
|
||||
msgbuf[0] = '\0';
|
||||
FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM | FORMAT_MESSAGE_IGNORE_INSERTS,
|
||||
NULL,
|
||||
cp_error_code,
|
||||
MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT),
|
||||
msgbuf,
|
||||
sizeof(msgbuf),
|
||||
NULL);
|
||||
if (!*msgbuf) sprintf(msgbuf, "%d", cp_error_code);
|
||||
char *c = msgbuf;
|
||||
while (*c) {
|
||||
if (*c == '\n' || *c == '\r') {
|
||||
*c = '\0';
|
||||
break;
|
||||
}
|
||||
c++;
|
||||
}
|
||||
janet_panicf("failed to create process: %s", janet_cstringv(msgbuf));
|
||||
}
|
||||
|
||||
pHandle = processInfo.hProcess;
|
||||
@@ -1870,9 +1893,8 @@ static struct tm *time_to_tm(const Janet *argv, int32_t argc, int32_t n, struct
|
||||
JANET_CORE_FN(os_date,
|
||||
"(os/date &opt time local)",
|
||||
"Returns the given time as a date struct, or the current time if `time` is not given. "
|
||||
"Returns a struct with following key values. Note that all numbers are 0-indexed. "
|
||||
"Date is given in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.\n\n"
|
||||
"the local timezone. Returns a struct with following key values. Note that all numbers are 0-indexed.\n\n"
|
||||
"* :seconds - number of seconds [0-61]\n\n"
|
||||
"* :minutes - number of minutes [0-59]\n\n"
|
||||
"* :hours - number of hours [0-23]\n\n"
|
||||
@@ -1881,7 +1903,9 @@ JANET_CORE_FN(os_date,
|
||||
"* :year - years since year 0 (e.g. 2019)\n\n"
|
||||
"* :week-day - day of the week [0-6]\n\n"
|
||||
"* :year-day - day of the year [0-365]\n\n"
|
||||
"* :dst - if Day Light Savings is in effect") {
|
||||
"* :dst - if Day Light Savings is in effect\n\n"
|
||||
"You can set local timezone by setting TZ environment variable. "
|
||||
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
|
||||
janet_arity(argc, 0, 2);
|
||||
(void) argv;
|
||||
struct tm t_infos;
|
||||
@@ -1899,14 +1923,15 @@ JANET_CORE_FN(os_date,
|
||||
return janet_wrap_struct(janet_struct_end(st));
|
||||
}
|
||||
|
||||
#define SIZETIMEFMT 250
|
||||
#define SIZETIMEFMT 250
|
||||
|
||||
JANET_CORE_FN(os_strftime,
|
||||
"(os/strftime fmt &opt time local)",
|
||||
"Format the given time as a string, or the current time if `time` is not given. "
|
||||
"The time is formatted according to the same rules as the ISO C89 function strftime(). "
|
||||
"The time is formatted in UTC unless `local` is truthy, in which case the date is formatted for "
|
||||
"the local timezone.") {
|
||||
"the local timezone. You can set local timezone by setting TZ environment variable. "
|
||||
"See tzset(<time.h>) or _tzset(<time.h>) for further details.") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *fmt = janet_getcstring(argv, 0);
|
||||
/* ANSI X3.159-1989, section 4.12.3.5 "The strftime function" */
|
||||
@@ -1914,6 +1939,9 @@ JANET_CORE_FN(os_strftime,
|
||||
const char *p = fmt;
|
||||
while (*p) {
|
||||
if (*p++ == '%') {
|
||||
if (!*p) {
|
||||
janet_panic("invalid conversion specifier");
|
||||
}
|
||||
if (!strchr(valid, *p)) {
|
||||
janet_panicf("invalid conversion specifier '%%%c'", *p);
|
||||
}
|
||||
@@ -1923,7 +1951,7 @@ JANET_CORE_FN(os_strftime,
|
||||
struct tm t_infos;
|
||||
struct tm *t_info = time_to_tm(argv, argc, 1, &t_infos);
|
||||
char buf[SIZETIMEFMT];
|
||||
(void)strftime(buf, SIZETIMEFMT, fmt, t_info);
|
||||
(void)strftime(buf, sizeof(buf), fmt, t_info);
|
||||
return janet_cstringv(buf);
|
||||
}
|
||||
|
||||
@@ -1931,7 +1959,7 @@ static int entry_getdst(Janet env_entry) {
|
||||
Janet v;
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
v = janet_table_get(entry, janet_ckeywordv("dst"));
|
||||
v = janet_table_get_keyword(entry, "dst");
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
v = janet_struct_get(entry, janet_ckeywordv("dst"));
|
||||
@@ -1955,7 +1983,7 @@ static timeint_t entry_getint(Janet env_entry, char *field) {
|
||||
Janet i;
|
||||
if (janet_checktype(env_entry, JANET_TABLE)) {
|
||||
JanetTable *entry = janet_unwrap_table(env_entry);
|
||||
i = janet_table_get(entry, janet_ckeywordv(field));
|
||||
i = janet_table_get_keyword(entry, field);
|
||||
} else if (janet_checktype(env_entry, JANET_STRUCT)) {
|
||||
const JanetKV *entry = janet_unwrap_struct(env_entry);
|
||||
i = janet_struct_get(entry, janet_ckeywordv(field));
|
||||
@@ -2668,10 +2696,11 @@ JANET_CORE_FN(os_open,
|
||||
" * :c - create a new file (O\\_CREATE)\n"
|
||||
" * :e - fail if the file exists (O\\_EXCL)\n"
|
||||
" * :t - shorten an existing file to length 0 (O\\_TRUNC)\n\n"
|
||||
" * :a - append to a file (O\\_APPEND on posix, FILE_APPEND_DATA on windows)\n"
|
||||
"Posix-only flags:\n\n"
|
||||
" * :a - append to a file (O\\_APPEND)\n"
|
||||
" * :x - O\\_SYNC\n"
|
||||
" * :C - O\\_NOCTTY\n\n"
|
||||
" * :N - Turn off O\\_NONBLOCK and disable ev reading/writing\n\n"
|
||||
"Windows-only flags:\n\n"
|
||||
" * :R - share reads (FILE\\_SHARE\\_READ)\n"
|
||||
" * :W - share writes (FILE\\_SHARE\\_WRITE)\n"
|
||||
@@ -2681,19 +2710,24 @@ JANET_CORE_FN(os_open,
|
||||
" * :F - FILE\\_ATTRIBUTE\\_OFFLINE\n"
|
||||
" * :T - FILE\\_ATTRIBUTE\\_TEMPORARY\n"
|
||||
" * :d - FILE\\_FLAG\\_DELETE\\_ON\\_CLOSE\n"
|
||||
" * :V - Turn off FILE\\_FLAG\\_OVERLAPPED and disable ev reading/writing\n"
|
||||
" * :I - set bInheritHandle on the created file so it can be passed to other processes.\n"
|
||||
" * :b - FILE\\_FLAG\\_NO\\_BUFFERING\n") {
|
||||
janet_arity(argc, 1, 3);
|
||||
const char *path = janet_getcstring(argv, 0);
|
||||
const uint8_t *opt_flags = janet_optkeyword(argv, argc, 1, (const uint8_t *) "r");
|
||||
jmode_t mode = os_optmode(argc, argv, 2, 0666);
|
||||
uint32_t stream_flags = 0;
|
||||
int disable_stream_mode = 0;
|
||||
JanetHandle fd;
|
||||
#ifdef JANET_WINDOWS
|
||||
(void) mode;
|
||||
int inherited_handle = 0;
|
||||
DWORD desiredAccess = 0;
|
||||
DWORD shareMode = 0;
|
||||
DWORD creationDisp = 0;
|
||||
DWORD flagsAndAttributes = FILE_FLAG_OVERLAPPED;
|
||||
DWORD fileFlags = FILE_FLAG_OVERLAPPED;
|
||||
DWORD fileAttributes = 0;
|
||||
/* We map unix-like open flags to the creationDisp parameter */
|
||||
int creatUnix = 0;
|
||||
#define OCREAT 1
|
||||
@@ -2713,6 +2747,11 @@ JANET_CORE_FN(os_open,
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'a':
|
||||
desiredAccess |= FILE_APPEND_DATA;
|
||||
stream_flags |= JANET_STREAM_WRITABLE;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
break;
|
||||
case 'c':
|
||||
creatUnix |= OCREAT;
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
|
||||
@@ -2735,22 +2774,29 @@ JANET_CORE_FN(os_open,
|
||||
shareMode |= FILE_SHARE_WRITE;
|
||||
break;
|
||||
case 'H':
|
||||
flagsAndAttributes |= FILE_ATTRIBUTE_HIDDEN;
|
||||
fileAttributes |= FILE_ATTRIBUTE_HIDDEN;
|
||||
break;
|
||||
case 'O':
|
||||
flagsAndAttributes |= FILE_ATTRIBUTE_READONLY;
|
||||
fileAttributes |= FILE_ATTRIBUTE_READONLY;
|
||||
break;
|
||||
case 'F':
|
||||
flagsAndAttributes |= FILE_ATTRIBUTE_OFFLINE;
|
||||
fileAttributes |= FILE_ATTRIBUTE_OFFLINE;
|
||||
break;
|
||||
case 'T':
|
||||
flagsAndAttributes |= FILE_ATTRIBUTE_TEMPORARY;
|
||||
fileAttributes |= FILE_ATTRIBUTE_TEMPORARY;
|
||||
break;
|
||||
case 'd':
|
||||
flagsAndAttributes |= FILE_FLAG_DELETE_ON_CLOSE;
|
||||
fileFlags |= FILE_FLAG_DELETE_ON_CLOSE;
|
||||
break;
|
||||
case 'b':
|
||||
flagsAndAttributes |= FILE_FLAG_NO_BUFFERING;
|
||||
fileFlags |= FILE_FLAG_NO_BUFFERING;
|
||||
break;
|
||||
case 'I':
|
||||
inherited_handle = 1;
|
||||
break;
|
||||
case 'V':
|
||||
fileFlags &= ~FILE_FLAG_OVERLAPPED;
|
||||
disable_stream_mode = 1;
|
||||
break;
|
||||
/* we could potentially add more here -
|
||||
* https://docs.microsoft.com/en-us/windows/win32/api/fileapi/nf-fileapi-createfilea
|
||||
@@ -2776,7 +2822,16 @@ JANET_CORE_FN(os_open,
|
||||
creationDisp = TRUNCATE_EXISTING;
|
||||
break;
|
||||
}
|
||||
fd = CreateFileA(path, desiredAccess, shareMode, NULL, creationDisp, flagsAndAttributes, NULL);
|
||||
if (fileAttributes == 0) {
|
||||
fileAttributes = FILE_ATTRIBUTE_NORMAL;
|
||||
}
|
||||
SECURITY_ATTRIBUTES saAttr;
|
||||
memset(&saAttr, 0, sizeof(saAttr));
|
||||
saAttr.nLength = sizeof(saAttr);
|
||||
if (inherited_handle) {
|
||||
saAttr.bInheritHandle = TRUE; /* Needed to do interesting things with file */
|
||||
}
|
||||
fd = CreateFileA(path, desiredAccess, shareMode, &saAttr, creationDisp, fileFlags | fileAttributes, NULL);
|
||||
if (fd == INVALID_HANDLE_VALUE) janet_panicv(janet_ev_lasterr());
|
||||
#else
|
||||
int open_flags = O_NONBLOCK;
|
||||
@@ -2820,6 +2875,10 @@ JANET_CORE_FN(os_open,
|
||||
case 'a':
|
||||
open_flags |= O_APPEND;
|
||||
break;
|
||||
case 'N':
|
||||
open_flags &= ~O_NONBLOCK;
|
||||
disable_stream_mode = 1;
|
||||
break;
|
||||
}
|
||||
}
|
||||
/* If both read and write, fix up to O_RDWR */
|
||||
@@ -2836,7 +2895,7 @@ JANET_CORE_FN(os_open,
|
||||
} while (fd == -1 && errno == EINTR);
|
||||
if (fd == -1) janet_panicv(janet_ev_lasterr());
|
||||
#endif
|
||||
return janet_wrap_abstract(janet_stream(fd, stream_flags, NULL));
|
||||
return janet_wrap_abstract(janet_stream(fd, disable_stream_mode ? 0 : stream_flags, NULL));
|
||||
}
|
||||
|
||||
JANET_CORE_FN(os_pipe,
|
||||
|
||||
@@ -194,6 +194,41 @@ tail:
|
||||
return memcmp(text, rule + 2, len) ? NULL : text + len;
|
||||
}
|
||||
|
||||
case RULE_DEBUG: {
|
||||
char buffer[32] = {0};
|
||||
size_t len = (size_t)(s->outer_text_end - text);
|
||||
memcpy(buffer, text, (len > 31 ? 31 : len));
|
||||
janet_eprintf("?? at [%s] (index %d)\n", buffer, (int32_t)(text - s->text_start));
|
||||
int has_color = janet_truthy(janet_dyn("err-color"));
|
||||
/* Accumulate buffer */
|
||||
if (s->scratch->count) {
|
||||
janet_eprintf("accumulate buffer: %v\n", janet_wrap_buffer(s->scratch));
|
||||
}
|
||||
/* Normal captures */
|
||||
if (s->captures->count) {
|
||||
janet_eprintf("stack [%d]:\n", s->captures->count);
|
||||
for (int32_t i = 0; i < s->captures->count; i++) {
|
||||
if (has_color) {
|
||||
janet_eprintf(" [%d]: %M\n", i, s->captures->data[i]);
|
||||
} else {
|
||||
janet_eprintf(" [%d]: %m\n", i, s->captures->data[i]);
|
||||
}
|
||||
}
|
||||
}
|
||||
/* Tagged captures */
|
||||
if (s->tagged_captures->count) {
|
||||
janet_eprintf("tag stack [%d]:\n", s->tagged_captures->count);
|
||||
for (int32_t i = 0; i < s->tagged_captures->count; i++) {
|
||||
if (has_color) {
|
||||
janet_eprintf(" [%d] tag=%d: %M\n", i, s->tags->data[i], s->tagged_captures->data[i]);
|
||||
} else {
|
||||
janet_eprintf(" [%d] tag=%d: %m\n", i, s->tags->data[i], s->tagged_captures->data[i]);
|
||||
}
|
||||
}
|
||||
}
|
||||
return text;
|
||||
}
|
||||
|
||||
case RULE_NCHAR: {
|
||||
uint32_t n = rule[1];
|
||||
return (text + n > s->text_end) ? NULL : text + n;
|
||||
@@ -1245,6 +1280,14 @@ static void spec_constant(Builder *b, int32_t argc, const Janet *argv) {
|
||||
emit_2(r, RULE_CONSTANT, emit_constant(b, argv[0]), tag);
|
||||
}
|
||||
|
||||
static void spec_debug(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_arity(b, argc, 0, 0);
|
||||
Reserve r = reserve(b, 1);
|
||||
uint32_t empty = 0;
|
||||
(void) argv;
|
||||
emit_rule(r, RULE_DEBUG, 0, &empty);
|
||||
}
|
||||
|
||||
static void spec_replace(Builder *b, int32_t argc, const Janet *argv) {
|
||||
peg_arity(b, argc, 2, 3);
|
||||
Reserve r = reserve(b, 4);
|
||||
@@ -1349,6 +1392,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"<-", spec_capture},
|
||||
{">", spec_look},
|
||||
{"?", spec_opt},
|
||||
{"??", spec_debug},
|
||||
{"accumulate", spec_accumulate},
|
||||
{"any", spec_any},
|
||||
{"argument", spec_argument},
|
||||
@@ -1363,6 +1407,7 @@ static const SpecialPair peg_specials[] = {
|
||||
{"cmt", spec_matchtime},
|
||||
{"column", spec_column},
|
||||
{"constant", spec_constant},
|
||||
{"debug", spec_debug},
|
||||
{"drop", spec_drop},
|
||||
{"error", spec_error},
|
||||
{"group", spec_group},
|
||||
@@ -1639,6 +1684,10 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
|
||||
case RULE_LITERAL:
|
||||
i += 2 + ((rule[1] + 3) >> 2);
|
||||
break;
|
||||
case RULE_DEBUG:
|
||||
/* [0 words] */
|
||||
i += 1;
|
||||
break;
|
||||
case RULE_NCHAR:
|
||||
case RULE_NOTNCHAR:
|
||||
case RULE_RANGE:
|
||||
@@ -1854,8 +1903,8 @@ static JanetPeg *compile_peg(Janet x) {
|
||||
JANET_CORE_FN(cfun_peg_compile,
|
||||
"(peg/compile peg)",
|
||||
"Compiles a peg source data structure into a <core/peg>. This will speed up matching "
|
||||
"if the same peg will be used multiple times. Will also use `(dyn :peg-grammar)` to supplement "
|
||||
"the grammar of the peg for otherwise undefined peg keywords.") {
|
||||
"if the same peg will be used multiple times. `(dyn :peg-grammar)` replaces "
|
||||
"`default-peg-grammar` for the grammar of the peg.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetPeg *peg = compile_peg(argv[0]);
|
||||
return janet_wrap_abstract(peg);
|
||||
|
||||
@@ -307,14 +307,14 @@ static JanetSlot janetc_varset(JanetFopts opts, int32_t argn, const Janet *argv)
|
||||
/* Add attributes to a global def or var table */
|
||||
static JanetTable *handleattr(JanetCompiler *c, const char *kind, int32_t argn, const Janet *argv) {
|
||||
int32_t i;
|
||||
JanetTable *tab = janet_table(2);
|
||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||
: "<multiple bindings>";
|
||||
if (argn < 2) {
|
||||
janetc_error(c, janet_formatc("expected at least 2 arguments to %s", kind));
|
||||
return NULL;
|
||||
}
|
||||
JanetTable *tab = janet_table(2);
|
||||
const char *binding_name = janet_type(argv[0]) == JANET_SYMBOL
|
||||
? ((const char *)janet_unwrap_symbol(argv[0]))
|
||||
: "<multiple bindings>";
|
||||
for (i = 1; i < argn - 1; i++) {
|
||||
Janet attr = argv[i];
|
||||
switch (janet_type(attr)) {
|
||||
@@ -443,8 +443,7 @@ static int varleaf(
|
||||
JanetSlot refslot;
|
||||
JanetTable *entry = janet_table_clone(reftab);
|
||||
|
||||
Janet redef_kw = janet_ckeywordv("redef");
|
||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
|
||||
JanetArray *ref;
|
||||
JanetBinding old_binding;
|
||||
@@ -464,7 +463,7 @@ static int varleaf(
|
||||
janetc_emit_ssu(c, JOP_PUT_INDEX, refslot, s, 0, 0);
|
||||
return 1;
|
||||
} else {
|
||||
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get(reftab, janet_ckeywordv("unused")));
|
||||
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
|
||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
|
||||
}
|
||||
}
|
||||
@@ -472,7 +471,7 @@ static int varleaf(
|
||||
static void check_metadata_lint(JanetCompiler *c, JanetTable *attr_table) {
|
||||
if (!(c->scope->flags & JANET_SCOPE_TOP) && attr_table && attr_table->count) {
|
||||
/* A macro is a normal lint, other metadata is a strict lint */
|
||||
if (janet_truthy(janet_table_get(attr_table, janet_ckeywordv("macro")))) {
|
||||
if (janet_truthy(janet_table_get_keyword(attr_table, "macro"))) {
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL, "macro tag is ignored in inner scopes");
|
||||
}
|
||||
}
|
||||
@@ -511,9 +510,8 @@ static int defleaf(
|
||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
|
||||
Janet redef_kw = janet_ckeywordv("redef");
|
||||
int is_redef = janet_truthy(janet_table_get(c->env, redef_kw));
|
||||
if (is_redef) janet_table_put(entry, redef_kw, janet_wrap_true());
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
|
||||
|
||||
if (is_redef) {
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
@@ -536,7 +534,7 @@ static int defleaf(
|
||||
/* Add env entry to env */
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||
}
|
||||
int no_unused = tab && tab->count && janet_truthy(janet_table_get(tab, janet_ckeywordv("unused")));
|
||||
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
|
||||
return namelocal(c, sym, 0, s, no_unused);
|
||||
}
|
||||
|
||||
@@ -686,8 +684,10 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
|
||||
/* Write jumps - only add jump lengths if jump actually emitted */
|
||||
labeld = janet_v_count(c->buffer);
|
||||
c->buffer[labeljr] |= (labelr - labeljr) << 16;
|
||||
if (!tail) c->buffer[labeljd] |= (labeld - labeljd) << 8;
|
||||
if (labeljr < labeld) {
|
||||
c->buffer[labeljr] |= (labelr - labeljr) << 16;
|
||||
if (!tail && labeljd < labeld) c->buffer[labeljd] |= (labeld - labeljd) << 8;
|
||||
}
|
||||
|
||||
if (tail) target.flags |= JANET_SLOT_RETURNED;
|
||||
return target;
|
||||
@@ -1076,6 +1076,14 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
}
|
||||
|
||||
/* Compile named arguments */
|
||||
if (namedargs) {
|
||||
Janet param = janet_wrap_table(named_table);
|
||||
destructure(c, param, named_slot, defleaf, NULL);
|
||||
janetc_freeslot(c, named_slot);
|
||||
janet_v_free(named_params);
|
||||
}
|
||||
|
||||
/* Compile destructed params */
|
||||
int32_t j = 0;
|
||||
for (i = 0; i < paramcount; i++) {
|
||||
@@ -1089,14 +1097,6 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
}
|
||||
janet_v_free(destructed_params);
|
||||
|
||||
/* Compile named arguments */
|
||||
if (namedargs) {
|
||||
Janet param = janet_wrap_table(named_table);
|
||||
destructure(c, param, named_slot, defleaf, NULL);
|
||||
janetc_freeslot(c, named_slot);
|
||||
janet_v_free(named_params);
|
||||
}
|
||||
|
||||
max_arity = (vararg || allow_extra) ? INT32_MAX : arity;
|
||||
if (!seenopt) min_arity = arity;
|
||||
|
||||
@@ -1139,8 +1139,12 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
def->arity = arity;
|
||||
def->min_arity = min_arity;
|
||||
def->max_arity = max_arity;
|
||||
if (named_table != NULL) {
|
||||
def->named_args_count = named_table->count;
|
||||
}
|
||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||
if (namedargs) def->flags |= JANET_FUNCDEF_FLAG_NAMEDARGS;
|
||||
|
||||
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
||||
janet_def_addflags(def);
|
||||
|
||||
@@ -155,6 +155,17 @@ Janet janet_table_get(JanetTable *t, Janet key) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
/* Used internally for compiler stuff */
|
||||
Janet janet_table_get_keyword(JanetTable *t, const char *keyword) {
|
||||
int32_t keyword_len = strlen(keyword);
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||
JanetKV *bucket = (JanetKV *) janet_dict_find_keyword(t->data, t->capacity, (const uint8_t *) keyword, keyword_len);
|
||||
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL))
|
||||
return bucket->value;
|
||||
}
|
||||
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) {
|
||||
for (int i = JANET_MAX_PROTO_DEPTH; t && i; t = t->proto, --i) {
|
||||
|
||||
@@ -321,6 +321,54 @@ const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key) {
|
||||
return first_bucket;
|
||||
}
|
||||
|
||||
/* Helper to find a keyword, symbol, or string in a Janet struct or table without allocating
|
||||
* memory or needing to find interned symbols */
|
||||
const JanetKV *janet_dict_find_keyword(
|
||||
const JanetKV *buckets, int32_t cap,
|
||||
const uint8_t *cstr, int32_t cstr_len) {
|
||||
int32_t hash = janet_string_calchash(cstr, cstr_len);
|
||||
int32_t index = janet_maphash(cap, hash);
|
||||
int32_t i;
|
||||
const JanetKV *first_bucket = NULL;
|
||||
/* Higher half */
|
||||
for (i = index; i < cap; i++) {
|
||||
const JanetKV *kv = buckets + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||
if (janet_checktype(kv->value, JANET_NIL)) {
|
||||
return kv;
|
||||
} else if (NULL == first_bucket) {
|
||||
first_bucket = kv;
|
||||
}
|
||||
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
|
||||
/* Works for symbol and keyword, too */
|
||||
JanetString str = janet_unwrap_string(kv->key);
|
||||
int32_t len = janet_string_length(str);
|
||||
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
|
||||
return buckets + i;
|
||||
}
|
||||
}
|
||||
}
|
||||
/* Lower half */
|
||||
for (i = 0; i < index; i++) {
|
||||
const JanetKV *kv = buckets + i;
|
||||
if (janet_checktype(kv->key, JANET_NIL)) {
|
||||
if (janet_checktype(kv->value, JANET_NIL)) {
|
||||
return kv;
|
||||
} else if (NULL == first_bucket) {
|
||||
first_bucket = kv;
|
||||
}
|
||||
} else if (janet_checktype(kv->key, JANET_KEYWORD)) {
|
||||
/* Works for symbol and keyword, too */
|
||||
JanetString str = janet_unwrap_string(kv->key);
|
||||
int32_t len = janet_string_length(str);
|
||||
if (hash == janet_string_hash(str) && len == cstr_len && !memcmp(str, cstr, len)) {
|
||||
return buckets + i;
|
||||
}
|
||||
}
|
||||
}
|
||||
return first_bucket;
|
||||
}
|
||||
|
||||
/* Get a value from a janet struct or table. */
|
||||
Janet janet_dictionary_get(const JanetKV *data, int32_t cap, Janet key) {
|
||||
const JanetKV *kv = janet_dict_find(data, cap, key);
|
||||
@@ -628,8 +676,11 @@ JanetBinding janet_binding_from_entry(Janet entry) {
|
||||
return binding;
|
||||
entry_table = janet_unwrap_table(entry);
|
||||
|
||||
/* deprecation check */
|
||||
Janet deprecate = janet_table_get(entry_table, janet_ckeywordv("deprecated"));
|
||||
Janet deprecate = janet_table_get_keyword(entry_table, "deprecated");
|
||||
int macro = janet_truthy(janet_table_get_keyword(entry_table, "macro"));
|
||||
Janet value = janet_table_get_keyword(entry_table, "value");
|
||||
Janet ref = janet_table_get_keyword(entry_table, "ref");
|
||||
|
||||
if (janet_checktype(deprecate, JANET_KEYWORD)) {
|
||||
JanetKeyword depkw = janet_unwrap_keyword(deprecate);
|
||||
if (!janet_cstrcmp(depkw, "relaxed")) {
|
||||
@@ -643,11 +694,8 @@ JanetBinding janet_binding_from_entry(Janet entry) {
|
||||
binding.deprecation = JANET_BINDING_DEP_NORMAL;
|
||||
}
|
||||
|
||||
int macro = janet_truthy(janet_table_get(entry_table, janet_ckeywordv("macro")));
|
||||
Janet value = janet_table_get(entry_table, janet_ckeywordv("value"));
|
||||
Janet ref = janet_table_get(entry_table, janet_ckeywordv("ref"));
|
||||
int ref_is_valid = janet_checktype(ref, JANET_ARRAY);
|
||||
int redef = ref_is_valid && janet_truthy(janet_table_get(entry_table, janet_ckeywordv("redef")));
|
||||
int redef = ref_is_valid && janet_truthy(janet_table_get_keyword(entry_table, "redef"));
|
||||
|
||||
if (macro) {
|
||||
binding.value = redef ? ref : value;
|
||||
|
||||
@@ -66,42 +66,72 @@
|
||||
|
||||
/* Utils */
|
||||
uint32_t janet_hash_mix(uint32_t input, uint32_t more);
|
||||
|
||||
#define janet_maphash(cap, hash) ((uint32_t)(hash) & (cap - 1))
|
||||
|
||||
int janet_valid_utf8(const uint8_t *str, int32_t len);
|
||||
|
||||
int janet_is_symbol_char(uint8_t c);
|
||||
|
||||
extern const char janet_base64[65];
|
||||
|
||||
int32_t janet_array_calchash(const Janet *array, int32_t len);
|
||||
|
||||
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len);
|
||||
|
||||
int32_t janet_string_calchash(const uint8_t *str, int32_t len);
|
||||
|
||||
int32_t janet_tablen(int32_t n);
|
||||
|
||||
void safe_memcpy(void *dest, const void *src, size_t len);
|
||||
|
||||
void janet_buffer_push_types(JanetBuffer *buffer, int types);
|
||||
|
||||
const JanetKV *janet_dict_find(const JanetKV *buckets, int32_t cap, Janet key);
|
||||
|
||||
void janet_memempty(JanetKV *mem, int32_t count);
|
||||
|
||||
void *janet_memalloc_empty(int32_t count);
|
||||
|
||||
JanetTable *janet_get_core_table(const char *name);
|
||||
|
||||
void janet_def_addflags(JanetFuncDef *def);
|
||||
|
||||
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
|
||||
|
||||
const char *janet_strerror(int e);
|
||||
|
||||
const void *janet_strbinsearch(
|
||||
const void *tab,
|
||||
size_t tabcount,
|
||||
size_t itemsize,
|
||||
const uint8_t *key);
|
||||
|
||||
void janet_buffer_format(
|
||||
JanetBuffer *b,
|
||||
const char *strfrmt,
|
||||
int32_t argstart,
|
||||
int32_t argc,
|
||||
Janet *argv);
|
||||
|
||||
Janet janet_next_impl(Janet ds, Janet key, int is_interpreter);
|
||||
|
||||
JanetBinding janet_binding_from_entry(Janet entry);
|
||||
|
||||
JanetByteView janet_text_substitution(
|
||||
Janet *subst,
|
||||
const uint8_t *bytes,
|
||||
uint32_t len,
|
||||
JanetArray *extra_args);
|
||||
|
||||
const JanetKV *janet_dict_find_keyword(
|
||||
const JanetKV *buckets,
|
||||
int32_t cap,
|
||||
const uint8_t *cstr,
|
||||
int32_t cstr_len);
|
||||
|
||||
Janet janet_table_get_keyword(JanetTable *t, const char *keyword);
|
||||
|
||||
/* Registry functions */
|
||||
void janet_registry_put(
|
||||
JanetCFunction key,
|
||||
|
||||
@@ -768,7 +768,8 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
JanetArray *array = janet_unwrap_array(ds);
|
||||
int32_t index = getter_checkint(type, key, INT32_MAX - 1);
|
||||
if (index >= array->count) {
|
||||
janet_array_setcount(array, index + 1);
|
||||
janet_array_ensure(array, index + 1, 2);
|
||||
array->count = index + 1;
|
||||
}
|
||||
array->data[index] = value;
|
||||
break;
|
||||
@@ -779,7 +780,8 @@ void janet_put(Janet ds, Janet key, Janet value) {
|
||||
if (!janet_checkint(value))
|
||||
janet_panicf("can only put integers in buffers, got %v", value);
|
||||
if (index >= buffer->count) {
|
||||
janet_buffer_setcount(buffer, index + 1);
|
||||
janet_buffer_ensure(buffer, index + 1, 2);
|
||||
buffer->count = index + 1;
|
||||
}
|
||||
buffer->data[index] = (uint8_t)(janet_unwrap_integer(value) & 0xFF);
|
||||
break;
|
||||
|
||||
@@ -1074,6 +1074,7 @@ struct JanetAbstractHead {
|
||||
#define JANET_FUNCDEF_FLAG_HASSOURCEMAP 0x800000
|
||||
#define JANET_FUNCDEF_FLAG_STRUCTARG 0x1000000
|
||||
#define JANET_FUNCDEF_FLAG_HASCLOBITSET 0x2000000
|
||||
#define JANET_FUNCDEF_FLAG_NAMEDARGS 0x4000000
|
||||
#define JANET_FUNCDEF_FLAG_TAG 0xFFFF
|
||||
|
||||
/* Source mapping structure for a bytecode instruction */
|
||||
@@ -1115,6 +1116,7 @@ struct JanetFuncDef {
|
||||
int32_t environments_length;
|
||||
int32_t defs_length;
|
||||
int32_t symbolmap_length;
|
||||
int32_t named_args_count;
|
||||
};
|
||||
|
||||
/* A function environment */
|
||||
@@ -1138,6 +1140,7 @@ struct JanetFunction {
|
||||
JanetFuncEnv *envs[];
|
||||
};
|
||||
|
||||
/* Use to read Janet data structures into memory from source code */
|
||||
typedef struct JanetParseState JanetParseState;
|
||||
typedef struct JanetParser JanetParser;
|
||||
|
||||
@@ -1187,7 +1190,10 @@ typedef struct {
|
||||
const JanetAbstractType *at;
|
||||
} JanetMarshalContext;
|
||||
|
||||
/* Defines an abstract type */
|
||||
/* Defines an abstract type. Use a const pointer to one of these structures
|
||||
* when creating abstract types. The memory for this pointer should not be free
|
||||
* until after janet_deinit is called. Usually, this means declaring JanetAbstractType's
|
||||
* as const data at file scope, and creating instances with janet_abstract(&MyType, sizeof(MyTypeStruct)); */
|
||||
struct JanetAbstractType {
|
||||
const char *name;
|
||||
int (*gc)(void *data, size_t len);
|
||||
@@ -1439,6 +1445,7 @@ JANET_API void janet_loop(void);
|
||||
* } else {
|
||||
* janet_schedule(interrupted_fiber, janet_wrap_nil());
|
||||
* }
|
||||
* janet_interpreter_interrupt_handled(NULL);
|
||||
* }
|
||||
* }
|
||||
*
|
||||
@@ -1478,9 +1485,18 @@ JANET_API void janet_ev_dec_refcount(void);
|
||||
JANET_API void *janet_abstract_begin_threaded(const JanetAbstractType *atype, size_t size);
|
||||
JANET_API void *janet_abstract_end_threaded(void *x);
|
||||
JANET_API void *janet_abstract_threaded(const JanetAbstractType *atype, size_t size);
|
||||
|
||||
/* Allow reference counting on threaded abstract types. This is useful when external code , either
|
||||
* in the current OS thread or in a different OS thread, takes a pointer to this abstract type. The programmer
|
||||
* should tncrement the reference count when taking the pointer, and then decrement and possibly cleanup and free
|
||||
* if the reference count is 0. */
|
||||
JANET_API int32_t janet_abstract_incref(void *abst);
|
||||
JANET_API int32_t janet_abstract_decref(void *abst);
|
||||
|
||||
/* If this returns 0, *abst will be deinitialized and freed. Useful shorthand if there is no other cleanup for
|
||||
* this abstract type before calling `janet_free` on it's backing memory. */
|
||||
JANET_API int32_t janet_abstract_decref_maybe_free(void *abst);
|
||||
|
||||
/* Expose channel utilities */
|
||||
JANET_API JanetChannel *janet_channel_make(uint32_t limit);
|
||||
JANET_API JanetChannel *janet_channel_make_threaded(uint32_t limit);
|
||||
@@ -1489,7 +1505,7 @@ JANET_API JanetChannel *janet_optchannel(const Janet *argv, int32_t argc, int32_
|
||||
JANET_API int janet_channel_give(JanetChannel *channel, Janet x);
|
||||
JANET_API int janet_channel_take(JanetChannel *channel, Janet *out);
|
||||
|
||||
/* Expose some OS sync primitives */
|
||||
/* Expose some OS sync primitives - mutexes and reader-writer locks */
|
||||
JANET_API size_t janet_os_mutex_size(void);
|
||||
JANET_API size_t janet_os_rwlock_size(void);
|
||||
JANET_API void janet_os_mutex_init(JanetOSMutex *mutex);
|
||||
@@ -1557,7 +1573,8 @@ JANET_API void janet_ev_post_event(JanetVM *vm, JanetCallback cb, JanetEVGeneric
|
||||
/* Callback used by janet_ev_threaded_await */
|
||||
JANET_API void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value);
|
||||
|
||||
/* Read async from a stream */
|
||||
/* Read async from a stream. These function yield to the event-loop with janet_await(), and so do not return.
|
||||
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
|
||||
JANET_NO_RETURN JANET_API void janet_ev_read(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_readchunk(JanetStream *stream, JanetBuffer *buf, int32_t nbytes);
|
||||
#ifdef JANET_NET
|
||||
@@ -1566,7 +1583,8 @@ JANET_NO_RETURN JANET_API void janet_ev_recvchunk(JanetStream *stream, JanetBuff
|
||||
JANET_NO_RETURN JANET_API void janet_ev_recvfrom(JanetStream *stream, JanetBuffer *buf, int32_t nbytes, int flags);
|
||||
#endif
|
||||
|
||||
/* Write async to a stream */
|
||||
/* Write async to a stream. These function yield to the event-loop with janet_await(), and so do not return.
|
||||
* When the fiber is resumed, the fiber will simply continue to the next Janet abstract machine instruction. */
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_buffer(JanetStream *stream, JanetBuffer *buf);
|
||||
JANET_NO_RETURN JANET_API void janet_ev_write_string(JanetStream *stream, JanetString str);
|
||||
#ifdef JANET_NET
|
||||
@@ -1578,17 +1596,63 @@ JANET_NO_RETURN JANET_API void janet_ev_sendto_string(JanetStream *stream, Janet
|
||||
|
||||
#endif
|
||||
|
||||
/* Parsing */
|
||||
/* Parsing.
|
||||
*
|
||||
* E.g.
|
||||
*
|
||||
* JanetParser parser;
|
||||
* janet_parser_init(&parser);
|
||||
* for (int i = 0; i < source_code_length + 1; i++) {
|
||||
* if (i >= source_code_length) {
|
||||
* janet_parser_eof(&parser);
|
||||
* } else {
|
||||
* janet_parser_consume(&parser, source_code[i]);
|
||||
* }
|
||||
* while (janet_parser_has_more(&parser)) {
|
||||
* Janet x = janet_parser_produce(&parser);
|
||||
* janet_printf("got value: %v\n", x);
|
||||
* }
|
||||
* switch (janet_parser_status(&parser)) {
|
||||
* case JANET_PARSE_PENDING: break;
|
||||
* case JANET_PARSE_ERROR: janet_eprintf("error: %s\n", janet_parser_error(&parser)); break;
|
||||
* case JANET_PARSE_ROOT: break;
|
||||
* case JANET_PARSE_DEAD: break;
|
||||
* }
|
||||
* }
|
||||
* janet_parser_deinit(&parser);
|
||||
*
|
||||
* */
|
||||
extern JANET_API const JanetAbstractType janet_parser_type;
|
||||
|
||||
/* Construct/destruct a parser. Parsers can be allocated on the stack or the heap. */
|
||||
JANET_API void janet_parser_init(JanetParser *parser);
|
||||
JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||
|
||||
/* Feed bytes into the parser. Check the parser state after every byte to handle errors. */
|
||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||
|
||||
/* Check the current status of the parser */
|
||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||
|
||||
/* Produce a value from the parser. Call this when janet_parser_has_more(&parser) is non-zero. */
|
||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
|
||||
/* Produce a value from the parser, wrapped in a tuple. The tuple is used to carry the source mapping information of the
|
||||
* top level form, such as a line number or symbol. */
|
||||
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
|
||||
|
||||
/* When there is an error while parsing (janet_parser_status(&parser) == JANET_PARSE_ERROR), get a nice error string.
|
||||
* Calling this will also flush the parser. */
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
|
||||
/* If there is a parsing error, flush the parser to set the state back to empty.
|
||||
* This allows for better error recover and less confusing error messages on bad syntax deep inside nested data structures. */
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
|
||||
/* Indicate that there is no more source code */
|
||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||
|
||||
/* If non-zero, the parser has values ready to be produced. */
|
||||
JANET_API int janet_parser_has_more(JanetParser *parser);
|
||||
|
||||
/* Assembly */
|
||||
@@ -1632,7 +1696,10 @@ JANET_API JanetCompileResult janet_compile_lint(
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
/* Execute strings */
|
||||
/* Execute strings.
|
||||
*
|
||||
* These functions wrap parsing, compilation, and evalutation into convenient functions.
|
||||
* */
|
||||
#define JANET_DO_ERROR_RUNTIME 0x01
|
||||
#define JANET_DO_ERROR_COMPILE 0x02
|
||||
#define JANET_DO_ERROR_PARSE 0x04
|
||||
@@ -1826,21 +1893,41 @@ JANET_API JanetTable *janet_env_lookup(JanetTable *env);
|
||||
JANET_API void janet_env_lookup_into(JanetTable *renv, JanetTable *env, const char *prefix, int recurse);
|
||||
|
||||
/* GC */
|
||||
JANET_API void janet_mark(Janet x);
|
||||
JANET_API void janet_sweep(void);
|
||||
|
||||
/* The main interface to garbage collection. Call this to do a full mark and sweep cleanup. */
|
||||
JANET_API void janet_collect(void);
|
||||
JANET_API void janet_clear_memory(void);
|
||||
|
||||
/* Add "roots" to the garbage collector to prevent the runtime from freeing objects.
|
||||
* This is only needed if code outside of Janet keeps references to Janet values */
|
||||
JANET_API void janet_gcroot(Janet root);
|
||||
JANET_API int janet_gcunroot(Janet root);
|
||||
JANET_API int janet_gcunrootall(Janet root);
|
||||
|
||||
/* Allow disabling garbage collection temporarily or for certain sections of code.
|
||||
* this is a very cheap operation. */
|
||||
JANET_API int janet_gclock(void);
|
||||
JANET_API void janet_gcunlock(int handle);
|
||||
|
||||
/* The mark and sweep components of the mark and sweep collector. Prefer using janet_collect directly. */
|
||||
JANET_API void janet_mark(Janet x);
|
||||
JANET_API void janet_sweep(void);
|
||||
|
||||
/* Clear all gced memory and call all destructors. Used as part of the standard cleanup routune, most programmers will not need this. */
|
||||
JANET_API void janet_clear_memory(void);
|
||||
|
||||
/* Remove all GC roots. Used as part of the standard cleanup routine, most programmers will not need this. */
|
||||
JANET_API int janet_gcunrootall(Janet root);
|
||||
|
||||
/* Hint to the collector that memory of size s was just allocated to help it better understand when to free memory. */
|
||||
JANET_API void janet_gcpressure(size_t s);
|
||||
|
||||
/* Functions */
|
||||
JANET_API JanetFuncDef *janet_funcdef_alloc(void);
|
||||
JANET_API JanetFunction *janet_thunk(JanetFuncDef *def);
|
||||
|
||||
/* Get a function that when called with no args, will return x. */
|
||||
JANET_API JanetFunction *janet_thunk_delay(Janet x);
|
||||
|
||||
/* Do some simple verfification on constructed bytecode to disallow any trivial incorrect bytecode. */
|
||||
JANET_API int janet_verify(JanetFuncDef *def);
|
||||
|
||||
/* Pretty printing */
|
||||
@@ -1889,7 +1976,7 @@ JANET_API void janet_vm_free(JanetVM *vm);
|
||||
JANET_API void janet_vm_save(JanetVM *into);
|
||||
JANET_API void janet_vm_load(JanetVM *from);
|
||||
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
|
||||
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
|
||||
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm); /* Call this after running interrupt handler */
|
||||
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
|
||||
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
|
||||
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
|
||||
@@ -1918,6 +2005,10 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
|
||||
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
|
||||
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
|
||||
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
|
||||
#define JANET_SANDBOX_COMPILE 32768
|
||||
#define JANET_SANDBOX_ASM 65536
|
||||
#define JANET_SANDBOX_THREADS 131072
|
||||
#define JANET_SANDBOX_UNMARSHAL 262144
|
||||
#define JANET_SANDBOX_ALL (UINT32_MAX)
|
||||
JANET_API void janet_sandbox(uint32_t flags);
|
||||
JANET_API void janet_sandbox_assert(uint32_t forbidden_flags);
|
||||
@@ -1962,7 +2053,14 @@ JANET_API JanetBinding janet_resolve_ext(JanetTable *env, JanetSymbol sym);
|
||||
/* Get values from the core environment. */
|
||||
JANET_API Janet janet_resolve_core(const char *name);
|
||||
|
||||
/* New C API */
|
||||
/* New C API
|
||||
*
|
||||
* The "New" C API is intended to make constructing good documentation and source maps
|
||||
* much more straightforward. This not only ensures doc strings for functions in native
|
||||
* modules, it also add source code mapping for C functions so that programmers can see which
|
||||
* file and line a native function that calls janet_panic came from.
|
||||
*
|
||||
* */
|
||||
|
||||
/* Shorthand for janet C function declarations */
|
||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||
@@ -2220,6 +2318,7 @@ typedef enum {
|
||||
RULE_NTH, /* [nth, rule, tag] */
|
||||
RULE_ONLY_TAGS, /* [rule] */
|
||||
RULE_MATCHSPLICE, /* [rule, constant, tag] */
|
||||
RULE_DEBUG, /* [] */
|
||||
} JanetPegOpcode;
|
||||
|
||||
typedef struct {
|
||||
|
||||
@@ -112,6 +112,8 @@ static JANET_THREAD_LOCAL int gbl_historyi = 0;
|
||||
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
|
||||
static JANET_THREAD_LOCAL int gbl_match_count = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
|
||||
static JANET_THREAD_LOCAL int gbl_history_loaded = 0;
|
||||
static JANET_THREAD_LOCAL char *gbl_history_file = NULL;
|
||||
#endif
|
||||
|
||||
/* Fallback */
|
||||
@@ -430,6 +432,63 @@ static int insert(char c, int draw) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void calc_history_file(void) {
|
||||
char *hist = getenv("JANET_HISTFILE");
|
||||
if (hist != NULL) {
|
||||
gbl_history_file = sdup(hist);
|
||||
} else {
|
||||
gbl_history_file = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
static void loadhistory(void) {
|
||||
if (gbl_history_loaded) return;
|
||||
calc_history_file();
|
||||
gbl_history_loaded = 1;
|
||||
if (NULL == gbl_history_file) return;
|
||||
FILE *history_file = fopen(gbl_history_file, "rb");
|
||||
if (NULL == history_file) return;
|
||||
JanetParser p;
|
||||
janet_parser_init(&p);
|
||||
int c = 0;
|
||||
while ((c = fgetc(history_file))) {
|
||||
if (c == EOF) {
|
||||
janet_parser_eof(&p);
|
||||
} else {
|
||||
janet_parser_consume(&p, c);
|
||||
}
|
||||
|
||||
while (janet_parser_has_more(&p) && gbl_history_count < JANET_HISTORY_MAX) {
|
||||
if (janet_parser_status(&p) == JANET_PARSE_ERROR) {
|
||||
janet_eprintf("bad history file: %s\n", janet_parser_error(&p));
|
||||
goto parsing_done;
|
||||
}
|
||||
Janet x = janet_parser_produce(&p);
|
||||
const char *cstr = (const char *) janet_to_string(x);
|
||||
if (cstr[0]) { /* Drop empty strings */
|
||||
gbl_history[gbl_history_count++] = sdup(cstr);
|
||||
}
|
||||
}
|
||||
|
||||
if (c == EOF) break;
|
||||
}
|
||||
parsing_done:
|
||||
janet_parser_deinit(&p);
|
||||
gbl_historyi = 0;
|
||||
fclose(history_file);
|
||||
}
|
||||
|
||||
static void savehistory(void) {
|
||||
if (gbl_history_count < 1 || (gbl_history_file == NULL)) return;
|
||||
FILE *history_file = fopen(gbl_history_file, "wb");
|
||||
for (int i = 0; i < gbl_history_count; i++) {
|
||||
if (gbl_history[i][0]) { /* Drop empty strings */
|
||||
janet_dynprintf(NULL, history_file, "%j\n", janet_cstringv(gbl_history[i]));
|
||||
}
|
||||
}
|
||||
fclose(history_file);
|
||||
}
|
||||
|
||||
static void historymove(int delta) {
|
||||
if (gbl_history_count > 1) {
|
||||
janet_free(gbl_history[gbl_historyi]);
|
||||
@@ -896,6 +955,7 @@ static int line() {
|
||||
case 3: /* ctrl-c */
|
||||
clearlines();
|
||||
norawmode();
|
||||
savehistory();
|
||||
#ifdef _WIN32
|
||||
ExitProcess(1);
|
||||
#else
|
||||
@@ -1089,17 +1149,21 @@ void janet_line_init() {
|
||||
}
|
||||
|
||||
void janet_line_deinit() {
|
||||
int i;
|
||||
norawmode();
|
||||
for (i = 0; i < gbl_history_count; i++)
|
||||
for (int i = 0; i < gbl_history_count; i++)
|
||||
janet_free(gbl_history[i]);
|
||||
gbl_historyi = 0;
|
||||
if (gbl_history_file) {
|
||||
janet_free(gbl_history_file);
|
||||
gbl_history_file = NULL;
|
||||
}
|
||||
}
|
||||
|
||||
void janet_line_get(const char *p, JanetBuffer *buffer) {
|
||||
gbl_prompt = p;
|
||||
buffer->count = 0;
|
||||
gbl_historyi = 0;
|
||||
loadhistory();
|
||||
if (check_simpleline(buffer)) return;
|
||||
FILE *out = janet_dynfile("err", stderr);
|
||||
if (line()) {
|
||||
@@ -1194,6 +1258,7 @@ int main(int argc, char **argv) {
|
||||
status = janet_loop_fiber(fiber);
|
||||
|
||||
/* Deinitialize vm */
|
||||
savehistory();
|
||||
janet_deinit();
|
||||
janet_line_deinit();
|
||||
|
||||
|
||||
@@ -75,5 +75,80 @@
|
||||
(foo 0)
|
||||
10)
|
||||
|
||||
# Issue #1699 - fuzz case with bad def
|
||||
(def result
|
||||
(compile '(defn sum3
|
||||
"Solve the 3SUM problem in O(n^2) time."
|
||||
[s]
|
||||
(def)tab @{})))
|
||||
(assert (get result :error) "bad sum3 fuzz issue valgrind")
|
||||
|
||||
# Issue #1700
|
||||
(def result
|
||||
(compile
|
||||
'(defn fuzz-case-1
|
||||
[start end &]
|
||||
(if end
|
||||
(if e start (lazy-range (+ 1 start) end)))
|
||||
1)))
|
||||
(assert (get result :error) "fuzz case issue #1700")
|
||||
|
||||
# Issue #1702 - fuzz case with upvalues
|
||||
(def result
|
||||
(compile
|
||||
'(each item [1 2 3]
|
||||
# Generate a lot of upvalues (more than 224)
|
||||
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
|
||||
(with-dyns [:out out-buf] 1))))
|
||||
(assert result "bad upvalues fuzz case")
|
||||
|
||||
# Named argument linting
|
||||
# Enhancement for #1654
|
||||
|
||||
(defn fnamed [&named x y z] [x y z])
|
||||
(defn fkeys [&keys ks] ks)
|
||||
(defn fnamed2 [_a _b _c &named x y z] [x y z])
|
||||
(defn fkeys2 [_a _b _c &keys ks] ks)
|
||||
(defn fnamed3 [{:x x} &named a b c] [x a b c])
|
||||
(defn fnamed4 [_y &opt _z &named a b c] [a b c])
|
||||
(defn fnamed5 [&opt _z &named a b c] [a b c])
|
||||
(defn g [x &opt y &named z] [x y z])
|
||||
|
||||
(defn check-good-compile
|
||||
[code msg]
|
||||
(def lints @[])
|
||||
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result) (empty? lints)) msg))
|
||||
|
||||
(defn check-lint-compile
|
||||
[code msg]
|
||||
(def lints @[])
|
||||
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result) (next lints)) msg))
|
||||
|
||||
(check-good-compile '(fnamed) "named no args")
|
||||
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
|
||||
(check-lint-compile '(fnamed :x) "named odd args")
|
||||
(check-lint-compile '(fnamed :w 0) "named wrong key args")
|
||||
(check-good-compile '(fkeys :a 1) "keys even args")
|
||||
(check-lint-compile '(fkeys :a 1 :b) "keys odd args")
|
||||
(check-good-compile '(fnamed2 nil nil nil) "named 2 no args")
|
||||
(check-good-compile '(fnamed2 nil nil nil :x 1 :y 2 :z 3) "named 2 full args")
|
||||
(check-lint-compile '(fnamed2 nil nil nil :x) "named 2 odd args")
|
||||
(check-lint-compile '(fnamed2 nil nil nil :w 0) "named 2 wrong key args")
|
||||
(check-good-compile '(fkeys2 nil nil nil :a 1) "keys 2 even args")
|
||||
(check-lint-compile '(fkeys2 nil nil nil :a 1 :b) "keys 2 odd args")
|
||||
(check-good-compile '(fnamed3 {:x 1} :a 1 :b 2 :c 3) "named 3 good")
|
||||
(check-lint-compile '(fnamed3 {:x 1} :a 1 :b 2 :d 3) "named 3 lint")
|
||||
(check-good-compile '(fnamed4 10 20 :a 1 :b 2 :c 3) "named 4 good")
|
||||
(check-lint-compile '(fnamed4 10 20 :a 1 :b 2 :d 3) "named 4 lint")
|
||||
(check-good-compile '(fnamed5 10 :a 1 :b 2 :c 3) "named 5 good")
|
||||
(check-lint-compile '(fnamed5 10 :a 1 :b 2 :d 3) "named 5 lint")
|
||||
(check-good-compile '(g 1) "g good 1")
|
||||
(check-good-compile '(g 1 2) "g good 2")
|
||||
(check-good-compile '(g 1 2 :z 10) "g good 3")
|
||||
(check-lint-compile '(g 1 2 :z) "g lint 1")
|
||||
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -202,5 +202,9 @@
|
||||
(assert-no-error "def destructure splice works 2" (do (def (n) [(splice [])]) n))
|
||||
(assert-no-error "var destructure splice works" (do (var [a] [;[1]]) a))
|
||||
|
||||
(end-suite)
|
||||
# Issue #1709
|
||||
(assert (= (macex1 '|(set (my-table [2 1]) 'foo))
|
||||
'(fn :short-fn [] (set (my-table [2 1]) (quote foo))))
|
||||
"Macro expand inside set preserves tuple type correctly")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -55,4 +55,33 @@
|
||||
(ev/sleep 0.2)
|
||||
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
|
||||
|
||||
# Issue #1705 - ev select
|
||||
(def supervisor (ev/chan 10))
|
||||
|
||||
(def ch (ev/chan))
|
||||
(def ch2 (ev/chan))
|
||||
|
||||
(ev/go |(do
|
||||
(ev/select ch ch2)
|
||||
(:close ch)
|
||||
"close ch...")
|
||||
nil supervisor)
|
||||
|
||||
(ev/go |(do
|
||||
(ev/sleep 0.05)
|
||||
(:close ch2)
|
||||
"close ch2...")
|
||||
nil supervisor)
|
||||
|
||||
(assert (let [[status] (ev/take supervisor)] (= status :ok)) "status 1 ev/select")
|
||||
(assert (let [[status] (ev/take supervisor)] (= status :ok)) "status 2 ev/select")
|
||||
(ev/sleep 0.1) # can we do better?
|
||||
(assert (= 0 (ev/count supervisor)) "empty supervisor")
|
||||
|
||||
# Issue #1707
|
||||
(def f (coro (repeat 10 (yield 1))))
|
||||
(resume f)
|
||||
(assert-error "cannot schedule non-new fiber"
|
||||
(ev/go f))
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -63,7 +63,10 @@
|
||||
"strftime january 2014")
|
||||
(assert (= (try (os/strftime "%%%d%t") ([err] err))
|
||||
"invalid conversion specifier '%t'")
|
||||
"invalid conversion specifier")
|
||||
"invalid conversion specifier 1")
|
||||
(assert (= (try (os/strftime "%H:%M:%") ([err] err))
|
||||
"invalid conversion specifier")
|
||||
"invalid conversion specifier 2")
|
||||
|
||||
# 07db4c530
|
||||
(os/setenv "TESTENV1" "v1")
|
||||
@@ -174,8 +177,27 @@
|
||||
:px
|
||||
{:out dn :err dn})))
|
||||
|
||||
# os/execute IO redirection with more windows flags
|
||||
(assert-no-error "IO redirection more windows flags"
|
||||
(defn devnull []
|
||||
(def os (os/which))
|
||||
(def path (if (or (= os :mingw) (= os :windows))
|
||||
"NUL"
|
||||
"/dev/null"))
|
||||
(os/open path (if (= os :windows) :wWI :wW)))
|
||||
(with [dn (devnull)]
|
||||
(os/execute [;run janet
|
||||
"-e"
|
||||
"(print :foo) (eprint :bar)"]
|
||||
:px
|
||||
{:out dn :err dn})))
|
||||
|
||||
# Issue 16922
|
||||
(assert-error "os/realpath errors when path does not exist"
|
||||
(os/realpath "abc123def456"))
|
||||
|
||||
# os/which changes
|
||||
(assert (os/which (os/which)) "os/which 1 arg")
|
||||
(assert (not (os/which :gobbledegook)) "os/which 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -101,9 +101,9 @@
|
||||
# 798c88b4c
|
||||
(def csv
|
||||
'{:field (+
|
||||
(* `"` (% (any (+ (<- (if-not `"` 1))
|
||||
(* (constant `"`) `""`)))) `"`)
|
||||
(<- (any (if-not (set ",\n") 1))))
|
||||
(* `"` (% (any (+ (<- (if-not `"` 1))
|
||||
(* (constant `"`) `""`)))) `"`)
|
||||
(<- (any (if-not (set ",\n") 1))))
|
||||
:main (* :field (any (* "," :field)) (+ "\n" -1))})
|
||||
|
||||
(defn check-csv
|
||||
@@ -266,6 +266,12 @@
|
||||
(marshpeg '(sub "abcdf" "abc"))
|
||||
(marshpeg '(* (sub 1 1)))
|
||||
(marshpeg '(split "," (+ "a" "b" "c")))
|
||||
(marshpeg "")
|
||||
(marshpeg 1)
|
||||
(marshpeg 0)
|
||||
(marshpeg -1)
|
||||
(marshpeg '(drop 1))
|
||||
(marshpeg '(accumulate 1))
|
||||
|
||||
# Peg swallowing errors
|
||||
# 159651117
|
||||
@@ -345,16 +351,16 @@
|
||||
# Using a large test grammar
|
||||
# cf05ff610
|
||||
(def- specials {'fn true
|
||||
'var true
|
||||
'do true
|
||||
'while true
|
||||
'def true
|
||||
'splice true
|
||||
'set true
|
||||
'unquote true
|
||||
'quasiquote true
|
||||
'quote true
|
||||
'if 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))
|
||||
|
||||
@@ -399,7 +405,7 @@
|
||||
:struct (* '"{" :root2 (+ '"}" (error "")))
|
||||
:parray (* '"@" :ptuple)
|
||||
:barray (* '"@" :btuple)
|
||||
:dict (* '"@" :struct)
|
||||
:dict (* '"@" :struct)
|
||||
:main (+ :root (error ""))})
|
||||
|
||||
(def p (peg/compile grammar))
|
||||
@@ -563,18 +569,18 @@
|
||||
(assert (= (string (f peg subst text)) expected) name))
|
||||
|
||||
(peg-test "peg/replace has access to captures"
|
||||
peg/replace
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b.c")
|
||||
peg/replace
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b.c")
|
||||
|
||||
(peg-test "peg/replace-all has access to captures"
|
||||
peg/replace-all
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b -> B, .c")
|
||||
peg/replace-all
|
||||
~(sequence "." (capture (set "ab")))
|
||||
(fn [str char] (string/format "%s -> %s, " str (string/ascii-upper char)))
|
||||
".a.b.c"
|
||||
".a -> A, .b -> B, .c")
|
||||
|
||||
# Peg bug
|
||||
# eab5f67c5
|
||||
@@ -648,20 +654,20 @@
|
||||
|
||||
# issue #1026 - 9341081a4
|
||||
(assert (deep=
|
||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||
@[]) "peg not")
|
||||
(peg/match '(not (* (constant 7) "a")) "hello")
|
||||
@[]) "peg not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||
@[]) "peg if-not")
|
||||
(peg/match '(if-not (* (constant 7) "a") "hello") "hello")
|
||||
@[]) "peg if-not")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if-not drop")
|
||||
(peg/match '(if-not (drop (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if-not drop")
|
||||
|
||||
(assert (deep=
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(defn test [name peg input expected]
|
||||
(assert-no-error "compile peg" (peg/compile peg))
|
||||
@@ -669,143 +675,143 @@
|
||||
(assert (deep= (peg/match peg input) expected) name))
|
||||
|
||||
(test "sub: matches the same input twice"
|
||||
~(sub "abcd" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
~(sub "abcd" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: second pattern cannot match more than the first pattern"
|
||||
~(sub "abcd" "abcde")
|
||||
"abcdef"
|
||||
nil)
|
||||
~(sub "abcd" "abcde")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if first pattern fails"
|
||||
~(sub "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
~(sub "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: fails if second pattern fails"
|
||||
~(sub "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
~(sub "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "sub: keeps captures from both patterns"
|
||||
~(sub '"abcd" '"abc")
|
||||
"abcdef"
|
||||
@["abcd" "abc"])
|
||||
~(sub '"abcd" '"abc")
|
||||
"abcdef"
|
||||
@["abcd" "abc"])
|
||||
|
||||
(test "sub: second pattern can reference captures from first"
|
||||
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
||||
"abcdef"
|
||||
@[5 "abc" "abc"])
|
||||
~(* (constant 5 :tag) (sub (capture "abc" :tag) (backref :tag)))
|
||||
"abcdef"
|
||||
@[5 "abc" "abc"])
|
||||
|
||||
(test "sub: second pattern can't see past what the first pattern matches"
|
||||
~(sub "abc" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
~(sub "abc" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "sub: positions inside second match are still relative to the entire input"
|
||||
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
~(* "one\ntw" (sub "o" (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
|
||||
(test "sub: advances to the end of the first pattern's match"
|
||||
~(* (sub "abc" "ab") "d")
|
||||
"abcdef"
|
||||
@[])
|
||||
~(* (sub "abc" "ab") "d")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "til: basic matching"
|
||||
~(til "d" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
~(til "d" "abc")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "til: second pattern can't see past the first occurrence of first pattern"
|
||||
~(til "d" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
~(til "d" (* "abc" -1))
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "til: fails if first pattern fails"
|
||||
~(til "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
~(til "x" "abc")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "til: fails if second pattern fails"
|
||||
~(til "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
~(til "abc" "x")
|
||||
"abcdef"
|
||||
nil)
|
||||
|
||||
(test "til: discards captures from initial pattern"
|
||||
~(til '"d" '"abc")
|
||||
"abcdef"
|
||||
@["abc"])
|
||||
~(til '"d" '"abc")
|
||||
"abcdef"
|
||||
@["abc"])
|
||||
|
||||
(test "til: positions inside second match are still relative to the entire input"
|
||||
~(* "one\ntw" (til 0 (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
~(* "one\ntw" (til 0 (* ($) (line) (column))))
|
||||
"one\ntwo\nthree\n"
|
||||
@[6 2 3])
|
||||
|
||||
(test "til: advances to the end of the first pattern's first occurrence"
|
||||
~(* (til "d" "ab") "e")
|
||||
"abcdef"
|
||||
@[])
|
||||
~(* (til "d" "ab") "e")
|
||||
"abcdef"
|
||||
@[])
|
||||
|
||||
(test "split: basic functionality"
|
||||
~(split "," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
~(split "," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: drops captures from separator pattern"
|
||||
~(split '"," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
~(split '"," '1)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: can match empty subpatterns"
|
||||
~(split "," ':w*)
|
||||
",a,,bar,,,c,,"
|
||||
@["" "a" "" "bar" "" "" "c" "" ""])
|
||||
~(split "," ':w*)
|
||||
",a,,bar,,,c,,"
|
||||
@["" "a" "" "bar" "" "" "c" "" ""])
|
||||
|
||||
(test "split: subpattern is limited to only text before the separator"
|
||||
~(split "," '(to -1))
|
||||
"a,,bar,c"
|
||||
@["a" "" "bar" "c"])
|
||||
~(split "," '(to -1))
|
||||
"a,,bar,c"
|
||||
@["a" "" "bar" "c"])
|
||||
|
||||
(test "split: fails if any subpattern fails"
|
||||
~(split "," '"a")
|
||||
"a,a,b"
|
||||
nil)
|
||||
~(split "," '"a")
|
||||
"a,a,b"
|
||||
nil)
|
||||
|
||||
(test "split: separator does not have to match anything"
|
||||
~(split "x" '(to -1))
|
||||
"a,a,b"
|
||||
@["a,a,b"])
|
||||
~(split "x" '(to -1))
|
||||
"a,a,b"
|
||||
@["a,a,b"])
|
||||
|
||||
(test "split: always consumes entire input"
|
||||
~(split 1 '"")
|
||||
"abc"
|
||||
@["" "" "" ""])
|
||||
~(split 1 '"")
|
||||
"abc"
|
||||
@["" "" "" ""])
|
||||
|
||||
(test "split: separator can be an arbitrary PEG"
|
||||
~(split :s+ '(to -1))
|
||||
"a b c"
|
||||
@["a" "b" "c"])
|
||||
~(split :s+ '(to -1))
|
||||
"a b c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "split: does not advance past the end of the input"
|
||||
~(* (split "," ':w+) 0)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
~(* (split "," ':w+) 0)
|
||||
"a,b,c"
|
||||
@["a" "b" "c"])
|
||||
|
||||
(test "nth 1"
|
||||
~{:prefix (number :d+ nil :n)
|
||||
:word '(lenprefix (-> :n) :w)
|
||||
:main (some (nth 1 (* :prefix ":" :word)))}
|
||||
"5:apple6:banana6:cherry"
|
||||
@["apple" "banana" "cherry"])
|
||||
~{:prefix (number :d+ nil :n)
|
||||
:word '(lenprefix (-> :n) :w)
|
||||
:main (some (nth 1 (* :prefix ":" :word)))}
|
||||
"5:apple6:banana6:cherry"
|
||||
@["apple" "banana" "cherry"])
|
||||
|
||||
(test "only-tags 1"
|
||||
~{:prefix (number :d+ nil :n)
|
||||
:word (capture (lenprefix (-> :n) :w) :W)
|
||||
:main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
|
||||
"5:apple6:banana6:cherry"
|
||||
@["apple" "banana" "cherry"])
|
||||
~{:prefix (number :d+ nil :n)
|
||||
:word (capture (lenprefix (-> :n) :w) :W)
|
||||
:main (some (* (only-tags (* :prefix ":" :word)) (-> :W)))}
|
||||
"5:apple6:banana6:cherry"
|
||||
@["apple" "banana" "cherry"])
|
||||
|
||||
# Issue #1539 - make sure split with "" doesn't infinite loop/oom
|
||||
(test "issue 1539"
|
||||
@@ -814,9 +820,9 @@
|
||||
nil)
|
||||
|
||||
(test "issue 1539 pt. 2"
|
||||
~(split "," (capture 0))
|
||||
"abc123,,,,"
|
||||
@["" "" "" "" ""])
|
||||
~(split "," (capture 0))
|
||||
"abc123,,,,"
|
||||
@["" "" "" "" ""])
|
||||
|
||||
# Issue #1549 - allow buffers as peg literals
|
||||
(test "issue 1549"
|
||||
@@ -845,4 +851,98 @@
|
||||
"abc"
|
||||
@[["b" "b" "b"]])
|
||||
|
||||
# Debug and ?? tests.
|
||||
(defn test-stderr [name peg input expected-matches expected-stderr]
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* true]
|
||||
(test name peg input expected-matches))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* false]
|
||||
(test name peg input expected-matches))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(test-stderr "?? long form"
|
||||
'(* (debug) "abc")
|
||||
"abc"
|
||||
@[]
|
||||
"?? at [abc] (index 0)\n")
|
||||
|
||||
(test-stderr "?? short form"
|
||||
'(* (??) "abc")
|
||||
"abc"
|
||||
@[]
|
||||
"?? at [abc] (index 0)\n")
|
||||
|
||||
(test-stderr "?? end of text"
|
||||
'(* "abc" (??))
|
||||
"abc"
|
||||
@[]
|
||||
"?? at [] (index 3)\n")
|
||||
|
||||
(test-stderr "?? between rules"
|
||||
'(* "a" (??) "bc")
|
||||
"abc"
|
||||
@[]
|
||||
"?? at [bc] (index 1)\n")
|
||||
|
||||
(test-stderr
|
||||
"?? stack display, string"
|
||||
'(* (<- "a") (??) "bc")
|
||||
"abc"
|
||||
@["a"]
|
||||
(string/format "?? at [bc] (index 1)\nstack [1]:\n [0]: %M\n" "a"))
|
||||
|
||||
(test-stderr
|
||||
"?? stack display, multiple types"
|
||||
'(* (<- "a") (number :d) (constant true) (constant {}) (constant @[]) (??) "bc")
|
||||
"a1bc"
|
||||
@["a" 1 true {} @[]]
|
||||
(string/format "?? at [bc] (index 2)\nstack [5]:\n [0]: %M\n [1]: %M\n [2]: %M\n [3]: %M\n [4]: %M\n" "a" 1 true {} @[]))
|
||||
|
||||
(marshpeg '(* (??) "abc"))
|
||||
(marshpeg '(* (some (debug)) (??) "abc"))
|
||||
|
||||
(test-stderr
|
||||
"?? displays when capture fails"
|
||||
'(* '1 (??) "x")
|
||||
"abc"
|
||||
nil
|
||||
(string/format "?? at [bc] (index 1)\nstack [1]:\n [0]: %M\n" "a"))
|
||||
|
||||
(test-stderr-no-color
|
||||
"?? displays accumuate and tagged captures"
|
||||
'(* '1 '2 (% (* '1 (??) (<- 2 :tag) '3 (backref :tag) (??))))
|
||||
"aksjndkajsnd"
|
||||
@["a" "ks" "jndkajnd"]
|
||||
(string/replace-all
|
||||
# In case on windows someone messes with line endings.
|
||||
"\r" ""
|
||||
```
|
||||
?? at [ndkajsnd] (index 4)
|
||||
accumulate buffer: @"j"
|
||||
stack [2]:
|
||||
[0]: "a"
|
||||
[1]: "ks"
|
||||
tag stack [3]:
|
||||
[0] tag=0: "a"
|
||||
[1] tag=0: "ks"
|
||||
[2] tag=0: "j"
|
||||
?? at [snd] (index 9)
|
||||
accumulate buffer: @"jndkajnd"
|
||||
stack [2]:
|
||||
[0]: "a"
|
||||
[1]: "ks"
|
||||
tag stack [6]:
|
||||
[0] tag=0: "a"
|
||||
[1] tag=0: "ks"
|
||||
[2] tag=0: "j"
|
||||
[3] tag=1: "nd"
|
||||
[4] tag=0: "kaj"
|
||||
[5] tag=0: "nd"
|
||||
|
||||
```))
|
||||
|
||||
(end-suite)
|
||||
|
||||
Reference in New Issue
Block a user