From e05aabbb81cddec46b3d9da802f632c3b20c67d1 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Thu, 8 Aug 2019 12:58:07 +0100
Subject: [PATCH] src/: Write dependency-tracking Makefile fragments.

And deploy them in the Makefile!
---
 doc/SYMBOLS            |  8 ++++++++
 doc/module.tex         |  5 ++++-
 doc/output.tex         |  3 +++
 src/frontend.lisp      | 10 +++++++++-
 src/module-output.lisp | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 src/module-parse.lisp  |  5 ++++-
 src/module-proto.lisp  |  5 ++++-
 test/Makefile.am       |  3 +++
 vars.am                |  6 ++++--
 9 files changed, 85 insertions(+), 6 deletions(-)

diff --git a/doc/SYMBOLS b/doc/SYMBOLS
index e533a38..cd3dbed 100644
--- a/doc/SYMBOLS
+++ b/doc/SYMBOLS
@@ -586,6 +586,7 @@ module-output.lisp
   one-off-output                                function
   output-module                                 function
   output-type-pathname                          function
+  write-dependency-file                         generic
 
 module-parse.lisp
   class-item
@@ -606,6 +607,7 @@ module-proto.lisp
   module                                        class
   module-dependencies                           generic setf-generic
   module-errors                                 generic
+  module-files                                  generic setf-generic
   module-import                                 generic
   module-items                                  generic setf-generic
   module-name                                   generic
@@ -1353,6 +1355,10 @@ module-dependencies
   t module
 module-errors
   module
+module-files
+  module
+(setf module-files)
+  t module
 module-import
   t
   module
@@ -1656,6 +1662,8 @@ vtmsgs-entries
   vtmsgs
 vtmsgs-subclass
   vtmsgs
+write-dependency-file
+  module t t
 
 -----------------------------------------------------------------------------
 Package `sod-frontend'
diff --git a/doc/module.tex b/doc/module.tex
index 5d245dd..ca9e13e 100644
--- a/doc/module.tex
+++ b/doc/module.tex
@@ -50,7 +50,8 @@
 \end{describe}
 
 \begin{describe}{cls}
-    {module () \&key :name :pset :items :dependencies :variables :state}
+    {module ()
+      \&key :name :pset :items :files :dependencies :variables :state}
 \end{describe}
 
 \begin{describe*}
@@ -59,6 +60,8 @@
      \dhead{gf}{module-errors @<module> @> @<integer>}
      \dhead{gf}{module-items @<module> @> @<list>}
      \dhead{gf}{setf (module-items @<module>) @<list>}
+     \dhead{gf}{module-files @<module> @> @<list>}
+     \dhead{gf}{setf (module-files @<module>) @<list>}
      \dhead{gf}{module-dependencies @<module> @> @<list>}
      \dhead{gf}{setf (module-dependencies @<module>) @<list>}
      \dhead{gf}{module-state @<module> @> @<symbol>}
diff --git a/doc/output.tex b/doc/output.tex
index 0423178..5b464ba 100644
--- a/doc/output.tex
+++ b/doc/output.tex
@@ -193,6 +193,9 @@ until the third.  So the final processing order is
   \end{describe*}
 \end{describe}
 
+\begin{describe}{gf}{write-dependency-file @<module> @<reason> @<output-dir>}
+\end{describe}
+
 \begin{describe}{fun}{output-module @<module> @<reason> @<stream>}
 \end{describe}
 
diff --git a/src/frontend.lisp b/src/frontend.lisp
index 1d09382..41f38cd 100644
--- a/src/frontend.lisp
+++ b/src/frontend.lisp
@@ -98,6 +98,7 @@
 	(backtracep nil)
 	(builtinsp nil)
 	(stdoutp nil)
+	(track-deps-p nil)
 	(args nil))
 
     ;; Option definitions.
@@ -145,6 +146,9 @@
 						  :print nil))))
 			   (error (error)
 			     (option-parse-error "~A" error))))))
+		(#\M "track-dependencies"
+		     "Write make(1) fragments recording dependencies."
+		     (set track-deps-p))
 		(#\p "stdout"
 		     ("Write output files to standard output.")
 		     (set stdoutp))
@@ -190,7 +194,11 @@
 			     :direction :output
 			     :if-exists :supersede
 			     :if-does-not-exist :create)
-			  (output-module module reason stream))))
+			  (output-module module reason stream))
+
+			(when track-deps-p
+			  (write-dependency-file module reason
+						 output-path))))
 
 		   ;; Error recovery.
 		   (continue ()
diff --git a/src/module-output.lisp b/src/module-output.lisp
index fe04f2b..f9eb3a4 100644
--- a/src/module-output.lisp
+++ b/src/module-output.lisp
@@ -212,6 +212,7 @@
 
    The output file name will be constructed by merging the module's pathname
    with PATHNAME."
+  (pushnew reason *output-types*)
   (setf (get reason 'output-type) pathname))
 
 (export 'output-type-pathname)
@@ -246,6 +247,51 @@
 		(make-pathname :directory nil
 			       :defaults (module-name module)))))
 
+(export 'write-dependency-file)
+(defgeneric write-dependency-file (module reason output-dir)
+  (:documentation
+   "Write a dependency-tracking make(1) fragment.
+
+   Specifically, we've processed a MODULE for a particular REASON (a
+   symbol), and the user has requested that output be written to OUTPUT-DIR
+   (a pathname): determine a suitable output pathname and write a make(1)
+   fragment explaining that the output file we've made depends on all of the
+   files we had to read to load the module."))
+
+(defmethod write-dependency-file ((module module) reason output-dir)
+  (let* ((common-case
+	  ;; Bletch.  We want to derive the filetype from the one we're
+	  ;; given, but we need to determine the environment's preferred
+	  ;; filetype case to do that.  Make a pathname and inspect it to
+	  ;; find out how to do this.
+
+	  (if (upper-case-p
+			   (char (pathname-type (make-pathname
+						 :type "TEST"
+						 :case :common))
+				 0))
+			  #'string-upcase
+			  #'string-downcase))
+
+	 (outpath (output-type-pathname reason))
+	 (deppath (make-pathname :type (concatenate 'string
+						    (pathname-type outpath)
+						    (funcall common-case
+							     "-DEP"))
+				 :defaults outpath))
+	 (outfile (module-output-file module reason output-dir))
+	 (depfile (module-output-file module deppath output-dir)))
+
+    (with-open-file (dep depfile
+		     :direction :output
+		     :if-exists :supersede
+		     :if-does-not-exist :create)
+      (format dep "### -*-makefile-*-~%~
+		   ~A:~{ \\~%	~A~}~%"
+	      outfile
+	      (cons (module-name module)
+		    (module-files module))))))
+
 (define-clear-the-decks reset-output-types
   "Clear out the registered output types."
   (dolist (reason *output-types*) (remprop reason 'output-type))
diff --git a/src/module-parse.lisp b/src/module-parse.lisp
index df058be..311206d 100644
--- a/src/module-parse.lisp
+++ b/src/module-parse.lisp
@@ -156,6 +156,7 @@
 							    :truename true)))
 				   (when module
 				     (module-import module)
+				     (pushnew path (module-files *module*))
 				     (pushnew module
 					      (module-dependencies
 					       *module*))))
@@ -170,7 +171,9 @@
 		   (common name "LISP" "Lisp file"
 			   (lambda (path true)
 			     (handler-case
-				 (load true :verbose nil :print nil)
+				 (progn
+				   (pushnew path (module-files *module*))
+				   (load true :verbose nil :print nil))
 			       (error (error)
 				 (cerror* "Error loading Lisp file ~S: ~A"
 					  path error)))))))))))
diff --git a/src/module-proto.lisp b/src/module-proto.lisp
index 1fbba7c..ca0d511 100644
--- a/src/module-proto.lisp
+++ b/src/module-proto.lisp
@@ -149,13 +149,14 @@
 ;;; Module objects.
 
 (export '(module module-name module-pset module-errors
-	  module-items module-dependencies module-state))
+	  module-items module-files module-dependencies module-state))
 (defclass module ()
   ((name :initarg :name :type pathname :reader module-name)
    (%pset :initarg :pset :initform (make-pset)
 	  :type pset :reader module-pset)
    (errors :initarg :errors :initform 0 :type fixnum :reader module-errors)
    (items :initarg :items :initform nil :type list :accessor module-items)
+   (files :initarg :files :initform nil :type list :accessor module-files)
    (dependencies :initarg :dependencies :initform nil
 		 :type list :accessor module-dependencies)
    (variables :initarg :variables :type list :accessor module-variables
@@ -181,6 +182,8 @@
 
      * A list of other modules that this one depends on.
 
+     * A list of other files this module has read.
+
      * A list of module-variable values, in the order in which they're named
        in `*module-bindings-alist*'.
 
diff --git a/test/Makefile.am b/test/Makefile.am
index de5b634..3ffec2b 100644
--- a/test/Makefile.am
+++ b/test/Makefile.am
@@ -29,6 +29,7 @@ include	$(top_srcdir)/vars.am
 ### The silly Chimaera example.
 
 check_PROGRAMS		+= chimaera
+-include chimaera.c-dep chimaera.h-dep
 
 EXTRA_DIST		+= chimaera.sod
 nodist_chimaera_SOURCES	 = chimaera.c chimaera.h
@@ -45,6 +46,7 @@ check-local:: chimaera chimaera.ref
 
 TESTS			+= test
 check_PROGRAMS		+= test
+-include test.c-dep test.h-dep
 
 EXTRA_DIST		+= test.sod
 nodist_test_SOURCES	 = test.c test.h
@@ -59,6 +61,7 @@ check-local:: kwtest kwtest.ref
 	diff -u $(srcdir)/kwtest.ref kwtest.out
 
 check_PROGRAMS		+= rat
+-include rat.c-dep rat.h-dep
 
 EXTRA_DIST		+= rat.sod rat.ref
 nodist_rat_SOURCES	 = rat.c rat.h
diff --git a/vars.am b/vars.am
index b3f81b7..21f03ce 100644
--- a/vars.am
+++ b/vars.am
@@ -94,8 +94,10 @@ V_SOD_h_0		 = @echo "  SOD[h]   $@";
 SUFFIXES		+= .c .h .sod
 .sod.c:; $(V_SOD_c)$(SOD) -tc $<
 .sod.h:; $(V_SOD_h)$(SOD) -th $<
-%.c: %.sod $(SOD); $(V_SOD_c)$(SOD) -tc $<
-%.h: %.sod $(SOD); $(V_SOD_h)$(SOD) -th $<
+%.c: %.sod $(SOD); $(V_SOD_c)$(SOD) -M -tc $<
+%.h: %.sod $(SOD); $(V_SOD_h)$(SOD) -M -th $<
+
+DISTCLEANFILES		+= *.c-dep *.h-dep
 
 ###--------------------------------------------------------------------------
 ### Silent rules for Lisp.
-- 
2.11.0

