mirror of
https://github.com/janet-lang/janet
synced 2024-11-19 15:14:48 +00:00
1427 lines
48 KiB
Plaintext
Executable File
1427 lines
48 KiB
Plaintext
Executable File
#!/usr/bin/env janet
|
|
|
|
# CLI tool for building janet projects.
|
|
|
|
#
|
|
# Basic Path Settings
|
|
#
|
|
|
|
# Windows is the OS outlier
|
|
(def- is-win (= (os/which) :windows))
|
|
(def- is-mac (= (os/which) :macos))
|
|
(def- sep (if is-win "\\" "/"))
|
|
(def- objext (if is-win ".obj" ".o"))
|
|
(def- modext (if is-win ".dll" ".so"))
|
|
(def- statext (if is-win ".static.lib" ".a"))
|
|
(def- absprefix (if is-win "C:\\" "/"))
|
|
|
|
#
|
|
# Defaults
|
|
#
|
|
|
|
###START###
|
|
|
|
# Overriden on some installs.
|
|
# To configure this script, replace the code between
|
|
# the START and END comments and define a function
|
|
# (install-paths) that gives the the default paths
|
|
# to use. Trailing directory separator not expected.
|
|
#
|
|
# Example.
|
|
#
|
|
# (defn- install-paths []
|
|
# {:headerpath "/usr/local/include/janet"
|
|
# :libpath "/usr/local/lib/janet"
|
|
# :binpath "/usr/local/bin"
|
|
#
|
|
|
|
(def- exe-dir
|
|
"Directory containing jpm script"
|
|
(do
|
|
(def exe (dyn :current-file))
|
|
(def i (last (string/find-all sep exe)))
|
|
(slice exe 0 i)))
|
|
|
|
(defn- try-real [path]
|
|
"If os/realpath fails just use normal path."
|
|
(try (os/realpath) ([_] path)))
|
|
|
|
(defn- install-paths []
|
|
{:headerpath (try-real (string exe-dir "/../include/janet"))
|
|
:libpath (try-real (string exe-dir "/../lib"))
|
|
:binpath exe-dir})
|
|
|
|
###END###
|
|
|
|
# Default based on janet binary location
|
|
(def JANET_HEADERPATH (or (os/getenv "JANET_HEADERPATH")
|
|
(get (install-paths) :headerpath)))
|
|
(def JANET_LIBPATH (or (os/getenv "JANET_LIBPATH")
|
|
(get (install-paths) :libpath)))
|
|
# We want setting JANET_PATH to contain installed binaries. However, it is convenient
|
|
# to have globally installed binaries got to the same place as jpm itself, which is on
|
|
# the $PATH.
|
|
(def JANET_BINPATH (or (os/getenv "JANET_BINPATH")
|
|
(if-let [mp (os/getenv "JANET_MODPATH")] (string mp "/bin"))
|
|
(if-let [mp (os/getenv "JANET_PATH")] (string mp "/bin"))
|
|
(get (install-paths) :binpath)))
|
|
|
|
# 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
|
|
#
|
|
|
|
(defn find-manifest-dir
|
|
"Get the path to the directory containing manifests for installed
|
|
packages."
|
|
[]
|
|
(string (dyn :modpath JANET_MODPATH) sep ".manifests"))
|
|
|
|
(defn find-manifest
|
|
"Get the full path of a manifest file given a package name."
|
|
[name]
|
|
(string (find-manifest-dir) sep name ".jdn"))
|
|
|
|
(defn find-cache
|
|
"Return the path to the global cache."
|
|
[]
|
|
(def path (dyn :modpath JANET_MODPATH))
|
|
(string path sep ".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 sep 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))
|
|
|
|
(def- default-pkglist
|
|
(or (os/getenv "JANET_PKGLIST") "https://github.com/janet-lang/pkgs.git"))
|
|
|
|
(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) sep))
|
|
(unless (empty? path) (os/mkdir path))))
|
|
|
|
(def- filepath-replacer
|
|
"Convert url with potential bad characters into a file path element."
|
|
(peg/compile ~(% (any (+ (/ '(set "<>:\"/\\|?*") "_") '1)))))
|
|
|
|
(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 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))
|
|
|
|
(defn shell
|
|
"Do a shell command"
|
|
[& args]
|
|
(if (dyn :verbose)
|
|
(print ;(interpose " " args)))
|
|
(def res (os/execute args :p))
|
|
(unless (zero? res)
|
|
(error (string "command exited with status " res))))
|
|
|
|
(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 mkdir
|
|
"Create a directory if it doesn't exist. If it does exist, do nothing.
|
|
If we can't create it, give a friendly error. Return true if created, false if
|
|
existing. Throw an error if we can't create it."
|
|
[dir]
|
|
(os/mkdir dir))
|
|
|
|
(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) sep path)))
|
|
|
|
#
|
|
# Rule Engine
|
|
#
|
|
|
|
(defn- getrules []
|
|
(if-let [rules (dyn :rules)] rules (setdyn :rules @{})))
|
|
|
|
(defn- gettarget [target]
|
|
(def item ((getrules) target))
|
|
(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]
|
|
(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."
|
|
[target deps & body]
|
|
~(,rule-impl ,target ,deps (fn [] ,;body)))
|
|
|
|
(defmacro phony
|
|
"Add a phony rule to the rule graph. A phony rule will run every time
|
|
(it is always considered out of date). Phony rules are good for defining
|
|
user facing tasks."
|
|
[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 [] (,assert (,zero? (,os/shell (,string ,;body)))))))
|
|
|
|
(defmacro sh-phony
|
|
"Add a phony rule that invokes a shell command, and fails if the command returns non-zero."
|
|
[target deps & body]
|
|
~(,rule-impl ,target ,deps (fn [] (,assert (,zero? (,os/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)))
|
|
|
|
(defn- needs-build
|
|
[dest src]
|
|
(let [mod-dest (os/stat dest :modified)
|
|
mod-src (os/stat src :modified)]
|
|
(< mod-dest mod-src)))
|
|
|
|
(defn- needs-build-some
|
|
[dest sources]
|
|
(def f (file/open dest))
|
|
(if (not f) (break true))
|
|
(file/close f)
|
|
(some (partial needs-build dest) sources))
|
|
|
|
(defn do-rule
|
|
"Evaluate a given rule."
|
|
[target]
|
|
(def item ((getrules) target))
|
|
(unless item
|
|
(if (os/stat target :mode)
|
|
(break target)
|
|
(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))
|
|
(each thunk phony (thunk))
|
|
(unless (empty? thunks)
|
|
(when (needs-build-some target realdeps)
|
|
(each thunk thunks (thunk))
|
|
target)))
|
|
|
|
#
|
|
# Importing a file
|
|
#
|
|
|
|
(def- _env (fiber/getenv (fiber/current)))
|
|
|
|
(defn- proto-flatten
|
|
[into x]
|
|
(when x
|
|
(proto-flatten into (table/getproto x))
|
|
(merge-into into x))
|
|
into)
|
|
|
|
(defn make-jpm-env
|
|
"Build an environment table with jpm functions preloaded."
|
|
[&opt no-deps]
|
|
(def env (make-env))
|
|
(put env :jpm-no-deps no-deps)
|
|
(loop [k :keys _env :when (symbol? k)]
|
|
(unless ((_env k) :private) (put env k (_env 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]
|
|
(unless (os/stat path :mode)
|
|
(error (string "cannot open " path)))
|
|
(def env (make-jpm-env no-deps))
|
|
(def currenv (proto-flatten @{} (fiber/getenv (fiber/current))))
|
|
(loop [k :keys currenv :when (keyword? k)]
|
|
(put env k (currenv k)))
|
|
(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]
|
|
(def env (require-jpm path no-deps))
|
|
(when-let [rules (env :rules)] (merge-into (getrules) rules))
|
|
env)
|
|
|
|
(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)))
|
|
|
|
#
|
|
# C Compilation
|
|
#
|
|
|
|
(def default-compiler (or (os/getenv "CC") (if is-win "cl.exe" "cc")))
|
|
(def default-cpp-compiler (or (os/getenv "CXX") (if is-win "cl.exe" "c++")))
|
|
(def default-linker (or (os/getenv "CC") (if is-win "link.exe" "cc")))
|
|
(def default-cpp-linker (or (os/getenv "CXX") (if is-win "link.exe" "c++")))
|
|
(def default-archiver (or (os/getenv "AR") (if is-win "lib.exe" "ar")))
|
|
|
|
# Detect threads
|
|
(def env (fiber/getenv (fiber/current)))
|
|
(def threads? (not (not (env 'thread/new))))
|
|
(def- thread-flags
|
|
(if is-win []
|
|
(if threads? ["-lpthread"] [])))
|
|
|
|
# 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-cppflags
|
|
(if is-win
|
|
["/nologo" "/MD" "/EHsc"]
|
|
["-std=c++11" "-Wall" "-Wextra"]))
|
|
(def default-ldflags [])
|
|
|
|
# Required flags for dynamic libraries. These
|
|
# are used no matter what for dynamic libraries.
|
|
(def- dynamic-cflags
|
|
(if is-win
|
|
["/LD"]
|
|
["-fPIC"]))
|
|
(def- dynamic-lflags
|
|
(if is-win
|
|
["/DLL"]
|
|
(if is-mac
|
|
["-shared" "-undefined" "dynamic_lookup" ;thread-flags]
|
|
["-shared" ;thread-flags])))
|
|
|
|
(defn- opt
|
|
"Get an option, allowing overrides via dynamic bindings AND some
|
|
default value dflt if no dynamic binding is set."
|
|
[opts key dflt]
|
|
(def ret (or (opts key) (dyn key dflt)))
|
|
(if (= nil ret)
|
|
(error (string "option :" key " not set")))
|
|
ret)
|
|
|
|
(defn check-cc
|
|
"Ensure we have a c compiler."
|
|
[]
|
|
(if is-win
|
|
(do
|
|
(if (os/getenv "INCLUDE") (break))
|
|
(error "Run jpm inside a Developer Command Prompt.
|
|
jpm needs a c compiler to compile natives. You can install the MSVC compiler from
|
|
microsoft.com"))
|
|
(do)))
|
|
|
|
(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" sep)))
|
|
|
|
(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- getcflags
|
|
"Generate the c flags from the input options."
|
|
[opts]
|
|
@[;(opt opts :cflags default-cflags)
|
|
(string "-I" (dyn :headerpath JANET_HEADERPATH))
|
|
(string "-O" (opt opts :optimize 2))])
|
|
|
|
(defn- getcppflags
|
|
"Generate the cpp flags from the input options."
|
|
[opts]
|
|
@[;(opt opts :cppflags default-cppflags)
|
|
(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."
|
|
[name]
|
|
(string "janet_module_entry_" (entry-replace name)))
|
|
|
|
(defn- compile-c
|
|
"Compile a C file into an object file."
|
|
[opts src dest &opt static?]
|
|
(def cc (opt opts :compiler default-compiler))
|
|
(def cflags [;(getcflags opts) ;(if static? [] 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]
|
|
(check-cc)
|
|
(print "compiling " src " to " dest "...")
|
|
(create-dirs dest)
|
|
(if is-win
|
|
(shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
|
|
(shell cc "-c" src ;defines ;cflags "-o" dest))))
|
|
|
|
(defn- compile-cpp
|
|
"Compile a C++ file into an object file."
|
|
[opts src dest &opt static?]
|
|
(def cpp (opt opts :cpp-compiler default-cpp-compiler))
|
|
(def cflags [;(getcppflags opts) ;(if static? [] 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]
|
|
(check-cc)
|
|
(print "compiling " src " to " dest "...")
|
|
(create-dirs dest)
|
|
(if is-win
|
|
(shell cpp ;defines "/c" ;cflags (string "/Fo" dest) src)
|
|
(shell cpp "-c" src ;defines ;cflags "-o" dest))))
|
|
|
|
(defn- libjanet
|
|
"Find libjanet.a (or libjanet.lib on windows) at compile time"
|
|
[]
|
|
(def libpath (dyn :libpath JANET_LIBPATH))
|
|
(unless libpath
|
|
(error "cannot find libpath: provide --libpath or JANET_LIBPATH"))
|
|
(string (dyn :libpath JANET_LIBPATH)
|
|
sep
|
|
(if is-win "libjanet.lib" "libjanet.a")))
|
|
|
|
(defn- win-import-library
|
|
"On windows, an import library is needed to link to a dll statically."
|
|
[]
|
|
(def hpath (dyn :headerpath JANET_HEADERPATH))
|
|
(unless hpath
|
|
(error "cannot find headerpath: provide --headerpath or JANET_HEADERPATH"))
|
|
(string hpath `\\janet.lib`))
|
|
|
|
(defn- link-c
|
|
"Link C object files together to make a native module."
|
|
[opts target & objects]
|
|
(def linker (opt opts (if is-win :linker :compiler) default-linker))
|
|
(def cflags (getcflags opts))
|
|
(def lflags [;(opt opts :lflags default-lflags)
|
|
;(if (opts :static) [] dynamic-lflags)])
|
|
(def ldflags [;(opt opts :ldflags [])])
|
|
(rule target objects
|
|
(check-cc)
|
|
(print "linking " target "...")
|
|
(create-dirs target)
|
|
(if is-win
|
|
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;lflags)
|
|
(shell linker ;cflags ;ldflags `-o` target ;objects ;lflags))))
|
|
|
|
(defn- link-cpp
|
|
"Link C++ object files together to make a native module."
|
|
[opts target & objects]
|
|
(def linker (opt opts (if is-win :cpp-linker :cpp-compiler) default-cpp-linker))
|
|
(def cflags (getcppflags opts))
|
|
(def lflags [;(opt opts :lflags default-lflags)
|
|
;(if (opts :static) [] dynamic-lflags)])
|
|
(def ldflags [;(opt opts :ldflags [])])
|
|
(rule target objects
|
|
(check-cc)
|
|
(print "linking " target "...")
|
|
(create-dirs target)
|
|
(if is-win
|
|
(shell linker ;ldflags (string "/OUT:" target) ;objects (win-import-library) ;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 :archiver default-archiver))
|
|
(rule target objects
|
|
(check-cc)
|
|
(print "creating static library " target "...")
|
|
(create-dirs target)
|
|
(if is-win
|
|
(shell ar "/nologo" (string "/out:" target) ;objects)
|
|
(shell ar "rcs" target ;objects))))
|
|
|
|
(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))))
|
|
|
|
(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]
|
|
(string (string/slice path 0 (- (length 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 modext))) statext))
|
|
|
|
(defn- make-bin-source
|
|
[declarations lookup-into-invocations]
|
|
(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();
|
|
|
|
/* Get core env */
|
|
JanetTable *env = janet_core_env(NULL);
|
|
JanetTable *lookup = janet_env_lookup(env);
|
|
JanetTable *temptab;
|
|
int handle = janet_gclock();
|
|
|
|
/* Load natives into unmarshalling dictionary */
|
|
|
|
```
|
|
lookup-into-invocations
|
|
```
|
|
/* Unmarshal bytecode */
|
|
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 = janet_table(0);
|
|
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;
|
|
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;
|
|
}
|
|
#ifdef JANET_NET
|
|
janet_loop();
|
|
#endif
|
|
janet_deinit();
|
|
return 0;
|
|
}
|
|
|
|
```))
|
|
|
|
(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]
|
|
|
|
# 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]
|
|
(check-cc)
|
|
(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 mdict (invert (env-lookup root-env)))
|
|
# 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) :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 []) ;janet-ldflags])
|
|
(def lflags [;static-libs (libjanet) ;dep-lflags ;(opt opts :lflags default-lflags) ;janet-lflags])
|
|
(def defines (make-defines (opt opts :defines {})))
|
|
(def cc (opt opts :compiler default-compiler))
|
|
(def cflags [;(getcflags opts) ;janet-cflags])
|
|
(check-cc)
|
|
(print "compiling " cimage_dest " to " oimage_dest "...")
|
|
(create-dirs oimage_dest)
|
|
(if is-win
|
|
(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 is-win :cpp-linker :cpp-compiler) default-cpp-linker)
|
|
cppflags [;(getcppflags opts) ;janet-cflags]]
|
|
(print "linking " dest "...")
|
|
(if is-win
|
|
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
|
(shell linker ;cppflags ;ldflags `-o` dest oimage_dest ;lflags)))
|
|
(let [linker (opt opts (if is-win :linker :compiler) default-linker)]
|
|
(print "linking " dest "...")
|
|
(create-dirs dest)
|
|
(if is-win
|
|
(shell linker ;ldflags (string "/OUT:" dest) oimage_dest ;lflags)
|
|
(shell linker ;cflags ;ldflags `-o` dest oimage_dest ;lflags)))))))
|
|
|
|
#
|
|
# Installation and Dependencies
|
|
#
|
|
|
|
(var- stored-git-path nil)
|
|
(defn- git-path
|
|
"Get the location of git such that it can be passed as an argument to os/execute."
|
|
"(Some builds/configurations of windows don't like just the string 'git')"
|
|
[]
|
|
(if stored-git-path (break stored-git-path))
|
|
(set stored-git-path
|
|
(if is-win
|
|
(or (os/getenv "JANET_GIT") (first (string/split "\n" (pslurp "where git"))))
|
|
(os/getenv "JANET_GIT" "git"))))
|
|
|
|
(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.")))
|
|
|
|
(defn install-git
|
|
"Install a bundle from git. If the bundle is already installed, the bundle
|
|
is reinistalled (but not rebuilt if artifacts are cached)."
|
|
[repotab &opt recurse no-deps]
|
|
(def repo (if (string? repotab) repotab (repotab :repo)))
|
|
(def tag (unless (string? repotab) (repotab :tag)))
|
|
# prevent infinite recursion (very unlikely, but consider
|
|
# 'my-package "my-package" in the package listing)
|
|
(when (> (or recurse 0) 100)
|
|
(error "too many references resolving package url"))
|
|
# Handle short names
|
|
(unless (string/find ":" repo)
|
|
(def pkgs
|
|
(try (require "pkgs")
|
|
([err f]
|
|
(install-git (dyn :pkglist default-pkglist))
|
|
(require "pkgs"))))
|
|
(def next-repo (get-in pkgs ['packages :value (symbol repo)]))
|
|
(unless next-repo
|
|
(error (string "package " repo " not found.")))
|
|
(unless (or (string? next-repo) (dictionary? next-repo))
|
|
(error (string "expected string or table for repository, got " next-repo)))
|
|
(break (install-git next-repo (if recurse (inc recurse) 0))))
|
|
(def cache (find-cache))
|
|
(mkdir cache)
|
|
(def id (filepath-replace repo))
|
|
(def module-dir (string cache sep id))
|
|
(var fresh false)
|
|
(if (dyn :offline)
|
|
(if (not= :directory (os/stat module-dir :mode))
|
|
(error (string "did not find cached repo for dependency " repo))
|
|
(set fresh true))
|
|
(when (mkdir module-dir)
|
|
(set fresh true)
|
|
(print "cloning repository " repo " to " module-dir)
|
|
(unless (zero? (os/execute [(git-path) "clone" repo module-dir] :p))
|
|
(rimraf module-dir)
|
|
(error (string "could not clone git dependency " repo)))))
|
|
(def olddir (os/cwd))
|
|
(try
|
|
(with-dyns [:rules @{}
|
|
:modpath (abspath (dyn :modpath JANET_MODPATH))
|
|
:headerpath (abspath (dyn :headerpath JANET_HEADERPATH))
|
|
:libpath (abspath (dyn :libpath JANET_LIBPATH))
|
|
:binpath (abspath (dyn :binpath JANET_BINPATH))]
|
|
(os/cd module-dir)
|
|
(unless fresh
|
|
(os/execute [(git-path) "pull" "origin" "master" "--ff-only"] :p))
|
|
(when tag
|
|
(os/execute [(git-path) "reset" "--hard" tag] :p))
|
|
(unless (dyn :offline)
|
|
(os/execute [(git-path) "submodule" "update" "--init" "--recursive"] :p))
|
|
(import-rules "./project.janet" true)
|
|
(unless no-deps (do-rule "install-deps"))
|
|
(do-rule "build")
|
|
(do-rule "install"))
|
|
([err f] (print "Error building git repository dependency: " err) (propagate err f)))
|
|
(os/cd olddir))
|
|
|
|
(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 sep name))
|
|
(array/push (dyn :installed-files) path)
|
|
(phony "install" []
|
|
(mkdir destdir)
|
|
(copy src destdir)))
|
|
|
|
(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 sep man))))
|
|
(if (and (dictionary? package) (package :repo) (package :sha))
|
|
(array/push packages package)
|
|
(print "Cannot add local or malformed package " mdir sep 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 "]"))))
|
|
|
|
(defn- load-lockfile
|
|
[&opt filename]
|
|
(default filename "lockfile.jdn")
|
|
(def lockarray (parse (slurp filename)))
|
|
(each {:repo url :sha sha} lockarray
|
|
(install-git {:repo url :tag sha} nil true)))
|
|
|
|
#
|
|
# Declaring Artifacts - used in project.janet, targets specifically
|
|
# tailored for janet.
|
|
#
|
|
|
|
(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 JANET_MODPATH))
|
|
|
|
# Make dynamic module
|
|
(def lname (string "build" sep name modext))
|
|
|
|
# Get objects to build with
|
|
(var has-cpp false)
|
|
(def objects
|
|
(seq [src :in sources]
|
|
(cond
|
|
(string/has-suffix? ".cpp" src)
|
|
(let [op (out-path src ".cpp" objext)]
|
|
(compile-cpp opts src op)
|
|
(set has-cpp true)
|
|
op)
|
|
(string/has-suffix? ".c" src)
|
|
(let [op (out-path src ".c" objext)]
|
|
(compile-c opts src op)
|
|
op)
|
|
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
|
|
|
(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" (if is-win ".janet.obj" ".janet.o")))
|
|
(array/push objects o-src)
|
|
(create-buffer-c src c-src (embed-name src))
|
|
(compile-c opts c-src o-src)))
|
|
((if has-cpp link-cpp link-c) 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 "...")
|
|
(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" sep name statext))
|
|
(def opts (merge @{:entry-name ename} opts))
|
|
(def sobjext (string ".static" objext))
|
|
(def sjobjext (string ".janet" sobjext))
|
|
|
|
# Get static objects
|
|
(def sobjects
|
|
(seq [src :in sources]
|
|
(cond
|
|
(string/has-suffix? ".cpp" src)
|
|
(let [op (out-path src ".cpp" sobjext)]
|
|
(compile-cpp opts src op true)
|
|
op)
|
|
(string/has-suffix? ".c" src)
|
|
(let [op (out-path src ".c" sobjext)]
|
|
(compile-c opts src op true)
|
|
op)
|
|
(errorf "unknown source file type: %s, expected .c or .cpp"))))
|
|
|
|
(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 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 JANET_MODPATH) (or prefix "")))
|
|
(if (bytes? sources)
|
|
(install-rule sources path)
|
|
(each s sources
|
|
(install-rule s path))))
|
|
|
|
(defn declare-bin
|
|
"Declare a generic file to be installed as an executable."
|
|
[&keys {:main main}]
|
|
(install-rule main (dyn :binpath JANET_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}]
|
|
(def name (if is-win (string name ".exe") name))
|
|
(def dest (string "build" sep name))
|
|
(create-executable @{:cflags cflags :lflags lflags :ldflags ldflags :no-compile no-compile} entry dest)
|
|
(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
|
|
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."
|
|
[&keys {:main main :hardcode-syspath hardcode}]
|
|
(def binpath (dyn :binpath JANET_BINPATH))
|
|
(if hardcode
|
|
(let [syspath (dyn :modpath JANET_MODPATH)]
|
|
(def parts (peg/match path-splitter main))
|
|
(def name (last parts))
|
|
(def path (string binpath sep name))
|
|
(array/push (dyn :installed-files) path)
|
|
(phony "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 first-line second-line rest)))
|
|
(create-dirs path)
|
|
(spit path contents)
|
|
(unless is-win (shell "chmod" "+x" path))))
|
|
(install-rule main binpath))
|
|
# Create a dud batch file when on windows.
|
|
(when is-win
|
|
(def name (last (peg/match path-splitter main)))
|
|
(def fullname (string binpath sep name))
|
|
(def bat (string "@echo off\r\njanet \"" fullname "\" %*"))
|
|
(def newname (string binpath sep name ".bat"))
|
|
(array/push (dyn :installed-files) newname)
|
|
(phony "install" []
|
|
(spit newname bat))))
|
|
|
|
(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 [[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 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" sep name ".jimage"))
|
|
(rule iname (or (opts :deps) [])
|
|
(create-dirs iname)
|
|
(spit iname (make-image (require entry))))
|
|
(def path (dyn :modpath JANET_MODPATH))
|
|
(add-dep "build" iname)
|
|
(install-rule iname path))
|
|
|
|
(defn declare-project
|
|
"Define your project metadata. This should
|
|
be the first declaration in a project.janet file.
|
|
Also sets up basic phony 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)
|
|
|
|
(phony "build" [])
|
|
|
|
(phony "manifest" [manifest])
|
|
(rule manifest []
|
|
(print "generating " manifest "...")
|
|
(mkdir manifests)
|
|
(def sha (pslurp (string "\"" (git-path) "\" rev-parse HEAD")))
|
|
(def url (pslurp (string "\"" (git-path) "\" 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)))
|
|
|
|
(phony "install" ["uninstall" "build" manifest]
|
|
(when (dyn :test)
|
|
(do-rule "test"))
|
|
(print "Installed as '" (meta :name) "'."))
|
|
|
|
(phony "install-deps" []
|
|
(if-let [deps (meta :dependencies)]
|
|
(each dep deps
|
|
(install-git dep))
|
|
(print "no dependencies found")))
|
|
|
|
(phony "uninstall" []
|
|
(uninstall (meta :name)))
|
|
|
|
(phony "clean" []
|
|
(when (os/stat "./build" :mode)
|
|
(rm "build")
|
|
(print "Deleted build directory.")))
|
|
|
|
(phony "test" ["build"]
|
|
(defn dodir
|
|
[dir]
|
|
(each sub (sort (os/dir dir))
|
|
(def ndir (string dir sep sub))
|
|
(case (os/stat ndir :mode)
|
|
:file (when (string/has-suffix? ".janet" ndir)
|
|
(print "running " ndir " ...")
|
|
(def result (os/execute [(dyn :executable "janet") ndir] :p))
|
|
(when (not= 0 result)
|
|
(os/exit result)))
|
|
:directory (dodir ndir))))
|
|
(dodir "test")
|
|
(print "All tests passed.")))
|
|
|
|
#
|
|
# CLI
|
|
#
|
|
|
|
(def- argpeg
|
|
(peg/compile
|
|
'(* "--" '(some (if-not "=" 1)) (+ (* "=" '(any 1)) -1))))
|
|
|
|
(defn- local-rule
|
|
[rule &opt no-deps]
|
|
(import-rules "./project.janet" no-deps)
|
|
(do-rule rule))
|
|
|
|
(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 show-help
|
|
[]
|
|
(print help))
|
|
|
|
(defn show-paths
|
|
[]
|
|
(print "binpath: " (dyn :binpath JANET_BINPATH))
|
|
(print "modpath: " (dyn :modpath JANET_MODPATH))
|
|
(print "libpath: " (dyn :libpath JANET_LIBPATH))
|
|
(print "headerpath: " (dyn :headerpath JANET_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 (install-git 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 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
|
|
[]
|
|
(install-git (dyn :pkglist default-pkglist)))
|
|
|
|
(defn quickbin
|
|
[input output]
|
|
(create-executable @{} input output)
|
|
(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})
|
|
|
|
(def- args (tuple/slice (dyn :args) 1))
|
|
(def- len (length args))
|
|
(var i :private 0)
|
|
|
|
# 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)
|
|
(help)
|
|
(do
|
|
(if-let [com (subcommands (args i))]
|
|
(com ;(tuple/slice args (+ i 1)))
|
|
(do
|
|
(print "invalid command " (args i))
|
|
(help)))))
|