mirror of
https://github.com/janet-lang/janet
synced 2026-04-02 13:01:28 +00:00
Compare commits
18 Commits
contributi
...
master
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2d1b54da37 | ||
|
|
9a9cf981ed | ||
|
|
0c512ab128 | ||
|
|
19e1dc494d | ||
|
|
c67dee7329 | ||
|
|
16f4f40d8e | ||
|
|
29474b915d | ||
|
|
ec5a78d3dc | ||
|
|
e42b3c667f | ||
|
|
93436bf973 | ||
|
|
df32109eea | ||
|
|
8b89901298 | ||
|
|
079776d39e | ||
|
|
6c2f08ef49 | ||
|
|
980999c97b | ||
|
|
1197cfe433 | ||
|
|
c63c6740d9 | ||
|
|
612971503d |
2
.github/workflows/test.yml
vendored
2
.github/workflows/test.yml
vendored
@@ -12,7 +12,7 @@ jobs:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest, macos-14, macos-15-intel ]
|
||||
os: [ ubuntu-latest, ubuntu-24.04-arm, macos-latest, macos-14, macos-15-intel ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
|
||||
@@ -2,9 +2,12 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add filewatch support to BSD and macos.
|
||||
- Add linting support for shadowed bindings.
|
||||
- Add nanboxing support for Linux on ARM64 and turn on nanboxing by default on macos on ARM64 (aarch64).
|
||||
- Documentation fixes
|
||||
- ev/thread-chan deadlock bug fixed
|
||||
- Re-add removed support for non-blocking net/connect on windows.
|
||||
- Re-add removed support for non-blocking net/connect on windows with bug fixes.
|
||||
|
||||
## 1.41.2 - 2026-02-18
|
||||
- Fix regressions in `put` for arrays and buffers.
|
||||
|
||||
@@ -3,10 +3,10 @@
|
||||
|
||||
(defn bork [x]
|
||||
|
||||
(defn bark [x]
|
||||
(defn bark [y]
|
||||
(print "Woof!")
|
||||
(print x)
|
||||
(error x)
|
||||
(print y)
|
||||
(error y)
|
||||
(print "Woof!"))
|
||||
|
||||
(bark (* 2 x))
|
||||
|
||||
14
examples/filewatch.janet
Normal file
14
examples/filewatch.janet
Normal file
@@ -0,0 +1,14 @@
|
||||
###
|
||||
### example/filewatch.janet ...files
|
||||
###
|
||||
### Watch for all changes in a list of files and directories. Behavior
|
||||
### depends on the filewatch module, and different operating systems will
|
||||
### report different events.
|
||||
|
||||
(def chan (ev/chan 1000))
|
||||
(def fw (filewatch/new chan))
|
||||
(each arg (drop 1 (dyn *args* []))
|
||||
(filewatch/add fw arg :all))
|
||||
(filewatch/listen fw)
|
||||
|
||||
(forever (let [event (ev/take chan)] (pp event)))
|
||||
@@ -7,13 +7,13 @@
|
||||
(print "simple yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
|
||||
(def f
|
||||
(def f2
|
||||
(coro
|
||||
(for i 0 10
|
||||
(yield (string "yield " i))
|
||||
(ev/sleep 0))))
|
||||
|
||||
(print "complex yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
(each item f2 (print "got: " item ", now " (fiber/status f2)))
|
||||
|
||||
(print (fiber/status f))
|
||||
(print (fiber/status f2))
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
# that must be called (realizing it), and the memoized.
|
||||
# Use with (import "./path/to/this/file" :prefix "seq.")
|
||||
|
||||
(defmacro delay
|
||||
(defmacro dolazy
|
||||
"Lazily evaluate a series of expressions. Returns a function that
|
||||
returns the result of the last expression. Will only evaluate the
|
||||
body once, and then memoizes the result."
|
||||
@@ -35,7 +35,7 @@
|
||||
(def x (tuple h t))
|
||||
(fn [] x))
|
||||
|
||||
(defn empty?
|
||||
(defn lazy-empty?
|
||||
"Check if a sequence is empty."
|
||||
[s]
|
||||
(not (s)))
|
||||
@@ -55,14 +55,14 @@
|
||||
[start end &]
|
||||
(if end
|
||||
(if (< start end)
|
||||
(delay (tuple start (lazy-range (+ 1 start) end)))
|
||||
(dolazy (tuple start (lazy-range (+ 1 start) end)))
|
||||
empty-seq)
|
||||
(lazy-range 0 start)))
|
||||
|
||||
(defn lazy-map
|
||||
"Return a sequence that is the result of applying f to each value in s."
|
||||
[f s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
|
||||
|
||||
@@ -76,31 +76,31 @@
|
||||
[f s]
|
||||
(when (s) (f (head s)) (realize-map f (tail s))))
|
||||
|
||||
(defn drop
|
||||
(defn lazy-drop
|
||||
"Ignores the first n values of the sequence and returns the rest."
|
||||
[n s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
|
||||
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn take
|
||||
(defn lazy-take
|
||||
"Returns at most the first n values of s."
|
||||
[n s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if (and x (pos? n))
|
||||
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
|
||||
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn randseq
|
||||
"Return a sequence of random numbers."
|
||||
[]
|
||||
(delay (tuple (math/random) (randseq))))
|
||||
(dolazy (tuple (math/random) (randseq))))
|
||||
|
||||
(defn take-while
|
||||
(defn lazy-take-while
|
||||
"Returns a sequence of values until the predicate is false."
|
||||
[pred s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(when x
|
||||
(def thehead (get HEAD x))
|
||||
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
|
||||
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))
|
||||
|
||||
@@ -16,8 +16,8 @@
|
||||
(def cell-set (frequencies state))
|
||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||
(seq [coord :keys neighbor-set
|
||||
:let [count (get neighbor-set coord)]
|
||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||
:let [ncount (get neighbor-set coord)]
|
||||
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
|
||||
coord))
|
||||
|
||||
(defn draw
|
||||
|
||||
@@ -72,6 +72,9 @@ conf.set_quoted('JANET_VERSION', meson.project_version())
|
||||
# Use options
|
||||
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
|
||||
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
|
||||
if get_option('nanbox_pointer_shift') != -1 # -1 is auto-detect
|
||||
conf.set('JANET_NANBOX_64_POINTER_SHIFT', get_option('nanbox_pointer_shift'))
|
||||
endif
|
||||
conf.set('JANET_SINGLE_THREADED', get_option('single_threaded'))
|
||||
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
|
||||
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
|
||||
@@ -2,6 +2,7 @@ option('git_hash', type : 'string', value : 'meson')
|
||||
|
||||
option('single_threaded', type : 'boolean', value : false)
|
||||
option('nanbox', type : 'boolean', value : true)
|
||||
option('nanbox_pointer_shift', type : 'integer', min : -1, max : 4, value : -1)
|
||||
option('dynamic_modules', type : 'boolean', value : true)
|
||||
option('docstrings', type : 'boolean', value : true)
|
||||
option('sourcemaps', type : 'boolean', value : true)
|
||||
|
||||
@@ -46,7 +46,6 @@
|
||||
(defn defmacro :macro :flycheck
|
||||
"Define a macro."
|
||||
[name & more]
|
||||
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
||||
(apply defn name :macro more))
|
||||
|
||||
(defmacro as-macro
|
||||
@@ -219,9 +218,9 @@
|
||||
|
||||
(defmacro default
|
||||
``Define a default value for an optional argument.
|
||||
Expands to `(def sym (if (= nil sym) val sym))`.``
|
||||
Expands to `(def sym :shadow (if (= nil sym) val sym))`.``
|
||||
[sym val]
|
||||
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
|
||||
~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
|
||||
|
||||
(defmacro comment
|
||||
"Ignores the body of the comment."
|
||||
@@ -2675,17 +2674,17 @@
|
||||
(var resumeval nil)
|
||||
(def f
|
||||
(fiber/new
|
||||
(fn []
|
||||
(fn :compile-and-lint []
|
||||
(array/clear lints)
|
||||
(def res (compile source env where lints))
|
||||
(unless (empty? lints)
|
||||
(when (next lints)
|
||||
# Convert lint levels to numbers.
|
||||
(def levels (get env *lint-levels* lint-levels))
|
||||
(def lint-error (get env *lint-error*))
|
||||
(def lint-warning (get env *lint-warn*))
|
||||
(def lint-error (or (get levels lint-error lint-error) 0))
|
||||
(def lint-warning (or (get levels lint-warning lint-warning) 2))
|
||||
(each [level line col msg] lints
|
||||
(each [level line col msg] (distinct lints) # some macros might cause code to be duplicated. Avoid repeated messages.
|
||||
(def lvl (get lint-levels level 0))
|
||||
(cond
|
||||
(<= lvl lint-error) (do
|
||||
|
||||
@@ -16,6 +16,7 @@
|
||||
/* #define JANET_THREAD_LOCAL _Thread_local */
|
||||
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
/* #define JANET_NANBOX_64_POINTER_SHIFT 0 */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
|
||||
@@ -29,7 +29,7 @@
|
||||
#endif
|
||||
|
||||
/* Look up table for instructions */
|
||||
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_0, /* JOP_NOOP, */
|
||||
JINT_S, /* JOP_ERROR, */
|
||||
JINT_ST, /* JOP_TYPECHECK, */
|
||||
|
||||
@@ -91,29 +91,38 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
}
|
||||
|
||||
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
|
||||
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
|
||||
if (sym[0] != '_') {
|
||||
switch (janetc_shadowcheck(c, sym)) {
|
||||
default:
|
||||
break;
|
||||
case JANETC_SHADOW_MACRO:
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a macro", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_LOCAL_HIDES_LOCAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_LOCAL_HIDES_GLOBAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a top-level binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_GLOBAL_HIDES_GLOBAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "top-level binding %q is shadowing another top-level binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
janet_v_push(c->scope->syms, sp);
|
||||
}
|
||||
|
||||
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
|
||||
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.referenced = 1;
|
||||
if (flags & JANET_DEFFLAG_NO_UNUSED) {
|
||||
sp.referenced = 1;
|
||||
} else {
|
||||
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
|
||||
}
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
@@ -260,6 +269,38 @@ static int lookup_missing(
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Check if a binding is defined in an upper scope. This lets us check for
|
||||
* variable shadowing. */
|
||||
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
|
||||
/* Check locals */
|
||||
JanetScope *scope = c->scope;
|
||||
int is_global = (scope->flags & JANET_SCOPE_TOP);
|
||||
while (scope) {
|
||||
int32_t len = janet_v_count(scope->syms);
|
||||
for (int32_t i = len - 1; i >= 0; i--) {
|
||||
SymPair *pair = scope->syms + i;
|
||||
if (pair->sym == sym) {
|
||||
janet_assert(!is_global, "shadowing analysis is incorrect. compiler bug");
|
||||
return JANETC_SHADOW_LOCAL_HIDES_LOCAL;
|
||||
}
|
||||
}
|
||||
scope = scope->parent;
|
||||
}
|
||||
/* Check globals */
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
if (binding.type == JANET_BINDING_MACRO || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
|
||||
return JANETC_SHADOW_MACRO;
|
||||
} else if (binding.type == JANET_BINDING_NONE) {
|
||||
return JANETC_SHADOW_NONE;
|
||||
} else {
|
||||
if (is_global) {
|
||||
return JANETC_SHADOW_GLOBAL_HIDES_GLOBAL;
|
||||
} else {
|
||||
return JANETC_SHADOW_LOCAL_HIDES_GLOBAL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Allow searching for symbols. Return information about the symbol */
|
||||
JanetSlot janetc_resolve(
|
||||
JanetCompiler *c,
|
||||
@@ -1103,6 +1144,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
c->lints = lints;
|
||||
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
|
||||
@@ -36,6 +36,15 @@ typedef enum {
|
||||
JANET_C_LINT_STRICT
|
||||
} JanetCompileLintLevel;
|
||||
|
||||
/* Kinds of variable shadowing for linting */
|
||||
typedef enum {
|
||||
JANETC_SHADOW_NONE,
|
||||
JANETC_SHADOW_MACRO,
|
||||
JANETC_SHADOW_GLOBAL_HIDES_GLOBAL,
|
||||
JANETC_SHADOW_LOCAL_HIDES_GLOBAL,
|
||||
JANETC_SHADOW_LOCAL_HIDES_LOCAL
|
||||
} Shadowing;
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
#define JANET_FUN_ERROR 2
|
||||
@@ -184,6 +193,9 @@ struct JanetCompiler {
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
|
||||
/* Cached version of (dyn *redef*) */
|
||||
int is_redef;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@@ -221,9 +233,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
|
||||
/* Get a special. Return NULL if none exists */
|
||||
const JanetSpecial *janetc_special(const uint8_t *name);
|
||||
|
||||
#define JANET_DEFFLAG_NO_SHADOWCHECK 1
|
||||
#define JANET_DEFFLAG_NO_UNUSED 2
|
||||
|
||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags);
|
||||
JanetSlot janetc_farslot(JanetCompiler *c);
|
||||
|
||||
/* Throw away some code after checking that it is well formed. */
|
||||
@@ -267,9 +281,12 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
|
||||
/* Create a destroy slot */
|
||||
JanetSlot janetc_cslot(Janet x);
|
||||
|
||||
/* Search for a symbol */
|
||||
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
|
||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Check if a symbol is already in scope for shadowing lints */
|
||||
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Bytecode optimization */
|
||||
void janet_bytecode_movopt(JanetFuncDef *def);
|
||||
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
||||
|
||||
@@ -70,7 +70,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
host.minor != modconf.minor ||
|
||||
host.bits != modconf.bits) {
|
||||
char errbuf[128];
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x) - native needs to be recompiled!",
|
||||
host.major,
|
||||
host.minor,
|
||||
host.patch,
|
||||
|
||||
@@ -1962,7 +1962,7 @@ void janet_stream_level_triggered(JanetStream *stream) {
|
||||
janet_register_stream_impl(stream, 0);
|
||||
}
|
||||
|
||||
#define JANET_KQUEUE_MAX_EVENTS 64
|
||||
#define JANET_KQUEUE_MAX_EVENTS 512
|
||||
|
||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
/* Poll for events */
|
||||
@@ -2026,6 +2026,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
|
||||
void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
/* TODO - replace selfpipe with EVFILT_USER (or other events) */
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm.kq = kqueue();
|
||||
janet_vm.timer_enabled = 0;
|
||||
|
||||
@@ -38,6 +38,13 @@
|
||||
#include <windows.h>
|
||||
#endif
|
||||
|
||||
#if defined(JANET_APPLE) || defined(JANET_BSD)
|
||||
#include <sys/event.h>
|
||||
#include <sys/stat.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
typedef struct {
|
||||
const char *name;
|
||||
uint32_t flag;
|
||||
@@ -89,7 +96,7 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
||||
sizeof(JanetWatchFlagName),
|
||||
keyw);
|
||||
if (!result) {
|
||||
janet_panicf("unknown inotify flag %v", options[i]);
|
||||
janet_panicf("unknown linux flag %v", options[i]);
|
||||
}
|
||||
flags |= result->flag;
|
||||
}
|
||||
@@ -128,8 +135,11 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
|
||||
|
||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
|
||||
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
|
||||
Janet pathv = janet_cstringv(path);
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
|
||||
if (!janet_checktype(check, JANET_NUMBER)) {
|
||||
janet_panic("bad watch descriptor");
|
||||
}
|
||||
int watch_handle = janet_unwrap_integer(check);
|
||||
int result;
|
||||
do {
|
||||
@@ -138,6 +148,10 @@ static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (result == -1) {
|
||||
janet_panicv(janet_ev_lasterr());
|
||||
}
|
||||
/*
|
||||
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
|
||||
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(watch_handle), janet_wrap_nil());
|
||||
*/
|
||||
}
|
||||
|
||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
@@ -500,6 +514,254 @@ static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
#elif defined(JANET_APPLE) || defined(JANET_BSD)
|
||||
|
||||
/* kqueue implementation */
|
||||
|
||||
/* Cribbed from ev.c */
|
||||
#define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
|
||||
|
||||
/* Different BSDs define different NOTE_* constants for different kinds of events. Use ifdef to
|
||||
determine when they are available (assuming they are defines and not enums */
|
||||
static const JanetWatchFlagName watcher_flags_kqueue[] = {
|
||||
{
|
||||
"all", NOTE_ATTRIB | NOTE_DELETE | NOTE_EXTEND | NOTE_RENAME | NOTE_REVOKE | NOTE_WRITE | NOTE_LINK
|
||||
#ifdef NOTE_CLOSE
|
||||
| NOTE_CLOSE
|
||||
#endif
|
||||
#ifdef NOTE_CLOSE_WRITE
|
||||
| NOTE_CLOSE_WRITE
|
||||
#endif
|
||||
#ifdef NOTE_OPEN
|
||||
| NOTE_OPEN
|
||||
#endif
|
||||
#ifdef NOTE_READ
|
||||
| NOTE_READ
|
||||
#endif
|
||||
#ifdef NOTE_FUNLOCK
|
||||
| NOTE_FUNLOCK
|
||||
#endif
|
||||
#ifdef NOTE_TRUNCATE
|
||||
| NOTE_TRUNCATE
|
||||
#endif
|
||||
},
|
||||
{"attrib", NOTE_ATTRIB},
|
||||
#ifdef NOTE_CLOSE
|
||||
{"close", NOTE_CLOSE},
|
||||
#endif
|
||||
#ifdef NOTE_CLOSE_WRITE
|
||||
{"close-write", NOTE_CLOSE_WRITE},
|
||||
#endif
|
||||
{"delete", NOTE_DELETE},
|
||||
{"extend", NOTE_EXTEND},
|
||||
#ifdef NOTE_FUNLOCK
|
||||
{"funlock", NOTE_FUNLOCK},
|
||||
#endif
|
||||
{"link", NOTE_LINK},
|
||||
#ifdef NOTE_OPEN
|
||||
{"open", NOTE_OPEN},
|
||||
#endif
|
||||
#ifdef NOTE_READ
|
||||
{"read", NOTE_READ},
|
||||
#endif
|
||||
{"rename", NOTE_RENAME},
|
||||
{"revoke", NOTE_REVOKE},
|
||||
#ifdef NOTE_TRUNCATE
|
||||
{"truncate", NOTE_TRUNCATE},
|
||||
#endif
|
||||
{"write", NOTE_WRITE},
|
||||
};
|
||||
|
||||
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
|
||||
janet_panicf("expected keyword, got %v", options[i]);
|
||||
}
|
||||
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
|
||||
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_kqueue,
|
||||
sizeof(watcher_flags_kqueue) / sizeof(JanetWatchFlagName),
|
||||
sizeof(JanetWatchFlagName),
|
||||
keyw);
|
||||
if (!result) {
|
||||
janet_panicf("unknown bsd flag %v", options[i]);
|
||||
}
|
||||
flags |= result->flag;
|
||||
}
|
||||
return flags;
|
||||
}
|
||||
|
||||
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
|
||||
int kq = kqueue();
|
||||
watcher->watch_descriptors = janet_table(0);
|
||||
watcher->channel = channel;
|
||||
watcher->default_flags = default_flags;
|
||||
watcher->is_watching = 0;
|
||||
watcher->stream = janet_stream(kq, JANET_STREAM_READABLE, NULL);
|
||||
janet_stream_level_triggered(watcher->stream);
|
||||
}
|
||||
|
||||
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
int kq = watcher->stream->handle;
|
||||
struct kevent kev = {0};
|
||||
/* Get file descriptor for path */
|
||||
int file_fd;
|
||||
do {
|
||||
file_fd = open(path, O_RDONLY);
|
||||
} while (file_fd == -1 && errno == EINTR);
|
||||
if (file_fd == -1) {
|
||||
janet_panicf("failed to open: %v", janet_ev_lasterr());
|
||||
}
|
||||
/* Watch for EVFILT_VNODE on the file descriptor */
|
||||
EV_SETx(&kev, file_fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, flags, 0, NULL);
|
||||
int status;
|
||||
do {
|
||||
status = kevent(kq, &kev, 1, NULL, 0, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) {
|
||||
close(file_fd);
|
||||
janet_panicf("failed to listen: %v", janet_ev_lasterr());
|
||||
}
|
||||
/* Bookkeeping */
|
||||
Janet name = janet_cstringv(path);
|
||||
Janet wd = janet_wrap_integer(file_fd);
|
||||
janet_table_put(watcher->watch_descriptors, name, wd);
|
||||
janet_table_put(watcher->watch_descriptors, wd, name);
|
||||
}
|
||||
|
||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
Janet pathv = janet_cstringv(path);
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
|
||||
if (!janet_checktype(check, JANET_NUMBER)) {
|
||||
janet_panic("bad watch descriptor");
|
||||
}
|
||||
/* Closing the file descriptor will also remove it from the kqueue */
|
||||
int wd = janet_unwrap_integer(check);
|
||||
int result;
|
||||
do {
|
||||
result = close(wd);
|
||||
} while (result != -1 && errno == EINTR);
|
||||
if (result == -1) {
|
||||
janet_panicv(janet_ev_lasterr());
|
||||
}
|
||||
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
|
||||
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(wd), janet_wrap_nil());
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
JanetWatcher *watcher;
|
||||
uint32_t cookie;
|
||||
} KqueueWatcherState;
|
||||
|
||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
KqueueWatcherState *state = fiber->ev_state;
|
||||
JanetWatcher *watcher = state->watcher;
|
||||
switch (event) {
|
||||
case JANET_ASYNC_EVENT_MARK:
|
||||
janet_mark(janet_wrap_abstract(watcher));
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_ERR: {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_HUP:
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
/* Pump events from the sub kqueue */
|
||||
const int num_events = 512; /* Extra will be pumped after another event loop rotation. */
|
||||
struct kevent events[num_events];
|
||||
int kq = stream->handle;
|
||||
int status;
|
||||
do {
|
||||
status = kevent(kq, NULL, 0, events, num_events, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
}
|
||||
for (int i = 0; i < status; i++) {
|
||||
state->cookie += 6700417;
|
||||
struct kevent kev = events[i];
|
||||
/* TODO - avoid stat call here, maybe just when adding listener? */
|
||||
struct stat stat_buf = {0};
|
||||
int status;
|
||||
do {
|
||||
status = fstat(kev.ident, &stat_buf);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) continue;
|
||||
int is_dir = S_ISDIR(stat_buf.st_mode);
|
||||
Janet ident = janet_wrap_integer(kev.ident);
|
||||
Janet path = janet_table_get(watcher->watch_descriptors, ident);
|
||||
for (unsigned int j = 1; j < (sizeof(watcher_flags_kqueue) / sizeof(watcher_flags_kqueue[0])); j++) {
|
||||
uint32_t flagcheck = watcher_flags_kqueue[j].flag;
|
||||
if (kev.fflags & flagcheck) {
|
||||
JanetKV *event = janet_struct_begin(6);
|
||||
janet_struct_put(event, janet_ckeywordv("wd"), ident);
|
||||
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
|
||||
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_number((double) state->cookie));
|
||||
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_flags_kqueue[j].name));
|
||||
if (is_dir) {
|
||||
/* Pass in directly */
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_cstringv(""));
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
|
||||
} else {
|
||||
/* Split path */
|
||||
JanetString spath = janet_unwrap_string(path);
|
||||
const uint8_t *cursor = spath + janet_string_length(spath);
|
||||
const uint8_t *cursor_end = cursor;
|
||||
while (cursor > spath && cursor[0] != '/') {
|
||||
cursor--;
|
||||
}
|
||||
if (cursor == spath) {
|
||||
/* No path separators */
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_cstringv("."));
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(spath));
|
||||
} else {
|
||||
/* Found path separator */
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
|
||||
}
|
||||
}
|
||||
Janet eventv = janet_wrap_struct(janet_struct_end(event));
|
||||
janet_channel_give(watcher->channel, eventv);
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
||||
if (watcher->is_watching) janet_panic("already watching");
|
||||
watcher->is_watching = 1;
|
||||
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
|
||||
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
|
||||
KqueueWatcherState *state = janet_malloc(sizeof(KqueueWatcherState));
|
||||
state->watcher = watcher;
|
||||
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
|
||||
janet_gcroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||
if (!watcher->is_watching) return;
|
||||
watcher->is_watching = 0;
|
||||
janet_stream_close(watcher->stream);
|
||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
/* Default implementation */
|
||||
@@ -582,10 +844,10 @@ JANET_CORE_FN(cfun_filewatch_make,
|
||||
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
|
||||
"Events also will contain keys specific to the host OS.\n\n"
|
||||
"Windows has no extra properties on events.\n\n"
|
||||
"Linux has the following extra properties on events:\n\n"
|
||||
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
|
||||
"Linux and the BSDs have the following extra properties on events:\n\n"
|
||||
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this. This is a file descriptor integer on BSD and macos.\n\n"
|
||||
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
|
||||
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
|
||||
"* `:cookie` -- a semi-randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
|
||||
"") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -600,6 +862,7 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"(filewatch/add watcher path flag & more-flags)",
|
||||
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
|
||||
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
|
||||
"FLAGS\n\n"
|
||||
"* `:all` - trigger an event for all of the below triggers.\n\n"
|
||||
"* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
|
||||
"* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
|
||||
@@ -626,6 +889,22 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"* `:open` - `IN_OPEN`\n\n"
|
||||
"* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
|
||||
"* `:unmount` - `IN_UNMOUNT`\n\n\n"
|
||||
"BSDs and macos (flags correspond to `NOTE_*` flags from <sys/event.h>). Not all flags are available on all systems:\n\n"
|
||||
"* `:all` - `All available NOTE_* flags on the current platform`\n\n"
|
||||
"* `:attrib` - `NOTE_ATTRIB`\n\n"
|
||||
"* `:close-write` - `NOTE_CLOSE_WRITE`\n\n"
|
||||
"* `:close` - `NOTE_CLOSE`\n\n"
|
||||
"* `:delete` - `NOTE_DELETE`\n\n"
|
||||
"* `:extend` - `NOTE_EXTEND`\n\n"
|
||||
"* `:funlock` - `NOTE_FUNLOCK`\n\n"
|
||||
"* `:link` - `NOTE_LINK`\n\n"
|
||||
"* `:open` - `NOTE_OPEN`\n\n"
|
||||
"* `:read` - `NOTE_READ`\n\n"
|
||||
"* `:rename` - `NOTE_RENAME`\n\n"
|
||||
"* `:revoke` - `NOTE_REVOKE`\n\n"
|
||||
"* `:truncate` - `NOTE_TRUNCATE`\n\n"
|
||||
"* `:write` - `NOTE_WRITE`\n\n\n"
|
||||
"EVENT TYPES\n\n"
|
||||
"On Windows, events will have the following possible types:\n\n"
|
||||
"* `:unknown`\n\n"
|
||||
"* `:added`\n\n"
|
||||
@@ -633,7 +912,7 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"* `:modified`\n\n"
|
||||
"* `:renamed-old`\n\n"
|
||||
"* `:renamed-new`\n\n"
|
||||
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"On Linux and BSDs, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
||||
@@ -648,6 +927,7 @@ JANET_CORE_FN(cfun_filewatch_remove,
|
||||
"Remove a path from the watcher.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
||||
/* TODO - pass string in directly to avoid extra allocation */
|
||||
const char *path = janet_getcstring(argv, 1);
|
||||
janet_watcher_remove(watcher, path);
|
||||
return argv[0];
|
||||
|
||||
@@ -333,7 +333,7 @@ static int compare_uint64_double(uint64_t x, double y) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64) {
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
@@ -368,7 +368,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) {
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
@@ -416,7 +416,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
* This will not affect the end result (property of twos complement).
|
||||
*/
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -427,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -437,7 +437,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define UNARYMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
||||
@@ -450,7 +450,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -463,7 +463,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -474,7 +474,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -488,7 +488,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -499,7 +499,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
@@ -510,7 +510,7 @@ static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
@@ -521,7 +521,7 @@ static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
@@ -535,7 +535,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
|
||||
@@ -374,7 +374,9 @@ const uint8_t *janet_to_string(Janet x) {
|
||||
struct pretty {
|
||||
JanetBuffer *buffer;
|
||||
int depth;
|
||||
int width;
|
||||
int align;
|
||||
int leaf_align;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
int32_t *keysort_buffer;
|
||||
@@ -466,14 +468,64 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void backtrack_newlines(const struct pretty *S) {
|
||||
if (S->flags & JANET_PRETTY_ONELINE || S->buffer->count <= 0)
|
||||
return;
|
||||
switch (S->buffer->data[S->buffer->count - 1]) {
|
||||
case ')':
|
||||
case '}':
|
||||
case ']':
|
||||
break;
|
||||
default:
|
||||
return;
|
||||
}
|
||||
int32_t removed = 0;
|
||||
int32_t offset = S->buffer->count;
|
||||
for (int columns = S->width, align = 0; offset-- >= 0;) {
|
||||
const char *s = offset < 0 ? "\n" : (char *)S->buffer->data + offset;
|
||||
if (*s == '\n') {
|
||||
if (align < S->leaf_align)
|
||||
break;
|
||||
columns += align;
|
||||
removed += align;
|
||||
align = 0;
|
||||
} else if (*s == ' ') {
|
||||
align++;
|
||||
} else {
|
||||
align = 0;
|
||||
/* Don't count color sequences: \x1B(0|3\d)m */
|
||||
if (S->flags & JANET_PRETTY_COLOR && *s == 'm') {
|
||||
if (offset >= 3 && strncmp("\x1B[0m", s - 3, 4) == 0) {
|
||||
offset -= 3;
|
||||
columns++;
|
||||
} else if (offset >= 4 && strncmp("\x1B[3", s - 4, 3) == 0) {
|
||||
offset -= 4;
|
||||
columns++;
|
||||
}
|
||||
}
|
||||
}
|
||||
if (--columns <= 0)
|
||||
return;
|
||||
}
|
||||
S->buffer->count -= removed;
|
||||
for (int32_t i = ++offset; i < S->buffer->count; i++)
|
||||
if (S->buffer->data[offset] == '\n') {
|
||||
S->buffer->data[i] = ' ';
|
||||
while (S->buffer->data[++offset] == ' ');
|
||||
} else {
|
||||
S->buffer->data[i] = S->buffer->data[offset++];
|
||||
}
|
||||
}
|
||||
|
||||
static void print_newline(struct pretty *S, int align) {
|
||||
int i;
|
||||
S->align = align;
|
||||
if (S->flags & JANET_PRETTY_ONELINE) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
return;
|
||||
}
|
||||
backtrack_newlines(S);
|
||||
janet_buffer_push_u8(S->buffer, '\n');
|
||||
S->leaf_align = S->align = align;
|
||||
for (i = 0; i < S->align; i++) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
}
|
||||
@@ -564,7 +616,7 @@ static void janet_pretty_one(struct pretty *S, Janet x) {
|
||||
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
|
||||
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
|
||||
janet_buffer_push_cstring(S->buffer, startstr);
|
||||
const int align = S->align += strlen(startstr);
|
||||
const int align = S->leaf_align = S->align += strlen(startstr);
|
||||
S->depth--;
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
@@ -639,7 +691,7 @@ static void janet_pretty_one(struct pretty *S, Janet x) {
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
const int align = ++S->align;
|
||||
const int align = S->leaf_align = ++S->align;
|
||||
|
||||
S->depth--;
|
||||
if (S->depth == 0) {
|
||||
@@ -732,13 +784,17 @@ static void janet_pretty_one(struct pretty *S, Janet x) {
|
||||
return;
|
||||
}
|
||||
|
||||
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) {
|
||||
#define JANET_COLUMNS 80
|
||||
|
||||
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int width,
|
||||
int flags, Janet x, int32_t startlen) {
|
||||
struct pretty S;
|
||||
if (NULL == buffer) {
|
||||
buffer = janet_buffer(0);
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.width = width;
|
||||
S.align = 0;
|
||||
S.flags = flags;
|
||||
S.bufstartlen = startlen;
|
||||
@@ -747,6 +803,7 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
|
||||
S.keysort_start = 0;
|
||||
janet_table_init(&S.seen, 10);
|
||||
janet_pretty_one(&S, x);
|
||||
backtrack_newlines(&S);
|
||||
janet_table_deinit(&S.seen);
|
||||
return S.buffer;
|
||||
}
|
||||
@@ -754,7 +811,8 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
|
||||
/* Helper for printing a janet value in a pretty form. Not meant to be used
|
||||
* for serialization or anything like that. */
|
||||
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
|
||||
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0);
|
||||
return janet_pretty_(buffer, depth, JANET_COLUMNS, flags,
|
||||
x, buffer ? buffer->count : 0);
|
||||
}
|
||||
|
||||
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) {
|
||||
@@ -986,11 +1044,17 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int columns = atoi(width);
|
||||
if (columns == 0)
|
||||
columns = JANET_COLUMNS;
|
||||
else if (columns < 0)
|
||||
has_oneline = 1;
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen);
|
||||
janet_pretty_(b, depth, columns, flags,
|
||||
va_arg(args, Janet), startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
@@ -1148,11 +1212,17 @@ void janet_buffer_format(
|
||||
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
|
||||
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
|
||||
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
|
||||
int columns = atoi(width);
|
||||
if (columns == 0)
|
||||
columns = JANET_COLUMNS;
|
||||
else if (columns < 0)
|
||||
has_oneline = 1;
|
||||
int flags = 0;
|
||||
flags |= has_color ? JANET_PRETTY_COLOR : 0;
|
||||
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
|
||||
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
|
||||
janet_pretty_(b, depth, flags, argv[arg], startlen);
|
||||
janet_pretty_(b, depth, columns, flags,
|
||||
argv[arg], startlen);
|
||||
break;
|
||||
}
|
||||
case 'j': {
|
||||
|
||||
@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
|
||||
}
|
||||
|
||||
/* Def or var a symbol in a local scope */
|
||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
|
||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, uint32_t def_flags) {
|
||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||
ret.index > 0 &&
|
||||
ret.envindex >= 0;
|
||||
@@ -425,11 +425,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
||||
ret = localslot;
|
||||
}
|
||||
ret.flags |= flags;
|
||||
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
|
||||
janetc_nameslot_no_unused(c, head, ret);
|
||||
} else {
|
||||
janetc_nameslot(c, head, ret);
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
}
|
||||
janetc_nameslot(c, head, ret, def_flags);
|
||||
return !isUnnamedRegister;
|
||||
}
|
||||
|
||||
@@ -443,7 +442,7 @@ static int varleaf(
|
||||
JanetSlot refslot;
|
||||
JanetTable *entry = janet_table_clone(reftab);
|
||||
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
int is_redef = c->is_redef;
|
||||
|
||||
JanetArray *ref;
|
||||
JanetBinding old_binding;
|
||||
@@ -464,7 +463,11 @@ static int varleaf(
|
||||
return 1;
|
||||
} else {
|
||||
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
|
||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
|
||||
int no_shadow = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "shadow"));
|
||||
uint32_t def_flags = 0;
|
||||
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
|
||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, def_flags);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -505,12 +508,14 @@ static int defleaf(
|
||||
const uint8_t *sym,
|
||||
JanetSlot s,
|
||||
JanetTable *tab) {
|
||||
JanetTable *entry = NULL;
|
||||
int is_redef = 0;
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
JanetTable *entry = janet_table_clone(tab);
|
||||
entry = janet_table_clone(tab);
|
||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
is_redef = c->is_redef;
|
||||
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
|
||||
|
||||
if (is_redef) {
|
||||
@@ -530,12 +535,18 @@ static int defleaf(
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
||||
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
||||
}
|
||||
|
||||
/* 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_keyword(tab, "unused"));
|
||||
return namelocal(c, sym, 0, s, no_unused);
|
||||
int no_shadow = is_redef || (tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "shadow")));
|
||||
uint32_t def_flags = 0;
|
||||
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
|
||||
int result = namelocal(c, sym, 0, s, def_flags);
|
||||
if (entry) {
|
||||
/* Add env entry to env AFTER namelocal to avoid the shadowcheck false positive */
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
@@ -1066,10 +1077,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
named_table = janet_table(10);
|
||||
named_slot = janetc_farslot(c);
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
janetc_nameslot(c, sym, janetc_farslot(c), 0);
|
||||
}
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
janetc_nameslot(c, sym, janetc_farslot(c), 0);
|
||||
}
|
||||
} else {
|
||||
janet_v_push(destructed_params, janetc_farslot(c));
|
||||
@@ -1118,7 +1129,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot slot = janetc_farslot(c);
|
||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||
janetc_nameslot_no_unused(c, sym, slot);
|
||||
/* We should figure out a better way to avoid `(def x 1) (def x :shadow (fn x [...] ...))` triggering a
|
||||
* shadow lint for the last x */
|
||||
janetc_nameslot(c, sym, slot, JANET_DEFFLAG_NO_UNUSED | JANET_DEFFLAG_NO_SHADOWCHECK);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -555,7 +555,9 @@ JANET_CORE_FN(cfun_string_format,
|
||||
"\n"
|
||||
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
|
||||
"variants generate colored output. These specifiers can take a precision "
|
||||
"argument to specify the maximum nesting depth to print.\n"
|
||||
"argument to specify the maximum nesting depth to print. "
|
||||
"The multiline specifiers can also take a width argument, "
|
||||
"which defaults to 80 columns.\n"
|
||||
"- `p`, `P`: pretty format, truncating if necessary\n"
|
||||
"- `m`, `M`: pretty format without truncating.\n"
|
||||
"- `q`, `Q`: pretty format on one line, truncating if necessary.\n"
|
||||
|
||||
@@ -49,6 +49,8 @@
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JANET_NUMBER_LENGTH_RIDICULOUS 0xFFFF
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||
static uint8_t digit_lookup[128] = {
|
||||
@@ -266,7 +268,7 @@ int janet_scan_number_base(
|
||||
* the decimal point, exponent could wrap around and become positive. It's
|
||||
* easier to reject ridiculously large inputs than to check for overflows.
|
||||
* */
|
||||
if (len > INT32_MAX / 40) goto error;
|
||||
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) goto error;
|
||||
|
||||
/* Get sign */
|
||||
if (str >= end) goto error;
|
||||
@@ -410,10 +412,7 @@ static int scan_uint64(
|
||||
*neg = 0;
|
||||
*out = 0;
|
||||
uint64_t accum = 0;
|
||||
/* len max is INT64_MAX in base 2 with _ between each bits */
|
||||
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
|
||||
/* zeros */
|
||||
if (len > 150) return 0;
|
||||
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) return 0;
|
||||
/* Get sign */
|
||||
if (str >= end) return 0;
|
||||
if (*str == '-') {
|
||||
|
||||
@@ -573,8 +573,24 @@ static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
|
||||
return (char *)(namebuf->buf);
|
||||
}
|
||||
|
||||
/* Add a little bit of safety when using nanboxing on arm. Instead of inserting run-time checks everywhere, we are
|
||||
* only doing it during registration which has much less cost (1 shift and mask). */
|
||||
static void janet_check_pointer_align(void *p) {
|
||||
(void) p;
|
||||
#if defined(JANET_NANBOX_64) && JANET_NANBOX_64_POINTER_SHIFT != 0
|
||||
union {
|
||||
void *p;
|
||||
uintptr_t u;
|
||||
} un;
|
||||
un.p = p;
|
||||
janet_assert(!(un.u & (uintptr_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)),
|
||||
"unaligned pointer wrap - cfunction pointers and abstract types must be aligned with this nanboxing configuration.");
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
@@ -584,6 +600,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
|
||||
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
@@ -595,6 +612,7 @@ void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
@@ -607,6 +625,7 @@ void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetR
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
@@ -623,6 +642,7 @@ void janet_register(const char *name, JanetCFunction cfun) {
|
||||
/* Abstract type introspection */
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
janet_check_pointer_align((void *) at);
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
Janet check = janet_table_get(janet_vm.abstract_registry, sym);
|
||||
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
|
||||
@@ -655,6 +675,7 @@ void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
|
||||
@@ -50,9 +50,9 @@
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
fprintf(stderr, "janet abort at %s:%d: %s\n",\
|
||||
__FILE__,\
|
||||
__LINE__,\
|
||||
(m));\
|
||||
abort();\
|
||||
} while (0)
|
||||
|
||||
@@ -194,12 +194,18 @@ Janet janet_wrap_number_safe(double d) {
|
||||
|
||||
void *janet_nanbox_to_pointer(Janet x) {
|
||||
x.i64 &= JANET_NANBOX_PAYLOADBITS;
|
||||
x.u64 <<= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
return x.pointer;
|
||||
}
|
||||
|
||||
Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
|
||||
Janet ret;
|
||||
ret.pointer = p;
|
||||
/* Should be noop when pointer shift is 0 */
|
||||
/*
|
||||
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
|
||||
*/
|
||||
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
ret.u64 |= tagmask;
|
||||
return ret;
|
||||
}
|
||||
@@ -207,6 +213,11 @@ Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
|
||||
Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
|
||||
Janet ret;
|
||||
ret.pointer = (void *)p;
|
||||
/* Should be noop when pointer shift is 0 */
|
||||
/*
|
||||
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
|
||||
*/
|
||||
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
ret.u64 |= tagmask;
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -307,25 +307,38 @@ extern "C" {
|
||||
* architectures (Nanboxing only tested on x86 and x64), comment out
|
||||
* the JANET_NANBOX define.*/
|
||||
|
||||
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
|
||||
#define JANET_NO_NANBOX
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv) || defined(__aarch64__) || defined(_M_ARM64)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* for x64 and risc-v. This is mainly because the approach is tied to the
|
||||
* for x64, risc-v, and arm64. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. Many arches allow/require this, but not all,
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations. */
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations by taking advantage
|
||||
* of pointer alignment to allow for 48 or 49 bits of address space. */
|
||||
#define JANET_NANBOX_64
|
||||
|
||||
/* Allow 64-bit nanboxing to assume aligned pointers to get back some extra bits for representation.
|
||||
* This is needed to use nanboxing on systems with larger than 47-bit address spaces, such as many
|
||||
* aarch64 systems. */
|
||||
#ifndef JANET_NANBOX_64_POINTER_SHIFT
|
||||
#if (defined(_M_ARM64) || defined(__aarch64__)) && !defined(JANET_APPLE)
|
||||
/* All pointers, including function pointers, should be 4-byte aligned on aarch64 by default.
|
||||
* The exception is aarch64 macos, as it uses the same 47-bit userland address-space as on amd64. */
|
||||
#define JANET_NANBOX_64_POINTER_SHIFT 2
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Allow for custom pointer alignment as well */
|
||||
#if defined(JANET_NANBOX_64) && !defined(JANET_NANBOX_64_POINTER_SHIFT)
|
||||
#define JANET_NANBOX_64_POINTER_SHIFT 0
|
||||
#endif
|
||||
|
||||
/* Runtime config constants */
|
||||
#ifdef JANET_NO_NANBOX
|
||||
#define JANET_NANBOX_BIT 0
|
||||
#define JANET_NANBOX_BIT 0x0
|
||||
#else
|
||||
#define JANET_NANBOX_BIT 0x1
|
||||
#endif
|
||||
@@ -336,9 +349,16 @@ extern "C" {
|
||||
#define JANET_SINGLE_THREADED_BIT 0
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_64_POINTER_SHIFT
|
||||
#define JANET_NANBOX_POINTER_SHIFT_BITS (JANET_NANBOX_64_POINTER_SHIFT ? (0x4 << JANET_NANBOX_64_POINTER_SHIFT) : 0)
|
||||
#else
|
||||
#define JANET_NANBOX_POINTER_SHIFT_BITS 0
|
||||
#endif
|
||||
|
||||
#define JANET_CURRENT_CONFIG_BITS \
|
||||
(JANET_SINGLE_THREADED_BIT | \
|
||||
JANET_NANBOX_BIT)
|
||||
JANET_NANBOX_BIT | \
|
||||
JANET_NANBOX_POINTER_SHIFT_BITS)
|
||||
|
||||
/* Represents the settings used to compile Janet, as well as the version */
|
||||
typedef struct {
|
||||
@@ -1415,7 +1435,7 @@ enum JanetOpCode {
|
||||
};
|
||||
|
||||
/* Info about all instructions */
|
||||
extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
extern const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** END SECTION OPCODES *****/
|
||||
|
||||
@@ -2063,8 +2083,14 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
*
|
||||
* */
|
||||
|
||||
#if defined(JANET_NANBOX_64) && (JANET_NANBOX_64_POINTER_SHIFT != 0) && !defined(JANET_MSVC)
|
||||
#define JANET_CFUNCTION_ALIGN __attribute__((aligned(1 << JANET_NANBOX_64_POINTER_SHIFT)))
|
||||
#else
|
||||
#define JANET_CFUNCTION_ALIGN
|
||||
#endif
|
||||
|
||||
/* Shorthand for janet C function declarations */
|
||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||
#define JANET_CFUN(name) JANET_CFUNCTION_ALIGN Janet name (int32_t argc, Janet *argv)
|
||||
|
||||
/* Declare a C function with documentation and source mapping */
|
||||
#define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
|
||||
@@ -2080,7 +2106,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
|
||||
|
||||
@@ -2088,7 +2114,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
|
||||
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
|
||||
janet_def(ENV, JNAME, VAL, DOC)
|
||||
|
||||
@@ -2097,7 +2123,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
|
||||
|
||||
|
||||
@@ -519,8 +519,13 @@ static void historymove(int delta) {
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
}
|
||||
gbl_len = (int) strlen(gbl_history[gbl_historyi]);
|
||||
/* If history element is longer the JANET_LINE_MAX - 1, truncate */
|
||||
if (gbl_len > JANET_LINE_MAX - 1) {
|
||||
gbl_len = JANET_LINE_MAX - 1;
|
||||
}
|
||||
gbl_pos = gbl_len;
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = (int) strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
@@ -1232,7 +1237,7 @@ int main(int argc, char **argv) {
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1] = {0};
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
@@ -1240,6 +1245,7 @@ int main(int argc, char **argv) {
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
hash_key[JANET_HASH_KEY_SIZE] = '\0'; /* in case copy didn't get null byte */
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
|
||||
@@ -27,9 +27,11 @@
|
||||
(def line-info (string/format "%s:%d"
|
||||
(frame :source) (frame :source-line)))
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||
(when is-verbose
|
||||
(eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)
|
||||
(eflush) (flush))
|
||||
(do
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
@@ -38,7 +40,7 @@
|
||||
(+= skip-n n)
|
||||
nil)
|
||||
|
||||
(defmacro assert
|
||||
(defmacro assert :shadow
|
||||
[x &opt e]
|
||||
(def xx (gensym))
|
||||
(default e (string/format "%j" x))
|
||||
@@ -50,12 +52,12 @@
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defmacro assert-error-value
|
||||
[msg errval & forms]
|
||||
(def e (gensym))
|
||||
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
|
||||
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
|
||||
|
||||
(defn check-compile-error
|
||||
[form]
|
||||
|
||||
@@ -70,9 +70,9 @@
|
||||
(assert (= (array/pop @[]) nil) "array/pop empty")
|
||||
|
||||
# Code coverage
|
||||
(def a @[1])
|
||||
(array/pop a)
|
||||
(array/trim a)
|
||||
(def a1 @[1])
|
||||
(array/pop a1)
|
||||
(array/trim a1)
|
||||
(array/ensure @[1 1] 6 2)
|
||||
|
||||
# array/join
|
||||
|
||||
@@ -48,8 +48,8 @@
|
||||
|
||||
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
|
||||
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
|
||||
(def b @"AA")
|
||||
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
|
||||
(def b1 @"AA")
|
||||
(assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
|
||||
|
||||
# buffer/push-byte
|
||||
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
|
||||
@@ -145,8 +145,8 @@
|
||||
|
||||
# Regression #301
|
||||
# a3d4ecddb
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
|
||||
(def b8 (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
|
||||
|
||||
(def a @"abcdefghijklm")
|
||||
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
|
||||
|
||||
@@ -84,23 +84,23 @@
|
||||
(assert (get result :error) "bad sum3 fuzz issue valgrind")
|
||||
|
||||
# Issue #1700
|
||||
(def result
|
||||
(def result1
|
||||
(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")
|
||||
(assert (get result1 :error) "fuzz case issue #1700")
|
||||
|
||||
# Issue #1702 - fuzz case with upvalues
|
||||
(def result
|
||||
(def result2
|
||||
(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")
|
||||
(assert result2 "bad upvalues fuzz case")
|
||||
|
||||
# Named argument linting
|
||||
# Enhancement for #1654
|
||||
@@ -117,14 +117,14 @@
|
||||
(defn check-good-compile
|
||||
[code msg]
|
||||
(def lints @[])
|
||||
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result) (empty? lints)) msg))
|
||||
(def result4 (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result4) (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))
|
||||
(def result4 (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result4) (next lints)) msg))
|
||||
|
||||
(check-good-compile '(fnamed) "named no args")
|
||||
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
|
||||
@@ -150,5 +150,10 @@
|
||||
(check-lint-compile '(g 1 2 :z) "g lint 1")
|
||||
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
|
||||
|
||||
(end-suite)
|
||||
# Variable shadowing linting
|
||||
(def outer1 "a")
|
||||
(check-lint-compile '(def outer1 "b") "shadow global-to-global")
|
||||
(check-lint-compile '(let [outer1 "b"] outer1) "shadow local-to-global")
|
||||
(check-lint-compile '(do (def x "b") (def x "c")) "shadow local-to-local")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -43,9 +43,9 @@
|
||||
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
|
||||
|
||||
# Another variant
|
||||
(def thread-channel (ev/thread-chan 100))
|
||||
(def super (ev/thread-chan 10))
|
||||
(defn worker []
|
||||
(def thread-channel :shadow (ev/thread-chan 100))
|
||||
(def super :shadow (ev/thread-chan 10))
|
||||
(defn worker :shadow []
|
||||
(while true
|
||||
(def item (ev/take thread-channel))
|
||||
(when (= item :deadline)
|
||||
|
||||
@@ -26,6 +26,8 @@
|
||||
(def chan (ev/chan 1000))
|
||||
(var is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
||||
(var is-linux (= :linux (os/which)))
|
||||
(def bsds [:freebsd :macos :openbsd :bsd :dragonfly :netbsd])
|
||||
(var is-kqueue (index-of (os/which) bsds))
|
||||
|
||||
# If not supported, exit early
|
||||
(def [supported msg] (protect (filewatch/new chan)))
|
||||
@@ -97,6 +99,10 @@
|
||||
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
|
||||
(filewatch/add fw td1 :close-write :create :delete)
|
||||
(filewatch/add fw td2 :close-write :create :delete :ignored))
|
||||
(when is-kqueue
|
||||
(filewatch/add fw (string td3 "/file3.txt") :all)
|
||||
(filewatch/add fw td1 :all)
|
||||
(filewatch/add fw td2 :all))
|
||||
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
|
||||
|
||||
#
|
||||
@@ -196,6 +202,30 @@
|
||||
(expect-empty)
|
||||
(gccollect))
|
||||
|
||||
#
|
||||
# Macos and BSD file writing
|
||||
#
|
||||
|
||||
# TODO - kqueue capabilities here are a bit more limited than inotify and windows by default.
|
||||
# This could be ammended with some heavier-weight functionality in userspace, though.
|
||||
(when is-kqueue
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :wd-path td1 :type :write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
# Currently, only operations that modify the parent vnode do anything
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :wd-path td2 :type :write)
|
||||
(expect-empty)
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :write) # a "write" to the vnode
|
||||
(expect-empty))
|
||||
|
||||
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
|
||||
(assert-no-error "cleanup 1" (rmrf td1))
|
||||
(assert-no-error "cleanup 2" (rmrf td2))
|
||||
|
||||
@@ -37,7 +37,7 @@
|
||||
|
||||
# Printing to functions
|
||||
# 4e263b8c3
|
||||
(def out-buf @"")
|
||||
(def out-buf :shadow @"")
|
||||
(defn prepend [x]
|
||||
(with-dyns [:out out-buf]
|
||||
(prin "> " x)))
|
||||
@@ -59,8 +59,8 @@
|
||||
|
||||
# issue #1055 - 2c927ea76
|
||||
(let [b @""]
|
||||
(defn dummy [a b c]
|
||||
(+ a b c))
|
||||
(defn dummy [a bb c]
|
||||
(+ a bb c))
|
||||
(trace dummy)
|
||||
(defn errout [arg]
|
||||
(buffer/push b arg))
|
||||
|
||||
@@ -95,11 +95,11 @@
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f1 :shadow [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ tup] (protect (f1 @[0])))
|
||||
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(def [f1 f2] :shadow (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
|
||||
|
||||
@@ -108,10 +108,10 @@
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(defn f1 :shadow [] (++ (a 0)))
|
||||
(defn f2 :shadow [] (++ (a 0)))
|
||||
(marshal [f1 f2] make-image-dict))
|
||||
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
|
||||
(def [f1 f2] :shadow (unmarshal (f1 @[0]) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-live-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-live-closure 2"))
|
||||
|
||||
@@ -189,11 +189,11 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (deep= t tclone) "table/weak marsh 7")
|
||||
|
||||
# table weak keys
|
||||
(def t (table/weak-keys 1))
|
||||
(def t :shadow (table/weak-keys 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-keys marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
|
||||
@@ -201,23 +201,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (deep= t tclone) "table/weak-keys marsh 5")
|
||||
|
||||
# table weak values
|
||||
(def t (table/weak-values 1))
|
||||
(def t :shadow (table/weak-values 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-values marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "table/weak-value marsh 3")
|
||||
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
|
||||
|
||||
# tables with prototypes
|
||||
(def t (table/weak-values 1))
|
||||
(def t :shadow (table/weak-values 1))
|
||||
(table/setproto t @{:abc 123})
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
|
||||
|
||||
@@ -138,13 +138,13 @@
|
||||
|
||||
# Parser clone
|
||||
# 43520ac67
|
||||
(def p (parser/new))
|
||||
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p))
|
||||
(def p0 (parser/new))
|
||||
(assert (= 7 (parser/consume p0 "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p0))
|
||||
(parser/consume p2 ") 1 ")
|
||||
(parser/consume p ") 1 ")
|
||||
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
|
||||
(parser/consume p0 ") 1 ")
|
||||
(assert (deep= (parser/status p0) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p0) (parser/state p2)) "parser 3")
|
||||
|
||||
# Parser errors
|
||||
# 976dfc719
|
||||
@@ -179,11 +179,11 @@
|
||||
(parser/consume p1 step1)
|
||||
(loop [_ :iterate (parser/produce p1)])
|
||||
(parser/state p1)
|
||||
(def p2 (parser/clone p1))
|
||||
(parser/state p2)
|
||||
(parser/consume p2 step2)
|
||||
(loop [_ :iterate (parser/produce p2)])
|
||||
(parser/state p2)
|
||||
(def p3 (parser/clone p1))
|
||||
(parser/state p3)
|
||||
(parser/consume p3 step2)
|
||||
(loop [_ :iterate (parser/produce p3)])
|
||||
(parser/state p3)
|
||||
|
||||
# parser delimiter errors
|
||||
(defn test-error [delim fmt]
|
||||
@@ -202,11 +202,11 @@
|
||||
(parser/consume p ")")
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
|
||||
(def p (parser/new))
|
||||
(parser/consume p `("hel`)
|
||||
(parser/insert p `lo`)
|
||||
(parser/consume p `")`)
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
(def p4 (parser/new))
|
||||
(parser/consume p4 `("hel`)
|
||||
(parser/insert p4 `lo`)
|
||||
(parser/consume p4 `")`)
|
||||
(assert (= (parser/produce p4) ["hello"]))
|
||||
|
||||
# Hex floats
|
||||
(assert (= math/pi +0x1.921fb54442d18p+0001))
|
||||
|
||||
@@ -84,10 +84,10 @@
|
||||
|
||||
# Substitution test with peg
|
||||
# d7626f8c5
|
||||
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(defn try-grammar [text]
|
||||
(assert (= (string/replace-all "dog" "purple panda" text)
|
||||
(0 (peg/match grammar text))) text))
|
||||
(0 (peg/match grammar1 text))) text))
|
||||
|
||||
(try-grammar "i have a dog called doug the dog. he is good.")
|
||||
(try-grammar "i have a dog called doug the dog. he is a good boy.")
|
||||
@@ -336,7 +336,7 @@
|
||||
|
||||
# unref
|
||||
# 96513665d
|
||||
(def grammar
|
||||
(def grammar2
|
||||
(peg/compile
|
||||
~{:main (* :tagged -1)
|
||||
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
|
||||
@@ -344,9 +344,9 @@
|
||||
:value (* (constant :value) (group (any (+ :tagged :untagged))))
|
||||
:close-tag (* "</" (backmatch :tag-name) ">")
|
||||
:untagged (capture (any (if-not "<" 1)))}))
|
||||
(check-deep grammar "<p><em>foobar</em></p>"
|
||||
(check-deep grammar2 "<p><em>foobar</em></p>"
|
||||
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
|
||||
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
(check-deep grammar2 "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
|
||||
# Using a large test grammar
|
||||
# cf05ff610
|
||||
@@ -369,7 +369,7 @@
|
||||
(def sym (symbol text))
|
||||
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
(def grammar3
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
:readermac (set "';~,")
|
||||
:symchars (+ (range "09" "AZ" "az" "\x80\xFF")
|
||||
@@ -408,13 +408,13 @@
|
||||
:dict (* '"@" :struct)
|
||||
:main (+ :root (error ""))})
|
||||
|
||||
(def p (peg/compile grammar))
|
||||
(def porig (peg/compile grammar3))
|
||||
|
||||
# Just make sure is valgrind clean.
|
||||
(def p (-> p make-image load-image))
|
||||
(def pprime (-> porig make-image load-image))
|
||||
|
||||
(assert (peg/match p "abc") "complex peg grammar 1")
|
||||
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
|
||||
(assert (peg/match pprime "abc") "complex peg grammar 1")
|
||||
(assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
|
||||
|
||||
###
|
||||
### Compiling brainfuck to Janet.
|
||||
@@ -565,8 +565,8 @@
|
||||
"peg/replace-all function")
|
||||
|
||||
# 9dc7e8ed3
|
||||
(defn peg-test [name f peg subst text expected]
|
||||
(assert (= (string (f peg subst text)) expected) name))
|
||||
(defn peg-test [name f pegg subst text expected]
|
||||
(assert (= (string (f pegg subst text)) expected) name))
|
||||
|
||||
(peg-test "peg/replace has access to captures"
|
||||
peg/replace
|
||||
@@ -602,10 +602,10 @@
|
||||
|
||||
# Marshal and unmarshal pegs
|
||||
# 446ab037b
|
||||
(def p (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p "abcd") "peg marshal 1")
|
||||
(assert (peg/match p "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
|
||||
(def p3 (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p3 "abcd") "peg marshal 1")
|
||||
(assert (peg/match p3 "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p3 "zabcdefg")) "peg marshal 3")
|
||||
|
||||
# to/thru bug
|
||||
# issue #971 - a895219d2
|
||||
@@ -669,10 +669,10 @@
|
||||
(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))
|
||||
(assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal))
|
||||
(assert (deep= (peg/match peg input) expected) name))
|
||||
(defn test [name pegg input expected]
|
||||
(assert-no-error "compile peg" (peg/compile pegg))
|
||||
(assert-no-error "marshal/unmarshal peg" (-> pegg marshal unmarshal))
|
||||
(assert (deep= (peg/match pegg input) expected) name))
|
||||
|
||||
(test "sub: matches the same input twice"
|
||||
~(sub "abcd" "abc")
|
||||
@@ -852,20 +852,20 @@
|
||||
@[["b" "b" "b"]])
|
||||
|
||||
# Debug and ?? tests.
|
||||
(defn test-stderr [name peg input expected-matches expected-stderr]
|
||||
(defn test-stderr [name pegg input expected-matches expected-stderr]
|
||||
(with-dyns [:err @""]
|
||||
(test name peg input expected-matches))
|
||||
(test name pegg input expected-matches))
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* true]
|
||||
(peg/match peg input))
|
||||
(peg/match pegg input))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
|
||||
(defn test-stderr-no-color [name pegg input expected-matches expected-stderr]
|
||||
(with-dyns [:err @""]
|
||||
(test name peg input expected-matches))
|
||||
(test name pegg input expected-matches))
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* false]
|
||||
(peg/match peg input))
|
||||
(peg/match pegg input))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(test-stderr
|
||||
|
||||
@@ -44,8 +44,8 @@
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp))
|
||||
`abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
|
||||
(def buftemp2 @"abcd")
|
||||
(assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
|
||||
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# 5c364e0
|
||||
@@ -67,26 +67,18 @@
|
||||
:baz 42}
|
||||
@{:_name "Foo"})}]
|
||||
(set (tab tup) tab)
|
||||
(assert (= (string/format "%m" {tup @[tup tab]
|
||||
'symbol tup})
|
||||
(assert (= (string/format "%67m" {tup @[tup tab]
|
||||
'symbol tup})
|
||||
`
|
||||
{symbol (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
{symbol (:keyword "string" @"buffer")
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") @[(:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
@{true @Foo{:bar (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
@"buffer") @[(:keyword "string" @"buffer")
|
||||
@{true @Foo{:bar (:keyword "string" @"buffer")
|
||||
:baz 42}
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") <cycle 2>}]}`))
|
||||
(assert (= (string/format "%p" {(freeze (zipcoll (range 42)
|
||||
(range -42 0))) tab})
|
||||
(:keyword "string" @"buffer") <cycle 2>}]}`))
|
||||
(assert (= (string/format "%67p" {(freeze (zipcoll (range 42)
|
||||
(range -42 0))) tab})
|
||||
`
|
||||
{{0 -42
|
||||
1 -41
|
||||
@@ -118,11 +110,6 @@
|
||||
27 -15
|
||||
28 -14
|
||||
29 -13
|
||||
...} @{true @Foo{:bar (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
:baz 42}
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") <cycle 1>}}`)))
|
||||
...} @{true @Foo{:bar (:keyword "string" @"buffer") :baz 42}
|
||||
(:keyword "string" @"buffer") <cycle 1>}}`)))
|
||||
(end-suite)
|
||||
|
||||
@@ -132,11 +132,11 @@
|
||||
|
||||
# Cancel test
|
||||
# 28439d822
|
||||
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume f)) "cancel resume 1")
|
||||
(assert (= 2 (resume f)) "cancel resume 2")
|
||||
(assert (= :hi (cancel f :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status f)) "cancel resume 4")
|
||||
(def fc (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume fc)) "cancel resume 1")
|
||||
(assert (= 2 (resume fc)) "cancel resume 2")
|
||||
(assert (= :hi (cancel fc :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status fc)) "cancel resume 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
7
tools/afl/pp_runner.janet
Normal file
7
tools/afl/pp_runner.janet
Normal file
@@ -0,0 +1,7 @@
|
||||
(def p (parser/new))
|
||||
(parser/consume p (slurp ((dyn :args) 1)))
|
||||
(while (parser/has-more p)
|
||||
(def x (parser/produce p))
|
||||
(printf "%m\n%99M\n%1m\n%0M" x x x x)
|
||||
(printf "%q\n%99Q\n%1p\n%P" x x x x)
|
||||
(protect (printf "%j" x)))
|
||||
Reference in New Issue
Block a user