1
0
mirror of https://github.com/janet-lang/janet synced 2024-11-28 11:09:54 +00:00

Merge branch 'master' into HEAD

This commit is contained in:
Calvin Rose 2020-12-30 12:19:13 -06:00
commit 9e42ee153c
31 changed files with 694 additions and 407 deletions

View File

@ -1,14 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@ -1,15 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dprf=true
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@ -1,22 +0,0 @@
image: openbsd/latest
sources:
- https://git.sr.ht/~bakpakin/janet
packages:
- meson
tasks:
- build: |
cd janet
meson setup build --buildtype=release
cd build
meson configure -Dsingle_threaded=true
meson configure -Dnanbox=false
meson configure -Ddynamic_modules=false
meson configure -Ddocstrings=false
meson configure -Dnet=false
meson configure -Dsourcemaps=false
meson configure -Dpeg=false
meson configure -Dassembler=false
meson configure -Dint_types=false
meson configure -Dtyped_array=false
meson configure -Dreduced_os=true
ninja # will not pass tests but should build

View File

@ -3,10 +3,31 @@ sources:
- https://git.sr.ht/~bakpakin/janet - https://git.sr.ht/~bakpakin/janet
packages: packages:
- gmake - gmake
- meson
tasks: tasks:
- build: | - gmake: |
cd janet cd janet
gmake gmake
gmake test gmake test
doas gmake install doas gmake install
gmake test-install gmake test-install
- meson_min: |
cd janet
meson setup build_meson_min --buildtype=release -Dsingle_threaded=true -Dnanbox=false -Ddynamic_modules=false -Ddocstrings=false -Dnet=false -Dsourcemaps=false -Dpeg=false -Dassembler=false -Dint_types=false -Dtyped_array=false -Dreduced_os=true
cd build_meson_min
ninja
- meson_prf: |
cd janet
meson setup build_meson_prf --buildtype=release -Dprf=true
cd build_meson_prf
ninja
ninja test
- meson_default: |
cd janet
meson setup build_meson_default --buildtype=release
cd build_meson_default
ninja
ninja test
doas ninja install
doas jpm --verbose install circlet

View File

@ -2,8 +2,24 @@
All notable changes to this project will be documented in this file. All notable changes to this project will be documented in this file.
## Unreleased - ??? ## Unreleased - ???
- Deprecate `file/popen` in favor of `os/spawn`.
- Add `:all` keyword to `ev/read` and `net/read` to make them more like `file/read`. However, we
do not provide any `:line` option as that requires buffering.
- Change repl behavior to make Ctrl-C raise SIGINT on posix. The old behavior for Ctrl-C,
to clear the current line buffer, has been moved to Ctrl-Q.
- Importing modules that start with `/` is now the only way to import from project root.
Before, this would import from / on disk.
- Change hash function for numbers.
- Improve error handling of `dofile`.
## 1.13.1 - 2020-12-13
- Pretty printing a table with a prototype will look for `:_name` instead of `:name`
in the prototype table to tag the output.
- `match` macro implementation changed to be tail recursive.
- Adds a :preload loader which allows one to manually put things into `module/cache`.
- Add `buffer/push` function.
- Backtick delimited strings and buffers are now reindented based on the column of the - Backtick delimited strings and buffers are now reindented based on the column of the
opening delimiter. WHitespace in columns to the left of the starting column is ignored unless opening delimiter. Whitespace in columns to the left of the starting column is ignored unless
there are non-space/non-newline characters in that region, in which case the old behavior is preserved. there are non-space/non-newline characters in that region, in which case the old behavior is preserved.
- Argument to `(error)` combinator in PEGs is now optional. - Argument to `(error)` combinator in PEGs is now optional.
- Add `(line)` and `(column)` combinators to PEGs to capture source line and column. - Add `(line)` and `(column)` combinators to PEGs to capture source line and column.
@ -12,16 +28,17 @@ All notable changes to this project will be documented in this file.
- During installation and release, merge janetconf.h into janet.h for easier install. - During installation and release, merge janetconf.h into janet.h for easier install.
- Add `upscope` special form. - Add `upscope` special form.
- `os/execute` and `os/spawn` can take streams for redirecting IO. - `os/execute` and `os/spawn` can take streams for redirecting IO.
- Add `;parser` and `:read` parameters to `run-context`. - Add `:parser` and `:read` parameters to `run-context`.
- Add `os/open` if ev is enabled. - Add `os/open` if ev is enabled.
- Add `os/pipe` if ev is enabled. - Add `os/pipe` if ev is enabled.
- Add `janet_thread_current(void)` to C API - Add `janet_thread_current(void)` to C API
- Add integer parsing forms to pegs. This makes parsing many binary protocols easier. - Add integer parsing forms to pegs. This makes parsing many binary protocols easier.
- Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows. - Lots of updates to networking code - now can use epoll (or poll) on linux and IOCP on windows.
- Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users - Add `ev/` module. This exposes a fiber scheduler, queues, timeouts, and other functionality to users
for single threaded cooperative scheduling and asynchornous IO. for single threaded cooperative scheduling and asynchronous IO.
- Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts - Add `net/accept-loop` and `net/listen`. These functions break down `net/server` into it's essential parts
and are more flexible. They also allow furter improvements to these utility functions. and are more flexible. They also allow further improvements to these utility functions.
- Various small bug fixes.
## 1.12.2 - 2020-09-20 ## 1.12.2 - 2020-09-20
- Add janet\_try and janet\_restore to C API. - Add janet\_try and janet\_restore to C API.

View File

@ -157,7 +157,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
##### Amalgamation ##### ##### Amalgamation #####
######################## ########################
SONAME=libjanet.so.1.12 SONAME=libjanet.so.1.13
build/shell.c: src/mainclient/shell.c build/shell.c: src/mainclient/shell.c
cp $< $@ cp $< $@

View File

@ -4,8 +4,6 @@
[![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet) [![Build Status](https://travis-ci.org/janet-lang/janet.svg?branch=master)](https://travis-ci.org/janet-lang/janet)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?) [![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/freebsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?) [![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/openbsd.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson.yml?)
[![builds.sr.ht status](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml.svg)](https://builds.sr.ht/~bakpakin/janet/commits/meson_min.yml?)
<img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left"> <img src="https://raw.githubusercontent.com/janet-lang/janet/master/assets/janet-w200.png" alt="Janet logo" width=200 align="left">

View File

@ -64,6 +64,10 @@ Move cursor to the beginning of input line.
.BR Ctrl\-B .BR Ctrl\-B
Move cursor one character to the left. Move cursor one character to the left.
.TP 16
.BR Ctrl\-D
If on a newline, indicate end of stream and exit the repl.
.TP 16 .TP 16
.BR Ctrl\-E .BR Ctrl\-E
Move cursor to the end of input line. Move cursor to the end of input line.
@ -100,6 +104,10 @@ Delete one word before the cursor.
.BR Ctrl\-G .BR Ctrl\-G
Show documentation for the current symbol under the cursor. Show documentation for the current symbol under the cursor.
.TP 16
.BR Ctrl\-Q
Clear the current command, including already typed lines.
.TP 16 .TP 16
.BR Alt\-B/Alt\-F .BR Alt\-B/Alt\-F
Move cursor backwards and forwards one word. Move cursor backwards and forwards one word.

View File

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

View File

@ -180,8 +180,8 @@
(defmacro cond (defmacro cond
`Evaluates conditions sequentially until the first true condition `Evaluates conditions sequentially until the first true condition
is found, and then executes the corresponding body. If there are an is found, and then executes the corresponding body. If there are an
odd number of forms, the last expression is executed if no forms odd number of forms, and no forms are matched, the last expression
are matched. If there are no matches, return nil.` is executed. If there are no matches, return nil.`
[& pairs] [& pairs]
(defn aux [i] (defn aux [i]
(def restlen (- (length pairs) i)) (def restlen (- (length pairs) i))
@ -494,13 +494,13 @@
(error (string "unexpected loop verb " verb))))) (error (string "unexpected loop verb " verb)))))
(defmacro forv (defmacro forv
`Do a c style for loop for side effects. The iteration variable i ``Do a C-style for-loop for side effects. The iteration variable `i`
can be mutated in the loop, unlike normal for. Returns nil.` can be mutated in the loop, unlike normal `for`. Returns nil.``
[i start stop & body] [i start stop & body]
(for-var-template i start stop 1 < + body)) (for-var-template i start stop 1 < + body))
(defmacro for (defmacro for
"Do a c style for loop for side effects. Returns nil." "Do a C-style for-loop for side effects. Returns nil."
[i start stop & body] [i start stop & body]
(for-template i start stop 1 < + body)) (for-template i start stop 1 < + body))
@ -562,7 +562,7 @@
two-element tuple with a start and (exclusive) end value, and an optional two-element tuple with a start and (exclusive) end value, and an optional
(positive!) step size. (positive!) step size.
* :down-to -- same :as down, but the range is inclusive [start, end]. * :down-to -- same as :down, but the range is inclusive [start, end].
* :keys -- iterate over the keys in a data structure. * :keys -- iterate over the keys in a data structure.
@ -692,7 +692,7 @@
;(tuple/slice functions 4 -1))))) ;(tuple/slice functions 4 -1)))))
(defn identity (defn identity
"A function that returns its first argument." "A function that returns its argument."
[x] [x]
x) x)
@ -731,11 +731,11 @@
## Polymorphic comparisons ## Polymorphic comparisons
(defn compare (defn compare
`Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively. ``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 Differs from the primitive comparators in that it first checks to
see whether either x or y implement a 'compare' method which can see whether either x or y implement a `compare` method which can
compare x and y. If so it uses that compare method. If not, it compare x and y. If so, it uses that method. If not, it
delegates to the primitive comparators.` delegates to the primitive comparators.``
[x y] [x y]
(or (or
(when-let [f (get x :compare)] (f x y)) (when-let [f (get x :compare)] (f x y))
@ -753,27 +753,27 @@
r) r)
(defn compare= (defn compare=
"Equivalent of '=' but using compare function instead of primitive comparator" ``Equivalent of `=` but using polymorphic `compare` instead of primitive comparator.``
[& xs] [& xs]
(compare-reduce = xs)) (compare-reduce = xs))
(defn compare< (defn compare<
"Equivalent of '<' but using compare function instead of primitive comparator" ``Equivalent of `<` but using polymorphic `compare` instead of primitive comparator.``
[& xs] [& xs]
(compare-reduce < xs)) (compare-reduce < xs))
(defn compare<= (defn compare<=
"Equivalent of '<=' but using compare function instead of primitive comparator" ``Equivalent of `<=` but using polymorphic `compare` instead of primitive comparator.``
[& xs] [& xs]
(compare-reduce <= xs)) (compare-reduce <= xs))
(defn compare> (defn compare>
"Equivalent of '>' but using compare function instead of primitive comparator" ``Equivalent of `>` but using polymorphic `compare` instead of primitive comparator.``
[& xs] [& xs]
(compare-reduce > xs)) (compare-reduce > xs))
(defn compare>= (defn compare>=
"Equivalent of '>=' but using compare function instead of primitive comparator" ``Equivalent of `>=` but using polymorphic `compare` instead of primitive comparator.``
[& xs] [& xs]
(compare-reduce >= xs)) (compare-reduce >= xs))
@ -790,36 +790,50 @@
### ###
### ###
(defn- sort-part (defn- median-of-three [a b c]
[a lo hi by] (if (not= (> a b) (> a c))
(def pivot (in a hi)) a
(var i lo) (if (not= (> b a) (> b c)) b c)))
(forv j lo hi
(def aj (in a j))
(when (by aj pivot)
(def ai (in a i))
(set (a i) aj)
(set (a j) ai)
(++ i)))
(set (a hi) (in a i))
(set (a i) pivot)
i)
(defn- sort-help (defn- insertion-sort [a lo hi by]
[a lo hi by] (for i (+ lo 1) (+ hi 1)
(when (> hi lo) (def temp (in a i))
(def piv (sort-part a lo hi by)) (var j (- i 1))
(sort-help a lo (- piv 1) by) (while (and (>= j lo) (by temp (in a j)))
(sort-help a (+ piv 1) hi by)) (set (a (+ j 1)) (in a j))
(-- j))
(set (a (+ j 1)) temp))
a) a)
(defn sort (defn sort
"Sort an array in-place. Uses quick-sort and is not a stable sort." "Sort an array in-place. Uses quick-sort and is not a stable sort."
[a &opt by] [a &opt by]
(sort-help a 0 (- (length a) 1) (or by <))) (default by <)
(def stack @[[0 (- (length a) 1)]])
(while (not (empty? stack))
(def [lo hi] (array/pop stack))
(when (< lo hi)
(when (< (- hi lo) 32) (insertion-sort a lo hi by) (break))
(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
(while (by (in a left) pivot) (++ left))
(while (by pivot (in a right)) (-- right))
(when (<= left right)
(def tmp (in a left))
(set (a left) (in a right))
(set (a right) tmp)
(++ left)
(-- right))
(if (>= left right) (break)))
(array/push stack [lo right])
(array/push stack [left hi])))
a)
(undef sort-part) (undef median-of-three)
(undef sort-help) (undef insertion-sort)
(defn sort-by (defn sort-by
`Returns a new sorted array that compares elements by invoking `Returns a new sorted array that compares elements by invoking
@ -945,8 +959,10 @@
counter) counter)
(defn keep (defn keep
`Given a predicate, take only elements from an array or tuple for ``Given a predicate `pred`, return a new array containing the truthy results
which (pred element) is truthy. Returns a new array of truthy predicate results.` of applying `pred` to each element in the indexed collection `ind`. This is
different from `filter` which returns an array of the original elements where
the predicate is truthy.``
[pred ind] [pred ind]
(def res @[]) (def res @[])
(each item ind (each item ind
@ -1557,109 +1573,173 @@
### ###
### ###
(defmacro- with-idemp
`Return janet code body that has been prepended
with a binding of form to atom. If form is a non-idempotent
form (a function call, etc.), make sure the resulting
code will only evaluate once, even if body contains multiple
copies of binding. In body, use binding instead of form.`
[binding form & body]
(def $result (gensym))
(def $form (gensym))
~(do
(def ,$form ,form)
(def ,binding (if (idempotent? ,$form) ,$form (gensym)))
(def ,$result (do ,;body))
(if (= ,$form ,binding)
,$result
(tuple 'do (tuple 'def ,binding ,$form) ,$result))))
# Sentinel value for mismatches
(def- sentinel ~',(gensym))
(defn- match-1
[pattern expr onmatch seen]
(cond
(= '_ pattern)
(onmatch)
(symbol? pattern)
(if (in seen pattern)
~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)
(do
(put seen pattern true)
~(do (def ,pattern ,expr) ,(onmatch))))
(and (tuple? pattern) (= :parens (tuple/type pattern)))
(if (= (get pattern 0) '@)
# Unification with external values
~(if (= ,(get pattern 1) ,expr) ,(onmatch) ,sentinel)
(match-1
(in pattern 0) expr
(fn []
~(if (and ,;(tuple/slice pattern 1)) ,(onmatch) ,sentinel)) seen))
(indexed? pattern)
(do
(def len (length pattern))
(var i -1)
(with-idemp
$arr expr
~(if (,indexed? ,$arr)
(if (< (,length ,$arr) ,len)
,sentinel
,((fn aux []
(++ i)
(if (= i len)
(onmatch)
(match-1 (in pattern i) (tuple in $arr i) aux seen)))))
,sentinel)))
(dictionary? pattern)
(do
(var key nil)
(with-idemp
$dict expr
~(if (,dictionary? ,$dict)
,((fn aux []
(set key (next pattern key))
(def $val (gensym))
(if (= key nil)
(onmatch)
~(do (def ,$val (,get ,$dict ,key))
,(match-1 [(in pattern key) [not= nil $val]] $val aux seen)))))
,sentinel)))
:else ~(if (= ,pattern ,expr) ,(onmatch) ,sentinel)))
(defmacro match (defmacro match
`Pattern matching. Match an expression x against ```
any number of cases. Each case is a pattern to match against, followed Pattern matching. Match an expression `x` against any number of cases.
by an expression to evaluate to if that case is matched. A pattern that is Each case is a pattern to match against, followed by an expression to
a symbol will match anything, binding x's value to that symbol. An array evaluate to if that case is matched. Legal patterns are:
will match only if all of it's elements match the corresponding elements in
x. A table or struct will match if all values match with the corresponding
values in x. A tuple pattern will match if it's first element matches, and the following
elements are treated as predicates and are true. The last special case is
the '_ symbol, which is a wildcard that will match any value without creating a binding.
Any other value pattern will only match if it is equal to x.`
[x & cases]
(with-idemp $x x
(def len (length cases))
(def len-1 (dec len))
((fn aux [i]
(cond
(= i len-1) (in cases i)
(< i len-1) (with-syms [$res]
~(if (= ,sentinel (def ,$res ,(match-1 (in cases i) $x (fn [] (in cases (inc i))) @{})))
,(aux (+ 2 i))
,$res)))) 0)))
(undef sentinel) * symbol -- a pattern that is a symbol will match anything, binding `x`'s
(undef match-1) value to that symbol.
(undef with-idemp)
* array -- an array will match only if all of its elements match the
corresponding elements in `x`.
* table or struct -- a table or struct will match if all values match with
the corresponding values in `x`.
* tuple -- a tuple pattern will match if its first element matches, and the
following elements are treated as predicates and are true.
* `_` symbol -- the last special case is the `_` symbol, which is a wildcard
that will match any value without creating a binding.
Any other value pattern will only match if it is equal to `x`.
```
[x & cases]
# 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)))
# Keep an array for accumulating the compilation output
(def x-sym (if (idempotent? x) x (gensym)))
(def accum @[])
(if (not= x x-sym) (array/push accum ['def x-sym x]))
# Table of gensyms
(def symbols @{[nil nil] x-sym})
(def length-symbols @{})
(defn emit [x] (array/push accum x))
(defn emit-branch [condition result] (array/push accum :branch condition result))
(defn get-sym
[parent-sym key]
(def symbol-key [parent-sym key])
(or (get symbols symbol-key)
(let [s (gensym)]
(put symbols symbol-key s)
(emit ['def s [get parent-sym key]])
s)))
(defn get-length-sym
[parent-sym]
(or (get length-symbols parent-sym)
(let [s (gensym)]
(put length-symbols parent-sym s)
(emit ['def s ['if [indexed? parent-sym] [length parent-sym]]])
s)))
(defn visit-pattern-1
[b2g parent-sym key pattern]
(if (= pattern '_) (break))
(def s (get-sym parent-sym key))
(def t (type pattern))
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(cond
# match local binding
(= t :symbol)
(if-let [x (in b2g pattern)]
(array/push x s)
(put b2g pattern @[s]))
# match data structure template
(or isarr (= t :struct) (= t :table))
(do
(when isarr (get-length-sym s))
(eachp [i sub-pattern] pattern
(visit-pattern-1 b2g s i sub-pattern)))
# match global unification
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
(break)
# match predicated binding
(and (= t :tuple) (>= (length pattern) 2))
(do
(visit-pattern-1 b2g parent-sym key (pattern 0)))))
(defn visit-pattern-2
[anda gun preds parent-sym key pattern]
(if (= pattern '_) (break))
(def s (get-sym parent-sym key))
(def t (type pattern))
(def isarr (or (= t :array) (and (= t :tuple) (= (tuple/type pattern) :brackets))))
(when isarr
(array/push anda (get-length-sym s))
(array/push anda [<= (length pattern) (get-length-sym s)]))
(cond
# match data structure template
(or isarr (= t :struct) (= t :table))
(eachp [i sub-pattern] pattern
(when (not isarr)
(array/push anda [not= nil (get-sym s i)]))
(visit-pattern-2 anda gun preds s i sub-pattern))
# match local binding
(= t :symbol) (break)
# match global unification
(and (= t :tuple) (= 2 (length pattern)) (= '@ (pattern 0)))
(if-let [x (in gun (pattern 1))]
(array/push x s)
(put gun (pattern 1) @[s]))
# match predicated binding
(and (= t :tuple) (>= (length pattern) 2))
(do
(array/push preds ;(slice pattern 1))
(visit-pattern-2 anda gun preds parent-sym key (pattern 0)))
# match literal
(array/push anda ['= s pattern])))
# Compile the patterns
(each [pattern expression] patterns
(def b2g @{})
(def gun @{})
(def preds @[])
(visit-pattern-1 b2g nil nil pattern)
(def anda @['and])
(visit-pattern-2 anda gun preds nil nil pattern)
# Local unification
(def unify @[])
(each syms b2g
(when (< 1 (length syms))
(array/push unify [= ;syms])))
# Global unification
(eachp [binding syms] gun
(array/push unify [= binding ;syms]))
(sort unify)
(array/concat anda unify)
# Final binding
(def defs (seq [[k v] :in (sort (pairs b2g))] ['def k (first v)]))
# Predicates
(unless (empty? preds)
(def pred-join ~(do ,;defs (and ,;preds)))
(array/push anda pred-join))
(emit-branch (tuple/slice anda) ['do ;defs expression]))
# Expand branches
(def stack @[else])
(each el (reverse accum)
(if (= :branch el)
(let [condition (array/pop stack)
truthy (array/pop stack)
if-form ~(if ,condition ,truthy
,(case (length stack)
0 nil
1 (stack 0)
~(do ,;(reverse stack))))]
(array/remove stack 0 (length stack))
(array/push stack if-form))
(array/push stack el)))
~(do ,;(reverse stack)))
### ###
### ###
@ -2061,7 +2141,8 @@
'quasiquote expandqq 'quasiquote expandqq
'var expanddef 'var expanddef
'while expandall 'while expandall
'break expandall}) 'break expandall
'upscope expandall})
(defn dotup [t] (defn dotup [t]
(def h (in t 0)) (def h (in t 0))
@ -2359,9 +2440,6 @@
(default where "<anonymous>") (default where "<anonymous>")
(default guard :ydt) (default guard :ydt)
# Are we done yet?
(var going true)
# Evaluate 1 source form in a protected manner # Evaluate 1 source form in a protected manner
(defn eval1 [source] (defn eval1 [source]
(def source (if expand (expand source) source)) (def source (if expand (expand source) source))
@ -2385,7 +2463,7 @@
(fiber/setenv f env) (fiber/setenv f env)
(while (fiber/can-resume? f) (while (fiber/can-resume? f)
(def res (resume f resumeval)) (def res (resume f resumeval))
(when good (when going (set resumeval (onstatus f res)))))) (when good (set resumeval (onstatus f res)))))
# Reader version # Reader version
(when read (when read
@ -2410,11 +2488,11 @@
# Loop # Loop
(def buf @"") (def buf @"")
(while going (var parser-not-done true)
(while parser-not-done
(if (env :exit) (break)) (if (env :exit) (break))
(buffer/clear buf) (buffer/clear buf)
(if (= (chunks buf p) (if (= (chunks buf p) :cancel)
:cancel)
(do (do
# A :cancel chunk represents a cancelled form in the REPL, so reset. # A :cancel chunk represents a cancelled form in the REPL, so reset.
(:flush p) (:flush p)
@ -2425,19 +2503,23 @@
(def len (length buf)) (def len (length buf))
(when (= len 0) (when (= len 0)
(:eof p) (:eof p)
(set going false)) (set parser-not-done false))
(while (> len pindex) (while (> len pindex)
(+= pindex (p-consume p buf pindex)) (+= pindex (p-consume p buf pindex))
(while (p-has-more p) (while (p-has-more p)
(eval1 (p-produce p))) (eval1 (p-produce p))
(if (env :exit) (break)))
(when (= (p-status p) :error) (when (= (p-status p) :error)
(parse-err p where)))))) (parse-err p where)
(if (env :exit) (break)))))))
# Check final parser state # Check final parser state
(while (p-has-more p) (unless (env :exit)
(eval1 (p-produce p))) (while (p-has-more p)
(when (= (p-status p) :error) (eval1 (p-produce p))
(parse-err p where)) (if (env :exit) (break)))
(when (= (p-status p) :error)
(parse-err p where)))
(in env :exit-value env)) (in env :exit-value env))
@ -2497,16 +2579,16 @@
(error (parser/error p)) (error (parser/error p))
(error "no value"))))) (error "no value")))))
(def make-image-dict
`A table used in combination with marshal to marshal code (images), such that
(make-image x) is the same as (marshal x make-image-dict).`
@{})
(def load-image-dict (def load-image-dict
`A table used in combination with unmarshal to unmarshal byte sequences created `A table used in combination with unmarshal to unmarshal byte sequences created
by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict).` by make-image, such that (load-image bytes) is the same as (unmarshal bytes load-image-dict).`
@{}) @{})
(def make-image-dict
`A table used in combination with marshal to marshal code (images), such that
(make-image x) is the same as (marshal x make-image-dict).`
@{})
(defmacro comptime (defmacro comptime
"Evals x at compile time and returns the result. Similar to a top level unquote." "Evals x at compile time and returns the result. Similar to a top level unquote."
[x] [x]
@ -2536,8 +2618,9 @@
[image] [image]
(unmarshal image load-image-dict)) (unmarshal image load-image-dict))
(defn- check-. [x] (if (string/has-prefix? "." x) x)) (defn- check-relative [x] (if (string/has-prefix? "." x) x))
(defn- not-check-. [x] (unless (string/has-prefix? "." x) x)) (defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "." x)) x))
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
(def module/paths (def module/paths
``` ```
@ -2557,6 +2640,10 @@
(setdyn :syspath (boot/opts "JANET_PATH")) (setdyn :syspath (boot/opts "JANET_PATH"))
(setdyn :headerpath (boot/opts "JANET_HEADERPATH")) (setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
(def module/cache
"Table mapping loaded module identifiers to their environments."
@{})
(defn module/add-paths (defn module/add-paths
``` ```
Add paths to module/paths for a given loader such that Add paths to module/paths for a given loader such that
@ -2569,18 +2656,19 @@
(defn- find-prefix (defn- find-prefix
[pre] [pre]
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0)) (or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) module/paths) 0))
(def all-index (find-prefix ":all:")) (def all-index (find-prefix ".:all:"))
(array/insert module/paths all-index [(string ":all:" ext) loader not-check-.]) (array/insert module/paths all-index [(string ".:all:" ext) loader check-project-relative])
(def sys-index (find-prefix ":sys:")) (def sys-index (find-prefix ":sys:"))
(array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader not-check-.]) (array/insert module/paths sys-index [(string ":sys:/:all:" ext) loader check-is-dep])
(def curall-index (find-prefix ":cur:/:all:")) (def curall-index (find-prefix ":cur:/:all:"))
(array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-.]) (array/insert module/paths curall-index [(string ":cur:/:all:" ext) loader check-relative])
module/paths) module/paths)
(module/add-paths ":native:" :native) (module/add-paths ":native:" :native)
(module/add-paths "/init.janet" :source) (module/add-paths "/init.janet" :source)
(module/add-paths ".janet" :source) (module/add-paths ".janet" :source)
(module/add-paths ".jimage" :image) (module/add-paths ".jimage" :image)
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload])
# Version of fexists that works even with a reduced OS # Version of fexists that works even with a reduced OS
(defn fexists (defn fexists
@ -2632,12 +2720,9 @@
(undef fexists) (undef fexists)
(undef mod-filter) (undef mod-filter)
(undef check-.) (undef check-relative)
(undef not-check-.) (undef check-project-relative)
(undef check-is-dep)
(def module/cache
"Table mapping loaded module identifiers to their environments."
@{})
(def module/loading (def module/loading
`Table mapping currently loading modules to true. Used to prevent `Table mapping currently loading modules to true. Used to prevent
@ -2665,15 +2750,25 @@
(def spath (string path)) (def spath (string path))
(put env :current-file (or src (if-not path-is-file spath))) (put env :current-file (or src (if-not path-is-file spath)))
(put env :source (or src (if-not path-is-file spath path))) (put env :source (or src (if-not path-is-file spath path)))
(var exit-error nil)
(var exit-fiber nil)
(defn chunks [buf _] (file/read f 2048 buf)) (defn chunks [buf _] (file/read f 2048 buf))
(defn bp [&opt x y] (defn bp [&opt x y]
(def ret (bad-parse x y)) (when exit
(if exit (os/exit 1)) (bad-parse x y)
ret) (os/exit 1))
(put env :exit true)
(def [line col] (:where x))
(def pe (string (:error x) " in " y " around line " line ", column " col))
(set exit-error pe))
(defn bc [&opt x y z] (defn bc [&opt x y z]
(def ret (bad-compile x y z)) (when exit
(if exit (os/exit 1)) (bad-compile x y z)
ret) (os/exit 1))
(put env :exit true)
(def ce (string x " while compiling " z))
(set exit-error ce)
(set exit-fiber y))
(unless f (unless f
(error (string "could not find file " path))) (error (string "could not find file " path)))
(def nenv (def nenv
@ -2683,27 +2778,40 @@
:on-compile-error bc :on-compile-error bc
:on-status (fn [f x] :on-status (fn [f x]
(when (not= (fiber/status f) :dead) (when (not= (fiber/status f) :dead)
(debug/stacktrace f x) (when exit
(if exit (os/exit 1) (eflush)))) (debug/stacktrace f x)
(eflush)
(os/exit 1))
(put env :exit true)
(set exit-error x)
(set exit-fiber f)))
:evaluator evaluator :evaluator evaluator
:expander expander :expander expander
:read read :read read
:parser parser :parser parser
:source (or src (if path-is-file "<anonymous>" spath))})) :source (or src (if path-is-file "<anonymous>" spath))}))
(if-not path-is-file (file/close f)) (if-not path-is-file (file/close f))
(when exit-error
(if exit-fiber
(propagate exit-error exit-fiber)
(error exit-error)))
nenv) nenv)
(def module/loaders (def module/loaders
`A table of loading method names to loading functions. `A table of loading method names to loading functions.
This table lets require and import load many different kinds This table lets require and import load many different kinds
of files as modules.` of files as modules.`
@{:native (fn [path &] (native path (make-env))) @{:native (fn native-loader [path &] (native path (make-env)))
:source (fn [path args] :source (fn source-loader [path args]
(put module/loading path true) (put module/loading path true)
(def newenv (dofile path ;args)) (defer (put module/loading path nil)
(put module/loading path nil) (dofile path ;args)))
newenv) :preload (fn preload-loader [path & args]
:image (fn [path &] (load-image (slurp path)))}) (when-let [m (in module/cache path)]
(if (function? m)
(set (module/cache path) (m path ;args))
m)))
:image (fn image-loader [path &] (load-image (slurp path)))})
(defn require-1 (defn require-1
[path args kargs] [path args kargs]
@ -3019,7 +3127,16 @@
(defmacro ev/spawn (defmacro ev/spawn
"Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))." "Run some code in a new fiber. This is shorthand for (ev/call (fn [] ;body))."
[& body] [& body]
~(,ev/call (fn [] ,;body)))) ~(,ev/call (fn [] ,;body)))
(defmacro ev/with-deadline
`Run a body of code with a deadline, such that if the code does not complete before
the deadline is up, it will be canceled.`
[deadline & body]
(with-syms [f]
~(let [,f (coro ,;body)]
(,ev/deadline ,deadline nil ,f)
(,resume ,f)))))
(compwhen (dyn 'net/listen) (compwhen (dyn 'net/listen)
(defn net/server (defn net/server
@ -3214,8 +3331,7 @@
(put load-dict 'boot/args nil) (put load-dict 'boot/args nil)
(each [k v] (pairs load-dict) (each [k v] (pairs load-dict)
(if (number? v) (put load-dict k nil))) (if (number? v) (put load-dict k nil)))
(merge-into load-image-dict load-dict) (merge-into load-image-dict load-dict))
(merge-into make-image-dict (invert load-dict)))
### ###
### ###

View File

@ -5,9 +5,9 @@
#define JANET_VERSION_MAJOR 1 #define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 13 #define JANET_VERSION_MINOR 13
#define JANET_VERSION_PATCH 0 #define JANET_VERSION_PATCH 2
#define JANET_VERSION_EXTRA "-dev" #define JANET_VERSION_EXTRA "-dev"
#define JANET_VERSION "1.13.0-dev" #define JANET_VERSION "1.13.2-dev"
/* #define JANET_BUILD "local" */ /* #define JANET_BUILD "local" */

View File

@ -31,12 +31,11 @@
/* Initialize a buffer */ /* Initialize a buffer */
JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) { JanetBuffer *janet_buffer_init(JanetBuffer *buffer, int32_t capacity) {
uint8_t *data = NULL; uint8_t *data = NULL;
if (capacity > 0) { if (capacity < 4) capacity = 4;
janet_gcpressure(capacity); janet_gcpressure(capacity);
data = malloc(sizeof(uint8_t) * (size_t) capacity); data = malloc(sizeof(uint8_t) * (size_t) capacity);
if (NULL == data) { if (NULL == data) {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
}
} }
buffer->count = 0; buffer->count = 0;
buffer->capacity = capacity; buffer->capacity = capacity;
@ -200,19 +199,14 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) { static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count) { if (buffer->count < buffer->capacity) {
if (buffer->count < buffer->capacity) { int32_t newcap = buffer->count > 4 ? buffer->count : 4;
uint8_t *newData = realloc(buffer->data, buffer->count); uint8_t *newData = realloc(buffer->data, newcap);
if (NULL == newData) { if (NULL == newData) {
JANET_OUT_OF_MEMORY; JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = buffer->count;
} }
} else { buffer->data = newData;
buffer->capacity = 0; buffer->capacity = newcap;
free(buffer->data);
buffer->data = NULL;
} }
return argv[0]; return argv[0];
} }
@ -256,6 +250,26 @@ static Janet cfun_buffer_chars(int32_t argc, Janet *argv) {
return argv[0]; return argv[0];
} }
static Janet cfun_buffer_push(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
for (i = 1; i < argc; i++) {
if (janet_checktype(argv[i], JANET_NUMBER)) {
janet_buffer_push_u8(buffer, (uint8_t)(janet_getinteger(argv, i) & 0xFF));
} else {
JanetByteView view = janet_getbytes(argv, i);
if (view.bytes == buffer->data) {
janet_buffer_ensure(buffer, buffer->count + view.len, 2);
view.bytes = buffer->data;
}
janet_buffer_push_bytes(buffer, view.bytes, view.len);
}
}
return argv[0];
}
static Janet cfun_buffer_clear(int32_t argc, Janet *argv) { static Janet cfun_buffer_clear(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0); JanetBuffer *buffer = janet_getbuffer(argv, 0);
@ -407,22 +421,32 @@ static const JanetReg buffer_cfuns[] = {
}, },
{ {
"buffer/push-byte", cfun_buffer_u8, "buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n" JDOC("(buffer/push-byte buffer & xs)\n\n"
"Append a byte to a buffer. Will expand the buffer as necessary. " "Append bytes to a buffer. Will expand the buffer as necessary. "
"Returns the modified buffer. Will throw an error if the buffer overflows.") "Returns the modified buffer. Will throw an error if the buffer overflows.")
}, },
{ {
"buffer/push-word", cfun_buffer_word, "buffer/push-word", cfun_buffer_word,
JDOC("(buffer/push-word buffer x)\n\n" JDOC("(buffer/push-word buffer & xs)\n\n"
"Append a machine word to a buffer. The 4 bytes of the integer are appended " "Append machine words to a buffer. The 4 bytes of the integer are appended "
"in twos complement, little endian order, unsigned. Returns the modified buffer. Will " "in twos complement, little endian order, unsigned for all x. Returns the modified buffer. Will "
"throw an error if the buffer overflows.") "throw an error if the buffer overflows.")
}, },
{ {
"buffer/push-string", cfun_buffer_chars, "buffer/push-string", cfun_buffer_chars,
JDOC("(buffer/push-string buffer str)\n\n" JDOC("(buffer/push-string buffer & xs)\n\n"
"Push a string onto the end of a buffer. Non string values will be converted " "Push byte sequences onto the end of a buffer. "
"to strings before being pushed. Returns the modified buffer. " "Will accept any of strings, keywords, symbols, and buffers. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.")
},
{
"buffer/push", cfun_buffer_push,
JDOC("(buffer/push buffer & xs)\n\n"
"Push both individual bytes and byte sequences to a buffer. For each x in xs, "
"push the byte if x is an integer, otherwise push the bytesequence to the buffer. "
"Thus, this function behaves like both `buffer/push-string` and `buffer/push-byte`. "
"Returns the modified buffer. "
"Will throw an error if the buffer overflows.") "Will throw an error if the buffer overflows.")
}, },
{ {

View File

@ -548,35 +548,35 @@ static const JanetReg corelib_cfuns[] = {
{ {
"describe", janet_core_describe, "describe", janet_core_describe,
JDOC("(describe x)\n\n" JDOC("(describe x)\n\n"
"Returns a string that is a human readable description of a value x.") "Returns a string that is a human-readable description of a value x.")
}, },
{ {
"string", janet_core_string, "string", janet_core_string,
JDOC("(string & parts)\n\n" JDOC("(string & xs)\n\n"
"Creates a string by concatenating values together. Values are " "Creates a string by concatenating the elements of `xs` together. If an "
"converted to bytes via describe if they are not byte sequences. " "element is not a byte sequence, it is converted to bytes via `describe`. "
"Returns the new string.") "Returns the new string.")
}, },
{ {
"symbol", janet_core_symbol, "symbol", janet_core_symbol,
JDOC("(symbol & xs)\n\n" JDOC("(symbol & xs)\n\n"
"Creates a symbol by concatenating values together. Values are " "Creates a symbol by concatenating the elements of `xs` together. If an "
"converted to bytes via describe if they are not byte sequences. Returns " "element is not a byte sequence, it is converted to bytes via `describe`. "
"the new symbol.") "Returns the new symbol.")
}, },
{ {
"keyword", janet_core_keyword, "keyword", janet_core_keyword,
JDOC("(keyword & xs)\n\n" JDOC("(keyword & xs)\n\n"
"Creates a keyword by concatenating values together. Values are " "Creates a keyword by concatenating the elements of `xs` together. If an "
"converted to bytes via describe if they are not byte sequences. Returns " "element is not a byte sequence, it is converted to bytes via `describe`. "
"the new keyword.") "Returns the new keyword.")
}, },
{ {
"buffer", janet_core_buffer, "buffer", janet_core_buffer,
JDOC("(buffer & xs)\n\n" JDOC("(buffer & xs)\n\n"
"Creates a new buffer by concatenating values together. Values are " "Creates a buffer by concatenating the elements of `xs` together. If an "
"converted to bytes via describe if they are not byte sequences. Returns " "element is not a byte sequence, it is converted to bytes via `describe`. "
"the new buffer.") "Returns the new buffer.")
}, },
{ {
"abstract?", janet_core_is_abstract, "abstract?", janet_core_is_abstract,
@ -1250,6 +1250,21 @@ JanetTable *janet_core_env(JanetTable *replacements) {
JanetTable *env = janet_unwrap_table(marsh_out); JanetTable *env = janet_unwrap_table(marsh_out);
janet_vm_core_env = env; janet_vm_core_env = env;
/* Invert image dict manually here. We can't do this in boot.janet as it
* breaks deterministic builds */
Janet lidv, midv;
lidv = midv = janet_wrap_nil();
janet_resolve(env, janet_csymbol("load-image-dict"), &lidv);
janet_resolve(env, janet_csymbol("make-image-dict"), &midv);
JanetTable *lid = janet_unwrap_table(lidv);
JanetTable *mid = janet_unwrap_table(midv);
for (int32_t i = 0; i < lid->capacity; i++) {
const JanetKV *kv = lid->data + i;
if (!janet_checktype(kv->key, JANET_NIL)) {
janet_table_put(mid, kv->value, kv->key);
}
}
return env; return env;
} }

View File

@ -132,6 +132,7 @@ typedef struct JanetTimeout JanetTimeout;
struct JanetTimeout { struct JanetTimeout {
JanetTimestamp when; JanetTimestamp when;
JanetFiber *fiber; JanetFiber *fiber;
JanetFiber *curr_fiber;
uint32_t sched_id; uint32_t sched_id;
int is_error; int is_error;
}; };
@ -378,12 +379,56 @@ static int janet_stream_getter(void *p, Janet key, Janet *out) {
return 0; return 0;
} }
static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
JanetStream *s = p;
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only marshal stream with unsafe flag");
}
janet_marshal_abstract(ctx, p);
janet_marshal_int(ctx, (int32_t) s->flags);
janet_marshal_int64(ctx, (intptr_t) s->methods);
#ifdef JANET_WINDOWS
/* TODO - ref counting to avoid situation where a handle is closed or GCed
* while in transit, and it's value gets reused. DuplicateHandle does not work
* for network sockets, and in general for winsock it is better to nipt duplicate
* unless there is a need to. */
janet_marshal_int64(ctx, (int64_t)(s->handle));
#else
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
int duph = dup(s->handle);
if (duph < 0) janet_panicf("failed to duplicate stream handle: %V", janet_ev_lasterr());
janet_marshal_int(ctx, (int32_t)(duph));
#endif
}
static void *janet_stream_unmarshal(JanetMarshalContext *ctx) {
if (!(ctx->flags & JANET_MARSHAL_UNSAFE)) {
janet_panic("can only unmarshal stream with unsafe flag");
}
JanetStream *p = janet_unmarshal_abstract(ctx, sizeof(JanetStream));
/* Can't share listening state and such across threads */
p->_mask = 0;
p->state = NULL;
p->flags = (uint32_t) janet_unmarshal_int(ctx);
p->methods = (void *) janet_unmarshal_int64(ctx);
#ifdef JANET_WINDOWS
p->handle = (JanetHandle) janet_unmarshal_int64(ctx);
#else
p->handle = (JanetHandle) janet_unmarshal_int(ctx);
#endif
return p;
}
const JanetAbstractType janet_stream_type = { const JanetAbstractType janet_stream_type = {
"core/stream", "core/stream",
janet_stream_gc, janet_stream_gc,
janet_stream_mark, janet_stream_mark,
janet_stream_getter, janet_stream_getter,
JANET_ATEND_GET NULL,
janet_stream_marshal,
janet_stream_unmarshal,
JANET_ATEND_UNMARSHAL
}; };
/* Register a fiber to resume with value */ /* Register a fiber to resume with value */
@ -435,6 +480,9 @@ void janet_ev_mark(void) {
/* Pending timeouts */ /* Pending timeouts */
for (size_t i = 0; i < janet_vm_tq_count; i++) { for (size_t i = 0; i < janet_vm_tq_count; i++) {
janet_mark(janet_wrap_fiber(janet_vm_tq[i].fiber)); janet_mark(janet_wrap_fiber(janet_vm_tq[i].fiber));
if (janet_vm_tq[i].curr_fiber != NULL) {
janet_mark(janet_wrap_fiber(janet_vm_tq[i].curr_fiber));
}
} }
/* Pending listeners */ /* Pending listeners */
@ -488,6 +536,7 @@ void janet_addtimeout(double sec) {
JanetTimeout to; JanetTimeout to;
to.when = ts_delta(ts_now(), sec); to.when = ts_delta(ts_now(), sec);
to.fiber = fiber; to.fiber = fiber;
to.curr_fiber = NULL;
to.sched_id = fiber->sched_id; to.sched_id = fiber->sched_id;
to.is_error = 1; to.is_error = 1;
add_timeout(to); add_timeout(to);
@ -776,11 +825,27 @@ void janet_loop1(void) {
JanetTimestamp now = ts_now(); JanetTimestamp now = ts_now();
while (peek_timeout(&to) && to.when <= now) { while (peek_timeout(&to) && to.when <= now) {
pop_timeout(0); pop_timeout(0);
if (to.fiber->sched_id == to.sched_id) { if (to.curr_fiber != NULL) {
if (to.is_error) { /* This is a deadline (for a fiber, not a function call) */
janet_cancel(to.fiber, janet_cstringv("timeout")); JanetFiberStatus s = janet_fiber_status(to.curr_fiber);
} else { int isFinished = s == (JANET_STATUS_DEAD ||
janet_schedule(to.fiber, janet_wrap_nil()); s == JANET_STATUS_ERROR ||
s == JANET_STATUS_USER0 ||
s == JANET_STATUS_USER1 ||
s == JANET_STATUS_USER2 ||
s == JANET_STATUS_USER3 ||
s == JANET_STATUS_USER4);
if (!isFinished) {
janet_cancel(to.fiber, janet_cstringv("deadline expired"));
}
} else {
/* This is a timeout (for a function call, not a whole fiber) */
if (to.fiber->sched_id == to.sched_id) {
if (to.is_error) {
janet_cancel(to.fiber, janet_cstringv("timeout"));
} else {
janet_schedule(to.fiber, janet_wrap_nil());
}
} }
} }
} }
@ -798,7 +863,7 @@ void janet_loop1(void) {
memset(&to, 0, sizeof(to)); memset(&to, 0, sizeof(to));
int has_timeout; int has_timeout;
/* Drop timeouts that are no longer needed */ /* Drop timeouts that are no longer needed */
while ((has_timeout = peek_timeout(&to)) && to.fiber->sched_id != to.sched_id) { while ((has_timeout = peek_timeout(&to)) && (to.curr_fiber == NULL) && to.fiber->sched_id != to.sched_id) {
pop_timeout(0); pop_timeout(0);
} }
/* Run polling implementation only if pending timeouts or pending events */ /* Run polling implementation only if pending timeouts or pending events */
@ -1319,7 +1384,7 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
janet_buffer_push_bytes(state->buf, state->chunk_buf, s->bytes); janet_buffer_push_bytes(state->buf, state->chunk_buf, s->bytes);
state->bytes_left -= s->bytes; state->bytes_left -= s->bytes;
if (state->bytes_left <= 0 || !state->is_chunk || s->bytes == 0) { if (state->bytes_left == 0 || !state->is_chunk || s->bytes == 0) {
Janet resume_val; Janet resume_val;
#ifdef JANET_NET #ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) { if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
@ -1382,12 +1447,11 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
} }
return JANET_ASYNC_STATUS_DONE; return JANET_ASYNC_STATUS_DONE;
} }
case JANET_ASYNC_EVENT_READ: case JANET_ASYNC_EVENT_READ: {
/* Read in bytes */
{
JanetBuffer *buffer = state->buf; JanetBuffer *buffer = state->buf;
int32_t bytes_left = state->bytes_left; int32_t bytes_left = state->bytes_left;
janet_buffer_extra(buffer, bytes_left); int32_t read_limit = bytes_left < 0 ? 4096 : bytes_left;
janet_buffer_extra(buffer, read_limit);
ssize_t nread; ssize_t nread;
#ifdef JANET_NET #ifdef JANET_NET
char saddr[256]; char saddr[256];
@ -1396,14 +1460,14 @@ JanetAsyncStatus ev_machine_read(JanetListenerState *s, JanetAsyncEvent event) {
do { do {
#ifdef JANET_NET #ifdef JANET_NET
if (state->mode == JANET_ASYNC_READMODE_RECVFROM) { if (state->mode == JANET_ASYNC_READMODE_RECVFROM) {
nread = recvfrom(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags, nread = recvfrom(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags,
(struct sockaddr *)&saddr, &socklen); (struct sockaddr *)&saddr, &socklen);
} else if (state->mode == JANET_ASYNC_READMODE_RECV) { } else if (state->mode == JANET_ASYNC_READMODE_RECV) {
nread = recv(s->stream->handle, buffer->data + buffer->count, bytes_left, state->flags); nread = recv(s->stream->handle, buffer->data + buffer->count, read_limit, state->flags);
} else } else
#endif #endif
{ {
nread = read(s->stream->handle, buffer->data + buffer->count, bytes_left); nread = read(s->stream->handle, buffer->data + buffer->count, read_limit);
} }
} while (nread == -1 && errno == EINTR); } while (nread == -1 && errno == EINTR);
@ -1784,6 +1848,7 @@ JANET_NO_RETURN void janet_sleep_await(double sec) {
to.fiber = janet_vm_root_fiber; to.fiber = janet_vm_root_fiber;
to.is_error = 0; to.is_error = 0;
to.sched_id = to.fiber->sched_id; to.sched_id = to.fiber->sched_id;
to.curr_fiber = NULL;
add_timeout(to); add_timeout(to);
janet_await(); janet_await();
} }
@ -1794,6 +1859,21 @@ static Janet cfun_ev_sleep(int32_t argc, Janet *argv) {
janet_sleep_await(sec); janet_sleep_await(sec);
} }
static Janet cfun_ev_deadline(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 3);
double sec = janet_getnumber(argv, 0);
JanetFiber *tocancel = janet_optfiber(argv, argc, 1, janet_vm_root_fiber);
JanetFiber *tocheck = janet_optfiber(argv, argc, 2, janet_vm_fiber);
JanetTimeout to;
to.when = ts_delta(ts_now(), sec);
to.fiber = tocancel;
to.curr_fiber = tocheck;
to.is_error = 0;
to.sched_id = to.fiber->sched_id;
add_timeout(to);
return janet_wrap_fiber(tocancel);
}
static Janet cfun_ev_cancel(int32_t argc, Janet *argv) { static Janet cfun_ev_cancel(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2); janet_fixarity(argc, 2);
JanetFiber *fiber = janet_getfiber(argv, 0); JanetFiber *fiber = janet_getfiber(argv, 0);
@ -1813,11 +1893,16 @@ Janet janet_cfun_stream_read(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE); janet_stream_flags(stream, JANET_STREAM_READABLE);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10); JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY); double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to); if (janet_keyeq(argv[1], "all")) {
janet_ev_read(stream, buffer, n); if (to != INFINITY) janet_addtimeout(to);
janet_ev_readchunk(stream, buffer, -1);
} else {
int32_t n = janet_getnat(argv, 1);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_read(stream, buffer, n);
}
janet_await(); janet_await();
} }
@ -1867,6 +1952,14 @@ static const JanetReg ev_cfuns[] = {
JDOC("(ev/sleep sec)\n\n" JDOC("(ev/sleep sec)\n\n"
"Suspend the current fiber for sec seconds without blocking the event loop.") "Suspend the current fiber for sec seconds without blocking the event loop.")
}, },
{
"ev/deadline", cfun_ev_deadline,
JDOC("(ev/deadline sec &opt tocancel tocheck)\n\n"
"Set a deadline for a fiber `tocheck`. If `tocheck` is not finished after `sec` seconds, "
"`tocancel` will be canceled as with `ev/cancel`. "
"If `tocancel` and `tocheck` are not given, they default to `(fiber/root)` and "
"`(fiber/current)` respectively. Returns `tocancel`.")
},
{ {
"ev/chan", cfun_channel_new, "ev/chan", cfun_channel_new,
JDOC("(ev/chan &opt capacity)\n\n" JDOC("(ev/chan &opt capacity)\n\n"
@ -1924,7 +2017,8 @@ static const JanetReg ev_cfuns[] = {
{ {
"ev/read", janet_cfun_stream_read, "ev/read", janet_cfun_stream_read,
JDOC("(ev/read stream n &opt buffer timeout)\n\n" JDOC("(ev/read stream n &opt buffer timeout)\n\n"
"Read up to n bytes into a buffer asynchronously from a stream. " "Read up to n bytes into a buffer asynchronously from a stream. `n` can also be the keyword "
"`:all` to read into the buffer until end of stream. "
"Optionally provide a buffer to write into " "Optionally provide a buffer to write into "
"as well as a timeout in seconds after which to cancel the operation and raise an error. " "as well as a timeout in seconds after which to cancel the operation and raise an error. "
"Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an " "Returns the buffer if the read was successful or nil if end-of-stream reached. Will raise an "

View File

@ -420,8 +420,7 @@ void janet_fiber_cframe(JanetFiber *fiber, JanetCFunction cfun) {
newframe->flags = 0; newframe->flags = 0;
} }
/* Pop a stack frame from the fiber. Returns the new stack frame, or /* Pop a stack frame from the fiber. */
* NULL if there are no more frames */
void janet_fiber_popframe(JanetFiber *fiber) { void janet_fiber_popframe(JanetFiber *fiber) {
JanetStackFrame *frame = janet_fiber_frame(fiber); JanetStackFrame *frame = janet_fiber_frame(fiber);
if (fiber->frame == 0) return; if (fiber->frame == 0) return;

View File

@ -226,11 +226,14 @@ static void janet_mark_function(JanetFunction *func) {
if (janet_gc_reachable(func)) if (janet_gc_reachable(func))
return; return;
janet_gc_mark(func); janet_gc_mark(func);
numenvs = func->def->environments_length; if (NULL != func->def) {
for (i = 0; i < numenvs; ++i) { /* this should always be true, except if function is only partially constructed */
janet_mark_funcenv(func->envs[i]); numenvs = func->def->environments_length;
for (i = 0; i < numenvs; ++i) {
janet_mark_funcenv(func->envs[i]);
}
janet_mark_funcdef(func->def);
} }
janet_mark_funcdef(func->def);
} }
static void janet_mark_fiber(JanetFiber *fiber) { static void janet_mark_fiber(JanetFiber *fiber) {

View File

@ -777,7 +777,7 @@ static const JanetReg io_cfuns[] = {
#ifndef JANET_NO_PROCESSES #ifndef JANET_NO_PROCESSES
{ {
"file/popen", cfun_io_popen, "file/popen", cfun_io_popen,
JDOC("(file/popen command &opt mode)\n\n" JDOC("(file/popen command &opt mode) (DEPRECATED for os/spawn)\n\n"
"Open a file that is backed by a process. The file must be opened in either " "Open a file that is backed by a process. The file must be opened in either "
"the :r (read) or the :w (write) mode. In :r mode, the stdout of the " "the :r (read) or the :w (write) mode. In :r mode, the stdout of the "
"process can be read from the file. In :w mode, the stdin of the process " "process can be read from the file. In :w mode, the stdin of the process "

View File

@ -286,7 +286,7 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
#define JANET_FIBER_FLAG_HASCHILD (1 << 29) #define JANET_FIBER_FLAG_HASCHILD (1 << 29)
#define JANET_FIBER_FLAG_HASENV (1 << 30) #define JANET_FIBER_FLAG_HASENV (1 << 30)
#define JANET_STACKFRAME_HASENV (1 << 31) #define JANET_STACKFRAME_HASENV (INT32_MIN)
/* Marshal a fiber */ /* Marshal a fiber */
static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) { static void marshal_one_fiber(MarshalState *st, JanetFiber *fiber, int flags) {
@ -542,9 +542,10 @@ static void marshal_one(MarshalState *st, Janet x, int flags) {
case JANET_FUNCTION: { case JANET_FUNCTION: {
pushbyte(st, LB_FUNCTION); pushbyte(st, LB_FUNCTION);
JanetFunction *func = janet_unwrap_function(x); JanetFunction *func = janet_unwrap_function(x);
marshal_one_def(st, func->def, flags); /* Mark seen before reading def */
/* Mark seen after reading def, but before envs */
MARK_SEEN(); MARK_SEEN();
pushint(st, func->def->environments_length);
marshal_one_def(st, func->def, flags);
for (int32_t i = 0; i < func->def->environments_length; i++) for (int32_t i = 0; i < func->def->environments_length; i++)
marshal_one_env(st, func->envs[i], flags + 1); marshal_one_env(st, func->envs[i], flags + 1);
return; return;
@ -1228,12 +1229,20 @@ static const uint8_t *unmarshal_one(
case LB_FUNCTION: { case LB_FUNCTION: {
JanetFunction *func; JanetFunction *func;
JanetFuncDef *def; JanetFuncDef *def;
data = unmarshal_one_def(st, data + 1, &def, flags + 1); data++;
int32_t len = readnat(st, &data);
if (len > 255) {
janet_panicf("invalid function");
}
func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) + func = janet_gcalloc(JANET_MEMORY_FUNCTION, sizeof(JanetFunction) +
def->environments_length * sizeof(JanetFuncEnv)); len * sizeof(JanetFuncEnv));
func->def = def;
*out = janet_wrap_function(func); *out = janet_wrap_function(func);
janet_v_push(st->lookup, *out); janet_v_push(st->lookup, *out);
data = unmarshal_one_def(st, data, &def, flags + 1);
if (def->environments_length != len) {
janet_panicf("invalid function");
}
func->def = def;
for (int32_t i = 0; i < def->environments_length; i++) { for (int32_t i = 0; i < def->environments_length; i++) {
data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1); data = unmarshal_one_env(st, data, &(func->envs[i]), flags + 1);
} }

View File

@ -509,11 +509,16 @@ static Janet cfun_stream_read(int32_t argc, Janet *argv) {
janet_arity(argc, 2, 4); janet_arity(argc, 2, 4);
JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type); JanetStream *stream = janet_getabstract(argv, 0, &janet_stream_type);
janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET); janet_stream_flags(stream, JANET_STREAM_READABLE | JANET_STREAM_SOCKET);
int32_t n = janet_getnat(argv, 1);
JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10); JanetBuffer *buffer = janet_optbuffer(argv, argc, 2, 10);
double to = janet_optnumber(argv, argc, 3, INFINITY); double to = janet_optnumber(argv, argc, 3, INFINITY);
if (to != INFINITY) janet_addtimeout(to); if (janet_keyeq(argv[1], "all")) {
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL); if (to != INFINITY) janet_addtimeout(to);
janet_ev_recvchunk(stream, buffer, -1, MSG_NOSIGNAL);
} else {
int32_t n = janet_getnat(argv, 1);
if (to != INFINITY) janet_addtimeout(to);
janet_ev_recv(stream, buffer, n, MSG_NOSIGNAL);
}
janet_await(); janet_await();
} }
@ -643,6 +648,7 @@ static const JanetReg net_cfuns[] = {
"net/read", cfun_stream_read, "net/read", cfun_stream_read,
JDOC("(net/read stream nbytes &opt buf timeout)\n\n" JDOC("(net/read stream nbytes &opt buf timeout)\n\n"
"Read up to n bytes from a stream, suspending the current fiber until the bytes are available. " "Read up to n bytes from a stream, suspending the current fiber until the bytes are available. "
"`n` can also be the keyword `:all` to read into the buffer until end of stream. "
"If less than n bytes are available (and more than 0), will push those bytes and return early. " "If less than n bytes are available (and more than 0), will push those bytes and return early. "
"Takes an optional timeout in seconds, after which will return nil. " "Takes an optional timeout in seconds, after which will return nil. "
"Returns a buffer with up to n more bytes in it, or raises an error if the read failed.") "Returns a buffer with up to n more bytes in it, or raises an error if the read failed.")

View File

@ -2126,25 +2126,25 @@ static const JanetReg os_cfuns[] = {
"mode should be a file mode as passed to os/chmod, but only if the create flag is given. " "mode should be a file mode as passed to os/chmod, but only if the create flag is given. "
"The default mode is 8r666. " "The default mode is 8r666. "
"Allowed flags are as follows:\n\n" "Allowed flags are as follows:\n\n"
"\t:r - open this file for reading\n" " * :r - open this file for reading\n"
"\t:w - open this file for writing\n" " * :w - open this file for writing\n"
"\t:c - create a new file (O_CREATE)\n" " * :c - create a new file (O_CREATE)\n"
"\t:e - fail if the file exists (O_EXCL)\n" " * :e - fail if the file exists (O_EXCL)\n"
"\t:t - shorten an existing file to length 0 (O_TRUNC)\n\n" " * :t - shorten an existing file to length 0 (O_TRUNC)\n\n"
"Posix only flags:\n" "Posix only flags:\n\n"
"\t:a - append to a file (O_APPEND)\n" " * :a - append to a file (O_APPEND)\n"
"\t:x - O_SYNC\n" " * :x - O_SYNC\n"
"\t:C - O_NOCTTY\n\n" " * :C - O_NOCTTY\n\n"
"Windows only flags:\n" "Windows only flags:\n\n"
"\t:R - share reads (FILE_SHARE_READ)\n" " * :R - share reads (FILE_SHARE_READ)\n"
"\t:W - share writes (FILE_SHARE_WRITE)\n" " * :W - share writes (FILE_SHARE_WRITE)\n"
"\t:D - share deletes (FILE_SHARE_DELETE)\n" " * :D - share deletes (FILE_SHARE_DELETE)\n"
"\t:H - FILE_ATTRIBUTE_HIDDEN\n" " * :H - FILE_ATTRIBUTE_HIDDEN\n"
"\t:O - FILE_ATTRIBUTE_READONLY\n" " * :O - FILE_ATTRIBUTE_READONLY\n"
"\t:F - FILE_ATTRIBUTE_OFFLINE\n" " * :F - FILE_ATTRIBUTE_OFFLINE\n"
"\t:T - FILE_ATTRIBUTE_TEMPORARY\n" " * :T - FILE_ATTRIBUTE_TEMPORARY\n"
"\t:d - FILE_FLAG_DELETE_ON_CLOSE\n" " * :d - FILE_FLAG_DELETE_ON_CLOSE\n"
"\t:b - FILE_FLAG_NO_BUFFERING\n") " * :b - FILE_FLAG_NO_BUFFERING\n")
}, },
{ {
"os/pipe", os_pipe, "os/pipe", os_pipe,

View File

@ -985,8 +985,20 @@ static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
} }
static Janet cfun_parse_where(int32_t argc, Janet *argv) { static Janet cfun_parse_where(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1); janet_arity(argc, 1, 3);
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type); JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
if (argc > 1) {
int32_t line = janet_getinteger(argv, 1);
if (line < 1)
janet_panicf("invalid line number %d", line);
p->line = (size_t) line;
}
if (argc > 2) {
int32_t column = janet_getinteger(argv, 2);
if (column < 0)
janet_panicf("invalid column number %d", column);
p->column = (size_t) column;
}
Janet *tup = janet_tuple_begin(2); Janet *tup = janet_tuple_begin(2);
tup[0] = janet_wrap_integer(p->line); tup[0] = janet_wrap_integer(p->line);
tup[1] = janet_wrap_integer(p->column); tup[1] = janet_wrap_integer(p->column);
@ -1247,8 +1259,10 @@ static const JanetReg parse_cfuns[] = {
}, },
{ {
"parser/where", cfun_parse_where, "parser/where", cfun_parse_where,
JDOC("(parser/where parser)\n\n" JDOC("(parser/where parser &opt line col)\n\n"
"Returns the current line number and column of the parser's internal state.") "Returns the current line number and column of the parser's internal state. If line is "
"provided, the current line number of the parser is first set to that value. If column is "
"also provided, the current column number of the parser is also first set to that value.")
}, },
{ {
"parser/eof", cfun_parse_eof, "parser/eof", cfun_parse_eof,

View File

@ -565,7 +565,7 @@ static void janet_pretty_one(struct pretty *S, Janet x, int is_dict_value) {
JanetTable *t = janet_unwrap_table(x); JanetTable *t = janet_unwrap_table(x);
JanetTable *proto = t->proto; JanetTable *proto = t->proto;
if (NULL != proto) { if (NULL != proto) {
Janet name = janet_table_get(proto, janet_ckeywordv("name")); Janet name = janet_table_get(proto, janet_ckeywordv("_name"));
const uint8_t *n; const uint8_t *n;
int32_t len; int32_t len;
if (janet_bytes_view(name, &n, &len)) { if (janet_bytes_view(name, &n, &len)) {

View File

@ -227,19 +227,21 @@ int32_t janet_string_calchash(const uint8_t *str, int32_t len) {
/* Computes hash of an array of values */ /* Computes hash of an array of values */
int32_t janet_array_calchash(const Janet *array, int32_t len) { int32_t janet_array_calchash(const Janet *array, int32_t len) {
const Janet *end = array + len; const Janet *end = array + len;
uint32_t hash = 5381; uint32_t hash = 0;
while (array < end) while (array < end) {
hash = (hash << 5) + hash + janet_hash(*array++); uint32_t elem = janet_hash(*array++);
hash ^= elem + 0x9e3779b9 + (hash << 6) + (hash >> 2);
}
return (int32_t) hash; return (int32_t) hash;
} }
/* Computes hash of an array of values */ /* Computes hash of an array of values */
int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) { int32_t janet_kv_calchash(const JanetKV *kvs, int32_t len) {
const JanetKV *end = kvs + len; const JanetKV *end = kvs + len;
uint32_t hash = 5381; uint32_t hash = 0;
while (kvs < end) { while (kvs < end) {
hash = (hash << 5) + hash + janet_hash(kvs->key); hash ^= janet_hash(kvs->key) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
hash = (hash << 5) + hash + janet_hash(kvs->value); hash ^= janet_hash(kvs->value) + 0x9e3779b9 + (hash << 6) + (hash >> 2);
kvs++; kvs++;
} }
return (int32_t) hash; return (int32_t) hash;

View File

@ -28,6 +28,8 @@
#include <janet.h> #include <janet.h>
#endif #endif
#include <math.h>
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL; JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL; JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_top = NULL;
JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL; JANET_THREAD_LOCAL JanetTraversalNode *janet_vm_traversal_base = NULL;
@ -261,6 +263,21 @@ int32_t janet_hash(Janet x) {
case JANET_STRUCT: case JANET_STRUCT:
hash = janet_struct_hash(janet_unwrap_struct(x)); hash = janet_struct_hash(janet_unwrap_struct(x));
break; break;
case JANET_NUMBER: {
double num = janet_unwrap_number(x);
if (isnan(num) || isinf(num) || num == 0) {
hash = 0;
} else {
hash = (int32_t)num;
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
hash = ((hash >> 16) ^ hash) * 0x45d9f3b;
hash = (hash >> 16) ^ hash;
uint32_t lo = (uint32_t)(janet_u64(x) & 0xFFFFFFFF);
hash ^= lo + 0x9e3779b9 + (hash << 6) + (hash >> 2);
}
break;
}
case JANET_ABSTRACT: { case JANET_ABSTRACT: {
JanetAbstract xx = janet_unwrap_abstract(x); JanetAbstract xx = janet_unwrap_abstract(x);
const JanetAbstractType *at = janet_abstract_type(xx); const JanetAbstractType *at = janet_abstract_type(xx);

View File

@ -126,28 +126,21 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#define JANET_LINE_MAX 1024 #define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256 #define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100 #define JANET_HISTORY_MAX 100
static int gbl_israwmode = 0; static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static const char *gbl_prompt = "> "; static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static int gbl_plen = 2; static JANET_THREAD_LOCAL int gbl_plen = 2;
static char gbl_buf[JANET_LINE_MAX]; static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static int gbl_len = 0; static JANET_THREAD_LOCAL int gbl_len = 0;
static int gbl_pos = 0; static JANET_THREAD_LOCAL int gbl_pos = 0;
static int gbl_cols = 80; static JANET_THREAD_LOCAL int gbl_cols = 80;
static char *gbl_history[JANET_HISTORY_MAX]; static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static int gbl_history_count = 0; static JANET_THREAD_LOCAL int gbl_history_count = 0;
static int gbl_historyi = 0; static JANET_THREAD_LOCAL int gbl_historyi = 0;
static int gbl_sigint_flag = 0; static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
static struct termios gbl_termios_start; static JANET_THREAD_LOCAL struct termios gbl_termios_start;
static JanetByteView gbl_matches[JANET_MATCH_MAX]; static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static int gbl_match_count = 0; static JANET_THREAD_LOCAL int gbl_match_count = 0;
static int gbl_lines_below = 0; static JANET_THREAD_LOCAL int gbl_lines_below = 0;
/* Put a lock around this global state so we don't screw up
* the terminal in a multithreaded situation */
#ifndef JANET_SINGLE_THREADED
#include <pthread.h>
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
#endif
/* Unsupported terminal list from linenoise */ /* Unsupported terminal list from linenoise */
static const char *badterms[] = { static const char *badterms[] = {
@ -169,9 +162,6 @@ static char *sdup(const char *s) {
/* Ansi terminal raw mode */ /* Ansi terminal raw mode */
static int rawmode(void) { static int rawmode(void) {
struct termios t; struct termios t;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_lock(&gbl_lock);
#endif
if (!isatty(STDIN_FILENO)) goto fatal; if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal; if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start; t = gbl_termios_start;
@ -185,9 +175,6 @@ static int rawmode(void) {
return 0; return 0;
fatal: fatal:
errno = ENOTTY; errno = ENOTTY;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
return -1; return -1;
} }
@ -195,9 +182,6 @@ fatal:
static void norawmode(void) { static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1) if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSADRAIN, &gbl_termios_start) != -1)
gbl_israwmode = 0; gbl_israwmode = 0;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
} }
static int curpos(void) { static int curpos(void) {
@ -774,6 +758,10 @@ static int line() {
kleft(); kleft();
break; break;
case 3: /* ctrl-c */ case 3: /* ctrl-c */
clearlines();
gbl_sigint_flag = 1;
return -1;
case 17: /* ctrl-q */
gbl_cancel_current_repl_form = 1; gbl_cancel_current_repl_form = 1;
clearlines(); clearlines();
return -1; return -1;

View File

@ -13,7 +13,7 @@
(when x (++ num-tests-passed)) (when x (++ num-tests-passed))
(def str (string e)) (def str (string e))
(def truncated (def truncated
(if (> (length e) 40) (string (string/slice e 0 35) "...") (string e))) (if (> (length e) 40) (string (string/slice e 0 35) "...") (describe e)))
(if x (if x
(eprintf "\e[32m✔\e[0m %s: %v" truncated x) (eprintf "\e[32m✔\e[0m %s: %v" truncated x)
(eprintf "\n\e[31m✘\e[0m %s: %v" truncated x)) (eprintf "\n\e[31m✘\e[0m %s: %v" truncated x))

View File

@ -1,3 +1,3 @@
(import build/testmod :as testmod) (import /build/testmod :as testmod)
(if (not= 5 (testmod/get5)) (error "testmod/get5 failed")) (if (not= 5 (testmod/get5)) (error "testmod/get5 failed"))

View File

@ -1,7 +1,7 @@
(use build/testmod) (use /build/testmod)
(use build/testmod2) (use /build/testmod2)
(use build/testmod3) (use /build/testmod3)
(use build/test-mod-4) (use /build/test-mod-4)
(defn main [&] (defn main [&]
(print "Hello from executable!") (print "Hello from executable!")

View File

@ -128,6 +128,18 @@
(assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol") (assert (not= nil (parse-error @"\xc3\x28")) "reject invalid utf-8 symbol")
(assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword") (assert (not= nil (parse-error @":\xc3\x28")) "reject invalid utf-8 keyword")
# Parser line and column numbers
(defn parser-location [input &opt location]
(def p (parser/new))
(parser/consume p input)
(if location
(parser/where p ;location)
(parser/where p)))
(assert (= [1 7] (parser-location @"(+ 1 2)")) "parser location 1")
(assert (= [5 7] (parser-location @"(+ 1 2)" [5])) "parser location 2")
(assert (= [10 10] (parser-location @"(+ 1 2)" [10 10])) "parser location 3")
# String check-set # String check-set
(assert (string/check-set "abc" "a") "string/check-set 1") (assert (string/check-set "abc" "a") "string/check-set 1")
(assert (not (string/check-set "abc" "z")) "string/check-set 2") (assert (not (string/check-set "abc" "z")) "string/check-set 2")

View File

@ -125,6 +125,7 @@
(assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5") (assert (= :yes (match {:a 1} {:a _} :yes :no)) "match wildcard 5")
(assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6") (assert (= false (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} false :no)) "match wildcard 6")
(assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7") (assert (= nil (match {:a 1 :b 2 :c 3} {:a a :b _ :c _ :d _} :no {:a _ :b _ :c _} nil :no)) "match wildcard 7")
(assert (= "t" (match [true nil] [true _] "t")) "match wildcard 8")
# Regression #301 # Regression #301
(def b (buffer/new-filled 128 0x78)) (def b (buffer/new-filled 128 0x78))
@ -221,20 +222,6 @@
neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02 neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
\0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict)) \0\0\0\0\0*\xFE\x01\04\x02\0\0'\x03\0\r\0\r\0\r\0\r" load-image-dict))
# No segfault, valgrind clean.
(def x @"\xCC\xCD.nd\x80\0\r\x1C\xCDg!\0\x07\xCC\xCD\r\x1Ce\x10\0\r;\xCDb\x04\xFF9\xFF\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04uu\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04}\x04\x04\x04\x04\x04\x04\x04\x04#\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\0\x01\0\0\x03\x04\x04\x04\xE2\x03\x04\x04\x04\x04\x04\x04\x04\x04\x04\x14\x1A\x04\x04\x04\x04\x04\x18\x04\x04!\x04\xE2\x03\x04\x04\x04\x04\x04\x04$\x04\x04\x04\x04\x04\x04\x04\x04\x04\x80\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04\x04A\0\0\0\x03\0\0!\xBF\xFF")
(assert-error "bad fiber status" (unmarshal x load-image-dict))
(gccollect)
(marshal x make-image-dict)
(def b @"\xCC\xCD\0\x03\0\x08\x04\rm\xCD\x7F\xFF\xFF\xFF\x02\0\x02\xD7\xCD\0\x98\0\0\x05\x01\x01\x01\x01\x08\xCE\x01f\xCE../tools/afl/generate_unmarshal_testcases.janet\xCE\x012,\x01\0\0&\x03\0\06\x02\x03\x03)\x03\x01\0*\x04\0\00\x03\x04\0>\x03\0\0\x03\x03\0\0*\x05\0\x11\0\x11\0\x05\0\x05\0\x05\0\x05\0\x05\xC9\xDA\x04\xC9\xC9\xC9")
(unmarshal b load-image-dict)
(gccollect)
(def v (unmarshal
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
(gccollect) (gccollect)
# in vs get regression # in vs get regression
@ -349,4 +336,12 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(check-replacer "aba" "ZZZZZZ" "ababababababa") (check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa") (check-replacer "aba" "" "ababababababa")
# Peg bug
(assert (deep= @[] (peg/match '(any 1) @"")) "peg empty pattern 1")
(assert (deep= @[] (peg/match '(any 1) (buffer))) "peg empty pattern 2")
(assert (deep= @[] (peg/match '(any 1) "")) "peg empty pattern 3")
(assert (deep= @[] (peg/match '(any 1) (string))) "peg empty pattern 4")
(assert (deep= @[] (peg/match '(* "test" (any 1)) @"test")) "peg empty pattern 5")
(assert (deep= @[] (peg/match '(* "test" (any 1)) (buffer "test"))) "peg empty pattern 6")
(end-suite) (end-suite)