Add jpm tool, based on cook.

Modify cook as well.

6 files changed, 204 insertions, 49 deletions

diff --git a/Makefile b/Makefile
index d0b38186..8d9351b7 100644
--- a/Makefile
+++ b/Makefile
@@ -300,6 +300,8 @@ install: $(JANET_TARGET) $(PKG_CONFIG_PATH)/janet.pc
 	ln -sf $(SONAME) $(LIBDIR)/libjanet.so
 	ln -sf libjanet.so.$(shell $(JANET_TARGET) -e '(print janet/version)') $(LIBDIR)/$(SONAME)
 	cp tools/cook.janet $(JANET_PATH)
+	cp tools/jpm $(BINDIR)/jpm
+	chmod +x $(BINDIR)/jpm
 	cp tools/highlight.janet $(JANET_PATH)
 	cp tools/bars.janet $(JANET_PATH)
 	mkdir -p $(MANPATH)
diff --git a/build_win.bat b/build_win.bat
index 38f2539a..ee33847b 100644
--- a/build_win.bat
+++ b/build_win.bat
@@ -131,6 +131,7 @@ copy src\include\janet.h dist\janet.h
 copy src\include\janetconf.h dist\janetconf.h
 copy tools\cook.janet dist\cook.janet
 copy tools\highlight.janet dist\highlight.janet
+copy tools\jpm dist\jpm
 exit /b 0
 
 :TESTFAIL
diff --git a/meson.build b/meson.build
index bbf91cec..e1712718 100644
--- a/meson.build
+++ b/meson.build
@@ -130,6 +130,7 @@ janet_mainclient = executable('janet', core_src, core_image, init_gen, mainclien
   include_directories : incdir,
   dependencies : [m_dep, dl_dep],
   install : true)
+janet_jpm = install_data('tools/jpm', install_dir : 'bin')
 
 # Documentation
 docs = custom_target('docs',
diff --git a/src/boot/boot.janet b/src/boot/boot.janet
index e960ed32..a491f9b5 100644
--- a/src/boot/boot.janet
+++ b/src/boot/boot.janet
@@ -1686,15 +1686,16 @@
   @{})
 
 (defn dofile
-  "Evaluate a file in a new environment and return the new environment."
+  "Evaluate a file and return the resulting environment."
   [path & args]
   (def {:exit exit-on-error
         :source source
+        :env env
         :compile-only compile-only} (table ;args))
   (def f (if (= (type path) :core/file)
            path
            (file/open path)))
-  (def newenv (make-env))
+  (default env (make-env))
   (defn chunks [buf _] (file/read f 2048 buf))
   (defn bp [&opt x y]
     (def ret (bad-parse x y))
@@ -1704,7 +1705,7 @@
     (def ret (bad-compile x y z))
     (if exit-on-error (os/exit 1))
     ret)
-  (run-context {:env newenv
+  (run-context {:env env
                 :chunks chunks
                 :on-parse-error bp
                 :on-compile-error bc
@@ -1715,7 +1716,7 @@
                 :compile-only compile-only
                 :source (or source (if (= f path) "<anonymous>" path))})
   (when (not= f path) (file/close f))
-  (table/setproto newenv nil))
+  env)
 
 (def module/loaders
   "A table of loading method names to loading functions.
diff --git a/tools/cook.janet b/tools/cook.janet
index 99175e6d..82ded334 100644
--- a/tools/cook.janet
+++ b/tools/cook.janet
@@ -1,5 +1,6 @@
 # Library to help build janet natives and other
 # build artifacts.
+# Copyright 2019 © Calvin Rose
 
 # Windows is the OS outlier
 (def- is-win (= (os/which) :windows))
@@ -8,26 +9,44 @@
 (def- objext (if is-win ".obj" ".o"))
 (def- modext (if is-win ".dll" ".so"))
 
-(def prefix (or (os/getenv "PREFIX") "/usr/local"))
+# Get default paths and options from environment
+(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 CC (or (os/getenv "CC") (if is-win "cl" "cc")))
+
+(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- add-command
+  "Add a build command."
+  [cmd]
+  (let [cmds (dyn :commands)]
+    (array/push (or cmds (setdyn :commands @[])) cmd)))
 
 (defn shell
   "Do a shell command"
   [& args]
-  (def cmd (string ;args))
-  (print cmd)
-  (def res (os/shell cmd))
-  (unless (zero? res)
-    (error (string "command exited with status " res))))
+  (add-command (string ;args)))
 
-(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)))
+(defmacro delay-build
+  "Delay an express to build time."
+  [& expr]
+  ~(,add-command (fn [] ,;expr)))
+
+(defn- copy
+  "Copy a file 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]
@@ -94,8 +113,6 @@
   (seq [[d v] :pairs defines] (make-define d (if (not= v true) v))))
 
 # Defaults
-(def OPTIMIZE 2)
-(def CC (if is-win "cl" "cc"))
 (def LD (if is-win
           "link"
           (string CC
@@ -103,12 +120,12 @@
                   (if is-mac " -undefined dynamic_lookup" ""))))
 (def CFLAGS (string
               (if is-win "/I" "-I")
-              module/*headerpath*
+              includedir
               (if is-win " /O" " -std=c99 -Wall -Wextra -fpic -O")
-              OPTIMIZE))
+              optimize))
 
 (defn- compile-c
-  "Compile a C file into an object file."
+  "Compile a C file into an object file. Delayed."
   [opts src dest]
   (def cc (or (opts :compiler) CC))
   (def cflags (or (opts :cflags) CFLAGS))
@@ -119,7 +136,7 @@
       (shell cc " -c " src " " ;defines " " cflags " -o " dest))))
 
 (defn- link-c
-  "Link a number of object files together."
+  "Link a number of object files together. Delayed."
   [opts target & objects]
   (def ld (or (opts :linker) LD))
   (def cflags (or (opts :cflags) CFLAGS))
@@ -131,7 +148,7 @@
       (shell ld " " cflags " -o " target " " olist " " lflags))))
 
 (defn- create-buffer-c
-  "Inline raw byte file as a c file."
+  "Inline raw byte file as a c file. Immediate."
   [source dest name]
   (when (needs-build dest source)
     (def f (file/open source :r))
@@ -148,47 +165,151 @@
     (file/close out)
     (file/close f)))
 
-# Public
+# 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 make-native
+(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
+
+(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))
-  (os/mkdir "build")
   (def sources (opt-table :source))
   (def name (opt-table :name))
+  (def lname (lib-name name))
+  (artifact [lname :native opt-table])
   (loop [src :in sources]
     (compile-c opt-table src (object-name src)))
   (def objects (map object-name sources))
   (when-let [embedded (opt-table :embedded)]
-    (loop [src :in embedded]
-      (def c-src (embed-c-name src))
-      (def o-src (embed-o-name src))
-      (array/push objects o-src)
-      (create-buffer-c src c-src (embed-name src))
-      (compile-c opt-table c-src o-src)))
-  (link-c opt-table (lib-name name) ;objects))
+            (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))
 
-(defn clean
-  "Remove all built artifacts."
-  []
-  (rm "build"))
+(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))
+  (each s sources
+    (artifact [s :janet opt-table])))
+
+(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]))
 
-(defn make-archive
+(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))
-  (os/mkdir "build")
   (def entry (opt-table :entry))
   (def name (opt-table :name))
-  (spit (string name ".jimage") (make-image (require entry))))
+  (def iname (string "build" sep name ".jimage"))
+  (artifact [iname :image opt-table])
+  (delay-build (spit iname (make-image (require entry)))))
 
-(defn make-binary
-  "Make a binary executable that can be run on the current platform. This function
-  generates a self contained binary that can be run of the same architecture as the
-  build machine, as the current janet vm will be packaged with the output binary."
-  [& opts]
-  (error "Not Yet Implemented."))
+(defn declare-project
+  "Define your project metadata."
+  [&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."))
diff --git a/tools/jpm b/tools/jpm
new file mode 100755
index 00000000..3258d779
--- /dev/null
+++ b/tools/jpm
@@ -0,0 +1,29 @@
+#!/usr/bin/env janet
+
+# Cook CLI tool for building janet projects.
+
+(import cook :prefix "")
+
+(defn- load
+  []
+  (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
+        `)))