mirror of https://github.com/janet-lang/janet
Work on port of jpm to modules.
This commit is contained in:
Calvin Rose
parent
87f8fe14dd
commit
f198071964
11
jpm
11
jpm
|
|
@ -2,6 +2,15 @@
|
|||
|
||||
# CLI tool for building janet projects.
|
||||
|
||||
# Check for package to replace jpm - jpm package exists, run it's `cli` function.
|
||||
(def- [ok cli]
|
||||
(protect
|
||||
(def pkg (require "jpm"))
|
||||
(get (get pkg 'cli) :value)))
|
||||
(when ok
|
||||
(cli ;(dyn :args))
|
||||
(os/exit 0))
|
||||
|
||||
#
|
||||
# Basic Path Settings
|
||||
#
|
||||
|
|
@ -598,8 +607,6 @@
|
|||
(with [f (file/open source :r)]
|
||||
(create-buffer-c-impl (:read f :all) dest name))))
|
||||
|
||||
(def- root-env (table/getproto (fiber/getenv (fiber/current))))
|
||||
|
||||
(defn- modpath-to-meta
|
||||
"Get the meta file path (.meta.janet) corresponding to a native module path (.so)."
|
||||
[path]
|
||||
|
|
|
|||
|
|
@ -1281,8 +1281,7 @@
|
|||
res)
|
||||
|
||||
(defn any?
|
||||
`Returns the first truthy value in ind, otherwise nil.
|
||||
falsey value.`
|
||||
`Returns the first truthy value in ind, otherwise nil.`
|
||||
[ind]
|
||||
(var res nil)
|
||||
(loop [x :in ind :until res]
|
||||
|
|
@ -3345,6 +3344,20 @@
|
|||
(each f fibers (ev/cancel f "sibling canceled"))
|
||||
(propagate (fiber/last-value fiber) fiber))))
|
||||
|
||||
(defn ev/gather-thunks
|
||||
``
|
||||
Function form of `ev/gather` that takes thunks instead of forms. If any of the
|
||||
sibling fibers error, all other siblings will be canceled. Returns the gathered
|
||||
results in an array.
|
||||
``
|
||||
[thunks]
|
||||
(def chan (ev/chan))
|
||||
(def res @[])
|
||||
(wait-for-fibers chan
|
||||
(seq [[i thunk] :pairs thunks]
|
||||
(ev/go (fiber/new (fn [] (put res i (thunk))) :tp) nil chan)))
|
||||
res)
|
||||
|
||||
(defmacro ev/gather
|
||||
``
|
||||
Run a number of fibers in parallel on the event loop, and join when they complete.
|
||||
|
|
|
|||
|
|
@ -697,6 +697,7 @@ static int janet_channel_push(JanetChannel *channel, Janet x, int mode) {
|
|||
} else if (janet_q_count(&channel->items) > channel->limit) {
|
||||
/* No root fiber, we are in completion on a root fiber. Don't block. */
|
||||
if (mode == 2) return 0;
|
||||
if (mode == 3) return 1;
|
||||
/* Pushed successfully, but should block. */
|
||||
JanetChannelPending pending;
|
||||
pending.fiber = janet_vm_root_fiber,
|
||||
|
|
@ -2223,7 +2224,7 @@ static const JanetReg ev_cfuns[] = {
|
|||
"Resume a (copy of a) `fiber` in a new operating system thread, optionally passing `value` "
|
||||
"to resume with. "
|
||||
"Unlike `ev/go`, this function will suspend the current fiber until the thread is complete. "
|
||||
"The the final result.")
|
||||
"Return the final result.")
|
||||
},
|
||||
{
|
||||
"ev/give-supervisor", cfun_ev_give_supervisor,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,347 @@
|
|||
###
|
||||
### C and C++ compiler rule utilties
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
(use ./rules)
|
||||
(use ./shutil)
|
||||
|
||||
(def- entry-replacer
|
||||
"Convert url with potential bad characters into an entry-name"
|
||||
(peg/compile ~(% (any (+ '(range "AZ" "az" "09" "__") (/ '1 ,|(string "_" ($ 0) "_")))))))
|
||||
|
||||
(defn entry-replace
|
||||
"Escape special characters in the entry-name"
|
||||
[name]
|
||||
(get (peg/match entry-replacer name) 0))
|
||||
|
||||
(defn embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
[path]
|
||||
(->> path
|
||||
(string/replace-all "\\" "___")
|
||||
(string/replace-all "/" "___")
|
||||
(string/replace-all ".janet" "")))
|
||||
|
||||
(defn out-path
|
||||
"Take a source file path and convert it to an output path."
|
||||
[path from-ext to-ext]
|
||||
(->> path
|
||||
(string/replace-all "\\" "___")
|
||||
(string/replace-all "/" "___")
|
||||
(string/replace-all from-ext to-ext)
|
||||
(string "build/")))
|
||||
|
||||
(defn make-define
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(if value
|
||||
(string "-D" define "=" value)
|
||||
(string "-D" define)))
|
||||
|
||||
(defn make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
true, generates -DNAME (/DNAME on windows), otherwise -DNAME=value."
|
||||
[defines]
|
||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||
|
||||
(defn- getflags
|
||||
"Generate the c flags from the input options."
|
||||
[opts compiler]
|
||||
(def flags (if (= compiler :cc) :cflags :cppflags))
|
||||
@[;(opt opts flags)
|
||||
(string "-I" (dyn:headerpath))
|
||||
(string "-I" (dyn:modpath))
|
||||
(string "-O" (opt opts :optimize))])
|
||||
|
||||
(defn entry-name
|
||||
"Name of symbol that enters static compilation of a module."
|
||||
[name]
|
||||
(string "janet_module_entry_" (entry-replace name)))
|
||||
|
||||
(defn compile-c
|
||||
"Compile a C file into an object file."
|
||||
[compiler opts src dest &opt static?]
|
||||
(def cc (opt opts compiler))
|
||||
(def cflags [;(getflags opts compiler) ;(if static? [] (dyn :dynamic-cflags))])
|
||||
(def entry-defines (if-let [n (and static? (opts :entry-name))]
|
||||
[(make-define "JANET_ENTRY_NAME" n)]
|
||||
[]))
|
||||
(def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
|
||||
(def headers (or (opts :headers) []))
|
||||
(rule dest [src ;headers]
|
||||
(print "compiling " src " to " dest "...")
|
||||
(create-dirs dest)
|
||||
(if (dyn :is-msvc)
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
||||
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
||||
|
||||
(defn link-c
|
||||
"Link C or C++ object files together to make a native module."
|
||||
[has-cpp opts target & objects]
|
||||
(def linker (dyn (if has-cpp :c++-link :cc-link)))
|
||||
(def cflags (getflags opts (if has-cpp :cppflags :cflags)))
|
||||
(def lflags [;(opt opts :lflags)
|
||||
;(if (opts :static) [] (dyn:dynamic-lflags))])
|
||||
(def deplibs (get opts :native-deps []))
|
||||
(def dep-ldflags (seq [x :in deplibs] (string (dyn:modpath) "/" x (dyn:modext))))
|
||||
# Use import libs on windows - we need an import lib to link natives to other natives.
|
||||
(def dep-importlibs (seq [x :in deplibs] (string (dyn:modpath) "/" x ".lib")))
|
||||
(def ldflags [;(opt opts :ldflags []) ;dep-ldflags])
|
||||
(rule target objects
|
||||
(print "linking " target "...")
|
||||
(create-dirs target)
|
||||
(if (dyn :is-msvc)
|
||||
(shell linker ;ldflags (string "/OUT:" target) ;objects
|
||||
(string (dyn:headerpath) "/janet.lib") ;dep-importlibs ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
||||
|
||||
(defn archive-c
|
||||
"Link object files together to make a static library."
|
||||
[opts target & objects]
|
||||
(def ar (opt opts :ar))
|
||||
(rule target objects
|
||||
(print "creating static library " target "...")
|
||||
(create-dirs target)
|
||||
(if (dyn :is-msvc)
|
||||
(shell ar "/nologo" (string "/out:" target) ;objects)
|
||||
(shell ar "rcs" target ;objects))))
|
||||
|
||||
#
|
||||
# Standalone C compilation
|
||||
#
|
||||
|
||||
(defn create-buffer-c-impl
|
||||
[bytes dest name]
|
||||
(create-dirs dest)
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in bytes] (string b)))
|
||||
(file/write out
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
(string/join (interpose ", " chunks))
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out))
|
||||
|
||||
(defn create-buffer-c
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(rule dest [source]
|
||||
(print "generating " dest "...")
|
||||
(create-dirs dest)
|
||||
(with [f (file/open source :r)]
|
||||
(create-buffer-c-impl (:read f :all) dest name))))
|
||||
|
||||
(defn modpath-to-meta
|
||||
"Get the meta file path (.meta.janet) corresponding to a native module path (.so)."
|
||||
[path]
|
||||
(string (string/slice path 0 (- (length (dyn :modext)))) "meta.janet"))
|
||||
|
||||
(defn modpath-to-static
|
||||
"Get the static library (.a) path corresponding to a native module path (.so)."
|
||||
[path]
|
||||
(string (string/slice path 0 (- -1 (length (dyn :modext)))) (dyn :statext)))
|
||||
|
||||
(defn make-bin-source
|
||||
[declarations lookup-into-invocations no-core]
|
||||
(string
|
||||
declarations
|
||||
```
|
||||
|
||||
int main(int argc, const char **argv) {
|
||||
|
||||
#if defined(JANET_PRF)
|
||||
uint8_t hash_key[JANET_HASH_KEY_SIZE + 1];
|
||||
#ifdef JANET_REDUCED_OS
|
||||
char *envvar = NULL;
|
||||
#else
|
||||
char *envvar = getenv("JANET_HASHSEED");
|
||||
#endif
|
||||
if (NULL != envvar) {
|
||||
strncpy((char *) hash_key, envvar, sizeof(hash_key) - 1);
|
||||
} else if (janet_cryptorand(hash_key, JANET_HASH_KEY_SIZE) != 0) {
|
||||
fputs("unable to initialize janet PRF hash function.\n", stderr);
|
||||
return 1;
|
||||
}
|
||||
janet_init_hash_key(hash_key);
|
||||
#endif
|
||||
|
||||
janet_init();
|
||||
|
||||
```
|
||||
(if no-core
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_table(8);
|
||||
JanetTable *lookup = janet_core_lookup_table(NULL);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
```
|
||||
```
|
||||
/* Get core env */
|
||||
JanetTable *env = janet_core_env(NULL);
|
||||
JanetTable *lookup = janet_env_lookup(env);
|
||||
JanetTable *temptab;
|
||||
int handle = janet_gclock();
|
||||
```)
|
||||
lookup-into-invocations
|
||||
```
|
||||
/* Unmarshal bytecode */
|
||||
Janet marsh_out = janet_unmarshal(
|
||||
janet_payload_image_embed,
|
||||
janet_payload_image_embed_size,
|
||||
0,
|
||||
lookup,
|
||||
NULL);
|
||||
|
||||
/* Verify the marshalled object is a function */
|
||||
if (!janet_checktype(marsh_out, JANET_FUNCTION)) {
|
||||
fprintf(stderr, "invalid bytecode image - expected function.");
|
||||
return 1;
|
||||
}
|
||||
JanetFunction *jfunc = janet_unwrap_function(marsh_out);
|
||||
|
||||
/* Check arity */
|
||||
janet_arity(argc, jfunc->def->min_arity, jfunc->def->max_arity);
|
||||
|
||||
/* Collect command line arguments */
|
||||
JanetArray *args = janet_array(argc);
|
||||
for (int i = 0; i < argc; i++) {
|
||||
janet_array_push(args, janet_cstringv(argv[i]));
|
||||
}
|
||||
|
||||
/* Create enviornment */
|
||||
temptab = env;
|
||||
janet_table_put(temptab, janet_ckeywordv("args"), janet_wrap_array(args));
|
||||
janet_gcroot(janet_wrap_table(temptab));
|
||||
|
||||
/* Unlock GC */
|
||||
janet_gcunlock(handle);
|
||||
|
||||
/* Run everything */
|
||||
JanetFiber *fiber = janet_fiber(jfunc, 64, argc, argc ? args->data : NULL);
|
||||
fiber->env = temptab;
|
||||
#ifdef JANET_EV
|
||||
janet_gcroot(janet_wrap_fiber(fiber));
|
||||
janet_schedule(fiber, janet_wrap_nil());
|
||||
janet_loop();
|
||||
int status = janet_fiber_status(fiber);
|
||||
janet_deinit();
|
||||
return status;
|
||||
#else
|
||||
Janet out;
|
||||
JanetSignal result = janet_continue(fiber, janet_wrap_nil(), &out);
|
||||
if (result != JANET_SIGNAL_OK && result != JANET_SIGNAL_EVENT) {
|
||||
janet_stacktrace(fiber, out);
|
||||
janet_deinit();
|
||||
return result;
|
||||
}
|
||||
janet_deinit();
|
||||
return 0;
|
||||
#endif
|
||||
}
|
||||
|
||||
```))
|
||||
|
||||
(defn create-executable
|
||||
"Links an image with libjanet.a (or .lib) to produce an
|
||||
executable. Also will try to link native modules into the
|
||||
final executable as well."
|
||||
[opts source dest no-core]
|
||||
|
||||
# Create executable's janet image
|
||||
(def cimage_dest (string dest ".c"))
|
||||
(def no-compile (opts :no-compile))
|
||||
(rule (if no-compile cimage_dest dest) [source]
|
||||
(print "generating executable c source...")
|
||||
(create-dirs dest)
|
||||
# Load entry environment and get main function.
|
||||
(def entry-env (dofile source))
|
||||
(def main ((entry-env 'main) :value))
|
||||
(def dep-lflags @[])
|
||||
(def dep-ldflags @[])
|
||||
|
||||
# Create marshalling dictionary
|
||||
(def mdict1 (invert (env-lookup root-env)))
|
||||
(def mdict
|
||||
(if no-core
|
||||
(let [temp @{}]
|
||||
(eachp [k v] mdict1
|
||||
(if (or (cfunction? k) (abstract? k))
|
||||
(put temp k v)))
|
||||
temp)
|
||||
mdict1))
|
||||
|
||||
# Load all native modules
|
||||
(def prefixes @{})
|
||||
(def static-libs @[])
|
||||
(loop [[name m] :pairs module/cache
|
||||
:let [n (m :native)]
|
||||
:when n
|
||||
:let [prefix (gensym)]]
|
||||
(print "found native " n "...")
|
||||
(put prefixes prefix n)
|
||||
(array/push static-libs (modpath-to-static n))
|
||||
(def oldproto (table/getproto m))
|
||||
(table/setproto m nil)
|
||||
(loop [[sym value] :pairs (env-lookup m)]
|
||||
(put mdict value (symbol prefix sym)))
|
||||
(table/setproto m oldproto))
|
||||
|
||||
# Find static modules
|
||||
(var has-cpp false)
|
||||
(def declarations @"")
|
||||
(def lookup-into-invocations @"")
|
||||
(loop [[prefix name] :pairs prefixes]
|
||||
(def meta (eval-string (slurp (modpath-to-meta name))))
|
||||
(if (meta :cpp) (set has-cpp true))
|
||||
(buffer/push-string lookup-into-invocations
|
||||
" temptab = janet_table(0);\n"
|
||||
" temptab->proto = env;\n"
|
||||
" " (meta :static-entry) "(temptab);\n"
|
||||
" janet_env_lookup_into(lookup, temptab, \""
|
||||
prefix
|
||||
"\", 0);\n\n")
|
||||
(when-let [lfs (meta :lflags)]
|
||||
(array/concat dep-lflags lfs))
|
||||
(when-let [lfs (meta :ldflags)]
|
||||
(array/concat dep-ldflags lfs))
|
||||
(buffer/push-string declarations
|
||||
"extern void "
|
||||
(meta :static-entry)
|
||||
"(JanetTable *);\n"))
|
||||
|
||||
# Build image
|
||||
(def image (marshal main mdict))
|
||||
# Make image byte buffer
|
||||
(create-buffer-c-impl image cimage_dest "janet_payload_image")
|
||||
# Append main function
|
||||
(spit cimage_dest (make-bin-source declarations lookup-into-invocations no-core) :ab)
|
||||
(def oimage_dest (out-path cimage_dest ".c" ".o"))
|
||||
# Compile and link final exectable
|
||||
(unless no-compile
|
||||
(def ldflags [;dep-ldflags ;(opt opts :ldflags []) ;(dyn :janet-ldflags)])
|
||||
(def lflags [;static-libs (dyn :libjanet) ;dep-lflags ;(opt opts :lflags) ;(dyn :janet-lflags)])
|
||||
(def defines (make-defines (opt opts :defines {})))
|
||||
(def cc (opt opts :cc))
|
||||
(def cflags [;(getflags opts :cc) ;(dyn :janet-cflags)])
|
||||
(print "compiling " cimage_dest " to " oimage_dest "...")
|
||||
(create-dirs oimage_dest)
|
||||
(if (dyn :is-msvc)
|
||||
(shell cc ;defines "/c" ;cflags (string "/Fo" oimage_dest) cimage_dest)
|
||||
(shell cc "-c" cimage_dest ;defines ;cflags "-o" oimage_dest))
|
||||
(if has-cpp
|
||||
(let [linker (opt opts (if (dyn :is-msvc) :cpp-linker :cpp-compiler))
|
||||
cppflags [;(getflags opts :c++) ;(dyn :janet-cflags)]]
|
||||
(print "linking " dest "...")
|
||||
(if (dyn :is-msvc)
|
||||
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
||||
(shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags)))
|
||||
(let [linker (opt opts (if (dyn :is-msvc) :linker :compiler))]
|
||||
(print "linking " dest "...")
|
||||
(create-dirs dest)
|
||||
(if (dyn :is-msvc)
|
||||
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
||||
(shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags)))))))
|
||||
|
|
@ -0,0 +1,91 @@
|
|||
###
|
||||
### Command Line interface for jpm.
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
(import ./commands)
|
||||
|
||||
# Import some submodules to create a jpm env.
|
||||
(import ./declare :prefix "" :export true)
|
||||
(import ./rules :prefix "" :export true)
|
||||
(import ./shutil :prefix "" :export true)
|
||||
(import ./cc :prefix "" :export true)
|
||||
(import ./pm :prefix "" :export true)
|
||||
|
||||
(def- _env (curenv))
|
||||
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
|
||||
|
||||
(defn main
|
||||
"Script entry."
|
||||
[& argv]
|
||||
|
||||
(def- args (tuple/slice argv 1))
|
||||
(def- len (length args))
|
||||
(var i :private 0)
|
||||
|
||||
# Get env variables
|
||||
(def JANET_PATH (os/getenv "JANET_PATH"))
|
||||
(def JANET_HEADERPATH (os/getenv "JANET_HEADERPATH"))
|
||||
(def JANET_LIBPATH (os/getenv "JANET_LIBPATH"))
|
||||
(def JANET_MODPATH (os/getenv "JANET_MODPATH"))
|
||||
(def JANET_BINPATH (os/getenv "JANET_BINPATH"))
|
||||
(def JANET_PKGLIST (os/getenv "JANET_PKGLIST"))
|
||||
(def JANET_GIT (os/getenv "JANET_GIT"))
|
||||
(def JANET_OS_WHICH (os/getenv "JANET_OS_WHICH"))
|
||||
(def CC (os/getenv "CC"))
|
||||
(def CXX (os/getenv "CXX"))
|
||||
(def AR (os/getenv "AR"))
|
||||
|
||||
# Set dynamic bindings
|
||||
(setdyn :gitpath (or JANET_GIT "git"))
|
||||
(setdyn :pkglist (or JANET_PKGLIST "https://github.com/janet-lang/pkgs.git"))
|
||||
(setdyn :modpath (or JANET_MODPATH (dyn :syspath)))
|
||||
(setdyn :headerpath (or JANET_HEADERPATH "/usr/local/include/janet"))
|
||||
(setdyn :libpath (or JANET_LIBPATH "/usr/local/lib"))
|
||||
(setdyn :binpath (or JANET_BINPATH "/usr/local/bin"))
|
||||
(setdyn :use-batch-shell false)
|
||||
(setdyn :cc (or CC "cc"))
|
||||
(setdyn :c++ (or CXX "c++"))
|
||||
(setdyn :cc-link (or CC "cc"))
|
||||
(setdyn :c++-link (or CXX "c++"))
|
||||
(setdyn :ar (or AR "ar"))
|
||||
(setdyn :lflags @[])
|
||||
(setdyn :ldflags @[])
|
||||
(setdyn :cflags @["-std=c99" "-Wall" "-Wextra"])
|
||||
(setdyn :cppflags @["-std=c99" "-Wall" "-Wextra"])
|
||||
(setdyn :dynamic-lflags @["-shared" "-lpthread"])
|
||||
(setdyn :dynamic-cflags @[])
|
||||
(setdyn :optimize 2)
|
||||
(setdyn :modext ".so")
|
||||
(setdyn :statext ".a")
|
||||
(setdyn :is-msvc false)
|
||||
(setdyn :libjanet (string (dyn :libpath) "/libjanet.a"))
|
||||
(setdyn :janet-ldflags @[])
|
||||
(setdyn :janet-lflags @["-lm" "-ldl" "-lrt" "-lpthread"])
|
||||
(setdyn :janet-cflags @[])
|
||||
(setdyn :jpm-env _env)
|
||||
(setdyn :janet (dyn :executable))
|
||||
(setdyn :auto-shebang true)
|
||||
|
||||
# Get flags
|
||||
(while (< i len)
|
||||
(if-let [m (peg/match argpeg (args i))]
|
||||
(if (= 2 (length m))
|
||||
(let [[key value] m]
|
||||
(setdyn (keyword key) value))
|
||||
(setdyn (keyword (m 0)) true))
|
||||
(break))
|
||||
(++ i))
|
||||
|
||||
# Run subcommand
|
||||
(if (= i len)
|
||||
(commands/help)
|
||||
(do
|
||||
(if-let [com (get commands/subcommands (args i))]
|
||||
(com ;(tuple/slice args (+ i 1)))
|
||||
(do
|
||||
(print "invalid command " (args i))
|
||||
(commands/help))))))
|
||||
|
|
@ -0,0 +1,236 @@
|
|||
###
|
||||
### All of the CLI sub commands
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
(use ./declare)
|
||||
(use ./rules)
|
||||
(use ./shutil)
|
||||
(use ./cc)
|
||||
(use ./pm)
|
||||
|
||||
(defn- help
|
||||
[]
|
||||
(print `
|
||||
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.
|
||||
|
||||
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.
|
||||
clear-cache : clear the git cache. Useful for updating dependencies.
|
||||
clear-manifest : clear the manifest. Useful for fixing broken installs.
|
||||
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.
|
||||
|
||||
Keys are:
|
||||
--modpath : The directory to install modules to. Defaults to $JANET_MODPATH, $JANET_PATH, or (dyn :syspath)
|
||||
--headerpath : The directory containing janet headers. Defaults to $JANET_HEADERPATH.
|
||||
--binpath : The directory to install binaries and scripts. Defaults to $JANET_BINPATH.
|
||||
--libpath : The directory containing janet C libraries (libjanet.*). Defaults to $JANET_LIBPATH.
|
||||
--compiler : C compiler to use for natives. Defaults to $CC or cc (cl.exe on windows).
|
||||
--cpp-compiler : C++ compiler to use for natives. Defaults to $CXX or c++ (cl.exe on windows).
|
||||
--archiver : C archiver to use for static libraries. Defaults to $AR ar (lib.exe on windows).
|
||||
--linker : C linker to use for linking natives. Defaults to link.exe on windows, not used on
|
||||
other platforms.
|
||||
--pkglist : URL of git repository for package listing. Defaults to $JANET_PKGLIST or https://github.com/janet-lang/pkgs.git
|
||||
|
||||
Flags are:
|
||||
--nocolor : Disable color in the jpm repl.
|
||||
--verbose : Print shell commands as they are executed.
|
||||
--test : If passed to jpm install, runs tests before installing. Will run tests recursively on dependencies.
|
||||
--offline : Prevents jpm from going to network to get dependencies - all dependencies should be in the cache or this command will fail.
|
||||
`))
|
||||
|
||||
(defn- local-rule
|
||||
[rule &opt no-deps]
|
||||
(import-rules "./project.janet" no-deps)
|
||||
(do-rule rule))
|
||||
|
||||
(defn show-help
|
||||
[]
|
||||
(print help))
|
||||
|
||||
(defn show-paths
|
||||
[]
|
||||
(print "binpath: " (dyn:binpath))
|
||||
(print "modpath: " (dyn:modpath))
|
||||
(print "libpath: " (dyn:libpath))
|
||||
(print "headerpath: " (dyn:headerpath))
|
||||
(print "syspath: " (dyn:syspath)))
|
||||
|
||||
(defn build
|
||||
[]
|
||||
(local-rule "build"))
|
||||
|
||||
(defn clean
|
||||
[]
|
||||
(local-rule "clean"))
|
||||
|
||||
(defn install
|
||||
[& repo]
|
||||
(if (empty? repo)
|
||||
(local-rule "install")
|
||||
(each rep repo (bundle-install rep))))
|
||||
|
||||
(defn test
|
||||
[]
|
||||
(local-rule "test"))
|
||||
|
||||
(defn- uninstall-cmd
|
||||
[& what]
|
||||
(if (empty? what)
|
||||
(local-rule "uninstall")
|
||||
(each wha what (uninstall wha))))
|
||||
|
||||
(defn deps
|
||||
[]
|
||||
(local-rule "install-deps" true))
|
||||
|
||||
(defn- print-rule-tree
|
||||
"Show dependencies for a given rule recursively in a nice tree."
|
||||
[root depth prefix prefix-part]
|
||||
(print prefix root)
|
||||
(when-let [{:inputs root-deps} ((getrules) root)]
|
||||
(when (pos? depth)
|
||||
(def l (-> root-deps length dec))
|
||||
(eachp [i d] (sorted root-deps)
|
||||
(print-rule-tree
|
||||
d (dec depth)
|
||||
(string prefix-part (if (= i l) " └─" " ├─"))
|
||||
(string prefix-part (if (= i l) " " " │ ")))))))
|
||||
|
||||
(defn show-rule-tree
|
||||
[&opt root depth]
|
||||
(import-rules "./project.janet")
|
||||
(def max-depth (if depth (scan-number depth) math/inf))
|
||||
(if root
|
||||
(print-rule-tree root max-depth "" "")
|
||||
(let [ks (sort (seq [k :keys (dyn :rules)] k))]
|
||||
(each k ks (print-rule-tree k max-depth "" "")))))
|
||||
|
||||
(defn list-rules
|
||||
[&opt ctx]
|
||||
(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
|
||||
[]
|
||||
(bundle-install (dyn:pkglist)))
|
||||
|
||||
(defn quickbin
|
||||
[input output]
|
||||
(if (= (os/stat output :mode) :file)
|
||||
(print "output " output " exists."))
|
||||
(create-executable @{:no-compile (dyn :no-compile)} input output (dyn :no-core))
|
||||
(do-rule output))
|
||||
|
||||
(defn jpm-debug-repl
|
||||
[]
|
||||
(def env
|
||||
(try
|
||||
(require-jpm "./project.janet")
|
||||
([err f]
|
||||
(if (= "cannot open ./project.janet" err)
|
||||
(put (make-jpm-env) :project {})
|
||||
(propagate err f)))))
|
||||
(setdyn :pretty-format (if-not (dyn :nocolor) "%.20Q" "%.20q"))
|
||||
(setdyn :err-color (if-not (dyn :nocolor) true))
|
||||
(def p (env :project))
|
||||
(def name (p :name))
|
||||
(if name (print "Project: " name))
|
||||
(if-let [r (p :repo)] (print "Repository: " r))
|
||||
(if-let [a (p :author)] (print "Author: " a))
|
||||
(defn getchunk [buf p]
|
||||
(def [line] (parser/where p))
|
||||
(getline (string "jpm[" (or name "repl") "]:" line ":" (parser/state p :delimiters) "> ") buf env))
|
||||
(repl getchunk nil env))
|
||||
|
||||
(def subcommands
|
||||
{"build" build
|
||||
"clean" clean
|
||||
"help" show-help
|
||||
"install" install
|
||||
"test" test
|
||||
"help" help
|
||||
"deps" deps
|
||||
"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
|
||||
"rules" list-rules
|
||||
"update-pkgs" update-pkgs
|
||||
"uninstall" uninstall-cmd
|
||||
"make-lockfile" make-lockfile
|
||||
"load-lockfile" load-lockfile
|
||||
"quickbin" quickbin})
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,61 @@
|
|||
###
|
||||
### Various defaults that can be set at compile time
|
||||
### and configure the behavior of the module.
|
||||
###
|
||||
|
||||
(def config-dyns
|
||||
"A table of all of the dynamic config bindings."
|
||||
@{})
|
||||
|
||||
(defmacro defdyn
|
||||
"Define a function that wraps (dyn :keyword). This will
|
||||
allow use of dynamic bindings with static runtime checks."
|
||||
[kw & meta]
|
||||
(put config-dyns kw true)
|
||||
(let [s (symbol "dyn:" kw)]
|
||||
~(defn ,s ,;meta [&opt dflt]
|
||||
(def x (,dyn ,kw dflt))
|
||||
(if (= x nil)
|
||||
(,errorf "no value found for dynamic binding %v" ,kw)
|
||||
x))))
|
||||
|
||||
(defn opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key &opt dflt]
|
||||
(def ret (or (get opts key) (dyn key dflt)))
|
||||
(if (= nil ret)
|
||||
(error (string "option :" key " not set")))
|
||||
ret)
|
||||
|
||||
# All jpm settings.
|
||||
(defdyn :ar)
|
||||
(defdyn :auto-shebang)
|
||||
(defdyn :binpath)
|
||||
(defdyn :c++)
|
||||
(defdyn :c++-link)
|
||||
(defdyn :cc)
|
||||
(defdyn :cc-link)
|
||||
(defdyn :cflags)
|
||||
(defdyn :cppflags)
|
||||
(defdyn :dynamic-cflags)
|
||||
(defdyn :dynamic-lflags)
|
||||
(defdyn :gitpath)
|
||||
(defdyn :headerpath)
|
||||
(defdyn :is-msvc)
|
||||
(defdyn :janet)
|
||||
(defdyn :janet-cflags)
|
||||
(defdyn :janet-ldflags)
|
||||
(defdyn :janet-lflags)
|
||||
(defdyn :ldflags)
|
||||
(defdyn :lflags)
|
||||
(defdyn :libjanet)
|
||||
(defdyn :libpath)
|
||||
(defdyn :modext)
|
||||
(defdyn :modpath)
|
||||
(defdyn :offline)
|
||||
(defdyn :optimize)
|
||||
(defdyn :pkglist)
|
||||
(defdyn :statext)
|
||||
(defdyn :syspath)
|
||||
(defdyn :use-batch-shell)
|
||||
|
|
@ -0,0 +1,71 @@
|
|||
###
|
||||
### dagbuild.janet
|
||||
###
|
||||
### A module for building files / running commands in an order.
|
||||
### Building blocks for a Make-like build system.
|
||||
###
|
||||
|
||||
#
|
||||
# DAG Execution
|
||||
#
|
||||
|
||||
(defn pmap
|
||||
"Function form of `ev/gather`. If any of the
|
||||
sibling fibers error, all other siblings will be canceled. Returns the gathered
|
||||
results in an array."
|
||||
[f data]
|
||||
(def chan (ev/chan))
|
||||
(def res @[])
|
||||
(def fibers
|
||||
(seq [[i x] :pairs data]
|
||||
(ev/go (fiber/new (fn [] (put res i (f x))) :tp) nil chan)))
|
||||
(repeat (length fibers)
|
||||
(def [sig fiber] (ev/take chan))
|
||||
(unless (= sig :ok)
|
||||
(each f fibers (ev/cancel f "sibling canceled"))
|
||||
(propagate (fiber/last-value fiber) fiber)))
|
||||
res)
|
||||
|
||||
(defn pdag
|
||||
"Executes a dag by calling f on every node in the graph.
|
||||
Can set the number of workers
|
||||
for parallel execution. The graph is represented as a table
|
||||
mapping nodes to arrays of child nodes. Each node will only be evaluated
|
||||
after all children have been evaluated. Returns a table mapping each node
|
||||
to the result of `(f node)`."
|
||||
[f dag &opt n-workers]
|
||||
|
||||
# preprocess
|
||||
(def res @{})
|
||||
(def seen @{})
|
||||
(def q (ev/chan math/int32-max))
|
||||
(def dep-counts @{})
|
||||
(def inv @{})
|
||||
(defn visit [node]
|
||||
(if (seen node) (break))
|
||||
(put seen node true)
|
||||
(def depends-on (get dag node []))
|
||||
(if (empty? depends-on)
|
||||
(ev/give q node))
|
||||
(each r depends-on
|
||||
(put inv r (array/push (get inv r @[]) node))
|
||||
(visit r)))
|
||||
(eachk r dag (visit r))
|
||||
|
||||
# run n workers in parallel
|
||||
(default n-workers (max 1 (length seen)))
|
||||
(assert (> n-workers 0))
|
||||
(defn worker [&]
|
||||
(while (next seen)
|
||||
(def node (ev/take q))
|
||||
(if-not node (break))
|
||||
(when (in seen node)
|
||||
(put seen node nil)
|
||||
(put res node (f node)))
|
||||
(each r (get inv node [])
|
||||
(when (zero? (set (dep-counts r) (dec (get dep-counts r 1))))
|
||||
(ev/give q r))))
|
||||
(ev/give q nil))
|
||||
|
||||
(pmap worker (range n-workers))
|
||||
res)
|
||||
|
|
@ -0,0 +1,271 @@
|
|||
###
|
||||
### Rule generation for adding native source code
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
(use ./rules)
|
||||
(use ./shutil)
|
||||
(use ./cc)
|
||||
(use ./pm)
|
||||
|
||||
(defn declare-native
|
||||
"Declare a native module. This is a shared library that can be loaded
|
||||
dynamically by a janet runtime. This also builds a static libary that
|
||||
can be used to bundle janet code and native into a single executable."
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def name (opts :name))
|
||||
(def path (dyn:modpath))
|
||||
|
||||
(def modext (dyn:modext))
|
||||
(def statext (dyn:statext))
|
||||
|
||||
# Make dynamic module
|
||||
(def lname (string "build/" name modext))
|
||||
|
||||
# Get objects to build with
|
||||
(var has-cpp false)
|
||||
(def objects
|
||||
(seq [src :in sources]
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix ".o"))
|
||||
(if (= suffix ".c")
|
||||
(compile-c :cc opts src op)
|
||||
(do (compile-c :c++ opts src op)
|
||||
(set has-cpp true)))
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
(def o-src (out-path src ".janet" ".janet.o"))
|
||||
(array/push objects o-src)
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c :cc opts c-src o-src)))
|
||||
(link-c has-cpp opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(install-rule lname path)
|
||||
|
||||
# Add meta file
|
||||
(def metaname (modpath-to-meta lname))
|
||||
(def ename (entry-name name))
|
||||
(rule metaname []
|
||||
(print "generating meta file " metaname "...")
|
||||
(os/mkdir "build")
|
||||
(spit metaname (string/format
|
||||
"# Metadata for static library %s\n\n%.20p"
|
||||
(string name statext)
|
||||
{:static-entry ename
|
||||
:cpp has-cpp
|
||||
:ldflags ~',(opts :ldflags)
|
||||
:lflags ~',(opts :lflags)})))
|
||||
(add-dep "build" metaname)
|
||||
(install-rule metaname path)
|
||||
|
||||
# Make static module
|
||||
(unless (dyn :nostatic)
|
||||
(def sname (string "build/" name statext))
|
||||
(def opts (merge @{:entry-name ename} opts))
|
||||
(def sobjext ".static.o")
|
||||
(def sjobjext ".janet.static.o")
|
||||
|
||||
# Get static objects
|
||||
(def sobjects
|
||||
(seq [src :in sources]
|
||||
(def suffix
|
||||
(cond
|
||||
(string/has-suffix? ".cpp" src) ".cpp"
|
||||
(string/has-suffix? ".cc" src) ".cc"
|
||||
(string/has-suffix? ".c" src) ".c"
|
||||
(errorf "unknown source file type: %s, expected .c, .cc, or .cpp" src)))
|
||||
(def op (out-path src suffix sobjext))
|
||||
(compile-c (if (= ".c" suffix) :cc :c++) opts src op true)
|
||||
op))
|
||||
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (out-path src ".janet" ".janet.c"))
|
||||
(def o-src (out-path src ".janet" sjobjext))
|
||||
(array/push sobjects o-src)
|
||||
# Buffer c-src is already declared by dynamic module
|
||||
(compile-c :cc opts c-src o-src true)))
|
||||
(archive-c opts sname ;sobjects)
|
||||
(add-dep "build" sname)
|
||||
(install-rule sname path)))
|
||||
|
||||
(defn declare-source
|
||||
"Create Janet modules. This does not actually build the module(s),
|
||||
but registers them for packaging and installation. :source should be an
|
||||
array of files and directores to copy into JANET_MODPATH or JANET_PATH.
|
||||
:prefix can optionally be given to modify the destination path to be
|
||||
(string JANET_PATH prefix source)."
|
||||
[&keys {:source sources :prefix prefix}]
|
||||
(def path (string (dyn:modpath) "/" (or prefix "")))
|
||||
(if (bytes? sources)
|
||||
(install-rule sources path)
|
||||
(each s sources
|
||||
(install-rule s path))))
|
||||
|
||||
(defn declare-headers
|
||||
"Declare headers for a library installation. Installed headers can be used by other native
|
||||
libraries."
|
||||
[&keys {:headers headers :prefix prefix}]
|
||||
(def path (string (dyn:modpath) "/" (or prefix "")))
|
||||
(if (bytes? headers)
|
||||
(install-rule headers path)
|
||||
(each h headers
|
||||
(install-rule h path))))
|
||||
|
||||
(defn declare-bin
|
||||
"Declare a generic file to be installed as an executable."
|
||||
[&keys {:main main}]
|
||||
(install-rule main (dyn:binpath)))
|
||||
|
||||
(defn declare-executable
|
||||
"Declare a janet file to be the entry of a standalone executable program. The entry
|
||||
file is evaluated and a main function is looked for in the entry file. This function
|
||||
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
|
||||
:no-compile no-compile :no-core no-core}]
|
||||
(def name (if (= (os/which) :windows) (string name ".exe") name))
|
||||
(def dest (string "build/" name))
|
||||
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest no-core)
|
||||
(if no-compile
|
||||
(let [cdest (string dest ".c")]
|
||||
(add-dep "build" cdest))
|
||||
(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))))))
|
||||
|
||||
(defn declare-binscript
|
||||
``Declare a janet file to be installed as an executable script. Creates
|
||||
a shim on windows. If hardcode is true, will insert code into the script
|
||||
such that it will run correctly even when JANET_PATH is changed. if auto-shebang
|
||||
is truthy, will also automatically insert a correct shebang line.
|
||||
``
|
||||
[&keys {:main main :hardcode-syspath hardcode :is-janet is-janet}]
|
||||
(def binpath (dyn:binpath))
|
||||
(def auto-shebang (and is-janet (dyn:auto-shebang)))
|
||||
(if (or auto-shebang hardcode)
|
||||
(let [syspath (dyn:modpath)]
|
||||
(def parts (peg/match path-splitter main))
|
||||
(def name (last parts))
|
||||
(def path (string binpath "/" name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(task "install" []
|
||||
(def contents
|
||||
(with [f (file/open main)]
|
||||
(def first-line (:read f :line))
|
||||
(def second-line (string/format "(put root-env :syspath %v)\n" syspath))
|
||||
(def rest (:read f :all))
|
||||
(string (if auto-shebang
|
||||
(string "#!" (dyn:binpath) "/janet\n"))
|
||||
first-line (if hardcode second-line) rest)))
|
||||
(create-dirs path)
|
||||
(spit path contents)
|
||||
(unless (= :windows (os/which)) (shell "chmod" "+x" path))))
|
||||
(install-rule main binpath))
|
||||
# Create a dud batch file when on windows.
|
||||
(when (dyn:use-batch-shell)
|
||||
(def name (last (peg/match path-splitter main)))
|
||||
(def fullname (string binpath "/" name))
|
||||
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
|
||||
(def newname (string binpath "/" name ".bat"))
|
||||
(array/push (dyn :installed-files) newname)
|
||||
(task "install" []
|
||||
(spit newname bat))))
|
||||
|
||||
(defn declare-archive
|
||||
"Build a janet archive. This is a file that bundles together many janet
|
||||
scripts into a janet image. This file can the be moved to any machine with
|
||||
a janet vm and the required dependencies and run there."
|
||||
[&keys opts]
|
||||
(def entry (opts :entry))
|
||||
(def name (opts :name))
|
||||
(def iname (string "build/" name ".jimage"))
|
||||
(rule iname (or (opts :deps) [])
|
||||
(create-dirs iname)
|
||||
(spit iname (make-image (require entry))))
|
||||
(def path (dyn:modpath))
|
||||
(add-dep "build" iname)
|
||||
(install-rule iname path))
|
||||
|
||||
(defn run-tests
|
||||
"Run tests on a project in the current directory."
|
||||
[&opt root-directory]
|
||||
(defn dodir
|
||||
[dir]
|
||||
(each sub (sort (os/dir dir))
|
||||
(def ndir (string dir "/" sub))
|
||||
(case (os/stat ndir :mode)
|
||||
:file (when (string/has-suffix? ".janet" ndir)
|
||||
(print "running " ndir " ...")
|
||||
(def result (os/execute [(dyn:janet) ndir] :p))
|
||||
(when (not= 0 result)
|
||||
(errorf "non-zero exit code in %s: %d" ndir result)))
|
||||
:directory (dodir ndir))))
|
||||
(dodir (or root-directory "test"))
|
||||
(print "All tests passed."))
|
||||
|
||||
(defn declare-project
|
||||
"Define your project metadata. This should
|
||||
be the first declaration in a project.janet file.
|
||||
Also sets up basic task targets like clean, build, test, etc."
|
||||
[&keys meta]
|
||||
(setdyn :project meta)
|
||||
|
||||
(def installed-files @[])
|
||||
(def manifests (find-manifest-dir))
|
||||
(def manifest (find-manifest (meta :name)))
|
||||
(setdyn :manifest manifest)
|
||||
(setdyn :manifest-dir manifests)
|
||||
(setdyn :installed-files installed-files)
|
||||
|
||||
(task "build" [])
|
||||
|
||||
(task "manifest" [manifest])
|
||||
(rule manifest []
|
||||
(print "generating " manifest "...")
|
||||
(os/mkdir manifests)
|
||||
(def sha (pslurp (string "\"" (dyn:gitpath) "\" rev-parse HEAD")))
|
||||
(def url (pslurp (string "\"" (dyn:gitpath) "\" remote get-url origin")))
|
||||
(def man
|
||||
{:sha (if-not (empty? sha) sha)
|
||||
:repo (if-not (empty? url) url)
|
||||
:dependencies (array/slice (get meta :dependencies []))
|
||||
:paths installed-files})
|
||||
(spit manifest (string/format "%j\n" man)))
|
||||
|
||||
(task "install" ["uninstall" "build" manifest]
|
||||
(when (dyn :test)
|
||||
(run-tests))
|
||||
(print "Installed as '" (meta :name) "'."))
|
||||
|
||||
(task "install-deps" []
|
||||
(if-let [deps (meta :dependencies)]
|
||||
(each dep deps
|
||||
(bundle-install dep))
|
||||
(print "no dependencies found")))
|
||||
|
||||
(task "uninstall" []
|
||||
(uninstall (meta :name)))
|
||||
|
||||
(task "clean" []
|
||||
(when (os/stat "./build" :mode)
|
||||
(rm "build")
|
||||
(print "Deleted build directory.")))
|
||||
|
||||
(task "test" ["build"]
|
||||
(run-tests)))
|
||||
|
|
@ -0,0 +1,4 @@
|
|||
#!/usr/bin/env janet
|
||||
(import "jpm/cli")
|
||||
(defn main [& argv]
|
||||
(cli/main ;argv))
|
||||
|
|
@ -0,0 +1,207 @@
|
|||
###
|
||||
### Package management functionality
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
(use ./shutil)
|
||||
(use ./rules)
|
||||
|
||||
(defn- proto-flatten
|
||||
[into x]
|
||||
(when x
|
||||
(proto-flatten into (table/getproto x))
|
||||
(merge-into into x))
|
||||
into)
|
||||
|
||||
(defn make-jpm-env
|
||||
"Create an environment that is preloaded with jpm symbols."
|
||||
[&opt base-env]
|
||||
(default base-env (dyn :jpm-env {}))
|
||||
(def env (make-env))
|
||||
(loop [k :keys base-env :when (symbol? k)
|
||||
:let [x (get base-env k)]]
|
||||
(unless (get x :private) (put env k x)))
|
||||
(def currenv (proto-flatten @{} (curenv)))
|
||||
(loop [k :keys currenv :when (keyword? k)]
|
||||
(put env k (currenv k)))
|
||||
env)
|
||||
|
||||
(defn require-jpm
|
||||
"Require a jpm file project file. This is different from a normal require
|
||||
in that code is loaded in the jpm environment."
|
||||
[path &opt no-deps base-env]
|
||||
(unless (os/stat path :mode)
|
||||
(error (string "cannot open " path)))
|
||||
(def env (make-jpm-env base-env))
|
||||
(dofile path :env env :exit true)
|
||||
env)
|
||||
|
||||
(defn import-rules
|
||||
"Import another file that defines more rules. This ruleset
|
||||
is merged into the current ruleset."
|
||||
[path &opt no-deps base-env]
|
||||
(def env (require-jpm path no-deps base-env))
|
||||
(when-let [rules (get env :rules)] (merge-into (getrules) rules))
|
||||
env)
|
||||
|
||||
(defn git
|
||||
"Make a call to git."
|
||||
[& args]
|
||||
(os/execute [(dyn:gitpath) ;args] :px))
|
||||
|
||||
(defn install-rule
|
||||
"Add install and uninstall rule for moving file from src into destdir."
|
||||
[src destdir]
|
||||
(def parts (peg/match path-splitter src))
|
||||
(def name (last parts))
|
||||
(def path (string destdir "/" name))
|
||||
(array/push (dyn :installed-files) path)
|
||||
(task "install" []
|
||||
(os/mkdir destdir)
|
||||
(copy src destdir)))
|
||||
|
||||
(var- bundle-install-recursive nil)
|
||||
|
||||
(defn resolve-bundle-name
|
||||
"Convert short bundle names to URLs."
|
||||
[bname]
|
||||
(if (string/find ":" bname)
|
||||
(let [pkgs (try
|
||||
(require "pkgs")
|
||||
([err]
|
||||
(bundle-install-recursive (dyn:pkglist))
|
||||
(require "pkgs")))
|
||||
url (get-in pkgs ['packages :value (symbol bname)])]
|
||||
(unless url
|
||||
(error (string "bundle " bname " not found.")))
|
||||
url)
|
||||
bname))
|
||||
|
||||
(defn download-bundle
|
||||
"Donwload the package source (using git) to the local cache. Return the
|
||||
path to the downloaded or cached soure code."
|
||||
[url &opt tag]
|
||||
(default tag "master")
|
||||
(def cache (find-cache))
|
||||
(os/mkdir cache)
|
||||
(def id (filepath-replace url))
|
||||
(def bundle-dir (string cache "/" id))
|
||||
(var fresh false)
|
||||
(if (dyn :offline)
|
||||
(if (not= :directory (os/stat bundle-dir :mode))
|
||||
(error (string "did not find cached repository for dependency " url))
|
||||
(set fresh true))
|
||||
(when (os/mkdir bundle-dir)
|
||||
(set fresh true)
|
||||
(print "cloning repository " url " to " bundle-dir)
|
||||
(unless (zero? (git "clone" url bundle-dir))
|
||||
(rimraf bundle-dir)
|
||||
(error (string "could not clone git dependency " url)))))
|
||||
(def gd (string "--git-dir=" bundle-dir "/.git"))
|
||||
(def wt (string "--work-tree=" bundle-dir))
|
||||
(unless (or (dyn :offline) fresh)
|
||||
(git gd wt "pull" "origin" "master" "--ff-only"))
|
||||
(when tag
|
||||
(git gd wt "reset" "--hard" tag))
|
||||
(unless (dyn :offline)
|
||||
(git gd wt "submodule" "update" "--init" "--recursive"))
|
||||
bundle-dir)
|
||||
|
||||
(defn bundle-install
|
||||
"Install a bundle from a git repository."
|
||||
[repotab &opt no-deps]
|
||||
(def repo (resolve-bundle-name
|
||||
(if (string? repotab) repotab (repotab :repo))))
|
||||
(def tag (unless (string? repotab) (repotab :tag)))
|
||||
(def bdir (download-bundle repo tag))
|
||||
(def olddir (os/cwd))
|
||||
(defer (os/cd olddir)
|
||||
(os/cd bdir)
|
||||
(with-dyns [:rules @{}
|
||||
:modpath (abspath (dyn:modpath))
|
||||
:headerpath (abspath (dyn:headerpath))
|
||||
:libpath (abspath (dyn:libpath))
|
||||
:binpath (abspath (dyn:binpath))]
|
||||
(def dep-env (require-jpm "./project.janet" true))
|
||||
(def rules
|
||||
(if no-deps
|
||||
["build" "install"]
|
||||
["install-deps" "build" "install"]))
|
||||
(each r rules
|
||||
(build-rules (get dep-env :rules {}) r)))))
|
||||
|
||||
(set bundle-install-recursive bundle-install)
|
||||
|
||||
(defn make-lockfile
|
||||
[&opt filename]
|
||||
(default filename "lockfile.jdn")
|
||||
(def cwd (os/cwd))
|
||||
(def packages @[])
|
||||
# Read installed modules from manifests
|
||||
(def mdir (find-manifest-dir))
|
||||
(each man (os/dir mdir)
|
||||
(def package (parse (slurp (string mdir "/" man))))
|
||||
(if (and (dictionary? package) (package :repo) (package :sha))
|
||||
(array/push packages package)
|
||||
(print "Cannot add local or malformed package " mdir "/" man " to lockfile, skipping...")))
|
||||
# Put in correct order, such that a package is preceded by all of its dependencies
|
||||
(def ordered-packages @[])
|
||||
(def resolved @{})
|
||||
(while (< (length ordered-packages) (length packages))
|
||||
(var made-progress false)
|
||||
(each p packages
|
||||
(def {:repo r :sha s :dependencies d} p)
|
||||
(def dep-urls (map |(if (string? $) $ ($ :repo)) d))
|
||||
(unless (resolved r)
|
||||
(when (all resolved dep-urls)
|
||||
(array/push ordered-packages {:repo r :sha s})
|
||||
(set made-progress true)
|
||||
(put resolved r true))))
|
||||
(unless made-progress
|
||||
(error (string/format "could not resolve package order for: %j"
|
||||
(filter (complement resolved) (map |($ :repo) packages))))))
|
||||
# Write to file, manual format for better diffs.
|
||||
(with [f (file/open filename :w)]
|
||||
(with-dyns [:out f]
|
||||
(prin "@[")
|
||||
(eachk i ordered-packages
|
||||
(unless (zero? i)
|
||||
(prin "\n "))
|
||||
(prinf "%j" (ordered-packages i)))
|
||||
(print "]")))
|
||||
(print "created " filename))
|
||||
|
||||
(defn load-lockfile
|
||||
"Load packages from a lockfile."
|
||||
[&opt filename]
|
||||
(default filename "lockfile.jdn")
|
||||
(def lockarray (parse (slurp filename)))
|
||||
(each {:repo url :sha sha} lockarray
|
||||
(bundle-install {:repo url :tag sha} true)))
|
||||
|
||||
(defn uninstall
|
||||
"Uninstall bundle named name"
|
||||
[name]
|
||||
(def manifest (find-manifest name))
|
||||
(when-with [f (file/open manifest)]
|
||||
(def man (parse (:read f :all)))
|
||||
(each path (get man :paths [])
|
||||
(print "removing " path)
|
||||
(rm path))
|
||||
(print "removing manifest " manifest)
|
||||
(:close f) # I hate windows
|
||||
(rm manifest)
|
||||
(print "Uninstalled.")))
|
||||
|
||||
(defmacro post-deps
|
||||
"Run code at the top level if jpm dependencies are installed. Build
|
||||
code that imports dependencies should be wrapped with this macro, as project.janet
|
||||
needs to be able to run successfully even without dependencies installed."
|
||||
[& body]
|
||||
(unless (dyn :jpm-no-deps)
|
||||
~',(reduce |(eval $1) nil body)))
|
||||
|
||||
(defn do-rule
|
||||
"Evaluate a given rule in a one-off manner."
|
||||
[target]
|
||||
(build-rules (dyn :rules) [target]))
|
||||
|
|
@ -0,0 +1,19 @@
|
|||
(declare-project
|
||||
:name "jpm")
|
||||
|
||||
(declare-source
|
||||
:source ["cc.janet"
|
||||
"cli.janet"
|
||||
"commands.janet"
|
||||
"config.janet"
|
||||
"dagbuild.janet"
|
||||
"declare.janet"
|
||||
"pm.janet"
|
||||
"rules.janet"
|
||||
"shutil.janet"]
|
||||
:prefix "jpm")
|
||||
|
||||
(declare-binscript
|
||||
:main "jpm"
|
||||
:hardcode-syspath false
|
||||
:is-janet true)
|
||||
|
|
@ -0,0 +1,191 @@
|
|||
###
|
||||
### Rule implementation
|
||||
###
|
||||
### Also contains wrappers to more easily define rules in an
|
||||
### incremental manner.
|
||||
###
|
||||
|
||||
(import ./dagbuild)
|
||||
(import ./shutil)
|
||||
|
||||
(defn- executor
|
||||
"How to execute a rule at runtime -
|
||||
extract the recipe thunk(s) and call them."
|
||||
[rule]
|
||||
(if-let [r (get rule :recipe)]
|
||||
(try
|
||||
(if (indexed? r)
|
||||
(each rr r (rr))
|
||||
(r))
|
||||
# On errors, ensure that none of the output file for this rule
|
||||
# are kept.
|
||||
([err f]
|
||||
(each o (get rule :outputs [])
|
||||
(protect (shutil/rm o)))
|
||||
(propagate err f)))))
|
||||
|
||||
(defn- target-not-found
|
||||
"Creates an error message."
|
||||
[target]
|
||||
(errorf "target %v does not exist and no rule exists to build it" target))
|
||||
|
||||
(defn- target-already-defined
|
||||
"Error when an output already has a rule defined to create it."
|
||||
[target]
|
||||
(errorf "target %v has multiple rules" target))
|
||||
|
||||
(defn- utd
|
||||
"Check if a target is up to date.
|
||||
Inputs are guaranteed to already be in the utd-cache."
|
||||
[target all-targets utd-cache]
|
||||
(def rule (get all-targets target))
|
||||
(if (= target (get rule :task)) (break false))
|
||||
(def mtime (os/stat target :modified))
|
||||
(if-not rule (break (or mtime (target-not-found target))))
|
||||
(if (not mtime) (break false))
|
||||
(var ret true)
|
||||
(each i (get rule :inputs [])
|
||||
(if-not (get utd-cache i) (break (set ret false)))
|
||||
(def s (os/stat i :modified))
|
||||
(when (or (not s) (< mtime s))
|
||||
(set ret false)
|
||||
(break)))
|
||||
ret)
|
||||
|
||||
(defn build-rules
|
||||
"Given a graph of all rules, extract a work graph that will build out-of-date
|
||||
files."
|
||||
[rules targets &opt n-workers]
|
||||
(def dag @{})
|
||||
(def utd-cache @{})
|
||||
(def all-targets @{})
|
||||
(def seen @{})
|
||||
(each rule (distinct rules)
|
||||
(when-let [p (get rule :task)]
|
||||
(when (get all-targets p) (target-already-defined p))
|
||||
(put all-targets p rule))
|
||||
(each o (get rule :outputs [])
|
||||
(when (get all-targets o) (target-already-defined o))
|
||||
(put all-targets o rule)))
|
||||
|
||||
(defn utd1
|
||||
[target]
|
||||
(def u (get utd-cache target))
|
||||
(if (not= nil u)
|
||||
u
|
||||
(set (utd-cache target) (utd target all-targets utd-cache))))
|
||||
|
||||
(defn visit [target]
|
||||
(if (in seen target) (break))
|
||||
(put seen target true)
|
||||
(def rule (get all-targets target))
|
||||
(def inputs (get rule :inputs []))
|
||||
(each i inputs
|
||||
(visit i))
|
||||
(def u (utd1 target))
|
||||
(unless u
|
||||
(def deps (set (dag rule) (get dag rule @[])))
|
||||
(each i inputs
|
||||
(unless (utd1 i)
|
||||
(if-let [r (get all-targets i)]
|
||||
(array/push deps r))))))
|
||||
|
||||
(each t targets (visit t))
|
||||
(dagbuild/pdag executor dag n-workers))
|
||||
|
||||
#
|
||||
# Convenience wrappers for defining a rule graph.
|
||||
# Must be mostly compatible with old jpm interface.
|
||||
# Main differences are multiple outputs for a rule are allowed,
|
||||
# and a rule cannot have both phony and non-phony thunks.
|
||||
#
|
||||
|
||||
(defn getrules []
|
||||
(if-let [targets (dyn :rules)] targets (setdyn :rules @{})))
|
||||
|
||||
(defn- gettarget [target]
|
||||
(def item ((getrules) target))
|
||||
(unless item (error (string "no rule for target '" target "'")))
|
||||
item)
|
||||
|
||||
(defn- target-append
|
||||
[target key v]
|
||||
(def item (gettarget target))
|
||||
(def vals (get item key))
|
||||
(unless (find |(= v $) vals)
|
||||
(array/push vals v))
|
||||
item)
|
||||
|
||||
(defn add-input
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target input]
|
||||
(target-append target :inputs input))
|
||||
|
||||
(defn add-dep
|
||||
"Alias for `add-input`"
|
||||
[target dep]
|
||||
(target-append target :inputs dep))
|
||||
|
||||
(defn add-output
|
||||
"Add an output file to an existing rule. Rules can contain multiple
|
||||
outputs, but are still referred to by a main target name."
|
||||
[target output]
|
||||
(target-append target :outputs output))
|
||||
|
||||
(defn add-thunk
|
||||
"Append a thunk to a target's recipe."
|
||||
[target thunk]
|
||||
(target-append target :recipe thunk))
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(def targets (getrules))
|
||||
(unless (get targets target)
|
||||
(def new-rule
|
||||
@{:task (if phony target)
|
||||
:inputs @[]
|
||||
:outputs @[]
|
||||
:recipe @[]})
|
||||
(put targets target new-rule))
|
||||
(each d deps (add-input target d))
|
||||
(unless phony
|
||||
(add-output target target))
|
||||
(add-thunk target thunk))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body)))
|
||||
|
||||
(defmacro task
|
||||
"Add a task rule to the rule graph. A task rule will always run if invoked
|
||||
(it is always considered out of date)."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
||||
|
||||
(defmacro phony
|
||||
"Alias for `task`."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;body) true))
|
||||
|
||||
(defmacro sh-rule
|
||||
"Add a rule that invokes a shell command, and fails if the command returns non-zero."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body)))))
|
||||
|
||||
(defmacro sh-task
|
||||
"Add a task that invokes a shell command, and fails if the command returns non-zero."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body))) true))
|
||||
|
||||
(defmacro sh-phony
|
||||
"Alias for `sh-task`."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] (,shutil/shell (,string ,;body))) true))
|
||||
|
||||
(defmacro add-body
|
||||
"Add recipe code to an existing rule. This makes existing rules do more but
|
||||
does not modify the dependency graph."
|
||||
[target & body]
|
||||
~(,add-thunk ,target (fn [] ,;body)))
|
||||
|
|
@ -0,0 +1,119 @@
|
|||
###
|
||||
### Utilties for running shell-like commands
|
||||
###
|
||||
|
||||
(use ./config)
|
||||
|
||||
(defn is-win
|
||||
"Check if we should assume a DOS-like shell or default
|
||||
to posix shell."
|
||||
[]
|
||||
(dyn:use-batch-shell))
|
||||
|
||||
(defn find-manifest-dir
|
||||
"Get the path to the directory containing manifests for installed
|
||||
packages."
|
||||
[]
|
||||
(string (dyn:modpath) "/.manifests"))
|
||||
|
||||
(defn find-manifest
|
||||
"Get the full path of a manifest file given a package name."
|
||||
[name]
|
||||
(string (find-manifest-dir) "/" name ".jdn"))
|
||||
|
||||
(defn find-cache
|
||||
"Return the path to the global cache."
|
||||
[]
|
||||
(def path (dyn:modpath))
|
||||
(string path "/.cache"))
|
||||
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(case (os/lstat path :mode)
|
||||
:directory (do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path "/" subpath)))
|
||||
(os/rmdir path))
|
||||
nil nil # do nothing if file does not exist
|
||||
# Default, try to remove
|
||||
(os/rm path)))
|
||||
|
||||
(defn rimraf
|
||||
"Hard delete directory tree"
|
||||
[path]
|
||||
(if (is-win)
|
||||
# windows get rid of read-only files
|
||||
(when (os/stat path :mode)
|
||||
(os/shell (string `rmdir /S /Q "` path `"`)))
|
||||
(rm path)))
|
||||
|
||||
(defn clear-cache
|
||||
"Clear the global git cache."
|
||||
[]
|
||||
(def cache (find-cache))
|
||||
(print "clearing cache " cache "...")
|
||||
(rimraf cache))
|
||||
|
||||
(defn clear-manifest
|
||||
"Clear the global installation manifest."
|
||||
[]
|
||||
(def manifest (find-manifest-dir))
|
||||
(print "clearing manifests " manifest "...")
|
||||
(rimraf manifest))
|
||||
|
||||
(defn pslurp
|
||||
"Like slurp, but with file/popen instead file/open. Also trims output"
|
||||
[cmd]
|
||||
(string/trim (with [f (file/popen cmd)] (:read f :all))))
|
||||
|
||||
(def path-splitter
|
||||
"split paths on / and \\."
|
||||
(peg/compile ~(any (* '(any (if-not (set `\/`) 1)) (+ (set `\/`) -1)))))
|
||||
|
||||
(defn create-dirs
|
||||
"Create all directories needed for a file (mkdir -p)."
|
||||
[dest]
|
||||
(def segs (peg/match path-splitter dest))
|
||||
(for i 1 (length segs)
|
||||
(def path (string/join (slice segs 0 i) "/"))
|
||||
(unless (empty? path) (os/mkdir path))))
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(if (dyn :verbose)
|
||||
(print ;(interpose " " args)))
|
||||
(os/execute args :px))
|
||||
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(print "copying " src " to " dest "...")
|
||||
(if (is-win)
|
||||
(let [end (last (peg/match path-splitter src))
|
||||
isdir (= (os/stat src :mode) :directory)]
|
||||
(shell "C:\\Windows\\System32\\xcopy.exe"
|
||||
(string/replace "/" "\\" src) (string/replace "/" "\\" (if isdir (string dest "\\" end) dest))
|
||||
"/y" "/s" "/e" "/i"))
|
||||
(shell "cp" "-rf" src dest)))
|
||||
|
||||
(defn abspath
|
||||
"Create an absolute path. Does not resolve . and .. (useful for
|
||||
generating entries in install manifest file)."
|
||||
[path]
|
||||
(if (if (is-win)
|
||||
(peg/match '(+ "\\" (* (range "AZ" "az") ":\\")) path)
|
||||
(string/has-prefix? "/" path))
|
||||
path
|
||||
(string (os/cwd) "/" path)))
|
||||
|
||||
(def- filepath-replacer
|
||||
"Convert url with potential bad characters into a file path element."
|
||||
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
||||
|
||||
(defn filepath-replace
|
||||
"Remove special characters from a string or path
|
||||
to make it into a path segment."
|
||||
[repo]
|
||||
(get (peg/match filepath-replacer repo) 0))
|
||||
|
|
@ -0,0 +1,40 @@
|
|||
/*
|
||||
* Copyright (c) 2021 Calvin Rose and contributors
|
||||
*
|
||||
* Permission is hereby granted, free of charge, to any person obtaining a copy
|
||||
* of this software and associated documentation files (the "Software"), to
|
||||
* deal in the Software without restriction, including without limitation the
|
||||
* rights to use, copy, modify, merge, publish, distribute, sublicense, and/or
|
||||
* sell copies of the Software, and to permit persons to whom the Software is
|
||||
* furnished to do so, subject to the following conditions:
|
||||
*
|
||||
* The above copyright notice and this permission notice shall be included in
|
||||
* all copies or substantial portions of the Software.
|
||||
*
|
||||
* THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
|
||||
* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
|
||||
* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
|
||||
* AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
|
||||
* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
|
||||
* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS
|
||||
* IN THE SOFTWARE.
|
||||
*/
|
||||
|
||||
/* A very simple native module */
|
||||
|
||||
#include <janet.h>
|
||||
|
||||
static Janet cfun_get_five(int32_t argc, Janet *argv) {
|
||||
(void) argv;
|
||||
janet_fixarity(argc, 0);
|
||||
return janet_wrap_number(5.0);
|
||||
}
|
||||
|
||||
static const JanetReg array_cfuns[] = {
|
||||
{"get5", cfun_get_five, NULL},
|
||||
{NULL, NULL, NULL}
|
||||
};
|
||||
|
||||
JANET_MODULE_ENTRY(JanetTable *env) {
|
||||
janet_cfuns(env, NULL, array_cfuns);
|
||||
}
|
||||
Loading…
Reference in New Issue