mirror of
https://github.com/janet-lang/janet
synced 2024-11-18 06:34:48 +00:00
Merge changes from bundle-tools branch:
- Update file IO to explicitly use 64bit ftell/fseek - Add env argument to eval - Allow naming function literals with keywords.
This commit is contained in:
parent
ae2c5820a1
commit
7bae7d9efd
4
.github/workflows/test.yml
vendored
4
.github/workflows/test.yml
vendored
@ -73,7 +73,7 @@ jobs:
|
||||
- name: Compile the project
|
||||
run: make clean && make CC=x86_64-w64-mingw32-gcc LD=x86_64-w64-mingw32-gcc UNAME=MINGW RUN=wine
|
||||
- name: Test the project
|
||||
run: make test UNAME=MINGW RUN=wine
|
||||
run: make test UNAME=MINGW RUN=wine VERBOSE=1
|
||||
|
||||
test-arm-linux:
|
||||
name: Build and test ARM32 cross compilation
|
||||
@ -88,4 +88,4 @@ jobs:
|
||||
- name: Compile the project
|
||||
run: make RUN="qemu-arm -L /usr/arm-linux-gnueabi/" CC=arm-linux-gnueabi-gcc LD=arm-linux-gnueabi-gcc
|
||||
- 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
|
||||
|
1
.gitignore
vendored
1
.gitignore
vendored
@ -48,6 +48,7 @@ janet.wasm
|
||||
# Generated files
|
||||
*.gen.h
|
||||
*.gen.c
|
||||
*.tmp
|
||||
|
||||
# Generate test files
|
||||
*.out
|
||||
|
@ -2,6 +2,9 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 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
|
||||
|
@ -1,5 +1,5 @@
|
||||
# The core janet library
|
||||
# Copyright 2023 © Calvin Rose
|
||||
# Copyright 2024 © Calvin Rose
|
||||
|
||||
###
|
||||
###
|
||||
@ -244,7 +244,7 @@
|
||||
(let [[[err fib]] catch
|
||||
f (gensym)
|
||||
r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,body) :ie)
|
||||
~(let [,f (,fiber/new (fn :try [] ,body) :ie)
|
||||
,r (,resume ,f)]
|
||||
(if (,= (,fiber/status ,f) :error)
|
||||
(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.`
|
||||
[& body]
|
||||
(let [f (gensym) r (gensym)]
|
||||
~(let [,f (,fiber/new (fn [] ,;body) :ie)
|
||||
~(let [,f (,fiber/new (fn :protect [] ,;body) :ie)
|
||||
,r (,resume ,f)]
|
||||
[(,not= :error (,fiber/status ,f)) ,r])))
|
||||
|
||||
@ -313,7 +313,7 @@
|
||||
[form & body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
||||
(def ,f (,fiber/new (fn :defer [] ,;body) :ti))
|
||||
(def ,r (,resume ,f))
|
||||
,form
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
@ -326,7 +326,7 @@
|
||||
[form & body]
|
||||
(with-syms [f r]
|
||||
~(do
|
||||
(def ,f (,fiber/new (fn [] ,;body) :ti))
|
||||
(def ,f (,fiber/new (fn :edefer [] ,;body) :ti))
|
||||
(def ,r (,resume ,f))
|
||||
(if (= (,fiber/status ,f) :dead)
|
||||
,r
|
||||
@ -338,7 +338,7 @@
|
||||
[tag & body]
|
||||
(with-syms [res target payload fib]
|
||||
~(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 [,target ,payload] ,res)
|
||||
(if (,= ,tag ,target)
|
||||
@ -629,17 +629,17 @@
|
||||
``Create a generator expression using the `loop` syntax. Returns a fiber
|
||||
that yields all values inside the loop in order. See `loop` for details.``
|
||||
[head & body]
|
||||
~(,fiber/new (fn [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
~(,fiber/new (fn :generate [] (loop ,head (yield (do ,;body)))) :yi))
|
||||
|
||||
(defmacro coro
|
||||
"A wrapper for making fibers that may yield multiple values (coroutine). Same as `(fiber/new (fn [] ;body) :yi)`."
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
(tuple fiber/new (tuple 'fn :coro '[] ;body) :yi))
|
||||
|
||||
(defmacro fiber-fn
|
||||
"A wrapper for making fibers. Same as `(fiber/new (fn [] ;body) flags)`."
|
||||
[flags & body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) flags))
|
||||
(tuple fiber/new (tuple 'fn :fiber-fn '[] ;body) flags))
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
@ -688,7 +688,7 @@
|
||||
~(if (def ,(def sym (gensym)) ,br)
|
||||
(do (def ,bl ,sym) ,(aux (+ 2 i)))
|
||||
,fal2)))))
|
||||
(aux 0))
|
||||
(aux 0))
|
||||
|
||||
(defmacro when-let
|
||||
"Same as `(if-let bindings (do ;body))`."
|
||||
@ -702,11 +702,11 @@
|
||||
(case (length functions)
|
||||
0 nil
|
||||
1 (in functions 0)
|
||||
2 (let [[f g] functions] (fn [& x] (f (g ;x))))
|
||||
3 (let [[f g h] functions] (fn [& x] (f (g (h ;x)))))
|
||||
4 (let [[f g h i] functions] (fn [& x] (f (g (h (i ;x))))))
|
||||
2 (let [[f g] functions] (fn :comp [& x] (f (g ;x))))
|
||||
3 (let [[f g h] functions] (fn :comp [& x] (f (g (h ;x)))))
|
||||
4 (let [[f g h i] functions] (fn :comp [& x] (f (g (h (i ;x))))))
|
||||
(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)))))
|
||||
|
||||
(defn identity
|
||||
@ -717,7 +717,7 @@
|
||||
(defn complement
|
||||
"Returns a function that is the complement to the argument."
|
||||
[f]
|
||||
(fn [x] (not (f x))))
|
||||
(fn :complement [x] (not (f x))))
|
||||
|
||||
(defmacro- do-extreme
|
||||
[order args]
|
||||
@ -880,7 +880,7 @@
|
||||
``Sorts `ind` in-place by calling a function `f` on each element and
|
||||
comparing the result with `<`.``
|
||||
[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
|
||||
``Returns a new sorted array without modifying the old one.
|
||||
@ -893,7 +893,7 @@
|
||||
``Returns a new sorted array that compares elements by invoking
|
||||
a function `f` on each element and comparing the result with `<`.``
|
||||
[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
|
||||
``Reduce, also know as fold-left in many languages, transforms
|
||||
@ -1192,7 +1192,7 @@
|
||||
``Returns the juxtaposition of functions. In other words,
|
||||
`((juxt* a b c) x)` evaluates to `[(a x) (b x) (c x)]`.``
|
||||
[& funs]
|
||||
(fn [& args]
|
||||
(fn :juxt* [& args]
|
||||
(def ret @[])
|
||||
(each f funs
|
||||
(array/push ret (f ;args)))
|
||||
@ -1205,7 +1205,7 @@
|
||||
(def $args (gensym))
|
||||
(each f funs
|
||||
(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
|
||||
``Define an alias for a keyword that is used as a dynamic binding. The
|
||||
@ -1421,12 +1421,12 @@
|
||||
(def dyn-forms
|
||||
(seq [i :range [0 (length bindings) 2]]
|
||||
~(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 [] ,;body) : ,env)))
|
||||
~(,resume (,fiber/new (fn :with-env [] ,;body) : ,env)))
|
||||
|
||||
(defmacro with-vars
|
||||
``Evaluates `body` with each var in `vars` temporarily bound. Similar signature to
|
||||
@ -1441,7 +1441,7 @@
|
||||
(with-syms [ret f s]
|
||||
~(do
|
||||
,;saveold
|
||||
(def ,f (,fiber/new (fn [] ,;setnew ,;body) :ti))
|
||||
(def ,f (,fiber/new (fn :with-vars [] ,;setnew ,;body) :ti))
|
||||
(def ,ret (,resume ,f))
|
||||
,;restoreold
|
||||
(if (= (,fiber/status ,f) :dead) ,ret (,propagate ,ret ,f)))))
|
||||
@ -1450,7 +1450,7 @@
|
||||
"Partial function application."
|
||||
[f & more]
|
||||
(if (zero? (length more)) f
|
||||
(fn [& r] (f ;more ;r))))
|
||||
(fn :partial [& r] (f ;more ;r))))
|
||||
|
||||
(defn every?
|
||||
``Evaluates to the last element of `ind` if all preceding elements are truthy,
|
||||
@ -1807,7 +1807,6 @@
|
||||
(printf (dyn *pretty-format* "%q") x)
|
||||
(flush))
|
||||
|
||||
|
||||
(defn file/lines
|
||||
"Return an iterator over the lines of a file."
|
||||
[file]
|
||||
@ -2148,8 +2147,8 @@
|
||||
(def ret
|
||||
(case (type x)
|
||||
:tuple (if (= (tuple/type x) :brackets)
|
||||
(tuple/brackets ;(map recur x))
|
||||
(dotup x))
|
||||
(tuple/brackets ;(map recur x))
|
||||
(dotup x))
|
||||
:array (map recur x)
|
||||
:struct (table/to-struct (dotable x recur))
|
||||
:table (dotable x recur)
|
||||
@ -2330,7 +2329,7 @@
|
||||
x)))
|
||||
x))
|
||||
(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)))
|
||||
~(fn ,;name-splice [,;fn-args ,;(if vararg ['& (symbol prefix '$&)] [])] ,expanded))
|
||||
|
||||
@ -2420,29 +2419,9 @@
|
||||
col
|
||||
": parse error: "
|
||||
(:error p)
|
||||
(if ec "\e[0m" ""))
|
||||
(if ec "\e[0m"))
|
||||
(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
|
||||
"Default handler for a compile warning."
|
||||
[msg level where &opt line col]
|
||||
@ -2455,10 +2434,7 @@
|
||||
":"
|
||||
col
|
||||
": compile warning (" level "): ")
|
||||
(eprint msg)
|
||||
(when ec
|
||||
(print-line-col where line col)
|
||||
(eprin "\e[0m"))
|
||||
(eprint msg (if ec "\e[0m"))
|
||||
(eflush))
|
||||
|
||||
(defn bad-compile
|
||||
@ -2475,10 +2451,7 @@
|
||||
": compile error: ")
|
||||
(if macrof
|
||||
(debug/stacktrace macrof msg "")
|
||||
(eprint msg))
|
||||
(when ec
|
||||
(print-line-col where line col)
|
||||
(eprin "\e[0m"))
|
||||
(eprint msg (if ec "\e[0m")))
|
||||
(eflush))
|
||||
|
||||
(defn curenv
|
||||
@ -2547,7 +2520,7 @@
|
||||
:read read
|
||||
:expander expand} opts)
|
||||
(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 on-compile-error bad-compile)
|
||||
(default on-compile-warning warn-compile)
|
||||
@ -2682,8 +2655,8 @@
|
||||
(defn eval
|
||||
``Evaluates a form in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[form]
|
||||
(def res (compile form nil :eval))
|
||||
[form &opt env]
|
||||
(def res (compile form env :eval))
|
||||
(if (= (type res) :function)
|
||||
(res)
|
||||
(error (get res :error))))
|
||||
@ -2722,9 +2695,9 @@
|
||||
(defn eval-string
|
||||
``Evaluates a string in the current environment. If more control over the
|
||||
environment is needed, use `run-context`.``
|
||||
[str]
|
||||
[str &opt env]
|
||||
(var ret nil)
|
||||
(each x (parse-all str) (set ret (eval x)))
|
||||
(each x (parse-all str) (set ret (eval x env)))
|
||||
ret)
|
||||
|
||||
(def load-image-dict
|
||||
@ -2867,7 +2840,7 @@
|
||||
(set ret [fullpath mod-kind])
|
||||
(break))))))
|
||||
(if ret ret
|
||||
(let [expander (fn [[t _ chk]]
|
||||
(let [expander (fn :expander [[t _ chk]]
|
||||
(when (string? t)
|
||||
(when (mod-filter chk path)
|
||||
(module/expand-path path t))))
|
||||
@ -2934,7 +2907,7 @@
|
||||
set to a truthy value."
|
||||
[env &opt level is-repl]
|
||||
(default level 1)
|
||||
(fn [f x]
|
||||
(fn :debugger [f x]
|
||||
(def fs (fiber/status f))
|
||||
(if (= :dead fs)
|
||||
(when is-repl
|
||||
@ -3024,7 +2997,7 @@
|
||||
``A table of loading method names to loading functions.
|
||||
This table lets `require` and `import` load many different kinds
|
||||
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]
|
||||
(def ml (dyn *module-loading* module/loading))
|
||||
(put ml path true)
|
||||
@ -3142,6 +3115,7 @@
|
||||
[&opt env local]
|
||||
(env-walk keyword? env local))
|
||||
|
||||
|
||||
(defdyn *doc-width*
|
||||
"Width in columns to print documentation printed with `doc-format`.")
|
||||
|
||||
@ -3704,7 +3678,7 @@
|
||||
[&opt chunks onsignal env parser read]
|
||||
(default env (make-env))
|
||||
(default chunks
|
||||
(fn [buf p]
|
||||
(fn :chunks [buf p]
|
||||
(getline
|
||||
(string
|
||||
"repl:"
|
||||
@ -3735,18 +3709,18 @@
|
||||
Returns a fiber that is scheduled to run the function.
|
||||
```
|
||||
[f & args]
|
||||
(ev/go (fn _call [&] (f ;args))))
|
||||
(ev/go (fn :call [&] (f ;args))))
|
||||
|
||||
(defmacro ev/spawn
|
||||
"Run some code in a new fiber. This is shorthand for `(ev/go (fn [] ;body))`."
|
||||
[& body]
|
||||
~(,ev/go (fn _spawn [&] ,;body)))
|
||||
~(,ev/go (fn :spawn [&] ,;body)))
|
||||
|
||||
(defmacro ev/do-thread
|
||||
``Run some code in a new thread. Suspends the current fiber until the thread is complete, and
|
||||
evaluates to nil.``
|
||||
[& body]
|
||||
~(,ev/thread (fn _do-thread [&] ,;body)))
|
||||
~(,ev/thread (fn :do-thread [&] ,;body)))
|
||||
|
||||
(defn- acquire-release
|
||||
[acq rel lock body]
|
||||
@ -3775,7 +3749,7 @@
|
||||
(defmacro ev/spawn-thread
|
||||
``Run some code in a new thread. Like `ev/do-thread`, but returns nil immediately.``
|
||||
[& body]
|
||||
~(,ev/thread (fn _spawn-thread [&] ,;body) nil :n))
|
||||
~(,ev/thread (fn :spawn-thread [&] ,;body) nil :n))
|
||||
|
||||
(defmacro ev/with-deadline
|
||||
``
|
||||
@ -3824,7 +3798,7 @@
|
||||
(def ,res @[])
|
||||
,;(seq [[i body] :pairs bodies]
|
||||
~(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)))
|
||||
(,wait-for-fibers ,chan ,fset)
|
||||
,res))))
|
||||
@ -3907,12 +3881,12 @@
|
||||
~(defn ,alias ,;meta [,;formal-args]
|
||||
(,ffi/call (,(delay (make-ptr))) (,(delay (make-sig))) ,;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
|
||||
"Generate bindings for native functions in a convenient manner."
|
||||
[name ret-type & body]
|
||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body))
|
||||
~(ffi/defbind-alias ,name ,name ,ret-type ,;body)))
|
||||
|
||||
###
|
||||
###
|
||||
@ -3989,7 +3963,6 @@
|
||||
(merge-into module/cache old-modcache)
|
||||
nil)
|
||||
|
||||
|
||||
###
|
||||
###
|
||||
### CLI Tool Main
|
||||
@ -4026,6 +3999,28 @@
|
||||
(compwhen (not (dyn 'os/isatty))
|
||||
(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
|
||||
`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.`
|
||||
@ -4057,28 +4052,6 @@
|
||||
(def x (in args (+ i 1)))
|
||||
(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
|
||||
(def handlers
|
||||
{"h" (fn [&]
|
||||
|
@ -1056,7 +1056,7 @@ JanetCompileResult janet_compile_lint(Janet source,
|
||||
|
||||
if (c.result.status == JANET_COMPILE_OK) {
|
||||
JanetFuncDef *def = janetc_pop_funcdef(&c);
|
||||
def->name = janet_cstring("_thunk");
|
||||
def->name = janet_cstring("thunk");
|
||||
janet_def_addflags(def);
|
||||
c.result.funcdef = def;
|
||||
} else {
|
||||
|
@ -164,7 +164,7 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
}
|
||||
}
|
||||
if (frame->flags & JANET_STACKFRAME_TAILCALL)
|
||||
janet_eprintf(" (tailcall)");
|
||||
janet_eprintf(" (tail call)");
|
||||
if (frame->func && frame->pc) {
|
||||
int32_t off = (int32_t)(frame->pc - def->bytecode);
|
||||
if (def->sourcemap) {
|
||||
@ -180,6 +180,11 @@ void janet_stacktrace_ext(JanetFiber *fiber, Janet err, const char *prefix) {
|
||||
}
|
||||
}
|
||||
janet_eprintf("\n");
|
||||
/* Print fiber points optionally. Clutters traces but provides info
|
||||
if (i <= 0 && fi > 0) {
|
||||
janet_eprintf(" in parent fiber\n");
|
||||
}
|
||||
*/
|
||||
}
|
||||
}
|
||||
|
||||
|
@ -76,4 +76,6 @@
|
||||
#define __BSD_VISIBLE 1
|
||||
#endif
|
||||
|
||||
#define _FILE_OFFSET_BITS 64
|
||||
|
||||
#endif
|
||||
|
@ -41,6 +41,11 @@ static void io_file_marshal(void *p, JanetMarshalContext *ctx);
|
||||
static void *io_file_unmarshal(JanetMarshalContext *ctx);
|
||||
static Janet io_file_next(void *p, Janet key);
|
||||
|
||||
#ifdef JANET_WINDOWS
|
||||
#define ftell _ftelli64
|
||||
#define fseek _fseeki64
|
||||
#endif
|
||||
|
||||
const JanetAbstractType janet_file_type = {
|
||||
"core/file",
|
||||
cfun_io_gc,
|
||||
@ -337,7 +342,7 @@ JANET_CORE_FN(cfun_io_fseek,
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_CLOSED)
|
||||
janet_panic("file is closed");
|
||||
long int offset = 0;
|
||||
int64_t offset = 0;
|
||||
int whence = SEEK_CUR;
|
||||
if (argc >= 2) {
|
||||
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]);
|
||||
}
|
||||
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");
|
||||
@ -365,7 +370,7 @@ JANET_CORE_FN(cfun_io_ftell,
|
||||
JanetFile *iof = janet_getabstract(argv, 0, &janet_file_type);
|
||||
if (iof->flags & JANET_FILE_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");
|
||||
return janet_wrap_number((double)pos);
|
||||
}
|
||||
|
@ -2411,8 +2411,18 @@ JANET_CORE_FN(os_dir,
|
||||
/* Read directory items with opendir / readdir / closedir */
|
||||
struct dirent *dp;
|
||||
DIR *dfd = opendir(dir);
|
||||
if (dfd == NULL) janet_panicf("cannot open directory %s", dir);
|
||||
while ((dp = readdir(dfd)) != NULL) {
|
||||
if (dfd == NULL) janet_panicf("cannot open directory %s: %s", dir, janet_strerror(errno));
|
||||
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, "..")) {
|
||||
continue;
|
||||
}
|
||||
|
@ -925,6 +925,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
int structarg = 0;
|
||||
int allow_extra = 0;
|
||||
int selfref = 0;
|
||||
int hasname = 0;
|
||||
int seenamp = 0;
|
||||
int seenopt = 0;
|
||||
int namedargs = 0;
|
||||
@ -943,6 +944,10 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
|
||||
head = argv[0];
|
||||
if (janet_checktype(head, JANET_SYMBOL)) {
|
||||
selfref = 1;
|
||||
hasname = 1;
|
||||
parami = 1;
|
||||
} else if (janet_checktype(head, JANET_KEYWORD)) {
|
||||
hasname = 1;
|
||||
parami = 1;
|
||||
}
|
||||
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 (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);
|
||||
defindex = janetc_addfuncdef(c, def);
|
||||
|
||||
|
@ -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 argv[2] = { rhs, lhs };
|
||||
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,
|
||||
rmethod, rhs);
|
||||
}
|
||||
|
@ -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
|
||||
# of this software and associated documentation files (the "Software"), to
|
||||
|
@ -42,7 +42,7 @@
|
||||
|
||||
(defn buffer-factory
|
||||
[]
|
||||
@"im am a buffer")
|
||||
@"i am a buffer")
|
||||
|
||||
(assert (not= (buffer-factory) (buffer-factory)) "buffer instantiation")
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user