fancy-build/example/fancy.build

(in-package :fancybuild)

(defun runp (cmd)
  (assert (zerop (uiop:wait-process (uiop:launch-program cmd :output *standard-output* :error-output *error-output*)))))

(defun target (name target)
  (setf (gethash name *targets*) target))

(defun mtime (x) (osicat-posix:stat-mtime (osicat-posix:stat x)))
; todo blake3?
(defun sha256 (fn)
  (with-open-file (fp fn
                      :direction :input
                      :if-does-not-exist :error
                      :element-type '(unsigned-byte 8))
    (let ((buf (make-array (file-length fp) :element-type '(unsigned-byte 8))))
      (read-sequence buf fp)
      (ironclad:digest-sequence :sha256 buf))))

(defun any (pred &rest lis)
  (if (null (car lis))
    nil
    (or (apply pred (mapcar #'car lis))
        (apply #'any (cons pred (mapcar #'cdr lis))))))
(defun all (pred &rest lis)
  (if (null (car lis))
    t
    (and (apply pred (mapcar #'car lis))
         (apply #'all (cons pred (mapcar #'cdr lis))))))

(defun freeze-file-state (fpath)
  (cons (mtime fpath) (sha256 fpath)))

(defun has-file-changed (fpath state)
  (and (not (= (mtime fpath) (car state)))
       (not (equalp (sha256 fpath) (cdr state)))))

; Rebuild whenever any of the output files doesn't exist
; Or, whenever any of the input files has a newer mtime than any of the output files
;  (that is, whenever the newest input file is newer than the oldest output file)
; Or, whenever any of the input files has been modified
(defclass rebuilt-on-change (buildable)
  ((input-files :initarg :input-files :initform nil)
   (output-files :initarg :output-files :initform nil)))

(defmethod snapshot ((b rebuilt-on-change))
  (mapcar #'freeze-file-state (slot-value b 'input-files)))

(defmethod is-dirty ((b rebuilt-on-change) old)
  (or (not (any #'probe-file (slot-value b 'output-files)))
      (> (reduce #'max (mapcar #'mtime (slot-value b 'input-files)))
	 (reduce #'min (mapcar #'mtime (slot-value b 'output-files))))
      (any #'has-file-changed (slot-value b 'input-files) old)))

(defclass c-source-buildable (rebuilt-on-change)
  ((source-file :initarg :source-file)
   (obj-file :initarg :obj-file)))

(defclass c-binary-buildable (rebuilt-on-change)
  ((target-binary :initarg :target-binary)
   (obj-files)))

(defmethod initialize-instance :after ((b c-binary-buildable) &key)
  (setf (slot-value b 'obj-files) (mapcar #'(lambda (x) (slot-value x 'obj-file)) (remove-if-not #'(lambda (x) (typep x 'c-source-buildable)) (slot-value b 'dependencies))))
  (setf (slot-value b 'input-files) (slot-value b 'obj-files))
  (setf (slot-value b 'output-files) (list (slot-value b 'target-binary)))
  (setf (slot-value b 'pretty-name) (slot-value b 'target-binary))
  (setf (slot-value b 'unique-key) (cons "c-binary-buildable" (cons (slot-value b 'target-binary) (slot-value b 'obj-files)))))

(defmethod do-build ((b c-binary-buildable))
  (runp (format nil "cc -o ~a ~{~a~^ ~}" (slot-value b 'target-binary) (slot-value b 'obj-files))))

(defmethod initialize-instance :after ((b c-source-buildable) &key)
  (setf (slot-value b 'input-files) (list (slot-value b 'source-file)))
  (setf (slot-value b 'output-files) (list (slot-value b 'obj-file)))
  (setf (slot-value b 'pretty-name) (slot-value b 'source-file))
  ; conspack doesn't automatically intern symbols so we have to use "c-source-buildable" instead of 'c-source-buildable
  ; (because uninterned symbols aren't equal to anything)
  (setf (slot-value b 'unique-key) (list "c-source-buildable" (slot-value b 'obj-file) (slot-value b 'source-file))))

(defmethod do-build ((b c-source-buildable))
  (ensure-directories-exist (directory-namestring (slot-value b 'obj-file)))
  (runp (format nil "cc -c -o ~a ~a" (slot-value b 'obj-file) (slot-value b 'source-file))))

(defun c-source (file)
  (make-instance 'c-source-buildable
                 :source-file file
                 :obj-file (format nil "build/~a.o" file)))
(defun c-sourcelist (srclist)
  (mapcar #'c-source srclist))
;(c-sourcelist srclist)

(defun c-binary (bin deps)
  (make-instance 'c-binary-buildable
                 :target-binary (format nil "build/~a" bin)
                 :dependencies deps))

(defparameter *t1*
  (c-binary "test"
            (c-sourcelist '("src/add.c" "src/test.c"))))
(defparameter *t2*
  (c-binary "test2"
            (c-sourcelist '("src/add.c" "src/test2.c"))))

;(defparameter x (make-instance 'c-source-buildable
;                               :source-file "test/test.c"
;                               :obj-file "build/test/test.o"))
;(defparameter y (make-instance 'c-source-buildable
;                               :source-file "test/add.c"
;                               :obj-file "build/test/add.o"))
;(defparameter z (make-instance 'c-binary-buildable
;                               :target-binary "build/test/test"
;                               :dependencies (list x y)))

(target "default" *t1*)
(target "other" *t2*)