mirror of
https://github.com/janet-lang/janet
synced 2025-02-02 18:29:10 +00:00
Merge branch 'master' into compile-opt
This commit is contained in:
commit
8a394f2506
@ -1,4 +1,4 @@
|
|||||||
image: openbsd/latest
|
image: openbsd/7.4
|
||||||
sources:
|
sources:
|
||||||
- https://git.sr.ht/~bakpakin/janet
|
- https://git.sr.ht/~bakpakin/janet
|
||||||
packages:
|
packages:
|
||||||
|
4
.github/workflows/test.yml
vendored
4
.github/workflows/test.yml
vendored
@ -73,7 +73,7 @@ jobs:
|
|||||||
- name: Compile the project
|
- name: Compile the project
|
||||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||||
- name: Test the project
|
- name: Test the project
|
||||||
run: make test UNAME=MINGW RUN=wine
|
run: make test UNAME=MINGW RUN=wine VERBOSE=1
|
||||||
|
|
||||||
test-arm-linux:
|
test-arm-linux:
|
||||||
name: Build and test ARM32 cross compilation
|
name: Build and test ARM32 cross compilation
|
||||||
@ -88,4 +88,4 @@ jobs:
|
|||||||
- name: Compile the project
|
- name: Compile the project
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
||||||
- name: Test the project
|
- name: Test the project
|
||||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test
|
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" SUBRUN="qemu-arm -L /usr/arm-linux-gnueabi/" test VERBOSE=1
|
||||||
|
4
.gitignore
vendored
4
.gitignore
vendored
@ -48,6 +48,7 @@ janet.wasm
|
|||||||
# Generated files
|
# Generated files
|
||||||
*.gen.h
|
*.gen.h
|
||||||
*.gen.c
|
*.gen.c
|
||||||
|
*.tmp
|
||||||
|
|
||||||
# Generate test files
|
# Generate test files
|
||||||
*.out
|
*.out
|
||||||
@ -126,6 +127,9 @@ vgcore.*
|
|||||||
*.idb
|
*.idb
|
||||||
*.pdb
|
*.pdb
|
||||||
|
|
||||||
|
# GGov
|
||||||
|
*.gcov
|
||||||
|
|
||||||
# Kernel Module Compile Results
|
# Kernel Module Compile Results
|
||||||
*.mod*
|
*.mod*
|
||||||
*.cmd
|
*.cmd
|
||||||
|
@ -2,6 +2,13 @@
|
|||||||
All notable changes to this project will be documented in this file.
|
All notable changes to this project will be documented in this file.
|
||||||
|
|
||||||
## Unreleased - ???
|
## Unreleased - ???
|
||||||
|
- Add extra optional `env` argument to `eval` and `eval-string`.
|
||||||
|
- Allow naming function literals with a keyword. This allows better stacktraces for macros without
|
||||||
|
accidentally adding new bindings.
|
||||||
|
- Add macros `ev/with-lock`, `ev/with-rlock`, and `ev/with-wlock` for using mutexes and rwlocks.
|
||||||
|
- Add `with-env`
|
||||||
|
- Add *module-make-env* dynamic binding
|
||||||
|
- Add buffer/format-at
|
||||||
- Add long form command line options for readable CLI usage
|
- Add long form command line options for readable CLI usage
|
||||||
- Fix bug with `net/accept-loop` that would sometimes miss connections.
|
- Fix bug with `net/accept-loop` that would sometimes miss connections.
|
||||||
|
|
||||||
|
@ -1,5 +1,5 @@
|
|||||||
# The core janet library
|
# The core janet library
|
||||||
# Copyright 2023 © Calvin Rose
|
# Copyright 2024 © Calvin Rose
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@ -244,7 +244,7 @@
|
|||||||
(let [[[err fib]] catch
|
(let [[[err fib]] catch
|
||||||
f (gensym)
|
f (gensym)
|
||||||
r (gensym)]
|
r (gensym)]
|
||||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
|
||||||
,r (,resume ,f)]
|
,r (,resume ,f)]
|
||||||
(if (,= (,fiber/status ,f) :error)
|
(if (,= (,fiber/status ,f) :error)
|
||||||
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
(do (def ,err ,r) ,(if fib ~(def ,fib ,f)) ,;(tuple/slice catch 1))
|
||||||
@ -256,7 +256,7 @@
|
|||||||
error, and the second is the return value or error.`
|
error, and the second is the return value or error.`
|
||||||
[& body]
|
[& body]
|
||||||
(let [f (gensym) r (gensym)]
|
(let [f (gensym) r (gensym)]
|
||||||
~(let [,f (,fiber/new (fn [] ,;body) :ie)
|
~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
|
||||||
,r (,resume ,f)]
|
,r (,resume ,f)]
|
||||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||||
|
|
||||||
@ -313,7 +313,7 @@
|
|||||||
[form & body]
|
[form & body]
|
||||||
(with-syms [f r]
|
(with-syms [f r]
|
||||||
~(do
|
~(do
|
||||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
|
||||||
(def ,r (,resume ,f))
|
(def ,r (,resume ,f))
|
||||||
,form
|
,form
|
||||||
(if (= (,fiber/status ,f) :dead)
|
(if (= (,fiber/status ,f) :dead)
|
||||||
@ -326,7 +326,7 @@
|
|||||||
[form & body]
|
[form & body]
|
||||||
(with-syms [f r]
|
(with-syms [f r]
|
||||||
~(do
|
~(do
|
||||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
(def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
|
||||||
(def ,r (,resume ,f))
|
(def ,r (,resume ,f))
|
||||||
(if (= (,fiber/status ,f) :dead)
|
(if (= (,fiber/status ,f) :dead)
|
||||||
,r
|
,r
|
||||||
@ -338,7 +338,7 @@
|
|||||||
[tag & body]
|
[tag & body]
|
||||||
(with-syms [res target payload fib]
|
(with-syms [res target payload fib]
|
||||||
~(do
|
~(do
|
||||||
(def ,fib (,fiber/new (fn [] [,tag (do ,;body)]) :i0))
|
(def ,fib (,fiber/new (fn :prompt [] [,tag (do ,;body)]) :i0))
|
||||||
(def ,res (,resume ,fib))
|
(def ,res (,resume ,fib))
|
||||||
(def [,target ,payload] ,res)
|
(def [,target ,payload] ,res)
|
||||||
(if (,= ,tag ,target)
|
(if (,= ,tag ,target)
|
||||||
@ -629,17 +629,17 @@
|
|||||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||||
that yields all values inside the loop in order. See `loop` for details.``
|
that yields all values inside the loop in order. See `loop` for details.``
|
||||||
[head & body]
|
[head & body]
|
||||||
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
|
||||||
|
|
||||||
(defmacro coro
|
(defmacro coro
|
||||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||||
[& body]
|
[& body]
|
||||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
(tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
|
||||||
|
|
||||||
(defmacro fiber-fn
|
(defmacro fiber-fn
|
||||||
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
|
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
|
||||||
[flags & body]
|
[flags & body]
|
||||||
(tuple fiber/new (tuple 'fn '[] ;body) flags))
|
(tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
|
||||||
|
|
||||||
(defn sum
|
(defn sum
|
||||||
"Returns the sum of xs. If xs is empty, returns 0."
|
"Returns the sum of xs. If xs is empty, returns 0."
|
||||||
@ -688,7 +688,7 @@
|
|||||||
~(if (def ,(def sym (gensym)) ,br)
|
~(if (def ,(def sym (gensym)) ,br)
|
||||||
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||||
,fal2)))))
|
,fal2)))))
|
||||||
(aux 0))
|
(aux 0))
|
||||||
|
|
||||||
(defmacro when-let
|
(defmacro when-let
|
||||||
"Same as `(if-let bindings (do ;body))`."
|
"Same as `(if-let bindings (do ;body))`."
|
||||||
@ -702,11 +702,11 @@
|
|||||||
(case (length functions)
|
(case (length functions)
|
||||||
0 nil
|
0 nil
|
||||||
1 (in functions 0)
|
1 (in functions 0)
|
||||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
|
||||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
|
||||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
|
||||||
(let [[f g h i] functions]
|
(let [[f g h i] functions]
|
||||||
(comp (fn [x] (f (g (h (i x)))))
|
(comp (fn :comp [x] (f (g (h (i x)))))
|
||||||
;(tuple/slice functions 4 -1)))))
|
;(tuple/slice functions 4 -1)))))
|
||||||
|
|
||||||
(defn identity
|
(defn identity
|
||||||
@ -717,7 +717,7 @@
|
|||||||
(defn complement
|
(defn complement
|
||||||
"Returns a function that is the complement to the argument."
|
"Returns a function that is the complement to the argument."
|
||||||
[f]
|
[f]
|
||||||
(fn [x] (not (f x))))
|
(fn :complement [x] (not (f x))))
|
||||||
|
|
||||||
(defmacro- do-extreme
|
(defmacro- do-extreme
|
||||||
[order args]
|
[order args]
|
||||||
@ -880,7 +880,7 @@
|
|||||||
``Sorts `ind` in-place by calling a function `f` on each element and
|
``Sorts `ind` in-place by calling a function `f` on each element and
|
||||||
comparing the result with `<`.``
|
comparing the result with `<`.``
|
||||||
[f ind]
|
[f ind]
|
||||||
(sort ind (fn [x y] (< (f x) (f y)))))
|
(sort ind (fn :sort-by-comp [x y] (< (f x) (f y)))))
|
||||||
|
|
||||||
(defn sorted
|
(defn sorted
|
||||||
``Returns a new sorted array without modifying the old one.
|
``Returns a new sorted array without modifying the old one.
|
||||||
@ -893,7 +893,7 @@
|
|||||||
``Returns a new sorted array that compares elements by invoking
|
``Returns a new sorted array that compares elements by invoking
|
||||||
a function `f` on each element and comparing the result with `<`.``
|
a function `f` on each element and comparing the result with `<`.``
|
||||||
[f ind]
|
[f ind]
|
||||||
(sorted ind (fn [x y] (< (f x) (f y)))))
|
(sorted ind (fn :sorted-by-comp [x y] (< (f x) (f y)))))
|
||||||
|
|
||||||
(defn reduce
|
(defn reduce
|
||||||
``Reduce, also know as fold-left in many languages, transforms
|
``Reduce, also know as fold-left in many languages, transforms
|
||||||
@ -1192,7 +1192,7 @@
|
|||||||
``Returns the juxtaposition of functions. In other words,
|
``Returns the juxtaposition of functions. In other words,
|
||||||
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
|
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
|
||||||
[& funs]
|
[& funs]
|
||||||
(fn [& args]
|
(fn :juxt* [& args]
|
||||||
(def ret @[])
|
(def ret @[])
|
||||||
(each f funs
|
(each f funs
|
||||||
(array/push ret (f ;args)))
|
(array/push ret (f ;args)))
|
||||||
@ -1205,7 +1205,7 @@
|
|||||||
(def $args (gensym))
|
(def $args (gensym))
|
||||||
(each f funs
|
(each f funs
|
||||||
(array/push parts (tuple apply f $args)))
|
(array/push parts (tuple apply f $args)))
|
||||||
(tuple 'fn (tuple '& $args) (tuple/slice parts 0)))
|
(tuple 'fn :juxt (tuple '& $args) (tuple/slice parts 0)))
|
||||||
|
|
||||||
(defmacro defdyn
|
(defmacro defdyn
|
||||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||||
@ -1421,7 +1421,12 @@
|
|||||||
(def dyn-forms
|
(def dyn-forms
|
||||||
(seq [i :range [0 (length bindings) 2]]
|
(seq [i :range [0 (length bindings) 2]]
|
||||||
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
~(setdyn ,(bindings i) ,(bindings (+ i 1)))))
|
||||||
~(,resume (,fiber/new (fn [] ,;dyn-forms ,;body) :p)))
|
~(,resume (,fiber/new (fn :with-dyns [] ,;dyn-forms ,;body) :p)))
|
||||||
|
|
||||||
|
(defmacro with-env
|
||||||
|
`Run a block of code with a given environment table`
|
||||||
|
[env & body]
|
||||||
|
~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
|
||||||
|
|
||||||
(defmacro with-vars
|
(defmacro with-vars
|
||||||
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
||||||
@ -1436,7 +1441,7 @@
|
|||||||
(with-syms [ret f s]
|
(with-syms [ret f s]
|
||||||
~(do
|
~(do
|
||||||
,;saveold
|
,;saveold
|
||||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
(def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
|
||||||
(def ,ret (,resume ,f))
|
(def ,ret (,resume ,f))
|
||||||
,;restoreold
|
,;restoreold
|
||||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||||
@ -1445,7 +1450,7 @@
|
|||||||
"Partial function application."
|
"Partial function application."
|
||||||
[f & more]
|
[f & more]
|
||||||
(if (zero? (length more)) f
|
(if (zero? (length more)) f
|
||||||
(fn [& r] (f ;more ;r))))
|
(fn :partial [& r] (f ;more ;r))))
|
||||||
|
|
||||||
(defn every?
|
(defn every?
|
||||||
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
||||||
@ -1802,7 +1807,6 @@
|
|||||||
(printf (dyn *pretty-format* "%q") x)
|
(printf (dyn *pretty-format* "%q") x)
|
||||||
(flush))
|
(flush))
|
||||||
|
|
||||||
|
|
||||||
(defn file/lines
|
(defn file/lines
|
||||||
"Return an iterator over the lines of a file."
|
"Return an iterator over the lines of a file."
|
||||||
[file]
|
[file]
|
||||||
@ -2143,8 +2147,8 @@
|
|||||||
(def ret
|
(def ret
|
||||||
(case (type x)
|
(case (type x)
|
||||||
:tuple (if (= (tuple/type x) :brackets)
|
:tuple (if (= (tuple/type x) :brackets)
|
||||||
(tuple/brackets ;(map recur x))
|
(tuple/brackets ;(map recur x))
|
||||||
(dotup x))
|
(dotup x))
|
||||||
:array (map recur x)
|
:array (map recur x)
|
||||||
:struct (table/to-struct (dotable x recur))
|
:struct (table/to-struct (dotable x recur))
|
||||||
:table (dotable x recur)
|
:table (dotable x recur)
|
||||||
@ -2325,7 +2329,7 @@
|
|||||||
x)))
|
x)))
|
||||||
x))
|
x))
|
||||||
(def expanded (macex arg on-binding))
|
(def expanded (macex arg on-binding))
|
||||||
(def name-splice (if name [name] []))
|
(def name-splice (if name [name] [:short-fn]))
|
||||||
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
|
(def fn-args (seq [i :range [0 (+ 1 max-param-seen)]] (symbol prefix '$ i)))
|
||||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
||||||
|
|
||||||
@ -2415,29 +2419,9 @@
|
|||||||
col
|
col
|
||||||
": parse error: "
|
": parse error: "
|
||||||
(:error p)
|
(:error p)
|
||||||
(if ec "\e[0m" ""))
|
(if ec "\e[0m"))
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn- print-line-col
|
|
||||||
``Print the source code at a line, column in a source file. If unable to open
|
|
||||||
the file, prints nothing.``
|
|
||||||
[where line col]
|
|
||||||
(if-not line (break))
|
|
||||||
(unless (string? where) (break))
|
|
||||||
(when-with [f (file/open where :r)]
|
|
||||||
(def source-code (file/read f :all))
|
|
||||||
(var index 0)
|
|
||||||
(repeat (dec line)
|
|
||||||
(if-not index (break))
|
|
||||||
(set index (string/find "\n" source-code index))
|
|
||||||
(if index (++ index)))
|
|
||||||
(when index
|
|
||||||
(def line-end (string/find "\n" source-code index))
|
|
||||||
(eprint " " (string/slice source-code index line-end))
|
|
||||||
(when col
|
|
||||||
(+= index col)
|
|
||||||
(eprint (string/repeat " " (inc col)) "^")))))
|
|
||||||
|
|
||||||
(defn warn-compile
|
(defn warn-compile
|
||||||
"Default handler for a compile warning."
|
"Default handler for a compile warning."
|
||||||
[msg level where &opt line col]
|
[msg level where &opt line col]
|
||||||
@ -2450,10 +2434,7 @@
|
|||||||
":"
|
":"
|
||||||
col
|
col
|
||||||
": compile warning (" level "): ")
|
": compile warning (" level "): ")
|
||||||
(eprint msg)
|
(eprint msg (if ec "\e[0m"))
|
||||||
(when ec
|
|
||||||
(print-line-col where line col)
|
|
||||||
(eprin "\e[0m"))
|
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn bad-compile
|
(defn bad-compile
|
||||||
@ -2470,10 +2451,7 @@
|
|||||||
": compile error: ")
|
": compile error: ")
|
||||||
(if macrof
|
(if macrof
|
||||||
(debug/stacktrace macrof msg "")
|
(debug/stacktrace macrof msg "")
|
||||||
(eprint msg))
|
(eprint msg (if ec "\e[0m")))
|
||||||
(when ec
|
|
||||||
(print-line-col where line col)
|
|
||||||
(eprin "\e[0m"))
|
|
||||||
(eflush))
|
(eflush))
|
||||||
|
|
||||||
(defn curenv
|
(defn curenv
|
||||||
@ -2542,7 +2520,7 @@
|
|||||||
:read read
|
:read read
|
||||||
:expander expand} opts)
|
:expander expand} opts)
|
||||||
(default env (or (fiber/getenv (fiber/current)) @{}))
|
(default env (or (fiber/getenv (fiber/current)) @{}))
|
||||||
(default chunks (fn [buf p] (getline "" buf env)))
|
(default chunks (fn chunks [buf p] (getline "" buf env)))
|
||||||
(default onstatus debug/stacktrace)
|
(default onstatus debug/stacktrace)
|
||||||
(default on-compile-error bad-compile)
|
(default on-compile-error bad-compile)
|
||||||
(default on-compile-warning warn-compile)
|
(default on-compile-warning warn-compile)
|
||||||
@ -2677,8 +2655,8 @@
|
|||||||
(defn eval
|
(defn eval
|
||||||
``Evaluates a form in the current environment. If more control over the
|
``Evaluates a form in the current environment. If more control over the
|
||||||
environment is needed, use `run-context`.``
|
environment is needed, use `run-context`.``
|
||||||
[form]
|
[form &opt env]
|
||||||
(def res (compile form nil :eval))
|
(def res (compile form env :eval))
|
||||||
(if (= (type res) :function)
|
(if (= (type res) :function)
|
||||||
(res)
|
(res)
|
||||||
(error (get res :error))))
|
(error (get res :error))))
|
||||||
@ -2717,9 +2695,9 @@
|
|||||||
(defn eval-string
|
(defn eval-string
|
||||||
``Evaluates a string in the current environment. If more control over the
|
``Evaluates a string in the current environment. If more control over the
|
||||||
environment is needed, use `run-context`.``
|
environment is needed, use `run-context`.``
|
||||||
[str]
|
[str &opt env]
|
||||||
(var ret nil)
|
(var ret nil)
|
||||||
(each x (parse-all str) (set ret (eval x)))
|
(each x (parse-all str) (set ret (eval x env)))
|
||||||
ret)
|
ret)
|
||||||
|
|
||||||
(def load-image-dict
|
(def load-image-dict
|
||||||
@ -2767,10 +2745,11 @@
|
|||||||
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
(defn- check-is-dep [x] (unless (or (string/has-prefix? "/" x) (string/has-prefix? "@" x) (string/has-prefix? "." x)) x))
|
||||||
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
(defn- check-project-relative [x] (if (string/has-prefix? "/" x) x))
|
||||||
|
|
||||||
(defdyn *module/cache* "Dynamic binding for overriding `module/cache`")
|
(defdyn *module-cache* "Dynamic binding for overriding `module/cache`")
|
||||||
(defdyn *module/paths* "Dynamic binding for overriding `module/cache`")
|
(defdyn *module-paths* "Dynamic binding for overriding `module/cache`")
|
||||||
(defdyn *module/loading* "Dynamic binding for overriding `module/cache`")
|
(defdyn *module-loading* "Dynamic binding for overriding `module/cache`")
|
||||||
(defdyn *module/loaders* "Dynamic binding for overriding `module/loaders`")
|
(defdyn *module-loaders* "Dynamic binding for overriding `module/loaders`")
|
||||||
|
(defdyn *module-make-env* "Dynamic binding for creating new environments for `import`, `require`, and `dofile`. Overrides `make-env`.")
|
||||||
|
|
||||||
(def module/cache
|
(def module/cache
|
||||||
"A table, mapping loaded module identifiers to their environments."
|
"A table, mapping loaded module identifiers to their environments."
|
||||||
@ -2800,7 +2779,7 @@
|
|||||||
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
||||||
```
|
```
|
||||||
[ext loader]
|
[ext loader]
|
||||||
(def mp (dyn *module/paths* module/paths))
|
(def mp (dyn *module-paths* module/paths))
|
||||||
(defn- find-prefix
|
(defn- find-prefix
|
||||||
[pre]
|
[pre]
|
||||||
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
|
(or (find-index |(and (string? ($ 0)) (string/has-prefix? pre ($ 0))) mp) 0))
|
||||||
@ -2818,7 +2797,7 @@
|
|||||||
(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 (dyn *module/cache* module/cache) path) path)) :preload check-not-relative])
|
(array/insert module/paths 0 [(fn is-cached [path] (if (in (dyn *module-cache* module/cache) path) path)) :preload check-not-relative])
|
||||||
|
|
||||||
# Version of fexists that works even with a reduced OS
|
# Version of fexists that works even with a reduced OS
|
||||||
(defn- fexists
|
(defn- fexists
|
||||||
@ -2848,7 +2827,7 @@
|
|||||||
```
|
```
|
||||||
[path]
|
[path]
|
||||||
(var ret nil)
|
(var ret nil)
|
||||||
(def mp (dyn *module/paths* module/paths))
|
(def mp (dyn *module-paths* module/paths))
|
||||||
(each [p mod-kind checker] mp
|
(each [p mod-kind checker] mp
|
||||||
(when (mod-filter checker path)
|
(when (mod-filter checker path)
|
||||||
(if (function? p)
|
(if (function? p)
|
||||||
@ -2861,7 +2840,7 @@
|
|||||||
(set ret [fullpath mod-kind])
|
(set ret [fullpath mod-kind])
|
||||||
(break))))))
|
(break))))))
|
||||||
(if ret ret
|
(if ret ret
|
||||||
(let [expander (fn [[t _ chk]]
|
(let [expander (fn :expander [[t _ chk]]
|
||||||
(when (string? t)
|
(when (string? t)
|
||||||
(when (mod-filter chk path)
|
(when (mod-filter chk path)
|
||||||
(module/expand-path path t))))
|
(module/expand-path path t))))
|
||||||
@ -2928,7 +2907,7 @@
|
|||||||
set to a truthy value."
|
set to a truthy value."
|
||||||
[env &opt level is-repl]
|
[env &opt level is-repl]
|
||||||
(default level 1)
|
(default level 1)
|
||||||
(fn [f x]
|
(fn :debugger [f x]
|
||||||
(def fs (fiber/status f))
|
(def fs (fiber/status f))
|
||||||
(if (= :dead fs)
|
(if (= :dead fs)
|
||||||
(when is-repl
|
(when is-repl
|
||||||
@ -2958,7 +2937,7 @@
|
|||||||
:core/stream path
|
:core/stream path
|
||||||
(file/open path :rb)))
|
(file/open path :rb)))
|
||||||
(def path-is-file (= f path))
|
(def path-is-file (= f path))
|
||||||
(default env (make-env (curenv)))
|
(default env ((dyn *module-make-env* make-env)))
|
||||||
(def spath (string path))
|
(def spath (string path))
|
||||||
(put env :source (or source (if-not path-is-file spath path)))
|
(put env :source (or source (if-not path-is-file spath path)))
|
||||||
(var exit-error nil)
|
(var exit-error nil)
|
||||||
@ -3018,14 +2997,14 @@
|
|||||||
``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 native-loader [path &] (native path (make-env)))
|
@{:native (fn native-loader [path &] (native path ((dyn *module-make-env* make-env))))
|
||||||
:source (fn source-loader [path args]
|
:source (fn source-loader [path args]
|
||||||
(def ml (dyn *module/loading* module/loading))
|
(def ml (dyn *module-loading* module/loading))
|
||||||
(put ml path true)
|
(put ml path true)
|
||||||
(defer (put ml path nil)
|
(defer (put ml path nil)
|
||||||
(dofile path ;args)))
|
(dofile path ;args)))
|
||||||
:preload (fn preload-loader [path & args]
|
:preload (fn preload-loader [path & args]
|
||||||
(def mc (dyn *module/cache* module/cache))
|
(def mc (dyn *module-cache* module/cache))
|
||||||
(when-let [m (in mc path)]
|
(when-let [m (in mc path)]
|
||||||
(if (function? m)
|
(if (function? m)
|
||||||
(set (mc path) (m path ;args))
|
(set (mc path) (m path ;args))
|
||||||
@ -3036,9 +3015,9 @@
|
|||||||
[path args kargs]
|
[path args kargs]
|
||||||
(def [fullpath mod-kind] (module/find path))
|
(def [fullpath mod-kind] (module/find path))
|
||||||
(unless fullpath (error mod-kind))
|
(unless fullpath (error mod-kind))
|
||||||
(def mc (dyn *module/cache* module/cache))
|
(def mc (dyn *module-cache* module/cache))
|
||||||
(def ml (dyn *module/loading* module/loading))
|
(def ml (dyn *module-loading* module/loading))
|
||||||
(def mls (dyn *module/loaders* module/loaders))
|
(def mls (dyn *module-loaders* module/loaders))
|
||||||
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
|
(if-let [check (if-not (kargs :fresh) (in mc fullpath))]
|
||||||
check
|
check
|
||||||
(if (ml fullpath)
|
(if (ml fullpath)
|
||||||
@ -3136,6 +3115,7 @@
|
|||||||
[&opt env local]
|
[&opt env local]
|
||||||
(env-walk keyword? env local))
|
(env-walk keyword? env local))
|
||||||
|
|
||||||
|
|
||||||
(defdyn *doc-width*
|
(defdyn *doc-width*
|
||||||
"Width in columns to print documentation printed with `doc-format`.")
|
"Width in columns to print documentation printed with `doc-format`.")
|
||||||
|
|
||||||
@ -3698,7 +3678,7 @@
|
|||||||
[&opt chunks onsignal env parser read]
|
[&opt chunks onsignal env parser read]
|
||||||
(default env (make-env))
|
(default env (make-env))
|
||||||
(default chunks
|
(default chunks
|
||||||
(fn [buf p]
|
(fn :chunks [buf p]
|
||||||
(getline
|
(getline
|
||||||
(string
|
(string
|
||||||
"repl:"
|
"repl:"
|
||||||
@ -3729,23 +3709,47 @@
|
|||||||
Returns a fiber that is scheduled to run the function.
|
Returns a fiber that is scheduled to run the function.
|
||||||
```
|
```
|
||||||
[f & args]
|
[f & args]
|
||||||
(ev/go (fn _call [&] (f ;args))))
|
(ev/go (fn :call [&] (f ;args))))
|
||||||
|
|
||||||
(defmacro ev/spawn
|
(defmacro ev/spawn
|
||||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/go (fn _spawn [&] ,;body)))
|
~(,ev/go (fn :spawn [&] ,;body)))
|
||||||
|
|
||||||
(defmacro ev/do-thread
|
(defmacro ev/do-thread
|
||||||
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
||||||
evaluates to nil.``
|
evaluates to nil.``
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/thread (fn _do-thread [&] ,;body)))
|
~(,ev/thread (fn :do-thread [&] ,;body)))
|
||||||
|
|
||||||
|
(defn- acquire-release
|
||||||
|
[acq rel lock body]
|
||||||
|
(def l (gensym))
|
||||||
|
~(do
|
||||||
|
(def ,l ,lock)
|
||||||
|
(,acq ,l)
|
||||||
|
(defer (,rel ,l)
|
||||||
|
,;body)))
|
||||||
|
|
||||||
|
(defmacro ev/with-lock
|
||||||
|
``Run a body of code after acquiring a lock. Will automatically release the lock when done.``
|
||||||
|
[lock & body]
|
||||||
|
(acquire-release ev/acquire-lock ev/release-lock lock body))
|
||||||
|
|
||||||
|
(defmacro ev/with-rlock
|
||||||
|
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
|
||||||
|
[lock & body]
|
||||||
|
(acquire-release ev/acquire-rlock ev/release-rlock lock body))
|
||||||
|
|
||||||
|
(defmacro ev/with-wlock
|
||||||
|
``Run a body of code after acquiring read access to an rwlock. Will automatically release the lock when done.``
|
||||||
|
[lock & body]
|
||||||
|
(acquire-release ev/acquire-wlock ev/release-wlock lock body))
|
||||||
|
|
||||||
(defmacro ev/spawn-thread
|
(defmacro ev/spawn-thread
|
||||||
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
||||||
[& body]
|
[& body]
|
||||||
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
|
~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
|
||||||
|
|
||||||
(defmacro ev/with-deadline
|
(defmacro ev/with-deadline
|
||||||
``
|
``
|
||||||
@ -3794,7 +3798,7 @@
|
|||||||
(def ,res @[])
|
(def ,res @[])
|
||||||
,;(seq [[i body] :pairs bodies]
|
,;(seq [[i body] :pairs bodies]
|
||||||
~(do
|
~(do
|
||||||
(def ,ftemp (,ev/go (fn [] (put ,res ,i ,body)) nil ,chan))
|
(def ,ftemp (,ev/go (fn :ev/gather [] (put ,res ,i ,body)) nil ,chan))
|
||||||
(,put ,fset ,ftemp ,ftemp)))
|
(,put ,fset ,ftemp ,ftemp)))
|
||||||
(,wait-for-fibers ,chan ,fset)
|
(,wait-for-fibers ,chan ,fset)
|
||||||
,res))))
|
,res))))
|
||||||
@ -3877,12 +3881,12 @@
|
|||||||
~(defn ,alias ,;meta [,;formal-args]
|
~(defn ,alias ,;meta [,;formal-args]
|
||||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;formal-args))
|
||||||
~(defn ,alias ,;meta [,;formal-args]
|
~(defn ,alias ,;meta [,;formal-args]
|
||||||
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args)))))
|
(,ffi/call ,(make-ptr) ,(make-sig) ,;formal-args))))
|
||||||
|
|
||||||
(defmacro ffi/defbind
|
(defmacro ffi/defbind
|
||||||
"Generate bindings for native functions in a convenient manner."
|
"Generate bindings for native functions in a convenient manner."
|
||||||
[name ret-type & body]
|
[name ret-type & body]
|
||||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))
|
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
@ -3959,7 +3963,6 @@
|
|||||||
(merge-into module/cache old-modcache)
|
(merge-into module/cache old-modcache)
|
||||||
nil)
|
nil)
|
||||||
|
|
||||||
|
|
||||||
###
|
###
|
||||||
###
|
###
|
||||||
### CLI Tool Main
|
### CLI Tool Main
|
||||||
@ -3996,6 +3999,28 @@
|
|||||||
(compwhen (not (dyn 'os/isatty))
|
(compwhen (not (dyn 'os/isatty))
|
||||||
(defmacro os/isatty [&] true))
|
(defmacro os/isatty [&] true))
|
||||||
|
|
||||||
|
(def- long-to-short
|
||||||
|
"map long options to short options"
|
||||||
|
{"-help" "h"
|
||||||
|
"-version" "v"
|
||||||
|
"-stdin" "s"
|
||||||
|
"-eval" "e"
|
||||||
|
"-expression" "E"
|
||||||
|
"-debug" "d"
|
||||||
|
"-repl" "r"
|
||||||
|
"-noprofile" "R"
|
||||||
|
"-persistent" "p"
|
||||||
|
"-quiet" "q"
|
||||||
|
"-flycheck" "k"
|
||||||
|
"-syspath" "m"
|
||||||
|
"-compile" "c"
|
||||||
|
"-image" "i"
|
||||||
|
"-nocolor" "n"
|
||||||
|
"-color" "N"
|
||||||
|
"-library" "l"
|
||||||
|
"-lint-warn" "w"
|
||||||
|
"-lint-error" "x"})
|
||||||
|
|
||||||
(defn cli-main
|
(defn cli-main
|
||||||
`Entrance for the Janet CLI tool. Call this function with the command line
|
`Entrance for the Janet CLI tool. Call this function with the command line
|
||||||
arguments as an array or tuple of strings to invoke the CLI interface.`
|
arguments as an array or tuple of strings to invoke the CLI interface.`
|
||||||
@ -4027,28 +4052,6 @@
|
|||||||
(def x (in args (+ i 1)))
|
(def x (in args (+ i 1)))
|
||||||
(or (scan-number x) (keyword x)))
|
(or (scan-number x) (keyword x)))
|
||||||
|
|
||||||
(def- long-to-short
|
|
||||||
"map long options to short options"
|
|
||||||
{"-help" "h"
|
|
||||||
"-version" "v"
|
|
||||||
"-stdin" "s"
|
|
||||||
"-eval" "e"
|
|
||||||
"-expression" "E"
|
|
||||||
"-debug" "d"
|
|
||||||
"-repl" "r"
|
|
||||||
"-noprofile" "R"
|
|
||||||
"-persistent" "p"
|
|
||||||
"-quiet" "q"
|
|
||||||
"-flycheck" "k"
|
|
||||||
"-syspath" "m"
|
|
||||||
"-compile" "c"
|
|
||||||
"-image" "i"
|
|
||||||
"-nocolor" "n"
|
|
||||||
"-color" "N"
|
|
||||||
"-library" "l"
|
|
||||||
"-lint-warn" "w"
|
|
||||||
"-lint-error" "x"})
|
|
||||||
|
|
||||||
# Flag handlers
|
# Flag handlers
|
||||||
(def handlers
|
(def handlers
|
||||||
{"h" (fn [&]
|
{"h" (fn [&]
|
||||||
|
@ -655,6 +655,27 @@ JANET_CORE_FN(cfun_buffer_format,
|
|||||||
return argv[0];
|
return argv[0];
|
||||||
}
|
}
|
||||||
|
|
||||||
|
JANET_CORE_FN(cfun_buffer_format_at,
|
||||||
|
"(buffer/format-at buffer at format & args)",
|
||||||
|
"Snprintf like functionality for printing values into a buffer. Returns "
|
||||||
|
"the modified buffer.") {
|
||||||
|
janet_arity(argc, 2, -1);
|
||||||
|
JanetBuffer *buffer = janet_getbuffer(argv, 0);
|
||||||
|
int32_t at = janet_getinteger(argv, 1);
|
||||||
|
if (at < 0) {
|
||||||
|
at += buffer->count + 1;
|
||||||
|
}
|
||||||
|
if (at > buffer->count || at < 0) janet_panicf("expected index at to be in range [0, %d), got %d", buffer->count, at);
|
||||||
|
int32_t oldcount = buffer->count;
|
||||||
|
buffer->count = at;
|
||||||
|
const char *strfrmt = (const char *) janet_getstring(argv, 2);
|
||||||
|
janet_buffer_format(buffer, strfrmt, 2, argc, argv);
|
||||||
|
if (buffer->count < oldcount) {
|
||||||
|
buffer->count = oldcount;
|
||||||
|
}
|
||||||
|
return argv[0];
|
||||||
|
}
|
||||||
|
|
||||||
void janet_lib_buffer(JanetTable *env) {
|
void janet_lib_buffer(JanetTable *env) {
|
||||||
JanetRegExt buffer_cfuns[] = {
|
JanetRegExt buffer_cfuns[] = {
|
||||||
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
JANET_CORE_REG("buffer/new", cfun_buffer_new),
|
||||||
@ -681,6 +702,7 @@ void janet_lib_buffer(JanetTable *env) {
|
|||||||
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
JANET_CORE_REG("buffer/bit-toggle", cfun_buffer_bittoggle),
|
||||||
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
JANET_CORE_REG("buffer/blit", cfun_buffer_blit),
|
||||||
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
JANET_CORE_REG("buffer/format", cfun_buffer_format),
|
||||||
|
JANET_CORE_REG("buffer/format-at", cfun_buffer_format_at),
|
||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
janet_core_cfuns_ext(env, NULL, buffer_cfuns);
|
||||||
|
@ -934,7 +934,7 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
|
|||||||
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
int32_t slotchunks = (def->slotcount + 31) >> 5;
|
||||||
/* numchunks is min of slotchunks and scope->ua.count */
|
/* numchunks is min of slotchunks and scope->ua.count */
|
||||||
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
int32_t numchunks = slotchunks > scope->ua.count ? scope->ua.count : slotchunks;
|
||||||
uint32_t *chunks = janet_calloc(sizeof(uint32_t), slotchunks);
|
uint32_t *chunks = janet_calloc(slotchunks, sizeof(uint32_t));
|
||||||
if (NULL == chunks) {
|
if (NULL == chunks) {
|
||||||
JANET_OUT_OF_MEMORY;
|
JANET_OUT_OF_MEMORY;
|
||||||
}
|
}
|
||||||
@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
|
|||||||
|
|
||||||
if (c.result.status == JANET_COMPILE_OK) {
|
if (c.result.status == JANET_COMPILE_OK) {
|
||||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||||
def->name = janet_cstring("_thunk");
|
def->name = janet_cstring("thunk");
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
c.result.funcdef = def;
|
c.result.funcdef = def;
|
||||||
} else {
|
} else {
|
||||||
|
@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||||
janet_eprintf(" (tailcall)");
|
janet_eprintf(" (tail call)");
|
||||||
if (frame->func && frame->pc) {
|
if (frame->func && frame->pc) {
|
||||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||||
if (def->sourcemap) {
|
if (def->sourcemap) {
|
||||||
@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
janet_eprintf("\n");
|
janet_eprintf("\n");
|
||||||
|
/* Print fiber points optionally. Clutters traces but provides info
|
||||||
|
if (i <= 0 && fi > 0) {
|
||||||
|
janet_eprintf(" in parent fiber\n");
|
||||||
|
}
|
||||||
|
*/
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -2095,7 +2095,7 @@ void janet_ev_threaded_call(JanetThreadedSubroutine fp, JanetEVGenericMessage ar
|
|||||||
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
int err = pthread_create(&waiter_thread, &janet_vm.new_thread_attr, janet_thread_body, init);
|
||||||
if (err) {
|
if (err) {
|
||||||
janet_free(init);
|
janet_free(init);
|
||||||
janet_panicf("%s", strerror(err));
|
janet_panicf("%s", janet_strerror(err));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
@ -2204,7 +2204,7 @@ Janet janet_ev_lasterr(void) {
|
|||||||
}
|
}
|
||||||
#else
|
#else
|
||||||
Janet janet_ev_lasterr(void) {
|
Janet janet_ev_lasterr(void) {
|
||||||
return janet_cstringv(strerror(errno));
|
return janet_cstringv(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
@ -76,4 +76,6 @@
|
|||||||
#define __BSD_VISIBLE 1
|
#define __BSD_VISIBLE 1
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
#define _FILE_OFFSET_BITS 64
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
@ -73,13 +73,13 @@ static void *int64_unmarshal(JanetMarshalContext *ctx) {
|
|||||||
|
|
||||||
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
static void it_s64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
char str[32];
|
char str[32];
|
||||||
sprintf(str, "%" PRId64, *((int64_t *)p));
|
snprintf(str, sizeof(str), "%" PRId64, *((int64_t *)p));
|
||||||
janet_buffer_push_cstring(buffer, str);
|
janet_buffer_push_cstring(buffer, str);
|
||||||
}
|
}
|
||||||
|
|
||||||
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
static void it_u64_tostring(void *p, JanetBuffer *buffer) {
|
||||||
char str[32];
|
char str[32];
|
||||||
sprintf(str, "%" PRIu64, *((uint64_t *)p));
|
snprintf(str, sizeof(str), "%" PRIu64, *((uint64_t *)p));
|
||||||
janet_buffer_push_cstring(buffer, str);
|
janet_buffer_push_cstring(buffer, str);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
|||||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||||
static Janet io_file_next(void *p, Janet key);
|
static Janet io_file_next(void *p, Janet key);
|
||||||
|
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
#define ftell _ftelli64
|
||||||
|
#define fseek _fseeki64
|
||||||
|
#endif
|
||||||
|
|
||||||
const JanetAbstractType janet_file_type = {
|
const JanetAbstractType janet_file_type = {
|
||||||
"core/file",
|
"core/file",
|
||||||
cfun_io_gc,
|
cfun_io_gc,
|
||||||
@ -126,7 +131,7 @@ JANET_CORE_FN(cfun_io_temp,
|
|||||||
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
// XXX use mkostemp when we can to avoid CLOEXEC race.
|
||||||
FILE *tmp = tmpfile();
|
FILE *tmp = tmpfile();
|
||||||
if (!tmp)
|
if (!tmp)
|
||||||
janet_panicf("unable to create temporary file - %s", strerror(errno));
|
janet_panicf("unable to create temporary file - %s", janet_strerror(errno));
|
||||||
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
return janet_makefile(tmp, JANET_FILE_WRITE | JANET_FILE_READ | JANET_FILE_BINARY);
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -168,7 +173,7 @@ JANET_CORE_FN(cfun_io_fopen,
|
|||||||
}
|
}
|
||||||
}
|
}
|
||||||
return f ? janet_makefile(f, flags)
|
return f ? janet_makefile(f, flags)
|
||||||
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, strerror(errno)), janet_wrap_nil())
|
: (flags & JANET_FILE_NONIL) ? (janet_panicf("failed to open file %s: %s", fname, janet_strerror(errno)), janet_wrap_nil())
|
||||||
: janet_wrap_nil();
|
: janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
|
|||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||||
if (iof->flags & JANET_FILE_CLOSED)
|
if (iof->flags & JANET_FILE_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
long int offset = 0;
|
int64_t offset = 0;
|
||||||
int whence = SEEK_CUR;
|
int whence = SEEK_CUR;
|
||||||
if (argc >= 2) {
|
if (argc >= 2) {
|
||||||
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
const uint8_t *whence_sym = janet_getkeyword(argv, 1);
|
||||||
@ -351,7 +356,7 @@ JANET_CORE_FN(cfun_io_fseek,
|
|||||||
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
janet_panicf("expected one of :cur, :set, :end, got %v", argv[1]);
|
||||||
}
|
}
|
||||||
if (argc == 3) {
|
if (argc == 3) {
|
||||||
offset = (long) janet_getinteger64(argv, 2);
|
offset = (int64_t) janet_getinteger64(argv, 2);
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
if (fseek(iof->file, offset, whence)) janet_panic("error seeking file");
|
||||||
@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
|
|||||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||||
if (iof->flags & JANET_FILE_CLOSED)
|
if (iof->flags & JANET_FILE_CLOSED)
|
||||||
janet_panic("file is closed");
|
janet_panic("file is closed");
|
||||||
long pos = ftell(iof->file);
|
int64_t pos = ftell(iof->file);
|
||||||
if (pos == -1) janet_panic("error getting position in file");
|
if (pos == -1) janet_panic("error getting position in file");
|
||||||
return janet_wrap_number((double)pos);
|
return janet_wrap_number((double)pos);
|
||||||
}
|
}
|
||||||
|
@ -349,6 +349,26 @@ JANET_CORE_FN(janet_cfun_lcm, "(math/lcm x y)",
|
|||||||
return janet_wrap_number(janet_lcm(x, y));
|
return janet_wrap_number(janet_lcm(x, y));
|
||||||
}
|
}
|
||||||
|
|
||||||
|
JANET_CORE_FN(janet_cfun_frexp, "(math/frexp x)",
|
||||||
|
"Returns a tuple of (mantissa, exponent) from number.") {
|
||||||
|
janet_fixarity(argc, 1);
|
||||||
|
double x = janet_getnumber(argv, 0);
|
||||||
|
int exp;
|
||||||
|
x = frexp(x, &exp);
|
||||||
|
Janet *result = janet_tuple_begin(2);
|
||||||
|
result[0] = janet_wrap_number(x);
|
||||||
|
result[1] = janet_wrap_number((double) exp);
|
||||||
|
return janet_wrap_tuple(janet_tuple_end(result));
|
||||||
|
}
|
||||||
|
|
||||||
|
JANET_CORE_FN(janet_cfun_ldexp, "(math/ldexp m e)",
|
||||||
|
"Creates a new number from a mantissa and an exponent.") {
|
||||||
|
janet_fixarity(argc, 2);
|
||||||
|
double x = janet_getnumber(argv, 0);
|
||||||
|
int32_t y = janet_getinteger(argv, 1);
|
||||||
|
return janet_wrap_number(ldexp(x, y));
|
||||||
|
}
|
||||||
|
|
||||||
/* Module entry point */
|
/* Module entry point */
|
||||||
void janet_lib_math(JanetTable *env) {
|
void janet_lib_math(JanetTable *env) {
|
||||||
JanetRegExt math_cfuns[] = {
|
JanetRegExt math_cfuns[] = {
|
||||||
@ -395,6 +415,8 @@ void janet_lib_math(JanetTable *env) {
|
|||||||
JANET_CORE_REG("math/next", janet_nextafter),
|
JANET_CORE_REG("math/next", janet_nextafter),
|
||||||
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
JANET_CORE_REG("math/gcd", janet_cfun_gcd),
|
||||||
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
JANET_CORE_REG("math/lcm", janet_cfun_lcm),
|
||||||
|
JANET_CORE_REG("math/frexp", janet_cfun_frexp),
|
||||||
|
JANET_CORE_REG("math/ldexp", janet_cfun_ldexp),
|
||||||
JANET_REG_END
|
JANET_REG_END
|
||||||
};
|
};
|
||||||
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
janet_core_cfuns_ext(env, NULL, math_cfuns);
|
||||||
|
@ -152,7 +152,7 @@ void net_callback_connect(JanetFiber *fiber, JanetAsyncEvent event) {
|
|||||||
if (res == 0) {
|
if (res == 0) {
|
||||||
janet_schedule(fiber, janet_wrap_abstract(stream));
|
janet_schedule(fiber, janet_wrap_abstract(stream));
|
||||||
} else {
|
} else {
|
||||||
janet_cancel(fiber, janet_cstringv(strerror(res)));
|
janet_cancel(fiber, janet_cstringv(janet_strerror(res)));
|
||||||
stream->flags |= JANET_STREAM_TOCLOSE;
|
stream->flags |= JANET_STREAM_TOCLOSE;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
@ -1037,7 +1037,7 @@ JANET_CORE_FN(cfun_net_setsockopt,
|
|||||||
|
|
||||||
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
|
int r = setsockopt((JSock) stream->handle, st->level, st->optname, optval, optlen);
|
||||||
if (r == -1) {
|
if (r == -1) {
|
||||||
janet_panicf("setsockopt(%q): %s", argv[1], strerror(errno));
|
janet_panicf("setsockopt(%q): %s", argv[1], janet_strerror(errno));
|
||||||
}
|
}
|
||||||
|
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
|
@ -38,6 +38,7 @@
|
|||||||
#include <string.h>
|
#include <string.h>
|
||||||
#include <sys/stat.h>
|
#include <sys/stat.h>
|
||||||
#include <signal.h>
|
#include <signal.h>
|
||||||
|
#include <locale.h>
|
||||||
|
|
||||||
#ifdef JANET_BSD
|
#ifdef JANET_BSD
|
||||||
#include <sys/sysctl.h>
|
#include <sys/sysctl.h>
|
||||||
@ -761,7 +762,7 @@ JANET_CORE_FN(os_proc_kill,
|
|||||||
}
|
}
|
||||||
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
int status = kill(proc->pid, signal == -1 ? SIGKILL : signal);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
#endif
|
#endif
|
||||||
/* After killing process we wait on it. */
|
/* After killing process we wait on it. */
|
||||||
@ -1274,7 +1275,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
status = execv(cargv[0], cargv);
|
status = execv(cargv[0], cargv);
|
||||||
}
|
}
|
||||||
} while (status == -1 && errno == EINTR);
|
} while (status == -1 && errno == EINTR);
|
||||||
janet_panicf("%p: %s", cargv[0], strerror(errno ? errno : ENOENT));
|
janet_panicf("%p: %s", cargv[0], janet_strerror(errno ? errno : ENOENT));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1331,7 +1332,7 @@ static Janet os_execute_impl(int32_t argc, Janet *argv, JanetExecuteMode mode) {
|
|||||||
os_execute_cleanup(envp, child_argv);
|
os_execute_cleanup(envp, child_argv);
|
||||||
if (status) {
|
if (status) {
|
||||||
/* correct for macos bug where errno is not set */
|
/* correct for macos bug where errno is not set */
|
||||||
janet_panicf("%p: %s", argv[0], strerror(errno ? errno : ENOENT));
|
janet_panicf("%p: %s", argv[0], janet_strerror(errno ? errno : ENOENT));
|
||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
@ -1432,7 +1433,7 @@ JANET_CORE_FN(os_posix_fork,
|
|||||||
result = fork();
|
result = fork();
|
||||||
} while (result == -1 && errno == EINTR);
|
} while (result == -1 && errno == EINTR);
|
||||||
if (result == -1) {
|
if (result == -1) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
if (result) {
|
if (result) {
|
||||||
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
JanetProc *proc = janet_abstract(&ProcAT, sizeof(JanetProc));
|
||||||
@ -1644,7 +1645,7 @@ JANET_CORE_FN(os_isatty,
|
|||||||
return janet_wrap_boolean(_isatty(fd));
|
return janet_wrap_boolean(_isatty(fd));
|
||||||
#else
|
#else
|
||||||
int fd = fileno(f);
|
int fd = fileno(f);
|
||||||
if (fd == -1) janet_panic(strerror(errno));
|
if (fd == -1) janet_panic(janet_strerror(errno));
|
||||||
return janet_wrap_boolean(isatty(fd));
|
return janet_wrap_boolean(isatty(fd));
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
@ -1879,7 +1880,7 @@ JANET_CORE_FN(os_mktime,
|
|||||||
}
|
}
|
||||||
|
|
||||||
if (t == (time_t) -1) {
|
if (t == (time_t) -1) {
|
||||||
janet_panicf("%s", strerror(errno));
|
janet_panicf("%s", janet_strerror(errno));
|
||||||
}
|
}
|
||||||
|
|
||||||
return janet_wrap_number((double)t);
|
return janet_wrap_number((double)t);
|
||||||
@ -1891,6 +1892,43 @@ JANET_CORE_FN(os_mktime,
|
|||||||
#define j_symlink symlink
|
#define j_symlink symlink
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
JANET_CORE_FN(os_setlocale,
|
||||||
|
"(os/setlocale &opt locale category)",
|
||||||
|
"Set the system locale, which affects how dates and numbers are formatted. "
|
||||||
|
"Passing nil to locale will return the current locale. Category can be one of:\n\n"
|
||||||
|
" * :all (default)\n"
|
||||||
|
" * :collate\n"
|
||||||
|
" * :ctype\n"
|
||||||
|
" * :monetary\n"
|
||||||
|
" * :numeric\n"
|
||||||
|
" * :time\n\n"
|
||||||
|
"Returns the new locale if set successfully, otherwise nil. Note that this will affect "
|
||||||
|
"other functions such as `os/strftime` and even `printf`.") {
|
||||||
|
janet_arity(argc, 0, 2);
|
||||||
|
const char *locale_name = janet_optcstring(argv, argc, 0, NULL);
|
||||||
|
int category_int = LC_ALL;
|
||||||
|
if (argc > 1 && !janet_checktype(argv[1], JANET_NIL)) {
|
||||||
|
if (janet_keyeq(argv[1], "all")) {
|
||||||
|
category_int = LC_ALL;
|
||||||
|
} else if (janet_keyeq(argv[1], "collate")) {
|
||||||
|
category_int = LC_COLLATE;
|
||||||
|
} else if (janet_keyeq(argv[1], "ctype")) {
|
||||||
|
category_int = LC_CTYPE;
|
||||||
|
} else if (janet_keyeq(argv[1], "monetary")) {
|
||||||
|
category_int = LC_MONETARY;
|
||||||
|
} else if (janet_keyeq(argv[1], "numeric")) {
|
||||||
|
category_int = LC_NUMERIC;
|
||||||
|
} else if (janet_keyeq(argv[1], "time")) {
|
||||||
|
category_int = LC_TIME;
|
||||||
|
} else {
|
||||||
|
janet_panicf("expected one of :all, :collate, :ctype, :monetary, :numeric, or :time, got %v", argv[1]);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
const char *old = setlocale(category_int, locale_name);
|
||||||
|
if (old == NULL) return janet_wrap_nil();
|
||||||
|
return janet_cstringv(old);
|
||||||
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_link,
|
JANET_CORE_FN(os_link,
|
||||||
"(os/link oldpath newpath &opt symlink)",
|
"(os/link oldpath newpath &opt symlink)",
|
||||||
"Create a link at newpath that points to oldpath and returns nil. "
|
"Create a link at newpath that points to oldpath and returns nil. "
|
||||||
@ -1908,7 +1946,7 @@ JANET_CORE_FN(os_link,
|
|||||||
const char *oldpath = janet_getcstring(argv, 0);
|
const char *oldpath = janet_getcstring(argv, 0);
|
||||||
const char *newpath = janet_getcstring(argv, 1);
|
const char *newpath = janet_getcstring(argv, 1);
|
||||||
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
int res = ((argc == 3 && janet_truthy(argv[2])) ? j_symlink : link)(oldpath, newpath);
|
||||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
@ -1927,7 +1965,7 @@ JANET_CORE_FN(os_symlink,
|
|||||||
const char *oldpath = janet_getcstring(argv, 0);
|
const char *oldpath = janet_getcstring(argv, 0);
|
||||||
const char *newpath = janet_getcstring(argv, 1);
|
const char *newpath = janet_getcstring(argv, 1);
|
||||||
int res = j_symlink(oldpath, newpath);
|
int res = j_symlink(oldpath, newpath);
|
||||||
if (-1 == res) janet_panicf("%s: %s -> %s", strerror(errno), oldpath, newpath);
|
if (-1 == res) janet_panicf("%s: %s -> %s", janet_strerror(errno), oldpath, newpath);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
@ -1949,7 +1987,7 @@ JANET_CORE_FN(os_mkdir,
|
|||||||
#endif
|
#endif
|
||||||
if (res == 0) return janet_wrap_true();
|
if (res == 0) return janet_wrap_true();
|
||||||
if (errno == EEXIST) return janet_wrap_false();
|
if (errno == EEXIST) return janet_wrap_false();
|
||||||
janet_panicf("%s: %s", strerror(errno), path);
|
janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
}
|
}
|
||||||
|
|
||||||
JANET_CORE_FN(os_rmdir,
|
JANET_CORE_FN(os_rmdir,
|
||||||
@ -1963,7 +2001,7 @@ JANET_CORE_FN(os_rmdir,
|
|||||||
#else
|
#else
|
||||||
int res = rmdir(path);
|
int res = rmdir(path);
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -1978,7 +2016,7 @@ JANET_CORE_FN(os_cd,
|
|||||||
#else
|
#else
|
||||||
int res = chdir(path);
|
int res = chdir(path);
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2002,7 +2040,7 @@ JANET_CORE_FN(os_touch,
|
|||||||
bufp = NULL;
|
bufp = NULL;
|
||||||
}
|
}
|
||||||
int res = utime(path, bufp);
|
int res = utime(path, bufp);
|
||||||
if (-1 == res) janet_panic(strerror(errno));
|
if (-1 == res) janet_panic(janet_strerror(errno));
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2012,7 +2050,7 @@ JANET_CORE_FN(os_remove,
|
|||||||
janet_fixarity(argc, 1);
|
janet_fixarity(argc, 1);
|
||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
int status = remove(path);
|
int status = remove(path);
|
||||||
if (-1 == status) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == status) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2031,7 +2069,7 @@ JANET_CORE_FN(os_readlink,
|
|||||||
const char *path = janet_getcstring(argv, 0);
|
const char *path = janet_getcstring(argv, 0);
|
||||||
ssize_t len = readlink(path, buffer, sizeof buffer);
|
ssize_t len = readlink(path, buffer, sizeof buffer);
|
||||||
if (len < 0 || (size_t)len >= sizeof buffer)
|
if (len < 0 || (size_t)len >= sizeof buffer)
|
||||||
janet_panicf("%s: %s", strerror(errno), path);
|
janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_stringv((const uint8_t *)buffer, len);
|
return janet_stringv((const uint8_t *)buffer, len);
|
||||||
#endif
|
#endif
|
||||||
}
|
}
|
||||||
@ -2326,7 +2364,7 @@ JANET_CORE_FN(os_chmod,
|
|||||||
#else
|
#else
|
||||||
int res = chmod(path, os_getmode(argv, 1));
|
int res = chmod(path, os_getmode(argv, 1));
|
||||||
#endif
|
#endif
|
||||||
if (-1 == res) janet_panicf("%s: %s", strerror(errno), path);
|
if (-1 == res) janet_panicf("%s: %s", janet_strerror(errno), path);
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -2362,7 +2400,7 @@ JANET_CORE_FN(os_dir,
|
|||||||
janet_panicf("path too long: %s", dir);
|
janet_panicf("path too long: %s", dir);
|
||||||
sprintf(pattern, "%s/*", dir);
|
sprintf(pattern, "%s/*", dir);
|
||||||
intptr_t res = _findfirst(pattern, &afile);
|
intptr_t res = _findfirst(pattern, &afile);
|
||||||
if (-1 == res) janet_panicv(janet_cstringv(strerror(errno)));
|
if (-1 == res) janet_panicv(janet_cstringv(janet_strerror(errno)));
|
||||||
do {
|
do {
|
||||||
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
if (strcmp(".", afile.name) && strcmp("..", afile.name)) {
|
||||||
janet_array_push(paths, janet_cstringv(afile.name));
|
janet_array_push(paths, janet_cstringv(afile.name));
|
||||||
@ -2373,8 +2411,18 @@ JANET_CORE_FN(os_dir,
|
|||||||
/* Read directory items with opendir / readdir / closedir */
|
/* Read directory items with opendir / readdir / closedir */
|
||||||
struct dirent *dp;
|
struct dirent *dp;
|
||||||
DIR *dfd = opendir(dir);
|
DIR *dfd = opendir(dir);
|
||||||
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
|
||||||
while ((dp = readdir(dfd)) != NULL) {
|
for (;;) {
|
||||||
|
errno = 0;
|
||||||
|
dp = readdir(dfd);
|
||||||
|
if (dp == NULL) {
|
||||||
|
if (errno) {
|
||||||
|
int olderr = errno;
|
||||||
|
closedir(dfd);
|
||||||
|
janet_panicf("failed to read directory %s: %s", dir, janet_strerror(olderr));
|
||||||
|
}
|
||||||
|
break;
|
||||||
|
}
|
||||||
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
if (!strcmp(dp->d_name, ".") || !strcmp(dp->d_name, "..")) {
|
||||||
continue;
|
continue;
|
||||||
}
|
}
|
||||||
@ -2394,7 +2442,7 @@ JANET_CORE_FN(os_rename,
|
|||||||
const char *dest = janet_getcstring(argv, 1);
|
const char *dest = janet_getcstring(argv, 1);
|
||||||
int status = rename(src, dest);
|
int status = rename(src, dest);
|
||||||
if (status) {
|
if (status) {
|
||||||
janet_panic(strerror(errno));
|
janet_panic(janet_strerror(errno));
|
||||||
}
|
}
|
||||||
return janet_wrap_nil();
|
return janet_wrap_nil();
|
||||||
}
|
}
|
||||||
@ -2414,7 +2462,7 @@ JANET_CORE_FN(os_realpath,
|
|||||||
#else
|
#else
|
||||||
char *dest = realpath(src, NULL);
|
char *dest = realpath(src, NULL);
|
||||||
#endif
|
#endif
|
||||||
if (NULL == dest) janet_panicf("%s: %s", strerror(errno), src);
|
if (NULL == dest) janet_panicf("%s: %s", janet_strerror(errno), src);
|
||||||
Janet ret = janet_cstringv(dest);
|
Janet ret = janet_cstringv(dest);
|
||||||
janet_free(dest);
|
janet_free(dest);
|
||||||
return ret;
|
return ret;
|
||||||
@ -2688,6 +2736,7 @@ void janet_lib_os(JanetTable *env) {
|
|||||||
JANET_CORE_REG("os/strftime", os_strftime),
|
JANET_CORE_REG("os/strftime", os_strftime),
|
||||||
JANET_CORE_REG("os/sleep", os_sleep),
|
JANET_CORE_REG("os/sleep", os_sleep),
|
||||||
JANET_CORE_REG("os/isatty", os_isatty),
|
JANET_CORE_REG("os/isatty", os_isatty),
|
||||||
|
JANET_CORE_REG("os/setlocale", os_setlocale),
|
||||||
|
|
||||||
/* env functions */
|
/* env functions */
|
||||||
JANET_CORE_REG("os/environ", os_environ),
|
JANET_CORE_REG("os/environ", os_environ),
|
||||||
|
@ -379,8 +379,10 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
|
|||||||
break;
|
break;
|
||||||
case JANET_NUMBER:
|
case JANET_NUMBER:
|
||||||
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
janet_buffer_ensure(S->buffer, S->buffer->count + BUFSIZE, 2);
|
||||||
int count = snprintf((char *) S->buffer->data + S->buffer->count, BUFSIZE, "%.17g", janet_unwrap_number(x));
|
double num = janet_unwrap_number(x);
|
||||||
S->buffer->count += count;
|
if (isnan(num)) return 1;
|
||||||
|
if (isinf(num)) return 1;
|
||||||
|
janet_buffer_dtostr(S->buffer, num);
|
||||||
break;
|
break;
|
||||||
case JANET_SYMBOL:
|
case JANET_SYMBOL:
|
||||||
case JANET_KEYWORD:
|
case JANET_KEYWORD:
|
||||||
@ -830,7 +832,7 @@ static const char *scanformat(
|
|||||||
if (loc != NULL && *loc != '\0') {
|
if (loc != NULL && *loc != '\0') {
|
||||||
const char *mapping = get_fmt_mapping(*p2++);
|
const char *mapping = get_fmt_mapping(*p2++);
|
||||||
size_t len = strlen(mapping);
|
size_t len = strlen(mapping);
|
||||||
strcpy(form, mapping);
|
memcpy(form, mapping, len);
|
||||||
form += len;
|
form += len;
|
||||||
} else {
|
} else {
|
||||||
*(form++) = *(p2++);
|
*(form++) = *(p2++);
|
||||||
|
@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
int structarg = 0;
|
int structarg = 0;
|
||||||
int allow_extra = 0;
|
int allow_extra = 0;
|
||||||
int selfref = 0;
|
int selfref = 0;
|
||||||
|
int hasname = 0;
|
||||||
int seenamp = 0;
|
int seenamp = 0;
|
||||||
int seenopt = 0;
|
int seenopt = 0;
|
||||||
int namedargs = 0;
|
int namedargs = 0;
|
||||||
@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
head = argv[0];
|
head = argv[0];
|
||||||
if (janet_checktype(head, JANET_SYMBOL)) {
|
if (janet_checktype(head, JANET_SYMBOL)) {
|
||||||
selfref = 1;
|
selfref = 1;
|
||||||
|
hasname = 1;
|
||||||
|
parami = 1;
|
||||||
|
} else if (janet_checktype(head, JANET_KEYWORD)) {
|
||||||
|
hasname = 1;
|
||||||
parami = 1;
|
parami = 1;
|
||||||
}
|
}
|
||||||
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
|
if (parami >= argn || !janet_checktype(argv[parami], JANET_TUPLE)) {
|
||||||
@ -1103,7 +1108,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
|||||||
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
if (vararg) def->flags |= JANET_FUNCDEF_FLAG_VARARG;
|
||||||
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
|
||||||
|
|
||||||
if (selfref) def->name = janet_unwrap_symbol(head);
|
if (hasname) def->name = janet_unwrap_symbol(head); /* Also correctly unwraps keyword */
|
||||||
janet_def_addflags(def);
|
janet_def_addflags(def);
|
||||||
defindex = janetc_addfuncdef(c, def);
|
defindex = janetc_addfuncdef(c, def);
|
||||||
|
|
||||||
|
@ -149,6 +149,11 @@ struct JanetVM {
|
|||||||
JanetTraversalNode *traversal_top;
|
JanetTraversalNode *traversal_top;
|
||||||
JanetTraversalNode *traversal_base;
|
JanetTraversalNode *traversal_base;
|
||||||
|
|
||||||
|
/* Thread safe strerror error buffer - for janet_strerror */
|
||||||
|
#ifndef JANET_WINDOWS
|
||||||
|
char strerror_buf[256];
|
||||||
|
#endif
|
||||||
|
|
||||||
/* Event loop and scheduler globals */
|
/* Event loop and scheduler globals */
|
||||||
#ifdef JANET_EV
|
#ifdef JANET_EV
|
||||||
size_t tq_count;
|
size_t tq_count;
|
||||||
|
@ -490,3 +490,18 @@ int janet_scan_uint64(const uint8_t *str, int32_t len, uint64_t *out) {
|
|||||||
}
|
}
|
||||||
|
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
void janet_buffer_dtostr(JanetBuffer *buffer, double x) {
|
||||||
|
#define BUFSIZE 32
|
||||||
|
janet_buffer_extra(buffer, BUFSIZE);
|
||||||
|
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, "%.17g", x);
|
||||||
|
#undef BUFSIZE
|
||||||
|
/* fix locale issues with commas */
|
||||||
|
for (int i = 0; i < count; i++) {
|
||||||
|
char c = buffer->data[buffer->count + i];
|
||||||
|
if (c == ',') {
|
||||||
|
buffer->data[buffer->count + i] = '.';
|
||||||
|
}
|
||||||
|
}
|
||||||
|
buffer->count += count;
|
||||||
|
}
|
||||||
|
@ -953,6 +953,20 @@ int janet_gettime(struct timespec *spec, enum JanetTimeSource source) {
|
|||||||
#endif
|
#endif
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
/* Better strerror (thread-safe if available) */
|
||||||
|
const char *janet_strerror(int e) {
|
||||||
|
#ifdef JANET_WINDOWS
|
||||||
|
/* Microsoft strerror seems sane here and is thread safe by default */
|
||||||
|
return strerror(e);
|
||||||
|
#elif defined(_GNU_SOURCE)
|
||||||
|
/* See https://linux.die.net/man/3/strerror_r */
|
||||||
|
return strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
|
||||||
|
#else
|
||||||
|
strerror_r(e, janet_vm.strerror_buf, sizeof(janet_vm.strerror_buf));
|
||||||
|
return janet_vm.strerror_buf;
|
||||||
|
#endif
|
||||||
|
}
|
||||||
|
|
||||||
/* Setting C99 standard makes this not available, but it should
|
/* Setting C99 standard makes this not available, but it should
|
||||||
* work/link properly if we detect a BSD */
|
* work/link properly if we detect a BSD */
|
||||||
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
|
||||||
|
@ -80,6 +80,8 @@ void janet_memempty(JanetKV *mem, int32_t count);
|
|||||||
void *janet_memalloc_empty(int32_t count);
|
void *janet_memalloc_empty(int32_t count);
|
||||||
JanetTable *janet_get_core_table(const char *name);
|
JanetTable *janet_get_core_table(const char *name);
|
||||||
void janet_def_addflags(JanetFuncDef *def);
|
void janet_def_addflags(JanetFuncDef *def);
|
||||||
|
void janet_buffer_dtostr(JanetBuffer *buffer, double x);
|
||||||
|
const char *janet_strerror(int e);
|
||||||
const void *janet_strbinsearch(
|
const void *janet_strbinsearch(
|
||||||
const void *tab,
|
const void *tab,
|
||||||
size_t tabcount,
|
size_t tabcount,
|
||||||
|
@ -318,7 +318,7 @@ static Janet janet_binop_call(const char *lmethod, const char *rmethod, Janet lh
|
|||||||
Janet lr = janet_method_lookup(rhs, rmethod);
|
Janet lr = janet_method_lookup(rhs, rmethod);
|
||||||
Janet argv[2] = { rhs, lhs };
|
Janet argv[2] = { rhs, lhs };
|
||||||
if (janet_checktype(lr, JANET_NIL)) {
|
if (janet_checktype(lr, JANET_NIL)) {
|
||||||
janet_panicf("could not find method :%s for %v, or :%s for %v",
|
janet_panicf("could not find method :%s for %v or :%s for %v",
|
||||||
lmethod, lhs,
|
lmethod, lhs,
|
||||||
rmethod, rhs);
|
rmethod, rhs);
|
||||||
}
|
}
|
||||||
|
@ -112,7 +112,8 @@ extern "C" {
|
|||||||
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
|| defined(__s390x__) /* S390 64-bit (BE) */ \
|
||||||
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
|| (defined(__ppc64__) || defined(__PPC64__)) \
|
||||||
|| defined(__aarch64__) /* ARM 64-bit */ \
|
|| defined(__aarch64__) /* ARM 64-bit */ \
|
||||||
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */
|
|| (defined(__riscv) && (__riscv_xlen == 64)) /* RISC-V 64-bit */ \
|
||||||
|
|| defined(__loongarch64) /* LoongArch64 64-bit */
|
||||||
#define JANET_64 1
|
#define JANET_64 1
|
||||||
#else
|
#else
|
||||||
#define JANET_32 1
|
#define JANET_32 1
|
||||||
|
@ -987,5 +987,7 @@
|
|||||||
(b)))
|
(b)))
|
||||||
(assert (= -2 (man-or-boy 2)))
|
(assert (= -2 (man-or-boy 2)))
|
||||||
(assert (= -67 (man-or-boy 10)))
|
(assert (= -67 (man-or-boy 10)))
|
||||||
|
(assert (= :a (with-env @{:b :a} (dyn :b))) "with-env dyn")
|
||||||
|
(assert-error "unknown symbol +" (with-env @{} (eval '(+ 1 2))))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
# Copyright (c) 2023 Calvin Rose
|
# Copyright (c) 2024 Calvin Rose
|
||||||
#
|
#
|
||||||
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
# Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||||
# of this software and associated documentation files (the "Software"), to
|
# of this software and associated documentation files (the "Software"), to
|
||||||
@ -162,5 +162,20 @@
|
|||||||
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
(assert (deep= @"abc423" (buffer/push-at @"abc123" 3 "4"))
|
||||||
"buffer/push-at 3")
|
"buffer/push-at 3")
|
||||||
|
|
||||||
|
# buffer/format-at
|
||||||
|
(def start-buf (buffer/new-filled 100 (chr "x")))
|
||||||
|
(buffer/format-at start-buf 50 "aa%dbb" 32)
|
||||||
|
(assert (= (string start-buf) (string (string/repeat "x" 50) "aa32bb" (string/repeat "x" 44)))
|
||||||
|
"buffer/format-at 1")
|
||||||
|
(assert
|
||||||
|
(deep=
|
||||||
|
(buffer/format @"" "%j" [1 2 3 :a :b :c])
|
||||||
|
(buffer/format-at @"" 0 "%j" [1 2 3 :a :b :c]))
|
||||||
|
"buffer/format-at empty buffer")
|
||||||
|
(def buf @"xxxyyy")
|
||||||
|
(buffer/format-at buf -4 "xxx")
|
||||||
|
(assert (= (string buf) "xxxxxx") "buffer/format-at negative index")
|
||||||
|
(assert-error "expected index at to be in range [0, 0), got 1" (buffer/format-at @"" 1 "abc"))
|
||||||
|
|
||||||
(end-suite)
|
(end-suite)
|
||||||
|
|
||||||
|
@ -42,7 +42,7 @@
|
|||||||
|
|
||||||
(defn buffer-factory
|
(defn buffer-factory
|
||||||
[]
|
[]
|
||||||
@"im am a buffer")
|
@"i am a buffer")
|
||||||
|
|
||||||
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user