Moonchild/fancy-build
1
0
Fork 1
Code Issues Pull Requests Releases Activity

organization; quit with non-zero exit code on error

Browse Source
This commit is contained in:
Moonchild 2020-10-04 17:42:39 -07:00
parent dccfa20b9b
commit f1ca59b7c9
2 changed files with 21 additions and 90 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

84
src/dependable.lisp
View File

@ -2,71 +2,6 @@
(:use #:cl)
(:export #:main))
; to do the 'test' target:
; - build the 'mocc' target
; AND THEN
; - run the file './aux/run-tests', failing iff it returns non-zero
; to do the 'mocc' target:
; - build the 'libmocl.a' target
; - build the 'src/buf.c' target
; - build the 'src/tok.c' target
; - build the 'src/parse.c' target
; AND THEN
; - run 'cc -o build/mocc build/cl/libmocl.a build/src/buf.o build/src/tok.o build/src/parse.o'
;
; ONLY IF 'mocc' needs to be rebuilt:
; to do the 'src/buf.c' target
; - run 'cc -c -o build/src/buf.c.o src/buf.c'
; ONLY IF 'build/src/buf.c.o' needs to be rebuilt:
; - build/src/buf.c.o doesn't exist
; - build/src/buf.c.o exists, but src/buf.c has been modified since the last time we built build/src/buf.c.o
; - build/src/buf.c.o exists, and src/buf.c hasn't been modified, but build/src/buf.c.d exists and one of the files in it has been modified since the last time we built build/src/buf.c.o
; Do I have to care about the relationship between 'src/buf.c' and 'build/src/buf.o'? No
; a buildable represents a relation from /dependencies/ to /products/
; a buildable will be built if any of its dependencies are dirty, or if it is dirty
; a buildable is dirty if its current state is incompatible with a previously snapshotted state
; or, if there is no previously snapshotted state--for instance, if this is the first time building the buildable
(in-package :fancybuild)
(defclass buildable ()
@ -79,22 +14,3 @@
(defgeneric is-dirty (buildable old))
(defgeneric do-build (buildable))
(defun build (b)
(mapcar #'build (slot-value b 'dependencies))
(when (and (not (slot-value b 'cached-snapshot))
(slot-value b 'unique-key)
(gethash (slot-value b 'unique-key) *global-cache*))
(setf (slot-value b 'cached-snapshot) (gethash (slot-value b 'unique-key) *global-cache*)))
(unless (and (slot-value b 'cached-snapshot)
(not (is-dirty b (slot-value b 'cached-snapshot))))
(format t "Building ~a...~%" (slot-value b 'pretty-name))
(handler-case (do-build b)
(error ()
(format t "Error building ~a!~%" (slot-value b 'pretty-name))
(uiop:quit))))
(setf (slot-value b 'cached-snapshot) (snapshot b))
(when (slot-value b 'unique-key)
(setf (gethash (slot-value b 'unique-key) *global-cache*)
(slot-value b 'cached-snapshot)))
nil)

27
src/fb-entry.lisp
View File

@ -3,15 +3,30 @@
(defparameter *targets* (make-hash-table :test #'equal))
(defparameter *global-cache* (make-hash-table :test #'equal))
; (let ((proc (uiop:launch-program "sleep 0.4")))
; (format t "process is ~a. Aliveness is ~a. Waiting for it...~%" proc (uiop:process-alive-p proc))
; (uiop:wait-process proc)
; (format t "process is done!~%exiting~%"))
(defun naively-build (b)
(mapcar #'naively-build (slot-value b 'dependencies))
(when (and (not (slot-value b 'cached-snapshot))
(slot-value b 'unique-key)
(gethash (slot-value b 'unique-key) *global-cache*))
(setf (slot-value b 'cached-snapshot) (gethash (slot-value b 'unique-key) *global-cache*)))
(unless (and (slot-value b 'cached-snapshot)
(not (is-dirty b (slot-value b 'cached-snapshot))))
(format t "Building ~a...~%" (slot-value b 'pretty-name))
(handler-case (do-build b)
(error ()
(format t "Error building ~a!~%" (slot-value b 'pretty-name))
(uiop:quit 1))))
(setf (slot-value b 'cached-snapshot) (snapshot b))
(when (slot-value b 'unique-key)
(setf (gethash (slot-value b 'unique-key) *global-cache*)
(slot-value b 'cached-snapshot)))
nil)
(defun main ()
(unless (probe-file "fancy.build")
(format t "Could not find build description file 'fancy.build'.~%")
(uiop:quit))
(uiop:quit 1))
(when (probe-file "fancy.buildcache")
(with-open-file (fp "fancy.buildcache"
@ -28,7 +43,7 @@
(mapcar #'(lambda (target-name)
(let ((target (gethash target-name *targets*)))
(if target
(build target)
(naively-build target)
(format t "No target named '~a'.~%" target-name))))
(or (uiop:command-line-arguments) '("default")))