1
0
mirror of https://github.com/janet-lang/janet synced 2026-04-04 14:01:28 +00:00

Compare commits

...

26 Commits

Author SHA1 Message Date
Calvin Rose
c6b802b082 Add #1737
Add some test cases and asserts for new pretty printing - we were not
properly handing the case when print formatter was not at the start of
the buffer.

A simple fix is to add a lookback_barrier, which is an index into the
buffer that backtracking print formatter can't go past. This ensures
that, whatever newlines are replace with spaces, we don't mess with any
explicit newlines that should be printed.

Also some tweaks to logic to try an make invariants more obvious and
simplify looping and indexing.
2026-04-03 08:38:12 -05:00
Calvin Rose
a261a8f6b4 Update CHANGELOG.md 2026-04-02 23:22:18 -05:00
Calvin Rose
2d1b54da37 Add more printing cases to pp_runner fuzz harness. 2026-04-01 19:02:51 -05:00
Calvin Rose
9a9cf981ed Add some afl stubs. 2026-04-01 18:58:14 -05:00
McSinyx
0c512ab128 Increase pretty printing line density (#1733)
* Increase pretty printing line density

* Allow specifying width for multiline pretty format
2026-04-01 18:55:22 -05:00
Calvin Rose
19e1dc494d Mitigation against mutated repl history. 2026-03-28 18:22:25 -05:00
Calvin Rose
c67dee7329 strncpy mitigations in mainclient.c 2026-03-28 09:47:46 -05:00
Calvin Rose
16f4f40d8e Update CHANGELOG 2026-03-27 11:34:50 -05:00
Calvin Rose
29474b915d Begin work on adding kqueue functionality to filewatch.
kqueue-based filewatch is more limited than inotify, but is still
useful in many cases. Notably absent is any ability to monitor
directories automatically without wasting a lot of file descriptors.
2026-03-25 22:16:30 -05:00
Calvin Rose
ec5a78d3dc Add pointer shift option for more nanboxing on arm64.
We now try to detect this and do it by default. This is important
as arm64 becomes more common and dominant.
2026-03-23 13:57:43 -05:00
Calvin Rose
e42b3c667f Reduce maximum size of parse number to something more manageable.
Parsing large number can have non-linear runtime behavior, and is
messing with our fuzzing.
2026-03-18 17:09:12 -05:00
Calvin Rose
93436bf973 Weaken variable shadowing to a "strict" lint.
Only get compiler lints/errors in strict mode. Also distinguish between
different kinds of shadowing for slightly different warnings and
lint-levels that better align with idiomatic code.
2026-03-17 20:28:16 -05:00
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
42 changed files with 1022 additions and 306 deletions

View File

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

View File

@@ -2,9 +2,13 @@
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## Unreleased - ??? ## Unreleased - ???
- Improve pretty printing layout for %M and %m modifiers to be more code-like.
- Add filewatch support to BSD and macos.
- Add linting support for shadowed bindings.
- Add nanboxing support for Linux on ARM64 and turn on nanboxing by default on macos on ARM64 (aarch64).
- Documentation fixes - Documentation fixes
- ev/thread-chan deadlock bug fixed - ev/thread-chan deadlock bug fixed
- Re-add removed support for non-blocking net/connect on windows. - Re-add removed support for non-blocking net/connect on windows with bug fixes.
## 1.41.2 - 2026-02-18 ## 1.41.2 - 2026-02-18
- Fix regressions in `put` for arrays and buffers. - 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 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. 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 ## C style
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with 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 a good description of the problem that is being solved
* Include descriptions of potential solutions if you have some in mind. * 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 bork [x]
(defn bark [x] (defn bark [y]
(print "Woof!") (print "Woof!")
(print x) (print y)
(error x) (error y)
(print "Woof!")) (print "Woof!"))
(bark (* 2 x)) (bark (* 2 x))

14
examples/filewatch.janet Normal file
View File

@@ -0,0 +1,14 @@
###
### example/filewatch.janet ...files
###
### Watch for all changes in a list of files and directories. Behavior
### depends on the filewatch module, and different operating systems will
### report different events.
(def chan (ev/chan 1000))
(def fw (filewatch/new chan))
(each arg (drop 1 (dyn *args* []))
(filewatch/add fw arg :all))
(filewatch/listen fw)
(forever (let [event (ev/take chan)] (pp event)))

View File

@@ -7,13 +7,13 @@
(print "simple yielding") (print "simple yielding")
(each item f (print "got: " item ", now " (fiber/status f))) (each item f (print "got: " item ", now " (fiber/status f)))
(def f (def f2
(coro (coro
(for i 0 10 (for i 0 10
(yield (string "yield " i)) (yield (string "yield " i))
(ev/sleep 0)))) (ev/sleep 0))))
(print "complex yielding") (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. # that must be called (realizing it), and the memoized.
# Use with (import "./path/to/this/file" :prefix "seq.") # Use with (import "./path/to/this/file" :prefix "seq.")
(defmacro delay (defmacro dolazy
"Lazily evaluate a series of expressions. Returns a function that "Lazily evaluate a series of expressions. Returns a function that
returns the result of the last expression. Will only evaluate the returns the result of the last expression. Will only evaluate the
body once, and then memoizes the result." body once, and then memoizes the result."
@@ -35,7 +35,7 @@
(def x (tuple h t)) (def x (tuple h t))
(fn [] x)) (fn [] x))
(defn empty? (defn lazy-empty?
"Check if a sequence is empty." "Check if a sequence is empty."
[s] [s]
(not (s))) (not (s)))
@@ -55,14 +55,14 @@
[start end &] [start end &]
(if end (if end
(if (< start end) (if (< start end)
(delay (tuple start (lazy-range (+ 1 start) end))) (dolazy (tuple start (lazy-range (+ 1 start) end)))
empty-seq) empty-seq)
(lazy-range 0 start))) (lazy-range 0 start)))
(defn lazy-map (defn lazy-map
"Return a sequence that is the result of applying f to each value in s." "Return a sequence that is the result of applying f to each value in s."
[f s] [f s]
(delay (dolazy
(def x (s)) (def x (s))
(if x (tuple (f (get x HEAD)) (map f (get x TAIL)))))) (if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
@@ -76,31 +76,31 @@
[f s] [f s]
(when (s) (f (head s)) (realize-map f (tail 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." "Ignores the first n values of the sequence and returns the rest."
[n s] [n s]
(delay (dolazy
(def x (s)) (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." "Returns at most the first n values of s."
[n s] [n s]
(delay (dolazy
(def x (s)) (def x (s))
(if (and x (pos? n)) (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 (defn randseq
"Return a sequence of random numbers." "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." "Returns a sequence of values until the predicate is false."
[pred s] [pred s]
(delay (dolazy
(def x (s)) (def x (s))
(when x (when x
(def thehead (get HEAD 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 cell-set (frequencies state))
(def neighbor-set (frequencies (mapcat neighbors state))) (def neighbor-set (frequencies (mapcat neighbors state)))
(seq [coord :keys neighbor-set (seq [coord :keys neighbor-set
:let [count (get neighbor-set coord)] :let [ncount (get neighbor-set coord)]
:when (or (= count 3) (and (get cell-set coord) (= count 2)))] :when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
coord)) coord))
(defn draw (defn draw

View File

@@ -72,6 +72,9 @@ conf.set_quoted('JANET_VERSION', meson.project_version())
# Use options # Use options
conf.set_quoted('JANET_BUILD', get_option('git_hash')) conf.set_quoted('JANET_BUILD', get_option('git_hash'))
conf.set('JANET_NO_NANBOX', not get_option('nanbox')) 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_SINGLE_THREADED', get_option('single_threaded'))
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules')) conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings')) conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))

View File

@@ -2,6 +2,7 @@ option('git_hash', type : 'string', value : 'meson')
option('single_threaded', type : 'boolean', value : false) option('single_threaded', type : 'boolean', value : false)
option('nanbox', type : 'boolean', value : true) 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('dynamic_modules', type : 'boolean', value : true)
option('docstrings', type : 'boolean', value : true) option('docstrings', type : 'boolean', value : true)
option('sourcemaps', type : 'boolean', value : true) option('sourcemaps', type : 'boolean', value : true)

View File

@@ -46,7 +46,6 @@
(defn defmacro :macro :flycheck (defn defmacro :macro :flycheck
"Define a macro." "Define a macro."
[name & more] [name & more]
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
(apply defn name :macro more)) (apply defn name :macro more))
(defmacro as-macro (defmacro as-macro
@@ -219,9 +218,9 @@
(defmacro default (defmacro default
``Define a default value for an optional argument. ``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] [sym val]
~(def ,sym (if (,= nil ,sym) ,val ,sym))) ~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
(defmacro comment (defmacro comment
"Ignores the body of the comment." "Ignores the body of the comment."
@@ -443,11 +442,36 @@
(def ,binding ,ctor) (def ,binding ,ctor)
,(defer-impl :with [(or dtor :close) binding] body))) ,(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 (defmacro when-with
``Similar to with, but if binding is false or nil, returns ``Similar to with, but if binding is false or nil, returns
nil without evaluating the body. Otherwise, the same as `with`.`` nil without evaluating the body. Otherwise, the same as `with`.``
[[binding ctor dtor] & body] [[binding ctor dtor] & body]
~(if-let [,binding ,ctor] ~(as-macro ,if-let [,binding ,ctor]
,(defer-impl :when-with [(or dtor :close) binding] body))) ,(defer-impl :when-with [(or dtor :close) binding] body)))
(defmacro if-with (defmacro if-with
@@ -455,7 +479,7 @@
the falsey path. Otherwise, evaluates the truthy path. In both cases, the falsey path. Otherwise, evaluates the truthy path. In both cases,
`ctor` is bound to binding.`` `ctor` is bound to binding.``
[[binding ctor dtor] truthy &opt falsey] [[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]) ,(defer-impl :if-with [(or dtor :close) binding] [truthy])
,falsey)) ,falsey))
@@ -539,13 +563,13 @@
(case binding (case binding
:until ~(do (if ,verb (break) nil) ,rest) :until ~(do (if ,verb (break) nil) ,rest)
:while ~(do (if ,verb nil (break)) ,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) :after ~(do ,rest ,verb nil)
:before ~(do ,verb ,rest nil) :before ~(do ,verb ,rest nil)
:repeat (with-syms [iter] :repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter)))) ~(do (var ,iter ,verb) (while (,> ,iter 0) ,rest (as-macro ,-- ,iter))))
:when ~(when ,verb ,rest) :when ~(as-macro ,when ,verb ,rest)
:unless ~(unless ,verb ,rest) :unless ~(as-macro ,unless ,verb ,rest)
(error (string "unexpected loop modifier " binding)))))) (error (string "unexpected loop modifier " binding))))))
# 3 term expression # 3 term expression
@@ -587,7 +611,7 @@
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil." "Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body] [n & body]
(with-syms [iter] (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 (defmacro forever
"Evaluate body forever in a loop, or until a break statement." "Evaluate body forever in a loop, or until a break statement."
@@ -683,7 +707,7 @@
[head & body] [head & body]
(def $accum (gensym)) (def $accum (gensym))
(check-empty-body body) (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 (defmacro catseq
``Similar to `loop`, but concatenates each element from the loop body into an array and returns that. ``Similar to `loop`, but concatenates each element from the loop body into an array and returns that.
@@ -691,21 +715,21 @@
[head & body] [head & body]
(def $accum (gensym)) (def $accum (gensym))
(check-empty-body body) (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 (defmacro tabseq
``Similar to `loop`, but accumulates key value pairs into a table. ``Similar to `loop`, but accumulates key value pairs into a table.
See `loop` for details.`` See `loop` for details.``
[head key-body & value-body] [head key-body & value-body]
(def $accum (gensym)) (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 (defmacro generate
``Create a generator expression using the `loop` syntax. Returns a fiber ``Create a generator expression using the `loop` syntax. Returns a fiber
that yields all values inside the loop in order. See `loop` for details.`` that yields all values inside the loop in order. See `loop` for details.``
[head & body] [head & body]
(check-empty-body 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 (defmacro coro
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`." "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)) (each x xs (*= accum x))
accum) 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 (defmacro when-let
"Same as `(if-let bindings (do ;body))`." "Same as `(if-let bindings (do ;body))`."
[bindings & body] [bindings & body]
~(if-let ,bindings (do ,;body))) ~(as-macro ,if-let ,bindings (do ,;body)))
(defn comp (defn comp
`Takes multiple functions and returns a function that is the composition `Takes multiple functions and returns a function that is the composition
@@ -1432,7 +1431,7 @@
(tuple n @[]))) (tuple n @[])))
(def sym (gensym)) (def sym (gensym))
(def parts (array/concat @[h sym] t)) (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)) (reduce fop x forms))
(defmacro -?>> (defmacro -?>>
@@ -1448,7 +1447,7 @@
(tuple n @[]))) (tuple n @[])))
(def sym (gensym)) (def sym (gensym))
(def parts (array/concat @[h] t @[sym])) (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)) (reduce fop x forms))
(defn- walk-ind [f form] (defn- walk-ind [f form]
@@ -2411,8 +2410,8 @@
(dictionary? m) (merge-into metadata m) (dictionary? m) (merge-into metadata m)
(error (string "invalid metadata " m)))) (error (string "invalid metadata " m))))
(with-syms [entry old-entry f] (with-syms [entry old-entry f]
~(let [,old-entry (,dyn ',name)] ~(as-macro ,let [,old-entry (,dyn ',name)]
(def ,entry (or ,old-entry @{:ref @[nil]})) (def ,entry (as-macro ,or ,old-entry @{:ref @[nil]}))
(,setdyn ',name ,entry) (,setdyn ',name ,entry)
(def ,f ,fbody) (def ,f ,fbody)
(,put-in ,entry [:ref 0] ,f) (,put-in ,entry [:ref 0] ,f)
@@ -2675,17 +2674,17 @@
(var resumeval nil) (var resumeval nil)
(def f (def f
(fiber/new (fiber/new
(fn [] (fn :compile-and-lint []
(array/clear lints) (array/clear lints)
(def res (compile source env where lints)) (def res (compile source env where lints))
(unless (empty? lints) (when (next lints)
# Convert lint levels to numbers. # Convert lint levels to numbers.
(def levels (get env *lint-levels* lint-levels)) (def levels (get env *lint-levels* lint-levels))
(def lint-error (get env *lint-error*)) (def lint-error (get env *lint-error*))
(def lint-warning (get env *lint-warn*)) (def lint-warning (get env *lint-warn*))
(def lint-error (or (get levels lint-error lint-error) 0)) (def lint-error (or (get levels lint-error lint-error) 0))
(def lint-warning (or (get levels lint-warning lint-warning) 2)) (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)) (def lvl (get lint-levels level 0))
(cond (cond
(<= lvl lint-error) (do (<= lvl lint-error) (do
@@ -3953,7 +3952,7 @@
`` ``
[sec & body] [sec & body]
(with-syms [f] (with-syms [f]
~(let [,f (coro ,;body)] ~(as-macro ,let [,f (as-macro ,coro ,;body)]
(,ev/deadline ,sec nil ,f) (,ev/deadline ,sec nil ,f)
(,resume ,f)))) (,resume ,f))))
@@ -4085,15 +4084,15 @@
(defn make-ptr [] (defn make-ptr []
(assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol)) (assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
(if lazy (if lazy
~(defn ,alias ,;meta [,;formal-args] ~(as-macro ,defn ,alias ,;meta [,;formal-args]
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;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)))) (,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
(defmacro ffi/defbind :flycheck (defmacro ffi/defbind :flycheck
"Generate bindings for native functions in a convenient manner." "Generate bindings for native functions in a convenient manner."
[name ret-type & body] [name ret-type & body]
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))) ~(as-macro ,ffi/defbind-alias ,name ,name ,ret-type ,;body)))
### ###
### ###

View File

@@ -16,6 +16,7 @@
/* #define JANET_THREAD_LOCAL _Thread_local */ /* #define JANET_THREAD_LOCAL _Thread_local */
/* #define JANET_NO_DYNAMIC_MODULES */ /* #define JANET_NO_DYNAMIC_MODULES */
/* #define JANET_NO_NANBOX */ /* #define JANET_NO_NANBOX */
/* #define JANET_NANBOX_64_POINTER_SHIFT 0 */
/* #define JANET_API __attribute__((visibility ("default"))) */ /* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is /* These settings should be specified before amalgamation is

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, "structarg")) return janet_disasm_structarg(f->def);
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(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, "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, "constants")) return janet_disasm_constants(f->def);
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def); if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def); if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);

View File

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

View File

@@ -91,29 +91,38 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
} }
/* Add a slot to a scope with a symbol associated with it (def or var). */ /* Add a slot to a scope with a symbol associated with it (def or var). */
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) { void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
if (sym[0] != '_') {
switch (janetc_shadowcheck(c, sym)) {
default:
break;
case JANETC_SHADOW_MACRO:
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a macro", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_LOCAL_HIDES_LOCAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a binding", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_LOCAL_HIDES_GLOBAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a top-level binding", janet_wrap_symbol(sym));
break;
case JANETC_SHADOW_GLOBAL_HIDES_GLOBAL:
janetc_lintf(c, JANET_C_LINT_STRICT, "top-level binding %q is shadowing another top-level binding", janet_wrap_symbol(sym));
break;
}
}
}
SymPair sp; SymPair sp;
int32_t cnt = janet_v_count(c->buffer); int32_t cnt = janet_v_count(c->buffer);
sp.sym = sym; sp.sym = sym;
sp.sym2 = sym; sp.sym2 = sym;
sp.slot = s; sp.slot = s;
sp.keep = 0; sp.keep = 0;
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */ if (flags & JANET_DEFFLAG_NO_UNUSED) {
sp.slot.flags |= JANET_SLOT_NAMED; sp.referenced = 1;
sp.birth_pc = cnt ? cnt - 1 : 0; } else {
sp.death_pc = UINT32_MAX; sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
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.slot.flags |= JANET_SLOT_NAMED;
sp.birth_pc = cnt ? cnt - 1 : 0; sp.birth_pc = cnt ? cnt - 1 : 0;
sp.death_pc = UINT32_MAX; sp.death_pc = UINT32_MAX;
@@ -260,6 +269,38 @@ static int lookup_missing(
return 1; 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 */ /* Allow searching for symbols. Return information about the symbol */
JanetSlot janetc_resolve( JanetSlot janetc_resolve(
JanetCompiler *c, JanetCompiler *c,
@@ -1103,6 +1144,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
c->current_mapping.line = -1; c->current_mapping.line = -1;
c->current_mapping.column = -1; c->current_mapping.column = -1;
c->lints = lints; c->lints = lints;
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
/* Init result */ /* Init result */
c->result.error = NULL; c->result.error = NULL;
c->result.status = JANET_COMPILE_OK; c->result.status = JANET_COMPILE_OK;

View File

@@ -36,6 +36,15 @@ typedef enum {
JANET_C_LINT_STRICT JANET_C_LINT_STRICT
} JanetCompileLintLevel; } 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 */ /* Tags for some functions for the prepared inliner */
#define JANET_FUN_DEBUG 1 #define JANET_FUN_DEBUG 1
#define JANET_FUN_ERROR 2 #define JANET_FUN_ERROR 2
@@ -184,6 +193,9 @@ struct JanetCompiler {
/* Collect linting results */ /* Collect linting results */
JanetArray *lints; JanetArray *lints;
/* Cached version of (dyn *redef*) */
int is_redef;
}; };
#define JANET_FOPTS_TAIL 0x10000 #define JANET_FOPTS_TAIL 0x10000
@@ -221,9 +233,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
/* Get a special. Return NULL if none exists */ /* Get a special. Return NULL if none exists */
const JanetSpecial *janetc_special(const uint8_t *name); 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_freeslot(JanetCompiler *c, JanetSlot s);
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);
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
JanetSlot janetc_farslot(JanetCompiler *c); JanetSlot janetc_farslot(JanetCompiler *c);
/* Throw away some code after checking that it is well formed. */ /* Throw away some code after checking that it is well formed. */
@@ -267,9 +281,12 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
/* Create a destroy slot */ /* Create a destroy slot */
JanetSlot janetc_cslot(Janet x); 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); 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 */ /* Bytecode optimization */
void janet_bytecode_movopt(JanetFuncDef *def); void janet_bytecode_movopt(JanetFuncDef *def);
void janet_bytecode_remove_noops(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.minor != modconf.minor ||
host.bits != modconf.bits) { host.bits != modconf.bits) {
char errbuf[128]; char errbuf[128];
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)", snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x) - native needs to be recompiled!",
host.major, host.major,
host.minor, host.minor,
host.patch, host.patch,

View File

@@ -1172,7 +1172,7 @@ JanetChannel *janet_channel_make(uint32_t limit) {
JanetChannel *janet_channel_make_threaded(uint32_t limit) { JanetChannel *janet_channel_make_threaded(uint32_t limit) {
janet_assert(limit <= INT32_MAX, "bad limit"); janet_assert(limit <= INT32_MAX, "bad limit");
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel)); 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; return channel;
} }
@@ -1962,7 +1962,7 @@ void janet_stream_level_triggered(JanetStream *stream) {
janet_register_stream_impl(stream, 0); janet_register_stream_impl(stream, 0);
} }
#define JANET_KQUEUE_MAX_EVENTS 64 #define JANET_KQUEUE_MAX_EVENTS 512
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) { void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
/* Poll for events */ /* Poll for events */
@@ -2026,6 +2026,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
void janet_ev_init(void) { void janet_ev_init(void) {
janet_ev_init_common(); janet_ev_init_common();
/* TODO - replace selfpipe with EVFILT_USER (or other events) */
janet_ev_setup_selfpipe(); janet_ev_setup_selfpipe();
janet_vm.kq = kqueue(); janet_vm.kq = kqueue();
janet_vm.timer_enabled = 0; janet_vm.timer_enabled = 0;

View File

@@ -38,6 +38,13 @@
#include <windows.h> #include <windows.h>
#endif #endif
#if defined(JANET_APPLE) || defined(JANET_BSD)
#include <sys/event.h>
#include <sys/stat.h>
#include <unistd.h>
#include <fcntl.h>
#endif
typedef struct { typedef struct {
const char *name; const char *name;
uint32_t flag; uint32_t flag;
@@ -89,7 +96,7 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
sizeof(JanetWatchFlagName), sizeof(JanetWatchFlagName),
keyw); keyw);
if (!result) { if (!result) {
janet_panicf("unknown inotify flag %v", options[i]); janet_panicf("unknown linux flag %v", options[i]);
} }
flags |= result->flag; flags |= result->flag;
} }
@@ -128,8 +135,11 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) { static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed"); if (watcher->stream == NULL) janet_panic("watcher closed");
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path)); Janet pathv = janet_cstringv(path);
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor"); Janet check = janet_table_get(watcher->watch_descriptors, pathv);
if (!janet_checktype(check, JANET_NUMBER)) {
janet_panic("bad watch descriptor");
}
int watch_handle = janet_unwrap_integer(check); int watch_handle = janet_unwrap_integer(check);
int result; int result;
do { do {
@@ -138,6 +148,10 @@ static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (result == -1) { if (result == -1) {
janet_panicv(janet_ev_lasterr()); janet_panicv(janet_ev_lasterr());
} }
/*
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(watch_handle), janet_wrap_nil());
*/
} }
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) { static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
@@ -500,6 +514,254 @@ static void janet_watcher_unlisten(JanetWatcher *watcher) {
janet_gcunroot(janet_wrap_abstract(watcher)); janet_gcunroot(janet_wrap_abstract(watcher));
} }
#elif defined(JANET_APPLE) || defined(JANET_BSD)
/* kqueue implementation */
/* Cribbed from ev.c */
#define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
/* Different BSDs define different NOTE_* constants for different kinds of events. Use ifdef to
determine when they are available (assuming they are defines and not enums */
static const JanetWatchFlagName watcher_flags_kqueue[] = {
{
"all", NOTE_ATTRIB | NOTE_DELETE | NOTE_EXTEND | NOTE_RENAME | NOTE_REVOKE | NOTE_WRITE | NOTE_LINK
#ifdef NOTE_CLOSE
| NOTE_CLOSE
#endif
#ifdef NOTE_CLOSE_WRITE
| NOTE_CLOSE_WRITE
#endif
#ifdef NOTE_OPEN
| NOTE_OPEN
#endif
#ifdef NOTE_READ
| NOTE_READ
#endif
#ifdef NOTE_FUNLOCK
| NOTE_FUNLOCK
#endif
#ifdef NOTE_TRUNCATE
| NOTE_TRUNCATE
#endif
},
{"attrib", NOTE_ATTRIB},
#ifdef NOTE_CLOSE
{"close", NOTE_CLOSE},
#endif
#ifdef NOTE_CLOSE_WRITE
{"close-write", NOTE_CLOSE_WRITE},
#endif
{"delete", NOTE_DELETE},
{"extend", NOTE_EXTEND},
#ifdef NOTE_FUNLOCK
{"funlock", NOTE_FUNLOCK},
#endif
{"link", NOTE_LINK},
#ifdef NOTE_OPEN
{"open", NOTE_OPEN},
#endif
#ifdef NOTE_READ
{"read", NOTE_READ},
#endif
{"rename", NOTE_RENAME},
{"revoke", NOTE_REVOKE},
#ifdef NOTE_TRUNCATE
{"truncate", NOTE_TRUNCATE},
#endif
{"write", NOTE_WRITE},
};
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
uint32_t flags = 0;
for (int32_t i = 0; i < n; i++) {
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
janet_panicf("expected keyword, got %v", options[i]);
}
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_kqueue,
sizeof(watcher_flags_kqueue) / sizeof(JanetWatchFlagName),
sizeof(JanetWatchFlagName),
keyw);
if (!result) {
janet_panicf("unknown bsd flag %v", options[i]);
}
flags |= result->flag;
}
return flags;
}
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
int kq = kqueue();
watcher->watch_descriptors = janet_table(0);
watcher->channel = channel;
watcher->default_flags = default_flags;
watcher->is_watching = 0;
watcher->stream = janet_stream(kq, JANET_STREAM_READABLE, NULL);
janet_stream_level_triggered(watcher->stream);
}
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
if (watcher->stream == NULL) janet_panic("watcher closed");
int kq = watcher->stream->handle;
struct kevent kev = {0};
/* Get file descriptor for path */
int file_fd;
do {
file_fd = open(path, O_RDONLY);
} while (file_fd == -1 && errno == EINTR);
if (file_fd == -1) {
janet_panicf("failed to open: %v", janet_ev_lasterr());
}
/* Watch for EVFILT_VNODE on the file descriptor */
EV_SETx(&kev, file_fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, flags, 0, NULL);
int status;
do {
status = kevent(kq, &kev, 1, NULL, 0, NULL);
} while (status == -1 && errno == EINTR);
if (status == -1) {
close(file_fd);
janet_panicf("failed to listen: %v", janet_ev_lasterr());
}
/* Bookkeeping */
Janet name = janet_cstringv(path);
Janet wd = janet_wrap_integer(file_fd);
janet_table_put(watcher->watch_descriptors, name, wd);
janet_table_put(watcher->watch_descriptors, wd, name);
}
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
if (watcher->stream == NULL) janet_panic("watcher closed");
Janet pathv = janet_cstringv(path);
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
if (!janet_checktype(check, JANET_NUMBER)) {
janet_panic("bad watch descriptor");
}
/* Closing the file descriptor will also remove it from the kqueue */
int wd = janet_unwrap_integer(check);
int result;
do {
result = close(wd);
} while (result != -1 && errno == EINTR);
if (result == -1) {
janet_panicv(janet_ev_lasterr());
}
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(wd), janet_wrap_nil());
}
typedef struct {
JanetWatcher *watcher;
uint32_t cookie;
} KqueueWatcherState;
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
JanetStream *stream = fiber->ev_stream;
KqueueWatcherState *state = fiber->ev_state;
JanetWatcher *watcher = state->watcher;
switch (event) {
case JANET_ASYNC_EVENT_MARK:
janet_mark(janet_wrap_abstract(watcher));
break;
case JANET_ASYNC_EVENT_CLOSE:
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
case JANET_ASYNC_EVENT_ERR: {
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
case JANET_ASYNC_EVENT_HUP:
case JANET_ASYNC_EVENT_INIT:
break;
case JANET_ASYNC_EVENT_READ: {
/* Pump events from the sub kqueue */
const int num_events = 512; /* Extra will be pumped after another event loop rotation. */
struct kevent events[num_events];
int kq = stream->handle;
int status;
do {
status = kevent(kq, NULL, 0, events, num_events, NULL);
} while (status == -1 && errno == EINTR);
if (status == -1) {
janet_schedule(fiber, janet_wrap_nil());
janet_async_end(fiber);
break;
}
for (int i = 0; i < status; i++) {
state->cookie += 6700417;
struct kevent kev = events[i];
/* TODO - avoid stat call here, maybe just when adding listener? */
struct stat stat_buf = {0};
int status;
do {
status = fstat(kev.ident, &stat_buf);
} while (status == -1 && errno == EINTR);
if (status == -1) continue;
int is_dir = S_ISDIR(stat_buf.st_mode);
Janet ident = janet_wrap_integer(kev.ident);
Janet path = janet_table_get(watcher->watch_descriptors, ident);
for (unsigned int j = 1; j < (sizeof(watcher_flags_kqueue) / sizeof(watcher_flags_kqueue[0])); j++) {
uint32_t flagcheck = watcher_flags_kqueue[j].flag;
if (kev.fflags & flagcheck) {
JanetKV *event = janet_struct_begin(6);
janet_struct_put(event, janet_ckeywordv("wd"), ident);
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_number((double) state->cookie));
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_flags_kqueue[j].name));
if (is_dir) {
/* Pass in directly */
janet_struct_put(event, janet_ckeywordv("file-name"), janet_cstringv(""));
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
} else {
/* Split path */
JanetString spath = janet_unwrap_string(path);
const uint8_t *cursor = spath + janet_string_length(spath);
const uint8_t *cursor_end = cursor;
while (cursor > spath && cursor[0] != '/') {
cursor--;
}
if (cursor == spath) {
/* No path separators */
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_cstringv("."));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(spath));
} else {
/* Found path separator */
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
}
}
Janet eventv = janet_wrap_struct(janet_struct_end(event));
janet_channel_give(watcher->channel, eventv);
}
}
}
break;
}
default:
break;
}
}
static void janet_watcher_listen(JanetWatcher *watcher) {
if (watcher->is_watching) janet_panic("already watching");
watcher->is_watching = 1;
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
KqueueWatcherState *state = janet_malloc(sizeof(KqueueWatcherState));
state->watcher = watcher;
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
janet_gcroot(janet_wrap_abstract(watcher));
}
static void janet_watcher_unlisten(JanetWatcher *watcher) {
if (!watcher->is_watching) return;
watcher->is_watching = 0;
janet_stream_close(watcher->stream);
janet_gcunroot(janet_wrap_abstract(watcher));
}
#else #else
/* Default implementation */ /* Default implementation */
@@ -582,10 +844,10 @@ JANET_CORE_FN(cfun_filewatch_make,
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n" "* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
"Events also will contain keys specific to the host OS.\n\n" "Events also will contain keys specific to the host OS.\n\n"
"Windows has no extra properties on events.\n\n" "Windows has no extra properties on events.\n\n"
"Linux has the following extra properties on events:\n\n" "Linux and the BSDs have the following extra properties on events:\n\n"
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n" "* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this. This is a file descriptor integer on BSD and macos.\n\n"
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n" "* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n" "* `:cookie` -- a semi-randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
"") { "") {
janet_sandbox_assert(JANET_SANDBOX_FS_READ); janet_sandbox_assert(JANET_SANDBOX_FS_READ);
janet_arity(argc, 1, -1); janet_arity(argc, 1, -1);
@@ -600,6 +862,7 @@ JANET_CORE_FN(cfun_filewatch_add,
"(filewatch/add watcher path flag & more-flags)", "(filewatch/add watcher path flag & more-flags)",
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n" "Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n" "Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
"FLAGS\n\n"
"* `:all` - trigger an event for all of the below triggers.\n\n" "* `:all` - trigger an event for all of the below triggers.\n\n"
"* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n" "* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
"* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n" "* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
@@ -626,6 +889,22 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:open` - `IN_OPEN`\n\n" "* `:open` - `IN_OPEN`\n\n"
"* `:q-overflow` - `IN_Q_OVERFLOW`\n\n" "* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
"* `:unmount` - `IN_UNMOUNT`\n\n\n" "* `:unmount` - `IN_UNMOUNT`\n\n\n"
"BSDs and macos (flags correspond to `NOTE_*` flags from <sys/event.h>). Not all flags are available on all systems:\n\n"
"* `:all` - `All available NOTE_* flags on the current platform`\n\n"
"* `:attrib` - `NOTE_ATTRIB`\n\n"
"* `:close-write` - `NOTE_CLOSE_WRITE`\n\n"
"* `:close` - `NOTE_CLOSE`\n\n"
"* `:delete` - `NOTE_DELETE`\n\n"
"* `:extend` - `NOTE_EXTEND`\n\n"
"* `:funlock` - `NOTE_FUNLOCK`\n\n"
"* `:link` - `NOTE_LINK`\n\n"
"* `:open` - `NOTE_OPEN`\n\n"
"* `:read` - `NOTE_READ`\n\n"
"* `:rename` - `NOTE_RENAME`\n\n"
"* `:revoke` - `NOTE_REVOKE`\n\n"
"* `:truncate` - `NOTE_TRUNCATE`\n\n"
"* `:write` - `NOTE_WRITE`\n\n\n"
"EVENT TYPES\n\n"
"On Windows, events will have the following possible types:\n\n" "On Windows, events will have the following possible types:\n\n"
"* `:unknown`\n\n" "* `:unknown`\n\n"
"* `:added`\n\n" "* `:added`\n\n"
@@ -633,7 +912,7 @@ JANET_CORE_FN(cfun_filewatch_add,
"* `:modified`\n\n" "* `:modified`\n\n"
"* `:renamed-old`\n\n" "* `:renamed-old`\n\n"
"* `:renamed-new`\n\n" "* `:renamed-new`\n\n"
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n" "On Linux and BSDs, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
"") { "") {
janet_arity(argc, 2, -1); janet_arity(argc, 2, -1);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
@@ -648,6 +927,7 @@ JANET_CORE_FN(cfun_filewatch_remove,
"Remove a path from the watcher.") { "Remove a path from the watcher.") {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at); JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
/* TODO - pass string in directly to avoid extra allocation */
const char *path = janet_getcstring(argv, 1); const char *path = janet_getcstring(argv, 1);
janet_watcher_remove(watcher, path); janet_watcher_remove(watcher, path);
return argv[0]; return argv[0];

View File

@@ -333,7 +333,7 @@ static int compare_uint64_double(uint64_t x, double y) {
} }
} }
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_S64) { if (janet_is_int(argv[0]) != JANET_INT_S64) {
janet_panic("compare method requires int/s64 as first argument"); janet_panic("compare method requires int/s64 as first argument");
@@ -368,7 +368,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
return janet_wrap_nil(); return janet_wrap_nil();
} }
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
if (janet_is_int(argv[0]) != JANET_INT_U64) { if (janet_is_int(argv[0]) != JANET_INT_U64) {
janet_panic("compare method requires int/u64 as first argument"); janet_panic("compare method requires int/u64 as first argument");
@@ -416,7 +416,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
* This will not affect the end result (property of twos complement). * This will not affect the end result (property of twos complement).
*/ */
#define OPMETHOD(T, type, name, oper) \ #define OPMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \ janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \ *box = janet_unwrap_##type(argv[0]); \
@@ -427,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \ } \
#define OPMETHODINVERT(T, type, name, oper) \ #define OPMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *box = janet_unwrap_##type(argv[1]); \
@@ -437,7 +437,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
} \ } \
#define UNARYMETHOD(T, type, name, oper) \ #define UNARYMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 1); \ janet_fixarity(argc, 1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = oper(janet_unwrap_##type(argv[0])); \ *box = oper(janet_unwrap_##type(argv[0])); \
@@ -450,7 +450,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
#define DIVZERO_mod return janet_wrap_abstract(box) #define DIVZERO_mod return janet_wrap_abstract(box)
#define DIVMETHOD(T, type, name, oper) \ #define DIVMETHOD(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \ janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \ *box = janet_unwrap_##type(argv[0]); \
@@ -463,7 +463,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \ } \
#define DIVMETHODINVERT(T, type, name, oper) \ #define DIVMETHODINVERT(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *box = janet_unwrap_##type(argv[1]); \
@@ -474,7 +474,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
} \ } \
#define DIVMETHOD_SIGNED(T, type, name, oper) \ #define DIVMETHOD_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
janet_arity(argc, 2, -1); \ janet_arity(argc, 2, -1); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[0]); \ *box = janet_unwrap_##type(argv[0]); \
@@ -488,7 +488,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
} \ } \
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \ #define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \ static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
janet_fixarity(argc, 2); \ janet_fixarity(argc, 2); \
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \ T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
*box = janet_unwrap_##type(argv[1]); \ *box = janet_unwrap_##type(argv[1]); \
@@ -499,7 +499,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
return janet_wrap_abstract(box); \ return janet_wrap_abstract(box); \
} \ } \
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op1 = janet_unwrap_s64(argv[0]);
@@ -510,7 +510,7 @@ static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[0]);
@@ -521,7 +521,7 @@ static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op1 = janet_unwrap_s64(argv[0]); int64_t op1 = janet_unwrap_s64(argv[0]);
@@ -535,7 +535,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
return janet_wrap_abstract(box); return janet_wrap_abstract(box);
} }
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) { static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t)); int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
int64_t op2 = janet_unwrap_s64(argv[0]); int64_t op2 = janet_unwrap_s64(argv[0]);

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); janet_buffer_extra(buffer, BUFSIZE);
uint8_t *buf = buffer->data + buffer->count; uint8_t *buf = buffer->data + buffer->count;
int32_t neg = 0; int32_t neg = 0;
@@ -80,7 +80,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
if (x == 0) { if (x == 0) {
buf[0] = '0'; buf[0] = '0';
buffer->count++; buffer->count++;
return; return 1;
} }
if (x > 0) { if (x > 0) {
x = -x; x = -x;
@@ -96,6 +96,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
x /= 10; x /= 10;
} }
buffer->count += len + neg; buffer->count += len + neg;
return len + neg;
} }
#define HEX(i) (((uint8_t *) janet_base64)[(i)]) #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 #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, '"'); janet_buffer_push_u8(buffer, '"');
int align = 1;
for (int32_t i = 0; i < len; ++i) { for (int32_t i = 0; i < len; ++i) {
uint8_t c = str[i]; uint8_t c = str[i];
switch (c) { switch (c) {
case '"': case '"':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
align += 2;
break; break;
case '\n': case '\n':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
align += 2;
break; break;
case '\r': case '\r':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
align += 2;
break; break;
case '\0': case '\0':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
align += 2;
break; break;
case '\f': case '\f':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
align += 2;
break; break;
case '\v': case '\v':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
align += 2;
break; break;
case '\a': case '\a':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
align += 2;
break; break;
case '\b': case '\b':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
align += 2;
break; break;
case 27: case 27:
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
align += 2;
break; break;
case '\\': case '\\':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
align += 2;
break; break;
case '\t': case '\t':
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2); janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
align += 2;
break; break;
default: default:
if (c < 32 || c > 126) { 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[2] = janet_base64[(c >> 4) & 0xF];
buf[3] = janet_base64[c & 0xF]; buf[3] = janet_base64[c & 0xF];
janet_buffer_push_bytes(buffer, buf, 4); janet_buffer_push_bytes(buffer, buf, 4);
align += 4;
} else { } else {
janet_buffer_push_u8(buffer, c); janet_buffer_push_u8(buffer, c);
align++;
} }
break; break;
} }
} }
janet_buffer_push_u8(buffer, '"'); janet_buffer_push_u8(buffer, '"');
return align + 1;
} }
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) { static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
@@ -358,9 +374,12 @@ const uint8_t *janet_to_string(Janet x) {
struct pretty { struct pretty {
JanetBuffer *buffer; JanetBuffer *buffer;
int depth; int depth;
int indent; int width;
int align;
int leaf_align;
int flags; int flags;
int32_t bufstartlen; int32_t bufstartlen;
int32_t lookback_barrier;
int32_t *keysort_buffer; int32_t *keysort_buffer;
int32_t keysort_capacity; int32_t keysort_capacity;
int32_t keysort_start; int32_t keysort_start;
@@ -450,14 +469,76 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
return 0; return 0;
} }
static void print_newline(struct pretty *S, int just_a_space) { static void backtrack_newlines(const struct pretty *S) {
if (S->flags & JANET_PRETTY_ONELINE || S->buffer->count <= 0)
return;
switch (S->buffer->data[S->buffer->count - 1]) {
case ')':
case '}':
case ']':
break;
default:
return;
}
int32_t removed = 0;
int32_t old_count = S->buffer->count;
int32_t offset = old_count;
int32_t b0 = S->lookback_barrier;
int32_t columns = S->width;
int32_t align = 0;
while (--offset >= b0) {
const char *s = (const char *)S->buffer->data + offset;
if (*s == '\n') {
if (align < S->leaf_align) {
break;
}
columns += align;
removed += align;
align = 0;
} else if (*s == ' ') {
align++;
} else {
align = 0;
/* Don't count color sequences: \x1B(0|3\d)m */
if (S->flags & JANET_PRETTY_COLOR && *s == 'm') {
if (offset >= (3 + b0) && strncmp("\x1B[0m", s - 3, 4) == 0) {
offset -= 3;
columns++;
} else if (offset >= (4 + b0) && strncmp("\x1B[3", s - 4, 3) == 0) {
offset -= 4;
columns++;
}
}
}
if (--columns <= 0) {
return;
}
}
offset++; /* Don't mess with the last newline we found */
janet_assert(offset >= b0, "bad buffer index");
S->buffer->count -= removed;
for (int32_t i = offset; i < S->buffer->count; i++) {
if (S->buffer->data[offset] == '\n') {
S->buffer->data[i] = ' ';
while (S->buffer->data[++offset] == ' ') {
janet_assert(offset < old_count, "bad replacement of newline");
}
} else {
S->buffer->data[i] = S->buffer->data[offset++];
}
}
}
static void print_newline(struct pretty *S, int align) {
int i; int i;
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) { if (S->flags & JANET_PRETTY_ONELINE) {
janet_buffer_push_u8(S->buffer, ' '); janet_buffer_push_u8(S->buffer, ' ');
return; return;
} }
backtrack_newlines(S);
janet_buffer_push_u8(S->buffer, '\n'); janet_buffer_push_u8(S->buffer, '\n');
for (i = 0; i < S->indent; i++) { S->leaf_align = S->align = align;
for (i = 0; i < S->align; i++) {
janet_buffer_push_u8(S->buffer, ' '); janet_buffer_push_u8(S->buffer, ' ');
} }
} }
@@ -484,14 +565,12 @@ static const char *janet_pretty_colors[] = {
"\x1B[36m" "\x1B[36m"
}; };
#define JANET_PRETTY_DICT_ONELINE 4
#define JANET_PRETTY_IND_ONELINE 10
#define JANET_PRETTY_DICT_LIMIT 30 #define JANET_PRETTY_DICT_LIMIT 30
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000 #define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
#define JANET_PRETTY_ARRAY_LIMIT 160 #define JANET_PRETTY_ARRAY_LIMIT 160
/* Helper for pretty printing */ /* 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 */ /* Add to seen */
switch (janet_type(x)) { switch (janet_type(x)) {
case JANET_NIL: case JANET_NIL:
@@ -506,7 +585,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, janet_cycle_color);
} }
janet_buffer_push_cstring(S->buffer, "<cycle "); 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, '>'); janet_buffer_push_u8(S->buffer, '>');
if (S->flags & JANET_PRETTY_COLOR) { if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m"); janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -528,9 +607,12 @@ 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) { 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_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
janet_buffer_push_u8(S->buffer, '@'); janet_buffer_push_u8(S->buffer, '@');
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen); /* Use start len to print to self better */
S->align += 1 + janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
} else { } else {
S->align -= S->buffer->count;
janet_description_b(S->buffer, x); janet_description_b(S->buffer, x);
S->align += S->buffer->count;
} }
if (color && (S->flags & JANET_PRETTY_COLOR)) { if (color && (S->flags & JANET_PRETTY_COLOR)) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m"); janet_buffer_push_cstring(S->buffer, "\x1B[0m");
@@ -547,35 +629,35 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "("; const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')'; const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
janet_buffer_push_cstring(S->buffer, startstr); janet_buffer_push_cstring(S->buffer, startstr);
S->align += strlen(startstr);
const int align = S->leaf_align = S->align;
S->depth--; S->depth--;
S->indent += 2;
if (S->depth == 0) { if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "..."); janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else { } 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)) { if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
for (i = 0; i < 3; i++) { for (i = 0; i < 3; i++) {
if (i) print_newline(S, 0); if (i) print_newline(S, align);
janet_pretty_one(S, arr[i], 0); janet_pretty_one(S, arr[i]);
} }
print_newline(S, 0); print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "..."); janet_buffer_push_cstring(S->buffer, "...");
for (i = 0; i < 3; i++) { S->align += 3;
print_newline(S, 0); for (i = len - 3; i < len; i++) {
janet_pretty_one(S, arr[len - 3 + i], 0); print_newline(S, align);
janet_pretty_one(S, arr[i]);
} }
} else { } else {
for (i = 0; i < len; i++) { for (i = 0; i < len; i++) {
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE); if (i) print_newline(S, align);
janet_pretty_one(S, arr[i], 0); janet_pretty_one(S, arr[i]);
} }
} }
} }
S->indent -= 2;
S->depth++; S->depth++;
janet_buffer_push_u8(S->buffer, endchar); janet_buffer_push_u8(S->buffer, endchar);
S->align++;
break; break;
} }
case JANET_STRUCT: case JANET_STRUCT:
@@ -586,6 +668,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
if (istable) { if (istable) {
JanetTable *t = janet_unwrap_table(x); JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto; JanetTable *proto = t->proto;
S->align++;
janet_buffer_push_cstring(S->buffer, "@"); janet_buffer_push_cstring(S->buffer, "@");
if (NULL != proto) { if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("_name")); Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
@@ -596,6 +679,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_cstring(S->buffer, janet_class_color);
} }
janet_buffer_push_bytes(S->buffer, n, len); janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) { if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m"); janet_buffer_push_cstring(S->buffer, "\x1B[0m");
} }
@@ -613,25 +697,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_cstring(S->buffer, janet_class_color);
} }
janet_buffer_push_bytes(S->buffer, n, len); janet_buffer_push_bytes(S->buffer, n, len);
S->align += len;
if (S->flags & JANET_PRETTY_COLOR) { if (S->flags & JANET_PRETTY_COLOR) {
janet_buffer_push_cstring(S->buffer, "\x1B[0m"); janet_buffer_push_cstring(S->buffer, "\x1B[0m");
} }
} }
} }
} }
janet_buffer_push_cstring(S->buffer, "{"); janet_buffer_push_u8(S->buffer, '{');
const int align = S->leaf_align = ++S->align;
S->depth--; S->depth--;
S->indent += 2;
if (S->depth == 0) { if (S->depth == 0) {
janet_buffer_push_cstring(S->buffer, "..."); janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} else { } else {
int32_t len = 0, cap = 0; int32_t len = 0, cap = 0;
const JanetKV *kvs = NULL; const JanetKV *kvs = NULL;
janet_dictionary_view(x, &kvs, &len, &cap); 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; int32_t ks_start = S->keysort_start;
int truncated = 0; int truncated = 0;
@@ -644,15 +727,17 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
int32_t j = 0; int32_t j = 0;
for (int32_t i = 0; i < len; i++) { for (int32_t i = 0; i < len; i++) {
while (janet_checktype(kvs[j].key, JANET_NIL)) j++; while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE); if (i) print_newline(S, align);
janet_pretty_one(S, kvs[j].key, 0); janet_pretty_one(S, kvs[j].key);
janet_buffer_push_u8(S->buffer, ' '); janet_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1); S->align++;
janet_pretty_one(S, kvs[j].value);
j++; j++;
} }
if (truncated) { if (truncated) {
print_newline(S, 0); print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "..."); janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} }
} else { } else {
/* Sorted keys dictionaries */ /* Sorted keys dictionaries */
@@ -685,24 +770,26 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
} }
for (int32_t i = 0; i < len; i++) { 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]; 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_buffer_push_u8(S->buffer, ' ');
janet_pretty_one(S, kvs[j].value, 1); S->align++;
janet_pretty_one(S, kvs[j].value);
} }
if (truncated) { if (truncated) {
print_newline(S, 0); print_newline(S, align);
janet_buffer_push_cstring(S->buffer, "..."); janet_buffer_push_cstring(S->buffer, "...");
S->align += 3;
} }
} }
S->keysort_start = ks_start; S->keysort_start = ks_start;
} }
S->indent -= 2;
S->depth++; S->depth++;
janet_buffer_push_u8(S->buffer, '}'); janet_buffer_push_u8(S->buffer, '}');
S->align++;
break; break;
} }
} }
@@ -711,21 +798,27 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
return; return;
} }
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Janet x, int32_t startlen) { #define JANET_COLUMNS 80
static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int width,
int flags, Janet x, int32_t startlen, int32_t lookback_barrier) {
struct pretty S; struct pretty S;
if (NULL == buffer) { if (NULL == buffer) {
buffer = janet_buffer(0); buffer = janet_buffer(0);
} }
S.buffer = buffer; S.buffer = buffer;
S.depth = depth; S.depth = depth;
S.indent = 0; S.width = width;
S.align = 0;
S.flags = flags; S.flags = flags;
S.bufstartlen = startlen; S.bufstartlen = startlen;
S.lookback_barrier = lookback_barrier;
S.keysort_capacity = 0; S.keysort_capacity = 0;
S.keysort_buffer = NULL; S.keysort_buffer = NULL;
S.keysort_start = 0; S.keysort_start = 0;
janet_table_init(&S.seen, 10); janet_table_init(&S.seen, 10);
janet_pretty_one(&S, x, 0); janet_pretty_one(&S, x);
backtrack_newlines(&S);
janet_table_deinit(&S.seen); janet_table_deinit(&S.seen);
return S.buffer; return S.buffer;
} }
@@ -733,19 +826,21 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
/* Helper for printing a janet value in a pretty form. Not meant to be used /* Helper for printing a janet value in a pretty form. Not meant to be used
* for serialization or anything like that. */ * for serialization or anything like that. */
JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) { JanetBuffer *janet_pretty(JanetBuffer *buffer, int depth, int flags, Janet x) {
return janet_pretty_(buffer, depth, flags, x, buffer ? buffer->count : 0); return janet_pretty_(buffer, depth, JANET_COLUMNS, flags,
x, buffer ? buffer->count : 0, buffer ? buffer->count : 0);
} }
static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen) { static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t startlen, int32_t lookback_barrier) {
struct pretty S; struct pretty S;
if (NULL == buffer) { if (NULL == buffer) {
buffer = janet_buffer(0); buffer = janet_buffer(0);
} }
S.buffer = buffer; S.buffer = buffer;
S.depth = depth; S.depth = depth;
S.indent = 0; S.align = 0;
S.flags = 0; S.flags = 0;
S.bufstartlen = startlen; S.bufstartlen = startlen;
S.lookback_barrier = lookback_barrier;
S.keysort_capacity = 0; S.keysort_capacity = 0;
S.keysort_buffer = NULL; S.keysort_buffer = NULL;
S.keysort_start = 0; S.keysort_start = 0;
@@ -759,7 +854,7 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
} }
JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) { JanetBuffer *janet_jdn(JanetBuffer *buffer, int depth, Janet x) {
return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0); return janet_jdn_(buffer, depth, x, buffer ? buffer->count : 0, buffer ? buffer->count : 0);
} }
static const char *typestr(Janet x) { static const char *typestr(Janet x) {
@@ -965,18 +1060,26 @@ void janet_formatbv(JanetBuffer *b, const char *format, va_list args) {
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N'); int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n'); int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n'); int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
int columns = atoi(width);
if (columns == 0) {
columns = JANET_COLUMNS;
} else if (columns < 0) {
has_oneline = 1;
}
int flags = 0; int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0; flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0; flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0; flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, va_arg(args, Janet), startlen); janet_pretty_(b, depth, columns, flags,
va_arg(args, Janet), startlen, b->count);
break; break;
} }
case 'j': { case 'j': {
int depth = atoi(precision); int depth = atoi(precision);
if (depth < 1) if (depth < 1) {
depth = JANET_RECURSION_GUARD; depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, va_arg(args, Janet), startlen); }
janet_jdn_(b, depth, va_arg(args, Janet), startlen, b->count);
break; break;
} }
default: { default: {
@@ -1127,18 +1230,24 @@ void janet_buffer_format(
int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N'); int has_color = (d == 'P') || (d == 'Q') || (d == 'M') || (d == 'N');
int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n'); int has_oneline = (d == 'Q') || (d == 'q') || (d == 'N') || (d == 'n');
int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n'); int has_notrunc = (d == 'M') || (d == 'm') || (d == 'N') || (d == 'n');
int columns = atoi(width);
if (columns == 0)
columns = JANET_COLUMNS;
else if (columns < 0)
has_oneline = 1;
int flags = 0; int flags = 0;
flags |= has_color ? JANET_PRETTY_COLOR : 0; flags |= has_color ? JANET_PRETTY_COLOR : 0;
flags |= has_oneline ? JANET_PRETTY_ONELINE : 0; flags |= has_oneline ? JANET_PRETTY_ONELINE : 0;
flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0; flags |= has_notrunc ? JANET_PRETTY_NOTRUNC : 0;
janet_pretty_(b, depth, flags, argv[arg], startlen); janet_pretty_(b, depth, columns, flags,
argv[arg], startlen, b->count);
break; break;
} }
case 'j': { case 'j': {
int depth = atoi(precision); int depth = atoi(precision);
if (depth < 1) if (depth < 1)
depth = JANET_RECURSION_GUARD; depth = JANET_RECURSION_GUARD;
janet_jdn_(b, depth, argv[arg], startlen); janet_jdn_(b, depth, argv[arg], startlen, b->count);
break; break;
} }
default: { default: {

View File

@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
} }
/* Def or var a symbol in a local scope */ /* 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) && int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
ret.index > 0 && ret.index > 0 &&
ret.envindex >= 0; ret.envindex >= 0;
@@ -425,11 +425,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
ret = localslot; ret = localslot;
} }
ret.flags |= flags; ret.flags |= flags;
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) { if (c->scope->flags & JANET_SCOPE_TOP) {
janetc_nameslot_no_unused(c, head, ret); def_flags |= JANET_DEFFLAG_NO_UNUSED;
} else {
janetc_nameslot(c, head, ret);
} }
janetc_nameslot(c, head, ret, def_flags);
return !isUnnamedRegister; return !isUnnamedRegister;
} }
@@ -443,7 +442,7 @@ static int varleaf(
JanetSlot refslot; JanetSlot refslot;
JanetTable *entry = janet_table_clone(reftab); 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; JanetArray *ref;
JanetBinding old_binding; JanetBinding old_binding;
@@ -464,7 +463,11 @@ static int varleaf(
return 1; return 1;
} else { } else {
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused")); int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused); 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, const uint8_t *sym,
JanetSlot s, JanetSlot s,
JanetTable *tab) { JanetTable *tab) {
JanetTable *entry = NULL;
int is_redef = 0;
if (c->scope->flags & JANET_SCOPE_TOP) { 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_table_put(entry, janet_ckeywordv("source-map"),
janet_wrap_tuple(janetc_make_sourcemap(c))); 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) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
if (is_redef) { if (is_redef) {
@@ -530,12 +535,18 @@ static int defleaf(
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry)); JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0); 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")); 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) { 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_table = janet_table(10);
named_slot = janetc_farslot(c); named_slot = janetc_farslot(c);
} else { } else {
janetc_nameslot(c, sym, janetc_farslot(c)); janetc_nameslot(c, sym, janetc_farslot(c), 0);
} }
} else { } else {
janetc_nameslot(c, sym, janetc_farslot(c)); janetc_nameslot(c, sym, janetc_farslot(c), 0);
} }
} else { } else {
janet_v_push(destructed_params, janetc_farslot(c)); 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); JanetSlot slot = janetc_farslot(c);
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION; slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1); 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

@@ -555,7 +555,9 @@ JANET_CORE_FN(cfun_string_format,
"\n" "\n"
"The following conversion specifiers are used for \"pretty-printing\", where the upper-case " "The following conversion specifiers are used for \"pretty-printing\", where the upper-case "
"variants generate colored output. These specifiers can take a precision " "variants generate colored output. These specifiers can take a precision "
"argument to specify the maximum nesting depth to print.\n" "argument to specify the maximum nesting depth to print. "
"The multiline specifiers can also take a width argument, "
"which defaults to 80 columns.\n"
"- `p`, `P`: pretty format, truncating if necessary\n" "- `p`, `P`: pretty format, truncating if necessary\n"
"- `m`, `M`: pretty format without truncating.\n" "- `m`, `M`: pretty format without truncating.\n"
"- `q`, `Q`: pretty format on one line, truncating if necessary.\n" "- `q`, `Q`: pretty format on one line, truncating if necessary.\n"

View File

@@ -49,6 +49,8 @@
#include <math.h> #include <math.h>
#include <string.h> #include <string.h>
#define JANET_NUMBER_LENGTH_RIDICULOUS 0xFFFF
/* Lookup table for getting values of characters when parsing numbers. Handles /* 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. */ * digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
static uint8_t digit_lookup[128] = { static uint8_t digit_lookup[128] = {
@@ -266,7 +268,7 @@ int janet_scan_number_base(
* the decimal point, exponent could wrap around and become positive. It's * the decimal point, exponent could wrap around and become positive. It's
* easier to reject ridiculously large inputs than to check for overflows. * easier to reject ridiculously large inputs than to check for overflows.
* */ * */
if (len > INT32_MAX / 40) goto error; if (len > JANET_NUMBER_LENGTH_RIDICULOUS) goto error;
/* Get sign */ /* Get sign */
if (str >= end) goto error; if (str >= end) goto error;
@@ -410,10 +412,7 @@ static int scan_uint64(
*neg = 0; *neg = 0;
*out = 0; *out = 0;
uint64_t accum = 0; uint64_t accum = 0;
/* len max is INT64_MAX in base 2 with _ between each bits */ if (len > JANET_NUMBER_LENGTH_RIDICULOUS) return 0;
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
/* zeros */
if (len > 150) return 0;
/* Get sign */ /* Get sign */
if (str >= end) return 0; if (str >= end) return 0;
if (*str == '-') { if (*str == '-') {

View File

@@ -573,8 +573,24 @@ static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
return (char *)(namebuf->buf); 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) { void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
while (cfuns->name) { while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation); if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
@@ -584,6 +600,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
while (cfuns->name) { while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(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); 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); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
@@ -595,6 +612,7 @@ void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *
NameBuf nb; NameBuf nb;
if (env) namebuf_init(&nb, regprefix); if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) { while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation); if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
@@ -607,6 +625,7 @@ void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetR
NameBuf nb; NameBuf nb;
if (env) namebuf_init(&nb, regprefix); if (env) namebuf_init(&nb, regprefix);
while (cfuns->name) { while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(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); 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); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
@@ -623,6 +642,7 @@ void janet_register(const char *name, JanetCFunction cfun) {
/* Abstract type introspection */ /* Abstract type introspection */
void janet_register_abstract_type(const JanetAbstractType *at) { void janet_register_abstract_type(const JanetAbstractType *at) {
janet_check_pointer_align((void *) at);
Janet sym = janet_csymbolv(at->name); Janet sym = janet_csymbolv(at->name);
Janet check = janet_table_get(janet_vm.abstract_registry, sym); Janet check = janet_table_get(janet_vm.abstract_registry, sym);
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) { if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
@@ -655,6 +675,7 @@ void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) { void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
(void) regprefix; (void) regprefix;
while (cfuns->name) { while (cfuns->name) {
janet_check_pointer_align(cfuns->cfun);
Janet fun = janet_wrap_cfunction(cfuns->cfun); Janet fun = janet_wrap_cfunction(cfuns->cfun);
janet_table_put(env, janet_csymbolv(cfuns->name), fun); janet_table_put(env, janet_csymbolv(cfuns->name), fun);
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line); janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);

View File

@@ -50,9 +50,9 @@
#ifndef JANET_EXIT #ifndef JANET_EXIT
#include <stdio.h> #include <stdio.h>
#define JANET_EXIT(m) do { \ #define JANET_EXIT(m) do { \
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\ fprintf(stderr, "janet abort at %s:%d: %s\n",\
__LINE__,\
__FILE__,\ __FILE__,\
__LINE__,\
(m));\ (m));\
abort();\ abort();\
} while (0) } while (0)

View File

@@ -194,12 +194,18 @@ Janet janet_wrap_number_safe(double d) {
void *janet_nanbox_to_pointer(Janet x) { void *janet_nanbox_to_pointer(Janet x) {
x.i64 &= JANET_NANBOX_PAYLOADBITS; x.i64 &= JANET_NANBOX_PAYLOADBITS;
x.u64 <<= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
return x.pointer; return x.pointer;
} }
Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) { Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
Janet ret; Janet ret;
ret.pointer = p; 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; ret.u64 |= tagmask;
return ret; return ret;
} }
@@ -207,6 +213,11 @@ Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) { Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
Janet ret; Janet ret;
ret.pointer = (void *)p; 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; ret.u64 |= tagmask;
return ret; return ret;
} }

View File

@@ -307,25 +307,38 @@ extern "C" {
* architectures (Nanboxing only tested on x86 and x64), comment out * architectures (Nanboxing only tested on x86 and x64), comment out
* the JANET_NANBOX define.*/ * the JANET_NANBOX define.*/
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
#define JANET_NO_NANBOX
#endif
#ifndef JANET_NO_NANBOX #ifndef JANET_NO_NANBOX
#ifdef JANET_32 #ifdef JANET_32
#define JANET_NANBOX_32 #define JANET_NANBOX_32
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv) #elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv) || defined(__aarch64__) || defined(_M_ARM64)
/* We will only enable nanboxing by default on 64 bit systems /* We will only enable nanboxing by default on 64 bit systems
* for x64 and risc-v. This is mainly because the approach is tied to the * for x64, risc-v, and arm64. This is mainly because the approach is tied to the
* implicit 47 bit address space. Many arches allow/require this, but not all, * implicit 47 bit address space. Many arches allow/require this, but not all,
* and it requires cooperation from the OS. ARM should also work in many configurations. */ * and it requires cooperation from the OS. ARM should also work in many configurations by taking advantage
* of pointer alignment to allow for 48 or 49 bits of address space. */
#define JANET_NANBOX_64 #define JANET_NANBOX_64
/* Allow 64-bit nanboxing to assume aligned pointers to get back some extra bits for representation.
* This is needed to use nanboxing on systems with larger than 47-bit address spaces, such as many
* aarch64 systems. */
#ifndef JANET_NANBOX_64_POINTER_SHIFT
#if (defined(_M_ARM64) || defined(__aarch64__)) && !defined(JANET_APPLE)
/* All pointers, including function pointers, should be 4-byte aligned on aarch64 by default.
* The exception is aarch64 macos, as it uses the same 47-bit userland address-space as on amd64. */
#define JANET_NANBOX_64_POINTER_SHIFT 2
#endif #endif
#endif #endif
#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 */ /* Runtime config constants */
#ifdef JANET_NO_NANBOX #ifdef JANET_NO_NANBOX
#define JANET_NANBOX_BIT 0 #define JANET_NANBOX_BIT 0x0
#else #else
#define JANET_NANBOX_BIT 0x1 #define JANET_NANBOX_BIT 0x1
#endif #endif
@@ -336,9 +349,16 @@ extern "C" {
#define JANET_SINGLE_THREADED_BIT 0 #define JANET_SINGLE_THREADED_BIT 0
#endif #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 \ #define JANET_CURRENT_CONFIG_BITS \
(JANET_SINGLE_THREADED_BIT | \ (JANET_SINGLE_THREADED_BIT | \
JANET_NANBOX_BIT) JANET_NANBOX_BIT | \
JANET_NANBOX_POINTER_SHIFT_BITS)
/* Represents the settings used to compile Janet, as well as the version */ /* Represents the settings used to compile Janet, as well as the version */
typedef struct { typedef struct {
@@ -1415,7 +1435,7 @@ enum JanetOpCode {
}; };
/* Info about all instructions */ /* Info about all instructions */
extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT]; extern const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
/***** END SECTION OPCODES *****/ /***** END SECTION OPCODES *****/
@@ -2063,8 +2083,14 @@ JANET_API Janet janet_resolve_core(const char *name);
* *
* */ * */
#if defined(JANET_NANBOX_64) && (JANET_NANBOX_64_POINTER_SHIFT != 0) && !defined(JANET_MSVC)
#define JANET_CFUNCTION_ALIGN __attribute__((aligned(1 << JANET_NANBOX_64_POINTER_SHIFT)))
#else
#define JANET_CFUNCTION_ALIGN
#endif
/* Shorthand for janet C function declarations */ /* Shorthand for janet C function declarations */
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv) #define JANET_CFUN(name) JANET_CFUNCTION_ALIGN Janet name (int32_t argc, Janet *argv)
/* Declare a C function with documentation and source mapping */ /* Declare a C function with documentation and source mapping */
#define JANET_REG_END {NULL, NULL, NULL, NULL, 0} #define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
@@ -2080,7 +2106,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_} #define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \ #define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
static const int32_t CNAME##_sourceline_ = __LINE__; \ static const int32_t CNAME##_sourceline_ = __LINE__; \
Janet CNAME (int32_t argc, Janet *argv) Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \ #define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__) janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
@@ -2088,7 +2114,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0} #define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \ #define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \ static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
Janet CNAME (int32_t argc, Janet *argv) Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \ #define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
janet_def(ENV, JNAME, VAL, DOC) janet_def(ENV, JNAME, VAL, DOC)
@@ -2097,7 +2123,7 @@ JANET_API Janet janet_resolve_core(const char *name);
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \ #define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
static const int32_t CNAME##_sourceline_ = __LINE__; \ static const int32_t CNAME##_sourceline_ = __LINE__; \
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \ static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
Janet CNAME (int32_t argc, Janet *argv) Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \ #define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__) janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)

View File

@@ -26,6 +26,7 @@
#include <janet.h> #include <janet.h>
#include <errno.h> #include <errno.h>
#include <assert.h>
#ifdef _WIN32 #ifdef _WIN32
#include <windows.h> #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) { static void refresh(void) {
char seq[64]; char seq[64];
JanetBuffer b; JanetBuffer b;
/* If prompt is too long, truncate */
int _plen = getplen();
/* Keep cursor position on screen */ /* Keep cursor position on screen */
char *_buf = gbl_buf; char *_buf = gbl_buf;
int _len = gbl_len; int _len = gbl_len;
int _pos = gbl_pos; int _pos = gbl_pos;
while ((gbl_plen + _pos) >= gbl_cols) {
while ((_plen + _pos) >= gbl_cols) {
_buf++; _buf++;
_len--; _len--;
_pos--; _pos--;
} }
while ((gbl_plen + _len) > gbl_cols) {
while ((_plen + _len) > gbl_cols) {
_len--; _len--;
} }
janet_buffer_init(&b, 0); janet_buffer_init(&b, 0);
/* Cursor to left edge, gbl_prompt and buffer */ /* Cursor to left edge, gbl_prompt and buffer */
janet_buffer_push_u8(&b, '\r'); janet_buffer_push_u8(&b, '\r');
janet_buffer_push_cstring(&b, gbl_prompt); janet_buffer_push_bytes(&b, (const uint8_t *) gbl_prompt, _plen);
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len); if (_len > 0) {
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
}
/* Erase to right */ /* Erase to right */
janet_buffer_push_cstring(&b, "\x1b[0K\r"); janet_buffer_push_cstring(&b, "\x1b[0K\r");
/* Move cursor to original position. */ /* Move cursor to original position. */
if (_pos + gbl_plen) { if (_pos + _plen) {
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + gbl_plen)); snprintf(seq, 64, "\x1b[%dC", (int)(_pos + _plen));
janet_buffer_push_cstring(&b, seq); janet_buffer_push_cstring(&b, seq);
} }
if (write_console((char *) b.data, b.count) == -1) { 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_pos++] = c;
gbl_buf[++gbl_len] = '\0'; gbl_buf[++gbl_len] = '\0';
if (draw) { 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 /* Avoid a full update of the line in the
* trivial case. */ * trivial case. */
if (write_console(&c, 1) == -1) return -1; if (write_console(&c, 1) == -1) return -1;
@@ -500,8 +519,13 @@ static void historymove(int delta) {
} else if (gbl_historyi >= gbl_history_count) { } else if (gbl_historyi >= gbl_history_count) {
gbl_historyi = gbl_history_count - 1; gbl_historyi = gbl_history_count - 1;
} }
gbl_len = (int) strlen(gbl_history[gbl_historyi]);
/* If history element is longer the JANET_LINE_MAX - 1, truncate */
if (gbl_len > JANET_LINE_MAX - 1) {
gbl_len = JANET_LINE_MAX - 1;
}
gbl_pos = gbl_len;
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1); strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
gbl_pos = gbl_len = (int) strlen(gbl_buf);
gbl_buf[gbl_len] = '\0'; gbl_buf[gbl_len] = '\0';
refresh(); refresh();
@@ -925,11 +949,12 @@ static int line() {
gbl_len = 0; gbl_len = 0;
gbl_pos = 0; gbl_pos = 0;
while (gbl_prompt[gbl_plen]) gbl_plen++; while (gbl_prompt[gbl_plen]) gbl_plen++;
int _plen = getplen();
gbl_buf[0] = '\0'; gbl_buf[0] = '\0';
addhistory(); addhistory();
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1; if (write_console((char *) gbl_prompt, _plen) == -1) return -1;
for (;;) { for (;;) {
char c; char c;
char seq[5]; char seq[5];
@@ -1212,7 +1237,7 @@ int main(int argc, char **argv) {
#endif #endif
#if defined(JANET_PRF) #if defined(JANET_PRF)
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1]; uint8_t hash_key[JANET_HASH_KEY_SIZE + 1] = {0};
#ifdef JANET_REDUCED_OS #ifdef JANET_REDUCED_OS
char *envvar = NULL; char *envvar = NULL;
#else #else
@@ -1220,6 +1245,7 @@ int main(int argc, char **argv) {
#endif #endif
if (NULL != envvar) { if (NULL != envvar) {
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1); strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
hash_key[JANET_HASH_KEY_SIZE] = '\0'; /* in case copy didn't get null byte */
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) { } else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
fputs("unable to initialize janet PRF hash function.\n", stderr); fputs("unable to initialize janet PRF hash function.\n", stderr);
return 1; return 1;

View File

@@ -27,9 +27,11 @@
(def line-info (string/format "%s:%d" (def line-info (string/format "%s:%d"
(frame :source) (frame :source-line))) (frame :source) (frame :source-line)))
(if x (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 (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) x)
(defn skip-asserts (defn skip-asserts
@@ -38,7 +40,7 @@
(+= skip-n n) (+= skip-n n)
nil) nil)
(defmacro assert (defmacro assert :shadow
[x &opt e] [x &opt e]
(def xx (gensym)) (def xx (gensym))
(default e (string/format "%j" x)) (default e (string/format "%j" x))
@@ -50,12 +52,12 @@
(defmacro assert-error (defmacro assert-error
[msg & forms] [msg & forms]
(def errsym (keyword (gensym))) (def errsym (keyword (gensym)))
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg)) ~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
(defmacro assert-error-value (defmacro assert-error-value
[msg errval & forms] [msg errval & forms]
(def e (gensym)) (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 (defn check-compile-error
[form] [form]

View File

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

View File

@@ -48,8 +48,8 @@
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer") (assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int") (assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
(def b @"AA") (def b1 @"AA")
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self") (assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
# buffer/push-byte # buffer/push-byte
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte") (assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
@@ -145,8 +145,8 @@
# Regression #301 # Regression #301
# a3d4ecddb # a3d4ecddb
(def b (buffer/new-filled 128 0x78)) (def b8 (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1") (assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
(def a @"abcdefghijklm") (def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2") (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") (assert (get result :error) "bad sum3 fuzz issue valgrind")
# Issue #1700 # Issue #1700
(def result (def result1
(compile (compile
'(defn fuzz-case-1 '(defn fuzz-case-1
[start end &] [start end &]
(if end (if end
(if e start (lazy-range (+ 1 start) end))) (if e start (lazy-range (+ 1 start) end)))
1))) 1)))
(assert (get result :error) "fuzz case issue #1700") (assert (get result1 :error) "fuzz case issue #1700")
# Issue #1702 - fuzz case with upvalues # Issue #1702 - fuzz case with upvalues
(def result (def result2
(compile (compile
'(each item [1 2 3] '(each item [1 2 3]
# Generate a lot of upvalues (more than 224) # Generate a lot of upvalues (more than 224)
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"") (def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
(with-dyns [:out out-buf] 1)))) (with-dyns [:out out-buf] 1))))
(assert result "bad upvalues fuzz case") (assert result2 "bad upvalues fuzz case")
# Named argument linting # Named argument linting
# Enhancement for #1654 # Enhancement for #1654
@@ -117,14 +117,14 @@
(defn check-good-compile (defn check-good-compile
[code msg] [code msg]
(def lints @[]) (def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints)) (def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (empty? lints)) msg)) (assert (and (function? result4) (empty? lints)) msg))
(defn check-lint-compile (defn check-lint-compile
[code msg] [code msg]
(def lints @[]) (def lints @[])
(def result (compile code (curenv) "suite-compile.janet" lints)) (def result4 (compile code (curenv) "suite-compile.janet" lints))
(assert (and (function? result) (next lints)) msg)) (assert (and (function? result4) (next lints)) msg))
(check-good-compile '(fnamed) "named no args") (check-good-compile '(fnamed) "named no args")
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full 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) "g lint 1")
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2") (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") (assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
# Another variant # Another variant
(def thread-channel (ev/thread-chan 100)) (def thread-channel :shadow (ev/thread-chan 100))
(def super (ev/thread-chan 10)) (def super :shadow (ev/thread-chan 10))
(defn worker [] (defn worker :shadow []
(while true (while true
(def item (ev/take thread-channel)) (def item (ev/take thread-channel))
(when (= item :deadline) (when (= item :deadline)

View File

@@ -26,6 +26,8 @@
(def chan (ev/chan 1000)) (def chan (ev/chan 1000))
(var is-win (or (= :mingw (os/which)) (= :windows (os/which)))) (var is-win (or (= :mingw (os/which)) (= :windows (os/which))))
(var is-linux (= :linux (os/which))) (var is-linux (= :linux (os/which)))
(def bsds [:freebsd :macos :openbsd :bsd :dragonfly :netbsd])
(var is-kqueue (index-of (os/which) bsds))
# If not supported, exit early # If not supported, exit early
(def [supported msg] (protect (filewatch/new chan))) (def [supported msg] (protect (filewatch/new chan)))
@@ -97,6 +99,10 @@
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete) (filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
(filewatch/add fw td1 :close-write :create :delete) (filewatch/add fw td1 :close-write :create :delete)
(filewatch/add fw td2 :close-write :create :delete :ignored)) (filewatch/add fw td2 :close-write :create :delete :ignored))
(when is-kqueue
(filewatch/add fw (string td3 "/file3.txt") :all)
(filewatch/add fw td1 :all)
(filewatch/add fw td2 :all))
(assert-no-error "filewatch/listen no error" (filewatch/listen fw)) (assert-no-error "filewatch/listen no error" (filewatch/listen fw))
# #
@@ -196,6 +202,30 @@
(expect-empty) (expect-empty)
(gccollect)) (gccollect))
#
# Macos and BSD file writing
#
# TODO - kqueue capabilities here are a bit more limited than inotify and windows by default.
# This could be ammended with some heavier-weight functionality in userspace, though.
(when is-kqueue
(spit-file td1 "file1.txt")
(expect :wd-path td1 :type :write)
(expect-empty)
(gccollect)
(spit-file td1 "file1.txt")
# Currently, only operations that modify the parent vnode do anything
(expect-empty)
(gccollect)
# Check that we don't get anymore events from test directory 2
(spit-file td2 "file2.txt")
(expect :wd-path td2 :type :write)
(expect-empty)
# Remove a file, then wait for remove event
(rmrf (string td1 "/file1.txt"))
(expect :type :write) # a "write" to the vnode
(expect-empty))
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw)) (assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
(assert-no-error "cleanup 1" (rmrf td1)) (assert-no-error "cleanup 1" (rmrf td1))
(assert-no-error "cleanup 2" (rmrf td2)) (assert-no-error "cleanup 2" (rmrf td2))

View File

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

View File

@@ -95,11 +95,11 @@
(do (do
(defn f1 (defn f1
[a] [a]
(defn f1 [] (++ (a 0))) (defn f1 :shadow [] (++ (a 0)))
(defn f2 [] (++ (a 0))) (defn f2 [] (++ (a 0)))
(error [f1 f2])) (error [f1 f2]))
(def [_ tup] (protect (f1 @[0]))) (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 (= 1 (f1)) "marshal-non-resumable-closure 1")
(assert (= 2 (f2)) "marshal-non-resumable-closure 2")) (assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
@@ -108,10 +108,10 @@
(do (do
(defn f1 (defn f1
[a] [a]
(defn f1 [] (++ (a 0))) (defn f1 :shadow [] (++ (a 0)))
(defn f2 [] (++ (a 0))) (defn f2 :shadow [] (++ (a 0)))
(marshal [f1 f2] make-image-dict)) (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 (= 1 (f1)) "marshal-live-closure 1")
(assert (= 2 (f2)) "marshal-live-closure 2")) (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") (assert (deep= t tclone) "table/weak marsh 7")
# table weak keys # table weak keys
(def t (table/weak-keys 1)) (def t :shadow (table/weak-keys 1))
(put t @"" keep-value) (put t @"" keep-value)
(put t :key @"") (put t :key @"")
(assert (= 2 (length t)) "table/weak-keys marsh 1") (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") (assert (= 2 (length tclone)) "table/weak-keys marsh 2")
(gccollect) (gccollect)
(assert (= 1 (length tclone)) "table/weak-keys marsh 3") (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") (assert (deep= t tclone) "table/weak-keys marsh 5")
# table weak values # table weak values
(def t (table/weak-values 1)) (def t :shadow (table/weak-values 1))
(put t @"" keep-value) (put t @"" keep-value)
(put t :key @"") (put t :key @"")
(assert (= 2 (length t)) "table/weak-values marsh 1") (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") (assert (= 2 (length tclone)) "table/weak-values marsh 2")
(gccollect) (gccollect)
(assert (= 1 (length t)) "table/weak-value marsh 3") (assert (= 1 (length t)) "table/weak-value marsh 3")
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4") (assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
# tables with prototypes # tables with prototypes
(def t (table/weak-values 1)) (def t :shadow (table/weak-values 1))
(table/setproto t @{:abc 123}) (table/setproto t @{:abc 123})
(put t @"" keep-value) (put t @"" keep-value)
(put t :key @"") (put t :key @"")
(assert (= 2 (length t)) "marsh weak tables with prototypes 1") (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") (assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
(gccollect) (gccollect)
(assert (= 1 (length t)) "marsh weak tables with prototypes 3") (assert (= 1 (length t)) "marsh weak tables with prototypes 3")

View File

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

View File

@@ -84,10 +84,10 @@
# Substitution test with peg # Substitution test with peg
# d7626f8c5 # d7626f8c5
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1))))) (def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
(defn try-grammar [text] (defn try-grammar [text]
(assert (= (string/replace-all "dog" "purple panda" 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 good.")
(try-grammar "i have a dog called doug the dog. he is a good boy.") (try-grammar "i have a dog called doug the dog. he is a good boy.")
@@ -336,7 +336,7 @@
# unref # unref
# 96513665d # 96513665d
(def grammar (def grammar2
(peg/compile (peg/compile
~{:main (* :tagged -1) ~{:main (* :tagged -1)
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct)) :tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
@@ -344,9 +344,9 @@
:value (* (constant :value) (group (any (+ :tagged :untagged)))) :value (* (constant :value) (group (any (+ :tagged :untagged))))
:close-tag (* "</" (backmatch :tag-name) ">") :close-tag (* "</" (backmatch :tag-name) ">")
:untagged (capture (any (if-not "<" 1)))})) :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"]}]}]) @[{: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 # Using a large test grammar
# cf05ff610 # cf05ff610
@@ -369,7 +369,7 @@
(def sym (symbol text)) (def sym (symbol text))
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text]) [(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
(def grammar (def grammar3
~{:ws (set " \v\t\r\f\n\0") ~{:ws (set " \v\t\r\f\n\0")
:readermac (set "';~,") :readermac (set "';~,")
:symchars (+ (range "09" "AZ" "az" "\x80\xFF") :symchars (+ (range "09" "AZ" "az" "\x80\xFF")
@@ -408,13 +408,13 @@
:dict (* '"@" :struct) :dict (* '"@" :struct)
:main (+ :root (error ""))}) :main (+ :root (error ""))})
(def p (peg/compile grammar)) (def porig (peg/compile grammar3))
# Just make sure is valgrind clean. # 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 pprime "abc") "complex peg grammar 1")
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2") (assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
### ###
### Compiling brainfuck to Janet. ### Compiling brainfuck to Janet.
@@ -565,8 +565,8 @@
"peg/replace-all function") "peg/replace-all function")
# 9dc7e8ed3 # 9dc7e8ed3
(defn peg-test [name f peg subst text expected] (defn peg-test [name f pegg subst text expected]
(assert (= (string (f peg subst text)) expected) name)) (assert (= (string (f pegg subst text)) expected) name))
(peg-test "peg/replace has access to captures" (peg-test "peg/replace has access to captures"
peg/replace peg/replace
@@ -602,10 +602,10 @@
# Marshal and unmarshal pegs # Marshal and unmarshal pegs
# 446ab037b # 446ab037b
(def p (-> "abcd" peg/compile marshal unmarshal)) (def p3 (-> "abcd" peg/compile marshal unmarshal))
(assert (peg/match p "abcd") "peg marshal 1") (assert (peg/match p3 "abcd") "peg marshal 1")
(assert (peg/match p "abcdefg") "peg marshal 2") (assert (peg/match p3 "abcdefg") "peg marshal 2")
(assert (not (peg/match p "zabcdefg")) "peg marshal 3") (assert (not (peg/match p3 "zabcdefg")) "peg marshal 3")
# to/thru bug # to/thru bug
# issue #971 - a895219d2 # issue #971 - a895219d2
@@ -669,10 +669,10 @@
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello") (peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
@[]) "peg if not") @[]) "peg if not")
(defn test [name peg input expected] (defn test [name pegg input expected]
(assert-no-error "compile peg" (peg/compile peg)) (assert-no-error "compile peg" (peg/compile pegg))
(assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal)) (assert-no-error "marshal/unmarshal peg" (-> pegg marshal unmarshal))
(assert (deep= (peg/match peg input) expected) name)) (assert (deep= (peg/match pegg input) expected) name))
(test "sub: matches the same input twice" (test "sub: matches the same input twice"
~(sub "abcd" "abc") ~(sub "abcd" "abc")
@@ -852,20 +852,20 @@
@[["b" "b" "b"]]) @[["b" "b" "b"]])
# Debug and ?? tests. # 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 @""] (with-dyns [:err @""]
(test name peg input expected-matches)) (test name pegg input expected-matches))
(def actual @"") (def actual @"")
(with-dyns [:err actual *err-color* true] (with-dyns [:err actual *err-color* true]
(peg/match peg input)) (peg/match pegg input))
(assert (deep= (string actual) expected-stderr))) (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 @""] (with-dyns [:err @""]
(test name peg input expected-matches)) (test name pegg input expected-matches))
(def actual @"") (def actual @"")
(with-dyns [:err actual *err-color* false] (with-dyns [:err actual *err-color* false]
(peg/match peg input)) (peg/match pegg input))
(assert (deep= (string actual) expected-stderr))) (assert (deep= (string actual) expected-stderr)))
(test-stderr (test-stderr

View File

@@ -44,8 +44,8 @@
(def buftemp @"abcd") (def buftemp @"abcd")
(assert (= (string (buffer/format buftemp "---%p---" buftemp)) (assert (= (string (buffer/format buftemp "---%p---" buftemp))
`abcd---@"abcd"---`) "buffer/format on self 1") `abcd---@"abcd"---`) "buffer/format on self 1")
(def buftemp @"abcd") (def buftemp2 @"abcd")
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp)) (assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2") `abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
# 5c364e0 # 5c364e0
@@ -61,5 +61,86 @@
(check-jdn "a string") (check-jdn "a string")
(check-jdn @"a buffer") (check-jdn @"a buffer")
(end-suite) # Issue 1737
(assert (deep= "@[]" (string/format "%M" @[])))
(assert (deep= " @[]" (string/format " %M" @[])))
(assert (deep= " @[]" (string/format " %M" @[])))
(assert (deep= " @[]" (string/format " %M" @[])))
(assert (deep= " @[]" (string/format " %M" @[])))
(assert (deep= " @[]" (string/format " %M" @[])))
(assert (deep= "@[1]" (string/format "%m" @[1])))
(assert (deep= " @[2]" (string/format " %m" @[2])))
(assert (deep= " @[3]" (string/format " %m" @[3])))
(assert (deep= " @[4]" (string/format " %m" @[4])))
(assert (deep= " @[5]" (string/format " %m" @[5])))
(assert (deep= " @[6]" (string/format " %m" @[6])))
# 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 "%67m" {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 "%67p" {(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>}}`)))
# Issue 1737
(def capture-buf @"")
(with-dyns [*err* capture-buf]
(peg/match ~(* (constant @[]) (??)) "a"))
(assert (deep= ```
?? at [a] (index 0)
stack [1]:
[0]: @[]
```
(string capture-buf)))
(assert (=
(string/format "?? at [bc] (index 2)\nstack [5]:\n [0]: %m\n [1]: %m\n [2]: %m\n [3]: %m\n [4]: %m\n" "a" 1 true {} @[])
"?? at [bc] (index 2)\nstack [5]:\n [0]: \"a\"\n [1]: 1\n [2]: true\n [3]: {}\n [4]: @[]\n")
"pretty format should not eat explicit newlines")
(end-suite)

View File

@@ -132,11 +132,11 @@
# Cancel test # Cancel test
# 28439d822 # 28439d822
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti)) (def fc (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
(assert (= 1 (resume f)) "cancel resume 1") (assert (= 1 (resume fc)) "cancel resume 1")
(assert (= 2 (resume f)) "cancel resume 2") (assert (= 2 (resume fc)) "cancel resume 2")
(assert (= :hi (cancel f :hi)) "cancel resume 3") (assert (= :hi (cancel fc :hi)) "cancel resume 3")
(assert (= :error (fiber/status f)) "cancel resume 4") (assert (= :error (fiber/status fc)) "cancel resume 4")
(end-suite) (end-suite)

View File

@@ -0,0 +1,7 @@
(def p (parser/new))
(parser/consume p (slurp ((dyn :args) 1)))
(while (parser/has-more p)
(def x (parser/produce p))
(printf "%m\n%99M\n%1m\n%0M" x x x x)
(printf "%q\n%99Q\n%1p\n%P" x x x x)
(protect (printf "%j" x)))