mirror of
https://github.com/janet-lang/janet
synced 2026-04-01 20:41:27 +00:00
Compare commits
21 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
19e1dc494d | ||
|
|
c67dee7329 | ||
|
|
16f4f40d8e | ||
|
|
29474b915d | ||
|
|
ec5a78d3dc | ||
|
|
e42b3c667f | ||
|
|
93436bf973 | ||
|
|
df32109eea | ||
|
|
8b89901298 | ||
|
|
079776d39e | ||
|
|
6c2f08ef49 | ||
|
|
980999c97b | ||
|
|
1197cfe433 | ||
|
|
c63c6740d9 | ||
|
|
612971503d | ||
|
|
df56efbae0 | ||
|
|
b160f4f5c0 | ||
|
|
a0cc867f14 | ||
|
|
8f446736ed | ||
|
|
decd7078af | ||
|
|
b96350f132 |
2
.github/workflows/test.yml
vendored
2
.github/workflows/test.yml
vendored
@@ -12,7 +12,7 @@ jobs:
|
||||
runs-on: ${{ matrix.os }}
|
||||
strategy:
|
||||
matrix:
|
||||
os: [ ubuntu-latest, macos-latest, macos-14, macos-15-intel ]
|
||||
os: [ ubuntu-latest, ubuntu-24.04-arm, macos-latest, macos-14, macos-15-intel ]
|
||||
steps:
|
||||
- name: Checkout the repository
|
||||
uses: actions/checkout@master
|
||||
|
||||
@@ -2,10 +2,12 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add `file/sync` as a wrapper around fsync.
|
||||
- Add filewatch support to BSD and macos.
|
||||
- Add linting support for shadowed bindings.
|
||||
- Add nanboxing support for Linux on ARM64 and turn on nanboxing by default on macos on ARM64 (aarch64).
|
||||
- Documentation fixes
|
||||
- ev/thread-chan deadlock bug fixed
|
||||
- Re-add removed support for non-blocking net/connect on windows.
|
||||
- Re-add removed support for non-blocking net/connect on windows with bug fixes.
|
||||
|
||||
## 1.41.2 - 2026-02-18
|
||||
- Fix regressions in `put` for arrays and buffers.
|
||||
|
||||
@@ -37,6 +37,12 @@ may require changes before being merged.
|
||||
do this indentation, or approximate as close as possible. There is a janet formatter
|
||||
in [spork](https://github.com/janet-lang/spork.git) that can be used to format code as well.
|
||||
|
||||
Bot pull requests will not be accepted, and anonymous submissions, including
|
||||
new accounts, unknown emails, and first time contributors will be subjected
|
||||
to greater scrutiny and code reivew. Automatically generated and filed bug
|
||||
reports MAY be ok, if they are of consistent and good quality, such as
|
||||
OSSFuzz or well constructed CI pipelines.
|
||||
|
||||
## C style
|
||||
|
||||
For changes to the VM and Core code, you will probably need to know C. Janet is programmed with
|
||||
@@ -90,3 +96,18 @@ timely manner. In short, if you want extra functionality now, then build it.
|
||||
|
||||
* Include a good description of the problem that is being solved
|
||||
* Include descriptions of potential solutions if you have some in mind.
|
||||
|
||||
## LLMs, Tool Usage, and Transparency
|
||||
|
||||
All usage of Large Language Models (LLMs), Neural Networks, "AI" tools, and
|
||||
other tools such as software fuzzers or static analyzers must be disclosed.
|
||||
This applies to pull requests, email patches, bug reports, and any other
|
||||
meaningful contribution to Janet's source code. Please also refrain from using
|
||||
generative AI for code that will be embedded in the Janet runtime, which include
|
||||
all C source files as well as boot.janet. All code should be well
|
||||
and completely understood by the human author, including test cases. Large and
|
||||
obviously AI-driven changes will be rejected. Be mindful and transparent on the
|
||||
copyright implications of any submitted code. We will use discretion when
|
||||
accepting generated test cases for bug reproductions, one-line bug
|
||||
fixes, or typo fixes. Often, these can be trivially rewritten by a human to
|
||||
avoid the problem.
|
||||
|
||||
@@ -29,16 +29,14 @@ if DEFINED CLANG (
|
||||
@set COMPILER=cl.exe
|
||||
)
|
||||
if DEFINED SANITIZE (
|
||||
@set "SANITIZERS=/fsanitize=address /Zi"
|
||||
@set "LINK_SAN=/DEBUG"
|
||||
@set "SANITIZERS=/fsanitize=address"
|
||||
) else (
|
||||
@set "SANITIZERS="
|
||||
@set "LINK_SAN=/DEBUG"
|
||||
)
|
||||
@set JANET_COMPILE=%COMPILER% /nologo /Isrc\include /Isrc\conf /c /O2 /W3 /D_CRT_SECURE_NO_WARNINGS /MD %SANITIZERS%
|
||||
@set JANET_LINK=link /nologo %LINK_SAN%
|
||||
@set JANET_LINK=link /nologo
|
||||
|
||||
@set JANET_LINK_STATIC=lib /nologo %LINK_SAN%
|
||||
@set JANET_LINK_STATIC=lib /nologo
|
||||
|
||||
@rem Add janet build tag
|
||||
if not "%JANET_BUILD%" == "" (
|
||||
|
||||
@@ -3,10 +3,10 @@
|
||||
|
||||
(defn bork [x]
|
||||
|
||||
(defn bark [x]
|
||||
(defn bark [y]
|
||||
(print "Woof!")
|
||||
(print x)
|
||||
(error x)
|
||||
(print y)
|
||||
(error y)
|
||||
(print "Woof!"))
|
||||
|
||||
(bark (* 2 x))
|
||||
|
||||
14
examples/filewatch.janet
Normal file
14
examples/filewatch.janet
Normal file
@@ -0,0 +1,14 @@
|
||||
###
|
||||
### example/filewatch.janet ...files
|
||||
###
|
||||
### Watch for all changes in a list of files and directories. Behavior
|
||||
### depends on the filewatch module, and different operating systems will
|
||||
### report different events.
|
||||
|
||||
(def chan (ev/chan 1000))
|
||||
(def fw (filewatch/new chan))
|
||||
(each arg (drop 1 (dyn *args* []))
|
||||
(filewatch/add fw arg :all))
|
||||
(filewatch/listen fw)
|
||||
|
||||
(forever (let [event (ev/take chan)] (pp event)))
|
||||
@@ -7,13 +7,13 @@
|
||||
(print "simple yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
|
||||
(def f
|
||||
(def f2
|
||||
(coro
|
||||
(for i 0 10
|
||||
(yield (string "yield " i))
|
||||
(ev/sleep 0))))
|
||||
|
||||
(print "complex yielding")
|
||||
(each item f (print "got: " item ", now " (fiber/status f)))
|
||||
(each item f2 (print "got: " item ", now " (fiber/status f2)))
|
||||
|
||||
(print (fiber/status f))
|
||||
(print (fiber/status f2))
|
||||
|
||||
@@ -4,7 +4,7 @@
|
||||
# that must be called (realizing it), and the memoized.
|
||||
# Use with (import "./path/to/this/file" :prefix "seq.")
|
||||
|
||||
(defmacro delay
|
||||
(defmacro dolazy
|
||||
"Lazily evaluate a series of expressions. Returns a function that
|
||||
returns the result of the last expression. Will only evaluate the
|
||||
body once, and then memoizes the result."
|
||||
@@ -35,7 +35,7 @@
|
||||
(def x (tuple h t))
|
||||
(fn [] x))
|
||||
|
||||
(defn empty?
|
||||
(defn lazy-empty?
|
||||
"Check if a sequence is empty."
|
||||
[s]
|
||||
(not (s)))
|
||||
@@ -55,14 +55,14 @@
|
||||
[start end &]
|
||||
(if end
|
||||
(if (< start end)
|
||||
(delay (tuple start (lazy-range (+ 1 start) end)))
|
||||
(dolazy (tuple start (lazy-range (+ 1 start) end)))
|
||||
empty-seq)
|
||||
(lazy-range 0 start)))
|
||||
|
||||
(defn lazy-map
|
||||
"Return a sequence that is the result of applying f to each value in s."
|
||||
[f s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if x (tuple (f (get x HEAD)) (map f (get x TAIL))))))
|
||||
|
||||
@@ -76,31 +76,31 @@
|
||||
[f s]
|
||||
(when (s) (f (head s)) (realize-map f (tail s))))
|
||||
|
||||
(defn drop
|
||||
(defn lazy-drop
|
||||
"Ignores the first n values of the sequence and returns the rest."
|
||||
[n s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if (and x (pos? n)) ((drop (- n 1) (get x TAIL))))))
|
||||
(if (and x (pos? n)) ((lazy-drop (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn take
|
||||
(defn lazy-take
|
||||
"Returns at most the first n values of s."
|
||||
[n s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(if (and x (pos? n))
|
||||
(tuple (get x HEAD) (take (- n 1) (get x TAIL))))))
|
||||
(tuple (get x HEAD) (lazy-take (- n 1) (get x TAIL))))))
|
||||
|
||||
(defn randseq
|
||||
"Return a sequence of random numbers."
|
||||
[]
|
||||
(delay (tuple (math/random) (randseq))))
|
||||
(dolazy (tuple (math/random) (randseq))))
|
||||
|
||||
(defn take-while
|
||||
(defn lazy-take-while
|
||||
"Returns a sequence of values until the predicate is false."
|
||||
[pred s]
|
||||
(delay
|
||||
(dolazy
|
||||
(def x (s))
|
||||
(when x
|
||||
(def thehead (get HEAD x))
|
||||
(if thehead (tuple thehead (take-while pred (get TAIL x)))))))
|
||||
(if thehead (tuple thehead (lazy-take-while pred (get TAIL x)))))))
|
||||
|
||||
@@ -16,8 +16,8 @@
|
||||
(def cell-set (frequencies state))
|
||||
(def neighbor-set (frequencies (mapcat neighbors state)))
|
||||
(seq [coord :keys neighbor-set
|
||||
:let [count (get neighbor-set coord)]
|
||||
:when (or (= count 3) (and (get cell-set coord) (= count 2)))]
|
||||
:let [ncount (get neighbor-set coord)]
|
||||
:when (or (= ncount 3) (and (get cell-set coord) (= ncount 2)))]
|
||||
coord))
|
||||
|
||||
(defn draw
|
||||
|
||||
@@ -72,6 +72,9 @@ conf.set_quoted('JANET_VERSION', meson.project_version())
|
||||
# Use options
|
||||
conf.set_quoted('JANET_BUILD', get_option('git_hash'))
|
||||
conf.set('JANET_NO_NANBOX', not get_option('nanbox'))
|
||||
if get_option('nanbox_pointer_shift') != -1 # -1 is auto-detect
|
||||
conf.set('JANET_NANBOX_64_POINTER_SHIFT', get_option('nanbox_pointer_shift'))
|
||||
endif
|
||||
conf.set('JANET_SINGLE_THREADED', get_option('single_threaded'))
|
||||
conf.set('JANET_NO_DYNAMIC_MODULES', not get_option('dynamic_modules'))
|
||||
conf.set('JANET_NO_DOCSTRINGS', not get_option('docstrings'))
|
||||
|
||||
@@ -2,6 +2,7 @@ option('git_hash', type : 'string', value : 'meson')
|
||||
|
||||
option('single_threaded', type : 'boolean', value : false)
|
||||
option('nanbox', type : 'boolean', value : true)
|
||||
option('nanbox_pointer_shift', type : 'integer', min : -1, max : 4, value : -1)
|
||||
option('dynamic_modules', type : 'boolean', value : true)
|
||||
option('docstrings', type : 'boolean', value : true)
|
||||
option('sourcemaps', type : 'boolean', value : true)
|
||||
|
||||
@@ -46,7 +46,6 @@
|
||||
(defn defmacro :macro :flycheck
|
||||
"Define a macro."
|
||||
[name & more]
|
||||
(setdyn name @{}) # override old macro definitions in the case of a recursive macro
|
||||
(apply defn name :macro more))
|
||||
|
||||
(defmacro as-macro
|
||||
@@ -219,9 +218,9 @@
|
||||
|
||||
(defmacro default
|
||||
``Define a default value for an optional argument.
|
||||
Expands to `(def sym (if (= nil sym) val sym))`.``
|
||||
Expands to `(def sym :shadow (if (= nil sym) val sym))`.``
|
||||
[sym val]
|
||||
~(def ,sym (if (,= nil ,sym) ,val ,sym)))
|
||||
~(def ,sym :shadow (if (,= nil ,sym) ,val ,sym)))
|
||||
|
||||
(defmacro comment
|
||||
"Ignores the body of the comment."
|
||||
@@ -443,11 +442,36 @@
|
||||
(def ,binding ,ctor)
|
||||
,(defer-impl :with [(or dtor :close) binding] body)))
|
||||
|
||||
# declare ahead of time
|
||||
(var- macexvar nil)
|
||||
|
||||
(defmacro if-let
|
||||
``Make multiple bindings, and if all are truthy,
|
||||
evaluate the `tru` form. If any are false or nil, evaluate
|
||||
the `fal` form. Bindings have the same syntax as the `let` macro.``
|
||||
[bindings tru &opt fal]
|
||||
(def len (length bindings))
|
||||
(if (= 0 len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
(def fal2 (if macexvar (macexvar fal) fal))
|
||||
(defn aux [i]
|
||||
(if (>= i len)
|
||||
tru
|
||||
(do
|
||||
(def bl (in bindings i))
|
||||
(def br (in bindings (+ 1 i)))
|
||||
(if (symbol? bl)
|
||||
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
|
||||
~(if (def ,(def sym (gensym)) ,br)
|
||||
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||
,fal2)))))
|
||||
(aux 0))
|
||||
|
||||
(defmacro when-with
|
||||
``Similar to with, but if binding is false or nil, returns
|
||||
nil without evaluating the body. Otherwise, the same as `with`.``
|
||||
[[binding ctor dtor] & body]
|
||||
~(if-let [,binding ,ctor]
|
||||
~(as-macro ,if-let [,binding ,ctor]
|
||||
,(defer-impl :when-with [(or dtor :close) binding] body)))
|
||||
|
||||
(defmacro if-with
|
||||
@@ -455,7 +479,7 @@
|
||||
the falsey path. Otherwise, evaluates the truthy path. In both cases,
|
||||
`ctor` is bound to binding.``
|
||||
[[binding ctor dtor] truthy &opt falsey]
|
||||
~(if-let [,binding ,ctor]
|
||||
~(as-macro ,if-let [,binding ,ctor]
|
||||
,(defer-impl :if-with [(or dtor :close) binding] [truthy])
|
||||
,falsey))
|
||||
|
||||
@@ -539,13 +563,13 @@
|
||||
(case binding
|
||||
:until ~(do (if ,verb (break) nil) ,rest)
|
||||
:while ~(do (if ,verb nil (break)) ,rest)
|
||||
:let ~(let ,verb (do ,rest))
|
||||
:let ~(as-macro ,let ,verb (do ,rest))
|
||||
:after ~(do ,rest ,verb nil)
|
||||
:before ~(do ,verb ,rest nil)
|
||||
:repeat (with-syms [iter]
|
||||
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
|
||||
:when ~(when ,verb ,rest)
|
||||
:unless ~(unless ,verb ,rest)
|
||||
~(do (var ,iter ,verb) (while (,> ,iter 0) ,rest (as-macro ,-- ,iter))))
|
||||
:when ~(as-macro ,when ,verb ,rest)
|
||||
:unless ~(as-macro ,unless ,verb ,rest)
|
||||
(error (string "unexpected loop modifier " binding))))))
|
||||
|
||||
# 3 term expression
|
||||
@@ -587,7 +611,7 @@
|
||||
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
|
||||
[n & body]
|
||||
(with-syms [iter]
|
||||
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
|
||||
~(do (var ,iter ,n) (while (,> ,iter 0) ,;body (as-macro ,-- ,iter)))))
|
||||
|
||||
(defmacro forever
|
||||
"Evaluate body forever in a loop, or until a break statement."
|
||||
@@ -683,7 +707,7 @@
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(check-empty-body body)
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
|
||||
~(do (def ,$accum @[]) (as-macro ,loop ,head (,array/push ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro catseq
|
||||
``Similar to `loop`, but concatenates each element from the loop body into an array and returns that.
|
||||
@@ -691,21 +715,21 @@
|
||||
[head & body]
|
||||
(def $accum (gensym))
|
||||
(check-empty-body body)
|
||||
~(do (def ,$accum @[]) (loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
|
||||
~(do (def ,$accum @[]) (as-macro ,loop ,head (,array/concat ,$accum (do ,;body))) ,$accum))
|
||||
|
||||
(defmacro tabseq
|
||||
``Similar to `loop`, but accumulates key value pairs into a table.
|
||||
See `loop` for details.``
|
||||
[head key-body & value-body]
|
||||
(def $accum (gensym))
|
||||
~(do (def ,$accum @{}) (loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
|
||||
~(do (def ,$accum @{}) (as-macro ,loop ,head (,put ,$accum ,key-body (do ,;value-body))) ,$accum))
|
||||
|
||||
(defmacro generate
|
||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See `loop` for details.``
|
||||
[head & body]
|
||||
(check-empty-body body)
|
||||
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
~(,fiber/new (fn :generate [] (as-macro ,loop ,head (,yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||
@@ -754,35 +778,10 @@
|
||||
(each x xs (*= accum x))
|
||||
accum)
|
||||
|
||||
# declare ahead of time
|
||||
(var- macexvar nil)
|
||||
|
||||
(defmacro if-let
|
||||
``Make multiple bindings, and if all are truthy,
|
||||
evaluate the `tru` form. If any are false or nil, evaluate
|
||||
the `fal` form. Bindings have the same syntax as the `let` macro.``
|
||||
[bindings tru &opt fal]
|
||||
(def len (length bindings))
|
||||
(if (= 0 len) (error "expected at least 1 binding"))
|
||||
(if (odd? len) (error "expected an even number of bindings"))
|
||||
(def fal2 (if macexvar (macexvar fal) fal))
|
||||
(defn aux [i]
|
||||
(if (>= i len)
|
||||
tru
|
||||
(do
|
||||
(def bl (in bindings i))
|
||||
(def br (in bindings (+ 1 i)))
|
||||
(if (symbol? bl)
|
||||
~(if (def ,bl ,br) ,(aux (+ 2 i)) ,fal2)
|
||||
~(if (def ,(def sym (gensym)) ,br)
|
||||
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||
,fal2)))))
|
||||
(aux 0))
|
||||
|
||||
(defmacro when-let
|
||||
"Same as `(if-let bindings (do ;body))`."
|
||||
[bindings & body]
|
||||
~(if-let ,bindings (do ,;body)))
|
||||
~(as-macro ,if-let ,bindings (do ,;body)))
|
||||
|
||||
(defn comp
|
||||
`Takes multiple functions and returns a function that is the composition
|
||||
@@ -1432,7 +1431,7 @@
|
||||
(tuple n @[])))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h sym] t))
|
||||
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defmacro -?>>
|
||||
@@ -1448,7 +1447,7 @@
|
||||
(tuple n @[])))
|
||||
(def sym (gensym))
|
||||
(def parts (array/concat @[h] t @[sym]))
|
||||
~(let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
~(as-macro ,let [,sym ,last] (if ,sym ,(keep-syntax! n parts))))
|
||||
(reduce fop x forms))
|
||||
|
||||
(defn- walk-ind [f form]
|
||||
@@ -2411,8 +2410,8 @@
|
||||
(dictionary? m) (merge-into metadata m)
|
||||
(error (string "invalid metadata " m))))
|
||||
(with-syms [entry old-entry f]
|
||||
~(let [,old-entry (,dyn ',name)]
|
||||
(def ,entry (or ,old-entry @{:ref @[nil]}))
|
||||
~(as-macro ,let [,old-entry (,dyn ',name)]
|
||||
(def ,entry (as-macro ,or ,old-entry @{:ref @[nil]}))
|
||||
(,setdyn ',name ,entry)
|
||||
(def ,f ,fbody)
|
||||
(,put-in ,entry [:ref 0] ,f)
|
||||
@@ -2675,17 +2674,17 @@
|
||||
(var resumeval nil)
|
||||
(def f
|
||||
(fiber/new
|
||||
(fn []
|
||||
(fn :compile-and-lint []
|
||||
(array/clear lints)
|
||||
(def res (compile source env where lints))
|
||||
(unless (empty? lints)
|
||||
(when (next lints)
|
||||
# Convert lint levels to numbers.
|
||||
(def levels (get env *lint-levels* lint-levels))
|
||||
(def lint-error (get env *lint-error*))
|
||||
(def lint-warning (get env *lint-warn*))
|
||||
(def lint-error (or (get levels lint-error lint-error) 0))
|
||||
(def lint-warning (or (get levels lint-warning lint-warning) 2))
|
||||
(each [level line col msg] lints
|
||||
(each [level line col msg] (distinct lints) # some macros might cause code to be duplicated. Avoid repeated messages.
|
||||
(def lvl (get lint-levels level 0))
|
||||
(cond
|
||||
(<= lvl lint-error) (do
|
||||
@@ -3953,7 +3952,7 @@
|
||||
``
|
||||
[sec & body]
|
||||
(with-syms [f]
|
||||
~(let [,f (coro ,;body)]
|
||||
~(as-macro ,let [,f (as-macro ,coro ,;body)]
|
||||
(,ev/deadline ,sec nil ,f)
|
||||
(,resume ,f))))
|
||||
|
||||
@@ -4085,15 +4084,15 @@
|
||||
(defn make-ptr []
|
||||
(assertf (ffi/lookup (if lazy (llib) lib) raw-symbol) "failed to find ffi symbol %v" raw-symbol))
|
||||
(if lazy
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
~(as-macro ,defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
~(as-macro ,defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
|
||||
|
||||
(defmacro ffi/defbind :flycheck
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||
~(as-macro ,ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||
|
||||
###
|
||||
###
|
||||
|
||||
@@ -16,6 +16,7 @@
|
||||
/* #define JANET_THREAD_LOCAL _Thread_local */
|
||||
/* #define JANET_NO_DYNAMIC_MODULES */
|
||||
/* #define JANET_NO_NANBOX */
|
||||
/* #define JANET_NANBOX_64_POINTER_SHIFT 0 */
|
||||
/* #define JANET_API __attribute__((visibility ("default"))) */
|
||||
|
||||
/* These settings should be specified before amalgamation is
|
||||
|
||||
@@ -1110,6 +1110,7 @@ JANET_CORE_FN(cfun_disasm,
|
||||
if (!janet_cstrcmp(kw, "structarg")) return janet_disasm_structarg(f->def);
|
||||
if (!janet_cstrcmp(kw, "namedargs")) return janet_disasm_namedargs(f->def);
|
||||
if (!janet_cstrcmp(kw, "slotcount")) return janet_disasm_slotcount(f->def);
|
||||
if (!janet_cstrcmp(kw, "symbolmap")) return janet_disasm_symbolslots(f->def);
|
||||
if (!janet_cstrcmp(kw, "constants")) return janet_disasm_constants(f->def);
|
||||
if (!janet_cstrcmp(kw, "sourcemap")) return janet_disasm_sourcemap(f->def);
|
||||
if (!janet_cstrcmp(kw, "environments")) return janet_disasm_environments(f->def);
|
||||
|
||||
@@ -29,7 +29,7 @@
|
||||
#endif
|
||||
|
||||
/* Look up table for instructions */
|
||||
enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
|
||||
JINT_0, /* JOP_NOOP, */
|
||||
JINT_S, /* JOP_ERROR, */
|
||||
JINT_ST, /* JOP_TYPECHECK, */
|
||||
|
||||
@@ -91,29 +91,38 @@ void janetc_freeslot(JanetCompiler *c, JanetSlot s) {
|
||||
}
|
||||
|
||||
/* Add a slot to a scope with a symbol associated with it (def or var). */
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags) {
|
||||
if (!(flags & JANET_DEFFLAG_NO_SHADOWCHECK)) {
|
||||
if (sym[0] != '_') {
|
||||
switch (janetc_shadowcheck(c, sym)) {
|
||||
default:
|
||||
break;
|
||||
case JANETC_SHADOW_MACRO:
|
||||
janetc_lintf(c, JANET_C_LINT_NORMAL, "binding %q is shadowing a macro", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_LOCAL_HIDES_LOCAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_LOCAL_HIDES_GLOBAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "binding %q is shadowing a top-level binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
case JANETC_SHADOW_GLOBAL_HIDES_GLOBAL:
|
||||
janetc_lintf(c, JANET_C_LINT_STRICT, "top-level binding %q is shadowing another top-level binding", janet_wrap_symbol(sym));
|
||||
break;
|
||||
}
|
||||
}
|
||||
}
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.referenced = sym[0] == '_'; /* Fake ref if symbol is _ to avoid lints */
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
janet_v_push(c->scope->syms, sp);
|
||||
}
|
||||
|
||||
/* Same as janetc_nameslot, but don't have a lint for unused bindings. */
|
||||
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s) {
|
||||
SymPair sp;
|
||||
int32_t cnt = janet_v_count(c->buffer);
|
||||
sp.sym = sym;
|
||||
sp.sym2 = sym;
|
||||
sp.slot = s;
|
||||
sp.keep = 0;
|
||||
sp.referenced = 1;
|
||||
if (flags & JANET_DEFFLAG_NO_UNUSED) {
|
||||
sp.referenced = 1;
|
||||
} else {
|
||||
sp.referenced = sym[0] == '_'; /* Fake ref if symbol starts with _ to avoid lints */
|
||||
}
|
||||
sp.slot.flags |= JANET_SLOT_NAMED;
|
||||
sp.birth_pc = cnt ? cnt - 1 : 0;
|
||||
sp.death_pc = UINT32_MAX;
|
||||
@@ -260,6 +269,38 @@ static int lookup_missing(
|
||||
return 1;
|
||||
}
|
||||
|
||||
/* Check if a binding is defined in an upper scope. This lets us check for
|
||||
* variable shadowing. */
|
||||
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym) {
|
||||
/* Check locals */
|
||||
JanetScope *scope = c->scope;
|
||||
int is_global = (scope->flags & JANET_SCOPE_TOP);
|
||||
while (scope) {
|
||||
int32_t len = janet_v_count(scope->syms);
|
||||
for (int32_t i = len - 1; i >= 0; i--) {
|
||||
SymPair *pair = scope->syms + i;
|
||||
if (pair->sym == sym) {
|
||||
janet_assert(!is_global, "shadowing analysis is incorrect. compiler bug");
|
||||
return JANETC_SHADOW_LOCAL_HIDES_LOCAL;
|
||||
}
|
||||
}
|
||||
scope = scope->parent;
|
||||
}
|
||||
/* Check globals */
|
||||
JanetBinding binding = janet_resolve_ext(c->env, sym);
|
||||
if (binding.type == JANET_BINDING_MACRO || binding.type == JANET_BINDING_DYNAMIC_MACRO) {
|
||||
return JANETC_SHADOW_MACRO;
|
||||
} else if (binding.type == JANET_BINDING_NONE) {
|
||||
return JANETC_SHADOW_NONE;
|
||||
} else {
|
||||
if (is_global) {
|
||||
return JANETC_SHADOW_GLOBAL_HIDES_GLOBAL;
|
||||
} else {
|
||||
return JANETC_SHADOW_LOCAL_HIDES_GLOBAL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Allow searching for symbols. Return information about the symbol */
|
||||
JanetSlot janetc_resolve(
|
||||
JanetCompiler *c,
|
||||
@@ -1103,6 +1144,7 @@ static void janetc_init(JanetCompiler *c, JanetTable *env, const uint8_t *where,
|
||||
c->current_mapping.line = -1;
|
||||
c->current_mapping.column = -1;
|
||||
c->lints = lints;
|
||||
c->is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
/* Init result */
|
||||
c->result.error = NULL;
|
||||
c->result.status = JANET_COMPILE_OK;
|
||||
|
||||
@@ -36,6 +36,15 @@ typedef enum {
|
||||
JANET_C_LINT_STRICT
|
||||
} JanetCompileLintLevel;
|
||||
|
||||
/* Kinds of variable shadowing for linting */
|
||||
typedef enum {
|
||||
JANETC_SHADOW_NONE,
|
||||
JANETC_SHADOW_MACRO,
|
||||
JANETC_SHADOW_GLOBAL_HIDES_GLOBAL,
|
||||
JANETC_SHADOW_LOCAL_HIDES_GLOBAL,
|
||||
JANETC_SHADOW_LOCAL_HIDES_LOCAL
|
||||
} Shadowing;
|
||||
|
||||
/* Tags for some functions for the prepared inliner */
|
||||
#define JANET_FUN_DEBUG 1
|
||||
#define JANET_FUN_ERROR 2
|
||||
@@ -184,6 +193,9 @@ struct JanetCompiler {
|
||||
|
||||
/* Collect linting results */
|
||||
JanetArray *lints;
|
||||
|
||||
/* Cached version of (dyn *redef*) */
|
||||
int is_redef;
|
||||
};
|
||||
|
||||
#define JANET_FOPTS_TAIL 0x10000
|
||||
@@ -221,9 +233,11 @@ const JanetFunOptimizer *janetc_funopt(uint32_t flags);
|
||||
/* Get a special. Return NULL if none exists */
|
||||
const JanetSpecial *janetc_special(const uint8_t *name);
|
||||
|
||||
#define JANET_DEFFLAG_NO_SHADOWCHECK 1
|
||||
#define JANET_DEFFLAG_NO_UNUSED 2
|
||||
|
||||
void janetc_freeslot(JanetCompiler *c, JanetSlot s);
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||
void janetc_nameslot_no_unused(JanetCompiler *c, const uint8_t *sym, JanetSlot s);
|
||||
void janetc_nameslot(JanetCompiler *c, const uint8_t *sym, JanetSlot s, uint32_t flags);
|
||||
JanetSlot janetc_farslot(JanetCompiler *c);
|
||||
|
||||
/* Throw away some code after checking that it is well formed. */
|
||||
@@ -267,9 +281,12 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c);
|
||||
/* Create a destroy slot */
|
||||
JanetSlot janetc_cslot(Janet x);
|
||||
|
||||
/* Search for a symbol */
|
||||
/* Search for a symbol, and mark any found symbols as "used" for dead code elimination and linting */
|
||||
JanetSlot janetc_resolve(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Check if a symbol is already in scope for shadowing lints */
|
||||
Shadowing janetc_shadowcheck(JanetCompiler *c, const uint8_t *sym);
|
||||
|
||||
/* Bytecode optimization */
|
||||
void janet_bytecode_movopt(JanetFuncDef *def);
|
||||
void janet_bytecode_remove_noops(JanetFuncDef *def);
|
||||
|
||||
@@ -70,7 +70,7 @@ JanetModule janet_native(const char *name, const uint8_t **error) {
|
||||
host.minor != modconf.minor ||
|
||||
host.bits != modconf.bits) {
|
||||
char errbuf[128];
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x)",
|
||||
snprintf(errbuf, sizeof(errbuf), "config mismatch - host %d.%.d.%d(%.4x) vs. module %d.%d.%d(%.4x) - native needs to be recompiled!",
|
||||
host.major,
|
||||
host.minor,
|
||||
host.patch,
|
||||
|
||||
@@ -968,7 +968,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
|
||||
JanetVM *vm = reader.thread;
|
||||
if (!vm) continue;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = reader.mode;
|
||||
msg.fiber = reader.fiber;
|
||||
msg.argi = (int32_t) reader.sched_id;
|
||||
@@ -986,7 +986,7 @@ static void janet_thread_chan_cb(JanetEVGenericMessage msg) {
|
||||
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
|
||||
JanetVM *vm = writer.thread;
|
||||
if (!vm) continue;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = writer.mode;
|
||||
msg.fiber = writer.fiber;
|
||||
msg.argi = (int32_t) writer.sched_id;
|
||||
@@ -1052,7 +1052,7 @@ static int janet_channel_push_with_lock(JanetChannel *channel, Janet x, int mode
|
||||
/* Pending reader */
|
||||
if (is_threaded) {
|
||||
JanetVM *vm = reader.thread;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = reader.mode;
|
||||
msg.fiber = reader.fiber;
|
||||
msg.argi = (int32_t) reader.sched_id;
|
||||
@@ -1112,7 +1112,7 @@ static int janet_channel_pop_with_lock(JanetChannel *channel, Janet *item, int i
|
||||
/* Pending writer */
|
||||
if (is_threaded) {
|
||||
JanetVM *vm = writer.thread;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.tag = writer.mode;
|
||||
msg.fiber = writer.fiber;
|
||||
msg.argi = (int32_t) writer.sched_id;
|
||||
@@ -1172,7 +1172,7 @@ JanetChannel *janet_channel_make(uint32_t limit) {
|
||||
JanetChannel *janet_channel_make_threaded(uint32_t limit) {
|
||||
janet_assert(limit <= INT32_MAX, "bad limit");
|
||||
JanetChannel *channel = janet_abstract_threaded(&janet_channel_type, sizeof(JanetChannel));
|
||||
janet_chan_init(channel, (int32_t) limit, 0);
|
||||
janet_chan_init(channel, (int32_t) limit, 1);
|
||||
return channel;
|
||||
}
|
||||
|
||||
@@ -1364,7 +1364,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
while (!janet_q_pop(&channel->write_pending, &writer, sizeof(writer))) {
|
||||
if (writer.thread != &janet_vm) {
|
||||
JanetVM *vm = writer.thread;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.fiber = writer.fiber;
|
||||
msg.argp = channel;
|
||||
msg.tag = JANET_CP_MODE_CLOSE;
|
||||
@@ -1387,7 +1387,7 @@ JANET_CORE_FN(cfun_channel_close,
|
||||
while (!janet_q_pop(&channel->read_pending, &reader, sizeof(reader))) {
|
||||
if (reader.thread != &janet_vm) {
|
||||
JanetVM *vm = reader.thread;
|
||||
JanetEVGenericMessage msg = {0};
|
||||
JanetEVGenericMessage msg;
|
||||
msg.fiber = reader.fiber;
|
||||
msg.argp = channel;
|
||||
msg.tag = JANET_CP_MODE_CLOSE;
|
||||
@@ -1722,7 +1722,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp to) {
|
||||
}
|
||||
if (fiber != NULL) {
|
||||
fiber->flags &= ~JANET_FIBER_EV_FLAG_IN_FLIGHT;
|
||||
jo->bytes_transferred = (ULONG_PTR) num_bytes_transferred;
|
||||
jo->bytes_transfered = (ULONG_PTR) num_bytes_transferred;
|
||||
fiber->ev_callback(fiber, result ? JANET_ASYNC_EVENT_COMPLETE : JANET_ASYNC_EVENT_FAILED);
|
||||
} else {
|
||||
janet_free((void *) jo);
|
||||
@@ -1962,7 +1962,7 @@ void janet_stream_level_triggered(JanetStream *stream) {
|
||||
janet_register_stream_impl(stream, 0);
|
||||
}
|
||||
|
||||
#define JANET_KQUEUE_MAX_EVENTS 64
|
||||
#define JANET_KQUEUE_MAX_EVENTS 512
|
||||
|
||||
void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
/* Poll for events */
|
||||
@@ -2026,6 +2026,7 @@ void janet_loop1_impl(int has_timeout, JanetTimestamp timeout) {
|
||||
|
||||
void janet_ev_init(void) {
|
||||
janet_ev_init_common();
|
||||
/* TODO - replace selfpipe with EVFILT_USER (or other events) */
|
||||
janet_ev_setup_selfpipe();
|
||||
janet_vm.kq = kqueue();
|
||||
janet_vm.timer_enabled = 0;
|
||||
@@ -2257,14 +2258,11 @@ static DWORD WINAPI janet_thread_body(LPVOID ptr) {
|
||||
/* Reuse memory from thread init for returning data */
|
||||
init->msg = subr(msg);
|
||||
init->cb = cb;
|
||||
BOOL result = PostQueuedCompletionStatus(iocp,
|
||||
janet_assert(PostQueuedCompletionStatus(iocp,
|
||||
sizeof(JanetSelfPipeEvent),
|
||||
0,
|
||||
(LPOVERLAPPED) init);
|
||||
if (!result) {
|
||||
JanetString x = janet_formatc("failed to post completion event: %V", janet_ev_lasterr());
|
||||
janet_assert(0, (const char *)x);
|
||||
}
|
||||
(LPOVERLAPPED) init),
|
||||
"failed to post completion event");
|
||||
return 0;
|
||||
}
|
||||
#else
|
||||
@@ -2366,7 +2364,8 @@ void janet_ev_default_threaded_callback(JanetEVGenericMessage return_value) {
|
||||
/* Convenience method for common case */
|
||||
JANET_NO_RETURN
|
||||
void janet_ev_threaded_await(JanetThreadedSubroutine fp, int tag, int argi, void *argp) {
|
||||
JanetEVGenericMessage arguments = {0};
|
||||
JanetEVGenericMessage arguments;
|
||||
memset(&arguments, 0, sizeof(arguments));
|
||||
arguments.tag = tag;
|
||||
arguments.argi = argi;
|
||||
arguments.argp = argp;
|
||||
@@ -2474,7 +2473,7 @@ void ev_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
case JANET_ASYNC_EVENT_FAILED:
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
/* Called when read finished */
|
||||
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transferred;
|
||||
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
|
||||
state->bytes_read += ev_bytes;
|
||||
if (state->bytes_read == 0 && (state->mode != JANET_ASYNC_READMODE_RECVFROM)) {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
@@ -2724,7 +2723,7 @@ void ev_callback_write(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
case JANET_ASYNC_EVENT_FAILED:
|
||||
case JANET_ASYNC_EVENT_COMPLETE: {
|
||||
/* Called when write finished */
|
||||
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transferred;
|
||||
uint32_t ev_bytes = (uint32_t) state->overlapped.bytes_transfered;
|
||||
if (ev_bytes == 0 && (state->mode != JANET_ASYNC_WRITEMODE_SENDTO)) {
|
||||
janet_cancel(fiber, janet_cstringv("disconnect"));
|
||||
janet_async_end(fiber);
|
||||
@@ -3208,7 +3207,8 @@ JANET_CORE_FN(cfun_ev_thread,
|
||||
janet_marshal(buffer, value, NULL, JANET_MARSHAL_UNSAFE);
|
||||
if (flags & 0x1) {
|
||||
/* Return immediately */
|
||||
JanetEVGenericMessage arguments = {0};
|
||||
JanetEVGenericMessage arguments;
|
||||
memset(&arguments, 0, sizeof(arguments));
|
||||
arguments.tag = (uint32_t) flags;
|
||||
arguments.argi = (uint32_t) janet_vm.sandbox_flags;
|
||||
arguments.argp = buffer;
|
||||
|
||||
@@ -38,6 +38,13 @@
|
||||
#include <windows.h>
|
||||
#endif
|
||||
|
||||
#if defined(JANET_APPLE) || defined(JANET_BSD)
|
||||
#include <sys/event.h>
|
||||
#include <sys/stat.h>
|
||||
#include <unistd.h>
|
||||
#include <fcntl.h>
|
||||
#endif
|
||||
|
||||
typedef struct {
|
||||
const char *name;
|
||||
uint32_t flag;
|
||||
@@ -89,7 +96,7 @@ static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
||||
sizeof(JanetWatchFlagName),
|
||||
keyw);
|
||||
if (!result) {
|
||||
janet_panicf("unknown inotify flag %v", options[i]);
|
||||
janet_panicf("unknown linux flag %v", options[i]);
|
||||
}
|
||||
flags |= result->flag;
|
||||
}
|
||||
@@ -128,8 +135,11 @@ static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t
|
||||
|
||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, janet_cstringv(path));
|
||||
janet_assert(janet_checktype(check, JANET_NUMBER), "bad watch descriptor");
|
||||
Janet pathv = janet_cstringv(path);
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
|
||||
if (!janet_checktype(check, JANET_NUMBER)) {
|
||||
janet_panic("bad watch descriptor");
|
||||
}
|
||||
int watch_handle = janet_unwrap_integer(check);
|
||||
int result;
|
||||
do {
|
||||
@@ -138,6 +148,10 @@ static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (result == -1) {
|
||||
janet_panicv(janet_ev_lasterr());
|
||||
}
|
||||
/*
|
||||
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
|
||||
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(watch_handle), janet_wrap_nil());
|
||||
*/
|
||||
}
|
||||
|
||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
@@ -500,6 +514,254 @@ static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
#elif defined(JANET_APPLE) || defined(JANET_BSD)
|
||||
|
||||
/* kqueue implementation */
|
||||
|
||||
/* Cribbed from ev.c */
|
||||
#define EV_SETx(ev, a, b, c, d, e, f) EV_SET((ev), (a), (b), (c), (d), (e), ((__typeof__((ev)->udata))(f)))
|
||||
|
||||
/* Different BSDs define different NOTE_* constants for different kinds of events. Use ifdef to
|
||||
determine when they are available (assuming they are defines and not enums */
|
||||
static const JanetWatchFlagName watcher_flags_kqueue[] = {
|
||||
{
|
||||
"all", NOTE_ATTRIB | NOTE_DELETE | NOTE_EXTEND | NOTE_RENAME | NOTE_REVOKE | NOTE_WRITE | NOTE_LINK
|
||||
#ifdef NOTE_CLOSE
|
||||
| NOTE_CLOSE
|
||||
#endif
|
||||
#ifdef NOTE_CLOSE_WRITE
|
||||
| NOTE_CLOSE_WRITE
|
||||
#endif
|
||||
#ifdef NOTE_OPEN
|
||||
| NOTE_OPEN
|
||||
#endif
|
||||
#ifdef NOTE_READ
|
||||
| NOTE_READ
|
||||
#endif
|
||||
#ifdef NOTE_FUNLOCK
|
||||
| NOTE_FUNLOCK
|
||||
#endif
|
||||
#ifdef NOTE_TRUNCATE
|
||||
| NOTE_TRUNCATE
|
||||
#endif
|
||||
},
|
||||
{"attrib", NOTE_ATTRIB},
|
||||
#ifdef NOTE_CLOSE
|
||||
{"close", NOTE_CLOSE},
|
||||
#endif
|
||||
#ifdef NOTE_CLOSE_WRITE
|
||||
{"close-write", NOTE_CLOSE_WRITE},
|
||||
#endif
|
||||
{"delete", NOTE_DELETE},
|
||||
{"extend", NOTE_EXTEND},
|
||||
#ifdef NOTE_FUNLOCK
|
||||
{"funlock", NOTE_FUNLOCK},
|
||||
#endif
|
||||
{"link", NOTE_LINK},
|
||||
#ifdef NOTE_OPEN
|
||||
{"open", NOTE_OPEN},
|
||||
#endif
|
||||
#ifdef NOTE_READ
|
||||
{"read", NOTE_READ},
|
||||
#endif
|
||||
{"rename", NOTE_RENAME},
|
||||
{"revoke", NOTE_REVOKE},
|
||||
#ifdef NOTE_TRUNCATE
|
||||
{"truncate", NOTE_TRUNCATE},
|
||||
#endif
|
||||
{"write", NOTE_WRITE},
|
||||
};
|
||||
|
||||
static uint32_t decode_watch_flags(const Janet *options, int32_t n) {
|
||||
uint32_t flags = 0;
|
||||
for (int32_t i = 0; i < n; i++) {
|
||||
if (!(janet_checktype(options[i], JANET_KEYWORD))) {
|
||||
janet_panicf("expected keyword, got %v", options[i]);
|
||||
}
|
||||
JanetKeyword keyw = janet_unwrap_keyword(options[i]);
|
||||
const JanetWatchFlagName *result = janet_strbinsearch(watcher_flags_kqueue,
|
||||
sizeof(watcher_flags_kqueue) / sizeof(JanetWatchFlagName),
|
||||
sizeof(JanetWatchFlagName),
|
||||
keyw);
|
||||
if (!result) {
|
||||
janet_panicf("unknown bsd flag %v", options[i]);
|
||||
}
|
||||
flags |= result->flag;
|
||||
}
|
||||
return flags;
|
||||
}
|
||||
|
||||
static void janet_watcher_init(JanetWatcher *watcher, JanetChannel *channel, uint32_t default_flags) {
|
||||
int kq = kqueue();
|
||||
watcher->watch_descriptors = janet_table(0);
|
||||
watcher->channel = channel;
|
||||
watcher->default_flags = default_flags;
|
||||
watcher->is_watching = 0;
|
||||
watcher->stream = janet_stream(kq, JANET_STREAM_READABLE, NULL);
|
||||
janet_stream_level_triggered(watcher->stream);
|
||||
}
|
||||
|
||||
static void janet_watcher_add(JanetWatcher *watcher, const char *path, uint32_t flags) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
int kq = watcher->stream->handle;
|
||||
struct kevent kev = {0};
|
||||
/* Get file descriptor for path */
|
||||
int file_fd;
|
||||
do {
|
||||
file_fd = open(path, O_RDONLY);
|
||||
} while (file_fd == -1 && errno == EINTR);
|
||||
if (file_fd == -1) {
|
||||
janet_panicf("failed to open: %v", janet_ev_lasterr());
|
||||
}
|
||||
/* Watch for EVFILT_VNODE on the file descriptor */
|
||||
EV_SETx(&kev, file_fd, EVFILT_VNODE, EV_ADD | EV_ENABLE | EV_CLEAR, flags, 0, NULL);
|
||||
int status;
|
||||
do {
|
||||
status = kevent(kq, &kev, 1, NULL, 0, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) {
|
||||
close(file_fd);
|
||||
janet_panicf("failed to listen: %v", janet_ev_lasterr());
|
||||
}
|
||||
/* Bookkeeping */
|
||||
Janet name = janet_cstringv(path);
|
||||
Janet wd = janet_wrap_integer(file_fd);
|
||||
janet_table_put(watcher->watch_descriptors, name, wd);
|
||||
janet_table_put(watcher->watch_descriptors, wd, name);
|
||||
}
|
||||
|
||||
static void janet_watcher_remove(JanetWatcher *watcher, const char *path) {
|
||||
if (watcher->stream == NULL) janet_panic("watcher closed");
|
||||
Janet pathv = janet_cstringv(path);
|
||||
Janet check = janet_table_get(watcher->watch_descriptors, pathv);
|
||||
if (!janet_checktype(check, JANET_NUMBER)) {
|
||||
janet_panic("bad watch descriptor");
|
||||
}
|
||||
/* Closing the file descriptor will also remove it from the kqueue */
|
||||
int wd = janet_unwrap_integer(check);
|
||||
int result;
|
||||
do {
|
||||
result = close(wd);
|
||||
} while (result != -1 && errno == EINTR);
|
||||
if (result == -1) {
|
||||
janet_panicv(janet_ev_lasterr());
|
||||
}
|
||||
janet_table_put(watcher->watch_descriptors, pathv, janet_wrap_nil());
|
||||
janet_table_put(watcher->watch_descriptors, janet_wrap_integer(wd), janet_wrap_nil());
|
||||
}
|
||||
|
||||
typedef struct {
|
||||
JanetWatcher *watcher;
|
||||
uint32_t cookie;
|
||||
} KqueueWatcherState;
|
||||
|
||||
static void watcher_callback_read(JanetFiber *fiber, JanetAsyncEvent event) {
|
||||
JanetStream *stream = fiber->ev_stream;
|
||||
KqueueWatcherState *state = fiber->ev_state;
|
||||
JanetWatcher *watcher = state->watcher;
|
||||
switch (event) {
|
||||
case JANET_ASYNC_EVENT_MARK:
|
||||
janet_mark(janet_wrap_abstract(watcher));
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_CLOSE:
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_ERR: {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
}
|
||||
case JANET_ASYNC_EVENT_HUP:
|
||||
case JANET_ASYNC_EVENT_INIT:
|
||||
break;
|
||||
case JANET_ASYNC_EVENT_READ: {
|
||||
/* Pump events from the sub kqueue */
|
||||
const int num_events = 512; /* Extra will be pumped after another event loop rotation. */
|
||||
struct kevent events[num_events];
|
||||
int kq = stream->handle;
|
||||
int status;
|
||||
do {
|
||||
status = kevent(kq, NULL, 0, events, num_events, NULL);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) {
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_async_end(fiber);
|
||||
break;
|
||||
}
|
||||
for (int i = 0; i < status; i++) {
|
||||
state->cookie += 6700417;
|
||||
struct kevent kev = events[i];
|
||||
/* TODO - avoid stat call here, maybe just when adding listener? */
|
||||
struct stat stat_buf = {0};
|
||||
int status;
|
||||
do {
|
||||
status = fstat(kev.ident, &stat_buf);
|
||||
} while (status == -1 && errno == EINTR);
|
||||
if (status == -1) continue;
|
||||
int is_dir = S_ISDIR(stat_buf.st_mode);
|
||||
Janet ident = janet_wrap_integer(kev.ident);
|
||||
Janet path = janet_table_get(watcher->watch_descriptors, ident);
|
||||
for (unsigned int j = 1; j < (sizeof(watcher_flags_kqueue) / sizeof(watcher_flags_kqueue[0])); j++) {
|
||||
uint32_t flagcheck = watcher_flags_kqueue[j].flag;
|
||||
if (kev.fflags & flagcheck) {
|
||||
JanetKV *event = janet_struct_begin(6);
|
||||
janet_struct_put(event, janet_ckeywordv("wd"), ident);
|
||||
janet_struct_put(event, janet_ckeywordv("wd-path"), path);
|
||||
janet_struct_put(event, janet_ckeywordv("cookie"), janet_wrap_number((double) state->cookie));
|
||||
janet_struct_put(event, janet_ckeywordv("type"), janet_ckeywordv(watcher_flags_kqueue[j].name));
|
||||
if (is_dir) {
|
||||
/* Pass in directly */
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_cstringv(""));
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), path);
|
||||
} else {
|
||||
/* Split path */
|
||||
JanetString spath = janet_unwrap_string(path);
|
||||
const uint8_t *cursor = spath + janet_string_length(spath);
|
||||
const uint8_t *cursor_end = cursor;
|
||||
while (cursor > spath && cursor[0] != '/') {
|
||||
cursor--;
|
||||
}
|
||||
if (cursor == spath) {
|
||||
/* No path separators */
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_cstringv("."));
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(spath));
|
||||
} else {
|
||||
/* Found path separator */
|
||||
janet_struct_put(event, janet_ckeywordv("dir-name"), janet_wrap_string(janet_string(spath, (cursor - spath))));
|
||||
janet_struct_put(event, janet_ckeywordv("file-name"), janet_wrap_string(janet_string(cursor + 1, (cursor_end - cursor - 1))));
|
||||
}
|
||||
}
|
||||
Janet eventv = janet_wrap_struct(janet_struct_end(event));
|
||||
janet_channel_give(watcher->channel, eventv);
|
||||
}
|
||||
}
|
||||
}
|
||||
break;
|
||||
}
|
||||
default:
|
||||
break;
|
||||
}
|
||||
}
|
||||
|
||||
static void janet_watcher_listen(JanetWatcher *watcher) {
|
||||
if (watcher->is_watching) janet_panic("already watching");
|
||||
watcher->is_watching = 1;
|
||||
JanetFunction *thunk = janet_thunk_delay(janet_wrap_nil());
|
||||
JanetFiber *fiber = janet_fiber(thunk, 64, 0, NULL);
|
||||
KqueueWatcherState *state = janet_malloc(sizeof(KqueueWatcherState));
|
||||
state->watcher = watcher;
|
||||
janet_async_start_fiber(fiber, watcher->stream, JANET_ASYNC_LISTEN_READ, watcher_callback_read, state);
|
||||
janet_gcroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
static void janet_watcher_unlisten(JanetWatcher *watcher) {
|
||||
if (!watcher->is_watching) return;
|
||||
watcher->is_watching = 0;
|
||||
janet_stream_close(watcher->stream);
|
||||
janet_gcunroot(janet_wrap_abstract(watcher));
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
/* Default implementation */
|
||||
@@ -582,10 +844,10 @@ JANET_CORE_FN(cfun_filewatch_make,
|
||||
"* `:dir-name` -- the directory name of the file that triggered the event.\n\n"
|
||||
"Events also will contain keys specific to the host OS.\n\n"
|
||||
"Windows has no extra properties on events.\n\n"
|
||||
"Linux has the following extra properties on events:\n\n"
|
||||
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this.\n\n"
|
||||
"Linux and the BSDs have the following extra properties on events:\n\n"
|
||||
"* `:wd` -- the integer key returned by `filewatch/add` for the path that triggered this. This is a file descriptor integer on BSD and macos.\n\n"
|
||||
"* `:wd-path` -- the string path for watched directory of file. For files, will be the same as `:file-name`, and for directories, will be the same as `:dir-name`.\n\n"
|
||||
"* `:cookie` -- a randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
|
||||
"* `:cookie` -- a semi-randomized integer used to associate related events, such as :moved-from and :moved-to events.\n\n"
|
||||
"") {
|
||||
janet_sandbox_assert(JANET_SANDBOX_FS_READ);
|
||||
janet_arity(argc, 1, -1);
|
||||
@@ -600,6 +862,7 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"(filewatch/add watcher path flag & more-flags)",
|
||||
"Add a path to the watcher. Available flags depend on the current OS, and are as follows:\n\n"
|
||||
"Windows/MINGW (flags correspond to `FILE_NOTIFY_CHANGE_*` flags in win32 documentation):\n\n"
|
||||
"FLAGS\n\n"
|
||||
"* `:all` - trigger an event for all of the below triggers.\n\n"
|
||||
"* `:attributes` - `FILE_NOTIFY_CHANGE_ATTRIBUTES`\n\n"
|
||||
"* `:creation` - `FILE_NOTIFY_CHANGE_CREATION`\n\n"
|
||||
@@ -626,6 +889,22 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"* `:open` - `IN_OPEN`\n\n"
|
||||
"* `:q-overflow` - `IN_Q_OVERFLOW`\n\n"
|
||||
"* `:unmount` - `IN_UNMOUNT`\n\n\n"
|
||||
"BSDs and macos (flags correspond to `NOTE_*` flags from <sys/event.h>). Not all flags are available on all systems:\n\n"
|
||||
"* `:all` - `All available NOTE_* flags on the current platform`\n\n"
|
||||
"* `:attrib` - `NOTE_ATTRIB`\n\n"
|
||||
"* `:close-write` - `NOTE_CLOSE_WRITE`\n\n"
|
||||
"* `:close` - `NOTE_CLOSE`\n\n"
|
||||
"* `:delete` - `NOTE_DELETE`\n\n"
|
||||
"* `:extend` - `NOTE_EXTEND`\n\n"
|
||||
"* `:funlock` - `NOTE_FUNLOCK`\n\n"
|
||||
"* `:link` - `NOTE_LINK`\n\n"
|
||||
"* `:open` - `NOTE_OPEN`\n\n"
|
||||
"* `:read` - `NOTE_READ`\n\n"
|
||||
"* `:rename` - `NOTE_RENAME`\n\n"
|
||||
"* `:revoke` - `NOTE_REVOKE`\n\n"
|
||||
"* `:truncate` - `NOTE_TRUNCATE`\n\n"
|
||||
"* `:write` - `NOTE_WRITE`\n\n\n"
|
||||
"EVENT TYPES\n\n"
|
||||
"On Windows, events will have the following possible types:\n\n"
|
||||
"* `:unknown`\n\n"
|
||||
"* `:added`\n\n"
|
||||
@@ -633,7 +912,7 @@ JANET_CORE_FN(cfun_filewatch_add,
|
||||
"* `:modified`\n\n"
|
||||
"* `:renamed-old`\n\n"
|
||||
"* `:renamed-new`\n\n"
|
||||
"On Linux, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"On Linux and BSDs, events will have a `:type` corresponding to the possible flags, excluding `:all`.\n"
|
||||
"") {
|
||||
janet_arity(argc, 2, -1);
|
||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
||||
@@ -648,6 +927,7 @@ JANET_CORE_FN(cfun_filewatch_remove,
|
||||
"Remove a path from the watcher.") {
|
||||
janet_fixarity(argc, 2);
|
||||
JanetWatcher *watcher = janet_getabstract(argv, 0, &janet_filewatch_at);
|
||||
/* TODO - pass string in directly to avoid extra allocation */
|
||||
const char *path = janet_getcstring(argv, 1);
|
||||
janet_watcher_remove(watcher, path);
|
||||
return argv[0];
|
||||
|
||||
@@ -333,7 +333,7 @@ static int compare_uint64_double(uint64_t x, double y) {
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_S64) {
|
||||
janet_panic("compare method requires int/s64 as first argument");
|
||||
@@ -368,7 +368,7 @@ static Janet cfun_it_s64_compare(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_nil();
|
||||
}
|
||||
|
||||
static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
if (janet_is_int(argv[0]) != JANET_INT_U64) {
|
||||
janet_panic("compare method requires int/u64 as first argument");
|
||||
@@ -416,7 +416,7 @@ static Janet cfun_it_u64_compare(int32_t argc, Janet *argv) {
|
||||
* This will not affect the end result (property of twos complement).
|
||||
*/
|
||||
#define OPMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -427,7 +427,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define OPMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -437,7 +437,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define UNARYMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = oper(janet_unwrap_##type(argv[0])); \
|
||||
@@ -450,7 +450,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
#define DIVZERO_mod return janet_wrap_abstract(box)
|
||||
|
||||
#define DIVMETHOD(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -463,7 +463,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -474,7 +474,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHOD_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
janet_arity(argc, 2, -1); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[0]); \
|
||||
@@ -488,7 +488,7 @@ static Janet cfun_it_##type##_##name(int32_t argc, Janet *argv) { \
|
||||
} \
|
||||
|
||||
#define DIVMETHODINVERT_SIGNED(T, type, name, oper) \
|
||||
static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
janet_fixarity(argc, 2); \
|
||||
T *box = janet_abstract(&janet_##type##_type, sizeof(T)); \
|
||||
*box = janet_unwrap_##type(argv[1]); \
|
||||
@@ -499,7 +499,7 @@ static Janet cfun_it_##type##_##name##i(int32_t argc, Janet *argv) { \
|
||||
return janet_wrap_abstract(box); \
|
||||
} \
|
||||
|
||||
static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
@@ -510,7 +510,7 @@ static Janet cfun_it_s64_divf(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
@@ -521,7 +521,7 @@ static Janet cfun_it_s64_divfi(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op1 = janet_unwrap_s64(argv[0]);
|
||||
@@ -535,7 +535,7 @@ static Janet cfun_it_s64_mod(int32_t argc, Janet *argv) {
|
||||
return janet_wrap_abstract(box);
|
||||
}
|
||||
|
||||
static Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
static JANET_CFUNCTION_ALIGN Janet cfun_it_s64_modi(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 2);
|
||||
int64_t *box = janet_abstract(&janet_s64_type, sizeof(int64_t));
|
||||
int64_t op2 = janet_unwrap_s64(argv[0]);
|
||||
|
||||
@@ -320,41 +320,6 @@ static int cfun_io_gc(void *p, size_t len) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
/* Cross-platform fsync binding for Janet */
|
||||
JANET_CORE_FN(cfun_io_fsync,
|
||||
"(file/sync f)",
|
||||
"Flushes all operating system buffers to disk for file `f`. Guarantees data is physically "
|
||||
"written to disk in a platform-dependent way. Returns the file handle if successful, raises error if not.") {
|
||||
janet_fixarity(argc, 1);
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
#ifdef JANET_WINDOWS
|
||||
{
|
||||
int fd = _fileno(iof->file);
|
||||
if (fd < 0)
|
||||
janet_panic("invalid file descriptor");
|
||||
HANDLE hFile = (HANDLE)_get_osfhandle(fd);
|
||||
if (hFile == INVALID_HANDLE_VALUE)
|
||||
janet_panic("invalid file handle");
|
||||
if (!FlushFileBuffers(hFile))
|
||||
janet_panic("could not flush file buffers");
|
||||
}
|
||||
#elif defined(_POSIX_VERSION)
|
||||
{
|
||||
int fd = fileno(iof->file);
|
||||
if (fd < 0)
|
||||
janet_panic("invalid file descriptor");
|
||||
if (fsync(fd) != 0)
|
||||
janet_panic("could not fsync file");
|
||||
}
|
||||
#else
|
||||
janet_panic("fsync not supported on this platform");
|
||||
#endif
|
||||
return argv[0];
|
||||
}
|
||||
|
||||
|
||||
/* Close a file */
|
||||
JANET_CORE_FN(cfun_io_fclose,
|
||||
"(file/close f)",
|
||||
@@ -429,7 +394,6 @@ static JanetMethod io_file_methods[] = {
|
||||
{"seek", cfun_io_fseek},
|
||||
{"tell", cfun_io_ftell},
|
||||
{"write", cfun_io_fwrite},
|
||||
{"sync", cfun_io_fsync},
|
||||
{NULL, NULL}
|
||||
};
|
||||
|
||||
@@ -882,7 +846,6 @@ void janet_lib_io(JanetTable *env) {
|
||||
JANET_CORE_REG("file/flush", cfun_io_fflush),
|
||||
JANET_CORE_REG("file/seek", cfun_io_fseek),
|
||||
JANET_CORE_REG("file/tell", cfun_io_ftell),
|
||||
JANET_CORE_REG("file/sync", cfun_io_fsync),
|
||||
JANET_REG_END
|
||||
};
|
||||
janet_core_cfuns_ext(env, NULL, io_cfuns);
|
||||
|
||||
105
src/core/pp.c
105
src/core/pp.c
@@ -72,7 +72,7 @@ static int count_dig10(int32_t x) {
|
||||
}
|
||||
}
|
||||
|
||||
static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||
static int32_t integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||
janet_buffer_extra(buffer, BUFSIZE);
|
||||
uint8_t *buf = buffer->data + buffer->count;
|
||||
int32_t neg = 0;
|
||||
@@ -80,7 +80,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||
if (x == 0) {
|
||||
buf[0] = '0';
|
||||
buffer->count++;
|
||||
return;
|
||||
return 1;
|
||||
}
|
||||
if (x > 0) {
|
||||
x = -x;
|
||||
@@ -96,6 +96,7 @@ static void integer_to_string_b(JanetBuffer *buffer, int32_t x) {
|
||||
x /= 10;
|
||||
}
|
||||
buffer->count += len + neg;
|
||||
return len + neg;
|
||||
}
|
||||
|
||||
#define HEX(i) (((uint8_t *) janet_base64)[(i)])
|
||||
@@ -134,43 +135,55 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
|
||||
#undef POINTSIZE
|
||||
}
|
||||
|
||||
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
static int janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
int align = 1;
|
||||
for (int32_t i = 0; i < len; ++i) {
|
||||
uint8_t c = str[i];
|
||||
switch (c) {
|
||||
case '"':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\"", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\n':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\n", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\r':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\r", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\0':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\0", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\f':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\f", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\v':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\v", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\a':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\a", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\b':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\b", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case 27:
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\e", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\\':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\\\", 2);
|
||||
align += 2;
|
||||
break;
|
||||
case '\t':
|
||||
janet_buffer_push_bytes(buffer, (const uint8_t *)"\\t", 2);
|
||||
align += 2;
|
||||
break;
|
||||
default:
|
||||
if (c < 32 || c > 126) {
|
||||
@@ -180,13 +193,16 @@ static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, in
|
||||
buf[2] = janet_base64[(c >> 4) & 0xF];
|
||||
buf[3] = janet_base64[c & 0xF];
|
||||
janet_buffer_push_bytes(buffer, buf, 4);
|
||||
align += 4;
|
||||
} else {
|
||||
janet_buffer_push_u8(buffer, c);
|
||||
align++;
|
||||
}
|
||||
break;
|
||||
}
|
||||
}
|
||||
janet_buffer_push_u8(buffer, '"');
|
||||
return align + 1;
|
||||
}
|
||||
|
||||
static void janet_escape_string_b(JanetBuffer *buffer, const uint8_t *str) {
|
||||
@@ -358,7 +374,7 @@ const uint8_t *janet_to_string(Janet x) {
|
||||
struct pretty {
|
||||
JanetBuffer *buffer;
|
||||
int depth;
|
||||
int indent;
|
||||
int align;
|
||||
int flags;
|
||||
int32_t bufstartlen;
|
||||
int32_t *keysort_buffer;
|
||||
@@ -450,14 +466,15 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static void print_newline(struct pretty *S, int just_a_space) {
|
||||
static void print_newline(struct pretty *S, int align) {
|
||||
int i;
|
||||
if (just_a_space || (S->flags & JANET_PRETTY_ONELINE)) {
|
||||
S->align = align;
|
||||
if (S->flags & JANET_PRETTY_ONELINE) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
return;
|
||||
}
|
||||
janet_buffer_push_u8(S->buffer, '\n');
|
||||
for (i = 0; i < S->indent; i++) {
|
||||
for (i = 0; i < S->align; i++) {
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
}
|
||||
}
|
||||
@@ -484,14 +501,12 @@ static const char *janet_pretty_colors[] = {
|
||||
"\x1B[36m"
|
||||
};
|
||||
|
||||
#define JANET_PRETTY_DICT_ONELINE 4
|
||||
#define JANET_PRETTY_IND_ONELINE 10
|
||||
#define JANET_PRETTY_DICT_LIMIT 30
|
||||
#define JANET_PRETTY_DICT_KEYSORT_LIMIT 2000
|
||||
#define JANET_PRETTY_ARRAY_LIMIT 160
|
||||
|
||||
/* Helper for pretty printing */
|
||||
static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
static void janet_pretty_one(struct pretty *S, Janet x) {
|
||||
/* Add to seen */
|
||||
switch (janet_type(x)) {
|
||||
case JANET_NIL:
|
||||
@@ -506,7 +521,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_cycle_color);
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "<cycle ");
|
||||
integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||
S->align += 8 + integer_to_string_b(S->buffer, janet_unwrap_integer(seenid));
|
||||
janet_buffer_push_u8(S->buffer, '>');
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
@@ -528,9 +543,11 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (janet_checktype(x, JANET_BUFFER) && janet_unwrap_buffer(x) == S->buffer) {
|
||||
janet_buffer_ensure(S->buffer, S->buffer->count + S->bufstartlen * 4 + 3, 1);
|
||||
janet_buffer_push_u8(S->buffer, '@');
|
||||
janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||
S->align += 1 + janet_escape_string_impl(S->buffer, S->buffer->data, S->bufstartlen);
|
||||
} else {
|
||||
S->align -= S->buffer->count;
|
||||
janet_description_b(S->buffer, x);
|
||||
S->align += S->buffer->count;
|
||||
}
|
||||
if (color && (S->flags & JANET_PRETTY_COLOR)) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
@@ -547,35 +564,34 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
const char *startstr = isarray ? "@[" : hasbrackets ? "[" : "(";
|
||||
const char endchar = isarray ? ']' : hasbrackets ? ']' : ')';
|
||||
janet_buffer_push_cstring(S->buffer, startstr);
|
||||
const int align = S->align += strlen(startstr);
|
||||
S->depth--;
|
||||
S->indent += 2;
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
S->align += 3;
|
||||
} else {
|
||||
if (!isarray && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_IND_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_IND_ONELINE) print_newline(S, 0);
|
||||
if (len > JANET_PRETTY_ARRAY_LIMIT && !(S->flags & JANET_PRETTY_NOTRUNC)) {
|
||||
for (i = 0; i < 3; i++) {
|
||||
if (i) print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
if (i) print_newline(S, align);
|
||||
janet_pretty_one(S, arr[i]);
|
||||
}
|
||||
print_newline(S, 0);
|
||||
print_newline(S, align);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
for (i = 0; i < 3; i++) {
|
||||
print_newline(S, 0);
|
||||
janet_pretty_one(S, arr[len - 3 + i], 0);
|
||||
S->align += 3;
|
||||
for (i = len - 3; i < len; i++) {
|
||||
print_newline(S, align);
|
||||
janet_pretty_one(S, arr[i]);
|
||||
}
|
||||
} else {
|
||||
for (i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < JANET_PRETTY_IND_ONELINE);
|
||||
janet_pretty_one(S, arr[i], 0);
|
||||
if (i) print_newline(S, align);
|
||||
janet_pretty_one(S, arr[i]);
|
||||
}
|
||||
}
|
||||
}
|
||||
S->indent -= 2;
|
||||
S->depth++;
|
||||
janet_buffer_push_u8(S->buffer, endchar);
|
||||
S->align++;
|
||||
break;
|
||||
}
|
||||
case JANET_STRUCT:
|
||||
@@ -586,6 +602,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
if (istable) {
|
||||
JanetTable *t = janet_unwrap_table(x);
|
||||
JanetTable *proto = t->proto;
|
||||
S->align++;
|
||||
janet_buffer_push_cstring(S->buffer, "@");
|
||||
if (NULL != proto) {
|
||||
Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
|
||||
@@ -596,6 +613,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
||||
}
|
||||
janet_buffer_push_bytes(S->buffer, n, len);
|
||||
S->align += len;
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
@@ -613,25 +631,24 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
janet_buffer_push_cstring(S->buffer, janet_class_color);
|
||||
}
|
||||
janet_buffer_push_bytes(S->buffer, n, len);
|
||||
S->align += len;
|
||||
if (S->flags & JANET_PRETTY_COLOR) {
|
||||
janet_buffer_push_cstring(S->buffer, "\x1B[0m");
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
janet_buffer_push_cstring(S->buffer, "{");
|
||||
janet_buffer_push_u8(S->buffer, '{');
|
||||
const int align = ++S->align;
|
||||
|
||||
S->depth--;
|
||||
S->indent += 2;
|
||||
if (S->depth == 0) {
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
S->align += 3;
|
||||
} else {
|
||||
int32_t len = 0, cap = 0;
|
||||
const JanetKV *kvs = NULL;
|
||||
janet_dictionary_view(x, &kvs, &len, &cap);
|
||||
if (!istable && !(S->flags & JANET_PRETTY_ONELINE) && len >= JANET_PRETTY_DICT_ONELINE)
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
if (is_dict_value && len >= JANET_PRETTY_DICT_ONELINE) print_newline(S, 0);
|
||||
int32_t ks_start = S->keysort_start;
|
||||
int truncated = 0;
|
||||
|
||||
@@ -644,15 +661,17 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
int32_t j = 0;
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
while (janet_checktype(kvs[j].key, JANET_NIL)) j++;
|
||||
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||
janet_pretty_one(S, kvs[j].key, 0);
|
||||
if (i) print_newline(S, align);
|
||||
janet_pretty_one(S, kvs[j].key);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[j].value, 1);
|
||||
S->align++;
|
||||
janet_pretty_one(S, kvs[j].value);
|
||||
j++;
|
||||
}
|
||||
if (truncated) {
|
||||
print_newline(S, 0);
|
||||
print_newline(S, align);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
S->align += 3;
|
||||
}
|
||||
} else {
|
||||
/* Sorted keys dictionaries */
|
||||
@@ -685,24 +704,26 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
|
||||
}
|
||||
|
||||
for (int32_t i = 0; i < len; i++) {
|
||||
if (i) print_newline(S, len < JANET_PRETTY_DICT_ONELINE);
|
||||
if (i) print_newline(S, align);
|
||||
int32_t j = S->keysort_buffer[i + ks_start];
|
||||
janet_pretty_one(S, kvs[j].key, 0);
|
||||
janet_pretty_one(S, kvs[j].key);
|
||||
janet_buffer_push_u8(S->buffer, ' ');
|
||||
janet_pretty_one(S, kvs[j].value, 1);
|
||||
S->align++;
|
||||
janet_pretty_one(S, kvs[j].value);
|
||||
}
|
||||
|
||||
if (truncated) {
|
||||
print_newline(S, 0);
|
||||
print_newline(S, align);
|
||||
janet_buffer_push_cstring(S->buffer, "...");
|
||||
S->align += 3;
|
||||
}
|
||||
|
||||
}
|
||||
S->keysort_start = ks_start;
|
||||
}
|
||||
S->indent -= 2;
|
||||
S->depth++;
|
||||
janet_buffer_push_u8(S->buffer, '}');
|
||||
S->align++;
|
||||
break;
|
||||
}
|
||||
}
|
||||
@@ -718,14 +739,14 @@ static JanetBuffer *janet_pretty_(JanetBuffer *buffer, int depth, int flags, Jan
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.align = 0;
|
||||
S.flags = flags;
|
||||
S.bufstartlen = startlen;
|
||||
S.keysort_capacity = 0;
|
||||
S.keysort_buffer = NULL;
|
||||
S.keysort_start = 0;
|
||||
janet_table_init(&S.seen, 10);
|
||||
janet_pretty_one(&S, x, 0);
|
||||
janet_pretty_one(&S, x);
|
||||
janet_table_deinit(&S.seen);
|
||||
return S.buffer;
|
||||
}
|
||||
@@ -743,7 +764,7 @@ static JanetBuffer *janet_jdn_(JanetBuffer *buffer, int depth, Janet x, int32_t
|
||||
}
|
||||
S.buffer = buffer;
|
||||
S.depth = depth;
|
||||
S.indent = 0;
|
||||
S.align = 0;
|
||||
S.flags = 0;
|
||||
S.bufstartlen = startlen;
|
||||
S.keysort_capacity = 0;
|
||||
|
||||
@@ -404,7 +404,7 @@ SlotHeadPair *dohead_destructure(JanetCompiler *c, SlotHeadPair *into, JanetFopt
|
||||
}
|
||||
|
||||
/* Def or var a symbol in a local scope */
|
||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, int no_unused) {
|
||||
static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, JanetSlot ret, uint32_t def_flags) {
|
||||
int isUnnamedRegister = !(ret.flags & JANET_SLOT_NAMED) &&
|
||||
ret.index > 0 &&
|
||||
ret.envindex >= 0;
|
||||
@@ -425,11 +425,10 @@ static int namelocal(JanetCompiler *c, const uint8_t *head, int32_t flags, Janet
|
||||
ret = localslot;
|
||||
}
|
||||
ret.flags |= flags;
|
||||
if ((c->scope->flags & JANET_SCOPE_TOP) || no_unused) {
|
||||
janetc_nameslot_no_unused(c, head, ret);
|
||||
} else {
|
||||
janetc_nameslot(c, head, ret);
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
}
|
||||
janetc_nameslot(c, head, ret, def_flags);
|
||||
return !isUnnamedRegister;
|
||||
}
|
||||
|
||||
@@ -443,7 +442,7 @@ static int varleaf(
|
||||
JanetSlot refslot;
|
||||
JanetTable *entry = janet_table_clone(reftab);
|
||||
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
int is_redef = c->is_redef;
|
||||
|
||||
JanetArray *ref;
|
||||
JanetBinding old_binding;
|
||||
@@ -464,7 +463,11 @@ static int varleaf(
|
||||
return 1;
|
||||
} else {
|
||||
int no_unused = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "unused"));
|
||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, no_unused);
|
||||
int no_shadow = reftab && reftab->count && janet_truthy(janet_table_get_keyword(reftab, "shadow"));
|
||||
uint32_t def_flags = 0;
|
||||
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
|
||||
return namelocal(c, sym, JANET_SLOT_MUTABLE, s, def_flags);
|
||||
}
|
||||
}
|
||||
|
||||
@@ -505,12 +508,14 @@ static int defleaf(
|
||||
const uint8_t *sym,
|
||||
JanetSlot s,
|
||||
JanetTable *tab) {
|
||||
JanetTable *entry = NULL;
|
||||
int is_redef = 0;
|
||||
if (c->scope->flags & JANET_SCOPE_TOP) {
|
||||
JanetTable *entry = janet_table_clone(tab);
|
||||
entry = janet_table_clone(tab);
|
||||
janet_table_put(entry, janet_ckeywordv("source-map"),
|
||||
janet_wrap_tuple(janetc_make_sourcemap(c)));
|
||||
|
||||
int is_redef = janet_truthy(janet_table_get_keyword(c->env, "redef"));
|
||||
is_redef = c->is_redef;
|
||||
if (is_redef) janet_table_put(entry, janet_ckeywordv("redef"), janet_wrap_true());
|
||||
|
||||
if (is_redef) {
|
||||
@@ -530,12 +535,18 @@ static int defleaf(
|
||||
JanetSlot tabslot = janetc_cslot(janet_wrap_table(entry));
|
||||
janetc_emit_sss(c, JOP_PUT, tabslot, valsym, s, 0);
|
||||
}
|
||||
|
||||
/* Add env entry to env */
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||
}
|
||||
int no_unused = tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "unused"));
|
||||
return namelocal(c, sym, 0, s, no_unused);
|
||||
int no_shadow = is_redef || (tab && tab->count && janet_truthy(janet_table_get_keyword(tab, "shadow")));
|
||||
uint32_t def_flags = 0;
|
||||
if (no_unused) def_flags |= JANET_DEFFLAG_NO_UNUSED;
|
||||
if (no_shadow) def_flags |= JANET_DEFFLAG_NO_SHADOWCHECK;
|
||||
int result = namelocal(c, sym, 0, s, def_flags);
|
||||
if (entry) {
|
||||
/* Add env entry to env AFTER namelocal to avoid the shadowcheck false positive */
|
||||
janet_table_put(c->env, janet_wrap_symbol(sym), janet_wrap_table(entry));
|
||||
}
|
||||
return result;
|
||||
}
|
||||
|
||||
static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
@@ -1066,10 +1077,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
named_table = janet_table(10);
|
||||
named_slot = janetc_farslot(c);
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
janetc_nameslot(c, sym, janetc_farslot(c), 0);
|
||||
}
|
||||
} else {
|
||||
janetc_nameslot(c, sym, janetc_farslot(c));
|
||||
janetc_nameslot(c, sym, janetc_farslot(c), 0);
|
||||
}
|
||||
} else {
|
||||
janet_v_push(destructed_params, janetc_farslot(c));
|
||||
@@ -1118,7 +1129,9 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
JanetSlot slot = janetc_farslot(c);
|
||||
slot.flags = JANET_SLOT_NAMED | JANET_FUNCTION;
|
||||
janetc_emit_s(c, JOP_LOAD_SELF, slot, 1);
|
||||
janetc_nameslot_no_unused(c, sym, slot);
|
||||
/* We should figure out a better way to avoid `(def x 1) (def x :shadow (fn x [...] ...))` triggering a
|
||||
* shadow lint for the last x */
|
||||
janetc_nameslot(c, sym, slot, JANET_DEFFLAG_NO_UNUSED | JANET_DEFFLAG_NO_SHADOWCHECK);
|
||||
}
|
||||
}
|
||||
|
||||
|
||||
@@ -49,6 +49,8 @@
|
||||
#include <math.h>
|
||||
#include <string.h>
|
||||
|
||||
#define JANET_NUMBER_LENGTH_RIDICULOUS 0xFFFF
|
||||
|
||||
/* Lookup table for getting values of characters when parsing numbers. Handles
|
||||
* digits 0-9 and a-z (and A-Z). A-Z have values of 10 to 35. */
|
||||
static uint8_t digit_lookup[128] = {
|
||||
@@ -266,7 +268,7 @@ int janet_scan_number_base(
|
||||
* the decimal point, exponent could wrap around and become positive. It's
|
||||
* easier to reject ridiculously large inputs than to check for overflows.
|
||||
* */
|
||||
if (len > INT32_MAX / 40) goto error;
|
||||
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) goto error;
|
||||
|
||||
/* Get sign */
|
||||
if (str >= end) goto error;
|
||||
@@ -410,10 +412,7 @@ static int scan_uint64(
|
||||
*neg = 0;
|
||||
*out = 0;
|
||||
uint64_t accum = 0;
|
||||
/* len max is INT64_MAX in base 2 with _ between each bits */
|
||||
/* '2r' + 64 bits + 63 _ + sign = 130 => 150 for some leading */
|
||||
/* zeros */
|
||||
if (len > 150) return 0;
|
||||
if (len > JANET_NUMBER_LENGTH_RIDICULOUS) return 0;
|
||||
/* Get sign */
|
||||
if (str >= end) return 0;
|
||||
if (*str == '-') {
|
||||
|
||||
@@ -573,8 +573,24 @@ static char *namebuf_name(NameBuf *namebuf, const char *suffix) {
|
||||
return (char *)(namebuf->buf);
|
||||
}
|
||||
|
||||
/* Add a little bit of safety when using nanboxing on arm. Instead of inserting run-time checks everywhere, we are
|
||||
* only doing it during registration which has much less cost (1 shift and mask). */
|
||||
static void janet_check_pointer_align(void *p) {
|
||||
(void) p;
|
||||
#if defined(JANET_NANBOX_64) && JANET_NANBOX_64_POINTER_SHIFT != 0
|
||||
union {
|
||||
void *p;
|
||||
uintptr_t u;
|
||||
} un;
|
||||
un.p = p;
|
||||
janet_assert(!(un.u & (uintptr_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)),
|
||||
"unaligned pointer wrap - cfunction pointers and abstract types must be aligned with this nanboxing configuration.");
|
||||
#endif
|
||||
}
|
||||
|
||||
void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns) {
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, cfuns->name, fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
@@ -584,6 +600,7 @@ void janet_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns)
|
||||
|
||||
void janet_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, cfuns->name, fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
@@ -595,6 +612,7 @@ void janet_cfuns_prefix(JanetTable *env, const char *regprefix, const JanetReg *
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, NULL, 0);
|
||||
@@ -607,6 +625,7 @@ void janet_cfuns_ext_prefix(JanetTable *env, const char *regprefix, const JanetR
|
||||
NameBuf nb;
|
||||
if (env) namebuf_init(&nb, regprefix);
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
if (env) janet_def_sm(env, namebuf_name(&nb, cfuns->name), fun, cfuns->documentation, cfuns->source_file, cfuns->source_line);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
@@ -623,6 +642,7 @@ void janet_register(const char *name, JanetCFunction cfun) {
|
||||
/* Abstract type introspection */
|
||||
|
||||
void janet_register_abstract_type(const JanetAbstractType *at) {
|
||||
janet_check_pointer_align((void *) at);
|
||||
Janet sym = janet_csymbolv(at->name);
|
||||
Janet check = janet_table_get(janet_vm.abstract_registry, sym);
|
||||
if (!janet_checktype(check, JANET_NIL) && at != janet_unwrap_pointer(check)) {
|
||||
@@ -655,6 +675,7 @@ void janet_core_def_sm(JanetTable *env, const char *name, Janet x, const void *p
|
||||
void janet_core_cfuns_ext(JanetTable *env, const char *regprefix, const JanetRegExt *cfuns) {
|
||||
(void) regprefix;
|
||||
while (cfuns->name) {
|
||||
janet_check_pointer_align(cfuns->cfun);
|
||||
Janet fun = janet_wrap_cfunction(cfuns->cfun);
|
||||
janet_table_put(env, janet_csymbolv(cfuns->name), fun);
|
||||
janet_registry_put(cfuns->cfun, cfuns->name, regprefix, cfuns->source_file, cfuns->source_line);
|
||||
|
||||
@@ -50,9 +50,9 @@
|
||||
#ifndef JANET_EXIT
|
||||
#include <stdio.h>
|
||||
#define JANET_EXIT(m) do { \
|
||||
fprintf(stderr, "janet internal error at line %d in file %s: %s\n",\
|
||||
__LINE__,\
|
||||
fprintf(stderr, "janet abort at %s:%d: %s\n",\
|
||||
__FILE__,\
|
||||
__LINE__,\
|
||||
(m));\
|
||||
abort();\
|
||||
} while (0)
|
||||
@@ -213,7 +213,7 @@ typedef struct {
|
||||
OVERLAPPED overlapped;
|
||||
WSAOVERLAPPED wsaoverlapped;
|
||||
} as;
|
||||
uint32_t bytes_transferred;
|
||||
uint32_t bytes_transfered;
|
||||
} JanetOverlapped;
|
||||
#endif
|
||||
#endif
|
||||
|
||||
@@ -194,12 +194,18 @@ Janet janet_wrap_number_safe(double d) {
|
||||
|
||||
void *janet_nanbox_to_pointer(Janet x) {
|
||||
x.i64 &= JANET_NANBOX_PAYLOADBITS;
|
||||
x.u64 <<= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
return x.pointer;
|
||||
}
|
||||
|
||||
Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
|
||||
Janet ret;
|
||||
ret.pointer = p;
|
||||
/* Should be noop when pointer shift is 0 */
|
||||
/*
|
||||
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
|
||||
*/
|
||||
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
ret.u64 |= tagmask;
|
||||
return ret;
|
||||
}
|
||||
@@ -207,6 +213,11 @@ Janet janet_nanbox_from_pointer(void *p, uint64_t tagmask) {
|
||||
Janet janet_nanbox_from_cpointer(const void *p, uint64_t tagmask) {
|
||||
Janet ret;
|
||||
ret.pointer = (void *)p;
|
||||
/* Should be noop when pointer shift is 0 */
|
||||
/*
|
||||
janet_assert(!(ret.u64 & (uint64_t) ((1 << JANET_NANBOX_64_POINTER_SHIFT) - 1)), "unaligned pointer wrap");
|
||||
*/
|
||||
ret.u64 >>= JANET_NANBOX_64_POINTER_SHIFT; /* Alignment, usually 0 */
|
||||
ret.u64 |= tagmask;
|
||||
return ret;
|
||||
}
|
||||
|
||||
@@ -307,25 +307,38 @@ extern "C" {
|
||||
* architectures (Nanboxing only tested on x86 and x64), comment out
|
||||
* the JANET_NANBOX define.*/
|
||||
|
||||
#if defined(_M_ARM64) || defined(_M_ARM) || defined(__aarch64__)
|
||||
#define JANET_NO_NANBOX
|
||||
#endif
|
||||
|
||||
#ifndef JANET_NO_NANBOX
|
||||
#ifdef JANET_32
|
||||
#define JANET_NANBOX_32
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv)
|
||||
#elif defined(__x86_64__) || defined(_WIN64) || defined(__riscv) || defined(__aarch64__) || defined(_M_ARM64)
|
||||
/* We will only enable nanboxing by default on 64 bit systems
|
||||
* for x64 and risc-v. This is mainly because the approach is tied to the
|
||||
* for x64, risc-v, and arm64. This is mainly because the approach is tied to the
|
||||
* implicit 47 bit address space. Many arches allow/require this, but not all,
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations. */
|
||||
* and it requires cooperation from the OS. ARM should also work in many configurations by taking advantage
|
||||
* of pointer alignment to allow for 48 or 49 bits of address space. */
|
||||
#define JANET_NANBOX_64
|
||||
|
||||
/* Allow 64-bit nanboxing to assume aligned pointers to get back some extra bits for representation.
|
||||
* This is needed to use nanboxing on systems with larger than 47-bit address spaces, such as many
|
||||
* aarch64 systems. */
|
||||
#ifndef JANET_NANBOX_64_POINTER_SHIFT
|
||||
#if (defined(_M_ARM64) || defined(__aarch64__)) && !defined(JANET_APPLE)
|
||||
/* All pointers, including function pointers, should be 4-byte aligned on aarch64 by default.
|
||||
* The exception is aarch64 macos, as it uses the same 47-bit userland address-space as on amd64. */
|
||||
#define JANET_NANBOX_64_POINTER_SHIFT 2
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
#endif
|
||||
|
||||
/* Allow for custom pointer alignment as well */
|
||||
#if defined(JANET_NANBOX_64) && !defined(JANET_NANBOX_64_POINTER_SHIFT)
|
||||
#define JANET_NANBOX_64_POINTER_SHIFT 0
|
||||
#endif
|
||||
|
||||
/* Runtime config constants */
|
||||
#ifdef JANET_NO_NANBOX
|
||||
#define JANET_NANBOX_BIT 0
|
||||
#define JANET_NANBOX_BIT 0x0
|
||||
#else
|
||||
#define JANET_NANBOX_BIT 0x1
|
||||
#endif
|
||||
@@ -336,9 +349,16 @@ extern "C" {
|
||||
#define JANET_SINGLE_THREADED_BIT 0
|
||||
#endif
|
||||
|
||||
#ifdef JANET_NANBOX_64_POINTER_SHIFT
|
||||
#define JANET_NANBOX_POINTER_SHIFT_BITS (JANET_NANBOX_64_POINTER_SHIFT ? (0x4 << JANET_NANBOX_64_POINTER_SHIFT) : 0)
|
||||
#else
|
||||
#define JANET_NANBOX_POINTER_SHIFT_BITS 0
|
||||
#endif
|
||||
|
||||
#define JANET_CURRENT_CONFIG_BITS \
|
||||
(JANET_SINGLE_THREADED_BIT | \
|
||||
JANET_NANBOX_BIT)
|
||||
JANET_NANBOX_BIT | \
|
||||
JANET_NANBOX_POINTER_SHIFT_BITS)
|
||||
|
||||
/* Represents the settings used to compile Janet, as well as the version */
|
||||
typedef struct {
|
||||
@@ -1415,7 +1435,7 @@ enum JanetOpCode {
|
||||
};
|
||||
|
||||
/* Info about all instructions */
|
||||
extern enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
extern const enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT];
|
||||
|
||||
/***** END SECTION OPCODES *****/
|
||||
|
||||
@@ -1531,9 +1551,6 @@ JANET_API Janet janet_ev_lasterr(void);
|
||||
* We could just use a pointer but this prevents malloc/free in the common case
|
||||
* of only a handful of arguments. */
|
||||
typedef struct {
|
||||
#ifdef JANET_WINDOWS
|
||||
char padding[48]; /* On windows, used for OVERLAPPED storage */
|
||||
#endif
|
||||
int tag;
|
||||
int argi;
|
||||
void *argp;
|
||||
@@ -2066,8 +2083,14 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
*
|
||||
* */
|
||||
|
||||
#if defined(JANET_NANBOX_64) && (JANET_NANBOX_64_POINTER_SHIFT != 0) && !defined(JANET_MSVC)
|
||||
#define JANET_CFUNCTION_ALIGN __attribute__((aligned(1 << JANET_NANBOX_64_POINTER_SHIFT)))
|
||||
#else
|
||||
#define JANET_CFUNCTION_ALIGN
|
||||
#endif
|
||||
|
||||
/* Shorthand for janet C function declarations */
|
||||
#define JANET_CFUN(name) Janet name (int32_t argc, Janet *argv)
|
||||
#define JANET_CFUN(name) JANET_CFUNCTION_ALIGN Janet name (int32_t argc, Janet *argv)
|
||||
|
||||
/* Declare a C function with documentation and source mapping */
|
||||
#define JANET_REG_END {NULL, NULL, NULL, NULL, 0}
|
||||
@@ -2083,7 +2106,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_REG_S(JNAME, CNAME) {JNAME, CNAME, NULL, __FILE__, CNAME##_sourceline_}
|
||||
#define JANET_FN_S(CNAME, USAGE, DOCSTRING) \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_S(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, NULL, __FILE__, __LINE__)
|
||||
|
||||
@@ -2091,7 +2114,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_REG_D(JNAME, CNAME) {JNAME, CNAME, CNAME##_docstring_, NULL, 0}
|
||||
#define JANET_FN_D(CNAME, USAGE, DOCSTRING) \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_D(ENV, JNAME, VAL, DOC) \
|
||||
janet_def(ENV, JNAME, VAL, DOC)
|
||||
|
||||
@@ -2100,7 +2123,7 @@ JANET_API Janet janet_resolve_core(const char *name);
|
||||
#define JANET_FN_SD(CNAME, USAGE, DOCSTRING) \
|
||||
static const int32_t CNAME##_sourceline_ = __LINE__; \
|
||||
static const char CNAME##_docstring_[] = USAGE "\n\n" DOCSTRING; \
|
||||
Janet CNAME (int32_t argc, Janet *argv)
|
||||
Janet JANET_CFUNCTION_ALIGN CNAME (int32_t argc, Janet *argv)
|
||||
#define JANET_DEF_SD(ENV, JNAME, VAL, DOC) \
|
||||
janet_def_sm(ENV, JNAME, VAL, DOC, __FILE__, __LINE__)
|
||||
|
||||
|
||||
@@ -26,6 +26,7 @@
|
||||
|
||||
#include <janet.h>
|
||||
#include <errno.h>
|
||||
#include <assert.h>
|
||||
|
||||
#ifdef _WIN32
|
||||
#include <windows.h>
|
||||
@@ -362,33 +363,50 @@ static void clear(void) {
|
||||
}
|
||||
}
|
||||
|
||||
static int getplen(void) {
|
||||
int _plen = gbl_plen;
|
||||
/* Ensure at least 16 characters of data entry; */
|
||||
while (_plen && (_plen + 16 > gbl_cols)) {
|
||||
_plen--;
|
||||
}
|
||||
return _plen;
|
||||
}
|
||||
|
||||
static void refresh(void) {
|
||||
char seq[64];
|
||||
JanetBuffer b;
|
||||
|
||||
/* If prompt is too long, truncate */
|
||||
int _plen = getplen();
|
||||
|
||||
/* Keep cursor position on screen */
|
||||
char *_buf = gbl_buf;
|
||||
int _len = gbl_len;
|
||||
int _pos = gbl_pos;
|
||||
while ((gbl_plen + _pos) >= gbl_cols) {
|
||||
|
||||
while ((_plen + _pos) >= gbl_cols) {
|
||||
_buf++;
|
||||
_len--;
|
||||
_pos--;
|
||||
}
|
||||
while ((gbl_plen + _len) > gbl_cols) {
|
||||
|
||||
while ((_plen + _len) > gbl_cols) {
|
||||
_len--;
|
||||
}
|
||||
|
||||
|
||||
janet_buffer_init(&b, 0);
|
||||
/* Cursor to left edge, gbl_prompt and buffer */
|
||||
janet_buffer_push_u8(&b, '\r');
|
||||
janet_buffer_push_cstring(&b, gbl_prompt);
|
||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||
janet_buffer_push_bytes(&b, (const uint8_t *) gbl_prompt, _plen);
|
||||
if (_len > 0) {
|
||||
janet_buffer_push_bytes(&b, (uint8_t *) _buf, _len);
|
||||
}
|
||||
/* Erase to right */
|
||||
janet_buffer_push_cstring(&b, "\x1b[0K\r");
|
||||
/* Move cursor to original position. */
|
||||
if (_pos + gbl_plen) {
|
||||
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + gbl_plen));
|
||||
if (_pos + _plen) {
|
||||
snprintf(seq, 64, "\x1b[%dC", (int)(_pos + _plen));
|
||||
janet_buffer_push_cstring(&b, seq);
|
||||
}
|
||||
if (write_console((char *) b.data, b.count) == -1) {
|
||||
@@ -414,7 +432,8 @@ static int insert(char c, int draw) {
|
||||
gbl_buf[gbl_pos++] = c;
|
||||
gbl_buf[++gbl_len] = '\0';
|
||||
if (draw) {
|
||||
if (gbl_plen + gbl_len < gbl_cols) {
|
||||
int _plen = getplen();
|
||||
if (_plen + gbl_len < gbl_cols) {
|
||||
/* Avoid a full update of the line in the
|
||||
* trivial case. */
|
||||
if (write_console(&c, 1) == -1) return -1;
|
||||
@@ -500,8 +519,13 @@ static void historymove(int delta) {
|
||||
} else if (gbl_historyi >= gbl_history_count) {
|
||||
gbl_historyi = gbl_history_count - 1;
|
||||
}
|
||||
gbl_len = (int) strlen(gbl_history[gbl_historyi]);
|
||||
/* If history element is longer the JANET_LINE_MAX - 1, truncate */
|
||||
if (gbl_len > JANET_LINE_MAX - 1) {
|
||||
gbl_len = JANET_LINE_MAX - 1;
|
||||
}
|
||||
gbl_pos = gbl_len;
|
||||
strncpy(gbl_buf, gbl_history[gbl_historyi], JANET_LINE_MAX - 1);
|
||||
gbl_pos = gbl_len = (int) strlen(gbl_buf);
|
||||
gbl_buf[gbl_len] = '\0';
|
||||
|
||||
refresh();
|
||||
@@ -925,11 +949,12 @@ static int line() {
|
||||
gbl_len = 0;
|
||||
gbl_pos = 0;
|
||||
while (gbl_prompt[gbl_plen]) gbl_plen++;
|
||||
int _plen = getplen();
|
||||
gbl_buf[0] = '\0';
|
||||
|
||||
addhistory();
|
||||
|
||||
if (write_console((char *) gbl_prompt, gbl_plen) == -1) return -1;
|
||||
if (write_console((char *) gbl_prompt, _plen) == -1) return -1;
|
||||
for (;;) {
|
||||
char c;
|
||||
char seq[5];
|
||||
@@ -1212,7 +1237,7 @@ int main(int argc, char **argv) {
|
||||
#endif
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1] = {0};
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
@@ -1220,6 +1245,7 @@ int main(int argc, char **argv) {
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
hash_key[JANET_HASH_KEY_SIZE] = '\0'; /* in case copy didn't get null byte */
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
|
||||
@@ -27,9 +27,11 @@
|
||||
(def line-info (string/format "%s:%d"
|
||||
(frame :source) (frame :source-line)))
|
||||
(if x
|
||||
(when is-verbose (eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x))
|
||||
(when is-verbose
|
||||
(eprintf "\e[32m✔\e[0m %s: %s: %v" line-info (describe e) x)
|
||||
(eflush) (flush))
|
||||
(do
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush)))
|
||||
(eprintf "\e[31m✘\e[0m %s: %s: %v" line-info (describe e) x) (eflush) (flush)))
|
||||
x)
|
||||
|
||||
(defn skip-asserts
|
||||
@@ -38,7 +40,7 @@
|
||||
(+= skip-n n)
|
||||
nil)
|
||||
|
||||
(defmacro assert
|
||||
(defmacro assert :shadow
|
||||
[x &opt e]
|
||||
(def xx (gensym))
|
||||
(default e (string/format "%j" x))
|
||||
@@ -50,12 +52,12 @@
|
||||
(defmacro assert-error
|
||||
[msg & forms]
|
||||
(def errsym (keyword (gensym)))
|
||||
~(assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
~(as-macro ,assert (= ,errsym (try (do ,;forms) ([_] ,errsym))) ,msg))
|
||||
|
||||
(defmacro assert-error-value
|
||||
[msg errval & forms]
|
||||
(def e (gensym))
|
||||
~(assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
|
||||
~(as-macro ,assert (= ,errval (try (do ,;forms) ([,e] ,e))) ,msg))
|
||||
|
||||
(defn check-compile-error
|
||||
[form]
|
||||
|
||||
@@ -70,9 +70,9 @@
|
||||
(assert (= (array/pop @[]) nil) "array/pop empty")
|
||||
|
||||
# Code coverage
|
||||
(def a @[1])
|
||||
(array/pop a)
|
||||
(array/trim a)
|
||||
(def a1 @[1])
|
||||
(array/pop a1)
|
||||
(array/trim a1)
|
||||
(array/ensure @[1 1] 6 2)
|
||||
|
||||
# array/join
|
||||
|
||||
@@ -48,8 +48,8 @@
|
||||
|
||||
(assert (deep= (buffer/push @"AA" @"BB") @"AABB") "buffer/push buffer")
|
||||
(assert (deep= (buffer/push @"AA" 66 66) @"AABB") "buffer/push int")
|
||||
(def b @"AA")
|
||||
(assert (deep= (buffer/push b b) @"AAAA") "buffer/push buffer self")
|
||||
(def b1 @"AA")
|
||||
(assert (deep= (buffer/push b1 b1) @"AAAA") "buffer/push buffer self")
|
||||
|
||||
# buffer/push-byte
|
||||
(assert (deep= (buffer/push-byte @"AA" 66) @"AAB") "buffer/push-byte")
|
||||
@@ -145,8 +145,8 @@
|
||||
|
||||
# Regression #301
|
||||
# a3d4ecddb
|
||||
(def b (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
|
||||
(def b8 (buffer/new-filled 128 0x78))
|
||||
(assert (= 38 (length (buffer/blit @"" b8 -1 90))) "buffer/blit 1")
|
||||
|
||||
(def a @"abcdefghijklm")
|
||||
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
|
||||
|
||||
@@ -84,23 +84,23 @@
|
||||
(assert (get result :error) "bad sum3 fuzz issue valgrind")
|
||||
|
||||
# Issue #1700
|
||||
(def result
|
||||
(def result1
|
||||
(compile
|
||||
'(defn fuzz-case-1
|
||||
[start end &]
|
||||
(if end
|
||||
(if e start (lazy-range (+ 1 start) end)))
|
||||
1)))
|
||||
(assert (get result :error) "fuzz case issue #1700")
|
||||
(assert (get result1 :error) "fuzz case issue #1700")
|
||||
|
||||
# Issue #1702 - fuzz case with upvalues
|
||||
(def result
|
||||
(def result2
|
||||
(compile
|
||||
'(each item [1 2 3]
|
||||
# Generate a lot of upvalues (more than 224)
|
||||
(def ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;out-buf @"")
|
||||
(with-dyns [:out out-buf] 1))))
|
||||
(assert result "bad upvalues fuzz case")
|
||||
(assert result2 "bad upvalues fuzz case")
|
||||
|
||||
# Named argument linting
|
||||
# Enhancement for #1654
|
||||
@@ -117,14 +117,14 @@
|
||||
(defn check-good-compile
|
||||
[code msg]
|
||||
(def lints @[])
|
||||
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result) (empty? lints)) msg))
|
||||
(def result4 (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result4) (empty? lints)) msg))
|
||||
|
||||
(defn check-lint-compile
|
||||
[code msg]
|
||||
(def lints @[])
|
||||
(def result (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result) (next lints)) msg))
|
||||
(def result4 (compile code (curenv) "suite-compile.janet" lints))
|
||||
(assert (and (function? result4) (next lints)) msg))
|
||||
|
||||
(check-good-compile '(fnamed) "named no args")
|
||||
(check-good-compile '(fnamed :x 1 :y 2 :z 3) "named full args")
|
||||
@@ -150,5 +150,10 @@
|
||||
(check-lint-compile '(g 1 2 :z) "g lint 1")
|
||||
(check-lint-compile '(g 1 2 :z 4 5) "g lint 2")
|
||||
|
||||
(end-suite)
|
||||
# Variable shadowing linting
|
||||
(def outer1 "a")
|
||||
(check-lint-compile '(def outer1 "b") "shadow global-to-global")
|
||||
(check-lint-compile '(let [outer1 "b"] outer1) "shadow local-to-global")
|
||||
(check-lint-compile '(do (def x "b") (def x "c")) "shadow local-to-local")
|
||||
|
||||
(end-suite)
|
||||
|
||||
@@ -43,9 +43,9 @@
|
||||
(assert (deep= '(:error "deadline expired" nil) (ev/take super)) "deadline expirataion")
|
||||
|
||||
# Another variant
|
||||
(def thread-channel (ev/thread-chan 100))
|
||||
(def super (ev/thread-chan 10))
|
||||
(defn worker []
|
||||
(def thread-channel :shadow (ev/thread-chan 100))
|
||||
(def super :shadow (ev/thread-chan 10))
|
||||
(defn worker :shadow []
|
||||
(while true
|
||||
(def item (ev/take thread-channel))
|
||||
(when (= item :deadline)
|
||||
|
||||
@@ -26,6 +26,8 @@
|
||||
(def chan (ev/chan 1000))
|
||||
(var is-win (or (= :mingw (os/which)) (= :windows (os/which))))
|
||||
(var is-linux (= :linux (os/which)))
|
||||
(def bsds [:freebsd :macos :openbsd :bsd :dragonfly :netbsd])
|
||||
(var is-kqueue (index-of (os/which) bsds))
|
||||
|
||||
# If not supported, exit early
|
||||
(def [supported msg] (protect (filewatch/new chan)))
|
||||
@@ -97,6 +99,10 @@
|
||||
(filewatch/add fw (string td3 "/file3.txt") :close-write :create :delete)
|
||||
(filewatch/add fw td1 :close-write :create :delete)
|
||||
(filewatch/add fw td2 :close-write :create :delete :ignored))
|
||||
(when is-kqueue
|
||||
(filewatch/add fw (string td3 "/file3.txt") :all)
|
||||
(filewatch/add fw td1 :all)
|
||||
(filewatch/add fw td2 :all))
|
||||
(assert-no-error "filewatch/listen no error" (filewatch/listen fw))
|
||||
|
||||
#
|
||||
@@ -196,6 +202,30 @@
|
||||
(expect-empty)
|
||||
(gccollect))
|
||||
|
||||
#
|
||||
# Macos and BSD file writing
|
||||
#
|
||||
|
||||
# TODO - kqueue capabilities here are a bit more limited than inotify and windows by default.
|
||||
# This could be ammended with some heavier-weight functionality in userspace, though.
|
||||
(when is-kqueue
|
||||
(spit-file td1 "file1.txt")
|
||||
(expect :wd-path td1 :type :write)
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
(spit-file td1 "file1.txt")
|
||||
# Currently, only operations that modify the parent vnode do anything
|
||||
(expect-empty)
|
||||
(gccollect)
|
||||
# Check that we don't get anymore events from test directory 2
|
||||
(spit-file td2 "file2.txt")
|
||||
(expect :wd-path td2 :type :write)
|
||||
(expect-empty)
|
||||
# Remove a file, then wait for remove event
|
||||
(rmrf (string td1 "/file1.txt"))
|
||||
(expect :type :write) # a "write" to the vnode
|
||||
(expect-empty))
|
||||
|
||||
(assert-no-error "filewatch/unlisten no error" (filewatch/unlisten fw))
|
||||
(assert-no-error "cleanup 1" (rmrf td1))
|
||||
(assert-no-error "cleanup 2" (rmrf td2))
|
||||
|
||||
@@ -37,7 +37,7 @@
|
||||
|
||||
# Printing to functions
|
||||
# 4e263b8c3
|
||||
(def out-buf @"")
|
||||
(def out-buf :shadow @"")
|
||||
(defn prepend [x]
|
||||
(with-dyns [:out out-buf]
|
||||
(prin "> " x)))
|
||||
@@ -55,13 +55,12 @@
|
||||
(file/flush f)
|
||||
(file/seek f :set 0)
|
||||
(assert (= 0 (file/tell f)) "start of file again")
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work")
|
||||
(assert-no-error "fsync" (file/sync f)))
|
||||
(assert (= (string (file/read f :all)) "foo\n") "temp files work"))
|
||||
|
||||
# issue #1055 - 2c927ea76
|
||||
(let [b @""]
|
||||
(defn dummy [a b c]
|
||||
(+ a b c))
|
||||
(defn dummy [a bb c]
|
||||
(+ a bb c))
|
||||
(trace dummy)
|
||||
(defn errout [arg]
|
||||
(buffer/push b arg))
|
||||
@@ -75,13 +74,9 @@
|
||||
(defn to-b [a] (buffer/push b a))
|
||||
(xprintf to-b "123")
|
||||
(assert (deep= b @"123\n") "xprintf to buffer")
|
||||
(assert-error "cannot print to 3" (xprintf 3 "123"))
|
||||
|
||||
# file/sync
|
||||
(with [f (file/temp)]
|
||||
(file/write f "123abc")
|
||||
(file/flush f)
|
||||
(file/sync f))
|
||||
|
||||
(assert-error "cannot print to 3" (xprintf 3 "123"))
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -95,11 +95,11 @@
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f1 :shadow [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(error [f1 f2]))
|
||||
(def [_ tup] (protect (f1 @[0])))
|
||||
(def [f1 f2] (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(def [f1 f2] :shadow (unmarshal (marshal tup make-image-dict) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-non-resumable-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-non-resumable-closure 2"))
|
||||
|
||||
@@ -108,10 +108,10 @@
|
||||
(do
|
||||
(defn f1
|
||||
[a]
|
||||
(defn f1 [] (++ (a 0)))
|
||||
(defn f2 [] (++ (a 0)))
|
||||
(defn f1 :shadow [] (++ (a 0)))
|
||||
(defn f2 :shadow [] (++ (a 0)))
|
||||
(marshal [f1 f2] make-image-dict))
|
||||
(def [f1 f2] (unmarshal (f1 @[0]) load-image-dict))
|
||||
(def [f1 f2] :shadow (unmarshal (f1 @[0]) load-image-dict))
|
||||
(assert (= 1 (f1)) "marshal-live-closure 1")
|
||||
(assert (= 2 (f2)) "marshal-live-closure 2"))
|
||||
|
||||
@@ -189,11 +189,11 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (deep= t tclone) "table/weak marsh 7")
|
||||
|
||||
# table weak keys
|
||||
(def t (table/weak-keys 1))
|
||||
(def t :shadow (table/weak-keys 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-keys marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-keys marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length tclone)) "table/weak-keys marsh 3")
|
||||
@@ -201,23 +201,23 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
|
||||
(assert (deep= t tclone) "table/weak-keys marsh 5")
|
||||
|
||||
# table weak values
|
||||
(def t (table/weak-values 1))
|
||||
(def t :shadow (table/weak-values 1))
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "table/weak-values marsh 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "table/weak-values marsh 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "table/weak-value marsh 3")
|
||||
(assert (deep= (freeze t) (freeze tclone)) "table/weak-values marsh 4")
|
||||
|
||||
# tables with prototypes
|
||||
(def t (table/weak-values 1))
|
||||
(def t :shadow (table/weak-values 1))
|
||||
(table/setproto t @{:abc 123})
|
||||
(put t @"" keep-value)
|
||||
(put t :key @"")
|
||||
(assert (= 2 (length t)) "marsh weak tables with prototypes 1")
|
||||
(def tclone (-> t marshal unmarshal))
|
||||
(def tclone :shadow (-> t marshal unmarshal))
|
||||
(assert (= 2 (length tclone)) "marsh weak tables with prototypes 2")
|
||||
(gccollect)
|
||||
(assert (= 1 (length t)) "marsh weak tables with prototypes 3")
|
||||
|
||||
@@ -138,13 +138,13 @@
|
||||
|
||||
# Parser clone
|
||||
# 43520ac67
|
||||
(def p (parser/new))
|
||||
(assert (= 7 (parser/consume p "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p))
|
||||
(def p0 (parser/new))
|
||||
(assert (= 7 (parser/consume p0 "(1 2 3 ")) "parser 1")
|
||||
(def p2 (parser/clone p0))
|
||||
(parser/consume p2 ") 1 ")
|
||||
(parser/consume p ") 1 ")
|
||||
(assert (deep= (parser/status p) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p) (parser/state p2)) "parser 3")
|
||||
(parser/consume p0 ") 1 ")
|
||||
(assert (deep= (parser/status p0) (parser/status p2)) "parser 2")
|
||||
(assert (deep= (parser/state p0) (parser/state p2)) "parser 3")
|
||||
|
||||
# Parser errors
|
||||
# 976dfc719
|
||||
@@ -179,11 +179,11 @@
|
||||
(parser/consume p1 step1)
|
||||
(loop [_ :iterate (parser/produce p1)])
|
||||
(parser/state p1)
|
||||
(def p2 (parser/clone p1))
|
||||
(parser/state p2)
|
||||
(parser/consume p2 step2)
|
||||
(loop [_ :iterate (parser/produce p2)])
|
||||
(parser/state p2)
|
||||
(def p3 (parser/clone p1))
|
||||
(parser/state p3)
|
||||
(parser/consume p3 step2)
|
||||
(loop [_ :iterate (parser/produce p3)])
|
||||
(parser/state p3)
|
||||
|
||||
# parser delimiter errors
|
||||
(defn test-error [delim fmt]
|
||||
@@ -202,11 +202,11 @@
|
||||
(parser/consume p ")")
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
|
||||
(def p (parser/new))
|
||||
(parser/consume p `("hel`)
|
||||
(parser/insert p `lo`)
|
||||
(parser/consume p `")`)
|
||||
(assert (= (parser/produce p) ["hello"]))
|
||||
(def p4 (parser/new))
|
||||
(parser/consume p4 `("hel`)
|
||||
(parser/insert p4 `lo`)
|
||||
(parser/consume p4 `")`)
|
||||
(assert (= (parser/produce p4) ["hello"]))
|
||||
|
||||
# Hex floats
|
||||
(assert (= math/pi +0x1.921fb54442d18p+0001))
|
||||
|
||||
@@ -84,10 +84,10 @@
|
||||
|
||||
# Substitution test with peg
|
||||
# d7626f8c5
|
||||
(def grammar '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(def grammar1 '(accumulate (any (+ (/ "dog" "purple panda") (<- 1)))))
|
||||
(defn try-grammar [text]
|
||||
(assert (= (string/replace-all "dog" "purple panda" text)
|
||||
(0 (peg/match grammar text))) text))
|
||||
(0 (peg/match grammar1 text))) text))
|
||||
|
||||
(try-grammar "i have a dog called doug the dog. he is good.")
|
||||
(try-grammar "i have a dog called doug the dog. he is a good boy.")
|
||||
@@ -336,7 +336,7 @@
|
||||
|
||||
# unref
|
||||
# 96513665d
|
||||
(def grammar
|
||||
(def grammar2
|
||||
(peg/compile
|
||||
~{:main (* :tagged -1)
|
||||
:tagged (unref (replace (* :open-tag :value :close-tag) ,struct))
|
||||
@@ -344,9 +344,9 @@
|
||||
:value (* (constant :value) (group (any (+ :tagged :untagged))))
|
||||
:close-tag (* "</" (backmatch :tag-name) ">")
|
||||
:untagged (capture (any (if-not "<" 1)))}))
|
||||
(check-deep grammar "<p><em>foobar</em></p>"
|
||||
(check-deep grammar2 "<p><em>foobar</em></p>"
|
||||
@[{:tag "p" :value @[{:tag "em" :value @["foobar"]}]}])
|
||||
(check-deep grammar "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
(check-deep grammar2 "<p>foobar</p>" @[{:tag "p" :value @["foobar"]}])
|
||||
|
||||
# Using a large test grammar
|
||||
# cf05ff610
|
||||
@@ -369,7 +369,7 @@
|
||||
(def sym (symbol text))
|
||||
[(if (or (root-env sym) (specials sym)) :coresym :symbol) text])
|
||||
|
||||
(def grammar
|
||||
(def grammar3
|
||||
~{:ws (set " \v\t\r\f\n\0")
|
||||
:readermac (set "';~,")
|
||||
:symchars (+ (range "09" "AZ" "az" "\x80\xFF")
|
||||
@@ -408,13 +408,13 @@
|
||||
:dict (* '"@" :struct)
|
||||
:main (+ :root (error ""))})
|
||||
|
||||
(def p (peg/compile grammar))
|
||||
(def porig (peg/compile grammar3))
|
||||
|
||||
# Just make sure is valgrind clean.
|
||||
(def p (-> p make-image load-image))
|
||||
(def pprime (-> porig make-image load-image))
|
||||
|
||||
(assert (peg/match p "abc") "complex peg grammar 1")
|
||||
(assert (peg/match p "[1 2 3 4]") "complex peg grammar 2")
|
||||
(assert (peg/match pprime "abc") "complex peg grammar 1")
|
||||
(assert (peg/match pprime "[1 2 3 4]") "complex peg grammar 2")
|
||||
|
||||
###
|
||||
### Compiling brainfuck to Janet.
|
||||
@@ -565,8 +565,8 @@
|
||||
"peg/replace-all function")
|
||||
|
||||
# 9dc7e8ed3
|
||||
(defn peg-test [name f peg subst text expected]
|
||||
(assert (= (string (f peg subst text)) expected) name))
|
||||
(defn peg-test [name f pegg subst text expected]
|
||||
(assert (= (string (f pegg subst text)) expected) name))
|
||||
|
||||
(peg-test "peg/replace has access to captures"
|
||||
peg/replace
|
||||
@@ -602,10 +602,10 @@
|
||||
|
||||
# Marshal and unmarshal pegs
|
||||
# 446ab037b
|
||||
(def p (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p "abcd") "peg marshal 1")
|
||||
(assert (peg/match p "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p "zabcdefg")) "peg marshal 3")
|
||||
(def p3 (-> "abcd" peg/compile marshal unmarshal))
|
||||
(assert (peg/match p3 "abcd") "peg marshal 1")
|
||||
(assert (peg/match p3 "abcdefg") "peg marshal 2")
|
||||
(assert (not (peg/match p3 "zabcdefg")) "peg marshal 3")
|
||||
|
||||
# to/thru bug
|
||||
# issue #971 - a895219d2
|
||||
@@ -669,10 +669,10 @@
|
||||
(peg/match '(if (not (* (constant 7) "a")) "hello") "hello")
|
||||
@[]) "peg if not")
|
||||
|
||||
(defn test [name peg input expected]
|
||||
(assert-no-error "compile peg" (peg/compile peg))
|
||||
(assert-no-error "marshal/unmarshal peg" (-> peg marshal unmarshal))
|
||||
(assert (deep= (peg/match peg input) expected) name))
|
||||
(defn test [name pegg input expected]
|
||||
(assert-no-error "compile peg" (peg/compile pegg))
|
||||
(assert-no-error "marshal/unmarshal peg" (-> pegg marshal unmarshal))
|
||||
(assert (deep= (peg/match pegg input) expected) name))
|
||||
|
||||
(test "sub: matches the same input twice"
|
||||
~(sub "abcd" "abc")
|
||||
@@ -852,20 +852,20 @@
|
||||
@[["b" "b" "b"]])
|
||||
|
||||
# Debug and ?? tests.
|
||||
(defn test-stderr [name peg input expected-matches expected-stderr]
|
||||
(defn test-stderr [name pegg input expected-matches expected-stderr]
|
||||
(with-dyns [:err @""]
|
||||
(test name peg input expected-matches))
|
||||
(test name pegg input expected-matches))
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* true]
|
||||
(peg/match peg input))
|
||||
(peg/match pegg input))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(defn test-stderr-no-color [name peg input expected-matches expected-stderr]
|
||||
(defn test-stderr-no-color [name pegg input expected-matches expected-stderr]
|
||||
(with-dyns [:err @""]
|
||||
(test name peg input expected-matches))
|
||||
(test name pegg input expected-matches))
|
||||
(def actual @"")
|
||||
(with-dyns [:err actual *err-color* false]
|
||||
(peg/match peg input))
|
||||
(peg/match pegg input))
|
||||
(assert (deep= (string actual) expected-stderr)))
|
||||
|
||||
(test-stderr
|
||||
|
||||
@@ -44,8 +44,8 @@
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p---" buftemp))
|
||||
`abcd---@"abcd"---`) "buffer/format on self 1")
|
||||
(def buftemp @"abcd")
|
||||
(assert (= (string (buffer/format buftemp "---%p %p---" buftemp buftemp))
|
||||
(def buftemp2 @"abcd")
|
||||
(assert (= (string (buffer/format buftemp2 "---%p %p---" buftemp2 buftemp2))
|
||||
`abcd---@"abcd" @"abcd"---`) "buffer/format on self 2")
|
||||
|
||||
# 5c364e0
|
||||
@@ -61,5 +61,68 @@
|
||||
(check-jdn "a string")
|
||||
(check-jdn @"a buffer")
|
||||
|
||||
# Test multiline pretty specifiers
|
||||
(let [tup [:keyword "string" @"buffer"]
|
||||
tab @{true (table/setproto @{:bar tup
|
||||
:baz 42}
|
||||
@{:_name "Foo"})}]
|
||||
(set (tab tup) tab)
|
||||
(assert (= (string/format "%m" {tup @[tup tab]
|
||||
'symbol tup})
|
||||
`
|
||||
{symbol (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") @[(:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
@{true @Foo{:bar (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
:baz 42}
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") <cycle 2>}]}`))
|
||||
(assert (= (string/format "%p" {(freeze (zipcoll (range 42)
|
||||
(range -42 0))) tab})
|
||||
`
|
||||
{{0 -42
|
||||
1 -41
|
||||
2 -40
|
||||
3 -39
|
||||
4 -38
|
||||
5 -37
|
||||
6 -36
|
||||
7 -35
|
||||
8 -34
|
||||
9 -33
|
||||
10 -32
|
||||
11 -31
|
||||
12 -30
|
||||
13 -29
|
||||
14 -28
|
||||
15 -27
|
||||
16 -26
|
||||
17 -25
|
||||
18 -24
|
||||
19 -23
|
||||
20 -22
|
||||
21 -21
|
||||
22 -20
|
||||
23 -19
|
||||
24 -18
|
||||
25 -17
|
||||
26 -16
|
||||
27 -15
|
||||
28 -14
|
||||
29 -13
|
||||
...} @{true @Foo{:bar (:keyword
|
||||
"string"
|
||||
@"buffer")
|
||||
:baz 42}
|
||||
(:keyword
|
||||
"string"
|
||||
@"buffer") <cycle 1>}}`)))
|
||||
(end-suite)
|
||||
|
||||
|
||||
@@ -132,11 +132,11 @@
|
||||
|
||||
# Cancel test
|
||||
# 28439d822
|
||||
(def f (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume f)) "cancel resume 1")
|
||||
(assert (= 2 (resume f)) "cancel resume 2")
|
||||
(assert (= :hi (cancel f :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status f)) "cancel resume 4")
|
||||
(def fc (fiber/new (fn [&] (yield 1) (yield 2) (yield 3) 4) :yti))
|
||||
(assert (= 1 (resume fc)) "cancel resume 1")
|
||||
(assert (= 2 (resume fc)) "cancel resume 2")
|
||||
(assert (= :hi (cancel fc :hi)) "cancel resume 3")
|
||||
(assert (= :error (fiber/status fc)) "cancel resume 4")
|
||||
|
||||
(end-suite)
|
||||
|
||||
|
||||
Reference in New Issue
Block a user