mirror of
https://github.com/janet-lang/janet
synced 2024-11-24 17:27:18 +00:00
Merge branch 'master' into ev
This commit is contained in:
Calvin Rose
commit
328ee94412
0
.gitattributes
vendored
0
.gitattributes
vendored
30
CHANGELOG.md
30
CHANGELOG.md
@ -2,7 +2,35 @@
|
||||
All notable changes to this project will be documented in this file.
|
||||
|
||||
## Unreleased - ???
|
||||
- Add JANET_GIT environment variable to jpm to use a specific git binary (useful mainly on windows).
|
||||
- `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.
|
||||
- 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.
|
||||
- Add `:h`, `:a`, and `:c` flags to `thread/new` for creating new kinds of threads.
|
||||
By default, threads will now consume much less memory per thread, but sending data between
|
||||
threads may cost more.
|
||||
- Fix flychecking when using the `use` macro.
|
||||
- CTRL-C no longer exits the repl, and instead cancels the current form.
|
||||
- Various small bug fixes
|
||||
- New MSI installer instead of NSIS based installer.
|
||||
- Make `os/realpath` work on windows.
|
||||
- Add polymorphic `compare` functions for comparing numbers.
|
||||
- Add `to` and `thru` peg combinators.
|
||||
- Add `JANET_GIT` environment variable to jpm to use a specific git binary (useful mainly on windows).
|
||||
- `asm` and `disasm` functions now use keywords instead of macros for keys. Also
|
||||
some slight changes to the way constants are encoded (remove wrapping `quote` in some cases).
|
||||
- Expose current macro form inside macros as (dyn :macro-form)
|
||||
|
||||
10
Makefile
10
Makefile
@ -150,7 +150,7 @@ build/janet.c: build/janet_boot src/boot/boot.janet
|
||||
##### Amalgamation #####
|
||||
########################
|
||||
|
||||
SONAME=libjanet.so.1.9
|
||||
SONAME=libjanet.so.1.10
|
||||
|
||||
build/shell.c: src/mainclient/shell.c
|
||||
cp $< $@
|
||||
@ -234,6 +234,10 @@ build/doc.html: $(JANET_TARGET) tools/gendoc.janet
|
||||
##### Installation #####
|
||||
########################
|
||||
|
||||
build/jpm: jpm $(JANET_TARGET)
|
||||
$(JANET_TARGET) tools/patch-jpm.janet jpm build/jpm "--libpath=$(LIBDIR)" "--headerpath=$(INCLUDEDIR)/janet" "--binpath=$(BINDIR)"
|
||||
chmod +x build/jpm
|
||||
|
||||
.INTERMEDIATE: build/janet.pc
|
||||
build/janet.pc: $(JANET_TARGET)
|
||||
echo 'prefix=$(PREFIX)' > $@
|
||||
@ -249,7 +253,7 @@ build/janet.pc: $(JANET_TARGET)
|
||||
echo 'Libs: -L$${libdir} -ljanet' >> $@
|
||||
echo 'Libs.private: $(CLIBS)' >> $@
|
||||
|
||||
install: $(JANET_TARGET) build/janet.pc
|
||||
install: $(JANET_TARGET) build/janet.pc build/jpm
|
||||
mkdir -p '$(DESTDIR)$(BINDIR)'
|
||||
cp $(JANET_TARGET) '$(DESTDIR)$(BINDIR)/janet'
|
||||
mkdir -p '$(DESTDIR)$(INCLUDEDIR)/janet'
|
||||
@ -260,7 +264,7 @@ install: $(JANET_TARGET) build/janet.pc
|
||||
cp $(JANET_STATIC_LIBRARY) '$(DESTDIR)$(LIBDIR)/libjanet.a'
|
||||
ln -sf $(SONAME) '$(DESTDIR)$(LIBDIR)/libjanet.so'
|
||||
ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(DESTDIR)$(LIBDIR)/$(SONAME)
|
||||
cp -rf jpm '$(DESTDIR)$(BINDIR)'
|
||||
cp -rf build/jpm '$(DESTDIR)$(BINDIR)'
|
||||
mkdir -p '$(DESTDIR)$(MANPATH)'
|
||||
cp janet.1 '$(DESTDIR)$(MANPATH)'
|
||||
cp jpm.1 '$(DESTDIR)$(MANPATH)'
|
||||
|
||||
@ -146,6 +146,7 @@ cd janet
|
||||
meson setup build \
|
||||
--buildtype release \
|
||||
--optimization 2 \
|
||||
--libdir /usr/local/lib \
|
||||
-Dgit_hash=$(git log --pretty=format:'%h' -n 1)
|
||||
ninja -C build
|
||||
|
||||
|
||||
140
jpm
140
jpm
@ -19,6 +19,9 @@
|
||||
# Defaults
|
||||
#
|
||||
|
||||
###START###
|
||||
|
||||
# Overriden on some installs.
|
||||
(def- exe-dir
|
||||
"Directory containing jpm script"
|
||||
(do
|
||||
@ -26,21 +29,28 @@
|
||||
(def i (last (string/find-all sep exe)))
|
||||
(slice exe 0 i)))
|
||||
|
||||
(def JANET_MODPATH (or (os/getenv "JANET_MODPATH") (dyn :syspath)))
|
||||
(defn- install-paths []
|
||||
{:headerpath (os/realpath (string exe-dir "/../include/janet"))
|
||||
:libpath (os/realpath (string exe-dir "/../lib"))
|
||||
:binpath exe-dir})
|
||||
|
||||
###END###
|
||||
|
||||
# Default based on janet binary location
|
||||
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
||||
(string exe-dir "/../include/janet")))
|
||||
(get (install-paths) :headerpath)))
|
||||
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
||||
(string exe-dir "/../lib")))
|
||||
|
||||
(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"))
|
||||
exe-dir))
|
||||
(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)))
|
||||
|
||||
#
|
||||
# Utilities
|
||||
@ -66,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
|
||||
@ -78,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
|
||||
@ -175,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."
|
||||
@ -201,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."
|
||||
@ -244,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
|
||||
@ -310,26 +329,30 @@
|
||||
# Detect threads
|
||||
(def env (fiber/getenv (fiber/current)))
|
||||
(def threads? (not (not (env 'thread/new))))
|
||||
|
||||
# Default libraries to link
|
||||
(def- thread-flags
|
||||
(if is-win []
|
||||
(if threads? ["-lpthread"] [])))
|
||||
|
||||
# lflags needed for the janet binary.
|
||||
# flags needed for the janet binary and compiling standalone
|
||||
# executables.
|
||||
(def janet-lflags
|
||||
(case (os/which)
|
||||
:macos ["-ldl" "-lm" ;thread-flags]
|
||||
:windows [;thread-flags]
|
||||
:linux ["-lm" "-ldl" "-lrt" ;thread-flags]
|
||||
["-lm" ;thread-flags]))
|
||||
(def janet-ldflags [])
|
||||
(def janet-cflags [])
|
||||
|
||||
# Default flags for natives, but not required
|
||||
# How can we better detect the need for -pthread?
|
||||
# we probably want to better detect compiler
|
||||
(def default-lflags (if is-win ["/nologo"] []))
|
||||
(def default-cflags
|
||||
(if is-win
|
||||
["/nologo" "/MD"]
|
||||
["-std=c99" "-Wall" "-Wextra"]))
|
||||
(def default-ldflags [])
|
||||
|
||||
# Required flags for dynamic libraries. These
|
||||
# are used no matter what for dynamic libraries.
|
||||
@ -339,7 +362,7 @@
|
||||
["-fPIC"]))
|
||||
(def- dynamic-lflags
|
||||
(if is-win
|
||||
["/DLL" ;thread-flags]
|
||||
["/DLL"]
|
||||
(if is-mac
|
||||
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
|
||||
["-shared" ;thread-flags])))
|
||||
@ -385,8 +408,8 @@
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(if value
|
||||
(string (if is-win "/D" "-D") define "=" value)
|
||||
(string (if is-win "/D" "-D") define)))
|
||||
(string "-D" define "=" value)
|
||||
(string "-D" define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
@ -398,8 +421,8 @@
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
@[;(opt opts :cflags default-cflags)
|
||||
(string (if is-win "/I" "-I") (dyn :headerpath JANET_HEADERPATH))
|
||||
(string (if is-win "/O" "-O") (opt opts :optimize 2))])
|
||||
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
||||
(string "-O" (opt opts :optimize 2))])
|
||||
|
||||
(defn- entry-name
|
||||
"Name of symbol that enters static compilation of a module."
|
||||
@ -585,7 +608,8 @@ int main(int argc, const char **argv) {
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
(rule dest [source]
|
||||
(def no-compile (opts :no-compile))
|
||||
(rule (if no-compile cimage_dest dest) [source]
|
||||
(check-cc)
|
||||
(print "generating executable c source...")
|
||||
(create-dirs dest)
|
||||
@ -641,11 +665,11 @@ int main(int argc, const char **argv) {
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations) :ab)
|
||||
# Compile and link final exectable
|
||||
(do
|
||||
(unless no-compile
|
||||
(def cc (opt opts :compiler default-compiler))
|
||||
(def ldflags [;dep-ldflags ;(opt opts :ldflags [])])
|
||||
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;janet-ldflags])
|
||||
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
|
||||
(def cflags (getcflags opts))
|
||||
(def cflags [;(getcflags opts) ;janet-cflags])
|
||||
(def defines (make-defines (opt opts :defines {})))
|
||||
(print "compiling and linking " dest "...")
|
||||
(if is-win
|
||||
@ -728,7 +752,7 @@ 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)
|
||||
@ -747,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]
|
||||
@ -884,17 +908,22 @@ int main(int argc, const char **argv) {
|
||||
is marshalled into bytecode which is then embedded in a final executable for distribution.\n\n
|
||||
This executable can be installed as well to the --binpath given."
|
||||
[&keys {:install install :name name :entry entry :headers headers
|
||||
:cflags cflags :lflags lflags :deps deps :ldflags ldflags}]
|
||||
:cflags cflags :lflags lflags :deps deps :ldflags ldflags
|
||||
:no-compile no-compile}]
|
||||
(def name (if is-win (string name ".exe") name))
|
||||
(def dest (string "build" sep name))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags} entry dest)
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
(when deps
|
||||
(each d deps (add-dep dest d)))
|
||||
(when install
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
|
||||
(if no-compile
|
||||
(let [cdest (string dest ".c")]
|
||||
(add-dep "build" cdest))
|
||||
(do
|
||||
(add-dep "build" dest)
|
||||
(when headers
|
||||
(each h headers (add-dep dest h)))
|
||||
(when deps
|
||||
(each d deps (add-dep dest d)))
|
||||
(when install
|
||||
(install-rule dest (dyn :binpath JANET_BINPATH))))))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script. Creates
|
||||
@ -908,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))
|
||||
@ -926,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
|
||||
@ -973,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")))
|
||||
@ -985,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) "'."))
|
||||
|
||||
17
meson.build
17
meson.build
@ -20,7 +20,7 @@
|
||||
|
||||
project('janet', 'c',
|
||||
default_options : ['c_std=c99', 'b_lundef=false', 'default_library=both'],
|
||||
version : '1.10.0')
|
||||
version : '1.10.2')
|
||||
|
||||
# Global settings
|
||||
janet_path = join_paths(get_option('prefix'), get_option('libdir'), 'janet')
|
||||
@ -247,7 +247,18 @@ pkg.generate(libjanet,
|
||||
|
||||
# Installation
|
||||
install_man('janet.1')
|
||||
install_man('jpm.1')
|
||||
install_headers(['src/include/janet.h', jconf], subdir: 'janet')
|
||||
install_data(sources : ['jpm'], install_dir : get_option('bindir'))
|
||||
install_data(sources : ['tools/.keep'], install_dir : join_paths(get_option('libdir'), 'janet'))
|
||||
if get_option('peg') and not get_option('reduced_os') and get_option('processes')
|
||||
install_man('jpm.1')
|
||||
patched_jpm = custom_target('patched-jpm',
|
||||
input : ['tools/patch-jpm.janet', 'jpm'],
|
||||
install : true,
|
||||
install_dir : get_option('bindir'),
|
||||
build_by_default : true,
|
||||
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'),
|
||||
'--headerpath=' + join_paths(get_option('prefix'), get_option('includedir'))])
|
||||
endif
|
||||
|
||||
@ -433,6 +433,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]
|
||||
|
||||
@ -470,12 +481,7 @@
|
||||
:pairs (keys-template binding object true [rest])
|
||||
:in (each-template binding object [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 for
|
||||
@ -493,6 +499,18 @@
|
||||
[x ds & body]
|
||||
(keys-template x ds true 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 each
|
||||
"Loop over each value in ds. Returns nil."
|
||||
[x ds & body]
|
||||
@ -542,6 +560,7 @@
|
||||
(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.
|
||||
|
||||
@ -28,9 +28,9 @@
|
||||
|
||||
#define JANET_VERSION_MAJOR 1
|
||||
#define JANET_VERSION_MINOR 10
|
||||
#define JANET_VERSION_PATCH 0
|
||||
#define JANET_VERSION_PATCH 2
|
||||
#define JANET_VERSION_EXTRA "-dev"
|
||||
#define JANET_VERSION "1.10.0"
|
||||
#define JANET_VERSION "1.10.2-dev"
|
||||
|
||||
/* #define JANET_BUILD "local" */
|
||||
|
||||
|
||||
@ -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}
|
||||
};
|
||||
|
||||
|
||||
@ -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"
|
||||
|
||||
@ -325,7 +325,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 +337,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) {
|
||||
|
||||
@ -206,14 +206,14 @@ static Janet cfun_it_u64_new(int32_t argc, Janet *argv) {
|
||||
// In the following code explicit casts are sometimes used to help
|
||||
// make it clear when int/float conversions are happening.
|
||||
//
|
||||
static int64_t compare_double_double(double x, double y) {
|
||||
static int compare_double_double(double x, double y) {
|
||||
return (x < y) ? -1 : ((x > y) ? 1 : 0);
|
||||
}
|
||||
|
||||
static int64_t compare_int64_double(int64_t x, double y) {
|
||||
static int compare_int64_double(int64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if ((y > ((double) - MAX_INT_IN_DBL)) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
} else if ((y > (- ((double) MAX_INT_IN_DBL))) && (y < ((double) MAX_INT_IN_DBL))) {
|
||||
double dx = (double) x;
|
||||
return compare_double_double(dx, y);
|
||||
} else if (y > ((double) INT64_MAX)) {
|
||||
@ -226,7 +226,7 @@ static int64_t compare_int64_double(int64_t x, double y) {
|
||||
}
|
||||
}
|
||||
|
||||
static int64_t compare_uint64_double(uint64_t x, double y) {
|
||||
static int compare_uint64_double(uint64_t x, double y) {
|
||||
if (isnan(y)) {
|
||||
return 0; // clojure and python do this
|
||||
} else if (y < 0) {
|
||||
|
||||
@ -1225,6 +1225,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 +1237,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) {
|
||||
|
||||
@ -123,9 +123,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) {
|
||||
@ -354,12 +351,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 +995,6 @@ void janet_buffer_format(
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
#undef HEX
|
||||
#undef BUFSIZE
|
||||
|
||||
@ -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 {
|
||||
|
||||
@ -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;
|
||||
|
||||
|
||||
@ -66,9 +66,15 @@ struct JanetMailbox {
|
||||
JanetBuffer messages[];
|
||||
};
|
||||
|
||||
#define JANET_THREAD_HEAVYWEIGHT 0x1
|
||||
#define JANET_THREAD_ABSTRACTS 0x2
|
||||
#define JANET_THREAD_CFUNCTIONS 0x4
|
||||
static const char janet_thread_flags[] = "hac";
|
||||
|
||||
typedef struct {
|
||||
JanetMailbox *original;
|
||||
JanetMailbox *newbox;
|
||||
uint64_t flags;
|
||||
} JanetMailboxPair;
|
||||
|
||||
static JANET_THREAD_LOCAL JanetMailbox *janet_vm_mailbox = NULL;
|
||||
@ -175,7 +181,7 @@ static int thread_mark(void *p, size_t size) {
|
||||
return 0;
|
||||
}
|
||||
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
|
||||
static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original, uint64_t flags) {
|
||||
JanetMailboxPair *pair = malloc(sizeof(JanetMailboxPair));
|
||||
if (NULL == pair) {
|
||||
JANET_OUT_OF_MEMORY;
|
||||
@ -183,6 +189,7 @@ static JanetMailboxPair *make_mailbox_pair(JanetMailbox *original) {
|
||||
pair->original = original;
|
||||
janet_mailbox_ref(original, 1);
|
||||
pair->newbox = janet_mailbox_create(1, 16);
|
||||
pair->flags = flags;
|
||||
return pair;
|
||||
}
|
||||
|
||||
@ -442,16 +449,44 @@ static int thread_worker(JanetMailboxPair *pair) {
|
||||
janet_init();
|
||||
|
||||
/* Get dictionaries for default encode/decode */
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
JanetTable *encode;
|
||||
if (pair->flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
janet_vm_thread_decode = janet_table(0);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_thread_decode));
|
||||
}
|
||||
|
||||
/* Create parent thread */
|
||||
JanetThread *parent = janet_make_thread(pair->original, encode);
|
||||
Janet parentv = janet_wrap_abstract(parent);
|
||||
|
||||
/* Unmarshal the abstract registry */
|
||||
if (pair->flags & JANET_THREAD_ABSTRACTS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
janet_vm_abstract_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_abstract_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the normal registry */
|
||||
if (pair->flags & JANET_THREAD_CFUNCTIONS) {
|
||||
Janet reg;
|
||||
int status = janet_thread_receive(®, INFINITY);
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(reg, JANET_TABLE)) goto error;
|
||||
janet_gcunroot(janet_wrap_table(janet_vm_registry));
|
||||
janet_vm_registry = janet_unwrap_table(reg);
|
||||
janet_gcroot(janet_wrap_table(janet_vm_registry));
|
||||
}
|
||||
|
||||
/* Unmarshal the function */
|
||||
Janet funcv;
|
||||
int status = janet_thread_receive(&funcv, INFINITY);
|
||||
|
||||
if (status) goto error;
|
||||
if (!janet_checktype(funcv, JANET_FUNCTION)) goto error;
|
||||
JanetFunction *func = janet_unwrap_function(funcv);
|
||||
@ -558,22 +593,40 @@ static Janet cfun_thread_current(int32_t argc, Janet *argv) {
|
||||
}
|
||||
|
||||
static Janet cfun_thread_new(int32_t argc, Janet *argv) {
|
||||
janet_arity(argc, 1, 2);
|
||||
janet_arity(argc, 1, 3);
|
||||
/* Just type checking */
|
||||
janet_getfunction(argv, 0);
|
||||
int32_t cap = janet_optinteger(argv, argc, 1, 10);
|
||||
if (cap < 1 || cap > UINT16_MAX) {
|
||||
janet_panicf("bad slot #1, expected integer in range [1, 65535], got %d", cap);
|
||||
}
|
||||
JanetTable *encode = janet_get_core_table("make-image-dict");
|
||||
uint64_t flags = argc >= 3 ? janet_getflags(argv, 2, janet_thread_flags) : JANET_THREAD_ABSTRACTS;
|
||||
JanetTable *encode;
|
||||
if (flags & JANET_THREAD_HEAVYWEIGHT) {
|
||||
encode = janet_get_core_table("make-image-dict");
|
||||
} else {
|
||||
encode = NULL;
|
||||
}
|
||||
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox);
|
||||
JanetMailboxPair *pair = make_mailbox_pair(janet_vm_mailbox, flags);
|
||||
JanetThread *thread = janet_make_thread(pair->newbox, encode);
|
||||
if (janet_thread_start_child(pair)) {
|
||||
destroy_mailbox_pair(pair);
|
||||
janet_panic("could not start thread");
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_ABSTRACTS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_abstract_registry), INFINITY)) {
|
||||
janet_panic("could not send abstract registry to thread");
|
||||
}
|
||||
}
|
||||
|
||||
if (flags & JANET_THREAD_CFUNCTIONS) {
|
||||
if (janet_thread_send(thread, janet_wrap_table(janet_vm_registry), INFINITY)) {
|
||||
janet_panic("could not send registry to thread");
|
||||
}
|
||||
}
|
||||
|
||||
/* If thread started, send the worker function. */
|
||||
if (janet_thread_send(thread, argv[0], INFINITY)) {
|
||||
janet_panicf("could not send worker function %v to thread", argv[0]);
|
||||
@ -638,10 +691,14 @@ static const JanetReg threadlib_cfuns[] = {
|
||||
},
|
||||
{
|
||||
"thread/new", cfun_thread_new,
|
||||
JDOC("(thread/new func &opt capacity)\n\n"
|
||||
JDOC("(thread/new func &opt capacity flags)\n\n"
|
||||
"Start a new thread that will start immediately. "
|
||||
"If capacity is provided, that is how many messages can be stored in the thread's mailbox before blocking senders. "
|
||||
"The capacity must be between 1 and 65535 inclusive, and defaults to 10. "
|
||||
"Can optionally provide flags to the new thread - supported flags are:\n"
|
||||
"\t:h - Start a heavyweight thread. This loads the core environment by default, so may use more memory initially. Messages may compress better, though.\n"
|
||||
"\t:a - Allow sending over registered abstract types to the new thread\n"
|
||||
"\t:c - Send over cfunction information to the new thread.\n"
|
||||
"Returns a handle to the new thread.")
|
||||
},
|
||||
{
|
||||
|
||||
@ -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;
|
||||
@ -929,7 +930,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
janet_stack_frame(stack)->pc = pc;
|
||||
if (janet_fiber_funcframe(fiber, func)) {
|
||||
@ -968,7 +969,7 @@ static JanetSignal run_vm(JanetFiber *fiber, Janet in) {
|
||||
if (janet_checktype(callee, JANET_FUNCTION)) {
|
||||
func = janet_unwrap_function(callee);
|
||||
if (func->gc.flags & JANET_FUNCFLAG_TRACE) {
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, stack);
|
||||
vm_do_trace(func, fiber->stacktop - fiber->stackstart, fiber->data + fiber->stackstart);
|
||||
}
|
||||
if (janet_fiber_funcframe_tail(fiber, func)) {
|
||||
janet_stack_frame(fiber->data + fiber->frame)->pc = pc;
|
||||
@ -1419,6 +1420,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 */
|
||||
@ -1449,6 +1452,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;
|
||||
|
||||
@ -1373,6 +1373,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);
|
||||
|
||||
@ -307,4 +307,22 @@ 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")
|
||||
|
||||
(end-suite)
|
||||
|
||||
33
tools/patch-jpm.janet
Normal file
33
tools/patch-jpm.janet
Normal file
@ -0,0 +1,33 @@
|
||||
# Patch jpm to have the correct paths for the current install.
|
||||
# usage: janet patch-jpm.janet output --libdir=/usr/local/lib/x64-linux/ --binpath
|
||||
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(to "=") "=" '(any 1))))
|
||||
|
||||
(def- args (tuple/slice (dyn :args) 3))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
|
||||
(def install-paths @{})
|
||||
|
||||
# Get flags
|
||||
(each a args
|
||||
(if-let [m (peg/match argpeg a)]
|
||||
(let [[key value] m]
|
||||
(put install-paths (keyword key) value))))
|
||||
|
||||
(def- replace-peg
|
||||
(peg/compile
|
||||
~(% (* '(to "###START###")
|
||||
(constant ,(string/format "# Inserted by tools/patch-jpm.janet\n(defn- install-paths [] %j)" install-paths))
|
||||
(thru "###END###")
|
||||
'(any 1)))))
|
||||
|
||||
(def source (slurp ((dyn :args) 1)))
|
||||
(def newsource (0 (peg/match replace-peg source)))
|
||||
|
||||
(spit ((dyn :args) 2) newsource)
|
||||
|
||||
(unless (= :windows (os/which))
|
||||
(os/shell (string `chmod +x "` ((dyn :args) 2) `"`)))
|
||||
Loading…
Reference in New Issue
Block a user