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

Compare commits

..

16 Commits

Author SHA1 Message Date
Calvin Rose
df32109eea Small typo fixes in comments. 2026-03-15 20:22:20 -05:00
Calvin Rose
8b89901298 Deduplicate lints.
Why see the same message twice?
2026-03-15 18:27:13 -05:00
Calvin Rose
079776d39e Elaborate comment. 2026-03-15 15:34:52 -05:00
Calvin Rose
6c2f08ef49 Add unit tests for variable shadowing. 2026-03-15 13:34:12 -05:00
Calvin Rose
980999c97b Make test suite not shadow any variables. 2026-03-15 13:14:10 -05:00
Calvin Rose
1197cfe433 Check redef only once per compile call. 2026-03-15 12:56:10 -05:00
Calvin Rose
c63c6740d9 First pass at linting binding shadowing.
Prevent redefining bindings by accident. There are
a few cases where we want to allow this, such as the `default` macro, so
we allow a keyword :shadow to be included in the `def` expression to
turn off this lint.

TODO:
* Clean up test suite to remove binding shadowing
* Make sure that we don't get lints with *redef* turned on
* Add positive and negative tests for lint messages.
* Add location of shadowed binding in message
2026-03-15 11:24:07 -05:00
Calvin Rose
612971503d Add LLM, AI and tool usage section to contribution guide. (#1730)
* Add LLM, AI and tool usage section to contribution guide.

* Word order and punctuation.

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

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

* Remove word.
2026-03-14 23:13:29 -05:00
PinieP
df56efbae0 Fix: add missing :symbolmap keyword to disasm function (#1729) 2026-03-12 19:25:51 -05:00
sogaiu
b160f4f5c0 Macro hygiene tweaks (#1727)
* Tweak hygiene for when-with, if-with, when-let

* Tweak hygiene for loop1 helper

* Tweak hygiene for repeat

* Tweak hygiene for seq and catseq

* Tweak hygiene for -?> and -?>>

* Tweak hygiene for varfn

* Tweak hygiene for ev/with-deadline

* Tweak hygiene for ffi/defbind-alias + ffi/defbind

---------

Co-authored-by: sogaiu <983021772@users.noreply.github.com>
2026-03-11 19:06:43 -05:00
Calvin Rose
a0cc867f14 Improve macro hygiene in boot.janet. 2026-03-09 19:46:55 -05:00
Calvin Rose
8f446736ed Fix #1723 - handle prompt longer than terminal is wide.
When this happened, we tried to print a buffer with a negative length
that resulted in invalid memmove call. This fix both checks that we
don't tried to append a negative buffer, and truncates a prompt that is
too long for the termimal so that one can still enter text with at least
16 visible characters for data entry.
2026-03-07 15:28:59 -06:00
PinieP
decd7078af fix janet_make_threaded to return threaded channel (#1724)
janet_make_threaded previously created a channel with threaded set to 0
2026-03-07 15:01:03 -06:00
McSinyx
b96350f132 Align items in multiline pretty format (%m and %p) (#1721)
Indentation levels are not sufficiently clear for deeply nested
data structures.  Instead, align items in a collection
with its opening bracket, also known as hanging indentation.

To avoid guessing the length of a "short" collection to print it
on one line, items are now always printed on separate lines.
2026-03-05 19:34:05 -06:00
Calvin Rose
aa63adccb4 Update CHANGELOG.md 2026-03-02 19:39:21 -06:00
Calvin Rose
7fc12ff167 Use ConnectEx for non-blocking connect on windows when available.
Still fallback to blocking connect with WSAConnect when ConnectEx is not
available or applicable, but ConnectEx is preferred and recommended by
Microsoft.

Also make some changes to our use of OVERLAPPED in various places in the
ev code, replacing all uses with JanetOverlapped. This also let's us
avoid reusing internal fields for OVERLAPPED which may or may not be
used in various places.
2026-03-02 19:39:21 -06:00
25 changed files with 421 additions and 248 deletions

View File

@@ -3,6 +3,8 @@ All notable changes to this project will be documented in this file.
## Unreleased - ???
- Documentation fixes
- ev/thread-chan deadlock bug fixed
- Re-add removed support for non-blocking net/connect on windows.
## 1.41.2 - 2026-02-18
- Fix regressions in `put` for arrays and buffers.

View File

@@ -37,6 +37,12 @@ may require changes before being merged.
do this indentation, or approximate as close as possible. There is a janet formatter
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
Bot pull requests will not be accepted, and anonymous submissions, including
new accounts, unknown emails, and first time contributors will be subjected
to greater scrutiny and code reivew. Automatically generated and filed bug
reports MAY be ok, if they are of consistent and good quality, such as
OSSFuzz or well constructed CI pipelines.
## C style
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
@@ -90,3 +96,18 @@ timely manner. In short, if you want extra functionality now, then build it.
* Include a good description of the problem that is being solved
* Include descriptions of potential solutions if you have some in mind.
## LLMs, Tool Usage, and Transparency
All usage of Large Language Models (LLMs), Neural Networks, "AI" tools, and
other tools such as software fuzzers or static analyzers must be disclosed.
This applies to pull requests, email patches, bug reports, and any other
meaningful contribution to Janet's source code. Please also refrain from using
generative AI for code that will be embedded in the Janet runtime, which include
all C source files as well as boot.janet. All code should be well
and completely understood by the human author, including test cases. Large and
obviously AI-driven changes will be rejected. Be mindful and transparent on the
copyright implications of any submitted code. We will use discretion when
accepting generated test cases for bug reproductions, one-line bug
fixes, or typo fixes. Often, these can be trivially rewritten by a human to
avoid the problem.

View File

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

View File

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

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

View File

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

View File

@@ -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."
@@ -443,11 +442,36 @@
(def ,binding ,ctor)
,(defer-impl :with [(or dtor :close) binding] body)))
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
the `fal` form. Bindings have the same syntax as the `let` macro.``
[bindings tru &opt fal]
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-with
``Similar to with, but if binding is false or nil, returns
nil without evaluating the body. Otherwise, the same as `with`.``
[[binding ctor dtor] & body]
~(if-let [,binding ,ctor]
~(as-macro ,if-let [,binding ,ctor]
,(defer-impl :when-with [(or dtor :close) binding] body)))
(defmacro if-with
@@ -455,7 +479,7 @@
the falsey path. Otherwise, evaluates the truthy path. In both cases,
`ctor` is bound to binding.``
[[binding ctor dtor] truthy &opt falsey]
~(if-let [,binding ,ctor]
~(as-macro ,if-let [,binding ,ctor]
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
,falsey))
@@ -539,13 +563,13 @@
(case binding
:until ~(do (if ,verb (break) nil) ,rest)
:while ~(do (if ,verb nil (break)) ,rest)
:let ~(let ,verb (do ,rest))
:let ~(as-macro ,let ,verb (do ,rest))
:after ~(do ,rest ,verb nil)
:before ~(do ,verb ,rest nil)
:repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
:when ~(when ,verb ,rest)
:unless ~(unless ,verb ,rest)
~(do (var ,iter ,verb) (while (,> ,iter 0) ,rest (as-macro ,-- ,iter))))
:when ~(as-macro ,when ,verb ,rest)
:unless ~(as-macro ,unless ,verb ,rest)
(error (string "unexpected loop modifier " binding))))))
# 3 term expression
@@ -587,7 +611,7 @@
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
~(do (var ,iter ,n) (while (,> ,iter 0) ,;body (as-macro ,-- ,iter)))))
(defmacro forever
"Evaluate body forever in a loop, or until a break statement."
@@ -683,7 +707,7 @@
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
~(do (def ,$accum @[]) (as-macro ,loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
(defmacro catseq
``Similar to `loop`, but concatenates each element from the loop body into an array and returns that.
@@ -691,21 +715,21 @@
[head & body]
(def $accum (gensym))
(check-empty-body body)
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
~(do (def ,$accum @[]) (as-macro ,loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
(defmacro tabseq
``Similar to `loop`, but accumulates key value pairs into a table.
See `loop` for details.``
[head key-body & value-body]
(def $accum (gensym))
~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
~(do (def ,$accum @{}) (as-macro ,loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
(defmacro generate
``Create a generator expression using the `loop` syntax. Returns a fiber
that yields all values inside the loop in order. See `loop` for details.``
[head & body]
(check-empty-body body)
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
~(,fiber/new (fn :generate [] (as-macro ,loop ,head (,yield (do ,;body)))) :yi))
(defmacro coro
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
@@ -754,35 +778,10 @@
(each x xs (*= accum x))
accum)
# declare ahead of time
(var- macexvar nil)
(defmacro if-let
``Make multiple bindings, and if all are truthy,
evaluate the `tru` form. If any are false or nil, evaluate
the `fal` form. Bindings have the same syntax as the `let` macro.``
[bindings tru &opt fal]
(def len (length bindings))
(if (= 0 len) (error "expected at least 1 binding"))
(if (odd? len) (error "expected an even number of bindings"))
(def fal2 (if macexvar (macexvar fal) fal))
(defn aux [i]
(if (>= i len)
tru
(do
(def bl (in bindings i))
(def br (in bindings (+ 1 i)))
(if (symbol? bl)
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
~(if (def ,(def sym (gensym)) ,br)
(do (def ,bl ,sym) ,(aux (+ 2 i)))
,fal2)))))
(aux 0))
(defmacro when-let
"Same as `(if-let bindings (do ;body))`."
[bindings & body]
~(if-let ,bindings (do ,;body)))
~(as-macro ,if-let ,bindings (do ,;body)))
(defn comp
`Takes multiple functions and returns a function that is the composition
@@ -1432,7 +1431,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h sym] t))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defmacro -?>>
@@ -1448,7 +1447,7 @@
(tuple n @[])))
(def sym (gensym))
(def parts (array/concat @[h] t @[sym]))
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
(reduce fop x forms))
(defn- walk-ind [f form]
@@ -2411,8 +2410,8 @@
(dictionary? m) (merge-into metadata m)
(error (string "invalid metadata " m))))
(with-syms [entry old-entry f]
~(let [,old-entry (,dyn ',name)]
(def ,entry (or ,old-entry @{:ref @[nil]}))
~(as-macro ,let [,old-entry (,dyn ',name)]
(def ,entry (as-macro ,or ,old-entry @{:ref @[nil]}))
(,setdyn ',name ,entry)
(def ,f ,fbody)
(,put-in ,entry [:ref 0] ,f)
@@ -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
@@ -3953,7 +3952,7 @@
``
[sec & body]
(with-syms [f]
~(let [,f (coro ,;body)]
~(as-macro ,let [,f (as-macro ,coro ,;body)]
(,ev/deadline ,sec nil ,f)
(,resume ,f))))
@@ -4085,15 +4084,15 @@
(defn make-ptr []
(assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
(if lazy
~(defn ,alias ,;meta [,;formal-args]
~(as-macro ,defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
~(defn ,alias ,;meta [,;formal-args]
~(as-macro ,defn ,alias ,;meta [,;formal-args]
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind :flycheck
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
~(as-macro ,ffi/defbind-alias ,name ,name ,ret-type ,;body)))
###
###

View File

@@ -1110,6 +1110,7 @@ JANET_CORE_FN(cfun_disasm,
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
if (!janet_cstrcmp(kw, "symbolmap")) return janet_disasm_symbolslots(f->def);
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);

View File

@@ -91,29 +91,28 @@ 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] != '_') {
int check = janetc_shadowcheck(c, sym);
if (check == 2) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a local binding", janet_wrap_symbol(sym));
} else if (check) {
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a global binding", janet_wrap_symbol(sym));
}
}
}
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 +259,24 @@ static int lookup_missing(
return 1;
}
/* Check if a binding is defined in an upper scope. This lets us check for
* variable shadowing. */
int janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
/* Check locals */
JanetScope *scope = c->scope;
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) return 2;
}
scope = scope->parent;
}
/* Check globals */
JanetBinding binding = janet_resolve_ext(c->env, sym);
return binding.type != JANET_BINDING_NONE;
}
/* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve(
JanetCompiler *c,
@@ -1103,6 +1120,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;

View File

@@ -184,6 +184,9 @@ struct JanetCompiler {
/* Collect linting results */
JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
};
#define JANET_FOPTS_TAIL 0x10000
@@ -221,9 +224,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 +272,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 */
int 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

@@ -1172,7 +1172,7 @@ JanetChannel *janet_channel_make(uint32_t limit) {
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
janet_chan_init(channel, (int32_t) limit, 0);
janet_chan_init(channel, (int32_t) limit, 1);
return channel;
}

View File

@@ -72,7 +72,7 @@ static int count_dig10(int32_t x) {
}
}
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
static int32_t integer_to_string_b(JanetBuffer *buffer, int32_t x) {
janet_buffer_extra(buffer, BUFSIZE);
uint8_t *buf = buffer->data + buffer->count;
int32_t neg = 0;
@@ -80,7 +80,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
if (x == 0) {
buf[0] = '0';
buffer->count++;
return;
return 1;
}
if (x > 0) {
x = -x;
@@ -96,6 +96,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
x /= 10;
}
buffer->count += len + neg;
return len + neg;
}
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
@@ -134,43 +135,55 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
static int janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
int align = 1;
for (int32_t i = 0; i < len; ++i) {
uint8_t c = str[i];
switch (c) {
case '"':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
align += 2;
break;
case '\n':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
align += 2;
break;
case '\r':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
align += 2;
break;
case '\0':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
align += 2;
break;
case '\f':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
align += 2;
break;
case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
align += 2;
break;
case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
align += 2;
break;
case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
align += 2;
break;
case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
align += 2;
break;
case '\\':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
align += 2;
break;
case '\t':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
align += 2;
break;
default:
if (c < 32 || c > 126) {
@@ -180,13 +193,16 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
buf[2] = janet_base64[(c >> 4) & 0xF];
buf[3] = janet_base64[c & 0xF];
janet_buffer_push_bytes(buffer, buf, 4);
align += 4;
} else {
janet_buffer_push_u8(buffer, c);
align++;
}
break;
}
}
janet_buffer_push_u8(buffer, '"');
return align + 1;
}
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
@@ -358,7 +374,7 @@ const uint8_t *janet_to_string(Janet x) {
struct pretty {
JanetBuffer *buffer;
int depth;
int indent;
int align;
int flags;
int32_t bufstartlen;
int32_t *keysort_buffer;
@@ -450,14 +466,15 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
return 0;
}
static void print_newline(struct pretty *S, int just_a_space) {
static void print_newline(struct pretty *S, int align) {
int i;
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
S->align = align;
if (S->flags & JANET_PRETTY_ONELINE) {
janet_buffer_push_u8(S->buffer, ' ');
return;
}
janet_buffer_push_u8(S->buffer, '\n');
for (i = 0; i < S->indent; i++) {
for (i = 0; i < S->align; i++) {
janet_buffer_push_u8(S->buffer, ' ');
}
}
@@ -484,14 +501,12 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m"
};
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
#define JANET_PRETTY_ARRAY_LIMIT 160
/* Helper for pretty printing */
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
static void janet_pretty_one(struct pretty *S, Janet x) {
/* Add to seen */
switch (janet_type(x)) {
case JANET_NIL:
@@ -506,7 +521,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
}
janet_buffer_push_cstring(S->buffer, "<cycle ");
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
S->align += 8 + integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
janet_buffer_push_u8(S->buffer, '>');
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -528,9 +543,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
janet_buffer_push_u8(S->buffer, '@');
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
S->align += 1 + janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
} else {
S->align -= S->buffer->count;
janet_description_b(S->buffer, x);
S->align += S->buffer->count;
}
if (color && (S->flags & JANET_PRETTY_COLOR)) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -547,35 +564,34 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
janet_buffer_push_cstring(S->buffer, startstr);
const int align = S->align += strlen(startstr);
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
for (i = 0; i < 3; i++) {
if (i) print_newline(S, 0);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
print_newline(S, 0);
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
for (i = 0; i < 3; i++) {
print_newline(S, 0);
janet_pretty_one(S, arr[len - 3 + i], 0);
S->align += 3;
for (i = len - 3; i < len; i++) {
print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
} else {
for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
janet_pretty_one(S, arr[i], 0);
if (i) print_newline(S, align);
janet_pretty_one(S, arr[i]);
}
}
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, endchar);
S->align++;
break;
}
case JANET_STRUCT:
@@ -586,6 +602,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (istable) {
JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto;
S->align++;
janet_buffer_push_cstring(S->buffer, "@");
if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
@@ -596,6 +613,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
@@ -613,25 +631,24 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
janet_buffer_push_cstring(S->buffer, janet_class_color);
}
janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
}
}
}
}
janet_buffer_push_cstring(S->buffer, "{");
janet_buffer_push_u8(S->buffer, '{');
const int align = ++S->align;
S->depth--;
S->indent += 2;
if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else {
int32_t len = 0, cap = 0;
const JanetKV *kvs = NULL;
janet_dictionary_view(x, &kvs, &len, &cap);
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
janet_buffer_push_u8(S->buffer, ' ');
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
int32_t ks_start = S->keysort_start;
int truncated = 0;
@@ -644,15 +661,17 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
int32_t j = 0;
for (int32_t i = 0; i < len; i++) {
while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
janet_pretty_one(S, kvs[j].key, 0);
if (i) print_newline(S, align);
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
S->align++;
janet_pretty_one(S, kvs[j].value);
j++;
}
if (truncated) {
print_newline(S, 0);
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
} else {
/* Sorted keys dictionaries */
@@ -685,24 +704,26 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
}
for (int32_t i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
if (i) print_newline(S, align);
int32_t j = S->keysort_buffer[i + ks_start];
janet_pretty_one(S, kvs[j].key, 0);
janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1);
S->align++;
janet_pretty_one(S, kvs[j].value);
}
if (truncated) {
print_newline(S, 0);
print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
}
}
S->keysort_start = ks_start;
}
S->indent -= 2;
S->depth++;
janet_buffer_push_u8(S->buffer, '}');
S->align++;
break;
}
}
@@ -718,14 +739,14 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.align = 0;
S.flags = flags;
S.bufstartlen = startlen;
S.keysort_capacity = 0;
S.keysort_buffer = NULL;
S.keysort_start = 0;
janet_table_init(&S.seen, 10);
janet_pretty_one(&S, x, 0);
janet_pretty_one(&S, x);
janet_table_deinit(&S.seen);
return S.buffer;
}
@@ -743,7 +764,7 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
}
S.buffer = buffer;
S.depth = depth;
S.indent = 0;
S.align = 0;
S.flags = 0;
S.bufstartlen = startlen;
S.keysort_capacity = 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, 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);
}
}

View File

@@ -26,6 +26,7 @@
#include <janet.h>
#include <errno.h>
#include <assert.h>
#ifdef _WIN32
#include <windows.h>
@@ -362,33 +363,50 @@ static void clear(void) {
}
}
static int getplen(void) {
int _plen = gbl_plen;
/* Ensure at least 16 characters of data entry; */
while (_plen && (_plen + 16 > gbl_cols)) {
_plen--;
}
return _plen;
}
static void refresh(void) {
char seq[64];
JanetBuffer b;
/* If prompt is too long, truncate */
int _plen = getplen();
/* Keep cursor position on screen */
char *_buf = gbl_buf;
int _len = gbl_len;
int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
while ((_plen + _pos) >= gbl_cols) {
_buf++;
_len--;
_pos--;
}
while ((gbl_plen + _len) > gbl_cols) {
while ((_plen + _len) > gbl_cols) {
_len--;
}
janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
janet_buffer_push_bytes(&b, (const uint8_t *) gbl_prompt, _plen);
if (_len > 0) {
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
}
/* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K\r");
/* Move cursor to original position. */
if (_pos + gbl_plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + gbl_plen));
if (_pos + _plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + _plen));
janet_buffer_push_cstring(&b, seq);
}
if (write_console((char *) b.data, b.count) == -1) {
@@ -414,7 +432,8 @@ static int insert(char c, int draw) {
gbl_buf[gbl_pos++] = c;
gbl_buf[++gbl_len] = '\0';
if (draw) {
if (gbl_plen + gbl_len < gbl_cols) {
int _plen = getplen();
if (_plen + gbl_len < gbl_cols) {
/* Avoid a full update of the line in the
* trivial case. */
if (write_console(&c, 1) == -1) return -1;
@@ -925,11 +944,12 @@ static int line() {
gbl_len = 0;
gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++;
int _plen = getplen();
gbl_buf[0] = '\0';
addhistory();
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
if (write_console((char *) gbl_prompt, _plen) == -1) return -1;
for (;;) {
char c;
char seq[5];

View File

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

View File

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

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

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

View File

@@ -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
@@ -61,5 +61,68 @@
(check-jdn "a string")
(check-jdn @"a buffer")
# Test multiline pretty specifiers
(let [tup [:keyword "string" @"buffer"]
tab @{true (table/setproto @{:bar tup
:baz 42}
@{:_name "Foo"})}]
(set (tab tup) tab)
(assert (= (string/format "%m" {tup @[tup tab]
'symbol tup})
`
{symbol (:keyword
"string"
@"buffer")
(:keyword
"string"
@"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})
`
{{0 -42
1 -41
2 -40
3 -39
4 -38
5 -37
6 -36
7 -35
8 -34
9 -33
10 -32
11 -31
12 -30
13 -29
14 -28
15 -27
16 -26
17 -25
18 -24
19 -23
20 -22
21 -21
22 -20
23 -19
24 -18
25 -17
26 -16
27 -15
28 -14
29 -13
...} @{true @Foo{:bar (:keyword
"string"
@"buffer")
:baz 42}
(:keyword
"string"
@"buffer") <cycle 1>}}`)))
(end-suite)

View File

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