buildscript runs in its own namespace; move rebuilt-on-file-change into main build tree

This commit is contained in:
Moonchild 2020-10-04 18:12:15 -07:00
parent f1ca59b7c9
commit ebad4e91e6
5 changed files with 62 additions and 55 deletions

@ -1,62 +1,11 @@
(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)
(defclass c-source-buildable (rebuilt-on-file-change)
((source-file :initarg :source-file)
(obj-file :initarg :obj-file)))
(defclass c-binary-buildable (rebuilt-on-change)
(defclass c-binary-buildable (rebuilt-on-file-change)
((target-binary :initarg :target-binary)
(obj-files)))

1
fb.asd

@ -9,6 +9,7 @@
:depends-on (#:osicat #:ironclad #:cl-conspack)
:components ((:file "dependable")
(:file "buildables/rebuilt-on-file-change" :depends-on ("dependable"))
(:file "fb-entry" :depends-on ("dependable")))
;(:file "x" :depends-on ("y" "z"))

@ -0,0 +1,46 @@
(in-package :fancybuild)
(export '(rebuilt-on-file-change input-files output-files))
(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 been modified
(defclass rebuilt-on-file-change (buildable)
((input-files :initarg :input-files :initform nil)
(output-files :initarg :output-files :initform nil)))
(defmethod snapshot ((b rebuilt-on-file-change))
(mapcar #'freeze-file-state (slot-value b 'input-files)))
(defmethod is-dirty ((b rebuilt-on-file-change) old)
(or (not (any #'probe-file (slot-value b 'output-files)))
(any #'has-file-changed (slot-value b 'input-files) old)))

@ -1,6 +1,10 @@
(defpackage #:fancybuild
(:use #:cl)
(:export #:main))
(:export #:buildable #:dependencies #:cached-snapshot #:pretty-name #:unique-key #:snapshot #:do-build #:is-dirty))
; package in which build scripts run
(defpackage #:fancily-built
(:use #:cl #:fancybuild))
(in-package :fancybuild)

@ -1,8 +1,13 @@
(in-package :fancybuild)
(export '(target main))
(defparameter *targets* (make-hash-table :test #'equal))
(defparameter *global-cache* (make-hash-table :test #'equal))
(defun target (name target)
(setf (gethash name *targets*) target))
(defun naively-build (b)
(mapcar #'naively-build (slot-value b 'dependencies))
(when (and (not (slot-value b 'cached-snapshot))
@ -38,7 +43,9 @@
(setf *global-cache*
(conspack:with-interning () (conspack:decode buf))))))
(load "fancy.build")
(progn
(in-package :fancily-built)
(load "fancy.build"))
(mapcar #'(lambda (target-name)
(let ((target (gethash target-name *targets*)))