From b9eddc86452f2908f37ea6e9b66c04dc5dac373c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Thu, 7 Sep 2023 15:35:12 +0200 Subject: Add new script to find undocumented symbols. --- module/scripts/find-undocumented.scm | 146 +++++++++++++++++++++++++++++++++++ 1 file changed, 146 insertions(+) create mode 100644 module/scripts/find-undocumented.scm (limited to 'module/scripts/find-undocumented.scm') diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm new file mode 100644 index 00000000..127baa74 --- /dev/null +++ b/module/scripts/find-undocumented.scm @@ -0,0 +1,146 @@ +(define-module (scripts find-undocumented) + :use-module (srfi srfi-1) + :use-module (hnh module-introspection all-modules) + :use-module (hnh util) + :use-module (hnh util path) + :use-module (ice-9 format) + :use-module (ice-9 regex) + :use-module (ice-9 rdelim) + :use-module (rnrs records syntactic) + :export (main) + ) + +(define %summary "Find all uncodumented exported declaration in a project.") + +(define %synopsis "find-undocumented ") + +;; (define %help "") + +(define texinfo-definition-forms + '(("deffn" _ name ...) + ("deftp" _ name ...) + ("defun" name ...) + ("defmac" name ...) + ("defspec" name ...) + ("deftypefn" _ _ name ...) + ("deftypefun" _ name ...) + ("defvr" _ name) + ("defvar" name) + ("defopt" name) + ("deftypevr" _ _ name) + ("deftypevar" _ name) + ("deftp" _ name ...) + ("defcv" _ _ name) + ("deftypecv" _ _ name) + ("defivar" _ name) + ("deftypeivar" _ _ name) + ("defop" _ _ name ...) + ("deftypeop" _ _ _ name ...) + ("defmethod" _ name ...) + ("deftypemethod" _ _ name ...))) + +(define (command cmd) (format #f "@ *(~a)x?" cmd)) +(define parameter "(\\{(@\\}|[^}])+\\}|[^ \t]+)") +(define rest ".*") +(define regexpes + (for form in texinfo-definition-forms + (list + form + (string-concatenate + (intersperse + "[ \t]*" + (for (idx symbol) in (enumerate form) + (cond ((string? symbol) (command symbol)) + ((eq? '_ symbol) parameter) + ((eq? '... symbol) rest) + ((symbol? symbol) parameter) + (else (scm-error 'misc-error "" "" '() #f))))))))) + +(define rxs + (for (name rx) in regexpes + (list name + (make-regexp + (format #f "^ *~a" rx) + regexp/newline)))) + + +(define-record-type doc-definition + (fields symbol type file line)) + +(define (cmp a b) + (eq? + (doc-definition-symbol a) + (doc-definition-symbol b))) + +(define (print-header msg) + (define middle (format #f "= ~a =" msg)) + (define side (make-string (string-length middle) #\=)) + (format #t "~a~%~a~%~a~%" side middle side)) + +(define (print-doc-definition def) + (display (symbol->string (doc-definition-symbol def))) + (cond ((doc-definition-file def) + => (lambda (it) + (display "\t(") + (display it) + (cond ((doc-definition-line def) + => (lambda (it) + (display " ") + (display it)))) + (display ")")))) + (newline)) + +(define (main . args) + (define source-directory "module") + (define doc-dir "doc/ref") + + (define documented-symbols + (concatenate + (for file in (all-files-under-directory doc-dir ".texi") + (let ((content (call-with-input-file file read-string))) + (concatenate + (for (form rx) in rxs + (for m in (list-matches rx content) + (make-doc-definition + (-> m + (match:substring + ;; Weird offsets to account for how matching groups work + (* 2 (1+ (list-index (lambda (x) (eqv? x 'name)) + (cdr form))))) + (string-trim-both (string->char-set "{}")) + string->symbol) + (string->symbol (match:substring m 1)) + file + (1+ (string-count (match:prefix m) (char-set #\newline))) + )))))))) + + (define defined-symbols + (concatenate + (for path in (all-modules-under-directory source-directory) + (define components* (drop (path-split path) (length (path-split source-directory)))) + (define name + (map string->symbol + (append (drop-right components* 1) + (list (basename (last components*) ".scm"))))) + (catch 'misc-error + (lambda () + (cond ((resolve-interface name) + => (lambda (module) (map (lambda (symb) (make-doc-definition symb #f path #f)) + (module-map (lambda (k v) k) module)))) + (else + (format (current-error-port) "~s is not a module~%" name) + '()))) + (lambda (err proc fmt args data) + (format (current-error-port) "Failed loading ~s: (~a) ~?~%" name proc fmt args) + '()))))) + + + (print-header "Documented functions without (or with private) definitions:") + (for-each print-doc-definition (lset-difference cmp documented-symbols defined-symbols)) + (newline) + + (print-header "Defined symbols without documentation:") + (for-each print-doc-definition (lset-difference cmp defined-symbols documented-symbols)) + + (newline) + ) -- cgit v1.2.3 From d098e1d2cb679516797fe3a9dee097cb6979cadd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Sep 2023 17:10:32 +0200 Subject: Document how find-undocumented's pattern builder work. --- module/scripts/find-undocumented.scm | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'module/scripts/find-undocumented.scm') diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm index 127baa74..01dde818 100644 --- a/module/scripts/find-undocumented.scm +++ b/module/scripts/find-undocumented.scm @@ -16,6 +16,15 @@ ;; (define %help "") +;;; All texinfo forms we want to capture. +;;; For each of these, the following grammar holds: +;;; - The first element should be a string of the texinfo tag to match +;;; - The following arguments are +;;; - Any number of `_`, meaning an argument we don't care about +;;; - a single instance of the symbol `name`, which indicates where the name of +;;; the definition is stored. +;;; - An optional final argument `...`, which indicates that more may argumnets +;;; may follow. (define texinfo-definition-forms '(("deffn" _ name ...) ("deftp" _ name ...) -- cgit v1.2.3 From 8560d5d0045cc5d6d28dcce1bc3e51bf89e5e979 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Sun, 10 Sep 2023 17:10:50 +0200 Subject: Allow find-undocumented to skip files. --- module/scripts/find-undocumented.scm | 5 +++++ 1 file changed, 5 insertions(+) (limited to 'module/scripts/find-undocumented.scm') diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm index 01dde818..8c321fc2 100644 --- a/module/scripts/find-undocumented.scm +++ b/module/scripts/find-undocumented.scm @@ -102,6 +102,9 @@ (define (main . args) (define source-directory "module") (define doc-dir "doc/ref") + (define skip-files + '("module/graphvis.scm" + "module/glob.scm")) (define documented-symbols (concatenate @@ -126,6 +129,8 @@ (define defined-symbols (concatenate (for path in (all-modules-under-directory source-directory) + (when (member path skip-files) + (continue)) (define components* (drop (path-split path) (length (path-split source-directory)))) (define name (map string->symbol -- cgit v1.2.3 From d026448edced5b71313629b9feaa9c38134e58e7 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 11 Sep 2023 22:36:30 +0200 Subject: Fix bug causing for's continue to not work. --- module/scripts/find-undocumented.scm | 2 -- 1 file changed, 2 deletions(-) (limited to 'module/scripts/find-undocumented.scm') diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm index 8c321fc2..499f18d6 100644 --- a/module/scripts/find-undocumented.scm +++ b/module/scripts/find-undocumented.scm @@ -130,8 +130,6 @@ (concatenate (for path in (all-modules-under-directory source-directory) (when (member path skip-files) - (continue)) - (define components* (drop (path-split path) (length (path-split source-directory)))) (define name (map string->symbol (append (drop-right components* 1) -- cgit v1.2.3 From 475307bc9926898e769c7ad6fa3a844853b07f52 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Tue, 12 Sep 2023 10:04:04 +0200 Subject: Add a bunch of documentation. --- module/scripts/find-undocumented.scm | 23 +++++++++++++++++++++-- 1 file changed, 21 insertions(+), 2 deletions(-) (limited to 'module/scripts/find-undocumented.scm') diff --git a/module/scripts/find-undocumented.scm b/module/scripts/find-undocumented.scm index 499f18d6..5aebcb25 100644 --- a/module/scripts/find-undocumented.scm +++ b/module/scripts/find-undocumented.scm @@ -7,6 +7,7 @@ :use-module (ice-9 regex) :use-module (ice-9 rdelim) :use-module (rnrs records syntactic) + :use-module (glob) :export (main) ) @@ -103,8 +104,20 @@ (define source-directory "module") (define doc-dir "doc/ref") (define skip-files - '("module/graphvis.scm" - "module/glob.scm")) + (append + '( + ;; Ignored since we arent't the implementor. + ;; It could however be nice to document it + "module/graphviz.scm" + ) + ;; Each entry-point should only export a main procedure, + ;; and is documented elsewhere + (glob "module/calp/entry-points/*.scm") + ;; These are scripts for `guild`. + ;; Each file exports a few pre-defined symbols, + ;; and are documented in other ways. + (glob "module/scripts/*.scm") + )) (define documented-symbols (concatenate @@ -130,6 +143,12 @@ (concatenate (for path in (all-modules-under-directory source-directory) (when (member path skip-files) + (continue '())) + + (define components* + (drop (path-split path) + (length (path-split source-directory)))) + (define name (map string->symbol (append (drop-right components* 1) -- cgit v1.2.3