Replacement for "sloccount", to count forms in a(n ASDF) system

form-count-via-asdf.lisp

#+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)))))