1
0
mirror of https://github.com/janet-lang/janet synced 2025-11-12 05:23:02 +00:00

Compare commits

..

1 Commits

Author SHA1 Message Date
Calvin Rose
1808c923bf Make negative indexing work like python.
This would break a lot of code :|
2023-07-14 17:18:20 -05:00
33 changed files with 323 additions and 776 deletions

View File

@@ -1,19 +1,7 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.31.0 - 2023-09-17
- Report line and column when using `janet_dobytes`
- Add `:unless` loop modifier
- Allow calling `reverse` on generators.
- Improve performance of a number of core functions including `partition`, `mean`, `keys`, `values`, `pairs`, `interleave`.
- Add `lengthable?`
- Add `os/sigaction`
- Change `every?` and `any?` to behave like the functional versions of the `and` and `or` macros.
- Fix bug with garbage collecting threaded abstract types.
- Add `:signal` to the `sandbox` function to allow intercepting signals.
## 1.30.0 - 2023-08-05
- Change indexing of `array/remove` to start from -1 at the end instead of -2.
## Unreleased - ???
- Add new string escape sequences `\\a`, `\\b`, `\\?`, and `\\'`.
- Fix bug with marshalling channels
- Add `div` for floored division

View File

@@ -48,7 +48,6 @@ SONAME_SETTER=-Wl,-soname,
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
# Symbols are (optionally) removed later, keep -g as default!
CFLAGS?=-O2 -g
LDFLAGS?=-rdynamic
RUN:=$(RUN)
@@ -196,9 +195,9 @@ build/%.bin.o: src/%.c $(JANET_HEADERS) $(JANET_LOCAL_HEADERS) Makefile
########################
ifeq ($(UNAME), Darwin)
SONAME=libjanet.1.31.dylib
SONAME=libjanet.1.29.dylib
else
SONAME=libjanet.so.1.31
SONAME=libjanet.so.1.29
endif
build/c/shell.c: src/mainclient/shell.c
@@ -267,7 +266,6 @@ build/janet-%.tar.gz: $(JANET_TARGET) \
README.md build/c/janet.c build/c/shell.c
mkdir -p build/$(JANET_DIST_DIR)/bin
cp $(JANET_TARGET) build/$(JANET_DIST_DIR)/bin/
strip -x -S 'build/$(JANET_DIST_DIR)/bin/janet'
mkdir -p build/$(JANET_DIST_DIR)/include
cp build/janet.h build/$(JANET_DIST_DIR)/include/
mkdir -p build/$(JANET_DIST_DIR)/lib/
@@ -366,7 +364,7 @@ build/janet.tmLanguage: tools/tm_lang_gen.janet $(JANET_TARGET)
$(RUN) $(JANET_TARGET) $< > $@
compile-commands:
# Requires pip install compiledb
# Requires pip install copmiledb
compiledb make
clean:

View File

@@ -1,41 +0,0 @@
###
### Usage: janet examples/sigaction.janet 1|2|3|4 &
###
### Then at shell: kill -s SIGTERM $!
###
(defn action
[]
(print "Handled SIGTERM!")
(flush)
(os/exit 1))
(defn main1
[]
(os/sigaction :term action true)
(forever))
(defn main2
[]
(os/sigaction :term action)
(forever))
(defn main3
[]
(os/sigaction :term action true)
(forever (ev/sleep math/inf)))
(defn main4
[]
(os/sigaction :term action)
(forever (ev/sleep math/inf)))
(defn main
[& args]
(def which (scan-number (get args 1 "1")))
(case which
1 (main1) # should work
2 (main2) # will not work
3 (main3) # should work
4 (main4) # should work
(error "bad main")))

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'build.c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.31.0')
version : '1.29.1')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')

View File

@@ -18,7 +18,7 @@ option('realpath', type : 'boolean', value : true)
option('simple_getline', type : 'boolean', value : false)
option('epoll', type : 'boolean', value : false)
option('kqueue', type : 'boolean', value : false)
option('interpreter_interrupt', type : 'boolean', value : true)
option('interpreter_interrupt', type : 'boolean', value : false)
option('ffi', type : 'boolean', value : true)
option('ffi_jit', type : 'boolean', value : true)

View File

@@ -103,13 +103,23 @@
(defn symbol? "Check if x is a symbol." [x] (= (type x) :symbol))
(defn keyword? "Check if x is a keyword." [x] (= (type x) :keyword))
(defn buffer? "Check if x is a buffer." [x] (= (type x) :buffer))
(defn function? "Check if x is a function (not a cfunction)." [x] (= (type x) :function))
(defn function? "Check if x is a function (not a cfunction)." [x]
(= (type x) :function))
(defn cfunction? "Check if x a cfunction." [x] (= (type x) :cfunction))
(defn table? "Check if x a table." [x] (= (type x) :table))
(defn struct? "Check if x a struct." [x] (= (type x) :struct))
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
(def t (type x))
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
(defn dictionary? "Check if x is a table or struct." [x]
(def t (type x))
(if (= t :table) true (= t :struct)))
(defn indexed? "Check if x is an array or tuple." [x]
(def t (type x))
(if (= t :array) true (= t :tuple)))
(defn truthy? "Check if x is truthy." [x] (if x true false))
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
@@ -419,11 +429,9 @@
(error (string "expected tuple for range, got " x))))
(defn- range-template
[binding object kind rest op comparison]
[binding object rest op comparison]
(let [[start stop step] (check-indexed object)]
(case kind
:range (for-template binding (if stop start 0) (or stop start) (or step 1) comparison op [rest])
:down (for-template binding start (or stop 0) (or step 1) comparison op [rest]))))
(for-template binding start stop (or step 1) comparison op [rest])))
(defn- each-template
[binding inx kind body]
@@ -438,8 +446,8 @@
:each ~(,in ,ds ,k)
:keys k
:pairs ~[,k (,in ,ds ,k)]))
(set ,k (,next ,ds ,k))
,;body))))
,;body
(set ,k (,next ,ds ,k))))))
(defn- iterate-template
[binding expr body]
@@ -473,17 +481,16 @@
:repeat (with-syms [iter]
~(do (var ,iter ,verb) (while (> ,iter 0) ,rest (-- ,iter))))
:when ~(when ,verb ,rest)
:unless ~(unless ,verb ,rest)
(error (string "unexpected loop modifier " binding))))))
# 3 term expression
(def {(+ i 2) object} head)
(let [rest (loop1 body head (+ i 3))]
(case verb
:range (range-template binding object :range rest + <)
:range-to (range-template binding object :range rest + <=)
:down (range-template binding object :down rest - >)
:down-to (range-template binding object :down rest - >=)
:range (range-template binding object rest + <)
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:keys (each-template binding object :keys [rest])
:pairs (each-template binding object :pairs [rest])
:in (each-template binding object :each [rest])
@@ -644,12 +651,7 @@
(defn mean
"Returns the mean of xs. If empty, returns NaN."
[xs]
(if (lengthable? xs)
(/ (sum xs) (length xs))
(do
(var [accum total] [0 0])
(each x xs (+= accum x) (++ total))
(/ accum total))))
(/ (sum xs) (length xs)))
(defn product
"Returns the product of xs. If xs is empty, returns 1."
@@ -698,7 +700,7 @@
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
(let [[f g h i] functions]
(comp (fn [x] (f (g (h (i x)))))
;(tuple/slice functions 4 -1)))))
;(tuple/slice functions 4)))))
(defn identity
"A function that returns its argument."
@@ -710,38 +712,30 @@
[f]
(fn [x] (not (f x))))
(defmacro- do-extreme
[order args]
~(do
(def ds ,args)
(var k (next ds nil))
(var ret (get ds k))
(while (,not= nil (set k (next ds k)))
(def x (in ds k))
(if (,order x ret) (set ret x)))
ret))
(defn extreme
``Returns the most extreme value in `args` based on the function `order`.
`order` should take two values and return true or false (a comparison).
Returns nil if `args` is empty.``
[order args] (do-extreme order args))
[order args]
(var [ret] args)
(each x args (if (order x ret) (set ret x)))
ret)
(defn max
"Returns the numeric maximum of the arguments."
[& args] (do-extreme > args))
[& args] (extreme > args))
(defn min
"Returns the numeric minimum of the arguments."
[& args] (do-extreme < args))
[& args] (extreme < args))
(defn max-of
"Returns the numeric maximum of the argument sequence."
[args] (do-extreme > args))
[args] (extreme > args))
(defn min-of
"Returns the numeric minimum of the argument sequence."
[args] (do-extreme < args))
[args] (extreme < args))
(defn first
"Get the first element from an indexed data structure."
@@ -755,14 +749,6 @@
## Polymorphic comparisons
(defmacro- do-compare
[x y]
~(if (def f (get ,x :compare))
(f ,x ,y)
(if (def f (get ,y :compare))
(- (f ,y ,x))
(cmp ,x ,y))))
(defn compare
``Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
@@ -770,18 +756,20 @@
compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.``
[x y]
(do-compare x y))
(or
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(defmacro- compare-reduce [op xs]
~(do
(var res true)
(var x (get ,xs 0))
(forv i 1 (length ,xs)
(let [y (in ,xs i)]
(if (,op (do-compare x y) 0)
(set x y)
(do (set res false) (break)))))
res))
(defn- compare-reduce [op xs]
(var r true)
(loop [i :range [0 (- (length xs) 1)]
:let [c (compare (xs i) (xs (+ i 1)))
ok (op c 0)]
:when (not ok)]
(set r false)
(break))
r)
(defn compare=
``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
@@ -821,31 +809,21 @@
###
###
(defmacro- median-of-three
[x y z]
~(if (<= ,x ,y)
(if (<= ,y ,z) ,y (if (<= ,z ,x) ,x ,z))
(if (<= ,z ,y) ,y (if (<= ,x ,z) ,x ,z))))
(defmacro- sort-partition-template
[ind before? left right pivot]
~(do
(while (,before? (in ,ind ,left) ,pivot) (++ ,left))
(while (,before? ,pivot (in ,ind ,right)) (-- ,right))))
(defn- median-of-three [a b c]
(if (not= (> a b) (> a c))
a
(if (not= (> b a) (> b c)) b c)))
(defn- sort-help [a lo hi before?]
(when (< lo hi)
(def [x y z] [(in a lo)
(in a (div (+ lo hi) 2))
(in a hi)])
(def pivot (median-of-three x y z))
(def pivot
(median-of-three (in a hi) (in a lo)
(in a (math/floor (/ (+ lo hi) 2)))))
(var left lo)
(var right hi)
(while true
(case before?
< (sort-partition-template a < left right pivot)
> (sort-partition-template a > left right pivot)
(sort-partition-template a before? left right pivot))
(while (before? (in a left) pivot) (++ left))
(while (before? pivot (in a right)) (-- right))
(when (<= left right)
(def tmp (in a left))
(set (a left) (in a right))
@@ -853,10 +831,8 @@
(++ left)
(-- right))
(if (>= left right) (break)))
(if (< lo right)
(sort-help a lo right before?))
(if (< left hi)
(sort-help a left hi before?)))
(sort-help a lo right before?)
(sort-help a left hi before?))
a)
(defn sort
@@ -864,8 +840,7 @@
If a `before?` comparator function is provided, sorts elements using that,
otherwise uses `<`.``
[ind &opt before?]
(default before? <)
(sort-help ind 0 (- (length ind) 1) before?))
(sort-help ind 0 (- (length ind) 1) (or before? <)))
(defn sort-by
``Sorts `ind` in-place by calling a function `f` on each element and
@@ -972,6 +947,7 @@
1 (map-n 1 ,maptype ,res ,f ,ind ,inds)
2 (map-n 2 ,maptype ,res ,f ,ind ,inds)
3 (map-n 3 ,maptype ,res ,f ,ind ,inds)
4 (map-n 4 ,maptype ,res ,f ,ind ,inds)
(do
(def iter-keys (array/new-filled ninds))
(def call-buffer (array/new-filled ninds))
@@ -1031,6 +1007,30 @@
(map-template :keep res pred ind inds)
res)
(defn range
`Create an array of values [start, end) with a given step.
With one argument, returns a range [0, end). With two arguments, returns
a range [start, end). With three, returns a range with optional step size.`
[& args]
(case (length args)
1 (do
(def [n] args)
(def arr (array/new n))
(forv i 0 n (put arr i i))
arr)
2 (do
(def [n m] args)
(def arr (array/new (- m n)))
(forv i n m (put arr (- i n) i))
arr)
3 (do
(def [n m s] args)
(cond
(zero? s) @[]
(neg? s) (seq [i :down [n m (- s)]] i)
(seq [i :range [n m s]] i)))
(error "expected 1 to 3 arguments to range")))
(defn find-index
``Find the index of indexed type for which `pred` is true. Returns `dflt` if not found.``
[pred ind &opt dflt]
@@ -1208,7 +1208,7 @@
(assert (symbol? alias) "alias must be a symbol")
(assert (and (> (length alias) 2) (= 42 (first alias) (last alias))) "name must have leading and trailing '*' characters")
(def prefix (dyn :defdyn-prefix))
(def kw (keyword prefix (slice alias 1 -2)))
(def kw (keyword prefix (slice alias 1 -1)))
~(def ,alias :dyn ,;more ,kw))
(defn has-key?
@@ -1439,50 +1439,48 @@
(fn [& r] (f ;more ;r))))
(defn every?
``Evaluates to the last element of `ind` if all preceding elements are truthy,
otherwise evaluates to the first falsey element.``
``Returns true if each value in `ind` is truthy, otherwise returns the first
falsey value.``
[ind]
(var res true)
(loop [x :in ind :while res]
(set res x))
(if x nil (set res x)))
res)
(defn any?
``Evaluates to the last element of `ind` if all preceding elements are falsey,
otherwise evaluates to the first truthy element.``
``Returns the first truthy value in `ind`, otherwise nil.``
[ind]
(var res nil)
(loop [x :in ind :until res]
(set res x))
(if x (set res x)))
res)
(defn reverse!
`Reverses the order of the elements in a given array or buffer and returns it
mutated.`
[t]
(var i 0)
(var j (length t))
(while (< i (-- j))
(def ti (in t i))
(put t i (in t j))
(put t j ti)
(++ i))
(def len-1 (- (length t) 1))
(def half (/ len-1 2))
(forv i 0 half
(def j (- len-1 i))
(def l (in t i))
(def r (in t j))
(put t i r)
(put t j l))
t)
(defn reverse
`Reverses the order of the elements in a given array or tuple and returns
a new array. If a string or buffer is provided, returns a buffer instead.`
a new array. If a string or buffer is provided, returns an array of its
byte values, reversed.`
[t]
(if (lengthable? t)
(do
(var n (length t))
(def ret (if (bytes? t)
(buffer/new-filled n)
(array/new-filled n)))
(each v t
(put ret (-- n) v))
ret)
(reverse! (seq [v :in t] v))))
(def len (length t))
(var n (- len 1))
(def ret (array/new len))
(while (>= n 0)
(array/push ret (in t n))
(-- n))
ret)
(defn invert
``Given an associative data structure `ds`, returns a new table where the
@@ -1592,41 +1590,32 @@
(defn keys
"Get the keys of an associative data structure."
[x]
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachk k x
(put arr i k)
(++ i))
arr)
(seq [k :keys x] k)))
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr k)
(set k (next x k)))
arr)
(defn values
"Get the values of an associative data structure."
[x]
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(each v x
(put arr i v)
(++ i))
arr)
(seq [v :in x] v)))
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (in x k))
(set k (next x k)))
arr)
(defn pairs
"Get the key-value pairs of an associative data structure."
[x]
(if (lengthable? x)
(do
(def arr (array/new-filled (length x)))
(var i 0)
(eachp p x
(put arr i p)
(++ i))
arr)
(seq [p :pairs x] p)))
(def arr @[])
(var k (next x nil))
(while (not= nil k)
(array/push arr (tuple k (in x k)))
(set k (next x k)))
arr)
(defn frequencies
"Get the number of occurrences of each value in an indexed data structure."
@@ -1671,7 +1660,14 @@
(defn interleave
"Returns an array of the first elements of each col, then the second elements, etc."
[& cols]
(mapcat tuple ;cols))
(def res @[])
(def ncol (length cols))
(when (> ncol 0)
(def len (min ;(map length cols)))
(loop [i :range [0 len]
ci :range [0 ncol]]
(array/push res (in (in cols ci) i))))
res)
(defn distinct
"Returns an array of the deduplicated values in `xs`."
@@ -1718,46 +1714,29 @@
``Returns a sequence of the elements of `ind` separated by
`sep`. Returns a new array.``
[sep ind]
(var k (next ind nil))
(if (not= nil k)
(if (lengthable? ind)
(do
(def ret (array/new-filled (- (* 2 (length ind)) 1) sep))
(var i 0)
(while (not= nil k)
(put ret i (in ind k))
(set k (next ind k))
(+= i 2))
ret)
(do
(def ret @[(in ind k)])
(while (not= nil (set k (next ind k)))
(array/push ret sep (in ind k)))
ret))
@[]))
(defn- partition-slice
[f n ind]
(var [start end] [0 n])
(def len (length ind))
(def parts (div len n))
(def ret (array/new-filled parts))
(forv k 0 parts
(put ret k (f ind start end))
(set start end)
(+= end n))
(if (< start len)
(array/push ret (f ind start)))
(def ret (array/new (- (* 2 len) 1)))
(if (> len 0) (put ret 0 (in ind 0)))
(var i 1)
(while (< i len)
(array/push ret sep (in ind i))
(++ i))
ret)
(defn partition
``Partition an indexed data structure `ind` into tuples
of size `n`. Returns a new array.``
[n ind]
(cond
(indexed? ind) (partition-slice tuple/slice n ind)
(bytes? ind) (partition-slice string/slice n ind)
(partition-slice tuple/slice n (values ind))))
(var i 0) (var nextn n)
(def len (length ind))
(def ret (array/new (math/ceil (/ len n))))
(def slicer (if (bytes? ind) string/slice tuple/slice))
(while (<= nextn len)
(array/push ret (slicer ind i nextn))
(set i nextn)
(+= nextn n))
(if (not= i len) (array/push ret (slicer ind i)))
ret)
###
###
@@ -1842,7 +1821,7 @@
# Partition body into sections.
(def oddlen (odd? (length cases)))
(def else (if oddlen (last cases)))
(def patterns (partition 2 (if oddlen (slice cases 0 -2) cases)))
(def patterns (partition 2 (if oddlen (slice cases 0 -1) cases)))
# Keep an array for accumulating the compilation output
(def x-sym (if (idempotent? x) x (gensym)))
@@ -2073,7 +2052,7 @@
(tuple/slice
(array/concat
@[(in t 0) (expand-bindings bound)]
(tuple/slice t 2 -2)
(tuple/slice t 2 -1)
@[(recur last)])))
(defn expandall [t]
@@ -2248,7 +2227,7 @@
[name & body]
(def expansion (apply defn name body))
(def fbody (last expansion))
(def modifiers (tuple/slice expansion 2 -2))
(def modifiers (tuple/slice expansion 2 -1))
(def metadata @{})
(each m modifiers
(cond
@@ -2904,12 +2883,7 @@
(if (= :dead fs)
(when is-repl
(put env '_ @{:value x})
(def pf (get env *pretty-format* "%q"))
(try
(printf pf x)
([e]
(eprintf "bad pretty format %v: %v" pf e)
(eflush)))
(printf (get env *pretty-format* "%q") x)
(flush))
(do
(debug/stacktrace f x "")
@@ -2943,7 +2917,7 @@
(def buf @"")
(with-dyns [*err* buf *err-color* false]
(bad-parse x y))
(set exit-error (string/slice buf 0 -2)))
(set exit-error (string/slice buf 0 -1)))
(defn bc [&opt x y z a b]
(when exit
(bad-compile x y z a b)
@@ -2952,7 +2926,7 @@
(def buf @"")
(with-dyns [*err* buf *err-color* false]
(bad-compile x nil z a b))
(set exit-error (string/slice buf 0 -2))
(set exit-error (string/slice buf 0 -1))
(set exit-fiber y))
(unless f
(error (string "could not find file " path)))
@@ -3815,7 +3789,7 @@
"Generate bindings for native functions in a convenient manner."
[name ret-type & body]
(def real-ret-type (eval ret-type))
(def meta (slice body 0 -2))
(def meta (slice body 0 -1))
(def arg-pairs (partition 2 (last body)))
(def formal-args (map 0 arg-pairs))
(def type-args (map 1 arg-pairs))

View File

@@ -4,10 +4,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 30
#define JANET_VERSION_MINOR 29
#define JANET_VERSION_PATCH 1
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.31.0"
#define JANET_VERSION "1.29.1"
/* #define JANET_BUILD "local" */

View File

@@ -177,8 +177,8 @@ JANET_CORE_FN(cfun_array_peek,
}
JANET_CORE_FN(cfun_array_push,
"(array/push arr & xs)",
"Push all the elements of xs to the end of an array. Modifies the input array and returns it.") {
"(array/push arr x)",
"Insert an element in the end of an array. Modifies the input array and returns it.") {
janet_arity(argc, 1, -1);
JanetArray *array = janet_getarray(argv, 0);
if (INT32_MAX - argc + 1 <= array->count) {
@@ -211,7 +211,7 @@ JANET_CORE_FN(cfun_array_slice,
"Takes a slice of array or tuple from `start` to `end`. The range is half open, "
"[start, end). Indexes can also be negative, indicating indexing from the "
"end of the array. By default, `start` is 0 and `end` is the length of the array. "
"Note that if the range is negative, it is taken as (start, end] to allow a full "
"Note that index -1 is synonymous with index `(length arrtup)` to allow a full "
"negative slice range. Returns a new array.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
@@ -259,8 +259,8 @@ JANET_CORE_FN(cfun_array_insert,
"(array/insert arr at & xs)",
"Insert all `xs` into array `arr` at index `at`. `at` should be an integer between "
"0 and the length of the array. A negative value for `at` will index backwards from "
"the end of the array, inserting after the index such that inserting at -1 appends to "
"the array. Returns the array.") {
"the end of the array, such that inserting at -1 appends to the array. "
"Returns the array.") {
size_t chunksize, restsize;
janet_arity(argc, 2, -1);
JanetArray *array = janet_getarray(argv, 0);

View File

@@ -221,20 +221,6 @@ JANET_CORE_FN(cfun_buffer_new_filled,
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_frombytes,
"(buffer/from-bytes & byte-vals)",
"Creates a buffer from integer parameters with byte values. All integers "
"will be coerced to the range of 1 byte 0-255.") {
int32_t i;
JanetBuffer *buffer = janet_buffer(argc);
for (i = 0; i < argc; i++) {
int32_t c = janet_getinteger(argv, i);
buffer->data[i] = c & 0xFF;
}
buffer->count = argc;
return janet_wrap_buffer(buffer);
}
JANET_CORE_FN(cfun_buffer_fill,
"(buffer/fill buffer &opt byte)",
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
@@ -476,15 +462,13 @@ JANET_CORE_FN(cfun_buffer_blit,
int same_buf = src.bytes == dest->data;
int32_t offset_dest = 0;
int32_t offset_src = 0;
if (argc > 2 && !janet_checktype(argv[2], JANET_NIL))
if (argc > 2)
offset_dest = janet_gethalfrange(argv, 2, dest->count, "dest-start");
if (argc > 3 && !janet_checktype(argv[3], JANET_NIL))
if (argc > 3)
offset_src = janet_gethalfrange(argv, 3, src.len, "src-start");
int32_t length_src;
if (argc > 4) {
int32_t src_end = src.len;
if (!janet_checktype(argv[4], JANET_NIL))
src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
int32_t src_end = janet_gethalfrange(argv, 4, src.len, "src-end");
length_src = src_end - offset_src;
if (length_src < 0) length_src = 0;
} else {
@@ -523,7 +507,6 @@ void janet_lib_buffer(JanetTable *env) {
JanetRegExt buffer_cfuns[] = {
JANET_CORE_REG("buffer/new", cfun_buffer_new),
JANET_CORE_REG("buffer/new-filled", cfun_buffer_new_filled),
JANET_CORE_REG("buffer/from-bytes", cfun_buffer_frombytes),
JANET_CORE_REG("buffer/fill", cfun_buffer_fill),
JANET_CORE_REG("buffer/trim", cfun_buffer_trim),
JANET_CORE_REG("buffer/push-byte", cfun_buffer_u8),

View File

@@ -334,34 +334,11 @@ size_t janet_getsize(const Janet *argv, int32_t n) {
}
int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length + 1;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length - 1, length);
return not_raw;
}
int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return 0;
}
return janet_gethalfrange(argv, n, length, "start");
}
int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length) {
if (n >= argc || janet_checktype(argv[n], JANET_NIL)) {
return length;
}
return janet_gethalfrange(argv, n, length, "end");
}
int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which) {
int32_t raw = janet_getinteger(argv, n);
int32_t not_raw = raw;
if (not_raw < 0) not_raw += length;
if (not_raw < 0 || not_raw > length)
janet_panicf("%s index %d out of range [%d,%d)", which, raw, -length, length);
janet_panicf("%s index %d out of range [%d,%d]", which, raw, -length, length);
return not_raw;
}
@@ -408,10 +385,24 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
janet_arity(argc, 1, 3);
JanetRange range;
int32_t length = janet_length(argv[0]);
range.start = janet_getstartrange(argv, argc, 1, length);
range.end = janet_getendrange(argv, argc, 2, length);
if (range.end < range.start)
range.end = range.start;
if (argc == 1) {
range.start = 0;
range.end = length;
} else if (argc == 2) {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = length;
} else {
range.start = janet_checktype(argv[1], JANET_NIL)
? 0
: janet_gethalfrange(argv, 1, length, "start");
range.end = janet_checktype(argv[2], JANET_NIL)
? length
: janet_gethalfrange(argv, 2, length, "end");
if (range.end < range.start)
range.end = range.start;
}
return range;
}
@@ -493,7 +484,7 @@ void *janet_optabstract(const Janet *argv, int32_t argc, int32_t n, const JanetA
/* Some definitions for function-like macros */
JANET_API JanetStructHead *(janet_struct_head)(JanetStruct st) {
JANET_API JanetStructHead *(janet_struct_head)(const JanetKV *st) {
return janet_struct_head(st);
}
@@ -501,10 +492,10 @@ JANET_API JanetAbstractHead *(janet_abstract_head)(const void *abstract) {
return janet_abstract_head(abstract);
}
JANET_API JanetStringHead *(janet_string_head)(JanetString s) {
JANET_API JanetStringHead *(janet_string_head)(const uint8_t *s) {
return janet_string_head(s);
}
JANET_API JanetTupleHead *(janet_tuple_head)(JanetTuple tuple) {
JANET_API JanetTupleHead *(janet_tuple_head)(const Janet *tuple) {
return janet_tuple_head(tuple);
}

View File

@@ -426,36 +426,6 @@ JANET_CORE_FN(janet_core_slice,
}
}
JANET_CORE_FN(janet_core_range,
"(range & args)",
"Create an array of values [start, end) with a given step. "
"With one argument, returns a range [0, end). With two arguments, returns "
"a range [start, end). With three, returns a range with optional step size.") {
janet_arity(argc, 1, 3);
int32_t start = 0, stop = 0, step = 1, count = 0;
if (argc == 3) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
step = janet_getinteger(argv, 2);
count = (step > 0) ? (stop - start - 1) / step + 1 :
((step < 0) ? (stop - start + 1) / step + 1 : 0);
} else if (argc == 2) {
start = janet_getinteger(argv, 0);
stop = janet_getinteger(argv, 1);
count = stop - start;
} else {
stop = janet_getinteger(argv, 0);
count = stop;
}
count = (count > 0) ? count : 0;
JanetArray *array = janet_array(count);
for (int32_t i = 0; i < count; i++) {
array->data[i] = janet_wrap_number(start + i * step);
}
array->count = count;
return janet_wrap_array(array);
}
JANET_CORE_FN(janet_core_table,
"(table & kvs)",
"Creates a new table from a variadic number of keys and values. "
@@ -659,34 +629,6 @@ ret_false:
return janet_wrap_false();
}
JANET_CORE_FN(janet_core_is_bytes,
"(bytes? x)",
"Check if x is a string, symbol, keyword, or buffer.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_BYTES));
}
JANET_CORE_FN(janet_core_is_indexed,
"(indexed? x)",
"Check if x is an array or tuple.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_INDEXED));
}
JANET_CORE_FN(janet_core_is_dictionary,
"(dictionary? x)",
"Check if x is a table or struct.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_DICTIONARY));
}
JANET_CORE_FN(janet_core_is_lengthable,
"(lengthable? x)",
"Check if x is a bytes, indexed, or dictionary.") {
janet_fixarity(argc, 1);
return janet_wrap_boolean(janet_checktypes(argv[0], JANET_TFLAG_LENGTHABLE));
}
JANET_CORE_FN(janet_core_signal,
"(signal what x)",
"Raise a signal with payload x. ") {
@@ -748,7 +690,6 @@ static const SandboxOption sandbox_options[] = {
{"net-connect", JANET_SANDBOX_NET_CONNECT},
{"net-listen", JANET_SANDBOX_NET_LISTEN},
{"sandbox", JANET_SANDBOX_SANDBOX},
{"signal", JANET_SANDBOX_SIGNAL},
{"subprocess", JANET_SANDBOX_SUBPROCESS},
{NULL, 0}
};
@@ -773,7 +714,6 @@ JANET_CORE_FN(janet_core_sandbox,
"* :net-connect - disallow making outbound network connections\n"
"* :net-listen - disallow accepting inbound network connections\n"
"* :sandbox - disallow calling this function\n"
"* :signal - disallow adding or removing signal handlers\n"
"* :subprocess - disallow running subprocesses") {
uint32_t flags = 0;
for (int32_t i = 0; i < argc; i++) {
@@ -1083,12 +1023,7 @@ static void janet_load_libs(JanetTable *env) {
JANET_CORE_REG("module/expand-path", janet_core_expand_path),
JANET_CORE_REG("int?", janet_core_check_int),
JANET_CORE_REG("nat?", janet_core_check_nat),
JANET_CORE_REG("bytes?", janet_core_is_bytes),
JANET_CORE_REG("indexed?", janet_core_is_indexed),
JANET_CORE_REG("dictionary?", janet_core_is_dictionary),
JANET_CORE_REG("lengthable?", janet_core_is_lengthable),
JANET_CORE_REG("slice", janet_core_slice),
JANET_CORE_REG("range", janet_core_range),
JANET_CORE_REG("signal", janet_core_signal),
JANET_CORE_REG("memcmp", janet_core_memcmp),
JANET_CORE_REG("getproto", janet_core_getproto),

View File

@@ -127,7 +127,7 @@ static int32_t janet_q_count(JanetQueue *q) {
: (q->tail - q->head);
}
static int janet_q_maybe_resize(JanetQueue *q, size_t itemsize) {
static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
int32_t count = janet_q_count(q);
/* Resize if needed */
if (count + 1 >= q->capacity) {
@@ -151,27 +151,11 @@ static int janet_q_maybe_resize(JanetQueue *q, size_t itemsize) {
}
q->capacity = newcap;
}
return 0;
}
static int janet_q_push(JanetQueue *q, void *item, size_t itemsize) {
if (janet_q_maybe_resize(q, itemsize)) return 1;
memcpy((char *) q->data + itemsize * q->tail, item, itemsize);
q->tail = q->tail + 1 < q->capacity ? q->tail + 1 : 0;
return 0;
}
static int janet_q_push_head(JanetQueue *q, void *item, size_t itemsize) {
if (janet_q_maybe_resize(q, itemsize)) return 1;
int32_t newhead = q->head - 1;
if (newhead < 0) {
newhead += q->capacity;
}
memcpy((char *) q->data + itemsize * newhead, item, itemsize);
q->head = newhead;
return 0;
}
static int janet_q_pop(JanetQueue *q, void *out, size_t itemsize) {
if (q->head == q->tail) return 1;
memcpy(out, (char *) q->data + itemsize * q->head, itemsize);
@@ -484,7 +468,7 @@ const JanetAbstractType janet_stream_type = {
};
/* Register a fiber to resume with value */
static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal sig, int soon) {
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
if (fiber->gc.flags & JANET_FIBER_EV_FLAG_CANCELED) return;
if (!(fiber->gc.flags & JANET_FIBER_FLAG_ROOT)) {
Janet task_element = janet_wrap_fiber(fiber);
@@ -493,19 +477,7 @@ static void janet_schedule_general(JanetFiber *fiber, Janet value, JanetSignal s
JanetTask t = { fiber, value, sig, ++fiber->sched_id };
fiber->gc.flags |= JANET_FIBER_FLAG_ROOT;
if (sig == JANET_SIGNAL_ERROR) fiber->gc.flags |= JANET_FIBER_EV_FLAG_CANCELED;
if (soon) {
janet_q_push_head(&janet_vm.spawn, &t, sizeof(t));
} else {
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
}
}
void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig) {
janet_schedule_general(fiber, value, sig, 0);
}
void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig) {
janet_schedule_general(fiber, value, sig, 1);
janet_q_push(&janet_vm.spawn, &t, sizeof(t));
}
void janet_cancel(JanetFiber *fiber, Janet value) {
@@ -590,7 +562,6 @@ void janet_ev_init_common(void) {
janet_vm.tq_capacity = 0;
janet_table_init_raw(&janet_vm.threaded_abstracts, 0);
janet_table_init_raw(&janet_vm.active_tasks, 0);
janet_table_init_raw(&janet_vm.signal_handlers, 0);
janet_rng_seed(&janet_vm.ev_rng, 0);
#ifndef JANET_WINDOWS
pthread_attr_init(&janet_vm.new_thread_attr);
@@ -606,7 +577,6 @@ void janet_ev_deinit_common(void) {
janet_vm.listeners = NULL;
janet_table_deinit(&janet_vm.threaded_abstracts);
janet_table_deinit(&janet_vm.active_tasks);
janet_table_deinit(&janet_vm.signal_handlers);
#ifndef JANET_WINDOWS
pthread_attr_destroy(&janet_vm.new_thread_attr);
#endif
@@ -631,27 +601,11 @@ void janet_addtimeout(double sec) {
}
void janet_ev_inc_refcount(void) {
#ifdef JANET_WINDOWS
#ifdef JANET_64
InterlockedIncrement64(&janet_vm.extra_listeners);
#else
InterlockedIncrement(&janet_vm.extra_listeners);
#endif
#else
__atomic_add_fetch(&janet_vm.extra_listeners, 1, __ATOMIC_RELAXED);
#endif
janet_vm.extra_listeners++;
}
void janet_ev_dec_refcount(void) {
#ifdef JANET_WINDOWS
#ifdef JANET_64
InterlockedDecrement64(&janet_vm.extra_listeners);
#else
InterlockedDecrement(&janet_vm.extra_listeners);
#endif
#else
__atomic_add_fetch(&janet_vm.extra_listeners, -1, __ATOMIC_RELAXED);
#endif
janet_vm.extra_listeners--;
}
/* Channels */
@@ -1270,7 +1224,6 @@ static Janet janet_chanat_next(void *p, Janet key) {
static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
JanetChannel *channel = (JanetChannel *)p;
janet_marshal_byte(ctx, channel->is_threaded);
janet_marshal_abstract(ctx, channel);
janet_marshal_byte(ctx, channel->closed);
janet_marshal_int(ctx, channel->limit);
@@ -1290,13 +1243,7 @@ static void janet_chanat_marshal(void *p, JanetMarshalContext *ctx) {
}
static void *janet_chanat_unmarshal(JanetMarshalContext *ctx) {
uint8_t is_threaded = janet_unmarshal_byte(ctx);
JanetChannel *abst;
if (is_threaded) {
abst = janet_unmarshal_abstract_threaded(ctx, sizeof(JanetChannel));
} else {
abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
}
JanetChannel *abst = janet_unmarshal_abstract(ctx, sizeof(JanetChannel));
uint8_t is_closed = janet_unmarshal_byte(ctx);
int32_t limit = janet_unmarshal_int(ctx);
int32_t count = janet_unmarshal_int(ctx);
@@ -1358,10 +1305,8 @@ JanetFiber *janet_loop1(void) {
}
}
/* Run scheduled fibers unless interrupts need to be handled. */
/* Run scheduled fibers */
while (janet_vm.spawn.head != janet_vm.spawn.tail) {
/* Don't run until all interrupts have been marked as handled by calling janet_interpreter_interrupt_handled */
if (janet_vm.auto_suspend) break;
JanetTask task = {NULL, janet_wrap_nil(), JANET_SIGNAL_OK, 0};
janet_q_pop(&janet_vm.spawn, &task, sizeof(task));
if (task.fiber->gc.flags & JANET_FIBER_EV_FLAG_SUSPENDED) janet_ev_dec_refcount();
@@ -1390,6 +1335,7 @@ JanetFiber *janet_loop1(void) {
janet_stacktrace_ext(task.fiber, res, "");
}
if (sig == JANET_SIGNAL_INTERRUPT) {
/* On interrupts, return the interrupted fiber immediately */
return task.fiber;
}
}
@@ -2579,17 +2525,14 @@ JanetAsyncStatus ev_machine_write(JanetListenerState *s, JanetAsyncEvent event)
switch (event) {
default:
break;
case JANET_ASYNC_EVENT_MARK: {
if (state->mode != JANET_ASYNC_WRITEMODE_CONNECT) {
janet_mark(state->is_buffer
? janet_wrap_buffer(state->src.buf)
: janet_wrap_string(state->src.str));
}
case JANET_ASYNC_EVENT_MARK:
janet_mark(state->is_buffer
? janet_wrap_buffer(state->src.buf)
: janet_wrap_string(state->src.str));
if (state->mode == JANET_ASYNC_WRITEMODE_SENDTO) {
janet_mark(janet_wrap_abstract(state->dest_abst));
}
break;
}
case JANET_ASYNC_EVENT_CLOSE:
janet_cancel(s->fiber, janet_cstringv("stream closed"));
return JANET_ASYNC_STATUS_DONE;

View File

@@ -370,15 +370,14 @@ void janet_sweep() {
if (head->type->gc) {
janet_assert(!head->type->gc(head->data, head->size), "finalizer failed");
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
/* Free memory */
janet_free(janet_abstract_head(abst));
}
/* Mark as tombstone in place */
items[i].key = janet_wrap_nil();
items[i].value = janet_wrap_false();
janet_vm.threaded_abstracts.deleted++;
janet_vm.threaded_abstracts.count--;
}
/* Reset for next sweep */

View File

@@ -143,8 +143,7 @@ JANET_CORE_FN(cfun_io_fopen,
"Following one of the initial flags, 0 or more of the following flags can be appended:\n\n"
"* b - open the file in binary mode (rather than text mode)\n\n"
"* + - append to the file instead of overwriting it\n\n"
"* n - error if the file cannot be opened instead of returning nil\n\n"
"See fopen (<stdio.h>, C99) for further details.") {
"* n - error if the file cannot be opened instead of returning nil") {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;

View File

@@ -1245,18 +1245,6 @@ void *janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size) {
return p;
}
void *janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size) {
#ifdef JANET_THREADS
void *p = janet_abstract_threaded(ctx->at, size);
janet_unmarshal_abstract_reuse(ctx, p);
return p;
#else
(void) ctx;
(void) size;
janet_panic("threaded abstracts not supported");
#endif
}
static const uint8_t *unmarshal_one_abstract(UnmarshalState *st, const uint8_t *data, Janet *out, int flags) {
Janet key;
data = unmarshal_one(st, data, &key, flags + 1);

View File

@@ -706,18 +706,6 @@ static const struct keyword_signal signal_keywords[] = {
#endif
{NULL, 0},
};
static int get_signal_kw(const Janet *argv, int32_t n) {
JanetKeyword signal_kw = janet_getkeyword(argv, n);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
return ptr->signal;
}
ptr++;
}
janet_panicf("undefined signal %v", argv[n]);
}
#endif
JANET_CORE_FN(os_proc_kill,
@@ -743,7 +731,18 @@ JANET_CORE_FN(os_proc_kill,
#else
int signal = -1;
if (argc == 3) {
signal = get_signal_kw(argv, 2);
JanetKeyword signal_kw = janet_getkeyword(argv, 2);
const struct keyword_signal *ptr = signal_keywords;
while (ptr->keyword) {
if (!janet_cstrcmp(signal_kw, ptr->keyword)) {
signal = ptr->signal;
break;
}
ptr++;
}
if (signal == -1) {
janet_panic("undefined signal");
}
}
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
if (status) {
@@ -804,108 +803,6 @@ static void close_handle(JanetHandle handle) {
#endif
}
#ifdef JANET_EV
#ifndef JANET_WINDOWS
static void janet_signal_callback(JanetEVGenericMessage msg) {
int sig = msg.tag;
if (msg.argi) janet_interpreter_interrupt_handled(NULL);
Janet handlerv = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(handlerv, JANET_FUNCTION)) {
/* Let another thread/process try to handle this */
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_BLOCK, &set, NULL);
#else
sigprocmask(SIG_BLOCK, &set, NULL);
#endif
raise(sig);
return;
}
JanetFunction *handler = janet_unwrap_function(handlerv);
JanetFiber *fiber = janet_fiber(handler, 64, 0, NULL);
janet_schedule_soon(fiber, janet_wrap_nil(), JANET_SIGNAL_OK);
janet_ev_dec_refcount();
}
static void janet_signal_trampoline_no_interrupt(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
janet_ev_inc_refcount();
}
static void janet_signal_trampoline(int sig) {
/* Do not interact with global janet state here except for janet_ev_post_event, unsafe! */
JanetEVGenericMessage msg;
memset(&msg, 0, sizeof(msg));
msg.tag = sig;
msg.argi = 1;
janet_interpreter_interrupt(NULL);
janet_ev_post_event(&janet_vm, janet_signal_callback, msg);
janet_ev_inc_refcount();
}
#endif
JANET_CORE_FN(os_sigaction,
"(os/sigaction which &opt handler interrupt-interpreter)",
"Add a signal handler for a given action. Use nil for the `handler` argument to remove a signal handler. "
"All signal handlers are the same as supported by `os/proc-kill`.") {
janet_sandbox_assert(JANET_SANDBOX_SIGNAL);
janet_arity(argc, 1, 3);
#ifdef JANET_WINDOWS
(void) argv;
janet_panic("unsupported on this platform");
#else
/* TODO - per thread signal masks */
int rc;
int sig = get_signal_kw(argv, 0);
JanetFunction *handler = janet_optfunction(argv, argc, 1, NULL);
int can_interrupt = janet_optboolean(argv, argc, 2, 0);
Janet oldhandler = janet_table_get(&janet_vm.signal_handlers, janet_wrap_integer(sig));
if (!janet_checktype(oldhandler, JANET_NIL)) {
janet_gcunroot(oldhandler);
}
if (NULL != handler) {
Janet handlerv = janet_wrap_function(handler);
janet_gcroot(handlerv);
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), handlerv);
} else {
janet_table_put(&janet_vm.signal_handlers, janet_wrap_integer(sig), janet_wrap_nil());
}
struct sigaction action;
sigset_t mask;
sigfillset(&mask);
memset(&action, 0, sizeof(action));
if (can_interrupt) {
#ifdef JANET_NO_INTERPRETER_INTERRUPT
janet_panic("interpreter interrupt not enabled");
#else
action.sa_handler = janet_signal_trampoline;
#endif
} else {
action.sa_handler = janet_signal_trampoline_no_interrupt;
}
action.sa_mask = mask;
RETRY_EINTR(rc, sigaction(sig, &action, NULL));
sigset_t set;
sigemptyset(&set);
sigaddset(&set, sig);
#ifdef JANET_THREADS
pthread_sigmask(SIG_UNBLOCK, &set, NULL);
#else
sigprocmask(SIG_UNBLOCK, &set, NULL);
#endif
return janet_wrap_nil();
#endif
}
#endif
/* Create piped file for os/execute and os/spawn. Need to be careful that we mark
the error flag if we can't create pipe and don't leak handles. *handle will be cleaned
up by the calling function. If everything goes well, *handle is owned by the calling function,
@@ -2639,7 +2536,6 @@ void janet_lib_os(JanetTable *env) {
#ifdef JANET_EV
JANET_CORE_REG("os/open", os_open), /* fs read and write */
JANET_CORE_REG("os/pipe", os_pipe),
JANET_CORE_REG("os/sigaction", os_sigaction),
#endif
#endif
JANET_REG_END

View File

@@ -57,20 +57,12 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
} else {
ret = janet_wrap_string(cres.error);
int32_t line = (int32_t) parser.line;
int32_t col = (int32_t) parser.column;
if ((cres.error_mapping.line > 0) &&
(cres.error_mapping.column > 0)) {
line = cres.error_mapping.line;
col = cres.error_mapping.column;
}
if (cres.macrofiber) {
janet_eprintf("%s:%d:%d: compile error", sourcePath,
line, col);
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace_ext(cres.macrofiber, ret, "");
} else {
janet_eprintf("%s:%d:%d: compile error: %s\n", sourcePath,
line, col, (const char *)cres.error);
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
}
errflags |= 0x02;
done = 1;

View File

@@ -530,32 +530,6 @@ static JanetSlot janetc_def(JanetFopts opts, int32_t argn, const Janet *argv) {
return ret;
}
/* Check if a form matches the pattern (= nil _) or (not= nil _) */
static int janetc_check_nil_form(JanetFopts opts, Janet x, Janet *capture, uint32_t fun_tag) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (3 != janet_tuple_length(tup)) return 0;
Janet op1 = tup[0];
if (janet_checktype(op1, JANET_SYMBOL)) {
Janet entry = janet_table_get(opts.compiler->env, op1);
if (janet_checktype(entry, JANET_TABLE)) {
op1 = janet_table_get(janet_unwrap_table(entry), janet_ckeywordv("value"));
}
}
if (!janet_checktype(op1, JANET_FUNCTION)) return 0;
JanetFunction *fun = janet_unwrap_function(op1);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != fun_tag) return 0;
if (janet_checktype(tup[1], JANET_NIL)) {
*capture = tup[2];
return 1;
} else if (janet_checktype(tup[2], JANET_NIL)) {
*capture = tup[1];
return 1;
}
return 0;
}
/*
* :condition
* ...
@@ -576,7 +550,6 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
JanetScope condscope, tempscope;
const int tail = opts.flags & JANET_FOPTS_TAIL;
const int drop = opts.flags & JANET_FOPTS_DROP;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
if (argn < 2 || argn > 3) {
janetc_cerror(c, "expected 2 or 3 arguments to if");
@@ -599,16 +572,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile condition */
janetc_scope(&condscope, c, 0, "if");
Janet condform = argv[0];
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
ifnjmp = JOP_JUMP_IF_NIL;
}
cond = janetc_value(condopts, condform);
cond = janetc_value(condopts, argv[0]);
/* Check constant condition. */
/* TODO: Use type info for more short circuits */
@@ -631,7 +595,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
}
/* Compile jump to right */
labeljr = janetc_emit_si(c, ifnjmp, cond, 0, 0);
labeljr = janetc_emit_si(c, JOP_JUMP_IF_NOT, cond, 0, 0);
/* Condition left body */
janetc_scope(&tempscope, c, 0, "if-true");
@@ -641,7 +605,7 @@ static JanetSlot janetc_if(JanetFopts opts, int32_t argn, const Janet *argv) {
/* Compile jump to done */
labeljd = janet_v_count(c->buffer);
if (!tail && !(drop && janet_checktype(falsebody, JANET_NIL))) janetc_emit(c, JOP_JUMP);
if (!tail) janetc_emit(c, JOP_JUMP);
/* Compile right body */
labelr = janet_v_count(c->buffer);
@@ -777,6 +741,20 @@ static JanetSlot janetc_break(JanetFopts opts, int32_t argn, const Janet *argv)
}
}
/* Check if a form matches the pattern (not= nil _) */
static int janetc_check_notnil_form(Janet x, Janet *capture) {
if (!janet_checktype(x, JANET_TUPLE)) return 0;
JanetTuple tup = janet_unwrap_tuple(x);
if (!janet_checktype(tup[0], JANET_FUNCTION)) return 0;
if (3 != janet_tuple_length(tup)) return 0;
JanetFunction *fun = janet_unwrap_function(tup[0]);
uint32_t tag = fun->def->flags & JANET_FUNCDEF_FLAG_TAG;
if (tag != JANET_FUN_NEQ) return 0;
if (!janet_checktype(tup[1], JANET_NIL)) return 0;
*capture = tup[2];
return 1;
}
/*
* :whiletop
* ...
@@ -793,7 +771,6 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
JanetScope tempscope;
int32_t labelwt, labeld, labeljt, labelc, i;
int infinite = 0;
int is_nil_form = 0;
int is_notnil_form = 0;
uint8_t ifjmp = JOP_JUMP_IF;
uint8_t ifnjmp = JOP_JUMP_IF_NOT;
@@ -807,16 +784,11 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
janetc_scope(&tempscope, c, JANET_SCOPE_WHILE, "while");
/* Check for `(= nil _)` or `(not= nil _)` in condition, and if so, use the
/* Check for `(not= nil _)` in condition, and if so, use the
* jmpnl or jmpnn instructions. This let's us implement `(each ...)`
* more efficiently. */
Janet condform = argv[0];
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_EQ)) {
is_nil_form = 1;
ifjmp = JOP_JUMP_IF_NIL;
ifnjmp = JOP_JUMP_IF_NOT_NIL;
}
if (janetc_check_nil_form(opts, condform, &condform, JANET_FUN_NEQ)) {
if (janetc_check_notnil_form(condform, &condform)) {
is_notnil_form = 1;
ifjmp = JOP_JUMP_IF_NOT_NIL;
ifnjmp = JOP_JUMP_IF_NIL;
@@ -828,9 +800,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Check for constant condition */
if (cond.flags & JANET_SLOT_CONSTANT) {
/* Loop never executes */
int never_executes = is_nil_form
? !janet_checktype(cond.constant, JANET_NIL)
: is_notnil_form
int never_executes = is_notnil_form
? janet_checktype(cond.constant, JANET_NIL)
: !janet_truthy(cond.constant);
if (never_executes) {

View File

@@ -24,7 +24,6 @@
#include "features.h"
#include <janet.h>
#include "state.h"
#include "util.h"
#endif
JANET_THREAD_LOCAL JanetVM janet_vm;
@@ -58,18 +57,5 @@ void janet_vm_load(JanetVM *from) {
* use NULL to interrupt the current VM when convenient */
void janet_interpreter_interrupt(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
#ifdef JANET_WINDOWS
InterlockedIncrement(&vm->auto_suspend);
#else
__atomic_add_fetch(&vm->auto_suspend, 1, __ATOMIC_RELAXED);
#endif
}
void janet_interpreter_interrupt_handled(JanetVM *vm) {
vm = vm ? vm : &janet_vm;
#ifdef JANET_WINDOWS
InterlockedDecrement(&vm->auto_suspend);
#else
__atomic_add_fetch(&vm->auto_suspend, -1, __ATOMIC_RELAXED);
#endif
vm->auto_suspend = 1;
}

View File

@@ -89,7 +89,7 @@ struct JanetVM {
/* If this flag is true, suspend on function calls and backwards jumps.
* When this occurs, this flag will be reset to 0. */
volatile int32_t auto_suspend;
int auto_suspend;
/* The current running fiber on the current thread.
* Set and unset by functions in vm.c */
@@ -157,10 +157,9 @@ struct JanetVM {
JanetListenerState **listeners;
size_t listener_count;
size_t listener_cap;
volatile size_t extra_listeners; /* used in signal handler, must be volatile */
size_t extra_listeners;
JanetTable threaded_abstracts; /* All abstract types that can be shared between threads (used in this thread) */
JanetTable active_tasks; /* All possibly live task fibers - used just for tracking */
JanetTable signal_handlers;
#ifdef JANET_WINDOWS
void **iocp;
#elif defined(JANET_EV_EPOLL)

View File

@@ -175,9 +175,8 @@ JANET_CORE_FN(cfun_string_slice,
"Returns a substring from a byte sequence. The substring is from "
"index `start` inclusive to index `end`, exclusive. All indexing "
"is from 0. `start` and `end` can also be negative to indicate indexing "
"from the end of the string. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range.") {
"from the end of the string. Note that index -1 is synonymous with "
"index `(length bytes)` to allow a full negative slice range. ") {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_stringv(view.bytes + range.start, range.end - range.start);

View File

@@ -69,9 +69,9 @@ JANET_CORE_FN(cfun_tuple_slice,
"inclusive to index `end` exclusive. If `start` or `end` are not provided, "
"they default to 0 and the length of `arrtup`, respectively. "
"`start` and `end` can also be negative to indicate indexing "
"from the end of the input. Note that if `start` is negative it is "
"exclusive, and if `end` is negative it is inclusive, to allow a full "
"negative slice range. Returns the new tuple.") {
"from the end of the input. Note that index -1 is synonymous with "
"index `(length arrtup)` to allow a full negative slice range. "
"Returns the new tuple.") {
JanetView view = janet_getindexed(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_wrap_tuple(janet_tuple_n(view.items + range.start, range.end - range.start));

View File

@@ -116,6 +116,7 @@
#else
#define vm_maybe_auto_suspend(COND) do { \
if ((COND) && janet_vm.auto_suspend) { \
janet_vm.auto_suspend = 0; \
fiber->flags |= (JANET_FIBER_RESUME_NO_USEVAL | JANET_FIBER_RESUME_NO_SKIP); \
vm_return(JANET_SIGNAL_INTERRUPT, janet_wrap_nil()); \
} \
@@ -799,13 +800,13 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
VM_OP(JOP_JUMP)
pc += DS;
vm_maybe_auto_suspend(DS <= 0);
vm_maybe_auto_suspend(DS < 0);
vm_next();
VM_OP(JOP_JUMP_IF)
if (janet_truthy(stack[A])) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
} else {
pc++;
}
@@ -816,14 +817,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
}
vm_next();
VM_OP(JOP_JUMP_IF_NIL)
if (janet_checktype(stack[A], JANET_NIL)) {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
} else {
pc++;
}
@@ -834,7 +835,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
pc++;
} else {
pc += ES;
vm_maybe_auto_suspend(ES <= 0);
vm_maybe_auto_suspend(ES < 0);
}
vm_next();

View File

@@ -43,10 +43,10 @@ int (janet_truthy)(Janet x) {
return janet_truthy(x);
}
JanetStruct(janet_unwrap_struct)(Janet x) {
const JanetKV *(janet_unwrap_struct)(Janet x) {
return janet_unwrap_struct(x);
}
JanetTuple(janet_unwrap_tuple)(Janet x) {
const Janet *(janet_unwrap_tuple)(Janet x) {
return janet_unwrap_tuple(x);
}
JanetFiber *(janet_unwrap_fiber)(Janet x) {
@@ -61,16 +61,16 @@ JanetTable *(janet_unwrap_table)(Janet x) {
JanetBuffer *(janet_unwrap_buffer)(Janet x) {
return janet_unwrap_buffer(x);
}
JanetString(janet_unwrap_string)(Janet x) {
const uint8_t *(janet_unwrap_string)(Janet x) {
return janet_unwrap_string(x);
}
JanetSymbol(janet_unwrap_symbol)(Janet x) {
const uint8_t *(janet_unwrap_symbol)(Janet x) {
return janet_unwrap_symbol(x);
}
JanetKeyword(janet_unwrap_keyword)(Janet x) {
const uint8_t *(janet_unwrap_keyword)(Janet x) {
return janet_unwrap_keyword(x);
}
JanetAbstract(janet_unwrap_abstract)(Janet x) {
void *(janet_unwrap_abstract)(Janet x) {
return janet_unwrap_abstract(x);
}
void *(janet_unwrap_pointer)(Janet x) {
@@ -102,22 +102,22 @@ Janet(janet_wrap_false)(void) {
Janet(janet_wrap_boolean)(int x) {
return janet_wrap_boolean(x);
}
Janet(janet_wrap_string)(JanetString x) {
Janet(janet_wrap_string)(const uint8_t *x) {
return janet_wrap_string(x);
}
Janet(janet_wrap_symbol)(JanetSymbol x) {
Janet(janet_wrap_symbol)(const uint8_t *x) {
return janet_wrap_symbol(x);
}
Janet(janet_wrap_keyword)(JanetKeyword x) {
Janet(janet_wrap_keyword)(const uint8_t *x) {
return janet_wrap_keyword(x);
}
Janet(janet_wrap_array)(JanetArray *x) {
return janet_wrap_array(x);
}
Janet(janet_wrap_tuple)(JanetTuple x) {
Janet(janet_wrap_tuple)(const Janet *x) {
return janet_wrap_tuple(x);
}
Janet(janet_wrap_struct)(JanetStruct x) {
Janet(janet_wrap_struct)(const JanetKV *x) {
return janet_wrap_struct(x);
}
Janet(janet_wrap_fiber)(JanetFiber *x) {
@@ -135,7 +135,7 @@ Janet(janet_wrap_cfunction)(JanetCFunction x) {
Janet(janet_wrap_table)(JanetTable *x) {
return janet_wrap_table(x);
}
Janet(janet_wrap_abstract)(JanetAbstract x) {
Janet(janet_wrap_abstract)(void *x) {
return janet_wrap_abstract(x);
}
Janet(janet_wrap_pointer)(void *x) {
@@ -317,3 +317,4 @@ JANET_WRAP_DEFINE(pointer, void *, JANET_POINTER, pointer)
#undef JANET_WRAP_DEFINE
#endif

View File

@@ -653,10 +653,10 @@ struct JanetListenerState {
* external bindings, we should prefer using the Head structs directly, and
* use the host language to add sugar around the manipulation of the Janet types. */
JANET_API JanetStructHead *janet_struct_head(JanetStruct st);
JANET_API JanetStructHead *janet_struct_head(const JanetKV *st);
JANET_API JanetAbstractHead *janet_abstract_head(const void *abstract);
JANET_API JanetStringHead *janet_string_head(JanetString s);
JANET_API JanetTupleHead *janet_tuple_head(JanetTuple tuple);
JANET_API JanetStringHead *janet_string_head(const uint8_t *s);
JANET_API JanetTupleHead *janet_tuple_head(const Janet *tuple);
/* Some language bindings won't have access to the macro versions. */
@@ -665,16 +665,16 @@ JANET_API int janet_checktype(Janet x, JanetType type);
JANET_API int janet_checktypes(Janet x, int typeflags);
JANET_API int janet_truthy(Janet x);
JANET_API JanetStruct janet_unwrap_struct(Janet x);
JANET_API JanetTuple janet_unwrap_tuple(Janet x);
JANET_API const JanetKV *janet_unwrap_struct(Janet x);
JANET_API const Janet *janet_unwrap_tuple(Janet x);
JANET_API JanetFiber *janet_unwrap_fiber(Janet x);
JANET_API JanetArray *janet_unwrap_array(Janet x);
JANET_API JanetTable *janet_unwrap_table(Janet x);
JANET_API JanetBuffer *janet_unwrap_buffer(Janet x);
JANET_API JanetString janet_unwrap_string(Janet x);
JANET_API JanetSymbol janet_unwrap_symbol(Janet x);
JANET_API JanetKeyword janet_unwrap_keyword(Janet x);
JANET_API JanetAbstract janet_unwrap_abstract(Janet x);
JANET_API const uint8_t *janet_unwrap_string(Janet x);
JANET_API const uint8_t *janet_unwrap_symbol(Janet x);
JANET_API const uint8_t *janet_unwrap_keyword(Janet x);
JANET_API void *janet_unwrap_abstract(Janet x);
JANET_API void *janet_unwrap_pointer(Janet x);
JANET_API JanetFunction *janet_unwrap_function(Janet x);
JANET_API JanetCFunction janet_unwrap_cfunction(Janet x);
@@ -687,18 +687,18 @@ JANET_API Janet janet_wrap_number(double x);
JANET_API Janet janet_wrap_true(void);
JANET_API Janet janet_wrap_false(void);
JANET_API Janet janet_wrap_boolean(int x);
JANET_API Janet janet_wrap_string(JanetString x);
JANET_API Janet janet_wrap_symbol(JanetSymbol x);
JANET_API Janet janet_wrap_keyword(JanetKeyword x);
JANET_API Janet janet_wrap_string(const uint8_t *x);
JANET_API Janet janet_wrap_symbol(const uint8_t *x);
JANET_API Janet janet_wrap_keyword(const uint8_t *x);
JANET_API Janet janet_wrap_array(JanetArray *x);
JANET_API Janet janet_wrap_tuple(JanetTuple x);
JANET_API Janet janet_wrap_struct(JanetStruct x);
JANET_API Janet janet_wrap_tuple(const Janet *x);
JANET_API Janet janet_wrap_struct(const JanetKV *x);
JANET_API Janet janet_wrap_fiber(JanetFiber *x);
JANET_API Janet janet_wrap_buffer(JanetBuffer *x);
JANET_API Janet janet_wrap_function(JanetFunction *x);
JANET_API Janet janet_wrap_cfunction(JanetCFunction x);
JANET_API Janet janet_wrap_table(JanetTable *x);
JANET_API Janet janet_wrap_abstract(JanetAbstract x);
JANET_API Janet janet_wrap_abstract(void *x);
JANET_API Janet janet_wrap_pointer(void *x);
JANET_API Janet janet_wrap_integer(int32_t x);
@@ -776,14 +776,14 @@ JANET_API Janet janet_nanbox_from_bits(uint64_t bits);
#define janet_wrap_pointer(s) janet_nanbox_wrap_((s), JANET_POINTER)
/* Unwrap the pointer types */
#define janet_unwrap_struct(x) ((JanetStruct)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((JanetTuple)janet_nanbox_to_pointer(x))
#define janet_unwrap_struct(x) ((const JanetKV *)janet_nanbox_to_pointer(x))
#define janet_unwrap_tuple(x) ((const Janet *)janet_nanbox_to_pointer(x))
#define janet_unwrap_fiber(x) ((JanetFiber *)janet_nanbox_to_pointer(x))
#define janet_unwrap_array(x) ((JanetArray *)janet_nanbox_to_pointer(x))
#define janet_unwrap_table(x) ((JanetTable *)janet_nanbox_to_pointer(x))
#define janet_unwrap_buffer(x) ((JanetBuffer *)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((JanetString)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((JanetSymbol)janet_nanbox_to_pointer(x))
#define janet_unwrap_string(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_symbol(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_keyword(x) ((const uint8_t *)janet_nanbox_to_pointer(x))
#define janet_unwrap_abstract(x) (janet_nanbox_to_pointer(x))
#define janet_unwrap_pointer(x) (janet_nanbox_to_pointer(x))
@@ -825,15 +825,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_wrap_cfunction(s) janet_nanbox32_from_tagp(JANET_CFUNCTION, (void *)(s))
#define janet_wrap_pointer(s) janet_nanbox32_from_tagp(JANET_POINTER, (void *)(s))
#define janet_unwrap_struct(x) ((JanetStruct)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).tagged.payload.pointer)
#define janet_unwrap_struct(x) ((const JanetKV *)(x).tagged.payload.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).tagged.payload.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).tagged.payload.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).tagged.payload.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).tagged.payload.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).tagged.payload.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).tagged.payload.pointer)
#define janet_unwrap_abstract(x) ((x).tagged.payload.pointer)
#define janet_unwrap_pointer(x) ((x).tagged.payload.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).tagged.payload.pointer)
@@ -848,15 +848,15 @@ JANET_API Janet janet_nanbox32_from_tagp(uint32_t tag, void *pointer);
#define janet_truthy(x) \
((x).type != JANET_NIL && ((x).type != JANET_BOOLEAN || ((x).as.u64 & 0x1)))
#define janet_unwrap_struct(x) ((JanetStruct)(x).as.pointer)
#define janet_unwrap_tuple(x) ((JanetTuple)(x).as.pointer)
#define janet_unwrap_struct(x) ((const JanetKV *)(x).as.pointer)
#define janet_unwrap_tuple(x) ((const Janet *)(x).as.pointer)
#define janet_unwrap_fiber(x) ((JanetFiber *)(x).as.pointer)
#define janet_unwrap_array(x) ((JanetArray *)(x).as.pointer)
#define janet_unwrap_table(x) ((JanetTable *)(x).as.pointer)
#define janet_unwrap_buffer(x) ((JanetBuffer *)(x).as.pointer)
#define janet_unwrap_string(x) ((JanetString)(x).as.pointer)
#define janet_unwrap_symbol(x) ((JanetSymbol)(x).as.pointer)
#define janet_unwrap_keyword(x) ((JanetKeyword)(x).as.pointer)
#define janet_unwrap_string(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_symbol(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_keyword(x) ((const uint8_t *)(x).as.pointer)
#define janet_unwrap_abstract(x) ((x).as.pointer)
#define janet_unwrap_pointer(x) ((x).as.pointer)
#define janet_unwrap_function(x) ((JanetFunction *)(x).as.pointer)
@@ -1388,7 +1388,6 @@ JANET_API void janet_stream_flags(JanetStream *stream, uint32_t flags);
JANET_API void janet_schedule(JanetFiber *fiber, Janet value);
JANET_API void janet_cancel(JanetFiber *fiber, Janet value);
JANET_API void janet_schedule_signal(JanetFiber *fiber, Janet value, JanetSignal sig);
JANET_API void janet_schedule_soon(JanetFiber *fiber, Janet value, JanetSignal sig);
/* Start a state machine listening for events from a stream */
JANET_API JanetListenerState *janet_listen(JanetStream *stream, JanetListener behavior, int mask, size_t size, void *user);
@@ -1613,7 +1612,7 @@ JANET_API void janet_buffer_push_u64(JanetBuffer *buffer, uint64_t x);
#define JANET_TUPLE_FLAG_BRACKETCTOR 0x10000
#define janet_tuple_head(t) ((JanetTupleHead *)((char *)t - offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((JanetTuple)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_from_head(gcobject) ((const Janet *)((char *)gcobject + offsetof(JanetTupleHead, data)))
#define janet_tuple_length(t) (janet_tuple_head(t)->length)
#define janet_tuple_hash(t) (janet_tuple_head(t)->hash)
#define janet_tuple_sm_line(t) (janet_tuple_head(t)->sm_line)
@@ -1659,7 +1658,7 @@ JANET_API JanetSymbol janet_symbol_gen(void);
/* Structs */
#define janet_struct_head(t) ((JanetStructHead *)((char *)t - offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((JanetStruct)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_from_head(t) ((const JanetKV *)((char *)gcobject + offsetof(JanetStructHead, data)))
#define janet_struct_length(t) (janet_struct_head(t)->length)
#define janet_struct_capacity(t) (janet_struct_head(t)->capacity)
#define janet_struct_hash(t) (janet_struct_head(t)->hash)
@@ -1800,7 +1799,6 @@ JANET_API void janet_vm_free(JanetVM *vm);
JANET_API void janet_vm_save(JanetVM *into);
JANET_API void janet_vm_load(JanetVM *from);
JANET_API void janet_interpreter_interrupt(JanetVM *vm);
JANET_API void janet_interpreter_interrupt_handled(JanetVM *vm);
JANET_API JanetSignal janet_continue(JanetFiber *fiber, Janet in, Janet *out);
JANET_API JanetSignal janet_continue_signal(JanetFiber *fiber, Janet in, Janet *out, JanetSignal sig);
JANET_API JanetSignal janet_pcall(JanetFunction *fun, int32_t argn, const Janet *argv, Janet *out, JanetFiber **f);
@@ -1824,7 +1822,6 @@ JANET_API void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *pr
#define JANET_SANDBOX_FS_TEMP 1024
#define JANET_SANDBOX_FFI_USE 2048
#define JANET_SANDBOX_FFI_JIT 4096
#define JANET_SANDBOX_SIGNAL 8192
#define JANET_SANDBOX_FFI (JANET_SANDBOX_FFI_DEFINE | JANET_SANDBOX_FFI_USE | JANET_SANDBOX_FFI_JIT)
#define JANET_SANDBOX_FS (JANET_SANDBOX_FS_WRITE | JANET_SANDBOX_FS_READ | JANET_SANDBOX_FS_TEMP)
#define JANET_SANDBOX_NET (JANET_SANDBOX_NET_CONNECT | JANET_SANDBOX_NET_LISTEN)
@@ -2000,9 +1997,6 @@ JANET_API JanetDictView janet_getdictionary(const Janet *argv, int32_t n);
JANET_API void *janet_getabstract(const Janet *argv, int32_t n, const JanetAbstractType *at);
JANET_API JanetRange janet_getslice(int32_t argc, const Janet *argv);
JANET_API int32_t janet_gethalfrange(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API int32_t janet_getstartrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getendrange(const Janet *argv, int32_t argc, int32_t n, int32_t length);
JANET_API int32_t janet_getargindex(const Janet *argv, int32_t n, int32_t length, const char *which);
JANET_API uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags);
/* Optionals */
@@ -2075,7 +2069,6 @@ JANET_API uint8_t janet_unmarshal_byte(JanetMarshalContext *ctx);
JANET_API void janet_unmarshal_bytes(JanetMarshalContext *ctx, uint8_t *dest, size_t len);
JANET_API Janet janet_unmarshal_janet(JanetMarshalContext *ctx);
JANET_API JanetAbstract janet_unmarshal_abstract(JanetMarshalContext *ctx, size_t size);
JANET_API JanetAbstract janet_unmarshal_abstract_threaded(JanetMarshalContext *ctx, size_t size);
JANET_API void janet_unmarshal_abstract_reuse(JanetMarshalContext *ctx, void *p);
JANET_API void janet_register_abstract_type(const JanetAbstractType *at);

View File

@@ -44,7 +44,7 @@
(number? x) (string x)
(string? x) (string/slice x
(length "test/suite-")
(- (inc (length ".janet"))))
(- (length ".janet")))
(string x)))
(set start-time (os/clock))
(eprint "Starting suite " suite-name "..."))

View File

@@ -37,7 +37,7 @@
(assert (array= @[:one :two :three :four :five]
@[:one :two :three :four :five]) "array comparison 3")
(assert (array= (array/slice @[1 2 3] 0 2) @[1 2]) "array/slice 1")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -2) @[3 9 1]) "array/slice 2")
(assert (array= (array/slice @[0 7 3 9 1 4] 2 -1) @[3 9 1]) "array/slice 2")
# Array remove
# 687a3c9

View File

@@ -113,22 +113,13 @@
# 7478ad11
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= false (any? [nil false])) "any? 3")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true
(any? [nil nil false nil nil true nil nil nil nil false :a nil]))
"any? 6")
(assert (= true (every? [])) "every? 1")
(assert (= true (every? [1 true])) "every? 2")
(assert (= 1 (every? [true 1])) "every? 3")
(assert (= nil (every? [nil])) "every? 4")
(assert (= 2 (every? [1 math/nan 2])) "every? 5")
(assert (= false
(every? [1 1 true 1 1 false 1 1 1 1 true :a nil]))
"every? 6")
# Some higher order functions and macros
# 5e2de33
(def my-array @[1 2 3 4 5 6])
@@ -186,11 +177,6 @@
(assert (= txs [[-1 -1] [-1 0] [-1 1] [0 -1] [0 1] [1 -1] [1 0] [1 1]])
"nested seq")
# :unless modifier
(assert (deep= (seq [i :range [0 10] :unless (odd? i)] i)
@[0 2 4 6 8])
":unless modifier")
# 515891b03
(assert (deep= (tabseq [i :in (range 3)] i (* 3 i))
@{0 0 1 3 2 6}))
@@ -209,12 +195,6 @@
(assert (deep= (seq [x :down-to [10 0]] x) (seq [x :down [10 -1]] x))
"loop :down-to")
# one-term :range forms
(assert (deep= (seq [x :range [10]] x) (seq [x :range [0 10]] x))
"one-term :range")
(assert (deep= (seq [x :down [10]] x) (seq [x :down [10 0]] x))
"one-term :down")
# 7880d7320
(def res @{})
(loop [[k v] :pairs @{1 2 3 4 5 6}]
@@ -354,13 +334,6 @@
"sort 5")
(assert (<= ;(sort (map (fn [x] (math/random)) (range 1000)))) "sort 6")
# #1283
(assert (deep=
(partition 2 (generate [ i :in [:a :b :c :d :e]] i))
'@[(:a :b) (:c :d) (:e)]))
(assert (= (mean (generate [i :in [2 3 5 7 11]] i))
5.6))
# And and or
# c16a9d846
(assert (= (and true true) true) "and true true")
@@ -389,7 +362,14 @@
(assert (= false (and false false)) "and 1")
(assert (= false (or false false)) "or 1")
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "range 1 argument")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "range 2 arguments")
(assert (deep= (range 5 10 2) @[5 7 9]) "range 3 arguments")
# 11cd1279d
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
(assert (deep= @{:a 1 :b 2 :c 3} (zipcoll '[:a :b :c] '[1 2 3])) "zipcoll")
# bc8be266f

View File

@@ -77,14 +77,6 @@
(buffer/push-string b5 "456" @"789")
(assert (= "123456789" (string b5)) "buffer/push-buffer 2")
# Buffer from bytes
(assert (deep= @"" (buffer/from-bytes)) "buffer/from-bytes 1")
(assert (deep= @"ABC" (buffer/from-bytes 65 66 67)) "buffer/from-bytes 2")
(assert (deep= @"0123456789" (buffer/from-bytes ;(range 48 58))) "buffer/from-bytes 3")
(assert (= 0 (length (buffer/from-bytes))) "buffer/from-bytes 4")
(assert (= 5 (length (buffer/from-bytes ;(range 5)))) "buffer/from-bytes 5")
(assert-error "bad slot #1, expected 32 bit signed integer" (buffer/from-bytes :abc))
# some tests for buffer/format
# 029394d
(assert (= (string (buffer/format @"" "pi = %6.3f" math/pi)) "pi = 3.142")
@@ -104,14 +96,13 @@
# Regression #301
# a3d4ecddb
(def b (buffer/new-filled 128 0x78))
(assert (= 38 (length (buffer/blit @"" b -1 90))) "buffer/blit 1")
(assert (= 38 (length (buffer/blit @"" b 0 90))) "buffer/blit 1")
(def a @"abcdefghijklm")
(assert (deep= @"abcde" (buffer/blit @"" a -1 0 5)) "buffer/blit 2")
(assert (deep= @"bcde" (buffer/blit @"" a -1 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a -1 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a -1 3 5)) "buffer/blit 5")
(assert (deep= @"de" (buffer/blit @"" a nil 3 5)) "buffer/blit 6")
(assert (deep= @"abcde" (buffer/blit @"" a 0 0 5)) "buffer/blit 2")
(assert (deep= @"bcde" (buffer/blit @"" a 0 1 5)) "buffer/blit 3")
(assert (deep= @"cde" (buffer/blit @"" a 0 2 5)) "buffer/blit 4")
(assert (deep= @"de" (buffer/blit @"" a 0 3 5)) "buffer/blit 5")
# buffer/push-at
# c55d93512
@@ -122,5 +113,8 @@
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
"buffer/push-at 3")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)

View File

@@ -159,23 +159,5 @@
(assert-error "invalid offset-a: 1" (memcmp "a" "b" 1 1 0))
(assert-error "invalid offset-b: 1" (memcmp "a" "b" 1 0 1))
# Range
# a982f351d
(assert (deep= (range 10) @[0 1 2 3 4 5 6 7 8 9]) "(range 10)")
(assert (deep= (range 5 10) @[5 6 7 8 9]) "(range 5 10)")
(assert (deep= (range 0 16 4) @[0 4 8 12]) "(range 0 16 4)")
(assert (deep= (range 0 17 4) @[0 4 8 12 16]) "(range 0 17 4)")
(assert (deep= (range 16 0 -4) @[16 12 8 4]) "(range 16 0 -4)")
(assert (deep= (range 17 0 -4) @[17 13 9 5 1]) "(range 17 0 -4)")
(assert (= (length (range 10)) 10) "(range 10)")
(assert (= (length (range -10)) 0) "(range -10)")
(assert (= (length (range 1 10)) 9) "(range 1 10)")
# iterating over generator
(assert-no-error "iterate over coro 1" (values (generate [x :range [0 10]] x)))
(assert-no-error "iterate over coro 2" (keys (generate [x :range [0 10]] x)))
(assert-no-error "iterate over coro 3" (pairs (generate [x :range [0 10]] x)))
(end-suite)

View File

@@ -69,7 +69,7 @@
(def first-nl (= (chr "\n") (first str)))
(def last-nl (= (chr "\n") (last str)))
(string/slice str (if first-nl 1 0) (if last-nl -2)))
(string/slice str (if first-nl 1 0) (if last-nl -1)))
(defn reindent-reference
"Same as reindent but use parser functionality. Useful for

View File

@@ -32,10 +32,10 @@
# Buffer self blitting, check for use after free
# bbcfaf128
(def buf1 @"1234567890")
(buffer/blit buf1 buf1 -1)
(buffer/blit buf1 buf1 -1)
(buffer/blit buf1 buf1 -1)
(buffer/blit buf1 buf1 -1)
(buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 (length buf1))
(buffer/blit buf1 buf1 (length buf1))
(assert (= (string buf1) (string/repeat "1234567890" 16))
"buffer blit against self")

View File

@@ -292,8 +292,5 @@
[2 6 4 'z]])
"arg & inner symbolmap")
# 4782a76
(assert (= 10 (do (var x 10) (def y x) (++ x) y)) "no invalid aliasing")
(end-suite)