From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Sat, 17 Mar 2018 19:54:43 +0000 (-0700)
Subject: devops/lint: Support @include lines in .texis.
X-Git-Tag: mit-scheme-pucked-x11-0.2.2~28
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=a4ec6e8fe02ef635ed91e648433b5e00debb38fe;p=mit-scheme.git

devops/lint: Support @include lines in .texis.
---

diff --git a/src/devops/lint.scm b/src/devops/lint.scm
index 9c41fe3e0..9b3e00c7b 100644
--- a/src/devops/lint.scm
+++ b/src/devops/lint.scm
@@ -31,96 +31,112 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
   (let* ((name (plugin-name plugin))
 	 (dir (plugin-directory plugin))
 	 (file (string dir"/"name".texi")))
-
-    (define (lint)
-      (let* ((texinfo (list->vector (call-with-input-file file read-lines)))
-	     (deffns (texinfo-deffns texinfo))
-	     (dups (duplicates deffns))
-	     (pmodel (read-package-model (string dir"/"name)
-					 microcode-id/operating-system))
-	     (bindings (difference
-			(append (pmodel/global-exports pmodel)
-				(if (not pkg)
-				    '()
-				    (pmodel/package-bindings pmodel pkg)))
-			exceptions))
-	     (missing (difference bindings deffns))
-	     (extras (difference deffns bindings)))
-	(append!
-	 (map (lambda (n) (string file": "n" has multiple descriptions")) dups)
-	 (map (lambda (n) (string file": "n" is not bound")) extras)
-	 (map (lambda (n) (string file": "n" is not documented")) missing))))
-
-    (define deffn-patt
-      (compile-regsexp '(seq "@deffn"(?"x")" "
-			     (alt "Class" "Procedure" "{Generic Procedure}")" "
-			     (group name
-				    (+ (char-not-in whitespace))))))
-
-    (define (deffn-name line)
-      (let ((match (regsexp-match-string deffn-patt line)))
-	(if match
-	    (intern (match-extract match 'name))
-	    (error "Could not find binding name:" line))))
-
-    (define (texinfo-deffns lines)
-      (let ((len (vector-length lines)))
-	(let loop ((i 0) (deffns '()))
-	  (if (fix:< i len)
-	      (let ((line (vector-ref lines i)))
-		(loop (fix:1+ i)
-		      (if (string-prefix? "@deffn" line)
-			  (cons (deffn-name line) deffns)
-			  deffns)))
-	      deffns))))
-
-    (define (pmodel/find-package pmodel package-name)
-      (find-matching-item (pmodel/packages pmodel)
-			  (lambda (p) (equal? package-name (package/name p)))))
-
-    (define (pmodel/global-exports pmodel)
-      (define (global-exports package)
-	(append-map! (lambda (link)
-		       (if (eq? '() (package/name
-				     (binding/package
-				      (link/destination link))))
-			   (list (binding/name (link/destination link)))
-			   '()))
-		     (package/links package)))
-      (append-map! global-exports (pmodel/packages pmodel)))
-
-    (define (pmodel/package-bindings pmodel package-name)
-      (let ((package (pmodel/find-package pmodel package-name)))
-	(if package
-	    (map binding/name (package/bindings package))
-	    (error "No such package:" package-name))))
-
-    (define (duplicates listset)
-      (let loop ((items listset) (duplicates '()))
-	(cond ((null? items)
-	       (reverse! duplicates))
-	      ((memq (car items) (cdr items))
-	       (if (memq (car items) duplicates)
-		   (loop (cdr items) duplicates)
-		   (loop (cdr items) (cons (car items) duplicates))))
-	      (else
-	       (loop (cdr items) duplicates)))))
-
-    (define (difference set1 set2)
-      (let loop ((items set1) (difference '()))
-	(cond ((null? items)
-	       difference)
-	      ((memq (car items) set2)
-	       (loop (cdr items) difference))
-	      (else
-	       (loop (cdr items) (cons (car items) difference))))))
-
     (if (file-exists? file)
-	(lint)
+	(let* ((texinfo (texi-lines file))
+	       (deffns (texinfo-deffns texinfo))
+	       (dups (duplicates deffns))
+	       (pmodel (read-package-model (string dir"/"name)
+					   microcode-id/operating-system))
+	       (bindings (difference
+			  (append (pmodel/global-exports pmodel)
+				  (if (not pkg)
+				      '()
+				      (pmodel/package-bindings pmodel pkg)))
+			  exceptions))
+	       (missing (difference bindings deffns))
+	       (extras (difference deffns bindings)))
+	  (append!
+	   (map (lambda (n) (string file": "n" has multiple descriptions"))dups)
+	   (map (lambda (n) (string file": "n" is not bound")) extras)
+	   (map (lambda (n) (string file": "n" is not documented")) missing)))
 	'())))
 
+(define deffn-patt
+  (compile-regsexp '(seq "@deffn"(?"x")" "
+			 (alt "Class" "Procedure" "{Generic Procedure}")" "
+			 (group name
+				(+ (char-not-in whitespace))))))
+
+(define (deffn-name line)
+  (let ((match (regsexp-match-string deffn-patt line)))
+    (if match
+	(intern (match-extract match 'name))
+	(error "Could not find binding name:" line))))
+
+(define (texinfo-deffns lines)
+  (let ((len (vector-length lines)))
+    (let loop ((i 0) (deffns '()))
+      (if (fix:< i len)
+	  (let ((line (vector-ref lines i)))
+	    (loop (fix:1+ i)
+		  (if (string-prefix? "@deffn" line)
+		      (cons (deffn-name line) deffns)
+		      deffns)))
+	  deffns))))
+
+(define (pmodel/find-package pmodel package-name)
+  (find-matching-item (pmodel/packages pmodel)
+		      (lambda (p) (equal? package-name (package/name p)))))
+
+(define (pmodel/global-exports pmodel)
+  (define (global-exports package)
+    (append-map! (lambda (link)
+		   (if (eq? '() (package/name
+				 (binding/package
+				  (link/destination link))))
+		       (list (binding/name (link/destination link)))
+		       '()))
+		 (package/links package)))
+  (append-map! global-exports (pmodel/packages pmodel)))
+
+(define (pmodel/package-bindings pmodel package-name)
+  (let ((package (pmodel/find-package pmodel package-name)))
+    (if package
+	(map binding/name (package/bindings package))
+	(error "No such package:" package-name))))
+
+(define (duplicates listset)
+  (let loop ((items listset) (duplicates '()))
+    (cond ((null? items)
+	   (reverse! duplicates))
+	  ((memq (car items) (cdr items))
+	   (if (memq (car items) duplicates)
+	       (loop (cdr items) duplicates)
+	       (loop (cdr items) (cons (car items) duplicates))))
+	  (else
+	   (loop (cdr items) duplicates)))))
+
+(define (difference set1 set2)
+  (let loop ((items set1) (difference '()))
+    (cond ((null? items)
+	   difference)
+	  ((memq (car items) set2)
+	   (loop (cdr items) difference))
+	  (else
+	   (loop (cdr items) (cons (car items) difference))))))
+
+(define (texi-lines file)
+  (list->vector (reverse! (texi-lines-reversed file))))
+
+(define (texi-lines-reversed file)
+  (call-with-input-file file
+    (lambda (port)
+      (let loop ((lines '()))
+	(let ((line (read-line port)))
+	  (cond ((eof-object? line)
+		 lines)
+		((string-prefix? "@include " line)
+		 (let ((name (string-trim (substring line 9))))
+		   (if (not (string=? name "version.texi"))
+		       (loop (append! (texi-lines-reversed
+				       (merge-pathnames name file))
+				      lines))
+		       (loop (cons line lines)))))
+		(else
+		 (loop (cons line lines)))))))))
+
 (define (plugin-texi-SCMVERS-lint file-name file-lines core-version-string)
-  ;; Too specific for general use.
+  ;; Needs the version number in the build-depends of debian/control!
   (let ((line (find file-lines
 		    (lambda (line)
 		      (string-prefix? "@set SCMVERS " line)))))