(Work in progress)

Clakefile

@@ -51,3 +51,16 @@
 ;; Use environment variable via roswell.
 (task "home" ()
   (echo (ros:getenv "HOME")))
+
+;; For simultaneous execution.
+(task "multi" ("a" "b" "c")
+  (echo "multi"))
+
+(task "a" ("b")
+  (echo "a"))
+
+(task "b" ("c")
+  (echo "b"))
+
+(task "c" ()
+  (echo "c"))

README.md

@@ -146,9 +146,9 @@ Clake provides the following forms to define tasks and namespaces in `Clakefile`
 
 ### [Function] clake
 
-    CLAKE &key target pathname verbose
+    CLAKE &key target pathname parallel verbose
 
-Loads a Clakefile specified with `pathname` to execute a task of name `target` defined in the Clakefile. Not nil `verbose` provides verbose mode. If `target` is not given, `"default"` is used for the default task name. If `pathname` is not given, a file of name `Clakefile` in the current directory is searched for. You should be aware that where the Common Lisp process' current directory is.
+Loads a Clakefile specified with `pathname` to execute a task of name `target` defined in the Clakefile. Not nil `parallel` enables parallel task execution. Not nil `verbose` provides verbose mode. If `target` is not given, `"default"` is used for the default task name. If `pathname` is not given, a file of name `Clakefile` in the current directory is searched for. You should be aware that where the Common Lisp process' current directory is.
 
     (clake :target "hello")
 
@@ -202,6 +202,8 @@ Clake provides its command line interface as a roswell script.
             Use FILE as a Clakefile.
         -h
             Print usage.
+        -j
+            Execute multiple tasks in parallel.
         -v
             Verbose mode.
 

clake.asd

@@ -22,6 +22,7 @@
                :cl-syntax-annot
                :closer-mop
                :alexandria
+               :bordeaux-threads
                :split-sequence
                :cl-syntax-interpol)
   :components ((:module "src"

roswell/clake.ros

@@ -11,22 +11,25 @@ exec ros -Q -- $0 "$@"
   (write-line "Options:")
   (write-line "  -f FILE       Use FILE as a clakefile.")
   (write-line "  -h            Print this message and exit.")
+  (write-line "  -j            Execute multiple tasks in parallel.")
   (write-line "  -v            Verbose mode."))
 
 (defun main (&rest argv)
   (declare (ignorable argv))
   (handler-case
-      (let (targets pathname f-mode v-mode)
+      (let (targets pathname f-mode j-mode v-mode)
         (loop for arg in argv
            do (cond
                 (f-mode (setf pathname arg)
                         (setf f-mode nil))
                 ((string= "-f" arg) (setf f-mode t))
                 ((string= "-h" arg) (print-help)
                                     (ros:quit 1))
+                ((string= "-j" arg) (setf j-mode t))
                 ((string= "-v" arg) (setf v-mode t))
                 (t (push arg targets))))
         (let ((params `(:verbose ,v-mode
+                        :parallel ,j-mode
                         ,@(when pathname
                             `(:pathname ,pathname)))))
           (if targets

src/clake.lisp

@@ -31,6 +31,53 @@
 (defun last1 (list)
   (car (last list)))
 
+(defmacro let% (bindings &body body)
+  (if bindings
+      (destructuring-bind ((var value) . rest) bindings
+        (alexandria:with-gensyms (orig)
+          `(let ((,orig ,var))
+             (setf ,var ,value)
+             (unwind-protect
+                  (let% (,@rest)
+                    ,@body)
+               (setf ,var ,orig)))))
+      `(progn ,@body)))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+
+  (defun dolist%-sequential-form (var list body)
+    `(dolist (,var ,list)
+       ,@body))
+
+  (defun dolist%-parallel-form (var list body)
+    `(let ((threads
+             (mapcar
+               #'(lambda (,var)
+                   (let ((parent (bt:current-thread)))
+                     (bt:make-thread
+                       #'(lambda ()
+                           (handler-case
+                               (progn ,@body)
+                             (error (e)
+                               (bt:interrupt-thread parent
+                                 #'(lambda ()
+                                     (error e))))))
+                       :initial-bindings
+                       `((*standard-output* . ,*standard-output*)
+                         (*error-output* . ,*error-output*)))))
+               ,list)))
+       (loop for thread in threads
+          do (bt:join-thread thread)))))
+
+(defmacro dolist% ((var list parallel) &body body)
+  (cond
+    ((eq parallel t) (dolist%-parallel-form var list body))
+    ((eq parallel nil) (dolist%-sequential-form var list body))
+    (t (once-only (list)
+         `(if (not ,parallel)
+              ,(dolist%-sequential-form var list body)
+              ,(dolist%-parallel-form var list body))))))
+
 
 ;;;
 ;;; Verbose
@@ -125,8 +172,8 @@
   (format stream "#<TASK ~S>" (task-name task)))
 
 (defmethod %execute-task ((task base-task))
-  ;; Needed just for (EXECUTE-TASK TASK) because of functional / CLOS sytle
-  ;; mismatch.
+  (when *parallel*
+    (verbose "Execute in parallel." t))
   (execute-task task))
 
 
@@ -152,26 +199,33 @@
 (defvar *history*)
 
 (defmethod %execute-task ((task task))
+  (when *parallel*
+    (verbose "Execute in parallel." t))
   (let ((*history* nil))
     (execute-task task)))
 
+(defvar *parallel* nil)
+
 (defmethod execute-task :before ((task task))
   ;; Execute dependency tasks.
-  (let ((*history* (cons task *history*)))
-    (loop for task-name in (task-dependency task)
-       do (cond
-            ((task-exists-p task-name)
-             (let ((task1 (get-task task-name)))
-               ;; Error if has circular dependency.
-               (unless (not (member task1 *history* :test #'task=))
-                 (error "The task ~S has circular dependency."
-                        (task-name (last1 *history*))))
-               ;; Execute a dependency task.
-               (execute-task task1)))
-            ((file-exists-p (dependency-file-name task-name))
-             ;; Noop.
-             nil)
-            (t (error "Don't know how to build task ~S." task-name))))))
+  (let ((history (cons task *history*))
+        (tasks *tasks*))
+    (dolist% (task-name (task-dependency task) *parallel*)
+      (cond
+        ((task-exists-p task-name tasks)
+         (let ((task1 (get-task task-name tasks)))
+           ;; Error if has circular dependency.
+           (unless (not (member task1 history :test #'task=))
+             (error "The task ~S has circular dependency."
+                    (task-name (last1 history))))
+           ;; Execute a dependency task.
+           (let ((*history* history)
+                 (*tasks* tasks))
+             (execute-task task1))))
+        ((file-exists-p (dependency-file-name task-name))
+         ;; Noop.
+         nil)
+        (t (error "Don't know how to build task ~S." task-name))))))
 
 (defmethod execute-task ((task task))
   ;; Show message if verbose.
@@ -338,8 +392,10 @@
 
 (defun clake (&key (target "default")
                    (pathname (get-clakefile-pathname))
-                   (verbose nil))
-  (let ((*verbose* verbose))
+                   parallel
+                   verbose)
+  (let% ((*parallel* parallel)
+         (*verbose* verbose))
     ;; Show message if verbose.
     (verbose (format nil "Current directory: ~A~%" (getcwd)))
     ;; Load Clakefile to execute tasks.

t/clake.lisp

@@ -47,6 +47,33 @@
             type-error
             "invalid list."))
 
+(subtest "let%"
+  (let ((x 1))
+    (clake::let% ((x 2))
+      (is x 2))
+    (is x 1)))
+
+(subtest "dolist%"
+
+  (let (ret)
+    (clake::dolist% (x '(1 2 3) nil)
+      (push x ret))
+    (is (reverse ret)
+        '(1 2 3)))
+
+  (let (ret)
+    (clake::dolist% (x '(1 2 3) t)
+      (push x ret))
+    (is (sort ret #'<)
+        '(1 2 3)))
+
+  (let ((parallel t))
+    (let (ret)
+      (clake::dolist% (x '(1 2 3) parallel)
+        (push x ret))
+      (is (sort ret #'<)
+          '(1 2 3)))))
+
 
 ;;;
 ;;; Verbose
@@ -203,15 +230,17 @@
       '("bar" "foo"))
 
   (is-error (clake::task-name-namespace :foo)
-            type-error))
+            type-error
+            "invalid task name."))
 
 (subtest "task-name-name"
 
   (is (clake::task-name-name "foo:bar:baz")
       "baz")
 
   (is-error (clake::task-name-name :foo)
-            type-error))
+            type-error
+            "invalid task name."))
 
 (subtest "namespace macro"
 
@@ -503,6 +532,34 @@
             "invalid task name."))
 
 
+;;;
+;;; Parallel
+;;;
+
+(subtest "parallel"
+
+  (clake::let% ((clake::*tasks* nil)
+                (clake::*parallel* t))
+    (let (ret)
+      (let ((task1 (clake::make-task "multi" nil '("a" "b" "c") #'noop))
+            (task2 (clake::make-task "a" nil '("b")
+                                     #'(lambda ()
+                                         (push 1 ret))))
+            (task3 (clake::make-task "b" nil '("c")
+                                     #'(lambda ()
+                                         (push 2 ret))))
+            (task4 (clake::make-task "c" nil nil
+                                     #'(lambda ()
+                                         (push 3 ret)))))
+        (clake::register-task task1)
+        (clake::register-task task2)
+        (clake::register-task task3)
+        (clake::register-task task4)
+        (clake::%execute-task task1)
+        (is (sort ret #'<)
+            '(1 2 2 3 3 3))))))
+
+
 ;;;
 ;;; Run
 ;;;