Parallel, make-like builds - work for adding parallel builds to jpm

dagbuild.janet

###
### 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)

#
# Rule implementation
#

(defn build
  "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 rules
    (if-let [p (get rule :task)]
      (put all-targets p rule))
    (each o (get rule :outputs [])
      (put all-targets o rule)))
  (defn utd1
    [target]
    (def rule (get all-targets target))
    (if (get rule :task) (break false))
    (def mtime (os/stat target :modified))
    (if-not rule (break (or mtime
                            (error (string "target '" target
                                           "' does not exist and no rule exists to build it.")))))
    (if (not mtime) (break false))
    (var ret true)
    (each i (get rule :inputs [])
      (def s (os/stat i :modified))
      (when (or (not s) (< mtime s))
        (set ret false)
        (break)))
    ret)
   (defn utd
     [target]
     (def u (get utd-cache target))
     (if (not= nil u) u (set (utd-cache target) (utd1 target))))
  (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 (utd target))
    (unless u
      (def deps (set (dag rule) (get dag rule @[])))
      (each i inputs
        (unless (utd i)
          (if-let [r (get all-targets i)]
            (array/push deps r))))))
  (each t targets (visit t))
  (pdag (fn executor [rule] (if-let [r (get rule :recipe)] (r))) dag n-workers))

#
# Test rules
#

(defn- main [& args]
  (defn shell
    "Run a shell rule."
    [& args]
    (def x (string/join args " "))
    (fn shellfn [&] (print x) (os/execute ["sh" "-c" x] :p)))
  (def test-rules
    [{:task "clean"
      :recipe (shell "rm -f *.o hello")}
     {:task "default"
      :inputs ["hello"]}
     {:inputs ["hello.c" "other.h"]
      :outputs ["hello.o"]
      :recipe (shell "cc -c hello.c")}
     {:inputs ["other.c" "other.h"]
      :outputs ["other.o"]
      :recipe (shell "cc -c other.c")}
     {:inputs ["other.o" "hello.o"]
      :outputs ["hello"]
      :recipe (shell "cc -o hello other.o hello.o")}])
  (build test-rules (slice args 1)))

Would use as janet dagbuild.janet default to build the default task.