Last active
July 16, 2020 09:05
-
-
Save phmarek/119b2e8051109b308c99842134e4f9c8 to your computer and use it in GitHub Desktop.
Replacement for "sloccount", to count forms in a(n ASDF) system
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#+cl-ppcre | |
(defun :form-count-for-asdf (system &key file-regex per-file) | |
(let ((files 0) | |
(per-file-alist ()) | |
(top-forms 0) | |
(forms 0) | |
;(more-data nil) | |
(system (or (asdf:find-system system) | |
(error "~s not found" system)))) | |
(labels ((rec (f) | |
(cond | |
((null f) 0) | |
((atom f) 0) | |
((consp f) | |
;; Can't use REDUCE for quoted things, they might include | |
;; dotted lists (alists) | |
;; Also ITER has (FOR (A . B) ON ...) | |
;; So: quoted things => only 1 form. | |
(1+ | |
(or | |
(if (not (or (eq (first f) 'quote) | |
(eq (first f) 'sb-int:quasiquote))) | |
(loop for x on (cdr f) | |
while (consp x) | |
sum (rec (car x)))) | |
0))) | |
(t 0))) | |
(asdf-children (x) | |
(dolist (child (asdf:component-children x)) | |
(cond | |
((typep child 'asdf:source-file) | |
(let ((fn (slot-value child 'asdf::absolute-pathname))) | |
(if (or (not file-regex) | |
(cl-ppcre:scan file-regex (uiop:native-namestring fn))) | |
(with-open-file (f fn) | |
(incf files) | |
(let ((*package* (find-package :cl-user)) | |
(file-t-forms 0) | |
(file-forms 0)) | |
(loop for form = (read f nil nil) | |
while form | |
;; (eval form) ; we assume that the system was already correctly loaded, | |
;; so there are no readtables or other stuff we might need to evaluate | |
when (eq (first form) 'cl:in-package) | |
do (setf *package* (find-package (second form))) | |
do (let ((f-c (rec form))) | |
(incf file-t-forms) | |
(incf file-forms f-c))) | |
(when per-file | |
(push (list (enough-namestring fn | |
(asdf:system-source-directory system)) | |
:top-forms file-t-forms | |
:forms file-forms) | |
per-file-alist)) | |
(incf top-forms file-t-forms) | |
(incf forms file-forms)))))) | |
((typep child 'asdf:parent-component) | |
(asdf-children child)))))) | |
(asdf-children system)) | |
(list* :files files | |
:top-forms top-forms | |
:forms forms | |
(when per-file | |
`(:per-file ,per-file-alist))))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment