1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-02 21:11:27 +00:00

Compare commits

..

5 Commits

Author SHA1 Message Date
Calvin Rose
d816011ec1 Remove word. 2026-03-14 23:12:47 -05:00
Calvin Rose
934cf9d5b8 Remove wiggle room for any AI code in the Janet runtime.
Still leave open the possibity for AI / tool usage for static analysis
and bug repots. However, the 5-15 lines of code limitation is fuzzy and
arbitrary. We can just say no.
2026-03-14 23:05:24 -05:00
Calvin Rose
9880475262 Add suggestions.
- No bot PRs
- Define "Large" code contribution

Also try to disuade users from using AI for one-line or simple changes, instead
preferring to treat that as "feedback" and rewrite instead.
2026-03-13 17:27:32 -05:00
Calvin Rose
bab71feadb Word order and punctuation. 2026-03-13 08:30:46 -05:00
Calvin Rose
8eae8984b1 Add LLM, AI and tool usage section to contribution guide. 2026-03-13 08:28:19 -05:00
30 changed files with 186 additions and 326 deletions

View File

@@ -12,7 +12,7 @@ jobs:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ ubuntu-latest, ubuntu-24.04-arm, macos-latest, macos-14, macos-15-intel ]
os: [ ubuntu-latest, macos-latest, macos-14, macos-15-intel ]
steps:
- name: Checkout the repository
uses: actions/checkout@master

View File

@@ -3,10 +3,10 @@
(defn bork [x]
(defn bark [y]
(defn bark [x]
(print "Woof!")
(print y)
(error y)
(print x)
(error x)
(print "Woof!"))
(bark (* 2 x))

View File

@@ -7,13 +7,13 @@
(print "simple yielding")
(each item f (print "got: " item ", now " (fiber/status f)))
(def f2
(def f
(coro
(for i 0 10
(yield (string "yield " i))
(ev/sleep 0))))
(print "complex yielding")
(each item f2 (print "got: " item ", now " (fiber/status f2)))
(each item f (print "got: " item ", now " (fiber/status f)))
(print (fiber/status f2))
(print (fiber/status f))

View File

@@ -4,7 +4,7 @@
# that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro dolazy
(defmacro delay
"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 lazy-empty?
(defn empty?
"Check if a sequence is empty."
[s]
(not (s)))
@@ -55,14 +55,14 @@
[start end &]
(if end
(if (< start end)
(dolazy (tuple start (lazy-range (+ 1 start) end)))
(delay (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]
(dolazy
(delay
(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 lazy-drop
(defn drop
"Ignores the first n values of the sequence and returns the rest."
[n s]
(dolazy
(delay
(def x (s))
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
(defn lazy-take
(defn take
"Returns at most the first n values of s."
[n s]
(dolazy
(delay
(def x (s))
(if (and x (pos? n))
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
(defn randseq
"Return a sequence of random numbers."
[]
(dolazy (tuple (math/random) (randseq))))
(delay (tuple (math/random) (randseq))))
(defn lazy-take-while
(defn take-while
"Returns a sequence of values until the predicate is false."
[pred s]
(dolazy
(delay
(def x (s))
(when x
(def thehead (get HEAD x))
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))

View File

@@ -16,8 +16,8 @@
(def cell-set (frequencies state))
(def neighbor-set (frequencies (mapcat neighbors state)))
(seq [coord :keys neighbor-set
:let [ncount (get neighbor-set coord)]
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
:let [count (get neighbor-set coord)]
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
coord))
(defn draw

View File

@@ -72,9 +72,6 @@ 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'))

View File

@@ -2,7 +2,6 @@ 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)

View File

@@ -46,6 +46,7 @@
(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
@@ -218,9 +219,9 @@
(defmacro default
``Define a default value for an optional argument.
Expands to `(def sym :shadow (if (= nil sym) val sym))`.``
Expands to `(def sym (if (= nil sym) val sym))`.``
[sym val]
~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
(defmacro comment
"Ignores the body of the comment."
@@ -2674,17 +2675,17 @@
(var resumeval nil)
(def f
(fiber/new
(fn :compile-and-lint []
(fn []
(array/clear lints)
(def res (compile source env where lints))
(when (next lints)
(unless (empty? 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] (distinct lints) # some macros might cause code to be duplicated. Avoid repeated messages.
(each [level line col msg] lints
(def lvl (get lint-levels level 0))
(cond
(<= lvl lint-error) (do

View File

@@ -16,7 +16,6 @@
/* #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

View File

@@ -29,7 +29,7 @@
#endif
/* Look up table for instructions */
const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_0, /* JOP_NOOP, */
JINT_S, /* JOP_ERROR, */
JINT_ST, /* JOP_TYPECHECK, */

View File

@@ -91,38 +91,29 @@ 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, 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;
}
}
}
void janetc_nameslot(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;
if (flags & JANET_DEFFLAG_NO_UNUSED) {
sp.referenced = 1;
} else {
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
}
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;
sp.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX;
@@ -269,38 +260,6 @@ 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,
@@ -1144,7 +1103,6 @@ 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;

View File

@@ -36,15 +36,6 @@ 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
@@ -193,9 +184,6 @@ struct JanetCompiler {
/* Collect linting results */
JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
};
#define JANET_FOPTS_TAIL 0x10000
@@ -233,11 +221,9 @@ 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, uint32_t flags);
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */
@@ -281,12 +267,9 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */
JanetSlot janetc_cslot(Janet x);
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
/* Search for a symbol */
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);

View File

@@ -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) - native needs to be recompiled!",
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
host.major,
host.minor,
host.patch,

View File

@@ -333,7 +333,7 @@ static int compare_uint64_double(uint64_t x, double y) {
}
}
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
static 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_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv
return janet_wrap_nil();
}
static JANET_CFUNCTION_ALIGN Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
static 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_CFUNCTION_ALIGN 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *
} \
#define OPMETHODINVERT(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Jane
} \
#define UNARYMETHOD(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *
#define DIVZERO_mod return janet_wrap_abstract(box)
#define DIVMETHOD(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *
} \
#define DIVMETHODINVERT(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Jane
} \
#define DIVMETHOD_SIGNED(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *
} \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
static 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_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Jane
return janet_wrap_abstract(box); \
} \
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
static 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_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
static 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_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv)
return janet_wrap_abstract(box);
}
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
static 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_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box);
}
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
static 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]);

View File

@@ -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, uint32_t def_flags) {
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 &&
ret.envindex >= 0;
@@ -425,10 +425,11 @@ 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) {
def_flags |= JANET_DEFFLAG_NO_UNUSED;
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
janetc_nameslot_no_unused(c, head, ret);
} else {
janetc_nameslot(c, head, ret);
}
janetc_nameslot(c, head, ret, def_flags);
return !isUnnamedRegister;
}
@@ -442,7 +443,7 @@ static int varleaf(
JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab);
int is_redef = c->is_redef;
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
JanetArray *ref;
JanetBinding old_binding;
@@ -463,11 +464,7 @@ static int varleaf(
return 1;
} else {
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "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);
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
}
}
@@ -508,14 +505,12 @@ 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) {
entry = janet_table_clone(tab);
JanetTable *entry = janet_table_clone(tab);
janet_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c)));
is_redef = c->is_redef;
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
if (is_redef) {
@@ -535,18 +530,12 @@ static int defleaf(
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
}
}
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "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 */
/* Add env entry to env */
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
}
return result;
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
return namelocal(c, sym, 0, s, no_unused);
}
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
@@ -1077,10 +1066,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), 0);
janetc_nameslot(c, sym, janetc_farslot(c));
}
} else {
janetc_nameslot(c, sym, janetc_farslot(c), 0);
janetc_nameslot(c, sym, janetc_farslot(c));
}
} else {
janet_v_push(destructed_params, janetc_farslot(c));
@@ -1129,9 +1118,7 @@ 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);
/* 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);
janetc_nameslot_no_unused(c, sym, slot);
}
}

View File

@@ -49,8 +49,6 @@
#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] = {
@@ -268,7 +266,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 > JANET_NUMBER_LENGTH_RIDICULOUS) goto error;
if (len > INT32_MAX / 40) goto error;
/* Get sign */
if (str >= end) goto error;
@@ -412,7 +410,10 @@ static int scan_uint64(
*neg = 0;
*out = 0;
uint64_t accum = 0;
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) return 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;
/* Get sign */
if (str >= end) return 0;
if (*str == '-') {

View File

@@ -573,24 +573,8 @@ 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);
@@ -600,7 +584,6 @@ 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);
@@ -612,7 +595,6 @@ 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);
@@ -625,7 +607,6 @@ 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);
@@ -642,7 +623,6 @@ 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)) {
@@ -675,7 +655,6 @@ 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);

View File

@@ -194,18 +194,12 @@ 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;
}
@@ -213,11 +207,6 @@ 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;
}

View File

@@ -307,38 +307,25 @@ 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) || defined(__aarch64__) || defined(_M_ARM64)
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
/* We will only enable nanboxing by default on 64 bit systems
* for x64, risc-v, and arm64. This is mainly because the approach is tied to the
* for x64 and risc-v. 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 by taking advantage
* of pointer alignment to allow for 48 or 49 bits of address space. */
* and it requires cooperation from the OS. ARM should also work in many configurations. */
#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 0 /* TODO - set me back to 2! (trying to trigger crash) */
#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 0x0
#define JANET_NANBOX_BIT 0
#else
#define JANET_NANBOX_BIT 0x1
#endif
@@ -349,16 +336,9 @@ 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_POINTER_SHIFT_BITS)
JANET_NANBOX_BIT)
/* Represents the settings used to compile Janet, as well as the version */
typedef struct {
@@ -1435,7 +1415,7 @@ enum JanetOpCode {
};
/* Info about all instructions */
extern const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** END SECTION OPCODES *****/
@@ -2083,14 +2063,8 @@ 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_CFUNCTION_ALIGN Janet name (int32_t argc, Janet *argv)
#define JANET_CFUN(name) 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}
@@ -2106,7 +2080,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 JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
@@ -2114,7 +2088,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 JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
janet_def(ENV, JNAME, VAL, DOC)
@@ -2123,7 +2097,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 JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
Janet CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)

View File

@@ -27,11 +27,9 @@
(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)
(eflush) (flush))
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
(do
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
x)
(defn skip-asserts
@@ -40,7 +38,7 @@
(+= skip-n n)
nil)
(defmacro assert :shadow
(defmacro assert
[x &opt e]
(def xx (gensym))
(default e (string/format "%j" x))
@@ -52,12 +50,12 @@
(defmacro assert-error
[msg & forms]
(def errsym (keyword (gensym)))
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value
[msg errval & forms]
(def e (gensym))
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
(defn check-compile-error
[form]

View File

@@ -70,9 +70,9 @@
(assert (= (array/pop @[]) nil) "array/pop empty")
# Code coverage
(def a1 @[1])
(array/pop a1)
(array/trim a1)
(def a @[1])
(array/pop a)
(array/trim a)
(array/ensure @[1 1] 6 2)
# array/join

View File

@@ -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 b1 @"AA")
(assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
(def b @"AA")
(assert (deep= (buffer/push b b) @"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 b8 (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")

View File

@@ -84,23 +84,23 @@
(assert (get result :error) "bad sum3 fuzz issue valgrind")
# Issue #1700
(def result1
(def result
(compile
'(defn fuzz-case-1
[start end &]
(if end
(if e start (lazy-range (+ 1 start) end)))
1)))
(assert (get result1 :error) "fuzz case issue #1700")
(assert (get result :error) "fuzz case issue #1700")
# Issue #1702 - fuzz case with upvalues
(def result2
(def result
(compile
'(each item [1 2 3]
# Generate a lot of upvalues (more than 224)
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
(with-dyns [:out out-buf] 1))))
(assert result2 "bad upvalues fuzz case")
(assert result "bad upvalues fuzz case")
# Named argument linting
# Enhancement for #1654
@@ -117,14 +117,14 @@
(defn check-good-compile
[code msg]
(def lints @[])
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (empty? lints)) msg))
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (empty? lints)) msg))
(defn check-lint-compile
[code msg]
(def lints @[])
(def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result4) (next lints)) msg))
(def result (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (next lints)) msg))
(check-good-compile '(fnamed) "named no args")
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
@@ -150,10 +150,5 @@
(check-lint-compile '(g 1 2 :z) "g lint 1")
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
# 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)

View File

@@ -43,9 +43,9 @@
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant
(def thread-channel :shadow (ev/thread-chan 100))
(def super :shadow (ev/thread-chan 10))
(defn worker :shadow []
(def thread-channel (ev/thread-chan 100))
(def super (ev/thread-chan 10))
(defn worker []
(while true
(def item (ev/take thread-channel))
(when (= item :deadline)

View File

@@ -37,7 +37,7 @@
# Printing to functions
# 4e263b8c3
(def out-buf :shadow @"")
(def out-buf @"")
(defn prepend [x]
(with-dyns [:out out-buf]
(prin "> " x)))
@@ -59,8 +59,8 @@
# issue #1055 - 2c927ea76
(let [b @""]
(defn dummy [a bb c]
(+ a bb c))
(defn dummy [a b c]
(+ a b c))
(trace dummy)
(defn errout [arg]
(buffer/push b arg))

View File

@@ -95,11 +95,11 @@
(do
(defn f1
[a]
(defn f1 :shadow [] (++ (a 0)))
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(error [f1 f2]))
(def [_ tup] (protect (f1 @[0])))
(def [f1 f2] :shadow (unmarshal (marshal tup make-image-dict) load-image-dict))
(def [f1 f2] (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 :shadow [] (++ (a 0)))
(defn f2 :shadow [] (++ (a 0)))
(defn f1 [] (++ (a 0)))
(defn f2 [] (++ (a 0)))
(marshal [f1 f2] make-image-dict))
(def [f1 f2] :shadow (unmarshal (f1 @[0]) load-image-dict))
(def [f1 f2] (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 :shadow (table/weak-keys 1))
(def t (table/weak-keys 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1")
(def tclone :shadow (-> t marshal unmarshal))
(def tclone (-> 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 :shadow (table/weak-values 1))
(def t (table/weak-values 1))
(put t @"" keep-value)
(put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1")
(def tclone :shadow (-> t marshal unmarshal))
(def tclone (-> 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 :shadow (table/weak-values 1))
(def t (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 :shadow (-> t marshal unmarshal))
(def tclone (-> t marshal unmarshal))
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")

View File

@@ -138,13 +138,13 @@
# Parser clone
# 43520ac67
(def p0 (parser/new))
(assert (= 7 (parser/consume p0 "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p0))
(def p (parser/new))
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
(def p2 (parser/clone p))
(parser/consume p2 ") 1 ")
(parser/consume p0 ") 1 ")
(assert (deep= (parser/status p0) (parser/status p2)) "parser 2")
(assert (deep= (parser/state p0) (parser/state p2)) "parser 3")
(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 errors
# 976dfc719
@@ -179,11 +179,11 @@
(parser/consume p1 step1)
(loop [_ :iterate (parser/produce p1)])
(parser/state p1)
(def p3 (parser/clone p1))
(parser/state p3)
(parser/consume p3 step2)
(loop [_ :iterate (parser/produce p3)])
(parser/state p3)
(def p2 (parser/clone p1))
(parser/state p2)
(parser/consume p2 step2)
(loop [_ :iterate (parser/produce p2)])
(parser/state p2)
# parser delimiter errors
(defn test-error [delim fmt]
@@ -202,11 +202,11 @@
(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"]))
(def p (parser/new))
(parser/consume p `("hel`)
(parser/insert p `lo`)
(parser/consume p `")`)
(assert (= (parser/produce p) ["hello"]))
# Hex floats
(assert (= math/pi +0x1.921fb54442d18p+0001))

View File

@@ -84,10 +84,10 @@
# Substitution test with peg
# d7626f8c5
(def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(defn try-grammar [text]
(assert (= (string/replace-all "dog" "purple panda" text)
(0 (peg/match grammar1 text))) text))
(0 (peg/match grammar 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 grammar2
(def grammar
(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 grammar2 "<p><em>foobar</em></p>"
(check-deep grammar "<p><em>foobar</em></p>"
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
(check-deep grammar2 "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
(check-deep grammar "<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 grammar3
(def grammar
~{: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 porig (peg/compile grammar3))
(def p (peg/compile grammar))
# Just make sure is valgrind clean.
(def pprime (-> porig make-image load-image))
(def p (-> p make-image load-image))
(assert (peg/match pprime "abc") "complex peg grammar 1")
(assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
(assert (peg/match p "abc") "complex peg grammar 1")
(assert (peg/match p "[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 pegg subst text expected]
(assert (= (string (f pegg subst text)) expected) name))
(defn peg-test [name f peg subst text expected]
(assert (= (string (f peg subst text)) expected) name))
(peg-test "peg/replace has access to captures"
peg/replace
@@ -602,10 +602,10 @@
# Marshal and unmarshal pegs
# 446ab037b
(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")
(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")
# 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 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))
(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))
(test "sub: matches the same input twice"
~(sub "abcd" "abc")
@@ -852,20 +852,20 @@
@[["b" "b" "b"]])
# Debug and ?? tests.
(defn test-stderr [name pegg input expected-matches expected-stderr]
(defn test-stderr [name peg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name pegg input expected-matches))
(test name peg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* true]
(peg/match pegg input))
(peg/match peg input))
(assert (deep= (string actual) expected-stderr)))
(defn test-stderr-no-color [name pegg input expected-matches expected-stderr]
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
(with-dyns [:err @""]
(test name pegg input expected-matches))
(test name peg input expected-matches))
(def actual @"")
(with-dyns [:err actual *err-color* false]
(peg/match pegg input))
(peg/match peg input))
(assert (deep= (string actual) expected-stderr)))
(test-stderr

View File

@@ -44,8 +44,8 @@
(def buftemp @"abcd")
(assert (= (string (buffer/format buftemp "---%p---" buftemp))
`abcd---@"abcd"---`) "buffer/format on self 1")
(def buftemp2 @"abcd")
(assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
(def buftemp @"abcd")
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
# 5c364e0

View File

@@ -132,11 +132,11 @@
# Cancel test
# 28439d822
(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")
(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")
(end-suite)