1
0
mirror of https://github.com/janet-lang/janet synced 2025-10-29 06:37:41 +00:00

Compare commits

..

86 Commits

Author SHA1 Message Date
Calvin Rose
fa55283f62 Release 1.11.0 2020-07-18 16:21:01 -05:00
Calvin Rose
9e163db491 Test building binaries with jpm.
Test in CI with both meson and normal build.
Also test windows.
2020-07-18 15:50:58 -05:00
Calvin Rose
286230f477 Fix meson paths. 2020-07-18 15:44:04 -05:00
Calvin Rose
3ba2c7e7e8 Address #394 and #451 - Prepare for 1.11.0
Prefix MANPATH and PKG_CONFIG_PATH variables
with JANET_ to disassociate with standard env variables
that have a different format.
2020-07-18 13:09:53 -05:00
Calvin Rose
b4f5e5bc00 Update docs for -l option. 2020-07-06 21:25:41 -05:00
Calvin Rose
f580d2e41a Add forever macro and add names to anon fns.
Adding names to anon functions that may error improves
stack traces, especially for user visible traces.
2020-07-06 19:26:37 -05:00
Calvin Rose
a1feb32a2f Update CHANGELOG.md 2020-07-06 17:21:55 -05:00
Calvin Rose
7478ad115f Add any? predicate to core.
This is the contrapositive to `every?`, and is analagous to `or` as
`every?` is to `and`.
2020-07-06 09:19:10 -05:00
Calvin Rose
9d8e338a11 Update default repl prompt to match errors. 2020-07-05 23:32:59 -05:00
Calvin Rose
ed4163cfde Replace copyright on boot with system information. 2020-07-05 23:24:07 -05:00
Calvin Rose
463e6d9316 Merge pull request #448 from GrayJack/fix-table-remove
Fix janet_table_remove returning the key instead of the value
2020-07-05 18:36:54 -05:00
Calvin Rose
3358811788 Update changelog and sort listing. 2020-07-05 17:51:49 -05:00
Calvin Rose
a45509d28e Add list-pkgs and list-installed to jpm. 2020-07-05 17:43:39 -05:00
Calvin Rose
68a12d1d17 Minor fixes for meson minimum build.
Also, fix regression that looses function name information.
2020-07-03 20:41:55 -05:00
Calvin Rose
c97d3cf359 Fix minimum meson build. 2020-07-03 20:30:09 -05:00
Calvin Rose
4721337c7c issues with gettime on mach kernel. 2020-07-03 20:19:36 -05:00
Calvin Rose
2b36ed967c Address some windows issues. 2020-07-03 20:13:49 -05:00
Calvin Rose
3bb8f1ac8d Don't use CLOCK_MONOTONIC for pthread stuff.
Also fix marshalling functions without full
sourcemapping information, as well as thread/receive
ignoring bad messages. Instead, thread/receive will error
on bad messages.
2020-07-03 19:54:58 -05:00
Calvin Rose
617ec7f565 Threading improvements.
- Add thread/exit to kill the current thread.
- Add global lock aroung custom getline and add atexit handler
- to prevent any possible issues when exiting program.
- Allow sending stderr, stdout, and stdin over thread.
2020-07-03 16:28:07 -05:00
Calvin Rose
dc259b9f8e Set fiber env for heavyweight threads.
Since you already incur the cost of creating the
core environment, this is probably what you want anyways.
This will make eval and other reflective code work as expected.
2020-07-03 15:20:19 -05:00
Calvin Rose
7b31a87b3c Update integer limits and printing. 2020-07-03 14:14:59 -05:00
Calvin Rose
6ea530cc48 Address compilation warnings and errors. 2020-07-03 12:25:24 -05:00
Calvin Rose
55cf9f5e1c Don't break reverse backwards compat.
Breaking backwards compatibiliy here is not worth it.
Also update changelog.
2020-07-03 10:17:50 -05:00
Calvin Rose
b89f0fac7b Move clock shims to util (Helps #430).
The thread module should also use these clock shims rather
than clock_gettime, which is not available on older mac systems.
2020-07-03 09:54:58 -05:00
GrayJack
8b3b3182bd Add tests to check janet_table_remove behaviour 2020-07-02 11:03:08 -03:00
Calvin Rose
97c64f27ff Remove duplicate code in loop macro.
Also evaluate for loop and range step exactly once.
Multiple evaluations can be inefficent and make infinite loop
detection impossible.
2020-07-01 22:37:04 -05:00
Calvin Rose
e548e1f6e0 Add peg/replace and peg/replace-all 2020-07-01 21:29:24 -05:00
GrayJack
7ea1c7d85a Fix janet_table_remove returning the key instead of the value 2020-07-01 20:05:07 -03:00
Calvin Rose
e08235b575 Merge pull request #436 from cellularmitosis/no_arc4random_buf
Add support for systems which are missing arc4random_buf
2020-07-01 15:54:15 -05:00
Calvin Rose
783c672130 Merge pull request #437 from pepe/add-peg-find-tests
Add tests for peg/find and peg/find-all
2020-07-01 15:48:43 -05:00
Calvin Rose
5351a6b2ed Merge pull request #447 from cellularmitosis/nan
math/nan
2020-07-01 15:47:13 -05:00
Jason Pepas
a110b103e8 math/nan 2020-07-01 15:35:36 -05:00
Josef Pospíšil
c26f573620 Add tests for peg/find and peg/find-all 2020-06-30 17:03:13 +02:00
Jason Pepas
f06e9ae30c Switch to using /dev/urandom for OS X prior to 10.7 2020-06-30 04:18:08 -05:00
Jason Pepas
f5d208d5d6 eliminate large stack allocation from arc4random_buf bodge 2020-06-30 04:06:20 -05:00
Calvin Rose
7fb8c4a68d Merge branch 'master' of github.com:janet-lang/janet 2020-06-29 22:57:46 -05:00
Calvin Rose
647fc56d47 Replace for with forv in most places in boot.janet
Generates slightly better bytecode with current compiler
(gets rid of a single extra move instruction per loop iteration).
2020-06-29 22:56:16 -05:00
Jason Pepas
597d84e263 Add support for systems missing arc4random_buf 2020-06-29 21:06:13 -05:00
Calvin Rose
977b0c3c0c Merge pull request #429 from pepe/fix-reverse-doc
Tune reverse[d] docstrings
2020-06-29 20:55:04 -05:00
Calvin Rose
1b0d6de735 Merge pull request #432 from cellularmitosis/no_cloexec
Support for systems missing O_CLOEXEC
2020-06-29 20:54:41 -05:00
Calvin Rose
2f5bb7774e Fix recursive post-deps. 2020-06-29 20:51:38 -05:00
Jason Pepas
5565f02dbd Simplifying workaround for missing O_CLOEXEC 2020-06-29 19:36:18 -05:00
Calvin Rose
17a131ac21 Add peg/find and peg/find-all.
These peg functions should make pegs a bit easier to use
and more efficient in some common cases.
2020-06-29 19:13:06 -05:00
Calvin Rose
9a5cfe9f75 Merge branch 'master' of github.com:janet-lang/janet 2020-06-29 13:47:02 -05:00
Calvin Rose
cc936d9977 Merge pull request #435 from pepe/add-keyword-symbol-slice-tests
Add keyword/slice and symbol/slice tests
2020-06-29 09:11:35 -05:00
Josef Pospíšil
e9911fee4d Add keyword/slice and symbol/slice tests 2020-06-29 09:18:26 +02:00
Calvin Rose
aefde67aa2 And lots of optimization functionality. 2020-06-28 18:16:57 -05:00
Calvin Rose
a1ea62a923 Fix optimization of do_get.
When the target slot (register) is the same as the default
register, do not clobber it.
2020-06-28 15:52:59 -05:00
Calvin Rose
7209ced446 Merge branch 'master' of github.com:janet-lang/janet 2020-06-28 15:09:01 -05:00
Calvin Rose
db63d352a2 Add specialization for 3 argument get.
This can be inlined with jmpnn instruction (jump if not nil) to
skip over the default value.

(get a b c)

can be exanded statically to

asm start:
    (get $0 $1 $2)
    (jmpnn $0 :label)
    ... Instructions to load default value to $0 - often a load.
    :label
asm end.
2020-06-28 15:03:01 -05:00
Josef Pospíšil
289de840fd Specify input types actions 2020-06-28 20:49:44 +02:00
Calvin Rose
cb34a8b620 Merge pull request #434 from elimisteve/master
Add .gitattributes: syntax highlight .janet files as Clojure
2020-06-27 17:01:45 -05:00
Calvin Rose
95c633914f Add auto-resizing of gc interval.
This should prevent over use of GC and O(n^2)
behavior.
2020-06-27 16:51:20 -05:00
Calvin Rose
d033412b1f Add symbol/slice and keyword/slice 2020-06-27 15:22:15 -05:00
Calvin Rose
9c5e97144d More small changes to help with cross compilation
via makefile. Add option to turn off built in
getline via janetconf.
2020-06-27 12:39:16 -05:00
Calvin Rose
8b96289e2f Merge branch 'master' of github.com:janet-lang/janet 2020-06-27 11:24:03 -05:00
Calvin Rose
51ff43e2f2 Update range checks for 64 bit integers. 2020-06-27 11:23:47 -05:00
Calvin Rose
1e30f4f973 Merge pull request #427 from pyrmont/nil-empty-string
Change default string representation of nil to empty string
2020-06-26 22:47:16 -05:00
Calvin Rose
36f66661f7 Merge pull request #431 from cellularmitosis/master
Add ppc to os/arch
2020-06-26 22:43:41 -05:00
Steve Phillips
de27fc15b6 Add .gitattributes: detect/syntax highlight .janet files as Clojure 2020-06-26 20:31:42 -07:00
Jason Pepas
f9f90ba1d6 Support for systems missing O_CLOEXEC 2020-06-26 14:44:57 -05:00
Jason Pepas
51bf8a3538 Add ppc to os/arch 2020-06-26 04:11:21 -05:00
Josef Pospíšil
7b033a48a3 Wrap both reverse and reversed docstring to 80 chr 2020-06-25 09:43:10 +02:00
Josef Pospíšil
1b420f69aa Fix reverse docstring 2020-06-25 09:35:03 +02:00
Calvin Rose
6a187a384b Make zipcoll more generic.
Work with any iterable (next) type.
2020-06-24 16:10:57 -05:00
Calvin Rose
ac5de1f96e Change compare-primitive to cmp.
cmp is implemented as a VM instruction rather than
a function.
2020-06-24 16:00:00 -05:00
Calvin Rose
6c917f686a Add :h default peg class, as well as ad \v to whitespace. 2020-06-24 08:40:23 -05:00
Calvin Rose
de9951594e Allow setting dynamic bindings at C top level.
Before, these bindings we just ignored. However, it useful for
controlling janet_printf and janet_eprintf, for example. These can
be called from C code without being inside a call to janet_continue.
2020-06-22 08:56:04 -05:00
Calvin Rose
561fc15ae9 Address #426 parse errors in *out janet_dostring
This should make its use a little more robust for
simple usage. To avoid printing to stderr, use

janet_table_put(env, janet_ckeywordv("err"), janet_wrap_false());
2020-06-22 08:34:17 -05:00
Calvin Rose
d65814c53f Update changelog.md 2020-06-21 18:52:10 -05:00
Calvin Rose
803f17aa90 Add eachy and repeat to make looping easier.
Like eachk and eachp, use eachy and repeat to bring loop
verbs outside of the loop macro. These new macros are very simple
and easy to understand, in contrast to the loop macro which is of
medium complexity.
2020-06-21 18:48:06 -05:00
Calvin Rose
08a3687eb5 Fix #428
Add binding check for generate verb in loops. The check is present
in other loop verbs.
2020-06-21 15:57:55 -05:00
Michael Camilleri
c4035b2273 Change string representation of nil to empty string 2020-06-21 17:54:06 +09:00
Calvin Rose
5c364e0f7c Better roundtrip jdn.
Use the most precise format specifier, such that output jdn numbers
are more accurate.
2020-06-18 21:54:34 -05:00
Calvin Rose
9cfc3d9d37 Update to 1.10.1 2020-06-18 19:24:17 -05:00
Calvin Rose
b5fdd30b77 Fix meson build version. 2020-06-18 18:43:10 -05:00
Calvin Rose
280292d3f5 Update CHANGELOG.md 2020-06-18 18:41:09 -05:00
Calvin Rose
c593d864be Merge branch 'master' of github.com:janet-lang/janet 2020-06-18 18:38:17 -05:00
Calvin Rose
6d17348c72 Merge pull request #425 from pyrmont/bugfix.make-install-paths-fn
Make install-paths a function
2020-06-18 15:13:36 -05:00
Michael Camilleri
536648ec19 Use function for install-paths 2020-06-18 19:07:43 +09:00
Calvin Rose
b5e32a9ce5 Expose janet_table_clear. 2020-06-15 15:33:41 -05:00
Calvin Rose
4077822e37 Update changelog. 2020-06-15 11:54:51 -05:00
Calvin Rose
e2d8750625 Update jpm.
Silence git warnings on git pull, and fix issue with double
dependencies in rules.
2020-06-15 11:22:32 -05:00
Calvin Rose
79f5751375 Add array/trim and buffer/trim. 2020-06-14 17:40:48 -05:00
Calvin Rose
106437bd45 Fixes #423
Re-add ifdef for realpath config option.
2020-06-14 15:50:09 -05:00
Calvin Rose
b7cd13bb0b Fix changelog typo. 2020-06-14 15:10:54 -05:00
48 changed files with 1090 additions and 386 deletions

View File

@@ -10,3 +10,5 @@ tasks:
cd build
ninja
ninja test
mkdir modpath
jpm --verbose --modpath=./modpath install https://github.com/bakpakin/x43bot.git

View File

@@ -17,7 +17,7 @@ tasks:
meson configure -Dpeg=false
meson configure -Dassembler=false
meson configure -Dint_types=false
meson configure -Dtyped_arrays=false
meson configure -Dtyped_array=false
meson configure -Dreduced_os=true
meson configure -Dprf=false
ninja # will not pass tests but should build

1
.gitattributes vendored Normal file
View File

@@ -0,0 +1 @@
*.janet linguist-language=Clojure

View File

@@ -1,7 +1,38 @@
# Changelog
All notable changes to this project will be documented in this file.
## 1.10.1 - 2020-06-14
## 1.11.0 - 2020-07-18
- Add `forever` macro.
- Add `any?` predicate to core.
- Add `jpm list-pkgs` subcommand to see which package aliases are in the listing.
- Add `jpm list-installed` subcommand to see which packages are installed.
- Add `math/int-min`, `math/int-max`, `math/int32-min`, and `math/int32-max` for getting integer limits.
- The gc interval is now autotuned, to prevent very bad gc behavior.
- Improvements to the bytecode compiler, Janet will now generate more efficient bytecode.
- Add `peg/find`, `peg/find-all`, `peg/replace`, and `peg/replace-all`
- Add `math/nan`
- Add `forv` macro
- Add `symbol/slice`
- Add `keyword/slice`
- Allow cross compilation with Makefile.
- Change `compare-primitve` to `cmp` and make it more efficient.
- Add `reverse!` for reversing an array or buffer in place.
- `janet_dobytes` and `janet_dostring` return parse errors in \*out
- Add `repeat` macro for iterating something n times.
- Add `eachy` (each yield) macro for iterating a fiber.
- Fix `:generate` verb in loop macro to accept non symbols as bindings.
- Add `:h`, `:h+`, and `:h*` in `default-peg-grammar` for hexidecimal digits.
- Fix `%j` formatter to print numbers precisely (using the `%.17g` format string to printf).
## 1.10.1 - 2020-06-18
- Expose `janet_table_clear` in API.
- Respect `JANET_NO_PROCESSES` define when building
- Fix `jpm` rules having multiple copies of the same dependency.
- Fix `jpm` install in some cases.
- Add `array/trim` and `buffer/trim` to shrink the backing capacity of these types
to their current length.
## 1.10.0 - 2020-06-14
- Hardcode default jpm paths on install so env variables are needed in fewer cases.
- Add `:no-compile` to `create-executable` option for jpm.
- Fix bug with the `trace` function.

View File

@@ -33,13 +33,20 @@ JANET_TARGET=build/janet
JANET_LIBRARY=build/libjanet.so
JANET_STATIC_LIBRARY=build/libjanet.a
JANET_PATH?=$(LIBDIR)/janet
MANPATH?=$(PREFIX)/share/man/man1/
PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
JANET_MANPATH?=$(PREFIX)/share/man/man1/
JANET_PKG_CONFIG_PATH?=$(LIBDIR)/pkgconfig
DEBUGGER=gdb
SONAME_SETTER=-Wl,-soname,
CFLAGS:=$(CFLAGS) -std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fPIC -O2 -fvisibility=hidden
LDFLAGS:=$(LDFLAGS) -rdynamic
# For cross compilation
HOSTCC?=$(CC)
HOSTAR?=$(AR)
CFLAGS?=-fPIC -O2
LDFLAGS?=-rdynamic
COMMON_CFLAGS:=-std=c99 -Wall -Wextra -Isrc/include -Isrc/conf -fvisibility=hidden
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) -O0 -g $(COMMON_CFLAGS)
BUILD_CFLAGS:=$(CFLAGS) $(COMMON_CFLAGS)
# For installation
LDCONFIG:=ldconfig "$(LIBDIR)"
@@ -131,7 +138,6 @@ JANET_BOOT_HEADERS=src/boot/tests.h
##########################################################
JANET_BOOT_OBJECTS=$(patsubst src/%.c,build/%.boot.o,$(JANET_CORE_SOURCES) $(JANET_BOOT_SOURCES))
BOOT_CFLAGS:=-DJANET_BOOTSTRAP -DJANET_BUILD=$(JANET_BUILD) $(CFLAGS)
$(JANET_BOOT_OBJECTS): $(JANET_BOOT_HEADERS)
@@ -161,24 +167,26 @@ build/janetconf.h: src/conf/janetconf.h
cp $< $@
build/janet.o: build/janet.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
build/shell.o: build/shell.c build/janet.h build/janetconf.h
$(CC) $(CFLAGS) -c $< -o $@ -I build
$(HOSTCC) $(BUILD_CFLAGS) -c $< -o $@ -I build
$(JANET_TARGET): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) -o $@ $^ $(CLIBS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) -o $@ $^ $(CLIBS)
$(JANET_LIBRARY): build/janet.o build/shell.o
$(CC) $(LDFLAGS) $(CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(HOSTCC) $(LDFLAGS) $(BUILD_CFLAGS) $(SONAME_SETTER)$(SONAME) -shared -o $@ $^ $(CLIBS)
$(JANET_STATIC_LIBRARY): build/janet.o build/shell.o
$(AR) rcs $@ $^
$(HOSTAR) rcs $@ $^
###################
##### Testing #####
###################
# Testing assumes HOSTCC=CC
TEST_SCRIPTS=$(wildcard test/suite*.janet)
repl: $(JANET_TARGET)
@@ -264,11 +272,11 @@ install: $(JANET_TARGET) build/janet.pc build/jpm
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
mkdir -p '$(DESTDIR)$(MANPATH)'
cp janet.1 '$(DESTDIR)$(MANPATH)'
cp jpm.1 '$(DESTDIR)$(MANPATH)'
mkdir -p '$(DESTDIR)$(PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
mkdir -p '$(DESTDIR)$(JANET_MANPATH)'
cp janet.1 '$(DESTDIR)$(JANET_MANPATH)'
cp jpm.1 '$(DESTDIR)$(JANET_MANPATH)'
mkdir -p '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)'
cp build/janet.pc '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
[ -z '$(DESTDIR)' ] && $(LDCONFIG) || true
uninstall:
@@ -276,9 +284,9 @@ uninstall:
-rm '$(DESTDIR)$(BINDIR)/jpm'
-rm -rf '$(DESTDIR)$(INCLUDEDIR)/janet'
-rm -rf '$(DESTDIR)$(LIBDIR)'/libjanet.*
-rm '$(DESTDIR)$(PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(MANPATH)/janet.1'
-rm '$(DESTDIR)$(MANPATH)/jpm.1'
-rm '$(DESTDIR)$(JANET_PKG_CONFIG_PATH)/janet.pc'
-rm '$(DESTDIR)$(JANET_MANPATH)/janet.1'
-rm '$(DESTDIR)$(JANET_MANPATH)/jpm.1'
# -rm -rf '$(DESTDIR)$(JANET_PATH)'/* - err on the side of correctness here
#################
@@ -309,6 +317,7 @@ test-install:
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/jhydro.git
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/path.git
cd test/install && jpm --verbose --test --modpath=./modpath install https://github.com/janet-lang/argparse.git
cd test/install && jpm --verbose --modpath=./modpath install https://github.com/bakpakin/x43bot.git
help:
@echo

View File

@@ -168,6 +168,8 @@ call jpm --verbose --test --modpath=. install https://github.com/janet-lang/path
@if errorlevel 1 goto :TESTINSTALLFAIL
call jpm --verbose --test --modpath=. install https://github.com/janet-lang/argparse.git
@if errorlevel 1 goto :TESTINSTALLFAIL
call jpm --verbose --modpath=. install https://github.com/bakpakin/x43bot.git
@if errorlevel 1 goto :TESTINSTALLFAIL
popd
exit /b 0

View File

@@ -194,8 +194,8 @@ Source should be a path to the Janet module to compile, and output should be the
resulting image. Output should usually end with the .jimage extension.
.TP
.BR \-l\ path
Load a Janet file before running a script or repl. Multiple files can be loaded
.BR \-l\ lib
Import a Janet module before running a script or repl. Multiple files can be loaded
in this manner, and exports from each file will be made available to the script
or repl.

149
jpm
View File

@@ -29,7 +29,7 @@
(def i (last (string/find-all sep exe)))
(slice exe 0 i)))
(def- install-paths
(defn- install-paths []
{:headerpath (os/realpath (string exe-dir "/../include/janet"))
:libpath (os/realpath (string exe-dir "/../lib"))
:binpath exe-dir})
@@ -38,16 +38,16 @@
# Default based on janet binary location
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
(get install-paths :headerpath)))
(get (install-paths) :headerpath)))
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
(get install-paths :libpath)))
(get (install-paths) :libpath)))
# We want setting JANET_PATH to contain installed binaries. However, it is convenient
# to have globally installed binaries got to the same place as jpm itself, which is on
# the $PATH.
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
(if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
(if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
(get install-paths :binpath)))
(get (install-paths) :binpath)))
# modpath should only be derived from the syspath being used or an environment variable.
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
@@ -76,11 +76,13 @@
(defn rm
"Remove a directory and all sub directories."
[path]
(if (= (os/lstat path :mode) :directory)
(do
(case (os/lstat path :mode)
:directory (do
(each subpath (os/dir path)
(rm (string path sep subpath)))
(os/rmdir path))
nil nil # do nothing if file does not exist
# Default, try to remove
(os/rm path)))
(defn- rimraf
@@ -88,7 +90,8 @@
[path]
(if is-win
# windows get rid of read-only files
(os/shell (string `rmdir /S /Q "` path `"`))
(when (os/stat path :mode)
(os/shell (string `rmdir /S /Q "` path `"`)))
(rm path)))
(defn clear-cache
@@ -185,9 +188,27 @@
(unless item (error (string "No rule for target " target)))
item)
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(unless (find |(= dep $) deps)
(array/push deps dep)))
(defn- add-thunk
[target more &opt phony]
(def item (gettarget target))
(def [_ thunks pthunks] item)
(array/push (if phony pthunks thunks) more)
item)
(defn- rule-impl
[target deps thunk &opt phony]
(put (getrules) target @[(array/slice deps) @[thunk] phony]))
(def rules (getrules))
(unless (rules target) (put rules target @[(array/slice deps) @[] @[]]))
(each d deps (add-dep target d))
(add-thunk target thunk phony))
(defmacro rule
"Add a rule to the rule graph."
@@ -211,20 +232,6 @@
[target deps & body]
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/shell (,string ,;body))))) true))
(defn add-dep
"Add a dependency to an existing rule. Useful for extending phony
rules or extending the dependency graph of existing rules."
[target dep]
(def [deps] (gettarget target))
(array/push deps dep))
(defn- add-thunk
[target more]
(def item (gettarget target))
(def [_ thunks] item)
(array/push thunks more)
item)
(defmacro add-body
"Add recipe code to an existing rule. This makes existing rules do more but
does not modify the dependency graph."
@@ -254,9 +261,11 @@
(error (string "No rule for file " target " found."))))
(def [deps thunks phony] item)
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
(when (or phony (needs-build-some target realdeps))
(each thunk thunks (thunk)))
(unless phony target))
(each thunk phony (thunk))
(unless (empty? thunks)
(when (needs-build-some target realdeps)
(each thunk thunks (thunk))
target)))
#
# Importing a file
@@ -743,12 +752,12 @@ int main(int argc, const char **argv) {
:binpath (abspath (dyn :binpath JANET_BINPATH))]
(os/cd module-dir)
(unless fresh
(os/execute [(git-path) "pull" "origin" "master"] :p))
(os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
(when tag
(os/execute [(git-path) "reset" "--hard" tag] :p))
(unless (dyn :offline)
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
(import-rules "./project.janet")
(import-rules "./project.janet" true)
(unless no-deps (do-rule "install-deps"))
(do-rule "build")
(do-rule "install"))
@@ -762,9 +771,9 @@ int main(int argc, const char **argv) {
(def name (last parts))
(def path (string destdir sep name))
(array/push (dyn :installed-files) path)
(add-body "install"
(mkdir destdir)
(copy src destdir)))
(phony "install" []
(mkdir destdir)
(copy src destdir)))
(defn- make-lockfile
[&opt filename]
@@ -928,7 +937,7 @@ int main(int argc, const char **argv) {
(def name (last parts))
(def path (string binpath sep name))
(array/push (dyn :installed-files) path)
(add-body "install"
(phony "install" []
(def contents
(with [f (file/open main)]
(def first-line (:read f :line))
@@ -946,7 +955,7 @@ int main(int argc, const char **argv) {
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
(def newname (string binpath sep name ".bat"))
(array/push (dyn :installed-files) newname)
(add-body "install"
(phony "install" []
(spit newname bat))))
(defn- print-rule-tree
@@ -993,7 +1002,8 @@ int main(int argc, const char **argv) {
(phony "build" [])
(phony "manifest" []
(phony "manifest" [manifest])
(rule manifest []
(print "generating " manifest "...")
(mkdir manifests)
(def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
@@ -1005,7 +1015,7 @@ int main(int argc, const char **argv) {
:paths installed-files})
(spit manifest (string/format "%j\n" man)))
(phony "install" ["uninstall" "build" "manifest"]
(phony "install" ["uninstall" "build" manifest]
(when (dyn :test)
(do-rule "test"))
(print "Installed as '" (meta :name) "'."))
@@ -1059,36 +1069,50 @@ usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
Run from a directory containing a project.janet file to perform operations
on a project, or from anywhere to do operations on the global module cache (modpath).
Commands that need write permission to the modpath are considered privileged commands - in
some environments they may require super user privileges.
Other project-level commands need to have a ./project.janet file in the current directory.
Subcommands are:
build : build all artifacts
Unprivileged global subcommands:
help : show this help text
show-paths : prints the paths that will be used to install things.
quickbin entry executable : Create an executable from a janet script with a main function.
Privileged global subcommands:
install (repo or name)... : install artifacts. If a repo is given, install the contents of that
git repository, assuming that the repository is a jpm project. If not, build
and install the current project.
uninstall (module)... : uninstall a module. If no module is given, uninstall the module
defined by the current directory.
show-paths : prints the paths that will be used to install things.
clean : remove any generated files or artifacts
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
deps : install dependencies for the current project.
clear-cache : clear the git cache. Useful for updating dependencies.
clear-manifest : clear the manifest. Useful for fixing broken installs.
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
Optinally provide a root rule to start printing from, and a
max depth to print. Without these options, all rules will print
their full dependency tree.
update-pkgs : Update the current package listing from the remote git repository selected.
quickbin entry executable : Create an executable from a janet script with a main function.
make-lockfile (lockfile) : Create a lockfile based on repositories in the cache. The
lockfile will record the exact versions of dependencies used to ensure a reproducible
build. Lockfiles are best used with applications, not libraries. The default lockfile
name is lockfile.jdn.
load-lockfile (lockfile) : Install modules from a lockfile in a reproducible way. The
default lockfile name is lockfile.jdn.
update-pkgs : Update the current package listing from the remote git repository selected.
Privileged project subcommands:
deps : install dependencies for the current project.
install : install artifacts of the current project.
uninstall : uninstall the current project's artifacts.
Unprivileged project subcommands:
build : build all artifacts
clean : remove any generated files or artifacts
test : run tests. Tests should be .janet files in the test/ directory relative to project.janet.
run rule : run a rule. Can also run custom rules added via (phony "task" [deps...] ...)
or (rule "ouput.file" [deps...] ...).
rules : list rules available with run.
list-installed : list installed packages in the current syspath.
list-pkgs (search) : list packages in the package listing that the contain the string search.
If no search pattern is given, prints the entire package listing.
rule-tree (root rule) (depth) : Print a nice tree to see what rules depend on other rules.
Optionally provide a root rule to start printing from, and a
max depth to print. Without these options, all rules will print
their full dependency tree.
debug-repl : Run a repl in the context of the current project.janet file. This lets you run rules and
otherwise debug the current project.janet file.
@@ -1161,10 +1185,33 @@ Flags are:
(defn list-rules
[&opt ctx]
(import-rules "./project.janet" true)
(import-rules "./project.janet")
(def ks (sort (seq [k :keys (dyn :rules)] k)))
(each k ks (print k)))
(defn list-installed
[]
(def xs
(seq [x :in (os/dir (find-manifest-dir))
:when (string/has-suffix? ".jdn" x)]
(string/slice x 0 -5)))
(sort xs)
(each x xs (print x)))
(defn list-pkgs
[&opt search]
(def [ok _] (module/find "pkgs"))
(unless ok
(eprint "no local package listing found. Run `jpm update-pkgs` to get listing.")
(os/exit 1))
(def pkgs-mod (require "pkgs"))
(def ps
(seq [p :keys (get-in pkgs-mod ['packages :value] [])
:when (if search (string/find search p) true)]
p))
(sort ps)
(each p ps (print p)))
(defn update-pkgs
[]
(install-git (dyn :pkglist default-pkglist)))
@@ -1206,6 +1253,8 @@ Flags are:
"debug-repl" jpm-debug-repl
"rule-tree" show-rule-tree
"show-paths" show-paths
"list-installed" list-installed
"list-pkgs" list-pkgs
"clear-cache" clear-cache
"clear-manifest" clear-manifest
"run" local-rule

9
jpm.1
View File

@@ -139,6 +139,15 @@ date or too large, clear-cache will remove the cache and jpm will rebuild it
when needed. clear-cache is a global command, so a project.janet is not
required.
.TP
.BR list-installed
List all installed packages in the current syspath.
.TP
.BR list-pkgs [\fBsearch\fR]
List all package aliases in the current package listing that contain the given search string.
If no search string is given, prints the entire listing.
.TP
.BR clear-manifest
jpm creates a manifest directory that contains a list of all installed files.

View File

@@ -20,7 +20,7 @@
project('janet', 'c',
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
version : '1.10.0')
version : '1.11.0')
# Global settings
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
@@ -257,6 +257,6 @@ if get_option('peg') and not get_option('reduced_os') and get_option('processes'
output : ['jpm'],
command : [janet_nativeclient, '@INPUT@', '@OUTPUT@',
'--binpath=' + join_paths(get_option('prefix'), get_option('bindir')),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir'), 'janet'),
'--libpath=' + join_paths(get_option('prefix'), get_option('libdir')),
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
endif

View File

@@ -99,7 +99,7 @@
(defn array? "Check if x is an array." [x] (= (type x) :array))
(defn tuple? "Check if x is a tuple." [x] (= (type x) :tuple))
(defn boolean? "Check if x is a boolean." [x] (= (type x) :boolean))
(defn bytes? "Check if x is a string, symbol, or buffer." [x]
(defn bytes? "Check if x is a string, symbol, keyword, or buffer." [x]
(def t (type x))
(if (= t :string) true (if (= t :symbol) true (if (= t :keyword) true (= t :buffer)))))
(defn dictionary? "Check if x a table or struct." [x]
@@ -112,7 +112,7 @@
(defn true? "Check if x is true." [x] (= x true))
(defn false? "Check if x is false." [x] (= x false))
(defn nil? "Check if x is nil." [x] (= x nil))
(defn empty? "Check if xs is empty." [xs] (= 0 (length xs)))
(defn empty? "Check if xs is empty." [xs] (= (length xs) 0))
(def idempotent?
"(idempotent? x)\n\nCheck if x is a value that evaluates to itself when compiled."
@@ -379,16 +379,27 @@
,(apply defer [(or dtor :close) binding] [truthy])
,falsey))
(defn- for-template
[binding start stop step comparison delta body]
(with-syms [i s]
(defn- for-var-template
[i start stop step comparison delta body]
(with-syms [s]
(def st (if (idempotent? step) step (gensym)))
(def loop-body
~(while (,comparison ,i ,s)
,;body
(set ,i (,delta ,i ,st))))
~(do
(var ,i ,start)
(def ,s ,stop)
(while (,comparison ,i ,s)
(def ,binding ,i)
,;body
(set ,i (,delta ,i ,step))))))
,;(if (= st step) [] [~(def ,st ,step)])
,(if (and (number? st) (> st 0))
loop-body
~(if (,> ,st 0) ,loop-body)))))
(defn- for-template
[binding start stop step comparison delta body]
(def i (gensym))
(for-var-template i start stop step comparison delta
[~(def ,binding ,i) ;body]))
(defn- check-indexed [x]
(if (indexed? x)
@@ -401,26 +412,18 @@
(for-template binding start stop (or step 1) comparison op [rest])))
(defn- each-template
[binding inx body]
[binding inx kind body]
(with-syms [k]
(def ds (if (idempotent? inx) inx (gensym)))
~(do
,(unless (= ds inx) ~(def ,ds ,inx))
(var ,k (,next ,ds nil))
(while (,not= nil ,k)
(def ,binding (,in ,ds ,k))
,;body
(set ,k (,next ,ds ,k))))))
(defn- keys-template
[binding in pair? body]
(with-syms [k]
(def ds (if (idempotent? in) in (gensym)))
~(do
,(unless (= ds in) ~(def ,ds ,in))
(var ,k (,next ,ds nil))
(while (,not= nil ,k)
(def ,binding ,(if pair? ~(tuple ,k (in ,ds ,k)) k))
(def ,binding
,(case kind
:each ~(,in ,ds ,k)
:keys k
:pairs ~(,tuple ,k (,in ,ds ,k))))
,;body
(set ,k (,next ,ds ,k))))))
@@ -433,6 +436,17 @@
(def ,binding ,i)
,body))))
(defn- loop-fiber-template
[binding expr body]
(with-syms [f s]
(def ds (if (idempotent? binding) binding (gensym)))
~(let [,f ,expr]
(while true
(def ,ds (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,;(if (= ds binding) [] [~(def ,binding ,ds)])
,;body))))
(defn- loop1
[body head i]
@@ -466,18 +480,19 @@
:range-to (range-template binding object rest + <=)
:down (range-template binding object rest - >)
:down-to (range-template binding object rest - >=)
:keys (keys-template binding object false [rest])
:pairs (keys-template binding object true [rest])
:in (each-template binding object [rest])
:keys (each-template binding object :keys [rest])
:pairs (each-template binding object :pairs [rest])
:in (each-template binding object :each [rest])
:iterate (iterate-template binding object rest)
:generate (with-syms [f s]
~(let [,f ,object]
(while true
(def ,binding (,resume ,f))
(if (= :dead (,fiber/status ,f)) (break))
,rest)))
:generate (loop-fiber-template binding object [rest])
(error (string "unexpected loop verb " verb)))))
(defmacro forv
"Do a c style for loop for side effects. The iteration variable i
can be mutated in the loop, unlike normal for. Returns nil."
[i start stop & body]
(for-var-template i start stop 1 < + body))
(defmacro for
"Do a c style for loop for side effects. Returns nil."
[i start stop & body]
@@ -486,17 +501,34 @@
(defmacro eachk
"Loop over each key in ds. Returns nil."
[x ds & body]
(keys-template x ds false body))
(each-template x ds :keys body))
(defmacro eachp
"Loop over each (key, value) pair in ds. Returns nil."
[x ds & body]
(keys-template x ds true body))
(each-template x ds :pairs body))
(defmacro eachy
"Resume a fiber in a loop until it has errored or died. Evaluate the body
of the loop with binding set to the yielded value."
[x fiber & body]
(loop-fiber-template x fiber body))
(defmacro repeat
"Evaluate body n times. If n is negative, body will be evaluated 0 times. Evaluates to nil."
[n & body]
(with-syms [iter]
~(do (var ,iter ,n) (while (> ,iter 0) ,;body (-- ,iter)))))
(defmacro forever
"Evaluate body forever in a loop, or until a break statement."
[& body]
~(while true ,;body))
(defmacro each
"Loop over each value in ds. Returns nil."
[x ds & body]
(each-template x ds body))
(each-template x ds :each body))
(defmacro loop
"A general purpose loop macro. This macro is similar to the Common Lisp
@@ -538,10 +570,11 @@
(put _env 'loop1 nil)
(put _env 'check-indexed nil)
(put _env 'for-template nil)
(put _env 'for-var-template nil)
(put _env 'iterate-template nil)
(put _env 'each-template nil)
(put _env 'keys-template nil)
(put _env 'range-template nil)
(put _env 'loop-fiber-template nil)
(defmacro seq
"Similar to loop, but accumulates the loop body into an array and returns that.
@@ -669,28 +702,17 @@
## Polymorphic comparisons
(defn compare-primitive
"Compare x and y using primitive operators.
Returns -1,0,1 for x < y, x = y, x > y respectively.
Present mostly for constructing 'compare' methods in prototypes."
[x y]
(cond
(= x y) 0
(< x y) -1
(> x y) 1))
(defn compare
"Polymorphic compare. Returns -1,0,1 for x < y, x = y, x > y respectively.
"Polymorphic compare. Returns -1, 0, 1 for x < y, x = y, x > y respectively.
Differs from the primitive comparators in that it first checks to
see whether either x or y implement a 'compare' method which can
compare x and y. If so it uses that compare method. If not, it
compare x and y. If so it uses that compare method. If not, it
delegates to the primitive comparators."
[x y]
(or
(when-let [f (get x :compare)] (f x y))
(when-let [f (get y :compare)
fyx (f y x)] (- fyx))
(compare-primitive x y)))
(when-let [f (get y :compare)] (- (f y x)))
(cmp x y)))
(defn- compare-reduce [op xs]
(var r true)
@@ -739,7 +761,7 @@
[a lo hi by]
(def pivot (in a hi))
(var i lo)
(for j lo hi
(forv j lo hi
(def aj (in a j))
(when (by aj pivot)
(def ai (in a i))
@@ -837,19 +859,19 @@
(def ninds (length inds))
(if (= 0 ninds) (error "expected at least 1 indexed collection"))
(var limit (length (in inds 0)))
(for i 0 ninds
(forv i 0 ninds
(def l (length (in inds i)))
(if (< l limit) (set limit l)))
(def [i1 i2 i3 i4] inds)
(def res (array/new limit))
(case ninds
1 (for i 0 limit (set (res i) (f (in i1 i))))
2 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
3 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
4 (for i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
(for i 0 limit
1 (forv i 0 limit (set (res i) (f (in i1 i))))
2 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i))))
3 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i))))
4 (forv i 0 limit (set (res i) (f (in i1 i) (in i2 i) (in i3 i) (in i4 i))))
(forv i 0 limit
(def args (array/new ninds))
(for j 0 ninds (set (args j) (in (in inds j) i)))
(forv j 0 ninds (set (args j) (in (in inds j) i)))
(set (res i) (f ;args))))
res)
@@ -901,12 +923,12 @@
1 (do
(def [n] args)
(def arr (array/new n))
(for i 0 n (put arr i i))
(forv i 0 n (put arr i i))
arr)
2 (do
(def [n m] args)
(def arr (array/new (- m n)))
(for i n m (put arr (- i n) i))
(forv i n m (put arr (- i n) i))
arr)
3 (do
(def [n m s] args)
@@ -1189,19 +1211,43 @@
(if x nil (set res x)))
res)
(defn any?
"Returns the first truthy valye in ind, otherwise nil.
falsey value."
[ind]
(var res nil)
(loop [x :in ind :until res]
(if x (set res x)))
res)
(defn reverse!
"Reverses the order of the elements in a given array or buffer and returns it
mutated."
[t]
(def len-1 (- (length t) 1))
(def half (/ len-1 2))
(forv i 0 half
(def j (- len-1 i))
(def l (in t i))
(def r (in t j))
(put t i r)
(put t j l))
t)
(defn reverse
"Reverses the order of the elements in a given array or tuple and returns a new array."
"Reverses the order of the elements in a given array or tuple and returns
a new array. If string or buffer is provided function returns array of chars reversed."
[t]
(def len (length t))
(var n (- len 1))
(def reversed (array/new len))
(def ret (array/new len))
(while (>= n 0)
(array/push reversed (in t n))
(array/push ret (in t n))
(-- n))
reversed)
ret)
(defn invert
"Returns a table of where the keys of an associative data structure
"Returns a table where the keys of an associative data structure
are the values, and the values of the keys. If multiple keys have the same
value, one key will be ignored."
[ds]
@@ -1215,11 +1261,14 @@
Returns a new table."
[ks vs]
(def res @{})
(def lk (length ks))
(def lv (length vs))
(def len (if (< lk lv) lk lv))
(for i 0 len
(put res (in ks i) (in vs i)))
(var kk nil)
(var vk nil)
(while true
(set kk (next ks kk))
(if (= nil kk) (break))
(set vk (next vs vk))
(if (= nil vk) (break))
(put res (in ks kk) (in vs vk)))
res)
(defn get-in
@@ -1239,7 +1288,7 @@
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(forv i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
@@ -1261,7 +1310,7 @@
(var d ds)
(def len-1 (- (length ks) 1))
(if (< len-1 0) (error "expected at least 1 key in ks"))
(for i 0 len-1
(forv i 0 len-1
(def k (get ks i))
(def v (get d k))
(if (= nil v)
@@ -1934,20 +1983,24 @@
that should make it easier to write more complex patterns."
~@{:d (range "09")
:a (range "az" "AZ")
:s (set " \t\r\n\0\f")
:s (set " \t\r\n\0\f\v")
:w (range "az" "AZ" "09")
:h (range "09" "af")
:S (if-not :s 1)
:W (if-not :w 1)
:A (if-not :a 1)
:D (if-not :d 1)
:H (if-not :h 1)
:d+ (some :d)
:a+ (some :a)
:s+ (some :s)
:w+ (some :w)
:h+ (some :h)
:d* (any :d)
:a* (any :a)
:w* (any :w)
:s* (any :s)})
:s* (any :s)
:h* (any :h)})
###
###
@@ -2129,12 +2182,12 @@
(buffer/push-string buf "\n")))
(var returnval nil)
(run-context {:chunks chunks
:on-compile-error (fn [msg errf &]
:on-compile-error (fn compile-error [msg errf &]
(error (string "compile error: " msg)))
:on-parse-error (fn [p x]
:on-parse-error (fn parse-error [p x]
(error (string "parse error: " (parser/error p))))
:fiber-flags :i
:on-status (fn [f val]
:on-status (fn on-status [f val]
(if-not (= (fiber/status f) :dead)
(error val))
(set returnval val))
@@ -2503,7 +2556,7 @@
[&opt n]
(def fun (.fn n))
(def bytecode (.bytecode n))
(for i 0 (length bytecode)
(forv i 0 (length bytecode)
(debug/fbreak fun i))
(print "Set " (length bytecode) " breakpoints in " fun))
@@ -2512,7 +2565,7 @@
[&opt n]
(def fun (.fn n))
(def bytecode (.bytecode n))
(for i 0 (length bytecode)
(forv i 0 (length bytecode)
(debug/unfbreak fun i))
(print "Cleared " (length bytecode) " breakpoints in " fun))
@@ -2554,7 +2607,7 @@
"Go to the next breakpoint."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(forv i 0 (or n 1)
(set res (resume (.fiber))))
res)
@@ -2568,7 +2621,7 @@
"Execute the next n instructions."
[&opt n]
(var res nil)
(for i 0 (or n 1)
(forv i 0 (or n 1)
(set res (debug/step (.fiber))))
res)
@@ -2714,7 +2767,7 @@
-m syspath : Set system path for loading global modules
-c source output : Compile janet source code into an image
-n : Disable ANSI color output in the repl
-l path : Execute code in a file before running the main script
-l lib : Import a module before processing more arguments
-- : Stop handling options`)
(os/exit 0)
1)
@@ -2726,17 +2779,17 @@
"k" (fn [&] (set *compile-only* true) (set *exit-on-error* false) 1)
"n" (fn [&] (set *colorize* false) 1)
"m" (fn [i &] (setdyn :syspath (in args (+ i 1))) 2)
"c" (fn [i &]
"c" (fn c-switch [i &]
(def e (dofile (in args (+ i 1))))
(spit (in args (+ i 2)) (make-image e))
(set *no-file* false)
3)
"-" (fn [&] (set *handleopts* false) 1)
"l" (fn [i &]
"l" (fn l-switch [i &]
(import* (in args (+ i 1))
:prefix "" :exit *exit-on-error*)
2)
"e" (fn [i &]
"e" (fn e-switch [i &]
(set *no-file* false)
(eval-string (in args (+ i 1)))
2)
@@ -2790,11 +2843,11 @@
(when (and (not *compile-only*) (or *should-repl* *no-file*))
(if-not *quiet*
(print "Janet " janet/version "-" janet/build " Copyright (C) 2017-2020 Calvin Rose"))
(print "Janet " janet/version "-" janet/build " " (os/which) "/" (os/arch)))
(flush)
(defn getprompt [p]
(def [line] (parser/where p))
(string "janet:" line ":" (parser/state p :delimiters) "> "))
(string "repl:" line ":" (parser/state p :delimiters) "> "))
(defn getstdin [prompt buf _]
(file/write stdout prompt)
(file/flush stdout)

View File

@@ -61,5 +61,11 @@ int table_test() {
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(janet_equals(janet_table_get(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 4);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key1")), janet_wrap_integer(10)));
assert(t2->count == 3);
assert(janet_equals(janet_table_remove(t2, janet_csymbolv("t2key2")), janet_wrap_integer(100)));
assert(t2->count == 2);
return 0;
}

View File

@@ -27,10 +27,10 @@
#define JANETCONF_H
#define JANET_VERSION_MAJOR 1
#define JANET_VERSION_MINOR 10
#define JANET_VERSION_MINOR 11
#define JANET_VERSION_PATCH 0
#define JANET_VERSION_EXTRA ""
#define JANET_VERSION "1.10.0"
#define JANET_VERSION "1.11.0"
/* #define JANET_BUILD "local" */
@@ -41,7 +41,8 @@
/* #define JANET_API __attribute__((visibility ("default"))) */
/* These settings should be specified before amalgamation is
* built. */
* built. Any build with these set should be considered non-standard, and
* certain Janet libraries should be expected not to work. */
/* #define JANET_NO_DOCSTRINGS */
/* #define JANET_NO_SOURCEMAPS */
/* #define JANET_REDUCED_OS */
@@ -51,13 +52,13 @@
/* #define JANET_NO_NET */
/* #define JANET_NO_TYPED_ARRAY */
/* #define JANET_NO_INT_TYPES */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
/* Other settings */
/* #define JANET_NO_PRF */
/* #define JANET_NO_UTC_MKTIME */
/* #define JANET_NO_REALPATH */
/* #define JANET_NO_SYMLINKS */
/* #define JANET_NO_UMASK */
/* #define JANET_OUT_OF_MEMORY do { printf("janet out of memory\n"); exit(1); } while (0) */
/* #define JANET_EXIT(msg) do { printf("C assert failed executing janet: %s\n", msg); exit(1); } while (0) */
/* #define JANET_TOP_LEVEL_SIGNAL(msg) call_my_function((msg), stderr) */
@@ -68,4 +69,7 @@
/* #define JANET_OS_NAME my-custom-os */
/* #define JANET_ARCH_NAME pdp-8 */
/* Main client settings, does not affect library code */
/* #define JANET_SIMPLE_GETLINE */
#endif /* end of include guard: JANETCONF_H */

View File

@@ -270,6 +270,26 @@ static Janet cfun_array_remove(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_array_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetArray *array = janet_getarray(argv, 0);
if (array->count) {
if (array->count < array->capacity) {
Janet *newData = realloc(array->data, array->count * sizeof(Janet));
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
array->data = newData;
array->capacity = array->count;
}
} else {
array->capacity = 0;
free(array->data);
array->data = NULL;
}
return argv[0];
}
static const JanetReg array_cfuns[] = {
{
"array/new", cfun_array_new,
@@ -345,6 +365,11 @@ static const JanetReg array_cfuns[] = {
"By default, n is 1. "
"Returns the array.")
},
{
"array/trim", cfun_array_trim,
JDOC("(array/trim arr)\n\n"
"Set the backing capacity of an array to its current length. Returns the modified array.")
},
{NULL, NULL, NULL}
};

View File

@@ -112,6 +112,8 @@ static const JanetInstructionDef janet_ops[] = {
{"movn", JOP_MOVE_NEAR},
{"mul", JOP_MULTIPLY},
{"mulim", JOP_MULTIPLY_IMMEDIATE},
{"neq", JOP_NOT_EQUALS},
{"neqim", JOP_NOT_EQUALS_IMMEDIATE},
{"next", JOP_NEXT},
{"noop", JOP_NOOP},
{"prop", JOP_PROPAGATE},
@@ -718,6 +720,9 @@ static JanetAssembleResult janet_asm1(JanetAssembler *parent, Janet source, int
janet_asm_error(&a, "invalid assembly");
}
/* Add final flags */
janet_def_addflags(def);
/* Finish everything and return funcdef */
janet_asm_deinit(&a);
result.error = NULL;

View File

@@ -197,6 +197,26 @@ static Janet cfun_buffer_fill(int32_t argc, Janet *argv) {
return argv[0];
}
static Janet cfun_buffer_trim(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
JanetBuffer *buffer = janet_getbuffer(argv, 0);
if (buffer->count) {
if (buffer->count < buffer->capacity) {
uint8_t *newData = realloc(buffer->data, buffer->count);
if (NULL == newData) {
JANET_OUT_OF_MEMORY;
}
buffer->data = newData;
buffer->capacity = buffer->count;
}
} else {
buffer->capacity = 0;
free(buffer->data);
buffer->data = NULL;
}
return argv[0];
}
static Janet cfun_buffer_u8(int32_t argc, Janet *argv) {
int32_t i;
janet_arity(argc, 1, -1);
@@ -379,6 +399,12 @@ static const JanetReg buffer_cfuns[] = {
"Fill up a buffer with bytes, defaulting to 0s. Does not change the buffer's length. "
"Returns the modified buffer.")
},
{
"buffer/trim", cfun_buffer_trim,
JDOC("(buffer/trim buffer)\n\n"
"Set the backing capacity of the buffer to the current length of the buffer. Returns the "
"modified buffer.")
},
{
"buffer/push-byte", cfun_buffer_u8,
JDOC("(buffer/push-byte buffer x)\n\n"

View File

@@ -101,10 +101,12 @@ enum JanetInstructionType janet_instructions[JOP_INSTRUCTION_COUNT] = {
JINT_SSS, /* JOP_GREATER_THAN_EQUAL */
JINT_SSS, /* JOP_LESS_THAN_EQUAL */
JINT_SSS, /* JOP_NEXT */
JINT_SSS, /* JOP_NOT_EQUALS, */
JINT_SSI, /* JOP_NOT_EQUALS_IMMEDIATE, */
};
/* Verify some bytecode */
int32_t janet_verify(JanetFuncDef *def) {
int janet_verify(JanetFuncDef *def) {
int vargs = !!(def->flags & JANET_FUNCDEF_FLAG_VARARG);
int32_t i;
int32_t maxslot = def->arity + vargs;

View File

@@ -27,12 +27,26 @@
#include "fiber.h"
#endif
#ifndef JANET_SINGLE_THREADED
#ifndef JANET_WINDOWS
#include <pthread.h>
#else
#include <windows.h>
#endif
#endif
JANET_NO_RETURN static void janet_top_level_signal(const char *msg) {
#ifdef JANET_TOP_LEVEL_SIGNAL
JANET_TOP_LEVEL_SIGNAL(msg);
#else
fputs(msg, stdout);
exit(1);
# ifdef JANET_SINGLE_THREADED
exit(-1);
# elif defined(JANET_WINDOWS)
ExitThread(-1);
# else
pthread_exit(NULL);
# endif
#endif
}
@@ -325,7 +339,10 @@ JanetRange janet_getslice(int32_t argc, const Janet *argv) {
}
Janet janet_dyn(const char *name) {
if (!janet_vm_fiber) return janet_wrap_nil();
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) return janet_wrap_nil();
return janet_table_get(janet_vm_top_dyns, janet_ckeywordv(name));
}
if (janet_vm_fiber->env) {
return janet_table_get(janet_vm_fiber->env, janet_ckeywordv(name));
} else {
@@ -334,11 +351,15 @@ Janet janet_dyn(const char *name) {
}
void janet_setdyn(const char *name, Janet value) {
if (!janet_vm_fiber) return;
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
if (!janet_vm_fiber) {
if (!janet_vm_top_dyns) janet_vm_top_dyns = janet_table(10);
janet_table_put(janet_vm_top_dyns, janet_ckeywordv(name), value);
} else {
if (!janet_vm_fiber->env) {
janet_vm_fiber->env = janet_table(1);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
janet_table_put(janet_vm_fiber->env, janet_ckeywordv(name), value);
}
uint64_t janet_getflags(const Janet *argv, int32_t n, const char *flags) {

View File

@@ -33,6 +33,11 @@ static int arity1or2(JanetFopts opts, JanetSlot *args) {
int32_t arity = janet_v_count(args);
return arity == 1 || arity == 2;
}
static int arity2or3(JanetFopts opts, JanetSlot *args) {
(void) opts;
int32_t arity = janet_v_count(args);
return arity == 2 || arity == 3;
}
static int fixarity1(JanetFopts opts, JanetSlot *args) {
(void) opts;
return janet_v_count(args) == 1;
@@ -90,34 +95,67 @@ static JanetSlot opfunction(
return t;
}
/* Check if a value can be coerced to an immediate value */
static int can_be_imm(Janet x, int8_t *out) {
if (!janet_checkint(x)) return 0;
int32_t integer = janet_unwrap_integer(x);
if (integer > 127 || integer < -127) return 0;
*out = (int8_t) integer;
return 1;
}
/* Check if a slot can be coerced to an immediate value */
static int can_slot_be_imm(JanetSlot s, int8_t *out) {
if (!(s.flags & JANET_SLOT_CONSTANT)) return 0;
return can_be_imm(s.constant, out);
}
/* Emit a series of instructions instead of a function call to a math op */
static JanetSlot opreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
Janet nullary) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
int neg = opim < 0;
if (opim < 0) opim = -opim;
len = janet_v_count(args);
JanetSlot t;
if (len == 0) {
return janetc_cslot(nullary);
} else if (len == 1) {
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
/* Special case subtract to be times -1 */
if (op == JOP_SUBTRACT) {
janetc_emit_ssi(c, JOP_MULTIPLY_IMMEDIATE, t, args[0], -1, 1);
} else {
janetc_emit_sss(c, op, t, janetc_cslot(nullary), args[0], 1);
}
return t;
}
t = janetc_gettarget(opts);
janetc_emit_sss(c, op, t, args[0], args[1], 1);
for (i = 2; i < len; i++)
janetc_emit_sss(c, op, t, t, args[i], 1);
if (opim && can_slot_be_imm(args[1], &imm)) {
janetc_emit_ssi(c, opim, t, args[0], neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, args[0], args[1], 1);
}
for (i = 2; i < len; i++) {
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, t, neg ? -imm : imm, 1);
} else {
janetc_emit_sss(c, op, t, t, args[i], 1);
}
}
return t;
}
/* Function optimizers */
static JanetSlot do_propagate(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_PROPAGATE, janet_wrap_nil());
return opreduce(opts, args, JOP_PROPAGATE, 0, janet_wrap_nil());
}
static JanetSlot do_error(JanetFopts opts, JanetSlot *args) {
janetc_emit_s(opts.compiler, JOP_ERROR, args[0], 0);
@@ -134,19 +172,40 @@ static JanetSlot do_debug(JanetFopts opts, JanetSlot *args) {
return t;
}
static JanetSlot do_in(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_IN, janet_wrap_nil());
return opreduce(opts, args, JOP_IN, 0, janet_wrap_nil());
}
static JanetSlot do_get(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_GET, janet_wrap_nil());
if (janet_v_count(args) == 3) {
JanetCompiler *c = opts.compiler;
JanetSlot t = janetc_gettarget(opts);
int target_is_default = janetc_sequal(t, args[2]);
JanetSlot dflt_slot = args[2];
if (target_is_default) {
dflt_slot = janetc_farslot(c);
janetc_copy(c, dflt_slot, t);
}
janetc_emit_sss(c, JOP_GET, t, args[0], args[1], 1);
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT_NIL, t, 0, 0);
janetc_copy(c, t, dflt_slot);
if (target_is_default) janetc_freeslot(c, dflt_slot);
int32_t current = janet_v_count(c->buffer);
c->buffer[label] |= (current - label) << 16;
return t;
} else {
return opreduce(opts, args, JOP_GET, 0, janet_wrap_nil());
}
}
static JanetSlot do_next(JanetFopts opts, JanetSlot *args) {
return opfunction(opts, args, JOP_NEXT, janet_wrap_nil());
}
static JanetSlot do_modulo(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MODULO, janet_wrap_nil());
return opreduce(opts, args, JOP_MODULO, 0, janet_wrap_nil());
}
static JanetSlot do_remainder(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_REMAINDER, janet_wrap_nil());
return opreduce(opts, args, JOP_REMAINDER, 0, janet_wrap_nil());
}
static JanetSlot do_cmp(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_COMPARE, 0, janet_wrap_nil());
}
static JanetSlot do_put(JanetFopts opts, JanetSlot *args) {
if (opts.flags & JANET_FOPTS_DROP) {
@@ -200,34 +259,34 @@ static JanetSlot do_apply(JanetFopts opts, JanetSlot *args) {
/* Variadic operators specialization */
static JanetSlot do_add(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_ADD, janet_wrap_integer(0));
return opreduce(opts, args, JOP_ADD, JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_sub(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SUBTRACT, janet_wrap_integer(0));
return opreduce(opts, args, JOP_SUBTRACT, -JOP_ADD_IMMEDIATE, janet_wrap_integer(0));
}
static JanetSlot do_mul(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_MULTIPLY, janet_wrap_integer(1));
return opreduce(opts, args, JOP_MULTIPLY, JOP_MULTIPLY_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_div(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_DIVIDE, janet_wrap_integer(1));
return opreduce(opts, args, JOP_DIVIDE, JOP_DIVIDE_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_band(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BAND, janet_wrap_integer(-1));
return opreduce(opts, args, JOP_BAND, 0, janet_wrap_integer(-1));
}
static JanetSlot do_bor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BOR, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_bxor(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_BXOR, janet_wrap_integer(0));
return opreduce(opts, args, JOP_BXOR, 0, janet_wrap_integer(0));
}
static JanetSlot do_lshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_LEFT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_LEFT, JOP_SHIFT_LEFT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshift(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT, JOP_SHIFT_RIGHT_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_rshiftu(JanetFopts opts, JanetSlot *args) {
return opreduce(opts, args, JOP_SHIFT_RIGHT, janet_wrap_integer(1));
return opreduce(opts, args, JOP_SHIFT_RIGHT_UNSIGNED, JOP_SHIFT_RIGHT_UNSIGNED_IMMEDIATE, janet_wrap_integer(1));
}
static JanetSlot do_bnot(JanetFopts opts, JanetSlot *args) {
return genericSS(opts, JOP_BNOT, args[0]);
@@ -238,9 +297,11 @@ static JanetSlot compreduce(
JanetFopts opts,
JanetSlot *args,
int op,
int opim,
int invert) {
JanetCompiler *c = opts.compiler;
int32_t i, len;
int8_t imm = 0;
len = janet_v_count(args);
int32_t *labels = NULL;
JanetSlot t;
@@ -251,19 +312,17 @@ static JanetSlot compreduce(
}
t = janetc_gettarget(opts);
for (i = 1; i < len; i++) {
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
if (opim && can_slot_be_imm(args[i], &imm)) {
janetc_emit_ssi(c, opim, t, args[i - 1], imm, 1);
} else {
janetc_emit_sss(c, op, t, args[i - 1], args[i], 1);
}
if (i != (len - 1)) {
int32_t label = janetc_emit_si(c, JOP_JUMP_IF_NOT, t, 0, 1);
int32_t label = janetc_emit_si(c, invert ? JOP_JUMP_IF : JOP_JUMP_IF_NOT, t, 0, 1);
janet_v_push(labels, label);
}
}
int32_t end = janet_v_count(c->buffer);
if (invert) {
janetc_emit_si(c, JOP_JUMP_IF, t, 3, 0);
janetc_emit_s(c, JOP_LOAD_TRUE, t, 1);
janetc_emit(c, JOP_JUMP | (2 << 8));
janetc_emit_s(c, JOP_LOAD_FALSE, t, 1);
}
for (i = 0; i < janet_v_count(labels); i++) {
int32_t label = labels[i];
c->buffer[label] |= ((end - label) << 16);
@@ -273,22 +332,22 @@ static JanetSlot compreduce(
}
static JanetSlot do_gt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN, 0);
return compreduce(opts, args, JOP_GREATER_THAN, JOP_GREATER_THAN_IMMEDIATE, 0);
}
static JanetSlot do_lt(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN, 0);
return compreduce(opts, args, JOP_LESS_THAN, JOP_LESS_THAN_IMMEDIATE, 0);
}
static JanetSlot do_gte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_GREATER_THAN_EQUAL, 0, 0);
}
static JanetSlot do_lte(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0);
return compreduce(opts, args, JOP_LESS_THAN_EQUAL, 0, 0);
}
static JanetSlot do_eq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 0);
return compreduce(opts, args, JOP_EQUALS, JOP_EQUALS_IMMEDIATE, 0);
}
static JanetSlot do_neq(JanetFopts opts, JanetSlot *args) {
return compreduce(opts, args, JOP_EQUALS, 1);
return compreduce(opts, args, JOP_NOT_EQUALS, JOP_NOT_EQUALS_IMMEDIATE, 1);
}
/* Arranged by tag */
@@ -319,10 +378,11 @@ static const JanetFunOptimizer optimizers[] = {
{NULL, do_eq},
{NULL, do_neq},
{fixarity2, do_propagate},
{fixarity2, do_get},
{arity2or3, do_get},
{arity1or2, do_next},
{fixarity2, do_modulo},
{fixarity2, do_remainder},
{fixarity2, do_cmp},
};
const JanetFunOptimizer *janetc_funopt(uint32_t flags) {

View File

@@ -698,7 +698,32 @@ JanetSlot janetc_value(JanetFopts opts, Janet x) {
return ret;
}
/* Add function flags to janet functions */
void janet_def_addflags(JanetFuncDef *def) {
int32_t set_flags = 0;
int32_t unset_flags = 0;
/* pos checks */
if (def->name) set_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) set_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) set_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) set_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (def->closure_bitset) set_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* negative checks */
if (!def->name) unset_flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (!def->source) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (!def->defs) unset_flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (!def->environments) unset_flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (!def->sourcemap) unset_flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
if (!def->closure_bitset) unset_flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
/* Update flags */
def->flags |= set_flags;
def->flags &= ~unset_flags;
}
/* Compile a funcdef */
/* Once the various other settings of the FuncDef have been tweaked,
* call janet_def_addflags to set the proper flags for the funcdef */
JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
JanetScope *scope = c->scope;
JanetFuncDef *def = janet_funcdef_alloc();
@@ -761,7 +786,6 @@ JanetFuncDef *janetc_pop_funcdef(JanetCompiler *c) {
/* Register allocator preallocates some registers [240-255, high 16 bits of chunk index 7], we can ignore those. */
if (scope->ua.count > 7) chunks[7] &= 0xFFFFU;
def->closure_bitset = chunks;
def->flags |= JANET_FUNCDEF_FLAG_HASCLOBITSET;
}
/* Pop the scope */
@@ -818,6 +842,7 @@ JanetCompileResult janet_compile(Janet source, JanetTable *env, const uint8_t *w
if (c.result.status == JANET_COMPILE_OK) {
JanetFuncDef *def = janetc_pop_funcdef(&c);
def->name = janet_cstring("_thunk");
janet_def_addflags(def);
c.result.funcdef = def;
} else {
c.result.error_mapping = c.current_mapping;

View File

@@ -60,6 +60,7 @@
#define JANET_FUN_NEXT 28
#define JANET_FUN_MODULO 29
#define JANET_FUN_REMAINDER 30
#define JANET_FUN_CMP 31
/* Compiler typedefs */
typedef struct JanetCompiler JanetCompiler;

View File

@@ -404,9 +404,11 @@ static Janet janet_core_gcsetinterval(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
size_t s = janet_getsize(argv, 0);
/* limit interval to 48 bits */
if (s > 0xFFFFFFFFFFFFUl) {
#ifdef JANET_64
if (s >> 48) {
janet_panic("interval too large");
}
#endif
janet_vm_gc_interval = s;
return janet_wrap_nil();
}
@@ -739,6 +741,7 @@ static void janet_quick_asm(
JANET_OUT_OF_MEMORY;
}
memcpy(def->bytecode, bytecode, bytecode_size);
janet_def_addflags(def);
janet_def(env, name, janet_wrap_function(janet_thunk(def)), doc);
}
@@ -968,6 +971,10 @@ static const uint32_t remainder_asm[] = {
JOP_REMAINDER | (1 << 24),
JOP_RETURN
};
static const uint32_t cmp_asm[] = {
JOP_COMPARE | (1 << 24),
JOP_RETURN
};
#endif /* ifdef JANET_BOOTSTRAP */
/*
@@ -1021,6 +1028,11 @@ JanetTable *janet_core_env(JanetTable *replacements) {
"%", 2, 2, 2, 2, remainder_asm, sizeof(remainder_asm),
JDOC("(% dividend divisor)\n\n"
"Returns the remainder of dividend / divisor."));
janet_quick_asm(env, JANET_FUN_CMP,
"cmp", 2, 2, 2, 2, cmp_asm, sizeof(cmp_asm),
JDOC("(cmp x y)\n\n"
"Returns -1 if x is strictly less than y, 1 if y is strictly greater "
"than x, and 0 otherwise. To return 0, x and y must be the exact same type."));
janet_quick_asm(env, JANET_FUN_NEXT,
"next", 2, 1, 2, 2, next_asm, sizeof(next_asm),
JDOC("(next ds &opt key)\n\n"

View File

@@ -37,7 +37,7 @@ int32_t janetc_allocfar(JanetCompiler *c) {
return reg;
}
/* Get a register less than 256 */
/* Get a register less than 256 for temporary use. */
int32_t janetc_allocnear(JanetCompiler *c, JanetcRegisterTemp tag) {
return janetc_regalloc_temp(&c->scope->ra, tag);
}
@@ -205,7 +205,7 @@ static int32_t janetc_regnear(JanetCompiler *c, JanetSlot s, JanetcRegisterTemp
}
/* Check if two slots are equal */
static int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
int janetc_sequal(JanetSlot lhs, JanetSlot rhs) {
if ((lhs.flags & ~JANET_SLOTTYPE_ANY) == (rhs.flags & ~JANET_SLOTTYPE_ANY) &&
lhs.index == rhs.index &&
lhs.envindex == rhs.envindex) {
@@ -245,8 +245,8 @@ void janetc_copy(
janetc_moveback(c, dest, nearreg);
/* Cleanup */
janetc_regalloc_freetemp(&c->scope->ra, nearreg, JANETC_REGTEMP_3);
}
/* Instruction templated emitters */
static int32_t emit1s(JanetCompiler *c, uint8_t op, JanetSlot s, int32_t rest, int wr) {

View File

@@ -42,6 +42,9 @@ int32_t janetc_emit_ssi(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2
int32_t janetc_emit_ssu(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, uint8_t immediate, int wr);
int32_t janetc_emit_sss(JanetCompiler *c, uint8_t op, JanetSlot s1, JanetSlot s2, JanetSlot s3, int wr);
/* Check if two slots are equivalent */
int janetc_sequal(JanetSlot x, JanetSlot y);
/* Move value from one slot to another. Cannot copy to constant slots. */
void janetc_copy(JanetCompiler *c, JanetSlot dest, JanetSlot src);

View File

@@ -39,6 +39,7 @@ struct JanetScratch {
JANET_THREAD_LOCAL void *janet_vm_blocks;
JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
JANET_THREAD_LOCAL size_t janet_vm_next_collection;
JANET_THREAD_LOCAL size_t janet_vm_block_count;
JANET_THREAD_LOCAL int janet_vm_gc_suspend = 0;
/* Roots */
@@ -327,6 +328,7 @@ void janet_sweep() {
previous = current;
current->flags &= ~JANET_MEM_REACHABLE;
} else {
janet_vm_block_count--;
janet_deinit_block(current);
if (NULL != previous) {
previous->next = next;
@@ -359,6 +361,7 @@ void *janet_gcalloc(enum JanetMemoryType type, size_t size) {
janet_vm_next_collection += size;
mem->next = janet_vm_blocks;
janet_vm_blocks = mem;
janet_vm_block_count++;
return (void *)mem;
}
@@ -388,6 +391,14 @@ void janet_collect(void) {
uint32_t i;
if (janet_vm_gc_suspend) return;
depth = JANET_RECURSION_GUARD;
/* Try and prevent many major collections back to back.
* A full collection will take O(janet_vm_block_count) time.
* If we have a large heap, make sure our interval is not too
* small so we won't make many collections over it. This is just a
* heuristic for automatically changing the gc interval */
if (janet_vm_block_count * 8 > janet_vm_gc_interval) {
janet_vm_gc_interval = janet_vm_block_count * sizeof(JanetGCObject);
}
orig_rootcount = janet_vm_root_count;
#ifdef JANET_NET
janet_net_markloop();

View File

@@ -20,18 +20,18 @@
* IN THE SOFTWARE.
*/
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "util.h"
#endif
#include <errno.h>
#include <stdlib.h>
#include <limits.h>
#include <inttypes.h>
#include <math.h>
/* Conditional compilation */
#ifdef JANET_INT_TYPES

View File

@@ -37,18 +37,23 @@
static int cfun_io_gc(void *p, size_t len);
static int io_file_get(void *p, Janet key, Janet *out);
static void io_file_marshal(void *p, JanetMarshalContext *ctx);
static void *io_file_unmarshal(JanetMarshalContext *ctx);
const JanetAbstractType janet_file_type = {
"core/file",
cfun_io_gc,
NULL,
io_file_get,
JANET_ATEND_GET
NULL,
io_file_marshal,
io_file_unmarshal,
JANET_ATEND_UNMARSHAL
};
/* Check arguments to fopen */
static int checkflags(const uint8_t *str) {
int flags = 0;
static int32_t checkflags(const uint8_t *str) {
int32_t flags = 0;
int32_t i;
int32_t len = janet_string_length(str);
if (!len || len > 3)
@@ -85,7 +90,7 @@ static int checkflags(const uint8_t *str) {
return flags;
}
static Janet makef(FILE *f, int flags) {
static void *makef(FILE *f, int32_t flags) {
JanetFile *iof = (JanetFile *) janet_abstract(&janet_file_type, sizeof(JanetFile));
iof->file = f;
iof->flags = flags;
@@ -95,7 +100,7 @@ static Janet makef(FILE *f, int flags) {
if (!(flags & JANET_FILE_NOT_CLOSEABLE))
fcntl(fileno(f), F_SETFD, FD_CLOEXEC);
#endif
return janet_wrap_abstract(iof);
return iof;
}
/* Open a process */
@@ -104,7 +109,7 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode = NULL;
int flags;
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
if (janet_string_length(fmode) != 1 ||
@@ -123,7 +128,7 @@ static Janet cfun_io_popen(int32_t argc, Janet *argv) {
if (!f) {
return janet_wrap_nil();
}
return makef(f, flags);
return janet_makefile(f, flags);
}
#endif
@@ -141,7 +146,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
janet_arity(argc, 1, 2);
const uint8_t *fname = janet_getstring(argv, 0);
const uint8_t *fmode;
int flags;
int32_t flags;
if (argc == 2) {
fmode = janet_getkeyword(argv, 1);
flags = checkflags(fmode);
@@ -150,7 +155,7 @@ static Janet cfun_io_fopen(int32_t argc, Janet *argv) {
flags = JANET_FILE_READ;
}
FILE *f = fopen((const char *)fname, (const char *)fmode);
return f ? makef(f, flags) : janet_wrap_nil();
return f ? janet_makefile(f, flags) : janet_wrap_nil();
}
/* Read up to n bytes into buffer. */
@@ -331,6 +336,49 @@ static int io_file_get(void *p, Janet key, Janet *out) {
return janet_getmethod(janet_unwrap_keyword(key), io_file_methods, out);
}
static void io_file_marshal(void *p, JanetMarshalContext *ctx) {
JanetFile *iof = (JanetFile *)p;
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
#ifdef JANET_WINDOWS
janet_marshal_int(ctx, _fileno(iof->file));
#else
janet_marshal_int(ctx, fileno(iof->file));
#endif
janet_marshal_int(ctx, iof->flags);
} else {
janet_panic("cannot marshal file in safe mode");
}
}
static void *io_file_unmarshal(JanetMarshalContext *ctx) {
if (ctx->flags & JANET_MARSHAL_UNSAFE) {
JanetFile *iof = janet_unmarshal_abstract(ctx, sizeof(JanetFile));
int32_t fd = janet_unmarshal_int(ctx);
int32_t flags = janet_unmarshal_int(ctx);
char fmt[4] = {0};
int index = 0;
if (flags & JANET_FILE_READ) fmt[index++] = 'r';
if (flags & JANET_FILE_APPEND) {
fmt[index++] = 'a';
} else if (flags & JANET_FILE_WRITE) {
fmt[index++] = 'w';
}
#ifdef JANET_WINDOWS
iof->file = _fdopen(fd, fmt);
#else
iof->file = fdopen(fd, fmt);
#endif
if (iof->file == NULL) {
iof->flags = JANET_FILE_CLOSED;
} else {
iof->flags = flags;
}
return iof;
} else {
janet_panic("cannot unmarshal file in safe mode");
}
}
FILE *janet_dynfile(const char *name, FILE *def) {
Janet x = janet_dyn(name);
if (!janet_checktype(x, JANET_ABSTRACT)) return def;
@@ -677,7 +725,7 @@ FILE *janet_getfile(const Janet *argv, int32_t n, int *flags) {
}
Janet janet_makefile(FILE *f, int flags) {
return makef(f, flags);
return janet_wrap_abstract(makef(f, flags));
}
JanetAbstract janet_checkfile(Janet j) {
@@ -693,18 +741,18 @@ FILE *janet_unwrapfile(Janet j, int *flags) {
/* Module entry point */
void janet_lib_io(JanetTable *env) {
janet_core_cfuns(env, NULL, io_cfuns);
janet_register_abstract_type(&janet_file_type);
/* stdout */
janet_core_def(env, "stdout",
makef(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdout, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard output file."));
/* stderr */
janet_core_def(env, "stderr",
makef(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stderr, JANET_FILE_APPEND | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard error file."));
/* stdin */
janet_core_def(env, "stdin",
makef(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
janet_makefile(stdin, JANET_FILE_READ | JANET_FILE_NOT_CLOSEABLE | JANET_FILE_SERIALIZABLE),
JDOC("The standard input file."));
}

View File

@@ -214,15 +214,6 @@ static void marshal_one_env(MarshalState *st, JanetFuncEnv *env, int flags) {
}
}
/* Add function flags to janet functions */
static void janet_func_addflags(JanetFuncDef *def) {
if (def->name) def->flags |= JANET_FUNCDEF_FLAG_HASNAME;
if (def->source) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCE;
if (def->defs) def->flags |= JANET_FUNCDEF_FLAG_HASDEFS;
if (def->environments) def->flags |= JANET_FUNCDEF_FLAG_HASENVS;
if (def->sourcemap) def->flags |= JANET_FUNCDEF_FLAG_HASSOURCEMAP;
}
/* Marshal a sequence of u32s */
static void janet_marshal_u32s(MarshalState *st, const uint32_t *u32s, int32_t n) {
for (int32_t i = 0; i < n; i++) {
@@ -243,7 +234,6 @@ static void marshal_one_def(MarshalState *st, JanetFuncDef *def, int flags) {
return;
}
}
janet_func_addflags(def);
/* Add to lookup */
janet_v_push(st->seen_defs, def);
pushint(st, def->flags);
@@ -900,7 +890,7 @@ static const uint8_t *unmarshal_one_def(
for (int32_t i = 0; i < bytecode_length; i++) {
current += readint(st, &data);
def->sourcemap[i].line = current;
def->sourcemap[i].column = readnat(st, &data);
def->sourcemap[i].column = readint(st, &data);
}
} else {
def->sourcemap = NULL;
@@ -908,11 +898,12 @@ static const uint8_t *unmarshal_one_def(
/* Unmarshal closure bitset if needed */
if (def->flags & JANET_FUNCDEF_FLAG_HASCLOBITSET) {
def->closure_bitset = malloc(sizeof(uint32_t) * def->slotcount);
int32_t n = (def->slotcount + 31) >> 5;
def->closure_bitset = malloc(sizeof(uint32_t) * (size_t) n);
if (NULL == def->closure_bitset) {
JANET_OUT_OF_MEMORY;
}
data = janet_unmarshal_u32s(st, data, def->closure_bitset, (def->slotcount + 31) >> 5);
data = janet_unmarshal_u32s(st, data, def->closure_bitset, n);
}
/* Validate */

View File

@@ -499,5 +499,19 @@ void janet_lib_math(JanetTable *env) {
JDOC("The number representing positive infinity"));
janet_def(env, "math/-inf", janet_wrap_number(-INFINITY),
JDOC("The number representing negative infinity"));
janet_def(env, "math/int32-min", janet_wrap_number(INT32_MIN),
JDOC("The maximum contiguous integer representable by a 32 bit signed integer"));
janet_def(env, "math/int32-max", janet_wrap_number(INT32_MAX),
JDOC("The minimum contiguous integer represtenable by a 32 bit signed integer"));
janet_def(env, "math/int-min", janet_wrap_number(JANET_INTMIN_DOUBLE),
JDOC("The maximum contiguous integer representable by a double (2^53)"));
janet_def(env, "math/int-max", janet_wrap_number(JANET_INTMAX_DOUBLE),
JDOC("The minimum contiguous integer represtenable by a double (-(2^53))"));
#ifdef NAN
janet_def(env, "math/nan", janet_wrap_number(NAN),
#else
janet_def(env, "math/nan", janet_wrap_number(0.0 / 0.0),
#endif
JDOC("Not a number (IEEE-754 NaN)"));
#endif
}

View File

@@ -112,7 +112,7 @@ typedef struct {
#endif
static JanetStream *make_stream(int fd, int flags) {
JanetStream *stream = janet_abstract(&StreamAT, sizeof(JanetStream));
#ifndef SOCK_CLOEXEC
#if !defined(SOCK_CLOEXEC) && defined(O_CLOEXEC)
int extra = O_CLOEXEC;
#else
int extra = 0;

View File

@@ -39,6 +39,10 @@
#define RETRY_EINTR(RC, CALL) do { (RC) = CALL; } while((RC) < 0 && errno == EINTR)
#ifdef JANET_APPLE
#include <AvailabilityMacros.h>
#endif
#ifdef JANET_WINDOWS
#include <windows.h>
#include <direct.h>
@@ -66,7 +70,7 @@ extern char **environ;
/* Setting C99 standard makes this not available, but it should
* work/link properly if we detect a BSD */
#if defined(JANET_BSD) || defined(JANET_APPLE)
#if defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
void arc4random_buf(void *buf, size_t nbytes);
#endif
@@ -159,6 +163,8 @@ static Janet os_arch(int32_t argc, Janet *argv) {
return janet_ckeywordv("arm");
#elif (defined(__sparc__))
return janet_ckeywordv("sparc");
#elif (defined(__ppc__))
return janet_ckeywordv("ppc");
#else
return janet_ckeywordv("unknown");
#endif
@@ -508,39 +514,11 @@ static Janet os_time(int32_t argc, Janet *argv) {
return janet_wrap_number(dtime);
}
/* Clock shims */
#ifdef JANET_WINDOWS
static int gettime(struct timespec *spec) {
FILETIME ftime;
GetSystemTimeAsFileTime(&ftime);
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
/* Windows epoch is January 1, 1601 apparently */
wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL;
/* Resolution is 100 nanoseconds. */
spec->tv_nsec = wintime % 10000000LL * 100;
return 0;
}
#elif defined(__MACH__)
static int gettime(struct timespec *spec) {
clock_serv_t cclock;
mach_timespec_t mts;
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec;
return 0;
}
#else
#define gettime(TV) clock_gettime(CLOCK_MONOTONIC, (TV))
#endif
static Janet os_clock(int32_t argc, Janet *argv) {
janet_fixarity(argc, 0);
(void) argv;
struct timespec tv;
if (gettime(&tv)) janet_panic("could not get time");
if (janet_gettime(&tv)) janet_panic("could not get time");
double dtime = tv.tv_sec + (tv.tv_nsec / 1E9);
return janet_wrap_number(dtime);
}
@@ -604,10 +582,11 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
v = v >> 8;
}
}
#elif defined(JANET_LINUX)
#elif defined(JANET_LINUX) || ( defined(JANET_APPLE) && !defined(MAC_OS_X_VERSION_10_7) )
/* We should be able to call getrandom on linux, but it doesn't seem
to be uniformly supported on linux distros.
In both cases, use this fallback path for now... */
On Mac, arc4random_buf wasn't available on until 10.7.
In these cases, use this fallback path for now... */
int rc;
int randfd;
RETRY_EINTR(randfd, open("/dev/urandom", O_RDONLY | O_CLOEXEC));
@@ -624,7 +603,7 @@ static Janet os_cryptorand(int32_t argc, Janet *argv) {
n -= nread;
}
RETRY_EINTR(rc, close(randfd));
#elif defined(JANET_BSD) || defined(JANET_APPLE)
#elif defined(JANET_BSD) || defined(MAC_OS_X_VERSION_10_7)
(void) genericerr;
arc4random_buf(buffer->data + offset, n);
#else
@@ -1225,6 +1204,9 @@ static Janet os_rename(int32_t argc, Janet *argv) {
static Janet os_realpath(int32_t argc, Janet *argv) {
janet_fixarity(argc, 1);
const char *src = janet_getcstring(argv, 0);
#ifdef JANET_NO_REALPATH
janet_panic("os/realpath not enabled for this platform");
#else
#ifdef JANET_WINDOWS
char *dest = _fullpath(NULL, src, _MAX_PATH);
#else
@@ -1234,6 +1216,7 @@ static Janet os_realpath(int32_t argc, Janet *argv) {
Janet ret = janet_cstringv(dest);
free(dest);
return ret;
#endif
}
static Janet os_permission_string(int32_t argc, Janet *argv) {

View File

@@ -1308,47 +1308,136 @@ static Janet cfun_peg_compile(int32_t argc, Janet *argv) {
return janet_wrap_abstract(peg);
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
janet_arity(argc, 2, -1);
/* Common data for peg cfunctions */
typedef struct {
JanetPeg *peg;
PegState s;
JanetByteView bytes;
JanetByteView repl;
int32_t start;
} PegCall;
/* Initialize state for peg cfunctions */
static PegCall peg_cfun_init(int32_t argc, Janet *argv, int get_replace) {
PegCall ret;
int32_t min = get_replace ? 3 : 2;
janet_arity(argc, get_replace, -1);
if (janet_checktype(argv[0], JANET_ABSTRACT) &&
janet_abstract_type(janet_unwrap_abstract(argv[0])) == &janet_peg_type) {
peg = janet_unwrap_abstract(argv[0]);
ret.peg = janet_unwrap_abstract(argv[0]);
} else {
peg = compile_peg(argv[0]);
ret.peg = compile_peg(argv[0]);
}
JanetByteView bytes = janet_getbytes(argv, 1);
int32_t start;
PegState s;
if (argc > 2) {
start = janet_gethalfrange(argv, 2, bytes.len, "offset");
s.extrac = argc - 3;
s.extrav = janet_tuple_n(argv + 3, argc - 3);
if (get_replace) {
ret.repl = janet_getbytes(argv, 1);
ret.bytes = janet_getbytes(argv, 2);
} else {
start = 0;
s.extrac = 0;
s.extrav = NULL;
ret.bytes = janet_getbytes(argv, 1);
}
s.mode = PEG_MODE_NORMAL;
s.text_start = bytes.bytes;
s.text_end = bytes.bytes + bytes.len;
s.depth = JANET_RECURSION_GUARD;
s.captures = janet_array(0);
s.scratch = janet_buffer(10);
s.tags = janet_buffer(10);
s.constants = peg->constants;
s.bytecode = peg->bytecode;
const uint8_t *result = peg_rule(&s, s.bytecode, bytes.bytes + start);
return result ? janet_wrap_array(s.captures) : janet_wrap_nil();
if (argc > min) {
ret.start = janet_gethalfrange(argv, min, ret.bytes.len, "offset");
ret.s.extrac = argc - min - 1;
ret.s.extrav = janet_tuple_n(argv + min + 1, argc - min - 1);
} else {
ret.start = 0;
ret.s.extrac = 0;
ret.s.extrav = NULL;
}
ret.s.mode = PEG_MODE_NORMAL;
ret.s.text_start = ret.bytes.bytes;
ret.s.text_end = ret.bytes.bytes + ret.bytes.len;
ret.s.depth = JANET_RECURSION_GUARD;
ret.s.captures = janet_array(0);
ret.s.scratch = janet_buffer(10);
ret.s.tags = janet_buffer(10);
ret.s.constants = ret.peg->constants;
ret.s.bytecode = ret.peg->bytecode;
return ret;
}
static void peg_call_reset(PegCall *c) {
c->s.captures->count = 0;
c->s.scratch->count = 0;
c->s.tags->count = 0;
}
static Janet cfun_peg_match(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + c.start);
return result ? janet_wrap_array(c.s.captures) : janet_wrap_nil();
}
static Janet cfun_peg_find(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
return janet_wrap_integer(i);
}
return janet_wrap_nil();
}
static Janet cfun_peg_find_all(int32_t argc, Janet *argv) {
PegCall c = peg_cfun_init(argc, argv, 0);
JanetArray *ret = janet_array(0);
for (int32_t i = c.start; i < c.bytes.len; i++) {
peg_call_reset(&c);
if (peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i))
janet_array_push(ret, janet_wrap_integer(i));
}
return janet_wrap_array(ret);
}
static Janet cfun_peg_replace_generic(int32_t argc, Janet *argv, int only_one) {
PegCall c = peg_cfun_init(argc, argv, 1);
JanetBuffer *ret = janet_buffer(0);
int32_t trail = 0;
for (int32_t i = c.start; i < c.bytes.len;) {
peg_call_reset(&c);
const uint8_t *result = peg_rule(&c.s, c.s.bytecode, c.bytes.bytes + i);
if (NULL != result) {
if (trail < i) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (i - trail));
trail = i;
}
int32_t nexti = (int32_t)(result - c.bytes.bytes);
janet_buffer_push_bytes(ret, c.repl.bytes, c.repl.len);
trail = nexti;
if (nexti == i) nexti++;
i = nexti;
if (only_one) break;
} else {
i++;
}
}
if (trail < c.bytes.len) {
janet_buffer_push_bytes(ret, c.bytes.bytes + trail, (c.bytes.len - trail));
}
return janet_wrap_buffer(ret);
}
static Janet cfun_peg_replace_all(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 0);
}
static Janet cfun_peg_replace(int32_t argc, Janet *argv) {
return cfun_peg_replace_generic(argc, argv, 1);
}
static JanetMethod peg_methods[] = {
{"match", cfun_peg_match},
{"find", cfun_peg_find},
{"find-all", cfun_peg_find_all},
{"replace", cfun_peg_replace},
{"replace-all", cfun_peg_replace_all},
{NULL, NULL}
};
static int cfun_peg_getter(JanetAbstract a, Janet key, Janet *out) {
(void) a;
if (janet_keyeq(key, "match")) {
*out = janet_wrap_cfunction(cfun_peg_match);
return 1;
}
return 0;
if (!janet_checktype(key, JANET_KEYWORD))
return 0;
return janet_getmethod(janet_unwrap_keyword(key), peg_methods, out);
}
static const JanetReg peg_cfuns[] = {
@@ -1364,6 +1453,27 @@ static const JanetReg peg_cfuns[] = {
"Match a Parsing Expression Grammar to a byte string and return an array of captured values. "
"Returns nil if text does not match the language defined by peg. The syntax of PEGs is documented on the Janet website.")
},
{
"peg/find", cfun_peg_find,
JDOC("(peg/find peg text &opt start & args)\n\n"
"Find first index where the peg matches in text. Returns an integer, or nil if not found.")
},
{
"peg/find-all", cfun_peg_find_all,
JDOC("(peg/find-all peg text &opt start & args)\n\n"
"Find all indexes where the peg matches in text. Returns an array of integers.")
},
{
"peg/replace", cfun_peg_replace,
JDOC("(peg/replace peg repl text &opt start & args)\n\n"
"Replace first match of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement. "
"If no matches are found, returns the input string in a new buffer.")
},
{
"peg/replace-all", cfun_peg_replace_all,
JDOC("(peg/replace-all peg repl text &opt start & args)\n\n"
"Replace all matches of peg in text with repl, returning a new buffer. The peg does not need to make captures to do replacement.")
},
{NULL, NULL, NULL}
};

View File

@@ -39,11 +39,9 @@
static void number_to_string_b(JanetBuffer *buffer, double x) {
janet_buffer_ensure(buffer, buffer->count + BUFSIZE, 2);
/* Use int32_t range for valid integers because that is the
* range most integer-expecting functions in the C api use. */
const char *fmt = (x == floor(x) &&
x <= ((double) INT32_MAX) &&
x >= ((double) INT32_MIN)) ? "%.0f" : "%g";
x <= JANET_INTMAX_DOUBLE &&
x >= JANET_INTMIN_DOUBLE) ? "%.0f" : "%g";
int count = snprintf((char *) buffer->data + buffer->count, BUFSIZE, fmt, x);
buffer->count += count;
}
@@ -123,9 +121,6 @@ static void string_description_b(JanetBuffer *buffer, const char *title, void *p
#undef POINTSIZE
}
#undef HEX
#undef BUFSIZE
static void janet_escape_string_impl(JanetBuffer *buffer, const uint8_t *str, int32_t len) {
janet_buffer_push_u8(buffer, '"');
for (int32_t i = 0; i < len; ++i) {
@@ -191,7 +186,7 @@ static void janet_escape_buffer_b(JanetBuffer *buffer, JanetBuffer *bx) {
void janet_to_string_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
janet_buffer_push_cstring(buffer, "");
break;
case JANET_BOOLEAN:
janet_buffer_push_cstring(buffer,
@@ -280,6 +275,9 @@ void janet_description_b(JanetBuffer *buffer, Janet x) {
switch (janet_type(x)) {
default:
break;
case JANET_NIL:
janet_buffer_push_cstring(buffer, "nil");
return;
case JANET_KEYWORD:
janet_buffer_push_u8(buffer, ':');
break;
@@ -354,12 +352,16 @@ static int print_jdn_one(struct pretty *S, Janet x, int depth) {
if (depth == 0) return 1;
switch (janet_type(x)) {
case JANET_NIL:
case JANET_NUMBER:
case JANET_BOOLEAN:
case JANET_BUFFER:
case JANET_STRING:
janet_description_b(S->buffer, x);
break;
case JANET_NUMBER:
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));
S->buffer->count += count;
break;
case JANET_SYMBOL:
case JANET_KEYWORD:
if (contains_bad_chars(janet_unwrap_keyword(x), janet_type(x) == JANET_SYMBOL)) return 1;
@@ -994,3 +996,6 @@ void janet_buffer_format(
}
}
}
#undef HEX
#undef BUFSIZE

View File

@@ -23,7 +23,6 @@
#ifndef JANET_AMALG
#include "features.h"
#include <janet.h>
#include "state.h"
#endif
/* Run a string */
@@ -56,9 +55,10 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
done = 1;
}
} else {
ret = janet_wrap_string(cres.error);
if (cres.macrofiber) {
janet_eprintf("compile error in %s: ", sourcePath);
janet_stacktrace(cres.macrofiber, janet_wrap_string(cres.error));
janet_stacktrace(cres.macrofiber, ret);
} else {
janet_eprintf("compile error in %s: %s\n", sourcePath,
(const char *)cres.error);
@@ -68,25 +68,23 @@ int janet_dobytes(JanetTable *env, const uint8_t *bytes, int32_t len, const char
}
}
if (done) break;
/* Dispatch based on parse state */
switch (janet_parser_status(&parser)) {
case JANET_PARSE_DEAD:
done = 1;
break;
case JANET_PARSE_ERROR:
case JANET_PARSE_ERROR: {
const char *e = janet_parser_error(&parser);
errflags |= 0x04;
janet_eprintf("parse error in %s: %s\n",
sourcePath, janet_parser_error(&parser));
ret = janet_cstringv(e);
janet_eprintf("parse error in %s: %s\n", sourcePath, e);
done = 1;
break;
case JANET_PARSE_PENDING:
if (index == len) {
janet_parser_eof(&parser);
} else {
janet_parser_consume(&parser, bytes[index++]);
}
break;
}
case JANET_PARSE_ROOT:
case JANET_PARSE_PENDING:
if (index >= len) {
janet_parser_eof(&parser);
} else {

View File

@@ -649,6 +649,7 @@ static JanetSlot janetc_while(JanetFopts opts, int32_t argn, const Janet *argv)
/* Compile function */
JanetFuncDef *def = janetc_pop_funcdef(c);
def->name = janet_cstring("_while");
janet_def_addflags(def);
int32_t defindex = janetc_addfuncdef(c, def);
/* And then load the closure and call it. */
int32_t cloreg = janetc_regalloc_temp(&c->scope->ra, JANETC_REGTEMP_0);
@@ -823,6 +824,7 @@ static JanetSlot janetc_fn(JanetFopts opts, int32_t argn, const Janet *argv) {
if (structarg) def->flags |= JANET_FUNCDEF_FLAG_STRUCTARG;
if (selfref) def->name = janet_unwrap_symbol(head);
janet_def_addflags(def);
defindex = janetc_addfuncdef(c, def);
/* Ensure enough slots for vararg function. */

View File

@@ -34,6 +34,9 @@
typedef struct JanetScratch JanetScratch;
/* Top level dynamic bindings */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
/* Cache the core environment */
extern JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
@@ -68,6 +71,7 @@ extern JANET_THREAD_LOCAL uint32_t janet_vm_cache_deleted;
extern JANET_THREAD_LOCAL void *janet_vm_blocks;
extern JANET_THREAD_LOCAL size_t janet_vm_gc_interval;
extern JANET_THREAD_LOCAL size_t janet_vm_next_collection;
extern JANET_THREAD_LOCAL size_t janet_vm_block_count;
extern JANET_THREAD_LOCAL int janet_vm_gc_suspend;
/* GC roots */

View File

@@ -62,7 +62,7 @@ int janet_string_compare(const uint8_t *lhs, const uint8_t *rhs) {
int32_t ylen = janet_string_length(rhs);
int32_t len = xlen > ylen ? ylen : xlen;
int res = memcmp(lhs, rhs, len);
if (res) return res;
if (res) return res > 0 ? 1 : -1;
if (xlen == ylen) return 0;
return xlen < ylen ? -1 : 1;
}
@@ -176,6 +176,18 @@ static Janet cfun_string_slice(int32_t argc, Janet *argv) {
return janet_stringv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_symbol_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_symbolv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_keyword_slice(int32_t argc, Janet *argv) {
JanetByteView view = janet_getbytes(argv, 0);
JanetRange range = janet_getslice(argc, argv);
return janet_keywordv(view.bytes + range.start, range.end - range.start);
}
static Janet cfun_string_repeat(int32_t argc, Janet *argv) {
janet_fixarity(argc, 2);
JanetByteView view = janet_getbytes(argv, 0);
@@ -529,6 +541,16 @@ static const JanetReg string_cfuns[] = {
"from the end of the string. Note that index -1 is synonymous with "
"index (length bytes) to allow a full negative slice range. ")
},
{
"keyword/slice", cfun_keyword_slice,
JDOC("(keyword/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a keyword.")
},
{
"symbol/slice", cfun_symbol_slice,
JDOC("(symbol/slice bytes &opt start end)\n\n"
"Same a string/slice, but returns a symbol.")
},
{
"string/repeat", cfun_string_repeat,
JDOC("(string/repeat bytes n)\n\n"

View File

@@ -173,7 +173,7 @@ Janet janet_table_rawget(JanetTable *t, Janet key) {
Janet janet_table_remove(JanetTable *t, Janet key) {
JanetKV *bucket = janet_table_find(t, key);
if (NULL != bucket && !janet_checktype(bucket->key, JANET_NIL)) {
Janet ret = bucket->key;
Janet ret = bucket->value;
t->count--;
t->deleted++;
bucket->key = janet_wrap_nil();

View File

@@ -234,7 +234,7 @@ static void janet_waiter_init(JanetWaiter *waiter, double sec) {
if (waiter->timedwait) {
/* N seconds -> timespec of (now + sec) */
struct timespec now;
clock_gettime(CLOCK_REALTIME, &now);
janet_gettime(&now);
time_t tvsec = (time_t) floor(sec);
long tvnsec = (long) floor(1000000000.0 * (sec - ((double) tvsec)));
tvsec += now.tv_sec;
@@ -375,8 +375,12 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
/* Handle errors */
if (setjmp(buf)) {
/* Cleanup jmp_buf, keep lock */
/* Cleanup jmp_buf, return error.
* Do not ignore bad messages as before. */
janet_vm_jmp_buf = old_buf;
*msg_out = *janet_vm_return_reg;
janet_mailbox_unlock(mailbox);
return 2;
} else {
JanetBuffer *msgbuf = mailbox->messages + mailbox->messageFirst;
mailbox->messageCount--;
@@ -411,7 +415,6 @@ int janet_thread_receive(Janet *msg_out, double timeout) {
return 1;
}
}
}
static int janet_thread_getter(void *p, Janet key, Janet *out);
@@ -499,6 +502,10 @@ static int thread_worker(JanetMailboxPair *pair) {
/* Call function */
Janet argv[1] = { parentv };
fiber = janet_fiber(func, 64, 1, argv);
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
fiber->env = janet_table(0);
fiber->env->proto = janet_core_env(NULL);
}
JanetSignal sig = janet_continue(fiber, janet_wrap_nil(), &out);
if (sig != JANET_SIGNAL_OK && sig < JANET_SIGNAL_USER0) {
janet_eprintf("in thread %v: ", janet_wrap_abstract(janet_make_thread(pair->newbox, encode)));
@@ -660,6 +667,8 @@ static Janet cfun_thread_receive(int32_t argc, Janet *argv) {
break;
case 1:
janet_panicf("timeout after %f seconds", wait);
case 2:
janet_panicf("failed to receive message: %v", out);
}
return out;
}
@@ -671,6 +680,18 @@ static Janet cfun_thread_close(int32_t argc, Janet *argv) {
return janet_wrap_nil();
}
static Janet cfun_thread_exit(int32_t argc, Janet *argv) {
(void) argv;
janet_arity(argc, 0, 1);
#if defined(JANET_WINDOWS)
int32_t flag = janet_optinteger(argv, argc, 0, 0);
ExitThread(flag);
#else
pthread_exit(NULL);
#endif
return janet_wrap_nil();
}
static const JanetMethod janet_thread_methods[] = {
{"send", cfun_thread_send},
{"close", cfun_thread_close},
@@ -719,6 +740,12 @@ static const JanetReg threadlib_cfuns[] = {
"Close a thread, unblocking it and ending communication with it. Note that closing "
"a thread is idempotent and does not cancel the thread's operation. Returns nil.")
},
{
"thread/exit", cfun_thread_exit,
JDOC("(thread/exit &opt code)\n\n"
"Exit from the current thread. If no more threads are running, ends the process, but otherwise does "
"not end the current process.")
},
{NULL, NULL, NULL}
};

View File

@@ -26,6 +26,9 @@
#include "util.h"
#include "state.h"
#include "gc.h"
#ifdef JANET_WINDOWS
#include <windows.h>
#endif
#endif
#include <inttypes.h>
@@ -574,8 +577,12 @@ int janet_checksize(Janet x) {
if (!janet_checktype(x, JANET_NUMBER))
return 0;
double dval = janet_unwrap_number(x);
return dval == (double)((size_t) dval) &&
dval <= SIZE_MAX;
if (dval != (double)((size_t) dval)) return 0;
if (SIZE_MAX > JANET_INTMAX_INT64) {
return dval <= JANET_INTMAX_INT64;
} else {
return dval <= SIZE_MAX;
}
}
JanetTable *janet_get_core_table(const char *name) {
@@ -586,3 +593,40 @@ JanetTable *janet_get_core_table(const char *name) {
if (!janet_checktype(out, JANET_TABLE)) return NULL;
return janet_unwrap_table(out);
}
/* Clock shims for various platforms */
#ifdef JANET_GETTIME
/* For macos */
#ifdef __MACH__
#include <mach/clock.h>
#include <mach/mach.h>
#endif
#ifdef JANET_WINDOWS
int janet_gettime(struct timespec *spec) {
FILETIME ftime;
GetSystemTimeAsFileTime(&ftime);
int64_t wintime = (int64_t)(ftime.dwLowDateTime) | ((int64_t)(ftime.dwHighDateTime) << 32);
/* Windows epoch is January 1, 1601 apparently */
wintime -= 116444736000000000LL;
spec->tv_sec = wintime / 10000000LL;
/* Resolution is 100 nanoseconds. */
spec->tv_nsec = wintime % 10000000LL * 100;
return 0;
}
#elif defined(__MACH__)
int janet_gettime(struct timespec *spec) {
clock_serv_t cclock;
mach_timespec_t mts;
host_get_clock_service(mach_host_self(), CALENDAR_CLOCK, &cclock);
clock_get_time(cclock, &mts);
mach_port_deallocate(mach_task_self(), cclock);
spec->tv_sec = mts.tv_sec;
spec->tv_nsec = mts.tv_nsec;
return 0;
}
#else
int janet_gettime(struct timespec *spec) {
return clock_gettime(CLOCK_REALTIME, spec);
}
#endif
#endif

View File

@@ -31,6 +31,11 @@
#include <stdio.h>
#include <errno.h>
#if !defined(JANET_REDUCED_OS) || !defined(JANET_SINGLE_THREADED)
#include <time.h>
#define JANET_GETTIME
#endif
/* Handle runtime errors */
#ifndef JANET_EXIT
#include <stdio.h>
@@ -75,6 +80,7 @@ Janet janet_dict_get(const JanetKV *buckets, int32_t cap, Janet key);
void janet_memempty(JanetKV *mem, int32_t count);
void *janet_memalloc_empty(int32_t count);
JanetTable *janet_get_core_table(const char *name);
void janet_def_addflags(JanetFuncDef *def);
const void *janet_strbinsearch(
const void *tab,
size_t tabcount,
@@ -97,6 +103,11 @@ void janet_core_def(JanetTable *env, const char *name, Janet x, const void *p);
void janet_core_cfuns(JanetTable *env, const char *regprefix, const JanetReg *cfuns);
#endif
/* Clock gettime */
#ifdef JANET_GETTIME
int janet_gettime(struct timespec *spec);
#endif
/* Initialize builtin libraries */
void janet_lib_io(JanetTable *env);
void janet_lib_math(JanetTable *env);

View File

@@ -33,6 +33,7 @@
#include <math.h>
/* VM state */
JANET_THREAD_LOCAL JanetTable *janet_vm_top_dyns;
JANET_THREAD_LOCAL JanetTable *janet_vm_core_env;
JANET_THREAD_LOCAL JanetTable *janet_vm_registry;
JANET_THREAD_LOCAL JanetTable *janet_vm_abstract_registry;
@@ -373,8 +374,8 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
&&label_JOP_GREATER_THAN_EQUAL,
&&label_JOP_LESS_THAN_EQUAL,
&&label_JOP_NEXT,
&&label_unknown_op,
&&label_unknown_op,
&&label_JOP_NOT_EQUALS,
&&label_JOP_NOT_EQUALS_IMMEDIATE,
&&label_unknown_op,
&&label_unknown_op,
&&label_unknown_op,
@@ -787,6 +788,14 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) == CS);
vm_pcnext();
VM_OP(JOP_NOT_EQUALS)
stack[A] = janet_wrap_boolean(!janet_equals(stack[B], stack[C]));
vm_pcnext();
VM_OP(JOP_NOT_EQUALS_IMMEDIATE)
stack[A] = janet_wrap_boolean(janet_unwrap_integer(stack[B]) != CS);
vm_pcnext();
VM_OP(JOP_COMPARE)
stack[A] = janet_wrap_integer(janet_compare(stack[B], stack[C]));
vm_pcnext();
@@ -1394,11 +1403,8 @@ int janet_init(void) {
/* Garbage collection */
janet_vm_blocks = NULL;
janet_vm_next_collection = 0;
/* Setting memoryInterval to zero forces
* a collection pretty much every cycle, which is
* incredibly horrible for performance, but can help ensure
* there are no memory bugs during development */
janet_vm_gc_interval = 0x10000;
janet_vm_gc_interval = 0x400000;
janet_vm_block_count = 0;
janet_symcache_init();
/* Initialize gc roots */
janet_vm_roots = NULL;
@@ -1419,6 +1425,8 @@ int janet_init(void) {
janet_vm_traversal_top = NULL;
/* Core env */
janet_vm_core_env = NULL;
/* Dynamic bindings */
janet_vm_top_dyns = NULL;
/* Seed RNG */
janet_rng_seed(janet_default_rng(), 0);
/* Fibers */
@@ -1443,6 +1451,7 @@ void janet_deinit(void) {
janet_vm_registry = NULL;
janet_vm_abstract_registry = NULL;
janet_vm_core_env = NULL;
janet_vm_top_dyns = NULL;
free(janet_vm_traversal_base);
janet_vm_fiber = NULL;
janet_vm_root_fiber = NULL;

View File

@@ -127,6 +127,12 @@ extern "C" {
#define JANET_LITTLE_ENDIAN 1
#endif
/* Limits for converting doubles to 64 bit integers */
#define JANET_INTMAX_DOUBLE 9007199254740992.0
#define JANET_INTMIN_DOUBLE (-9007199254740992.0)
#define JANET_INTMAX_INT64 9007199254740992
#define JANET_INTMIN_INT64 (-9007199254740992)
/* Check emscripten */
#ifdef __EMSCRIPTEN__
#define JANET_NO_DYNAMIC_MODULES
@@ -706,7 +712,7 @@ JANET_API int janet_checkint64(Janet x);
JANET_API int janet_checksize(Janet x);
JANET_API JanetAbstract janet_checkabstract(Janet x, const JanetAbstractType *at);
#define janet_checkintrange(x) ((x) >= INT32_MIN && (x) <= INT32_MAX && (x) == (int32_t)(x))
#define janet_checkint64range(x) ((x) >= INT64_MIN && (x) <= INT64_MAX && (x) == (int64_t)(x))
#define janet_checkint64range(x) ((x) >= JANET_INTMIN_DOUBLE && (x) <= JANET_INTMAX_DOUBLE && (x) == (int64_t)(x))
#define janet_unwrap_integer(x) ((int32_t) janet_unwrap_number(x))
#define janet_wrap_integer(x) janet_wrap_number((int32_t)(x))
@@ -996,7 +1002,7 @@ struct JanetRNG {
typedef struct JanetFile JanetFile;
struct JanetFile {
FILE *file;
int flags;
int32_t flags;
};
/* Thread types */
@@ -1118,6 +1124,8 @@ enum JanetOpCode {
JOP_GREATER_THAN_EQUAL,
JOP_LESS_THAN_EQUAL,
JOP_NEXT,
JOP_NOT_EQUALS,
JOP_NOT_EQUALS_IMMEDIATE,
JOP_INSTRUCTION_COUNT
};
@@ -1302,6 +1310,7 @@ JANET_API void janet_table_merge_table(JanetTable *table, JanetTable *other);
JANET_API void janet_table_merge_struct(JanetTable *table, JanetStruct other);
JANET_API JanetKV *janet_table_find(JanetTable *t, Janet key);
JANET_API JanetTable *janet_table_clone(JanetTable *table);
JANET_API void janet_table_clear(JanetTable *table);
/* Fiber */
JANET_API JanetFiber *janet_fiber(JanetFunction *callee, int32_t capacity, int32_t argc, const Janet *argv);
@@ -1525,11 +1534,11 @@ extern JANET_API const JanetAbstractType janet_file_type;
#define JANET_FILE_SERIALIZABLE 128
#define JANET_FILE_PIPED 256
JANET_API Janet janet_makefile(FILE *f, int flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int *flags);
JANET_API Janet janet_makefile(FILE *f, int32_t flags);
JANET_API FILE *janet_getfile(const Janet *argv, int32_t n, int32_t *flags);
JANET_API FILE *janet_dynfile(const char *name, FILE *def);
JANET_API JanetAbstract janet_checkfile(Janet j);
JANET_API FILE *janet_unwrapfile(Janet j, int *flags);
JANET_API FILE *janet_unwrapfile(Janet j, int32_t *flags);
/* Marshal API */
JANET_API void janet_marshal_size(JanetMarshalContext *ctx, size_t value);

View File

@@ -84,7 +84,7 @@ static void simpleline(JanetBuffer *buffer) {
}
/* Windows */
#ifdef JANET_WINDOWS
#if defined(JANET_WINDOWS) || defined(JANET_SIMPLE_GETLINE)
void janet_line_init() {
;
@@ -126,21 +126,28 @@ https://github.com/antirez/linenoise/blob/master/linenoise.c
#define JANET_LINE_MAX 1024
#define JANET_MATCH_MAX 256
#define JANET_HISTORY_MAX 100
static JANET_THREAD_LOCAL int gbl_israwmode = 0;
static JANET_THREAD_LOCAL const char *gbl_prompt = "> ";
static JANET_THREAD_LOCAL int gbl_plen = 2;
static JANET_THREAD_LOCAL char gbl_buf[JANET_LINE_MAX];
static JANET_THREAD_LOCAL int gbl_len = 0;
static JANET_THREAD_LOCAL int gbl_pos = 0;
static JANET_THREAD_LOCAL int gbl_cols = 80;
static JANET_THREAD_LOCAL char *gbl_history[JANET_HISTORY_MAX];
static JANET_THREAD_LOCAL int gbl_history_count = 0;
static JANET_THREAD_LOCAL int gbl_historyi = 0;
static JANET_THREAD_LOCAL int gbl_sigint_flag = 0;
static JANET_THREAD_LOCAL struct termios gbl_termios_start;
static JANET_THREAD_LOCAL JanetByteView gbl_matches[JANET_MATCH_MAX];
static JANET_THREAD_LOCAL int gbl_match_count = 0;
static JANET_THREAD_LOCAL int gbl_lines_below = 0;
static int gbl_israwmode = 0;
static const char *gbl_prompt = "> ";
static int gbl_plen = 2;
static char gbl_buf[JANET_LINE_MAX];
static int gbl_len = 0;
static int gbl_pos = 0;
static int gbl_cols = 80;
static char *gbl_history[JANET_HISTORY_MAX];
static int gbl_history_count = 0;
static int gbl_historyi = 0;
static int gbl_sigint_flag = 0;
static struct termios gbl_termios_start;
static JanetByteView gbl_matches[JANET_MATCH_MAX];
static int gbl_match_count = 0;
static int gbl_lines_below = 0;
/* Put a lock around this global state so we don't screw up
* the terminal in a multithreaded situation */
#ifndef JANET_SINGLE_THREADED
#include <pthread.h>
static pthread_mutex_t gbl_lock = PTHREAD_MUTEX_INITIALIZER;
#endif
/* Unsupported terminal list from linenoise */
static const char *badterms[] = {
@@ -162,6 +169,9 @@ static char *sdup(const char *s) {
/* Ansi terminal raw mode */
static int rawmode(void) {
struct termios t;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_lock(&gbl_lock);
#endif
if (!isatty(STDIN_FILENO)) goto fatal;
if (tcgetattr(STDIN_FILENO, &gbl_termios_start) == -1) goto fatal;
t = gbl_termios_start;
@@ -175,6 +185,9 @@ static int rawmode(void) {
return 0;
fatal:
errno = ENOTTY;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
return -1;
}
@@ -182,6 +195,9 @@ fatal:
static void norawmode(void) {
if (gbl_israwmode && tcsetattr(STDIN_FILENO, TCSAFLUSH, &gbl_termios_start) != -1)
gbl_israwmode = 0;
#ifndef JANET_SINGLE_THREADED
pthread_mutex_unlock(&gbl_lock);
#endif
}
static int curpos(void) {
@@ -996,6 +1012,11 @@ int main(int argc, char **argv) {
SetConsoleOutputCP(65001);
#endif
#if !defined(JANET_WINDOWS) && !defined(JANET_SIMPLE_GETLINE)
/* Try and not leave the terminal in a bad state */
atexit(norawmode);
#endif
/* Set up VM */
janet_init();

View File

@@ -337,9 +337,9 @@
## Polymorphic comparison -- Issue #272
# confirm polymorphic comparison delegation to primitive comparators:
(assert (= 0 (compare-primitive 3 3)) "compare-primitive integers (1)")
(assert (= -1 (compare-primitive 3 5)) "compare-primitive integers (2)")
(assert (= 1 (compare-primitive "foo" "bar")) "compare-primitive strings")
(assert (= 0 (cmp 3 3)) "compare-primitive integers (1)")
(assert (= -1 (cmp 3 5)) "compare-primitive integers (2)")
(assert (= 1 (cmp "foo" "bar")) "compare-primitive strings")
(assert (= 0 (compare 1 1)) "compare integers (1)")
(assert (= -1 (compare 1 2)) "compare integers (2)")
(assert (= 1 (compare "foo" "bar")) "compare strings (1)")
@@ -372,9 +372,9 @@
@{:type :mynum :v 0 :compare
(fn [self other]
(case (type other)
:number (compare-primitive (self :v) other)
:number (cmp (self :v) other)
:table (when (= (get other :type) :mynum)
(compare-primitive (self :v) (other :v)))))})
(cmp (self :v) (other :v)))))})
(let [n3 (table/setproto @{:v 3} mynum)]
(assert (= 0 (compare 3 n3)) "compare num to object (1)")
@@ -386,17 +386,14 @@
(assert (compare= 3 n3 (table/setproto @{:v 3} mynum)) "compare= poly")
(assert (deep= (sorted @[4 5 n3 2] compare<) @[2 n3 4 5]) "polymorphic sort"))
(let [
MAX_INT_64_STRING "9223372036854775807"
(let [MAX_INT_64_STRING "9223372036854775807"
MAX_UINT_64_STRING "18446744073709551615"
MAX_INT_IN_DBL_STRING "9007199254740991"
NAN (math/log -1)
INF (/ 1 0)
MINUS_INF (/ -1 0)
compare-poly-tests
[
[(int/s64 3) (int/u64 3) 0]
[[(int/s64 3) (int/u64 3) 0]
[(int/s64 -3) (int/u64 3) -1]
[(int/s64 3) (int/u64 2) 1]
[(int/s64 3) 3 0] [(int/s64 3) 4 -1] [(int/s64 3) -9 1]
@@ -409,11 +406,16 @@
[(+ 1 (int/u64 MAX_INT_IN_DBL_STRING)) (scan-number MAX_INT_IN_DBL_STRING) 1]
[(int/s64 0) INF -1] [(int/u64 0) INF -1]
[MINUS_INF (int/u64 0) -1] [MINUS_INF (int/s64 0) -1]
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]
]]
[(int/s64 1) NAN 0] [NAN (int/u64 1) 0]]]
(each [x y c] compare-poly-tests
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c)))
)
(assert (= c (compare x y)) (string/format "compare polymorphic %q %q %d" x y c))))
(assert (= nil (any? [])) "any? 1")
(assert (= nil (any? [false nil])) "any? 2")
(assert (= nil (any? [nil false])) "any? 3")
(assert (= 1 (any? [1])) "any? 4")
(assert (nan? (any? [nil math/nan nil])) "any? 5")
(assert (= true (any? [nil nil false nil nil true nil nil nil nil false :a nil])) "any? 6")
(end-suite)

View File

@@ -315,4 +315,9 @@
(assert (= 40 counter) "if-with 1")
(def a @[])
(eachk x [:a :b :c :d]
(array/push a x))
(assert (deep= (range 4) a) "eachk 1")
(end-suite)

View File

@@ -36,7 +36,7 @@
:loop (/ (* "[" :main "]") ,(fn [& captures]
~(while (not= (get DATA POS) 0)
,;captures)))
:main (any (+ :s :loop :+ :- :> :< :.)) }))
:main (any (+ :s :loop :+ :- :> :< :.))}))
(defn bf
"Run brainfuck."
@@ -233,8 +233,8 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(gccollect)
(def v (unmarshal
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
@"\xD7\xCD0\xD4000000\0\x03\x01\xCE\00\0\x01\0\0000\x03\0\0\0000000000\xCC0\0000"
load-image-dict))
(gccollect)
# in vs get regression
@@ -271,7 +271,7 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
:packet-body '(lenprefix (-> :header-len) 1)
# header, followed by body, and drop the :header-len capture
:packet (/ (* :packet-header :packet-body) ,|$1)
:packet (/ (* :packet-header :packet-body) ,|$1)
# any exact seqence of packets (no extra characters)
:main (* (any :packet) -1)}))
@@ -307,4 +307,46 @@ neldb\0\0\0\xD8\x05printG\x01\0\xDE\xDE\xDE'\x03\0marshal_tes/\x02
(assert (:match peg5 "abcabcabcac") "repeat alias 2")
(assert (not (:match peg5 "abcabc")) "repeat alias 3")
(defn check-jdn [x]
(assert (deep= (parse (string/format "%j" x)) x) "round trip jdn"))
(check-jdn 0)
(check-jdn nil)
(check-jdn [])
(check-jdn @[[] [] 1231 9.123123 -123123 0.1231231230001])
(check-jdn -0.123123123123)
(check-jdn 12837192371923)
(check-jdn "a string")
(check-jdn @"a buffer")
# Issue 428
(var result nil)
(defn f [] (yield {:a :ok}))
(assert-no-error "issue 428 1" (loop [{:a x} :generate (fiber/new f)] (set result x)))
(assert (= result :ok) "issue 428 2")
# Inline 3 argument get
(assert (= 10 (do (var a 10) (set a (get '{} :a a)))) "inline get 1")
# Keyword and Symbol slice
(assert (= :keyword (keyword/slice "some_keyword_slice" 5 12)) "keyword slice")
(assert (= 'symbol (symbol/slice "some_symbol_slice" 5 11)) "symbol slice")
# Peg find and find-all
(def p "/usr/local/bin/janet")
(assert (= (peg/find '"n/" p) 13) "peg find 1")
(assert (not (peg/find '"t/" p)) "peg find 2")
(assert (deep= (peg/find-all '"/" p) @[0 4 10 14]) "peg find-all")
# Peg replace and replace-all
(var ti 0)
(defn check-replacer
[x y z]
(assert (= (string/replace x y z) (string (peg/replace x y z))) "replacer test replace")
(assert (= (string/replace-all x y z) (string (peg/replace-all x y z))) "replacer test replace-all"))
(check-replacer "abc" "Z" "abcabcabcabasciabsabc")
(check-replacer "abc" "Z" "")
(check-replacer "aba" "ZZZZZZ" "ababababababa")
(check-replacer "aba" "" "ababababababa")
(end-suite)

View File

@@ -20,7 +20,7 @@
(def- replace-peg
(peg/compile
~(% (* '(to "###START###")
(constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(def install-paths %j)" install-paths))
(constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
(thru "###END###")
'(any 1)))))