4
\$\begingroup\$

This is a rewrite of the Dependencies program submitted previously at https://codereview.stackexchange.com/questions/255635/detecting-dependencies-in-common-lisp-project-files/256336?noredirect=1#comment506766_256336 that incorporates the many insightful changes recommended there.

I'm requesting another review to check that the changes are implemented correctly, and to see if they raise other issues.

To quickly recap, the program creates a dependency graph for the symbols in a project's files, and tracks down inter-file dependencies and cycles.

UPDATED USER INTERFACE FUNCTIONS

get-all-dependencies (&key (pathspec #P"*.lisp") (stream *standard-output*)
                           (print nil))
"Returns (or prints) all inter-file dependencies and codependencies."


file1-depends-on-file2 (file1 file2 &key (stream *standard-output*)
                                         (print nil))
"Returns (or prints) all of the symbols in file1 that depend on definitions in file2."


file-depends-on-what (file1 &key (pathspec #P"*.lisp")
                                 (stream *standard-output*) (print nil))
"Returns (or prints), for a given file1, all of the files and definitions it depends on."

For example, (dep:get-all-dependencies :print t) is the simplest way to get everything at once in a user-friendly format. Assumes *default-pathname-defaults* has been set to the project directory. The keyword :print determines if the output is in data structure format or user-friendly format.

ASDF DEFINITION FILE

;;; Filename: dependencies.asd

(defsystem "dependencies"
  :description "dependencies: A Common Lisp system for detecting dependencies
                between a project's files."
  :version "1.1"
  :author "David Brown <[email protected]>"
  :licence "Public Domain"
  :depends-on ("alexandria" "cl-ppcre")
  :components ((:file "dependencies")))

COMMENTS

The program requires cl-ppcre simply to pre-process a project's files. The function purify-file removes quoted expressions, so they will not interfere with the lisp reader subsequently reading a file's forms into a big string. A previous suggestion was to reconfigure the lisp reader to obviate the problem. The cl-ppcre package and pre-processing then could be eliminated. But I can't figure out how to do this. Setting *read-suppress* seems promising--any further guidance is welcome.

Detecting the appropriate symbols associated with defstruct definitions is more complicated than for the other kinds of definitions covered (namely, defun, defmacro, defparameter, defvar, defmethod). And defclass is not covered at all. The accessor function names for a defstruct can be altered by the :nconc-name option, but the program assumes the standard hyphenation for project files. (ps: If someone wanted to include class definitions and accessors, would closer-mop be the best way to go?)

The basic format for a dependency used throughout the program is a list of three items (file1 file2 dependents), which means file1 depends on file2, and dependents is a list of the symbols in file1 that depend on definitions in file2. Filenames are stored as strings--eg, "my-file.lisp". The format for codependencies is a list which contains sublists of files that depend on each other--ie, contain cycles of dependency.

The dependency graph is searched using the recursive backtrack algorithm in backtrack-search. The original brute-force search broke down when tested on a large project of 47 substantial lisp files. The revised algorithm does not repeat searching from a node that was previously searched.

I have often used alexandria:flatten on code trees, before working on them with the sequence functions. But, as previously pointed out, it can involve a lot of consing. I'm wondering if it's generally better to search the tree directly to process the items of interest, assuming walking the tree is as efficient as alexandria. I found an interesting way to do this at https://lisptips.com/post/43404489000/the-tree-walkers-of-cl:

(defun walk-tree-atoms (fun tree)
  (tree-equal tree tree
              :test (lambda (element-1 element-2)
                      (declare (ignore element-2))
                      (funcall fun element-1)
                      t)))

Is this a better approach than alexandria:flatten? Thanks for your time.

PROGRAM FILE

;;; Filename:  dependencies.lisp

; Finds the dependencies among files (ie, inter-file references) in a Common
; Lisp project directory. Assumes the project files have already been loaded,
; and that *default-pathname-defaults* points to the project directory.


(defpackage :dependencies
  (:use :cl :alexandria :cl-ppcre)
  (:nicknames :dep)
  (:export #:file1-depends-on-file2 #:file-depends-on-what
           #:get-all-dependencies))


(in-package :dep)


; Function Specs
(declaim
  (ftype (function (string) (values t t))  ;ideal: (values string boolean)
         purify-file)
  (ftype (function (list) list)
         collect-symbols)
  (ftype (function (t) list)
         collect-defs)
  (ftype (function (t) list)
         collect-defstructs)
  (ftype (function (list) list)
         delete-duplicate-cycles)
  (ftype (function (string) list)
         pseudo-load)
  (ftype (function (string string &key (:stream stream) (:print t))
                   list)
         file1-depends-on-file2)
  (ftype (function (string &key (:pathspec pathname) (:stream stream)
                                (:print t))
                   list)
         file-depends-on-what)
  (ftype (function (list hash-table hash-table) list)
         backtrack-search)
  (ftype (function (list list) list)
         search-for-codependents)
  (ftype (function (list) list)
         get-codependencies)
  (ftype (function (&key (:pathspec pathname) (:stream stream) (:print t))
                   (values list list))
         get-all-dependencies))


(defmacro prt (&rest vars)
  "For debugging: Print the names & values of given variables or accessors.
   Can also wrap around an expression, returning its value."
  `(progn ,@(loop for var in vars
              collect `(format t "~&  ~S => ~S~%" ',var ,var))
          ,@(last `,vars)))


(defun purify-file (file)
  "Transforms problematic symbols to benign NIL in file, before reading.
   Returns a string of altered file content."
  (let ((file-string (alexandria:read-file-into-string file))
        (modified-file-string ""))
    (setf modified-file-string 
      (ppcre:regex-replace-all
        "[ \t\r\n]'[A-Za-z0-9!@$%&*_+:=<.>/?-]+"
        file-string " NIL"))
    (ppcre:regex-replace-all
      "[(][qQ][uU][oO][tT][eE][ \t\r\n]+[A-Za-z0-9!@$%&*_+:=<.>/?-]+[)]"
      modified-file-string "NIL")))


(defun collect-symbols (form)
  "Collects all of the unique symbols in a form."
  (let ((all-items (alexandria:flatten form)))
    (delete-if (lambda (item)
                 (or (not (symbolp item))
                     (find-symbol (symbol-name item) :cl)))
               (delete-duplicates all-items))))


(defun collect-defs (forms)
  "Collects all of the defined names in forms, excluding defstructs."
  (loop for form in forms
    when (and (consp form)
              (member (first form)
                      '(defun defmacro defparameter defvar defmethod)))
      collect (second form)))


(defun collect-defstructs (forms)
  "Collects all of the defined defstruct names in forms."
  (loop for form in forms
    when (and (consp form)
              (member (first form) 
                      '(defstruct)))
      if (symbolp (second form))
        collect (second form)
        else if (listp (second form))
               collect (first (second form))))


(defun collect-struct-fns (defstruct-syms all-syms)
  "Collects all of the structure access function names in all-syms
   that are associated with the structure names in defstruct-syms."
  (delete-if #'null
    (alexandria:map-product
      (lambda (defstruct-sym sym)
        (when (and (not (eql defstruct-sym sym))
                   ;only std :conc-name structure prefix
                   ;with hyphen recognized
                   (search (format NIL "~S-" defstruct-sym)
                           (format NIL "~S" sym)))
          sym))
      defstruct-syms all-syms)))


(defun delete-duplicate-cycles (cycles)
  "Deletes any duplicate dependency cycles found during search."
  (delete-duplicates cycles
    :test (lambda (cyc1 cyc2)
            (alexandria:set-equal cyc1 cyc2 :test #'equal))))


(defun pseudo-load (file)
  "Attempt to read a file doing what LOAD would do. May not always do
   the right thing. Returns list of all forms, including package prefixes.
   Based on a function provided by tfb on Stack Overflow."
  (let ((file-string (purify-file file))
        (*package* *package*))
    (with-input-from-string (in-stream file-string)
      (loop for form = (read in-stream NIL in-stream)
        while (not (eql form in-stream))
        when (and (consp form)
                  (eql (first form) 'in-package))
          do (let ((file-pkg (find-package (second form))))
               (if file-pkg
                 (setf *package* file-pkg)
                 (error "~%Unknown package name: ~A in file: ~A
                         ~&Make sure project files are loaded.~%"
                        (second form) file)))
          collect form))))


(defun file1-depends-on-file2 (file1 file2 &key (stream *standard-output*)
                                                (print nil))
  "Returns or prints those symbols in file1 that are defined in file2."
  (let* ((forms1 (pseudo-load file1))
         (all-syms1 (collect-symbols forms1))
         (def-syms1 (collect-defs forms1))  ;eg, (defun sym ...
         (defstruct-syms1 (collect-defstructs forms1))  ;eg, (defstruct sym ...
         (struct-fns1 (collect-struct-fns defstruct-syms1  ;eg, (sym-slot ...
                                          all-syms1))
         (active-syms1 (set-difference all-syms1 
                                       (append def-syms1 defstruct-syms1
                                               struct-fns1)))
         (forms2 (pseudo-load file2))
         (def-syms2 (collect-defs forms2))
         (defstruct-syms2 (collect-defstructs forms2))
         (all-defs2 (append def-syms2 defstruct-syms2))
         ;collect dependent structure fn names in active-sims1
         ;for structures defined in forms2
         (dep-struct-fns1 (collect-struct-fns defstruct-syms2 active-syms1)))
    (let ((dependent-symbols 
            (append (set-difference (intersection active-syms1 all-defs2)
                                    defstruct-syms2)
                    dep-struct-fns1)))
      (if print
        (format stream "~%~S symbols dependent on ~S definitions:~%~S~2%"
                       file1 file2 dependent-symbols)
        (when dependent-symbols
          (list file1 file2 dependent-symbols))))))


(defun file-depends-on-what (file1 &key (pathspec #P"*.lisp")
                                        (stream *standard-output*) (print nil))
  "Returns a list of, or prints, all dependencies of a file
   in directory = *default-pathname-defaults*."
  (loop with files = (mapcar #'file-namestring (directory pathspec))
    for file2 in files
    unless (equal file1 file2)
      collect (file1-depends-on-file2 file1 file2 :stream stream)
             into dependencies
    finally (let ((actual-dependencies (delete-if #'null dependencies)))
              (if print
                (dolist (dep actual-dependencies)
                  (format stream 
                          "~%~S symbols dependent on ~S definitions:~%~S~2%"
                          (first dep) (second dep) (third dep)))
                (return actual-dependencies)))))


(defun backtrack-search (current-path adjacency-table visited)
  "Recursively follow dependency paths from all file nodes, detecting cycles."
  (let* ((node (first current-path))
         (cycle (member node (reverse (cdr current-path)) :test #'equal)))
    (if cycle
      (progn (setf (gethash node visited) T)
             (list cycle))
      (let ((children (gethash node adjacency-table)))
        (if children
          (loop for child in children
            unless (gethash child visited)
            nconc (backtrack-search (cons child current-path)
                                    adjacency-table visited)
            finally (setf (gethash node visited) T))
          (not (setf (gethash node visited) T)))))))


(defun search-for-codependents (node-list dependencies)
  "Detects & returns all dependent cycles for all nodes
   in a dependency network."
  (let* ((node-count (length node-list))
         (adjacency-table (make-hash-table :test #'equal :size node-count))
         (visited (make-hash-table :test #'equal :size node-count)))
    (loop for (file1 file2 *) in dependencies
      do (push file2 (gethash file1 adjacency-table)))
    (loop for node in node-list
      do (clrhash visited)
      nconc (backtrack-search (list node) adjacency-table visited)
            into all-cycles
      finally (return (delete-duplicate-cycles all-cycles)))))


(defun get-codependencies (dependencies)
  "Returns all codependencies among a group of inter-dependent files."
  (let ((file-list (delete-duplicates 
                     (loop for (file1 file2 *) in dependencies
                       collect file1 collect file2)
                     :test #'equal)))
    (search-for-codependents file-list dependencies)))


(defun get-all-dependencies (&key (pathspec #P"*.lisp")
                                  (stream *standard-output*) (print nil))
  "Returns or prints dependencies and codependencies of every pathspec file in 
   directory = *default-pathname-defaults*."
  (let* ((files (mapcar #'file-namestring (directory pathspec)))
         (dependencies (delete-if #'null
                         (alexandria:map-product
                           (lambda (file1 file2)
                             (unless (equal file1 file2)
                               (file1-depends-on-file2 file1 file2)))
                           files files)))
         (codependencies (get-codependencies dependencies)))
    (cond (print
            (dolist (dep dependencies)
              (format stream "~%~S symbols dependent on ~S definitions:~%~S~%"
                             (first dep) (second dep) (third dep)))
            (format stream "~2%Codependent files (with circular references):~%")
            (dolist (codep codependencies)
             (format stream "~S~%" codep)))
          (t (values dependencies codependencies)))))
\$\endgroup\$

0

This site is temporarily in read-only mode and not accepting new answers.

Browse other questions tagged .