mirror of
https://github.com/janet-lang/janet
synced 2025-10-28 06:07:43 +00:00
Compare commits
27 Commits
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
2795e8a8b7 | ||
|
|
bdf14170a4 | ||
|
|
10dcbc639a | ||
|
|
6a9bb0f4e4 | ||
|
|
c941e5a8f4 | ||
|
|
be91414c7a | ||
|
|
6839b603c8 | ||
|
|
926b68d62e | ||
|
|
d374e90033 | ||
|
|
b168b0758a | ||
|
|
54c66ecfc0 | ||
|
|
1c158bd4ff | ||
|
|
ff24143f54 | ||
|
|
dd117e81c2 | ||
|
|
f4744a18c6 | ||
|
|
259d5fabd9 | ||
|
|
d122a75efd | ||
|
|
c9ea3ac304 | ||
|
|
c63fe6ef8a | ||
|
|
72ec89dfe9 | ||
|
|
04805d106e | ||
|
|
9aed578466 | ||
|
|
77c5279296 | ||
|
|
af75bf3b64 | ||
|
|
a5157e868b | ||
|
|
01a3d8f932 | ||
|
|
f22472a644 |
@@ -4,12 +4,20 @@ sources:
|
||||
packages:
|
||||
- meson
|
||||
tasks:
|
||||
- build: |
|
||||
- with-epoll: |
|
||||
cd janet
|
||||
meson setup build --buildtype=release
|
||||
cd build
|
||||
meson setup with-epoll --buildtype=release
|
||||
cd with-epoll
|
||||
meson configure -Depoll=true
|
||||
ninja
|
||||
ninja test
|
||||
- no-epoll: |
|
||||
cd janet
|
||||
meson setup no-epoll --buildtype=release
|
||||
cd no-epoll
|
||||
meson configure -Depoll=false
|
||||
ninja
|
||||
ninja test
|
||||
sudo ninja install
|
||||
sudo jpm --verbose install circlet
|
||||
sudo jpm --verbose install spork
|
||||
|
||||
3
.gitignore
vendored
3
.gitignore
vendored
@@ -140,3 +140,6 @@ compile_commands.json
|
||||
CTestTestfile.cmake
|
||||
|
||||
# End of https://www.gitignore.io/api/cmake
|
||||
|
||||
# Astyle
|
||||
*.orig
|
||||
|
||||
10
CHANGELOG.md
10
CHANGELOG.md
@@ -1,6 +1,16 @@
|
||||
# Changelog
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## 1.15.0 - 2021-02-08
|
||||
- Fix `gtim` and `ltim` bytecode instructions on non-integer values.
|
||||
- Clean up output of flychecking to be the same as the repl.
|
||||
- Change behavior of `debug/stacktrace` with a nil error value.
|
||||
- Add optional argument to `parser/produce`.
|
||||
- Add `no-core` option to creating standalone binaries to make execution faster.
|
||||
- Fix bug where a buffer overflow could be confused with an out of memory error.
|
||||
- Change error output to `file:line:column: message`. Column is in bytes - tabs
|
||||
are considered to have width 1 (instead of 8).
|
||||
|
||||
## 1.14.2 - 2021-01-23
|
||||
- Allow `JANET_PROFILE` env variable to load a profile before loading the repl.
|
||||
- Update `tracev` macro to allow `def` and `var` inside to work as expected.
|
||||
|
||||
18
Makefile
18
Makefile
@@ -66,7 +66,7 @@ ifeq ($(UNAME), Haiku)
|
||||
LDFLAGS=-Wl,--export-dynamic
|
||||
endif
|
||||
|
||||
$(shell mkdir -p build/core build/mainclient build/webclient build/boot)
|
||||
$(shell mkdir -p build/core build/c build/boot)
|
||||
all: $(JANET_TARGET) $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) build/janet.h
|
||||
|
||||
######################
|
||||
@@ -149,7 +149,7 @@ build/janet_boot: $(JANET_BOOT_OBJECTS)
|
||||
$(CC) $(BOOT_CFLAGS) -o $@ $(JANET_BOOT_OBJECTS) $(CLIBS)
|
||||
|
||||
# Now the reason we bootstrap in the first place
|
||||
build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/c/janet.c: build/janet_boot src/boot/boot.janet
|
||||
build/janet_boot . JANET_PATH '$(JANET_PATH)' > $@
|
||||
cksum $@
|
||||
|
||||
@@ -157,9 +157,9 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.14
|
||||
SONAME=libjanet.so.1.15
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
build/c/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
|
||||
build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
@@ -168,11 +168,11 @@ build/janet.h: $(JANET_TARGET) src/include/janet.h src/conf/janetconf.h
|
||||
build/janetconf.h: src/conf/janetconf.h
|
||||
cp $< $@
|
||||
|
||||
build/janet.o: build/janet.c src/include/janet.h src/conf/janetconf.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
build/janet.o: build/c/janet.c src/conf/janetconf.h src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
build/shell.o: build/shell.c src/include/janet.h src/conf/janetconf.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
|
||||
build/shell.o: build/c/shell.c src/conf/janetconf.h src/include/janet.h
|
||||
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@
|
||||
|
||||
$(JANET_TARGET): build/janet.o build/shell.o
|
||||
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
|
||||
@@ -224,7 +224,7 @@ dist: build/janet-dist.tar.gz
|
||||
build/janet-%.tar.gz: $(JANET_TARGET) \
|
||||
build/janet.h \
|
||||
jpm.1 janet.1 LICENSE CONTRIBUTING.md $(JANET_LIBRARY) $(JANET_STATIC_LIBRARY) \
|
||||
build/doc.html README.md build/janet.c build/shell.c jpm
|
||||
build/doc.html README.md build/c/janet.c build/c/shell.c jpm
|
||||
$(eval JANET_DIST_DIR = "janet-$(shell basename $*)")
|
||||
mkdir -p build/$(JANET_DIST_DIR)
|
||||
cp -r $^ build/$(JANET_DIST_DIR)/
|
||||
|
||||
@@ -58,9 +58,9 @@ Documentation is also available locally in the REPL.
|
||||
Use the `(doc symbol-name)` macro to get API
|
||||
documentation for symbols in the core library. For example,
|
||||
```
|
||||
(doc doc)
|
||||
(doc apply)
|
||||
```
|
||||
Shows documentation for the doc macro.
|
||||
Shows documentation for the `apply` function.
|
||||
|
||||
To get a list of all bindings in the default
|
||||
environment, use the `(all-bindings)` function. You
|
||||
|
||||
@@ -30,7 +30,7 @@ if not "%JANET_BUILD%" == "" (
|
||||
|
||||
if not exist build mkdir build
|
||||
if not exist build\core mkdir build\core
|
||||
if not exist build\mainclient mkdir build\mainclient
|
||||
if not exist build\c mkdir build\c
|
||||
if not exist build\boot mkdir build\boot
|
||||
|
||||
@rem Build the bootstrap interpreter
|
||||
@@ -44,10 +44,10 @@ for %%f in (src\boot\*.c) do (
|
||||
)
|
||||
%JANET_LINK% /out:build\janet_boot.exe build\boot\*.obj
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
build\janet_boot . > build\janet.c
|
||||
build\janet_boot . > build\c\janet.c
|
||||
|
||||
@rem Build the sources
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\janet.c
|
||||
%JANET_COMPILE% /Fobuild\janet.obj build\c\janet.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
%JANET_COMPILE% /Fobuild\shell.obj src\mainclient\shell.c
|
||||
@if errorlevel 1 goto :BUILDFAIL
|
||||
@@ -102,9 +102,9 @@ exit /b 0
|
||||
mkdir dist
|
||||
janet.exe tools\gendoc.janet > dist\doc.html
|
||||
janet.exe tools\removecr.janet dist\doc.html
|
||||
janet.exe tools\removecr.janet build\janet.c
|
||||
janet.exe tools\removecr.janet build\c\janet.c
|
||||
|
||||
copy build\janet.c dist\janet.c
|
||||
copy build\c\janet.c dist\janet.c
|
||||
copy src\mainclient\shell.c dist\shell.c
|
||||
copy janet.exe dist\janet.exe
|
||||
copy LICENSE dist\LICENSE
|
||||
|
||||
53
jpm
53
jpm
@@ -602,7 +602,7 @@
|
||||
(string (string/slice path 0 (- -1 (length modext))) statext))
|
||||
|
||||
(defn- make-bin-source
|
||||
[declarations lookup-into-invocations]
|
||||
[declarations lookup-into-invocations no-core]
|
||||
(string
|
||||
declarations
|
||||
```
|
||||
@@ -627,15 +627,22 @@ int main(int argc, const char **argv) {
|
||||
|
||||
janet_init();
|
||||
|
||||
```
|
||||
(if no-core
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_table(8);
|
||||
JanetTable *lookup = janet_core_lookup_table(NULL);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
```
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
JanetTable *lookup = janet_env_lookup(env);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
|
||||
/* Load natives into unmarshalling dictionary */
|
||||
|
||||
```
|
||||
```)
|
||||
lookup-into-invocations
|
||||
```
|
||||
/* Unmarshal bytecode */
|
||||
@@ -663,7 +670,6 @@ int main(int argc, const char **argv) {
|
||||
}
|
||||
|
||||
/* Create enviornment */
|
||||
temptab = janet_table(0);
|
||||
temptab = env;
|
||||
janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args));
|
||||
janet_gcroot(janet_wrap_table(temptab));
|
||||
@@ -674,6 +680,14 @@ int main(int argc, const char **argv) {
|
||||
/* Run everything */
|
||||
JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL);
|
||||
fiber->env = temptab;
|
||||
#ifdef JANET_EV
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_loop();
|
||||
int status = janet_fiber_status(fiber);
|
||||
janet_deinit();
|
||||
return status;
|
||||
#else
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) {
|
||||
@@ -681,11 +695,9 @@ int main(int argc, const char **argv) {
|
||||
janet_deinit();
|
||||
return result;
|
||||
}
|
||||
#ifdef JANET_NET
|
||||
janet_loop();
|
||||
#endif
|
||||
janet_deinit();
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
```))
|
||||
@@ -694,7 +706,7 @@ int main(int argc, const char **argv) {
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest]
|
||||
[opts source dest no-core]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
@@ -710,7 +722,16 @@ int main(int argc, const char **argv) {
|
||||
(def dep-ldflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict (invert (env-lookup root-env)))
|
||||
(def mdict1 (invert (env-lookup root-env)))
|
||||
(def mdict
|
||||
(if no-core
|
||||
(let [temp @{}]
|
||||
(eachp [k v] mdict1
|
||||
(if (or (cfunction? k) (abstract? k))
|
||||
(put temp k v)))
|
||||
temp)
|
||||
mdict1))
|
||||
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
@@ -755,7 +776,7 @@ int main(int argc, const char **argv) {
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations no-core) :ab)
|
||||
(def oimage_dest (out-path cimage_dest ".c" ".o"))
|
||||
# Compile and link final exectable
|
||||
(unless no-compile
|
||||
@@ -1044,10 +1065,10 @@ int main(int argc, const char **argv) {
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags :deps deps :ldflags ldflags
|
||||
:no-compile no-compile}]
|
||||
:no-compile no-compile :no-core no-core}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest no-core)
|
||||
(if no-compile
|
||||
(let [cdest (string dest ".c")]
|
||||
(add-dep "build" cdest))
|
||||
@@ -1354,7 +1375,9 @@ Flags are:
|
||||
|
||||
(defn quickbin
|
||||
[input output]
|
||||
(create-executable @{} input output)
|
||||
(if (= (os/stat output :mode) :file)
|
||||
(print "output " output " exists."))
|
||||
(create-executable @{:no-compile (dyn :no-compile)} input output (dyn :no-core))
|
||||
(do-rule output))
|
||||
|
||||
(defn jpm-debug-repl
|
||||
|
||||
@@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.14.2')
|
||||
version : '1.15.0')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
|
||||
@@ -7,8 +7,6 @@
|
||||
###
|
||||
###
|
||||
|
||||
(def root-env "The root environment used to create environments with (make-env)" _env)
|
||||
|
||||
(def defn :macro
|
||||
```
|
||||
(defn name & more)
|
||||
@@ -585,16 +583,6 @@
|
||||
[& body]
|
||||
(tuple fiber/new (tuple 'fn '[] ;body) :yi))
|
||||
|
||||
(defmacro- undef
|
||||
"Remove binding from root-env"
|
||||
[& syms]
|
||||
~(do ,;(seq [s :in syms] ~(put root-env ',s nil))))
|
||||
|
||||
(undef _env)
|
||||
|
||||
(undef loop1 check-indexed for-template for-var-template iterate-template
|
||||
each-template range-template)
|
||||
|
||||
(defn sum
|
||||
"Returns the sum of xs. If xs is empty, returns 0."
|
||||
[xs]
|
||||
@@ -757,8 +745,6 @@
|
||||
(defn even? "Check if x is even." [x] (= 0 (compare 0 (mod x 2))))
|
||||
(defn odd? "Check if x is odd." [x] (= 0 (compare 1 (mod x 2))))
|
||||
|
||||
(undef compare-reduce)
|
||||
|
||||
###
|
||||
###
|
||||
### Indexed Combinators
|
||||
@@ -770,7 +756,7 @@
|
||||
a
|
||||
(if (not= (> b a) (> b c)) b c)))
|
||||
|
||||
(defn sort-help [a lo hi by]
|
||||
(defn- sort-help [a lo hi before?]
|
||||
(when (< lo hi)
|
||||
(def pivot
|
||||
(median-of-three (in a hi) (in a lo)
|
||||
@@ -778,8 +764,8 @@
|
||||
(var left lo)
|
||||
(var right hi)
|
||||
(while true
|
||||
(while (by (in a left) pivot) (++ left))
|
||||
(while (by pivot (in a right)) (-- right))
|
||||
(while (before? (in a left) pivot) (++ left))
|
||||
(while (before? pivot (in a right)) (-- right))
|
||||
(when (<= left right)
|
||||
(def tmp (in a left))
|
||||
(set (a left) (in a right))
|
||||
@@ -787,32 +773,29 @@
|
||||
(++ left)
|
||||
(-- right))
|
||||
(if (>= left right) (break)))
|
||||
(sort-help a lo right by)
|
||||
(sort-help a left hi by))
|
||||
(sort-help a lo right before?)
|
||||
(sort-help a left hi before?))
|
||||
a)
|
||||
|
||||
(defn sort
|
||||
"Sort an array in-place. Uses quick-sort and is not a stable sort."
|
||||
[a &opt by]
|
||||
(sort-help a 0 (- (length a) 1) (or by <)))
|
||||
|
||||
(undef median-of-three)
|
||||
(undef sort-help)
|
||||
[a &opt before?]
|
||||
(sort-help a 0 (- (length a) 1) (or before? <)))
|
||||
|
||||
(defn sort-by
|
||||
`Returns a new sorted array that compares elements by invoking
|
||||
a function on each element and comparing the result with <.`
|
||||
``Returns `ind` sorted by calling
|
||||
a function `f` on each element and comparing the result with <.``
|
||||
[f ind]
|
||||
(sort ind (fn [x y] (< (f x) (f y)))))
|
||||
|
||||
(defn sorted
|
||||
"Returns a new sorted array without modifying the old one."
|
||||
[ind &opt by]
|
||||
(sort (array/slice ind) by))
|
||||
[ind &opt before?]
|
||||
(sort (array/slice ind) before?))
|
||||
|
||||
(defn sorted-by
|
||||
`Returns a new sorted array that compares elements by invoking
|
||||
a function on each element and comparing the result with <.`
|
||||
``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)))))
|
||||
|
||||
@@ -1204,9 +1187,6 @@
|
||||
(tuple/brackets ;x)))
|
||||
form))
|
||||
|
||||
(undef walk-ind)
|
||||
(undef walk-dict)
|
||||
|
||||
(defn postwalk
|
||||
`Do a post-order traversal of a data structure and call (f x)
|
||||
on every visitation.`
|
||||
@@ -2033,10 +2013,11 @@
|
||||
###
|
||||
###
|
||||
|
||||
# Get boot options
|
||||
(def- boot/opts @{})
|
||||
# Initialize syspath and header path
|
||||
(each [k v] (partition 2 (tuple/slice boot/args 2))
|
||||
(put boot/opts k v))
|
||||
(case k
|
||||
"JANET_PATH" (setdyn :syspath v)
|
||||
"JANET_HEADERPATH" (setdyn :headerpath v)))
|
||||
|
||||
(defn make-env
|
||||
`Create a new environment table. The new environment
|
||||
@@ -2054,30 +2035,31 @@
|
||||
(def [line col] (:where p))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"parse error in "
|
||||
where
|
||||
" around line "
|
||||
(string line)
|
||||
", column "
|
||||
(string col)
|
||||
": "
|
||||
":"
|
||||
line
|
||||
":"
|
||||
col
|
||||
": parse error: "
|
||||
(:error p)
|
||||
(if ec "\e[0m" ""))
|
||||
(eflush))
|
||||
|
||||
(defn bad-compile
|
||||
"Default handler for a compile error."
|
||||
[msg macrof where]
|
||||
[msg macrof where &opt line col]
|
||||
(def ec (dyn :err-color))
|
||||
(eprin
|
||||
(if ec "\e[31m" "")
|
||||
where
|
||||
":"
|
||||
line
|
||||
":"
|
||||
col
|
||||
": compile error: ")
|
||||
(if macrof
|
||||
(debug/stacktrace macrof (string msg " while compiling " where))
|
||||
(eprint
|
||||
(if ec "\e[31m" "")
|
||||
"compile error: "
|
||||
msg
|
||||
" while compiling "
|
||||
where
|
||||
(if ec "\e[0m" "")))
|
||||
(debug/stacktrace macrof msg)
|
||||
(eprint msg (if ec "\e[0m" "")))
|
||||
(eflush))
|
||||
|
||||
(defn curenv
|
||||
@@ -2130,7 +2112,7 @@
|
||||
(default guard :ydt)
|
||||
|
||||
# Evaluate 1 source form in a protected manner
|
||||
(defn eval1 [source]
|
||||
(defn eval1 [source &opt l c]
|
||||
(def source (if expand (expand source) source))
|
||||
(var good true)
|
||||
(var resumeval nil)
|
||||
@@ -2143,11 +2125,7 @@
|
||||
(do
|
||||
(set good false)
|
||||
(def {:error err :line line :column column :fiber errf} res)
|
||||
(def msg
|
||||
(if (<= 0 line)
|
||||
(string err " on line " line ", column " column)
|
||||
err))
|
||||
(on-compile-error msg errf where))))
|
||||
(on-compile-error err errf where (or line l) (or column c)))))
|
||||
guard))
|
||||
(fiber/setenv f env)
|
||||
(while (fiber/can-resume? f)
|
||||
@@ -2175,6 +2153,10 @@
|
||||
(fiber/setenv f env)
|
||||
(resume f))
|
||||
|
||||
(defn produce []
|
||||
(def tup (p-produce p true))
|
||||
[(in tup 0) ;(tuple/sourcemap tup)])
|
||||
|
||||
# Loop
|
||||
(def buf @"")
|
||||
(var parser-not-done true)
|
||||
@@ -2196,7 +2178,7 @@
|
||||
(while (> len pindex)
|
||||
(+= pindex (p-consume p buf pindex))
|
||||
(while (p-has-more p)
|
||||
(eval1 (p-produce p))
|
||||
(eval1 ;(produce))
|
||||
(if (env :exit) (break)))
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where)
|
||||
@@ -2205,7 +2187,7 @@
|
||||
# Check final parser state
|
||||
(unless (env :exit)
|
||||
(while (p-has-more p)
|
||||
(eval1 (p-produce p))
|
||||
(eval1 ;(produce))
|
||||
(if (env :exit) (break)))
|
||||
(when (= (p-status p) :error)
|
||||
(parse-err p where)))
|
||||
@@ -2330,16 +2312,13 @@
|
||||
```
|
||||
@[])
|
||||
|
||||
(setdyn :syspath (boot/opts "JANET_PATH"))
|
||||
(setdyn :headerpath (boot/opts "JANET_HEADERPATH"))
|
||||
|
||||
(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
|
||||
the generated paths behave like other module types, including
|
||||
relative imports and syspath imports. ext is the file extension
|
||||
to associate with this module type, including the dot. loader is the
|
||||
keyword name of a loader that is module/loaders. Returns the modified module/paths.
|
||||
relative imports and syspath imports. `ext` is the file extension
|
||||
to associate with this module type, including the dot. `loader` is the
|
||||
keyword name of a loader in `module/loaders`. Returns the modified `module/paths`.
|
||||
```
|
||||
[ext loader]
|
||||
(defn- find-prefix
|
||||
@@ -2360,7 +2339,7 @@
|
||||
(array/insert module/paths 0 [(fn is-cached [path] (if (in module/cache path) path)) :preload check-is-dep])
|
||||
|
||||
# Version of fexists that works even with a reduced OS
|
||||
(defn fexists
|
||||
(defn- fexists
|
||||
[path]
|
||||
(compif (dyn 'os/stat)
|
||||
(= :file (os/stat path :mode))
|
||||
@@ -2407,12 +2386,6 @@
|
||||
str-parts (interpose "\n " paths)]
|
||||
[nil (string "could not find module " path ":\n " ;str-parts)])))
|
||||
|
||||
(undef fexists)
|
||||
(undef mod-filter)
|
||||
(undef check-relative)
|
||||
(undef check-project-relative)
|
||||
(undef check-is-dep)
|
||||
|
||||
(def module/loading
|
||||
`Table mapping currently loading modules to true. Used to prevent
|
||||
circular dependencies.`
|
||||
@@ -2441,22 +2414,25 @@
|
||||
(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 4096 buf))
|
||||
(defn bp [&opt x y]
|
||||
(when exit
|
||||
(bad-parse x y)
|
||||
(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]
|
||||
(def buf @"")
|
||||
(with-dyns [:err buf :err-color false]
|
||||
(bad-parse x y))
|
||||
(set exit-error (string/slice buf 0 -2)))
|
||||
(defn bc [&opt x y z a b]
|
||||
(when exit
|
||||
(bad-compile x y z)
|
||||
(bad-compile x y z a b)
|
||||
(os/exit 1))
|
||||
(put env :exit true)
|
||||
(def ce (string x " while compiling " z))
|
||||
(set exit-error ce)
|
||||
(def buf @"")
|
||||
(with-dyns [:err buf :err-color false]
|
||||
(bad-compile x nil z a b))
|
||||
(set exit-error (string/slice buf 0 -2))
|
||||
(set exit-fiber y))
|
||||
(unless f
|
||||
(error (string "could not find file " path)))
|
||||
@@ -2468,7 +2444,8 @@
|
||||
:on-status (fn [f x]
|
||||
(when (not= (fiber/status f) :dead)
|
||||
(when exit
|
||||
(debug/stacktrace f x)
|
||||
(eprint x)
|
||||
(debug/stacktrace f)
|
||||
(eflush)
|
||||
(os/exit 1))
|
||||
(put env :exit true)
|
||||
@@ -2502,7 +2479,7 @@
|
||||
m)))
|
||||
:image (fn image-loader [path &] (load-image (slurp path)))})
|
||||
|
||||
(defn require-1
|
||||
(defn- require-1
|
||||
[path args kargs]
|
||||
(def [fullpath mod-kind] (module/find path))
|
||||
(unless fullpath (error mod-kind))
|
||||
@@ -2551,8 +2528,6 @@
|
||||
(string (last (string/split "/" path)) "/")))
|
||||
(merge-module env newenv prefix ep))
|
||||
|
||||
(undef require-1)
|
||||
|
||||
(defmacro import
|
||||
`Import a module. First requires the module, and then merges its
|
||||
symbols into the current environment, prepending a given prefix as needed.
|
||||
@@ -2913,10 +2888,6 @@
|
||||
(if-not found
|
||||
(print "documentation for value " x " not found.")))
|
||||
|
||||
(undef env-walk)
|
||||
(undef print-index)
|
||||
(undef print-module-entry)
|
||||
|
||||
###
|
||||
###
|
||||
### Debugger
|
||||
@@ -2962,71 +2933,67 @@
|
||||
(in (.slots frame-idx) (or nth 0)))
|
||||
|
||||
# Conditional compilation for disasm
|
||||
(def disasm-alias (if-let [x (root-env 'disasm)] (x :value)))
|
||||
(compwhen (dyn 'disasm)
|
||||
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(disasm-alias func))
|
||||
(defn .disasm
|
||||
"Gets the assembly for the current function."
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(disasm func))
|
||||
|
||||
(defn .bytecode
|
||||
"Get the bytecode for the current function."
|
||||
[&opt n]
|
||||
((.disasm n) :bytecode))
|
||||
(defn .bytecode
|
||||
"Get the bytecode for the current function."
|
||||
[&opt n]
|
||||
((.disasm n) :bytecode))
|
||||
|
||||
(defn .ppasm
|
||||
"Pretty prints the assembly for the current function"
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(def dasm (disasm-alias func))
|
||||
(def bytecode (in dasm :bytecode))
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (in dasm :sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n signal: " (.signal))
|
||||
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
|
||||
(when-let [constants (dasm :constants)]
|
||||
(printf " constants: %.4q" constants))
|
||||
(printf " slots: %.4q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||
(prin (if (= i pc) "> " " "))
|
||||
(prinf "%.20s" (string (string/join (map string instr) " ") padding))
|
||||
(when sourcemap
|
||||
(let [[sl sc] (sourcemap i)
|
||||
loc [sl sc]]
|
||||
(when (not= loc last-loc)
|
||||
(set last-loc loc)
|
||||
(prin " # line " sl ", column " sc))))
|
||||
(defn .ppasm
|
||||
"Pretty prints the assembly for the current function"
|
||||
[&opt n]
|
||||
(def frame (.frame n))
|
||||
(def func (frame :function))
|
||||
(def dasm (disasm func))
|
||||
(def bytecode (in dasm :bytecode))
|
||||
(def pc (frame :pc))
|
||||
(def sourcemap (in dasm :sourcemap))
|
||||
(var last-loc [-2 -2])
|
||||
(print "\n signal: " (.signal))
|
||||
(print " function: " (dasm :name) " [" (in dasm :source "") "]")
|
||||
(when-let [constants (dasm :constants)]
|
||||
(printf " constants: %.4q" constants))
|
||||
(printf " slots: %.4q\n" (frame :slots))
|
||||
(def padding (string/repeat " " 20))
|
||||
(loop [i :range [0 (length bytecode)]
|
||||
:let [instr (bytecode i)]]
|
||||
(prin (if (= (tuple/type instr) :brackets) "*" " "))
|
||||
(prin (if (= i pc) "> " " "))
|
||||
(prinf "%.20s" (string (string/join (map string instr) " ") padding))
|
||||
(when sourcemap
|
||||
(let [[sl sc] (sourcemap i)
|
||||
loc [sl sc]]
|
||||
(when (not= loc last-loc)
|
||||
(set last-loc loc)
|
||||
(prin " # line " sl ", column " sc))))
|
||||
(print))
|
||||
(print))
|
||||
(print))
|
||||
|
||||
(defn .breakall
|
||||
"Set breakpoints on all instructions in the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/fbreak fun i))
|
||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||
(defn .breakall
|
||||
"Set breakpoints on all instructions in the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/fbreak fun i))
|
||||
(print "Set " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(defn .clearall
|
||||
"Clear all breakpoints on the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun))
|
||||
|
||||
(unless (get root-env 'disasm)
|
||||
(undef .disasm .bytecode .breakall .clearall .ppasm))
|
||||
(undef disasm-alias)
|
||||
(defn .clearall
|
||||
"Clear all breakpoints on the current function."
|
||||
[&opt n]
|
||||
(def fun (.fn n))
|
||||
(def bytecode (.bytecode n))
|
||||
(forv i 0 (length bytecode)
|
||||
(debug/unfbreak fun i))
|
||||
(print "Cleared " (length bytecode) " breakpoints in " fun)))
|
||||
|
||||
(defn .source
|
||||
"Show the source code for the function being debugged."
|
||||
@@ -3082,7 +3049,6 @@
|
||||
|
||||
(def- debugger-keys (filter (partial string/has-prefix? ".") (keys root-env)))
|
||||
(each k debugger-keys (put debugger-env k (root-env k)) (put root-env k nil))
|
||||
(undef debugger-keys)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -3156,6 +3122,7 @@
|
||||
###
|
||||
|
||||
(compwhen (dyn 'ev/go)
|
||||
|
||||
(defn net/close "Alias for ev/close." [stream] (ev/close stream))
|
||||
|
||||
(defn ev/call
|
||||
@@ -3207,9 +3174,7 @@
|
||||
(,wait-for-fibers ,chan
|
||||
,(seq [[i body] :pairs bodies]
|
||||
~(,ev/go (,fiber/new (fn [] (put ,res ,i ,body)) :tp) nil ,chan)))
|
||||
,res)))
|
||||
|
||||
(undef wait-for-fibers))
|
||||
,res))))
|
||||
|
||||
(compwhen (dyn 'net/listen)
|
||||
(defn net/server
|
||||
@@ -3251,7 +3216,10 @@
|
||||
(defn- use-2 [evaluator args]
|
||||
(each a args (import* (string a) :prefix "" :evaluator evaluator)))
|
||||
|
||||
(defn- evaluator
|
||||
(defn- flycheck-evaluator
|
||||
``An evaluator function that is passed to `run-context` that lints (flychecks) code.
|
||||
This means code will parsed and compiled, macros executed, but the code will not be run.
|
||||
Used by `flycheck`.``
|
||||
[thunk source env where]
|
||||
(when (tuple? source)
|
||||
(def head (source 0))
|
||||
@@ -3265,20 +3233,25 @@
|
||||
(thunk)
|
||||
# Use
|
||||
(= 'use head)
|
||||
(use-2 evaluator (tuple/slice source 1))
|
||||
(use-2 flycheck-evaluator (tuple/slice source 1))
|
||||
# Import-like form
|
||||
(importers head)
|
||||
(let [[l c] (tuple/sourcemap source)
|
||||
newtup (tuple/setmap (tuple ;source :evaluator evaluator) l c)]
|
||||
newtup (tuple/setmap (tuple ;source :evaluator flycheck-evaluator) l c)]
|
||||
((compile newtup env where))))))
|
||||
|
||||
(defn flycheck
|
||||
``Check a file for errors without running the file. Found errors will be printed to stderr
|
||||
in the usual format. Macros will still be executed, however, so
|
||||
arbitrary execution is possible. Other arguments are the same as dofile. `path` can also be
|
||||
a file value such as stdin.``
|
||||
a file value such as stdin. Returns nil.``
|
||||
[path &keys kwargs]
|
||||
(dofile path :evaluator evaluator ;(kvs kwargs)))
|
||||
(try
|
||||
(dofile path :evaluator flycheck-evaluator ;(kvs kwargs))
|
||||
([e f]
|
||||
(eprint e)
|
||||
(debug/stacktrace f)))
|
||||
nil)
|
||||
|
||||
###
|
||||
###
|
||||
@@ -3286,7 +3259,6 @@
|
||||
###
|
||||
###
|
||||
|
||||
|
||||
# conditional compilation for reduced os
|
||||
(def- getenv-alias (if-let [entry (in root-env 'os/getenv)] (entry :value) (fn [&])))
|
||||
|
||||
@@ -3412,23 +3384,6 @@
|
||||
(setdyn :err-color (if *colorize* true))
|
||||
(repl getchunk nil env)))))
|
||||
|
||||
(undef no-side-effects is-safe-def safe-forms importers use-2 getenv-alias)
|
||||
|
||||
###
|
||||
###
|
||||
### Clean up
|
||||
###
|
||||
###
|
||||
|
||||
(do
|
||||
(undef boot/opts undef)
|
||||
(def load-dict (env-lookup root-env))
|
||||
(put load-dict 'boot/config nil)
|
||||
(put load-dict 'boot/args nil)
|
||||
(each [k v] (pairs load-dict)
|
||||
(if (number? v) (put load-dict k nil)))
|
||||
(merge-into load-image-dict load-dict))
|
||||
|
||||
###
|
||||
###
|
||||
### Bootstrap
|
||||
@@ -3446,29 +3401,38 @@
|
||||
(put into k (x k))))
|
||||
into)
|
||||
|
||||
# Modify env based on some options.
|
||||
(loop [[k v] :pairs root-env
|
||||
# Modify root-env to remove private symbols and
|
||||
# flatten nested tables.
|
||||
(loop [[k v] :in (pairs root-env)
|
||||
:when (symbol? k)]
|
||||
(def flat (proto-flatten @{} v))
|
||||
(when (boot/config :no-docstrings)
|
||||
(put flat :doc nil))
|
||||
(when (boot/config :no-sourcemaps)
|
||||
(put flat :source-map nil))
|
||||
(put root-env k flat))
|
||||
|
||||
(if (v :private)
|
||||
(put root-env k nil)
|
||||
(put root-env k flat)))
|
||||
(put root-env 'boot/config nil)
|
||||
(put root-env 'boot/args nil)
|
||||
|
||||
(def image (let [env-pairs (pairs (env-lookup root-env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
# Check no duplicate values
|
||||
(def temp @{})
|
||||
(eachp [k v] lookup
|
||||
(if (in temp v) (errorf "duplicate value: %v" v))
|
||||
(put temp v k))
|
||||
(marshal root-env reverse-lookup)))
|
||||
# Build dictionary for loading images
|
||||
(def load-dict (env-lookup root-env))
|
||||
(each [k v] (pairs load-dict)
|
||||
(if (number? v) (put load-dict k nil)))
|
||||
(merge-into load-image-dict load-dict)
|
||||
|
||||
(def image
|
||||
(let [env-pairs (pairs (env-lookup root-env))
|
||||
essential-pairs (filter (fn [[k v]] (or (cfunction? v) (abstract? v))) env-pairs)
|
||||
lookup (table ;(mapcat identity essential-pairs))
|
||||
reverse-lookup (invert lookup)]
|
||||
# Check no duplicate values
|
||||
(def temp @{})
|
||||
(eachp [k v] lookup
|
||||
(if (in temp v) (errorf "duplicate value: %v" v))
|
||||
(put temp v k))
|
||||
(marshal root-env reverse-lookup)))
|
||||
|
||||
# Create amalgamation
|
||||
|
||||
|
||||
@@ -4,10 +4,10 @@
|
||||
#define JANETCONF_H
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 14
|
||||
#define JANET_VERSION_PATCH 2
|
||||
#define JANET_VERSION_MINOR 15
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_EXTRA ""
|
||||
#define JANET_VERSION "1.14.2"
|
||||
#define JANET_VERSION "1.15.0"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@@ -91,7 +91,7 @@ void janet_buffer_extra(JanetBuffer *buffer, int32_t n) {
|
||||
}
|
||||
int32_t new_size = buffer->count + n;
|
||||
if (new_size > buffer->capacity) {
|
||||
int32_t new_capacity = new_size * 2;
|
||||
int32_t new_capacity = (new_size > (INT32_MAX / 2)) ? INT32_MAX : (new_size * 2);
|
||||
uint8_t *new_data = realloc(buffer->data, new_capacity * sizeof(uint8_t));
|
||||
janet_gcpressure(new_capacity - buffer->capacity);
|
||||
if (NULL == new_data) {
|
||||
|
||||
@@ -872,8 +872,12 @@ static Janet cfun(int32_t argc, Janet *argv) {
|
||||
} else {
|
||||
JanetTable *t = janet_table(4);
|
||||
janet_table_put(t, janet_ckeywordv("error"), janet_wrap_string(res.error));
|
||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
||||
if (res.error_mapping.line > 0) {
|
||||
janet_table_put(t, janet_ckeywordv("line"), janet_wrap_integer(res.error_mapping.line));
|
||||
}
|
||||
if (res.error_mapping.column > 0) {
|
||||
janet_table_put(t, janet_ckeywordv("column"), janet_wrap_integer(res.error_mapping.column));
|
||||
}
|
||||
if (res.macrofiber) {
|
||||
janet_table_put(t, janet_ckeywordv("fiber"), janet_wrap_fiber(res.macrofiber));
|
||||
}
|
||||
|
||||
@@ -1206,7 +1206,8 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
"if native modules are compatible with the host program."));
|
||||
|
||||
/* Allow references to the environment */
|
||||
janet_def(env, "_env", janet_wrap_table(env), JDOC("The environment table for the current scope."));
|
||||
janet_def(env, "root-env", janet_wrap_table(env),
|
||||
JDOC("The root environment used to create environments with (make-env)."));
|
||||
|
||||
janet_load_libs(env);
|
||||
janet_gcroot(janet_wrap_table(env));
|
||||
@@ -1221,22 +1222,7 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
return janet_vm_core_env;
|
||||
}
|
||||
|
||||
/* Load core cfunctions (and some built in janet assembly functions) */
|
||||
JanetTable *dict = janet_table(512);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
JanetTable *dict = janet_core_lookup_table(replacements);
|
||||
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
@@ -1270,3 +1256,23 @@ JanetTable *janet_core_env(JanetTable *replacements) {
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
JanetTable *janet_core_lookup_table(JanetTable *replacements) {
|
||||
JanetTable *dict = janet_table(512);
|
||||
janet_load_libs(dict);
|
||||
|
||||
/* Add replacements */
|
||||
if (replacements != NULL) {
|
||||
for (int32_t i = 0; i < replacements->capacity; i++) {
|
||||
JanetKV kv = replacements->data[i];
|
||||
if (!janet_checktype(kv.key, JANET_NIL)) {
|
||||
janet_table_put(dict, kv.key, kv.value);
|
||||
if (janet_checktype(kv.value, JANET_CFUNCTION)) {
|
||||
janet_table_put(janet_vm_registry, kv.value, kv.key);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return dict;
|
||||
}
|
||||
|
||||
@@ -102,7 +102,9 @@ void janet_stacktrace(JanetFiber *fiber, Janet err) {
|
||||
int32_t fi;
|
||||
const char *errstr = (const char *)janet_to_string(err);
|
||||
JanetFiber **fibers = NULL;
|
||||
int wrote_error = 0;
|
||||
|
||||
/* Don't print error line if it is nil. */
|
||||
int wrote_error = janet_checktype(err, JANET_NIL);
|
||||
|
||||
int print_color = janet_truthy(janet_dyn("err-color"));
|
||||
if (print_color) janet_eprintf("\x1b[31m");
|
||||
@@ -302,7 +304,6 @@ static Janet cfun_debug_stacktrace(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetFiber *fiber = janet_getfiber(argv, 0);
|
||||
Janet x = argc == 1 ? janet_wrap_nil() : argv[1];
|
||||
x = janet_checktype(x, JANET_NIL) ? fiber->last_value : x;
|
||||
janet_stacktrace(fiber, x);
|
||||
return argv[0];
|
||||
}
|
||||
@@ -382,7 +383,7 @@ static const JanetReg debug_cfuns[] = {
|
||||
JDOC("(debug/stacktrace fiber &opt err)\n\n"
|
||||
"Prints a nice looking stacktrace for a fiber. Can optionally provide "
|
||||
"an error value to print the stack trace with. If `err` is nil or not "
|
||||
"provided, will default to `(fiber/last-value fiber)`. Returns the fiber.")
|
||||
"provided, will skipp the error line. Returns the fiber.")
|
||||
},
|
||||
{
|
||||
"debug/lineage", cfun_debug_lineage,
|
||||
|
||||
@@ -393,7 +393,20 @@ static void janet_stream_marshal(void *p, JanetMarshalContext *ctx) {
|
||||
* 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));
|
||||
HANDLE duph = INVALID_HANDLE_VALUE;
|
||||
if (s->flags & JANET_STREAM_SOCKET) {
|
||||
duph = s->handle;
|
||||
} else {
|
||||
DuplicateHandle(
|
||||
GetCurrentProcess(),
|
||||
s->handle,
|
||||
GetCurrentProcess(),
|
||||
&duph,
|
||||
0,
|
||||
FALSE,
|
||||
DUPLICATE_SAME_ACCESS);
|
||||
}
|
||||
janet_marshal_int64(ctx, (int64_t)(duph));
|
||||
#else
|
||||
/* Marshal after dup becuse it is easier than maintaining our own ref counting. */
|
||||
int duph = dup(s->handle);
|
||||
@@ -2314,6 +2327,7 @@ static const JanetReg ev_cfuns[] = {
|
||||
|
||||
void janet_lib_ev(JanetTable *env) {
|
||||
janet_core_cfuns(env, NULL, ev_cfuns);
|
||||
janet_register_abstract_type(&janet_stream_type);
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
@@ -746,6 +746,7 @@ static const JanetReg io_cfuns[] = {
|
||||
"* r - allow reading from the file\n\n"
|
||||
"* w - allow writing to the file\n\n"
|
||||
"* a - append to the file\n\n"
|
||||
"Following one fo the initial flags, 0 or more of the following flags can be appended:\n\n"
|
||||
"* b - open the file in binary mode (rather than text mode)\n\n"
|
||||
"* + - append to the file instead of overwriting it\n\n"
|
||||
"* n - error if the file cannot be opened instead of returning nil")
|
||||
|
||||
@@ -1428,9 +1428,9 @@ static const JanetReg marsh_cfuns[] = {
|
||||
"marshal", cfun_marshal,
|
||||
JDOC("(marshal x &opt reverse-lookup buffer)\n\n"
|
||||
"Marshal a value into a buffer and return the buffer. The buffer "
|
||||
"can the later be unmarshalled to reconstruct the initial value. "
|
||||
"can then later be unmarshalled to reconstruct the initial value. "
|
||||
"Optionally, one can pass in a reverse lookup table to not marshal "
|
||||
"aliased values that are found in the table. Then a forward"
|
||||
"aliased values that are found in the table. Then a forward "
|
||||
"lookup table can be used to recover the original value when "
|
||||
"unmarshalling.")
|
||||
},
|
||||
|
||||
@@ -175,7 +175,14 @@ static void popstate(JanetParser *p, Janet val) {
|
||||
if (newtop->flags & PFLAG_CONTAINER) {
|
||||
newtop->argn++;
|
||||
/* Keep track of number of values in the root state */
|
||||
if (p->statecount == 1) p->pending++;
|
||||
if (p->statecount == 1) {
|
||||
p->pending++;
|
||||
/* Root items are always wrapped in a tuple for source map info. */
|
||||
const Janet *tup = janet_tuple_n(&val, 1);
|
||||
janet_tuple_sm_line(tup) = (int32_t) top.line;
|
||||
janet_tuple_sm_column(tup) = (int32_t) top.column;
|
||||
val = janet_wrap_tuple(tup);
|
||||
}
|
||||
push_arg(p, val);
|
||||
return;
|
||||
} else if (newtop->flags & PFLAG_READERMAC) {
|
||||
@@ -730,6 +737,19 @@ const char *janet_parser_error(JanetParser *parser) {
|
||||
}
|
||||
|
||||
Janet janet_parser_produce(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
ret = janet_unwrap_tuple(parser->args[0])[0];
|
||||
for (i = 1; i < parser->argcount; i++) {
|
||||
parser->args[i - 1] = parser->args[i];
|
||||
}
|
||||
parser->pending--;
|
||||
parser->argcount--;
|
||||
return ret;
|
||||
}
|
||||
|
||||
Janet janet_parser_produce_wrapped(JanetParser *parser) {
|
||||
Janet ret;
|
||||
size_t i;
|
||||
if (parser->pending == 0) return janet_wrap_nil();
|
||||
@@ -910,8 +930,13 @@ static Janet cfun_parse_insert(int32_t argc, Janet *argv) {
|
||||
if (s->flags & PFLAG_COMMENT) s--;
|
||||
if (s->flags & PFLAG_CONTAINER) {
|
||||
s->argn++;
|
||||
if (p->statecount == 1) p->pending++;
|
||||
push_arg(p, argv[1]);
|
||||
if (p->statecount == 1) {
|
||||
p->pending++;
|
||||
Janet tup = janet_wrap_tuple(janet_tuple_n(argv + 1, 1));
|
||||
push_arg(p, tup);
|
||||
} else {
|
||||
push_arg(p, argv[1]);
|
||||
}
|
||||
} else if (s->flags & (PFLAG_STRING | PFLAG_LONGSTRING)) {
|
||||
const uint8_t *str = janet_to_string(argv[1]);
|
||||
int32_t slen = janet_string_length(str);
|
||||
@@ -980,9 +1005,13 @@ static Janet cfun_parse_error(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_parse_produce(int32_t argc, Janet *argv) {
|
||||
janet_fixarity(argc, 1);
|
||||
janet_arity(argc, 1, 2);
|
||||
JanetParser *p = janet_getabstract(argv, 0, &janet_parser_type);
|
||||
return janet_parser_produce(p);
|
||||
if (argc == 2 && janet_truthy(argv[1])) {
|
||||
return janet_parser_produce_wrapped(p);
|
||||
} else {
|
||||
return janet_parser_produce(p);
|
||||
}
|
||||
}
|
||||
|
||||
static Janet cfun_parse_flush(int32_t argc, Janet *argv) {
|
||||
@@ -1217,10 +1246,12 @@ static const JanetReg parse_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"parser/produce", cfun_parse_produce,
|
||||
JDOC("(parser/produce parser)\n\n"
|
||||
JDOC("(parser/produce parser &opt wrap)\n\n"
|
||||
"Dequeue the next value in the parse queue. Will return nil if "
|
||||
"no parsed values are in the queue, otherwise will dequeue the "
|
||||
"next value.")
|
||||
"next value. If `wrap` is truthy, will return a 1-element tuple that "
|
||||
"wraps the result. This tuple can be used for source-mapping "
|
||||
"purposes.")
|
||||
},
|
||||
{
|
||||
"parser/consume", cfun_parse_consume,
|
||||
|
||||
@@ -84,6 +84,9 @@ static JANET_THREAD_LOCAL JanetTable *janet_vm_thread_decode = NULL;
|
||||
static JanetTable *janet_thread_get_decode(void) {
|
||||
if (janet_vm_thread_decode == NULL) {
|
||||
janet_vm_thread_decode = janet_get_core_table("load-image-dict");
|
||||
if (NULL == janet_vm_thread_decode) {
|
||||
janet_vm_thread_decode = janet_table(0);
|
||||
}
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
return janet_vm_thread_decode;
|
||||
|
||||
@@ -108,6 +108,11 @@ void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cf
|
||||
int janet_gettime(struct timespec *spec);
|
||||
#endif
|
||||
|
||||
/* strdup */
|
||||
#ifdef JANET_WINDOWS
|
||||
#define strdup(x) _strdup(x)
|
||||
#endif
|
||||
|
||||
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
|
||||
|
||||
/* Initialize builtin libraries */
|
||||
|
||||
@@ -307,18 +307,14 @@ int32_t janet_hash(Janet x) {
|
||||
hash = janet_struct_hash(janet_unwrap_struct(x));
|
||||
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);
|
||||
}
|
||||
union {
|
||||
double d;
|
||||
uint64_t u;
|
||||
} as;
|
||||
as.d = janet_unwrap_number(x);
|
||||
uint32_t lo = (uint32_t)(as.u & 0xFFFFFFFF);
|
||||
uint32_t hi = (uint32_t)(as.u >> 32);
|
||||
hash = (int32_t)(hi ^ (lo >> 3));
|
||||
break;
|
||||
}
|
||||
case JANET_ABSTRACT: {
|
||||
|
||||
@@ -202,6 +202,20 @@ JANET_THREAD_LOCAL jmp_buf *janet_vm_jmp_buf = NULL;
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
#define vm_compop_imm(op) \
|
||||
{\
|
||||
Janet op1 = stack[B];\
|
||||
if (janet_checktype(op1, JANET_NUMBER)) {\
|
||||
double x1 = janet_unwrap_number(op1);\
|
||||
double x2 = (double) CS; \
|
||||
stack[A] = janet_wrap_boolean(x1 op x2);\
|
||||
vm_pcnext();\
|
||||
} else {\
|
||||
vm_commit();\
|
||||
stack[A] = janet_wrap_boolean(janet_compare(op1, janet_wrap_integer(CS)) op 0);\
|
||||
vm_checkgc_pcnext();\
|
||||
}\
|
||||
}
|
||||
|
||||
/* Trace a function call */
|
||||
static void vm_do_trace(JanetFunction *func, int32_t argc, const Janet *argv) {
|
||||
@@ -780,8 +794,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_compop( <=);
|
||||
|
||||
VM_OP(JOP_LESS_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) < CS);
|
||||
vm_pcnext();
|
||||
vm_compop_imm( <);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN)
|
||||
vm_compop( >);
|
||||
@@ -790,15 +803,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_compop( >=);
|
||||
|
||||
VM_OP(JOP_GREATER_THAN_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) > CS);
|
||||
vm_pcnext();
|
||||
vm_compop_imm( >);
|
||||
|
||||
VM_OP(JOP_EQUALS)
|
||||
stack[A] = janet_wrap_boolean(janet_equals(stack[B], stack[C]));
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) == (double) CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS)
|
||||
@@ -806,7 +818,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
|
||||
stack[A] = janet_wrap_boolean(janet_unwrap_number(stack[B]) != (double) CS);
|
||||
vm_pcnext();
|
||||
|
||||
VM_OP(JOP_COMPARE)
|
||||
@@ -1276,7 +1288,14 @@ Janet janet_call(JanetFunction *fun, int32_t argc, const Janet *argv) {
|
||||
/* Push frame */
|
||||
janet_fiber_pushn(janet_vm_fiber, argv, argc);
|
||||
if (janet_fiber_funcframe(janet_vm_fiber, fun)) {
|
||||
janet_panicf("arity mismatch in %v", janet_wrap_function(fun));
|
||||
int32_t min = fun->def->min_arity;
|
||||
int32_t max = fun->def->max_arity;
|
||||
Janet funv = janet_wrap_function(fun);
|
||||
if (min == max && min != argc)
|
||||
janet_panicf("arity mismatch in %v, expected %d, got %d", funv, min, argc);
|
||||
if (min >= 0 && argc < min)
|
||||
janet_panicf("arity mismatch in %v, expected at least %d, got %d", funv, min, argc);
|
||||
janet_panicf("arity mismatch in %v, expected at most %d, got %d", funv, max, argc);
|
||||
}
|
||||
janet_fiber_frame(janet_vm_fiber)->flags |= JANET_STACKFRAME_ENTRANCE;
|
||||
|
||||
|
||||
@@ -1367,6 +1367,7 @@ JANET_API void janet_parser_deinit(JanetParser *parser);
|
||||
JANET_API void janet_parser_consume(JanetParser *parser, uint8_t c);
|
||||
JANET_API enum JanetParserStatus janet_parser_status(JanetParser *parser);
|
||||
JANET_API Janet janet_parser_produce(JanetParser *parser);
|
||||
JANET_API Janet janet_parser_produce_wrapped(JanetParser *parser);
|
||||
JANET_API const char *janet_parser_error(JanetParser *parser);
|
||||
JANET_API void janet_parser_flush(JanetParser *parser);
|
||||
JANET_API void janet_parser_eof(JanetParser *parser);
|
||||
@@ -1406,6 +1407,7 @@ JANET_API JanetCompileResult janet_compile(Janet source, JanetTable *env, JanetS
|
||||
|
||||
/* Get the default environment for janet */
|
||||
JANET_API JanetTable *janet_core_env(JanetTable *replacements);
|
||||
JANET_API JanetTable *janet_core_lookup_table(JanetTable *replacements);
|
||||
|
||||
JANET_API int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char *sourcePath, Janet *out);
|
||||
JANET_API int janet_dostring(JanetTable *env, const char *str, const char *sourcePath, Janet *out);
|
||||
|
||||
@@ -1042,19 +1042,23 @@ int main(int argc, char **argv) {
|
||||
janet_table_put(env, janet_ckeywordv("executable"), janet_cstringv(argv[0]));
|
||||
|
||||
/* Run startup script */
|
||||
Janet mainfun, out;
|
||||
Janet mainfun;
|
||||
janet_resolve(env, janet_csymbol("cli-main"), &mainfun);
|
||||
Janet mainargs[1] = { janet_wrap_array(args) };
|
||||
JanetFiber *fiber = janet_fiber(janet_unwrap_function(mainfun), 64, 1, mainargs);
|
||||
fiber->env = env;
|
||||
|
||||
#ifdef JANET_EV
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_loop();
|
||||
status = janet_fiber_status(fiber);
|
||||
#else
|
||||
Janet out;
|
||||
status = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (status != JANET_SIGNAL_OK && status != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, out);
|
||||
}
|
||||
|
||||
#ifdef JANET_EV
|
||||
status = JANET_SIGNAL_OK;
|
||||
janet_loop();
|
||||
#endif
|
||||
|
||||
/* Deinitialize vm */
|
||||
|
||||
@@ -137,4 +137,10 @@
|
||||
(assert (deep= (string/split "qq" "1qqqqz") @["1" "" "z"]) "string/split 1")
|
||||
(assert (deep= (string/split "aa" "aaa") @["" "a"]) "string/split 2")
|
||||
|
||||
# Comparisons
|
||||
(assert (> 1e23 100) "less than immediate 1")
|
||||
(assert (> 1e23 1000) "less than immediate 2")
|
||||
(assert (< 100 1e23) "greater than immediate 1")
|
||||
(assert (< 1000 1e23) "greater than immediate 2")
|
||||
|
||||
(end-suite)
|
||||
|
||||
Reference in New Issue
Block a user