mirror of
https://github.com/janet-lang/janet
synced 2024-06-26 07:03:16 +00:00
More work on jpm
Switch to rea dependency graph for a rake-like tool. This model is more powerful for writing build scripts.
This commit is contained in:
Calvin Rose
parent
1696de233c
commit
e7189438dd
432
tools/cook.janet
432
tools/cook.janet
|
|
@ -1,6 +1,88 @@
|
|||
# Library to help build janet natives and other
|
||||
# build artifacts.
|
||||
# Copyright 2019 © Calvin Rose
|
||||
### cook.janet
|
||||
###
|
||||
### Library to help build janet natives and other
|
||||
### build artifacts.
|
||||
###
|
||||
### Copyright 2019 © Calvin Rose
|
||||
|
||||
#
|
||||
# Rule Engine
|
||||
#
|
||||
|
||||
(defn- getrules []
|
||||
(def rules (dyn :rules))
|
||||
(if rules rules (setdyn :rules @{})))
|
||||
|
||||
(defn- gettarget [target]
|
||||
(def item ((getrules) target))
|
||||
(unless item (error (string "No rule for target " target)))
|
||||
item)
|
||||
|
||||
(defn- rule-impl
|
||||
[target deps thunk &opt phony]
|
||||
(put (getrules) target @[(array/slice deps) thunk phony]))
|
||||
|
||||
(defmacro rule
|
||||
"Add a rule to the rule graph."
|
||||
[target deps & body]
|
||||
~(,rule-impl ,target ,deps (fn [] nil ,;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))
|
||||
|
||||
(defn add-dep
|
||||
"Add a dependency to an existing rule. Useful for extending phony
|
||||
rules or extending the dependency graph of existing rules."
|
||||
[target dep]
|
||||
(def [deps] (gettarget target))
|
||||
(array/push deps dep))
|
||||
|
||||
(defn- add-thunk
|
||||
[target more]
|
||||
(def item (gettarget target))
|
||||
(def [_ thunk] item)
|
||||
(put item 1 (fn [] (more) (thunk))))
|
||||
|
||||
(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 thunk phony] item)
|
||||
(def realdeps (seq [dep :in deps :let [x (do-rule dep)] :when x] x))
|
||||
(when (or phony (needs-build-some target realdeps))
|
||||
(thunk))
|
||||
(unless phony target))
|
||||
|
||||
#
|
||||
# Configuration
|
||||
#
|
||||
|
||||
# Windows is the OS outlier
|
||||
(def- is-win (= (os/which) :windows))
|
||||
|
|
@ -10,57 +92,67 @@
|
|||
(def- modext (if is-win ".dll" ".so"))
|
||||
|
||||
# Get default paths and options from environment
|
||||
(def prefix (or (os/getenv "PREFIX")
|
||||
(def PREFIX (or (os/getenv "PREFIX")
|
||||
(if is-win "C:\\Janet" "/usr/local")))
|
||||
(def bindir (or (os/getenv "BINDIR")
|
||||
(string prefix sep "bin")))
|
||||
(def libdir (or (os/getenv "LIBDIR")
|
||||
(string prefix sep (if is-win "Library" "lib/janet"))))
|
||||
(def includedir (or (os/getenv "INCLUDEDIR") module/*headerpath*))
|
||||
(def optimize (or (os/getenv "OPTIMIZE") 2))
|
||||
(def BINDIR (or (os/getenv "BINDIR")
|
||||
(string PREFIX sep "bin")))
|
||||
(def LIBDIR (or (os/getenv "LIBDIR")
|
||||
(string PREFIX sep (if is-win "Library" "lib/janet"))))
|
||||
(def INCLUDEDIR (or (os/getenv "INCLUDEDIR")
|
||||
module/*headerpath*
|
||||
(string PREFIX sep "include" sep "janet")))
|
||||
(def OPTIMIZE (or (os/getenv "OPTIMIZE") 2))
|
||||
(def CC (or (os/getenv "CC") (if is-win "cl" "cc")))
|
||||
(def LD (or (os/getenv "LINKER") (if is-win "link" CC)))
|
||||
(def LDFLAGS (or (os/getenv "LFLAGS")
|
||||
(if is-win ""
|
||||
(string " -shared"
|
||||
(if is-mac " -undefined dynamic_lookup" "")))))
|
||||
(def CFLAGS (or (os/getenv "CFLAGS") (if is-win "" " -std=c99 -Wall -Wextra -fpic")))
|
||||
|
||||
(defn artifact
|
||||
"Add an artifact. An artifact is an item that can be installed
|
||||
or otherwise depended upon after being built."
|
||||
[x]
|
||||
(let [as (dyn :artifacts)]
|
||||
(array/push (or as (setdyn :artifacts @[])) x)))
|
||||
(defn- opt
|
||||
"Get an option, allowing overrides via dynamic bindings AND some
|
||||
default value dflt if no dynamic binding is set."
|
||||
[opts key dflt]
|
||||
(or (opts key) (dyn key dflt)))
|
||||
|
||||
(defn- add-command
|
||||
"Add a build command."
|
||||
[cmd]
|
||||
(let [cmds (dyn :commands)]
|
||||
(array/push (or cmds (setdyn :commands @[])) cmd)))
|
||||
#
|
||||
# OS and shell helpers
|
||||
#
|
||||
|
||||
(defn shell
|
||||
"Do a shell command"
|
||||
[& args]
|
||||
(add-command (string ;args)))
|
||||
(def cmd (string/join args))
|
||||
(print cmd)
|
||||
(def res (os/shell cmd))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
|
||||
(defmacro delay-build
|
||||
"Delay an express to build time."
|
||||
[& expr]
|
||||
~(,add-command (fn [] ,;expr)))
|
||||
(defn rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn- copy
|
||||
"Copy a file from one location to another."
|
||||
(defn copy
|
||||
"Copy a file or directory recursively from one location to another."
|
||||
[src dest]
|
||||
(shell (if is-win "robocopy " "cp -rf ") src " " dest (if is-win " /s /e" "")))
|
||||
|
||||
(defn- needs-build
|
||||
[dest src]
|
||||
"Check if dest is older than src. Used for checking if a file should be updated."
|
||||
(def f (file/open dest))
|
||||
(if (not f) (break true))
|
||||
(file/close f)
|
||||
(let [mod-dest (os/stat dest :modified)
|
||||
mod-src (os/stat src :modified)]
|
||||
(< mod-dest mod-src)))
|
||||
(defn- install-data
|
||||
"Helper for installing file at path into dir."
|
||||
[path dir]
|
||||
(try (os/mkdir dir) ([err] nil))
|
||||
(copy path dir))
|
||||
|
||||
(defn- needs-build-some
|
||||
[f others]
|
||||
(some (partial needs-build f) others))
|
||||
#
|
||||
# C Compilation
|
||||
#
|
||||
|
||||
(defn- embed-name
|
||||
"Rename a janet symbol for embedding."
|
||||
|
|
@ -101,10 +193,10 @@
|
|||
(defn- make-define
|
||||
"Generate strings for adding custom defines to the compiler."
|
||||
[define value]
|
||||
(def prefix (if is-win "/D" "-D"))
|
||||
(def pre (if is-win "/D" "-D"))
|
||||
(if value
|
||||
(string prefix define "=" value)
|
||||
(string prefix define)))
|
||||
(string pre define "=" value)
|
||||
(string pre define)))
|
||||
|
||||
(defn- make-defines
|
||||
"Generate many defines. Takes a dictionary of defines. If a value is
|
||||
|
|
@ -112,204 +204,134 @@
|
|||
[defines]
|
||||
(seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
|
||||
|
||||
# Defaults
|
||||
(def LD (if is-win
|
||||
"link"
|
||||
(string CC
|
||||
" -shared"
|
||||
(if is-mac " -undefined dynamic_lookup" ""))))
|
||||
(def CFLAGS (string
|
||||
(if is-win "/I" "-I")
|
||||
includedir
|
||||
(if is-win " /O" " -std=c99 -Wall -Wextra -fpic -O")
|
||||
optimize))
|
||||
(defn- getcflags
|
||||
"Generate the c flags from the input options."
|
||||
[opts]
|
||||
(string (opt opts :cflags CFLAGS)
|
||||
(if is-win " /I" " -I")
|
||||
(opt opts :includedir INCLUDEDIR)
|
||||
(if is-win " /O" " -O")
|
||||
(opt opts :optimize OPTIMIZE)))
|
||||
|
||||
(defn- compile-c
|
||||
"Compile a C file into an object file. Delayed."
|
||||
"Compile a C file into an object file."
|
||||
[opts src dest]
|
||||
(def cc (or (opts :compiler) CC))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def defines (interpose " " (make-defines (or (opts :defines) {}))))
|
||||
(if (needs-build dest src)
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
||||
(shell cc " -c " src " " ;defines " " cflags " -o " dest))))
|
||||
(def cc (opt opts :compiler CC))
|
||||
(def cflags (getcflags opts))
|
||||
(def defines (interpose " " (make-defines (opt opts :defines {}))))
|
||||
(rule dest [src]
|
||||
(if is-win
|
||||
(shell cc " " ;defines " /nologo /c " cflags " /Fo" dest " " src)
|
||||
(shell cc " -c " src " " ;defines " " cflags " -o " dest))))
|
||||
|
||||
(defn- link-c
|
||||
"Link a number of object files together. Delayed."
|
||||
"Link a number of object files together."
|
||||
[opts target & objects]
|
||||
(def ld (or (opts :linker) LD))
|
||||
(def cflags (or (opts :cflags) CFLAGS))
|
||||
(def lflags (or (opts :lflags) ""))
|
||||
(def ld (opt opts :linker LD))
|
||||
(def cflags (getcflags opts))
|
||||
(def lflags (opt opts :lflags LDFLAGS))
|
||||
(def olist (string/join objects " "))
|
||||
(if (needs-build-some target objects)
|
||||
(if is-win
|
||||
(shell ld " /DLL /OUT:" target " " olist " %JANET_PATH%\\janet.lib")
|
||||
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||
(rule target objects
|
||||
(if is-win
|
||||
(shell ld " " lflags " /DLL /OUT:" target " " olist " %JANET_PATH%\\janet.lib")
|
||||
(shell ld " " cflags " -o " target " " olist " " lflags))))
|
||||
|
||||
(defn- create-buffer-c
|
||||
"Inline raw byte file as a c file. Immediate."
|
||||
"Inline raw byte file as a c file."
|
||||
[source dest name]
|
||||
(when (needs-build dest source)
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out)
|
||||
(file/close f)))
|
||||
(rule dest [source]
|
||||
(def f (file/open source :r))
|
||||
(if (not f) (error (string "file " f " not found")))
|
||||
(def out (file/open dest :w))
|
||||
(def chunks (seq [b :in (file/read f :all)] (string b)))
|
||||
(file/write out
|
||||
"#include <janet.h>\n"
|
||||
"static const unsigned char bytes[] = {"
|
||||
;(interpose ", " chunks)
|
||||
"};\n\n"
|
||||
"const unsigned char *" name "_embed = bytes;\n"
|
||||
"size_t " name "_embed_size = sizeof(bytes);\n")
|
||||
(file/close out)
|
||||
(file/close f)))
|
||||
|
||||
# Installation Helpers
|
||||
|
||||
(defn- prep-install
|
||||
[dir]
|
||||
(try (os/mkdir dir) ([err] nil)))
|
||||
|
||||
(defn- install-janet-module
|
||||
"Install a janet source module."
|
||||
[name]
|
||||
(prep-install libdir)
|
||||
(copy name libdir))
|
||||
|
||||
(defn- install-native-module
|
||||
"Install a native module."
|
||||
[name]
|
||||
(prep-install libdir)
|
||||
(copy name libdir))
|
||||
|
||||
(defn- install-binscript
|
||||
"Install a binscript."
|
||||
[name]
|
||||
(prep-install bindir)
|
||||
(copy name bindir))
|
||||
|
||||
# Declaring Artifacts - used in project.janet
|
||||
#
|
||||
# Declaring Artifacts - used in project.janet, targets specifically
|
||||
# tailored for janet.
|
||||
#
|
||||
|
||||
(defn declare-native
|
||||
"Build a native binary. This is a shared library that can be loaded
|
||||
dynamically by a janet runtime."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(def sources (opt-table :source))
|
||||
(def name (opt-table :name))
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def name (opts :name))
|
||||
(def lname (lib-name name))
|
||||
(artifact [lname :native opt-table])
|
||||
(loop [src :in sources]
|
||||
(compile-c opt-table src (object-name src)))
|
||||
(compile-c opts src (object-name src)))
|
||||
(def objects (map object-name sources))
|
||||
(when-let [embedded (opt-table :embedded)]
|
||||
(when-let [embedded (opts :embedded)]
|
||||
(loop [src :in embedded]
|
||||
(def c-src (embed-c-name src))
|
||||
(def o-src (embed-o-name src))
|
||||
(array/push objects o-src)
|
||||
(delay-build (create-buffer-c src c-src (embed-name src)))
|
||||
(compile-c opt-table c-src o-src)))
|
||||
(link-c opt-table lname ;objects))
|
||||
(create-buffer-c src c-src (embed-name src))
|
||||
(compile-c opts c-src o-src)))
|
||||
(link-c opts lname ;objects)
|
||||
(add-dep "build" lname)
|
||||
(def libdir (opt opts :libdir LIBDIR))
|
||||
(add-body "install" (install-data lname LIBDIR))
|
||||
lname)
|
||||
|
||||
(defn declare-source
|
||||
"Create a Janet modules. This does not actually build the module(s),
|
||||
but registers it for packaging and installation."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(def sources (opt-table :source))
|
||||
[&keys opts]
|
||||
(def sources (opts :source))
|
||||
(def libdir (opt opts :libdir LIBDIR))
|
||||
(each s sources
|
||||
(artifact [s :janet opt-table])))
|
||||
(add-body "install" (install-data s libdir))))
|
||||
|
||||
(defn declare-binscript
|
||||
"Declare a janet file to be installed as an executable script."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(def main (opt-table :main))
|
||||
(artifact [main :binscript opt-table]))
|
||||
[&keys opts]
|
||||
(def main (opts :main))
|
||||
(def bindir (opt opts :bindir BINDIR))
|
||||
(add-body "install" (install-data main bindir))
|
||||
main)
|
||||
|
||||
(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."
|
||||
[& opts]
|
||||
(def opt-table (table ;opts))
|
||||
(def entry (opt-table :entry))
|
||||
(def name (opt-table :name))
|
||||
[&keys opts]
|
||||
(def entry (opts :entry))
|
||||
(def name (opts :name))
|
||||
(def iname (string "build" sep name ".jimage"))
|
||||
(artifact [iname :image opt-table])
|
||||
(delay-build (spit iname (make-image (require entry)))))
|
||||
(rule iname (or (opts :deps) [])
|
||||
(spit iname (make-image (require entry))))
|
||||
(def libdir (opt opts :libdir LIBDIR))
|
||||
(add-body "install" (install-data iname libdir))
|
||||
iname)
|
||||
|
||||
(defn declare-project
|
||||
"Define your project metadata."
|
||||
"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))
|
||||
|
||||
# Tool usage - called from tool
|
||||
|
||||
(defn- rm
|
||||
"Remove a directory and all sub directories."
|
||||
[path]
|
||||
(if (= (os/stat path :mode) :directory)
|
||||
(do
|
||||
(each subpath (os/dir path)
|
||||
(rm (string path sep subpath)))
|
||||
(os/rmdir path))
|
||||
(os/rm path)))
|
||||
|
||||
(defn- flush-commands
|
||||
"Run all pending commands."
|
||||
[]
|
||||
(os/mkdir "build")
|
||||
(when-let [cmds (dyn :commands)]
|
||||
(each cmd cmds
|
||||
(if (bytes? cmd)
|
||||
(do
|
||||
(print cmd)
|
||||
(def res (os/shell cmd))
|
||||
(unless (zero? res)
|
||||
(error (string "command exited with status " res))))
|
||||
(cmd)))
|
||||
(setdyn :commands @[])))
|
||||
|
||||
(defn clean
|
||||
"Remove all built artifacts."
|
||||
[]
|
||||
(print "cleaning...")
|
||||
(rm "build"))
|
||||
|
||||
(defn build
|
||||
"Build all artifacts."
|
||||
[]
|
||||
(print "building...")
|
||||
(flush-commands))
|
||||
|
||||
(defn install
|
||||
"Install all artifacts."
|
||||
[]
|
||||
(flush-commands)
|
||||
(print "installing...")
|
||||
(each [name kind opts] (dyn :artifacts ())
|
||||
(case kind
|
||||
:janet (install-janet-module name)
|
||||
:image (install-janet-module name)
|
||||
:native (install-native-module name)
|
||||
:binscript (install-binscript name)))
|
||||
(flush-commands))
|
||||
|
||||
(defn test
|
||||
"Run all tests. This means executing janet files in the test directory."
|
||||
[]
|
||||
(flush-commands)
|
||||
(print "testing...")
|
||||
(defn dodir
|
||||
[dir]
|
||||
(each sub (os/dir dir)
|
||||
(def ndir (string dir sep sub))
|
||||
(case (os/stat ndir :mode)
|
||||
:file (when (string/has-suffix? ".janet" ndir)
|
||||
(print "running " ndir " ...")
|
||||
(dofile ndir :exit true))
|
||||
:directory (dodir ndir))))
|
||||
(dodir "test")
|
||||
(print "All tests passed."))
|
||||
(setdyn :project meta)
|
||||
(try (os/mkdir "build") ([err] nil))
|
||||
(phony "build" [] (print "Built."))
|
||||
(phony "install" ["build"] (print "Installed."))
|
||||
(phony "clean" [] (rm "build") (print "Deleted build directory."))
|
||||
(phony "test" ["build"]
|
||||
(defn dodir
|
||||
[dir]
|
||||
(each sub (os/dir dir)
|
||||
(def ndir (string dir sep sub))
|
||||
(case (os/stat ndir :mode)
|
||||
:file (when (string/has-suffix? ".janet" ndir)
|
||||
(print "running " ndir " ...")
|
||||
(dofile ndir :exit true))
|
||||
:directory (dodir ndir))))
|
||||
(dodir "test")
|
||||
(print "All tests passed.")))
|
||||
|
|
|
|||
57
tools/jpm
57
tools/jpm
|
|
@ -1,29 +1,40 @@
|
|||
#!/usr/bin/env janet
|
||||
|
||||
# Cook CLI tool for building janet projects.
|
||||
# CLI tool for building janet projects. Wraps cook.
|
||||
|
||||
(import cook :prefix "")
|
||||
|
||||
(defn- load
|
||||
[]
|
||||
(dofile "./project.janet" :env (fiber/getenv (fiber/current))))
|
||||
(dofile "./project.janet" :env (fiber/getenv (fiber/current)))
|
||||
|
||||
# Flag handlers
|
||||
(case (process/args 2)
|
||||
"install" (do (load) (install))
|
||||
"build" (do (load) (build))
|
||||
"clean" (clean)
|
||||
"test" (do (load) (test))
|
||||
(do
|
||||
(def x (process/args 2))
|
||||
(if (not= x "help") (print "unknown command: " x))
|
||||
(print "usage: jpm [command]")
|
||||
(print
|
||||
`
|
||||
Commands are:
|
||||
help : Show this help
|
||||
install : Install all artifacts
|
||||
test : Run all tests
|
||||
build : Build all artifacts
|
||||
clean : Remove all artifacts
|
||||
`)))
|
||||
(def- argpeg
|
||||
(peg/compile
|
||||
'(* "--" '(some (if-not "=" 1)) "=" '(any 1))))
|
||||
|
||||
(defn- help
|
||||
[]
|
||||
(print "usage: jpm [targets]... --key=value ...")
|
||||
(print "Available targets are:")
|
||||
(each k (sort (keys (dyn :rules @{})))
|
||||
(print " " k))
|
||||
(print `
|
||||
|
||||
Keys are:
|
||||
--prefix : The prefix to install to. Defaults to $PREFIX or /usr/local
|
||||
--libdir : The directory to install. Defaults to $LIBDIR or $prefix/lib/janet
|
||||
--includedir : The directory containing janet headers. Defaults to $INCLUDEDIR or module/*headerpath*.
|
||||
--bindir : The directory to install binaries and scripts. Defaults to $BINDIR or $prefix/bin
|
||||
--optimize : Optimization level for natives. Defaults to $OPTIMIZE or 2.
|
||||
--compiler : C compiler to use for natives. Defaults to $CC or cc.
|
||||
--linker : C linker to use for linking natives. Defaults to $LINKER or cc.
|
||||
--cflags : Extra compiler flags for native modules. Defaults to $CFLAGS if set.
|
||||
--lflags : Extra linker flags for native modules. Defaults to $LFLAGS if set.
|
||||
`))
|
||||
|
||||
(def args (tuple/slice process/args 2))
|
||||
(each arg args
|
||||
(if (string/has-prefix? "--" arg)
|
||||
(let [[key value] (peg/match argpeg arg)]
|
||||
(setdyn (keyword key) value))
|
||||
(do-rule arg)))
|
||||
|
||||
(if (empty? args) (help))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user