mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2025-04-08 00:06:38 +00:00
Code Issues 1 Releases Wiki Activity

Merge branch 'master' into compile-opt

Browse Source
This commit is contained in:
Calvin Rose 2025-02-17 18:08:17 -06:00
commit 059253fdee
31 changed files with 709 additions and 262 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
.github/workflows/codeql.yml vendored
View File

@ -27,15 +27,16 @@ jobs:
uses: actions/checkout@v3
- name: Initialize CodeQL
uses: github/codeql-action/init@v2
uses: github/codeql-action/init@v3
with:
languages: ${{ matrix.language }}
queries: +security-and-quality
tools: linked
- name: Autobuild
uses: github/codeql-action/autobuild@v2
uses: github/codeql-action/autobuild@v3
- name: Perform CodeQL Analysis
uses: github/codeql-action/analyze@v2
uses: github/codeql-action/analyze@v3
with:
category: "/language:${{ matrix.language }}"

3
.github/workflows/test.yml vendored
View File

@ -38,6 +38,9 @@ jobs:
- name: Test the project
shell: cmd
run: build_win test
- name: Test installer build
shell: cmd
run: build_win dist
test-windows-min:
name: Build and test on Windows Minimal build

16
CHANGELOG.md
View File

@ -2,6 +2,22 @@
All notable changes to this project will be documented in this file.
## ??? - Unreleased
- Improve `?` peg special termination behavior
- Add IEEE hex floats to grammar.
- Add buffer peg literal support
- Improve `split` peg special edge case behavior
- Add Arm64 .msi support
- Add `no-reuse` argument to `net/listen` to disable reusing server sockets
- Add `struct/rawget`
- Fix `deep=` and `deep-not=` to better handle degenerate cases with mutable table keys
- Long strings will now dedent on `\r\n` instead of just `\n`.
- Add `ev/to-file` for synchronous resource operations
- Improve `file/open` error message by including path
## 1.37.1 - 2024-12-05
- Fix meson cross compilation
- Update timeout documentation for networking APIs: timeouts raise errors and do not return nil.
- Add `janet_addtimeout_nil(double sec);` to the C API.
- Change string hashing.
- Fix string equality bug.
- Add `assertf`

2
README.md
View File

@ -207,7 +207,7 @@ Alternatively, install the package directly with `pkgin install janet`.
To build an `.msi` installer executable, in addition to the above steps, you will have to:
5. Install, or otherwise add to your PATH the [WiX 3.11 Toolset](https://github.com/wixtoolset/wix3/releases).
5. Install, or otherwise add to your PATH the [WiX 3.14 Toolset](https://github.com/wixtoolset/wix3/releases).
6. Run `build_win dist`.
Now you should have an `.msi`. You can run `build_win install` to install the `.msi`, or execute the file itself.

13
build_win.bat
View File

@ -91,7 +91,7 @@ exit /b 0
@rem Clean build artifacts
:CLEAN
del *.exe *.lib *.exp
del *.exe *.lib *.exp *.msi *.wixpdb
rd /s /q build
if exist dist (
rd /s /q dist
@ -138,11 +138,18 @@ if defined APPVEYOR_REPO_TAG_NAME (
set RELEASE_VERSION=%JANET_VERSION%
)
if defined CI (
set WIXBIN="c:\Program Files (x86)\WiX Toolset v3.11\bin\"
set WIXBIN="%WIX%bin\"
echo WIXBIN = %WIXBIN%
) else (
set WIXBIN=
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %BUILDARCH% -out build\
set WIXARCH=%BUILDARCH%
if "%WIXARCH%"=="aarch64" (
set WIXARCH=arm64
)
%WIXBIN%candle.exe tools\msi\janet.wxs -arch %WIXARCH% -out build\
%WIXBIN%light.exe "-sice:ICE38" -b tools\msi -ext WixUIExtension build\janet.wixobj -out janet-%RELEASE_VERSION%-windows-%BUILDARCH%-installer.msi
exit /b 0

29
meson.build
View File

@ -20,14 +20,23 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.37.0')
version : '1.37.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
header_path = join_paths(get_option('prefix'), get_option('includedir'), 'janet')
# Link math library on all systems
# Compilers
cc = meson.get_compiler('c')
native_cc = meson.get_compiler('c', native : true)
# Native deps
native_m_dep = native_cc.find_library('m', required : false)
native_dl_dep = native_cc.find_library('dl', required : false)
native_android_spawn_dep = native_cc.find_library('android-spawn', required : false)
native_thread_dep = dependency('threads', native : true)
# Deps
m_dep = cc.find_library('m', required : false)
dl_dep = cc.find_library('dl', required : false)
android_spawn_dep = cc.find_library('android-spawn', required : false)
@ -167,11 +176,18 @@ mainclient_src = [
'src/mainclient/shell.c'
]
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
janet_native_dependencies = [native_m_dep, native_dl_dep, native_android_spawn_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
janet_native_dependencies += native_thread_dep
endif
# Build boot binary
janet_boot = executable('janet-boot', core_src, boot_src,
include_directories : incdir,
c_args : '-DJANET_BOOTSTRAP',
dependencies : [m_dep, dl_dep, thread_dep, android_spawn_dep],
dependencies : janet_native_dependencies,
native : true)
# Build janet.c
@ -184,11 +200,6 @@ janetc = custom_target('janetc',
'JANET_PATH', janet_path
])
janet_dependencies = [m_dep, dl_dep, android_spawn_dep]
if not get_option('single_threaded')
janet_dependencies += thread_dep
endif
# Allow building with no shared library
if cc.has_argument('-fvisibility=hidden')
lib_cflags = ['-fvisibility=hidden']
@ -234,7 +245,7 @@ if meson.is_cross_build()
endif
janet_nativeclient = executable('janet-native', janetc, mainclient_src,
include_directories : incdir,
dependencies : janet_dependencies,
dependencies : janet_native_dependencies,
c_args : extra_native_cflags,
native : true)
else

131
src/boot/boot.janet
View File

@ -996,7 +996,7 @@
(defn reduce2
``The 2-argument version of `reduce` that does not take an initialization value.
Instead, the first element of the array is used for initialization.``
Instead, the first element of the array is used for initialization. If `ind` is empty, will evaluate to nil.``
[f ind]
(var k (next ind))
(if (= nil k) (break nil))
@ -1311,7 +1311,7 @@
(defdyn *redef* "When set, allow dynamically rebinding top level defs. Will slow generated code and is intended to be used for development.")
(defdyn *debug* "Enables a built in debugger on errors and other useful features for debugging in a repl.")
(defdyn *exit* "When set, will cause the current context to complete. Can be set to exit from repl (or file), for example.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit. By default, `run-context` will return nil.")
(defdyn *exit-value* "Set the return value from `run-context` upon an exit.")
(defdyn *task-id* "When spawning a thread or fiber, the task-id can be assigned for concurrency control.")
(defdyn *current-file*
@ -2219,56 +2219,31 @@
(map-template :some res pred ind inds)
res)
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(case tx
:tuple (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:array (or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
:struct (deep-not= (kvs x) (kvs y))
:table (deep-not= (table/to-struct x) (table/to-struct y))
:buffer (not= (string x) (string y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn freeze
`Freeze an object (make it immutable) and do a deep copy, making
child values also immutable. Closures, fibers, and abstract types
will not be recursively frozen, but all other types will.`
[x]
(case (type x)
:array (tuple/slice (map freeze x))
:tuple (tuple/slice (map freeze x))
:table (if-let [p (table/getproto x)]
(freeze (merge (table/clone p) x))
(struct ;(map freeze (kvs x))))
:struct (struct ;(map freeze (kvs x)))
:buffer (string x)
(def tx (type x))
(cond
(or (= tx :array) (= tx :tuple))
(tuple/slice (map freeze x))
(or (= tx :table) (= tx :struct))
(let [temp-tab @{}]
# Handle multiple unique keys that freeze. Result should
# be independent of iteration order.
(eachp [k v] x
(def kk (freeze k))
(def vv (freeze v))
(def old (get temp-tab kk))
(def new (if (= nil old) vv (max vv old)))
(put temp-tab kk new))
(table/to-struct temp-tab (freeze (getproto x))))
(= tx :buffer)
(string x)
x))
(defn thaw
@ -2284,6 +2259,41 @@
:string (buffer ds)
ds))
(defn deep-not=
``Like `not=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `not=`.``
[x y]
(def tx (type x))
(or
(not= tx (type y))
(cond
(or (= tx :tuple) (= tx :array))
(or (not= (length x) (length y))
(do
(var ret false)
(forv i 0 (length x)
(def xx (in x i))
(def yy (in y i))
(if (deep-not= xx yy)
(break (set ret true))))
ret))
(or (= tx :struct) (= tx :table))
(or (not= (length x) (length y))
(do
(def rawget (if (= tx :struct) struct/rawget table/rawget))
(var ret false)
(eachp [k v] x
(if (deep-not= (rawget y k) v) (break (set ret true))))
ret))
(= tx :buffer) (not= 0 (- (length x) (length y)) (memcmp x y))
(not= x y))))
(defn deep=
``Like `=`, but mutable types (arrays, tables, buffers) are considered
equal if they have identical structure. Much slower than `=`.``
[x y]
(not (deep-not= x y)))
(defn macex
``Expand macros completely.
`on-binding` is an optional callback for whenever a normal symbolic binding
@ -2335,17 +2345,11 @@
(defmacro short-fn
```
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the 0-indexed
argument of the function. `$` is also an alias for the first (index 0) argument.
The `$&` symbol will make the anonymous function variadic if it appears in the
body of the function, and can be combined with positional arguments.
Example usage:
(short-fn (+ $ $)) # A function that doubles its arguments.
(short-fn (string $0 $1)) # accepting multiple args.
|(+ $ $) # use pipe reader macro for terse function literals.
|(+ $&) # variadic functions
Shorthand for `fn`. Arguments are given as `$n`, where `n` is the
0-indexed argument of the function. `$` is also an alias for the
first (index 0) argument. The `$&` symbol will make the anonymous
function variadic if it appears in the body of the function, and
can be combined with positional arguments.
```
[arg &opt name]
(var max-param-seen -1)
@ -2665,7 +2669,6 @@
(do
(var pindex 0)
(var pstatus nil)
(def len (length buf))
(when (= len 0)
(:eof p)
@ -2855,8 +2858,8 @@
(when (and (string? pattern) (string/has-prefix? ":sys:/" pattern))
(set last-index index)
(array/push copies [(string/replace ":sys:" path pattern) ;(drop 1 entry)])))
(array/insert mp (+ 1 last-index) ;copies)
mp)
(array/insert mp (+ 1 last-index) ;copies)
mp)
(module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source)
@ -3874,8 +3877,8 @@
(compwhen (dyn 'net/listen)
(defn net/server
"Start a server asynchronously with `net/listen` and `net/accept-loop`. Returns the new server stream."
[host port &opt handler type]
(def s (net/listen host port type))
[host port &opt handler type no-reuse]
(def s (net/listen host port type no-reuse))
(if handler
(ev/go (fn [] (net/accept-loop s handler))))
s))
@ -4097,7 +4100,7 @@
(when (empty? b) (buffer/trim b) (os/chmod to perm) (break))
(file/write fto b)
(buffer/clear b)))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "destination file %s cannot be opened for writing" to))
(errorf "source file %s cannot be opened for reading" from)))
(defn- copyrf

6
src/conf/janetconf.h
View File

@ -5,9 +5,9 @@
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 37
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.37.0-dev"
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.37.1"
/* #define JANET_BUILD "local" */

12
src/core/capi.c
View File

@ -62,6 +62,18 @@ JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
void janet_signalv(JanetSignal sig, Janet message) {
if (janet_vm.return_reg != NULL) {
/* Should match logic in janet_call for coercing everything not ok to an error (no awaits, yields, etc.) */
if (janet_vm.coerce_error && sig != JANET_SIGNAL_OK) {
#ifdef JANET_EV
if (NULL != janet_vm.root_fiber && sig == JANET_SIGNAL_EVENT) {
janet_vm.root_fiber->sched_id++;
}
#endif
if (sig != JANET_SIGNAL_ERROR) {
message = janet_wrap_string(janet_formatc("%v coerced from %s to error", message, janet_signal_names[sig]));
}
sig = JANET_SIGNAL_ERROR;
}
*janet_vm.return_reg = message;
if (NULL != janet_vm.fiber) {
janet_vm.fiber->flags |= JANET_FIBER_DID_LONGJUMP;

162
src/core/corelib.c
View File

@ -449,8 +449,9 @@ JANET_CORE_FN(janet_core_range,
}
count = (count > 0) ? count : 0;
int32_t int_count;
janet_assert(count >= 0, "bad range code");
if (count > (double) INT32_MAX) {
int_count = INT32_MAX;
janet_panicf("range is too large, %f elements", count);
} else {
int_count = (int32_t) ceil(count);
}
@ -1001,12 +1002,11 @@ static void make_apply(JanetTable *env) {
janet_quick_asm(env, JANET_FUN_APPLY | JANET_FUNCDEF_FLAG_VARARG,
"apply", 1, 1, INT32_MAX, 6, apply_asm, sizeof(apply_asm),
JDOC("(apply f & args)\n\n"
"Applies a function to a variable number of arguments. Each element in args "
"is used as an argument to f, except the last element in args, which is expected to "
"be an array-like. Each element in this last argument is then also pushed as an argument to "
"f. For example:\n\n"
"\t(apply + 1000 (range 10))\n\n"
"sums the first 10 integers and 1000."));
"Applies a function f to a variable number of arguments. Each "
"element in args is used as an argument to f, except the last "
"element in args, which is expected to be an array or a tuple. "
"Each element in this last argument is then also pushed as an "
"argument to f."));
}
static const uint32_t error_asm[] = {
@ -1159,82 +1159,82 @@ JanetTable *janet_core_env(JanetTable *replacements) {
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
"Gets the next key in a data structure. Can be used to iterate through "
"the keys of a data structure in an unspecified order. Keys are guaranteed "
"to be seen only once per iteration if the data structure is not mutated "
"during iteration. If key is nil, next returns the first key. If next "
"returns nil, there are no more keys to iterate through."));
janet_quick_asm(env, JANET_FUN_PROP,
"propagate", 2, 2, 2, 2, propagate_asm, sizeof(propagate_asm),
JDOC("(propagate x fiber)\n\n"
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
"Propagate a signal from a fiber to the current fiber and "
"set the last value of the current fiber to `x`. The signal "
"value is then available as the status of the current fiber. "
"The resulting stack trace from the current fiber will include "
"frames from fiber. If fiber is in a state that can be resumed, "
"resuming the current fiber will first resume `fiber`. "
"This function can be used to re-raise an error without losing "
"the original stack trace."));
janet_quick_asm(env, JANET_FUN_DEBUG,
"debug", 1, 0, 1, 1, debug_asm, sizeof(debug_asm),
JDOC("(debug &opt x)\n\n"
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume."));
"Throws a debug signal that can be caught by a parent fiber and used to inspect "
"the running state of the current fiber. Returns the value passed in by resume."));
janet_quick_asm(env, JANET_FUN_ERROR,
"error", 1, 1, 1, 1, error_asm, sizeof(error_asm),
JDOC("(error e)\n\n"
"Throws an error e that can be caught and handled by a parent fiber."));
"Throws an error e that can be caught and handled by a parent fiber."));
janet_quick_asm(env, JANET_FUN_YIELD,
"yield", 1, 0, 1, 2, yield_asm, sizeof(yield_asm),
JDOC("(yield &opt x)\n\n"
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
"Yield a value to a parent fiber. When a fiber yields, its execution is paused until "
"another thread resumes it. The fiber will then resume, and the last yield call will "
"return the value that was passed to resume."));
janet_quick_asm(env, JANET_FUN_CANCEL,
"cancel", 2, 2, 2, 2, cancel_asm, sizeof(cancel_asm),
JDOC("(cancel fiber err)\n\n"
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
"Resume a fiber but have it immediately raise an error. This lets a programmer unwind a pending fiber. "
"Returns the same result as resume."));
janet_quick_asm(env, JANET_FUN_RESUME,
"resume", 2, 1, 2, 2, resume_asm, sizeof(resume_asm),
JDOC("(resume fiber &opt x)\n\n"
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber."));
"Resume a new or suspended fiber and optionally pass in a value to the fiber that "
"will be returned to the last yield in the case of a pending fiber, or the argument to "
"the dispatch function in the case of a new fiber. Returns either the return result of "
"the fiber's dispatch function, or the value from the next yield call in fiber."));
janet_quick_asm(env, JANET_FUN_IN,
"in", 3, 2, 3, 4, in_asm, sizeof(in_asm),
JDOC("(in ds key &opt dflt)\n\n"
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found."));
"Get value in ds at key, works on associative data structures. Arrays, tuples, tables, structs, "
"strings, symbols, and buffers are all associative and can be used. Arrays, tuples, strings, buffers, "
"and symbols must use integer keys that are in bounds or an error is raised. Structs and tables can "
"take any value as a key except nil and will return nil or dflt if not found."));
janet_quick_asm(env, JANET_FUN_GET,
"get", 3, 2, 3, 4, get_asm, sizeof(in_asm),
JDOC("(get ds key &opt dflt)\n\n"
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error."));
"Get the value mapped to key in data structure ds, and return dflt or nil if not found. "
"Similar to in, but will not throw an error if the key is invalid for the data structure "
"unless the data structure is an abstract type. In that case, the abstract type getter may throw "
"an error."));
janet_quick_asm(env, JANET_FUN_PUT,
"put", 3, 3, 3, 3, put_asm, sizeof(put_asm),
JDOC("(put ds key value)\n\n"
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
"Associate a key with a value in any mutable associative data structure. Indexed data structures "
"(arrays and buffers) only accept non-negative integer keys, and will expand if an out of bounds "
"value is provided. In an array, extra space will be filled with nils, and in a buffer, extra "
"space will be filled with 0 bytes. In a table, putting a key that is contained in the table prototype "
"will hide the association defined by the prototype, but will not mutate the prototype table. Putting "
"a value nil into a table will remove the key from the table. Returns the data structure ds."));
janet_quick_asm(env, JANET_FUN_LENGTH,
"length", 1, 1, 1, 1, length_asm, sizeof(length_asm),
JDOC("(length ds)\n\n"
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure."));
"Returns the length or count of a data structure in constant time as an integer. For "
"structs and tables, returns the number of key-value pairs in the data structure."));
janet_quick_asm(env, JANET_FUN_BNOT,
"bnot", 1, 1, 1, 1, bnot_asm, sizeof(bnot_asm),
JDOC("(bnot x)\n\nReturns the bit-wise inverse of integer x."));
@ -1243,74 +1243,74 @@ JanetTable *janet_core_env(JanetTable *replacements) {
/* Variadic ops */
templatize_varop(env, JANET_FUN_ADD, "+", 0, 0, JOP_ADD,
JDOC("(+ & xs)\n\n"
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
"Returns the sum of all xs. xs must be integers or real numbers only. If xs is empty, return 0."));
templatize_varop(env, JANET_FUN_SUBTRACT, "-", 0, 0, JOP_SUBTRACT,
JDOC("(- & xs)\n\n"
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements."));
"Returns the difference of xs. If xs is empty, returns 0. If xs has one element, returns the "
"negative value of that element. Otherwise, returns the first element in xs minus the sum of "
"the rest of the elements."));
templatize_varop(env, JANET_FUN_MULTIPLY, "*", 1, 1, JOP_MULTIPLY,
JDOC("(* & xs)\n\n"
"Returns the product of all elements in xs. If xs is empty, returns 1."));
"Returns the product of all elements in xs. If xs is empty, returns 1."));
templatize_varop(env, JANET_FUN_DIVIDE, "/", 1, 1, JOP_DIVIDE,
JDOC("(/ & xs)\n\n"
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
"Returns the quotient of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_DIVIDE_FLOOR, "div", 1, 1, JOP_DIVIDE_FLOOR,
JDOC("(div & xs)\n\n"
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
"Returns the floored division of xs. If xs is empty, returns 1. If xs has one value x, returns "
"the reciprocal of x. Otherwise return the first value of xs repeatedly divided by the remaining "
"values."));
templatize_varop(env, JANET_FUN_MODULO, "mod", 0, 1, JOP_MODULO,
JDOC("(mod & xs)\n\n"
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
"Returns the result of applying the modulo operator on the first value of xs with each remaining value. "
"`(mod x 0)` is defined to be `x`."));
templatize_varop(env, JANET_FUN_REMAINDER, "%", 0, 1, JOP_REMAINDER,
JDOC("(% & xs)\n\n"
"Returns the remainder of dividing the first value of xs by each remaining value."));
"Returns the remainder of dividing the first value of xs by each remaining value."));
templatize_varop(env, JANET_FUN_BAND, "band", -1, -1, JOP_BAND,
JDOC("(band & xs)\n\n"
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
"Returns the bit-wise and of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BOR, "bor", 0, 0, JOP_BOR,
JDOC("(bor & xs)\n\n"
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
"Returns the bit-wise or of all values in xs. Each x in xs must be an integer."));
templatize_varop(env, JANET_FUN_BXOR, "bxor", 0, 0, JOP_BXOR,
JDOC("(bxor & xs)\n\n"
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
"Returns the bit-wise xor of all values in xs. Each in xs must be an integer."));
templatize_varop(env, JANET_FUN_LSHIFT, "blshift", 1, 1, JOP_SHIFT_LEFT,
JDOC("(blshift x & shifts)\n\n"
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
"Returns the value of x bit shifted left by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFT, "brshift", 1, 1, JOP_SHIFT_RIGHT,
JDOC("(brshift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer."));
templatize_varop(env, JANET_FUN_RSHIFTU, "brushift", 1, 1, JOP_SHIFT_RIGHT_UNSIGNED,
JDOC("(brushift x & shifts)\n\n"
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive."));
"Returns the value of x bit shifted right by the sum of all values in shifts. x "
"and each element in shift must be an integer. The sign of x is not preserved, so "
"for positive shifts the return value will always be positive."));
/* Variadic comparators */
templatize_comparator(env, JANET_FUN_GT, ">", 0, JOP_GREATER_THAN,
JDOC("(> & xs)\n\n"
"Check if xs is in descending order. Returns a boolean."));
"Check if xs is in descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LT, "<", 0, JOP_LESS_THAN,
JDOC("(< & xs)\n\n"
"Check if xs is in ascending order. Returns a boolean."));
"Check if xs is in ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_GTE, ">=", 0, JOP_GREATER_THAN_EQUAL,
JDOC("(>= & xs)\n\n"
"Check if xs is in non-ascending order. Returns a boolean."));
"Check if xs is in non-ascending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_LTE, "<=", 0, JOP_LESS_THAN_EQUAL,
JDOC("(<= & xs)\n\n"
"Check if xs is in non-descending order. Returns a boolean."));
"Check if xs is in non-descending order. Returns a boolean."));
templatize_comparator(env, JANET_FUN_EQ, "=", 0, JOP_EQUALS,
JDOC("(= & xs)\n\n"
"Check if all values in xs are equal. Returns a boolean."));
"Check if all values in xs are equal. Returns a boolean."));
templatize_comparator(env, JANET_FUN_NEQ, "not=", 1, JOP_EQUALS,
JDOC("(not= & xs)\n\n"
"Check if any values in xs are not equal. Returns a boolean."));
"Check if any values in xs are not equal. Returns a boolean."));
/* Platform detection */
janet_def(env, "janet/version", janet_cstringv(JANET_VERSION),
@ -1319,7 +1319,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JDOC("The build identifier of the running janet program."));
janet_def(env, "janet/config-bits", janet_wrap_integer(JANET_CURRENT_CONFIG_BITS),
JDOC("The flag set of config options from janetconf.h which is used to check "
"if native modules are compatible with the host program."));
"if native modules are compatible with the host program."));
/* Allow references to the environment */
janet_def(env, "root-env", janet_wrap_table(env),

102
src/core/ev.c
View File

@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@ -32,9 +32,11 @@
#ifdef JANET_EV
#include <math.h>
#include <fcntl.h>
#ifdef JANET_WINDOWS
#include <winsock2.h>
#include <windows.h>
#include <io.h>
#else
#include <pthread.h>
#include <limits.h>
@ -43,7 +45,6 @@
#include <signal.h>
#include <sys/ioctl.h>
#include <sys/types.h>
#include <fcntl.h>
#include <netinet/in.h>
#include <netinet/tcp.h>
#include <netdb.h>
@ -625,6 +626,18 @@ void janet_addtimeout(double sec) {
add_timeout(to);
}
/* Set timeout for the current root fiber but resume with nil instead of raising an error */
void janet_addtimeout_nil(double sec) {
JanetFiber *fiber = janet_vm.root_fiber;
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = fiber;
to.curr_fiber = NULL;
to.sched_id = fiber->sched_id;
to.is_error = 0;
add_timeout(to);
}
void janet_ev_inc_refcount(void) {
janet_atomic_inc(&janet_vm.listener_count);
}
@ -1024,6 +1037,9 @@ JANET_CORE_FN(cfun_channel_push,
"Returns the channel if the write succeeded, nil otherwise.") {
janet_fixarity(argc, 2);
JanetChannel *channel = janet_getchannel(argv, 0);
if (janet_vm.coerce_error) {
janet_panic("cannot give to channel inside janet_call");
}
if (janet_channel_push(channel, argv[1], 0)) {
janet_await();
}
@ -1036,6 +1052,9 @@ JANET_CORE_FN(cfun_channel_pop,
janet_fixarity(argc, 1);
JanetChannel *channel = janet_getchannel(argv, 0);
Janet item;
if (janet_vm.coerce_error) {
janet_panic("cannot take from channel inside janet_call");
}
if (janet_channel_pop(channel, &item, 0)) {
janet_schedule(janet_vm.root_fiber, item);
}
@ -1072,6 +1091,10 @@ JANET_CORE_FN(cfun_channel_choice,
int32_t len;
const Janet *data;
if (janet_vm.coerce_error) {
janet_panic("cannot select from channel inside janet_call");
}
/* Check channels for immediate reads and writes */
for (int32_t i = 0; i < argc; i++) {
if (janet_indexed_view(argv[i], &data, &len) && len == 2) {
@ -1776,6 +1799,22 @@ void janet_stream_edge_triggered(JanetStream *stream) {
}
void janet_stream_level_triggered(JanetStream *stream) {
/* On macos, we seem to need to delete any registered events before re-registering without
* EV_CLEAR, otherwise the new event will still have EV_CLEAR set erroneously. This could be a
* kernel bug, but unfortunately the specification is vague here, esp. in regards to where and when
* EV_CLEAR is set automatically. */
struct kevent kevs[2];
int length = 0;
if (stream->flags & (JANET_STREAM_READABLE | JANET_STREAM_ACCEPTABLE)) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_READ, EV_DELETE, 0, 0, stream);
}
if (stream->flags & JANET_STREAM_WRITABLE) {
EV_SETx(&kevs[length++], stream->handle, EVFILT_WRITE, EV_DELETE, 0, 0, stream);
}
int status;
do {
status = kevent(janet_vm.kq, kevs, length, NULL, 0, NULL);
} while (status == -1 && errno == EINTR);
janet_register_stream_impl(stream, 0);
}
@ -3263,6 +3302,64 @@ JANET_CORE_FN(janet_cfun_rwlock_write_release,
return argv[0];
}
static JanetFile *get_file_for_stream(JanetStream *stream) {
int32_t flags = 0;
char fmt[4] = {0};
int index = 0;
if (stream->flags & JANET_STREAM_READABLE) {
flags |= JANET_FILE_READ;
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
fmt[index++] = 'r';
}
if (stream->flags & JANET_STREAM_WRITABLE) {
flags |= JANET_FILE_WRITE;
janet_sandbox_assert(JANET_SANDBOX_FS_WRITE);
int currindex = index;
fmt[index++] = (currindex == 0) ? 'w' : '+';
}
if (index == 0) return NULL;
/* duplicate handle when converting stream to file */
#ifdef JANET_WINDOWS
int htype = 0;
if (fmt[0] == 'r' && fmt[1] == '+') {
htype = _O_RDWR;
} else if (fmt[0] == 'r') {
htype = _O_RDONLY;
} else if (fmt[0] == 'w') {
htype = _O_WRONLY;
}
int fd = _open_osfhandle((intptr_t) stream->handle, htype);
if (fd < 0) return NULL;
int fd_dup = _dup(fd);
if (fd_dup < 0) return NULL;
FILE *f = _fdopen(fd_dup, fmt);
if (NULL == f) {
_close(fd_dup);
return NULL;
}
#else
int fd_dup = dup(stream->handle);
if (fd_dup < 0) return NULL;
FILE *f = fdopen(fd_dup, fmt);
if (NULL == f) {
close(fd_dup);
return NULL;
}
#endif
return janet_makejfile(f, flags);
}
JANET_CORE_FN(janet_cfun_to_file,
"(ev/to-file)",
"Create core/file copy of the stream. This value can be used "
"when blocking IO behavior is needed.") {
janet_fixarity(argc, 1);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
JanetFile *iof = get_file_for_stream(stream);
if (iof == NULL) janet_panic("cannot make file from stream");
return janet_wrap_abstract(iof);
}
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.") {
@ -3307,6 +3404,7 @@ void janet_lib_ev(JanetTable *env) {
JANET_CORE_REG("ev/acquire-wlock", janet_cfun_rwlock_write_lock),
JANET_CORE_REG("ev/release-rlock", janet_cfun_rwlock_read_release),
JANET_CORE_REG("ev/release-wlock", janet_cfun_rwlock_write_release),
JANET_CORE_REG("ev/to-file", janet_cfun_to_file),
JANET_CORE_REG("ev/all-tasks", janet_cfun_ev_all_tasks),
JANET_REG_END
};

6
src/core/inttypes.c
View File

@ -191,21 +191,21 @@ Janet janet_wrap_u64(uint64_t x) {
JANET_CORE_FN(cfun_it_s64_new,
"(int/s64 value)",
"Create a boxed signed 64 bit integer from a string value.") {
"Create a boxed signed 64 bit integer from a string value or a number.") {
janet_fixarity(argc, 1);
return janet_wrap_s64(janet_unwrap_s64(argv[0]));
}
JANET_CORE_FN(cfun_it_u64_new,
"(int/u64 value)",
"Create a boxed unsigned 64 bit integer from a string value.") {
"Create a boxed unsigned 64 bit integer from a string value or a number.") {
janet_fixarity(argc, 1);
return janet_wrap_u64(janet_unwrap_u64(argv[0]));
}
JANET_CORE_FN(cfun_to_number,
"(int/to-number value)",
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int32.") {
"Convert an int/u64 or int/s64 to a number. Fails if the number is out of range for an int64.") {
janet_fixarity(argc, 1);
if (janet_type(argv[0]) == JANET_ABSTRACT) {
void *abst = janet_unwrap_abstract(argv[0]);

9
src/core/io.c
View File

@ -31,6 +31,7 @@
#ifndef JANET_WINDOWS
#include <fcntl.h>
#include <sys/stat.h>
#include <sys/wait.h>
#include <unistd.h>
#endif
@ -164,6 +165,14 @@ JANET_CORE_FN(cfun_io_fopen,
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
if (f != NULL) {
#ifndef JANET_WINDOWS
struct stat st;
fstat(fileno(f), &st);
if (S_ISDIR(st.st_mode)) {
fclose(f);
janet_panicf("cannot open directory: %s", fname);
}
#endif
size_t bufsize = janet_optsize(argv, argc, 2, BUFSIZ);
if (bufsize != BUFSIZ) {
int result = setvbuf(f, NULL, bufsize ? _IOFBF : _IONBF, bufsize);

47
src/core/net.c
View File

@ -554,7 +554,10 @@ JANET_CORE_FN(cfun_net_connect,
int err = WSAGetLastError();
freeaddrinfo(ai);
#else
int status = connect(sock, addr, addrlen);
int status;
do {
status = connect(sock, addr, addrlen);
} while (status == -1 && errno == EINTR);
int err = errno;
if (is_unix) {
janet_free(ai);
@ -578,17 +581,23 @@ JANET_CORE_FN(cfun_net_connect,
net_sched_connect(stream);
}
static const char *serverify_socket(JSock sfd) {
static const char *serverify_socket(JSock sfd, int reuse_addr, int reuse_port) {
/* Set various socket options */
int enable = 1;
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
if (reuse_addr) {
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEADDR, (char *) &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEADDR) failed";
}
}
if (reuse_port) {
#ifdef SO_REUSEPORT
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
if (setsockopt(sfd, SOL_SOCKET, SO_REUSEPORT, &enable, sizeof(int)) < 0) {
return "setsockopt(SO_REUSEPORT) failed";
}
#else
(void) reuse_port;
#endif
}
janet_net_socknoblock(sfd);
return NULL;
}
@ -642,19 +651,21 @@ JANET_CORE_FN(cfun_net_shutdown,
}
JANET_CORE_FN(cfun_net_listen,
"(net/listen host port &opt type)",
"(net/listen host port &opt type no-reuse)",
"Creates a server. Returns a new stream that is neither readable nor "
"writeable. Use net/accept or net/accept-loop be to handle connections and start the server. "
"The type parameter specifies the type of network connection, either "
"a :stream (usually tcp), or :datagram (usually udp). If not specified, the default is "
":stream. The host and port arguments are the same as in net/address.") {
":stream. The host and port arguments are the same as in net/address. The last boolean parameter `no-reuse` will "
"disable the use of SO_REUSEADDR and SO_REUSEPORT when creating a server on some operating systems.") {
janet_sandbox_assert(JANET_SANDBOX_NET_LISTEN);
janet_arity(argc, 2, 3);
janet_arity(argc, 2, 4);
/* Get host, port, and handler*/
int socktype = janet_get_sockettype(argv, argc, 2);
int is_unix = 0;
struct addrinfo *ai = janet_get_addrinfo(argv, 0, socktype, 1, &is_unix);
int reuse = !(argc >= 4 && janet_truthy(argv[3]));
JSock sfd = JSOCKDEFAULT;
#ifndef JANET_WINDOWS
@ -664,7 +675,7 @@ JANET_CORE_FN(cfun_net_listen,
janet_free(ai);
janet_panicf("could not create socket: %V", janet_ev_lasterr());
}
const char *err = serverify_socket(sfd);
const char *err = serverify_socket(sfd, reuse, 0);
if (NULL != err || bind(sfd, (struct sockaddr *)ai, sizeof(struct sockaddr_un))) {
JSOCKCLOSE(sfd);
janet_free(ai);
@ -687,7 +698,7 @@ JANET_CORE_FN(cfun_net_listen,
sfd = socket(rp->ai_family, rp->ai_socktype | JSOCKFLAGS, rp->ai_protocol);
#endif
if (!JSOCKVALID(sfd)) continue;
const char *err = serverify_socket(sfd);
const char *err = serverify_socket(sfd, reuse, reuse);
if (NULL != err) {
JSOCKCLOSE(sfd);
continue;
@ -829,7 +840,7 @@ JANET_CORE_FN(cfun_stream_accept_loop,
JANET_CORE_FN(cfun_stream_accept,
"(net/accept stream &opt timeout)",
"Get the next connection on a server stream. This would usually be called in a loop in a dedicated fiber. "
"Takes an optional timeout in seconds, after which will return nil. "
"Takes an optional timeout in seconds, after which will raise an error. "
"Returns a new duplex stream which represents a connection to the client.") {
janet_arity(argc, 1, 2);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@ -844,7 +855,7 @@ JANET_CORE_FN(cfun_stream_read,
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. "
"Takes an optional timeout in seconds, after which will raise an error. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@ -864,7 +875,7 @@ JANET_CORE_FN(cfun_stream_read,
JANET_CORE_FN(cfun_stream_chunk,
"(net/chunk stream nbytes &opt buf timeout)",
"Same a net/read, but will wait for all n bytes to arrive rather than return early. "
"Takes an optional timeout in seconds, after which will return nil.") {
"Takes an optional timeout in seconds, after which will raise an error.") {
janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
@ -878,7 +889,7 @@ JANET_CORE_FN(cfun_stream_chunk,
JANET_CORE_FN(cfun_stream_recv_from,
"(net/recv-from stream nbytes buf &opt timeout)",
"Receives data from a server stream and puts it into a buffer. Returns the socket-address the "
"packet came from. Takes an optional timeout in seconds, after which will return nil.") {
"packet came from. Takes an optional timeout in seconds, after which will raise an error.") {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_UDPSERVER | JANET_STREAM_SOCKET);
@ -892,7 +903,7 @@ JANET_CORE_FN(cfun_stream_recv_from,
JANET_CORE_FN(cfun_stream_write,
"(net/write stream data &opt timeout)",
"Write data to a stream, suspending the current fiber until the write "
"completes. Takes an optional timeout in seconds, after which will return nil. "
"completes. Takes an optional timeout in seconds, after which will raise an error. "
"Returns nil, or raises an error if the write failed.") {
janet_arity(argc, 2, 3);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
@ -911,7 +922,7 @@ JANET_CORE_FN(cfun_stream_write,
JANET_CORE_FN(cfun_stream_send_to,
"(net/send-to stream dest data &opt timeout)",
"Writes a datagram to a server stream. dest is a the destination address of the packet. "
"Takes an optional timeout in seconds, after which will return nil. "
"Takes an optional timeout in seconds, after which will raise an error. "
"Returns stream.") {
janet_arity(argc, 3, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);

35
src/core/parse.c
View File

@ -363,8 +363,7 @@ static int stringend(JanetParser *p, JanetParseState *state) {
JanetParseState top = p->states[p->statecount - 1];
int32_t indent_col = (int32_t) top.column - 1;
uint8_t *r = bufstart, *end = r + buflen;
/* Check if there are any characters before the start column -
* if so, do not reindent. */
/* Unless there are only spaces before EOLs, disable reindenting */
int reindent = 1;
while (reindent && (r < end)) {
if (*r++ == '\n') {
@ -374,34 +373,36 @@ static int stringend(JanetParser *p, JanetParseState *state) {
break;
}
}
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') reindent = 1;
}
}
/* Now reindent if able to, otherwise just drop leading newline. */
if (!reindent) {
if (buflen > 0 && bufstart[0] == '\n') {
buflen--;
bufstart++;
}
} else {
/* Now reindent if able */
if (reindent) {
uint8_t *w = bufstart;
r = bufstart;
while (r < end) {
if (*r == '\n') {
if (r == bufstart) {
/* Skip leading newline */
r++;
} else {
*w++ = *r++;
}
*w++ = *r++;
for (int32_t j = 0; (r < end) && (*r != '\n') && (j < indent_col); j++, r++);
if ((r + 1) < end && *r == '\r' && *(r + 1) == '\n') *w++ = *r++;
} else {
*w++ = *r++;
}
}
buflen = (int32_t)(w - bufstart);
}
/* Check for trailing newline character so we can remove it */
if (buflen > 0 && bufstart[buflen - 1] == '\n') {
/* Check for leading EOL so we can remove it */
if (buflen > 1 && bufstart[0] == '\r' && bufstart[1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
bufstart = bufstart + 2;
} else if (buflen > 0 && bufstart[0] == '\n') { /* Unix EOL */
buflen--;
bufstart++;
}
/* Check for trailing EOL so we can remove it */
if (buflen > 1 && bufstart[buflen - 2] == '\r' && bufstart[buflen - 1] == '\n') { /* Windows EOL */
buflen = buflen - 2;
} else if (buflen > 0 && bufstart[buflen - 1] == '\n') { /* Unix EOL */
buflen--;
}
}

90
src/core/peg.c
View File

@ -1,5 +1,5 @@
/*
* Copyright (c) 2024 Calvin Rose
* Copyright (c) 2025 Calvin Rose
*
* Permission is hereby granted, free of charge, to any person obtaining a copy
* of this software and associated documentation files (the "Software"), to
@ -342,7 +342,7 @@ tail:
while (captured < hi) {
CapState cs2 = cap_save(s);
next_text = peg_rule(s, rule_a, text);
if (!next_text || next_text == text) {
if (!next_text || ((next_text == text) && (hi == UINT32_MAX))) {
cap_load(s, cs2);
break;
}
@ -544,41 +544,80 @@ tail:
return window_end;
}
case RULE_TIL: {
const uint32_t *rule_terminus = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *terminus_start = text;
const uint8_t *terminus_end = NULL;
down1(s);
while (terminus_start <= s->text_end) {
CapState cs2 = cap_save(s);
terminus_end = peg_rule(s, rule_terminus, terminus_start);
cap_load(s, cs2);
if (terminus_end) {
break;
}
terminus_start++;
}
up1(s);
if (!terminus_end) {
return NULL;
}
const uint8_t *saved_end = s->text_end;
s->text_end = terminus_start;
down1(s);
const uint8_t *matched = peg_rule(s, rule_subpattern, text);
up1(s);
s->text_end = saved_end;
if (!matched) {
return NULL;
}
return terminus_end;
}
case RULE_SPLIT: {
const uint8_t *saved_end = s->text_end;
const uint32_t *rule_separator = s->bytecode + rule[1];
const uint32_t *rule_subpattern = s->bytecode + rule[2];
const uint8_t *separator_end = NULL;
do {
const uint8_t *text_start = text;
const uint8_t *chunk_start = text;
const uint8_t *chunk_end = NULL;
while (text <= saved_end) {
/* Find next split (or end of text) */
CapState cs = cap_save(s);
down1(s);
while (text <= s->text_end) {
separator_end = peg_rule(s, rule_separator, text);
while (text <= saved_end) {
chunk_end = text;
const uint8_t *check = peg_rule(s, rule_separator, text);
cap_load(s, cs);
if (separator_end) {
if (check) {
text = check;
break;
}
text++;
}
up1(s);
if (separator_end) {
s->text_end = text;
text = separator_end;
}
/* Match between splits */
s->text_end = chunk_end;
down1(s);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, text_start);
const uint8_t *subpattern_end = peg_rule(s, rule_subpattern, chunk_start);
up1(s);
s->text_end = saved_end;
if (!subpattern_end) return NULL; /* Don't match anything */
if (!subpattern_end) {
return NULL;
}
} while (separator_end);
/* Ensure forward progress */
if (text == chunk_start) return NULL;
chunk_start = text;
}
s->text_end = saved_end;
return s->text_end;
}
@ -1227,6 +1266,14 @@ static void spec_sub(Builder *b, int32_t argc, const Janet *argv) {
emit_2(r, RULE_SUB, subrule1, subrule2);
}
static void spec_til(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
uint32_t subrule1 = peg_compile1(b, argv[0]);
uint32_t subrule2 = peg_compile1(b, argv[1]);
emit_2(r, RULE_TIL, subrule1, subrule2);
}
static void spec_split(Builder *b, int32_t argc, const Janet *argv) {
peg_fixarity(b, argc, 2);
Reserve r = reserve(b, 3);
@ -1323,6 +1370,7 @@ static const SpecialPair peg_specials[] = {
{"split", spec_split},
{"sub", spec_sub},
{"thru", spec_thru},
{"til", spec_til},
{"to", spec_to},
{"uint", spec_uint_le},
{"uint-be", spec_uint_be},
@ -1416,6 +1464,11 @@ static uint32_t peg_compile1(Builder *b, Janet peg) {
emit_bytes(b, RULE_LITERAL, len, str);
break;
}
case JANET_BUFFER: {
const JanetBuffer *buf = janet_unwrap_buffer(peg);
emit_bytes(b, RULE_LITERAL, buf->count, buf->data);
break;
}
case JANET_TABLE: {
/* Build grammar table */
JanetTable *new_grammar = janet_table_clone(janet_unwrap_table(peg));
@ -1657,6 +1710,7 @@ static void *peg_unmarshal(JanetMarshalContext *ctx) {
i += 4;
break;
case RULE_SUB:
case RULE_TIL:
case RULE_SPLIT:
/* [rule, rule] */
if (rule[1] >= blen) goto bad;

28
src/core/run.c
View File

@ -28,7 +28,7 @@
/* Run a string */
int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out) {
JanetParser parser;
JanetParser *parser;
int errflags = 0, done = 0;
int32_t index = 0;
Janet ret = janet_wrap_nil();
@ -37,14 +37,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (where) janet_gcroot(janet_wrap_string(where));
if (NULL == sourcePath) sourcePath = "<unknown>";
janet_parser_init(&parser);
parser = janet_abstract(&janet_parser_type, sizeof(JanetParser));
janet_parser_init(parser);
janet_gcroot(janet_wrap_abstract(parser));
/* While we haven't seen an error */
while (!done) {
/* Evaluate parsed values */
while (janet_parser_has_more(&parser)) {
Janet form = janet_parser_produce(&parser);
while (janet_parser_has_more(parser)) {
Janet form = janet_parser_produce(parser);
JanetCompileResult cres = janet_compile(form, env, where);
if (cres.status == JANET_COMPILE_OK) {
JanetFunction *f = janet_thunk(cres.funcdef);
@ -58,8 +60,8 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
@ -81,16 +83,16 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
switch (janet_parser_status(parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
const char *e = janet_parser_error(parser);
errflags |= 0x04;
ret = janet_cstringv(e);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
int32_t line = (int32_t) parser->line;
int32_t col = (int32_t) parser->column;
janet_eprintf("%s:%d:%d: parse error: %s\n", sourcePath, line, col, e);
done = 1;
break;
@ -98,9 +100,9 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
janet_parser_eof(parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
janet_parser_consume(parser, bytes[index++]);
}
break;
}
@ -108,7 +110,7 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
/* Clean up and return errors */
janet_parser_deinit(&parser);
janet_gcunroot(janet_wrap_abstract(parser));
if (where) janet_gcunroot(janet_wrap_string(where));
#ifdef JANET_EV
/* Enter the event loop if we are not already in it */

1
src/core/state.h
View File

@ -100,6 +100,7 @@ struct JanetVM {
* return point for panics. */
jmp_buf *signal_buf;
Janet *return_reg;
int coerce_error;
/* The global registry for c functions. Used to store meta-data
* along with otherwise bare c function pointers. */

11
src/core/strtod.c
View File

@ -301,6 +301,7 @@ int janet_scan_number_base(
if (base == 0) {
base = 10;
}
int exp_base = base;
/* Skip leading zeros */
while (str < end && (*str == '0' || *str == '.')) {
@ -322,6 +323,12 @@ int janet_scan_number_base(
} else if (*str == '&') {
foundexp = 1;
break;
} else if (base == 16 && (*str == 'P' || *str == 'p')) { /* IEEE hex float */
foundexp = 1;
exp_base = 10;
base = 2;
ex *= 4; /* We need to correct the current exponent after we change the base */
break;
} else if (base == 10 && (*str == 'E' || *str == 'e')) {
foundexp = 1;
break;
@ -360,9 +367,9 @@ int janet_scan_number_base(
}
while (str < end) {
int digit = digit_lookup[*str & 0x7F];
if (*str > 127 || digit >= base) goto error;
if (*str > 127 || digit >= exp_base) goto error;
if (ee < (INT32_MAX / 40)) {
ee = base * ee + digit;
ee = exp_base * ee + digit;
}
str++;
seenadigit = 1;

11
src/core/struct.c
View File

@ -294,6 +294,16 @@ JANET_CORE_FN(cfun_struct_to_table,
return janet_wrap_table(tab);
}
JANET_CORE_FN(cfun_struct_rawget,
"(struct/rawget st key)",
"Gets a value from a struct `st` without looking at the prototype struct. "
"If `st` does not contain the key directly, the function will return "
"nil without checking the prototype. Returns the value in the struct.") {
janet_fixarity(argc, 2);
JanetStruct st = janet_getstruct(argv, 0);
return janet_struct_rawget(st, argv[1]);
}
/* Load the struct module */
void janet_lib_struct(JanetTable *env) {
JanetRegExt struct_cfuns[] = {
@ -301,6 +311,7 @@ void janet_lib_struct(JanetTable *env) {
JANET_CORE_REG("struct/getproto", cfun_struct_getproto),
JANET_CORE_REG("struct/proto-flatten", cfun_struct_flatten),
JANET_CORE_REG("struct/to-table", cfun_struct_to_table),
JANET_CORE_REG("struct/rawget", cfun_struct_rawget),
JANET_REG_END
};
janet_core_cfuns_ext(env, NULL, struct_cfuns);

12
src/core/table.c
View File

@ -372,12 +372,14 @@ JANET_CORE_FN(cfun_table_setproto,
}
JANET_CORE_FN(cfun_table_tostruct,
"(table/to-struct tab)",
"Convert a table to a struct. Returns a new struct. This function "
"does not take into account prototype tables.") {
janet_fixarity(argc, 1);
"(table/to-struct tab &opt proto)",
"Convert a table to a struct. Returns a new struct.") {
janet_arity(argc, 1, 2);
JanetTable *t = janet_gettable(argv, 0);
return janet_wrap_struct(janet_table_to_struct(t));
JanetStruct proto = janet_optstruct(argv, argc, 1, NULL);
JanetStruct st = janet_table_to_struct(t);
janet_struct_proto(st) = proto;
return janet_wrap_struct(st);
}
JANET_CORE_FN(cfun_table_rawget,

15
src/core/vm.c
View File

@ -1373,7 +1373,10 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
/* Run vm */
janet_vm.fiber->flags |= JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP;
int old_coerce_error = janet_vm.coerce_error;
janet_vm.coerce_error = 1;
JanetSignal signal = run_vm(janet_vm.fiber, janet_wrap_nil());
janet_vm.coerce_error = old_coerce_error;
/* Teardown */
janet_vm.stackn = oldn;
@ -1384,6 +1387,15 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
}
if (signal != JANET_SIGNAL_OK) {
/* Should match logic in janet_signalv */
#ifdef JANET_EV
if (janet_vm.root_fiber != NULL && signal == JANET_SIGNAL_EVENT) {
janet_vm.root_fiber->sched_id++;
}
#endif
if (signal != JANET_SIGNAL_ERROR) {
*janet_vm.return_reg = janet_wrap_string(janet_formatc("%v coerced from %s to error", *janet_vm.return_reg, janet_signal_names[signal]));
}
janet_panicv(*janet_vm.return_reg);
}
@ -1430,8 +1442,10 @@ void janet_try_init(JanetTryState *state) {
state->vm_fiber = janet_vm.fiber;
state->vm_jmp_buf = janet_vm.signal_buf;
state->vm_return_reg = janet_vm.return_reg;
state->coerce_error = janet_vm.coerce_error;
janet_vm.return_reg = &(state->payload);
janet_vm.signal_buf = &(state->buf);
janet_vm.coerce_error = 0;
}
void janet_restore(JanetTryState *state) {
@ -1440,6 +1454,7 @@ void janet_restore(JanetTryState *state) {
janet_vm.fiber = state->vm_fiber;
janet_vm.signal_buf = state->vm_jmp_buf;
janet_vm.return_reg = state->vm_return_reg;
janet_vm.coerce_error = state->coerce_error;
}
static JanetSignal janet_continue_no_check(JanetFiber *fiber, Janet in, Janet *out) {

3
src/include/janet.h
View File

@ -1262,6 +1262,7 @@ typedef struct {
/* new state */
jmp_buf buf;
Janet payload;
int coerce_error;
} JanetTryState;
/***** END SECTION TYPES *****/
@ -1443,6 +1444,7 @@ JANET_NO_RETURN JANET_API void janet_sleep_await(double sec);
/* For use inside listeners - adds a timeout to the current fiber, such that
* it will be resumed after sec seconds if no other event schedules the current fiber. */
JANET_API void janet_addtimeout(double sec);
JANET_API void janet_addtimeout_nil(double sec);
JANET_API void janet_ev_inc_refcount(void);
JANET_API void janet_ev_dec_refcount(void);
@ -2181,6 +2183,7 @@ typedef enum {
RULE_UNREF, /* [rule, tag] */
RULE_CAPTURE_NUM, /* [rule, tag] */
RULE_SUB, /* [rule, rule] */
RULE_TIL, /* [rule, rule] */
RULE_SPLIT, /* [rule, rule] */
RULE_NTH, /* [nth, rule, tag] */
RULE_ONLY_TAGS, /* [rule] */

2
test/helper.janet
View File

@ -39,7 +39,7 @@
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e ~',x)
(default e (string/format "%j" x))
~(do
(def ,xx ,x)
(,assert-no-tail ,xx ,e)

25
test/suite-boot.janet
View File

@ -896,11 +896,18 @@
(struct/with-proto {:a [1 2 3]} :c 22 :b [1 2 3 4] :d "test" :e "test2"))
(table/setproto table-to-freeze @{:a @[1 2 3]})
(assert (deep= {:a [1 2 3] :b [1 2 3 4] :c 22 :d "test" :e "test2"}
(freeze table-to-freeze)))
(assert (deep= struct-to-thaw (freeze table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw table-to-freeze)))
(assert (deep= table-to-freeze-with-inline-proto (thaw struct-to-thaw)))
# Check that freezing mutable keys is deterministic
# for issue #1535
(def hashes @{})
(repeat 200
(def x (freeze {@"" 1 @"" 2 @"" 3 @"" 4 @"" 5}))
(put hashes (hash x) true))
(assert (= 1 (length hashes)) "freeze mutable keys is deterministic")
# Make sure Carriage Returns don't end up in doc strings
# e528b86
(assert (not (string/find "\r"
@ -1006,4 +1013,18 @@
(assert-error "assertf error 3" (assertf false "%s message" "mystery"))
(assert-error "assertf error 4" (assertf nil "%s %s" "alice" "bob"))
# issue #1535
(loop [i :range [1 1000]]
(assert (deep-not= @{:key1 "value1" @"key" "value2"}
@{:key1 "value1" @"key" "value2"}) "deep= mutable keys"))
(assert (deep-not= {"abc" 123} {@"abc" 123}) "deep= mutable keys vs immutable key")
(assert (deep-not= {@"" 1 @"" 2 @"" 3} {@"" 1 @"" 2 @"" 3}) "deep= duplicate mutable keys")
(assert (deep-not= {@"" @"" @"" @"" @"" 3} {@"" @"" @"" @"" @"" 3}) "deep= duplicate mutable keys 2")
(assert (deep-not= {@[] @"" @[] @"" @[] 3} {@[] @"" @[] @"" @[] 3}) "deep= duplicate mutable keys 3")
(assert (deep-not= {@{} @"" @{} @"" @{} 3} {@{} @"" @{} @"" @{} 3}) "deep= duplicate mutable keys 4")
(assert (deep-not= @{:key1 "value1" @"key2" @"value2"}
@{:key1 "value1" @"key2" "value2"}) "deep= mutable keys")
(assert (deep-not= @{:key1 "value1" [@"key2"] @"value2"}
@{:key1 "value1" [@"key2"] @"value2"}) "deep= mutable keys")
(end-suite)

1
test/suite-corelib.janet
View File

@ -174,6 +174,7 @@
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
(assert-error "large range" (range 0xFFFFFFFFFF))
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range -10)) 0) "(range -10)")

81
test/suite-ev.janet
View File

@ -1,4 +1,4 @@
# Copyright (c) 2023 Calvin Rose & contributors
# Copyright (c) 2025 Calvin Rose & contributors
#
# Permission is hereby granted, free of charge, to any person obtaining a copy
# of this software and associated documentation files (the "Software"), to
@ -199,7 +199,7 @@
(assert s "made server 1")
(defn test-echo [msg]
(with [conn (net/connect test-host test-port)]
(with [conn (assert (net/connect test-host test-port))]
(net/write conn msg)
(def res (net/read conn 1024))
(assert (= (string res) msg) (string "echo " msg))))
@ -213,6 +213,7 @@
# Test on both server and client
# 504411e
(var iterations 0)
(defn names-handler
[stream]
(defer (:close stream)
@ -220,21 +221,26 @@
(ev/read stream 1)
(def [host port] (net/localname stream))
(assert (= host test-host) "localname host server")
(assert (= port (scan-number test-port)) "localname port server")))
(assert (= port (scan-number test-port)) "localname port server")
(++ iterations)
(ev/write stream " ")))
# Test localname and peername
# 077bf5eba
(repeat 10
(with [s (net/server test-host test-port names-handler)]
(repeat 10
(with [conn (net/connect test-host test-port)]
(with [conn (assert (net/connect test-host test-port))]
(def [host port] (net/peername conn))
(assert (= host test-host) "peername host client ")
(assert (= port (scan-number test-port)) "peername port client")
# let server close
(ev/write conn " "))))
(++ iterations)
(ev/write conn " ")
(ev/read conn 1))))
(gccollect))
(assert (= iterations 200) "localname and peername not enough checks")
# Create pipe
# 12f09ad2d
(var pipe-counter 0)
@ -410,6 +416,10 @@
(ev/call handler connection)
(break))))
# Make sure we can't bind again with no-reuse
(assert-error "no-reuse"
(net/listen test-host test-port :stream true))
# Read from socket
(defn expect-read
@ -418,11 +428,17 @@
(assert (= result text) (string/format "expected %v, got %v" text result)))
# Now do our telnet chat
(def bob (net/connect test-host test-port))
(def bob (assert (net/connect test-host test-port :stream)))
(expect-read bob "Whats your name?\n")
(net/write bob "bob")
(if (= :mingw (os/which))
(net/write bob "bob")
(do
(def fbob (ev/to-file bob))
(file/write fbob "bob")
(file/flush fbob)
(:close fbob)))
(expect-read bob "Welcome bob\n")
(def alice (net/connect test-host test-port))
(def alice (assert (net/connect test-host test-port)))
(expect-read alice "Whats your name?\n")
(net/write alice "alice")
(expect-read alice "Welcome alice\n")
@ -436,7 +452,7 @@
(expect-read bob "[alice]:hi\n")
# Ted joins the chat server
(def ted (net/connect test-host test-port))
(def ted (assert (net/connect test-host test-port)))
(expect-read ted "Whats your name?\n")
(net/write ted "ted")
(expect-read ted "Welcome ted\n")
@ -465,4 +481,49 @@
# Close chat server
(:close chat-server)
# Issue #1531
(defn sleep-print [x] (ev/sleep 0) (print x))
(protect (with-dyns [*out* sleep-print] (prin :foo)))
(defn level-trigger-handling [conn &] (:close conn))
(def s (assert (net/server test-host test-port level-trigger-handling)))
(def c (assert (net/connect test-host test-port)))
(:close s)
# Issue #1531 no. 2
(def c (ev/chan 0))
(ev/spawn (while (def x (ev/take c))))
(defn print-to-chan [x] (ev/give c x))
(assert-error "coerce await inside janet_call to error"
(with-dyns [*out* print-to-chan]
(pp :foo)))
(ev/chan-close c)
# soreuseport on unix domain sockets
(compwhen (or (= :macos (os/which)) (= :linux (os/which)))
(assert-no-error "unix-domain socket reuseaddr"
(let [s (net/listen :unix "./unix-domain-socket" :stream)]
(:close s))))
# net/accept-loop level triggering
(gccollect)
(def maxconn 50)
(var connect-count 0)
(defn level-trigger-handling
[conn &]
(with [conn conn]
(ev/write conn (ev/read conn 4096))
(++ connect-count)))
(def s (assert (net/server test-host test-port level-trigger-handling)))
(def cons @[])
(repeat maxconn (array/push cons (assert (net/connect test-host test-port))))
(assert (= maxconn (length cons)))
(defn do-connect [i]
(with [c (get cons i)]
(ev/write c "abc123")
(ev/read c 4096)))
(for i 0 maxconn (ev/spawn (do-connect i)))
(ev/sleep 0.1)
(assert (= maxconn connect-count))
(:close s)
(end-suite)

4
test/suite-marsh.janet
View File

@ -207,7 +207,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= t tclone) "table/weak-values marsh 4")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
# tables with prototypes
(def t (table/weak-values 1))
@ -219,7 +219,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
(assert (deep= t tclone) "marsh weak tables with prototypes 4")
(assert (deep= (freeze t) (freeze tclone)) "marsh weak tables with prototypes 4")
(assert (deep= (getproto t) (getproto tclone)) "marsh weak tables with prototypes 5")
(end-suite)

39
test/suite-parse.janet
View File

@ -57,6 +57,8 @@
(for i (+ index 1) (+ index indent 1)
(case (get text i)
nil (break)
(chr "\r") (if-not (= (chr "\n") (get text (inc i)))
(set rewrite false))
(chr "\n") (break)
(chr " ") nil
(set rewrite false))))
@ -64,12 +66,17 @@
# Only re-indent if no dedented characters.
(def str
(if rewrite
(peg/replace-all ~(* "\n" (between 0 ,indent " ")) "\n" text)
(peg/replace-all ~(* '(* (? "\r") "\n") (between 0 ,indent " "))
(fn [mtch eol] eol) text)
text))
(def first-nl (= (chr "\n") (first str)))
(def last-nl (= (chr "\n") (last str)))
(string/slice str (if first-nl 1 0) (if last-nl -2)))
(def first-eol (cond
(string/has-prefix? "\r\n" str) :crlf
(string/has-prefix? "\n" str) :lf))
(def last-eol (cond
(string/has-suffix? "\r\n" str) :crlf
(string/has-suffix? "\n" str) :lf))
(string/slice str (case first-eol :crlf 2 :lf 1 0) (case last-eol :crlf -3 :lf -2)))
(defn reindent-reference
"Same as reindent but use parser functionality. Useful for
@ -89,8 +96,10 @@
(let [a (reindent text indent)
b (reindent-reference text indent)]
(assert (= a b)
(string "indent " indent-counter " (indent=" indent ")"))))
(string/format "reindent: %q, parse: %q (indent-test #%d with indent of %d)" a b indent-counter indent)
)))
# Unix EOLs
(check-indent "" 0)
(check-indent "\n" 0)
(check-indent "\n" 1)
@ -106,6 +115,17 @@
(check-indent "\n Hello, world!\n " 4)
(check-indent "\n Hello, world!\n dedented text\n " 4)
(check-indent "\n Hello, world!\n indented text\n " 4)
# Windows EOLs
(check-indent "\r\n" 0)
(check-indent "\r\n" 1)
(check-indent "\r\n\r\n" 0)
(check-indent "\r\n\r\n" 1)
(check-indent "\r\nHello, world!" 0)
(check-indent "\r\nHello, world!" 1)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n " 4)
(check-indent "\r\n Hello, world!\r\n dedented text\r\n " 4)
(check-indent "\r\n Hello, world!\r\n indented text\r\n " 4)
# Symbols with @ character
# d68eae9
@ -188,5 +208,14 @@
(parser/consume p `")`)
(assert (= (parser/produce p) ["hello"]))
# Hex floats
(assert (= math/pi +0x1.921fb54442d18p+0001))
(assert (= math/int-max +0x1.ffff_ffff_ffff_ffp+0052))
(assert (= math/int-min -0x1.ffff_ffff_ffff_ffp+0052))
(assert (= 1 0x1P0))
(assert (= 2 0x1P1))
(assert (= -2 -0x1p1))
(assert (= -0.5 -0x1p-1))
(end-suite)

63
test/suite-peg.janet
View File

@ -713,6 +713,41 @@
"abcdef"
@[])
(test "til: basic matching"
~(til "d" "abc")
"abcdef"
@[])
(test "til: second pattern can't see past the first occurrence of first pattern"
~(til "d" (* "abc" -1))
"abcdef"
@[])
(test "til: fails if first pattern fails"
~(til "x" "abc")
"abcdef"
nil)
(test "til: fails if second pattern fails"
~(til "abc" "x")
"abcdef"
nil)
(test "til: discards captures from initial pattern"
~(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])
(test "til: advances to the end of the first pattern's first occurrence"
~(* (til "d" "ab") "e")
"abcdef"
@[])
(test "split: basic functionality"
~(split "," '1)
"a,b,c"
@ -772,5 +807,33 @@
"5:apple6:banana6:cherry"
@["apple" "banana" "cherry"])
# Issue #1539 - make sure split with "" doesn't infinite loop/oom
(test "issue 1539"
~(split "" (capture (to -1)))
"hello there friends"
nil)
(test "issue 1539 pt. 2"
~(split "," (capture 0))
"abc123,,,,"
@["" "" "" "" ""])
# Issue #1549 - allow buffers as peg literals
(test "issue 1549"
''@"abc123"
"abc123"
@["abc123"])
# Issue 1554 - 0-width match termination behavior
(test "issue 1554 case 1" '(any (> '1)) "abc" @[])
(test "issue 1554 case 2" '(any (? (> '1))) "abc" @[])
(test "issue 1554 case 3" '(any (> (? '1))) "abc" @[])
(test "issue 1554 case 4" '(* "a" (> '1)) "abc" @["b"])
(test "issue 1554 case 5" '(* "a" (? (> '1))) "abc" @["b"])
(test "issue 1554 case 6" '(* "a" (> (? '1))) "abc" @["b"])
(test "issue 1554 case 7" '(between 0 2 (> '1)) "abc" @["a" "a"])
(test "issue 1554 case 8" '(between 2 3 (? (> '1))) "abc" @["a" "a" "a"])
(test "issue 1554 case 9" '(between 0 0 (> (? '1))) "abc" @[])
(end-suite)

5
tools/msi/janet.wxs
View File

@ -19,6 +19,11 @@
<?define ProgramFilesFolder="ProgramFilesFolder" ?>
<?define Win64="no" ?>
<?define Arch="(x86)" ?>
<?elseif $(sys.BUILDARCH)="arm64" ?>
<?define UpgradeCode="0bd4bab6-c838-4c2a-b9e6-56ea8064863c" ?>
<?define ProgramFilesFolder="ProgramFiles64Folder" ?>
<?define Win64="yes" ?>
<?define Arch="(Arm)" ?>
<?else ?>
<?error Unsupported value of sys.BUILDARCH=$(sys.BUILDARCH)?>
<?endif?>