More work on bringing jpm port to functional levels.

Can now compiler jaylib quickly and bootstrap.

jpm

@@ -1065,7 +1065,7 @@ int main(int argc, const char **argv) {
   :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 "")))
+  (def path (string (dyn :modpath JANET_MODPATH) "/" (or prefix "")))
   (if (bytes? sources)
     (install-rule sources path)
     (each s sources
@@ -1075,7 +1075,7 @@ int main(int argc, const char **argv) {
   "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 JANET_MODPATH) (or prefix "")))
+  (def path (string (dyn :modpath JANET_MODPATH) "/" (or prefix "")))
   (if (bytes? headers)
     (install-rule headers path)
     (each h headers

src/jpm/cc.janet

@@ -70,7 +70,7 @@
   (def defines [;(make-defines (opt opts :defines {})) ;entry-defines])
   (def headers (or (opts :headers) []))
   (rule dest [src ;headers]
-        (print "compiling " src " to " dest "...")
+        (unless (dyn:verbose) (print "compiling " src " to " dest "..."))
         (create-dirs dest)
         (if (dyn :is-msvc)
           (shell cc ;defines "/c" ;cflags (string "/Fo" dest) src)
@@ -89,7 +89,7 @@
   (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 "...")
+        (unless (dyn:verbose) (print "linking " target "..."))
         (create-dirs target)
         (if (dyn :is-msvc)
           (shell linker ;ldflags (string "/OUT:" target) ;objects
@@ -101,7 +101,7 @@
   [opts target & objects]
   (def ar (opt opts :ar))
   (rule target objects
-        (print "creating static library " target "...")
+        (unless (dyn:verbose) (print "creating static library " target "..."))
         (create-dirs target)
         (if (dyn :is-msvc)
           (shell ar "/nologo" (string "/out:" target) ;objects)

src/jpm/cli.janet

@@ -55,9 +55,9 @@
   (setdyn :lflags @[])
   (setdyn :ldflags @[])
   (setdyn :cflags @["-std=c99" "-Wall" "-Wextra"])
-  (setdyn :cppflags @["-std=c99" "-Wall" "-Wextra"])
+  (setdyn :cppflags @["-std=c++11" "-Wall" "-Wextra"])
   (setdyn :dynamic-lflags @["-shared" "-lpthread"])
-  (setdyn :dynamic-cflags @[])
+  (setdyn :dynamic-cflags @["-fPIC"])
   (setdyn :optimize 2)
   (setdyn :modext ".so")
   (setdyn :statext ".a")
@@ -69,23 +69,38 @@
   (setdyn :jpm-env _env)
   (setdyn :janet (dyn :executable))
   (setdyn :auto-shebang true)
+  (setdyn :workers nil)
+  (setdyn :verbose false)
 
   # Get flags
-  (while (< i len)
+  (def cmdbuf @[])
-    (if-let [m (peg/match argpeg (args i))]
+  (var flags-done false)
-      (if (= 2 (length m))
+  (each a args
-        (let [[key value] m]
+    (cond
-          (setdyn (keyword key) value))
+      (= a "--")
-        (setdyn (keyword (m 0)) true))
+      (set flags-done true)
-      (break))
+
-    (++ i))
+      flags-done
+      (array/push cmdbuf a)
+
+      (if-let [m (peg/match argpeg a)]
+        (do
+          (def key (keyword (get m 0)))
+          (def value-parser (get config-dyns key))
+          (unless value-parser
+            (error (string "unknown cli option " key)))
+          (if (= 2 (length m))
+            (do
+              (def v (value-parser key (get m 1)))
+              (setdyn key v))
+            (setdyn key true)))
+        (array/push cmdbuf a))))
 
   # Run subcommand
-  (if (= i len)
+  (if (empty? cmdbuf)
     (commands/help)
-    (do
+    (if-let [com (get commands/subcommands (first cmdbuf))]
-      (if-let [com (get commands/subcommands (args i))]
+        (com ;(slice cmdbuf 1))
-        (com ;(tuple/slice args (+ i 1)))
         (do
-          (print "invalid command " (args i))
+          (print "invalid command " (first cmdbuf))
-          (commands/help))))))
+          (commands/help)))))

src/jpm/commands.janet

@@ -9,7 +9,7 @@
 (use ./cc)
 (use ./pm)
 
-(defn- help
+(defn help
   []
   (print `
 usage: jpm [--key=value, --flag] ... [subcommand] [args] ...
@@ -87,10 +87,6 @@ Flags are:
   (import-rules "./project.janet" no-deps)
   (do-rule rule))
 
-(defn show-help
-  []
-  (print help))
-
 (defn show-paths
   []
   (print "binpath:    " (dyn:binpath))
@@ -213,7 +209,7 @@ Flags are:
 (def subcommands
   {"build" build
    "clean" clean
-   "help" show-help
+   "help" help
    "install" install
    "test" test
    "help" help

src/jpm/config.janet

@@ -7,11 +7,44 @@
   "A table of all of the dynamic config bindings."
   @{})
 
+(defn- parse-boolean
+  [kw x]
+  (case (string/ascii-lower x)
+    "f" false
+    "0" false
+    "false" false
+    "off" false
+    "no" false
+    "t" true
+    "1" true
+    "on" true
+    "yes" true
+    "true" true
+    (errorf "option :%s, unknown boolean option %s" kw x)))
+
+(defn- parse-integer
+  [kw x]
+  (if-let [n (scan-number x)]
+    (if (not= n (math/floor n))
+      (errorf "option :%s, expected integer, got %v" kw x)
+      n)
+    (errorf "option :%s, expected integer, got %v" kw x)))
+
+(defn- parse-string
+  [kw x]
+  x)
+
+(def- config-parsers
+  "A table of all of the option parsers."
+  @{:int parse-integer
+    :string parse-string
+    :boolean parse-boolean})
+
 (defmacro defdyn
   "Define a function that wraps (dyn :keyword). This will
   allow use of dynamic bindings with static runtime checks."
-  [kw & meta]
+  [kw parser & meta]
-  (put config-dyns kw true)
+  (put config-dyns kw (get config-parsers parser))
   (let [s (symbol "dyn:" kw)]
     ~(defn ,s ,;meta [&opt dflt]
        (def x (,dyn ,kw dflt))
@@ -29,33 +62,36 @@
   ret)
 
 # All jpm settings.
-(defdyn :ar)
+(defdyn :ar :string)
-(defdyn :auto-shebang)
+(defdyn :auto-shebang :string)
-(defdyn :binpath)
+(defdyn :binpath :string)
-(defdyn :c++)
+(defdyn :c++ :string)
-(defdyn :c++-link)
+(defdyn :c++-link :string)
-(defdyn :cc)
+(defdyn :cc :string)
-(defdyn :cc-link)
+(defdyn :cc-link :string)
-(defdyn :cflags)
+(defdyn :cflags nil)
-(defdyn :cppflags)
+(defdyn :cppflags nil)
-(defdyn :dynamic-cflags)
+(defdyn :dynamic-cflags nil)
-(defdyn :dynamic-lflags)
+(defdyn :dynamic-lflags nil)
-(defdyn :gitpath)
+(defdyn :gitpath :string)
-(defdyn :headerpath)
+(defdyn :headerpath :string)
-(defdyn :is-msvc)
+(defdyn :is-msvc :boolean)
-(defdyn :janet)
+(defdyn :janet :string)
-(defdyn :janet-cflags)
+(defdyn :janet-cflags nil)
-(defdyn :janet-ldflags)
+(defdyn :janet-ldflags nil)
-(defdyn :janet-lflags)
+(defdyn :janet-lflags nil)
-(defdyn :ldflags)
+(defdyn :ldflags nil)
-(defdyn :lflags)
+(defdyn :lflags nil)
-(defdyn :libjanet)
+(defdyn :libjanet :string)
-(defdyn :libpath)
+(defdyn :libpath :string)
-(defdyn :modext)
+(defdyn :modext nil)
-(defdyn :modpath)
+(defdyn :modpath :string)
-(defdyn :offline)
+(defdyn :offline :boolean)
-(defdyn :optimize)
+(defdyn :optimize :int)
-(defdyn :pkglist)
+(defdyn :pkglist :string)
-(defdyn :statext)
+(defdyn :silent :boolean)
-(defdyn :syspath)
+(defdyn :statext nil)
-(defdyn :use-batch-shell)
+(defdyn :syspath nil)
+(defdyn :use-batch-shell :boolean)
+(defdyn :verbose :boolean)
+(defdyn :workers :int)

src/jpm/dagbuild.janet

@@ -45,6 +45,7 @@
     (if (seen node) (break))
     (put seen node true)
     (def depends-on (get dag node []))
+    (put dep-counts node (length depends-on))
     (if (empty? depends-on)
       (ev/give q node))
     (each r depends-on

src/jpm/declare.janet

@@ -94,6 +94,7 @@
         (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)))
@@ -236,7 +237,7 @@
   (task "build" [])
 
   (task "manifest" [manifest])
-  (rule manifest []
+  (rule manifest ["uninstall"]
         (print "generating " manifest "...")
         (os/mkdir manifests)
         (def sha (pslurp (string "\"" (dyn:gitpath) "\" rev-parse HEAD")))

src/jpm/pm.janet

@@ -24,6 +24,11 @@
   (def currenv (proto-flatten @{} (curenv)))
   (loop [k :keys currenv :when (keyword? k)]
     (put env k (currenv k)))
+  # For compatibility reasons
+  (put env 'default-cflags @{:value (dyn:cflags)})
+  (put env 'default-lflags @{:value (dyn:lflags)})
+  (put env 'default-ldflags @{:value (dyn:ldflags)})
+  (put env 'default-cppflags @{:value (dyn:cppflags)})
   env)
 
 (defn require-jpm
@@ -204,4 +209,4 @@
 (defn do-rule
   "Evaluate a given rule in a one-off manner."
   [target]
-  (build-rules (dyn :rules) [target]))
+  (build-rules (dyn :rules) [target] (dyn :workers)))

src/jpm/project.janet

@@ -15,5 +15,6 @@
 
 (declare-binscript
   :main "jpm"
-  :hardcode-syspath false
+  :hardcode-syspath true
+  :auto-shebang true
   :is-janet true)

src/jpm/shutil.janet

@@ -79,12 +79,20 @@
     (def path (string/join (slice segs 0 i) "/"))
     (unless (empty? path) (os/mkdir path))))
 
+(defn devnull
+  []
+  (os/open (if (= :windows (os/which)) "NUL" "/dev/null") :rw))
+
 (defn shell
   "Do a shell command"
   [& args]
+  (def args (map string args))
   (if (dyn :verbose)
     (print ;(interpose " " args)))
-  (os/execute args :px))
+  (if (dyn :silent)
+    (with [dn (devnull)]
+      (os/execute args :px {:out dn :err dn}))
+    (os/execute args :px)))
 
 (defn copy
   "Copy a file or directory recursively from one location to another."