codegraph.lisp

;;;; codegraph.lisp — Build a Knowledge Graph from a live CL package

(in-package #:cl-codegraph)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (require :sb-introspect))

(defmacro define-constant (name value)
  `(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)))

;;; Predicates

(define-constant +type+ "rdf:type")
(define-constant +calls+ "cg:calls")
(define-constant +called-by+ "cg:calledBy")
(define-constant +subclass-of+ "cg:subclassOf")
(define-constant +has-slot+ "cg:hasSlot")
(define-constant +method-of+ "cg:methodOf")
(define-constant +specializes-on+ "cg:specializesOn")
(define-constant +exports+ "cg:exports")
(define-constant +in-package+ "cg:inPackage")
(define-constant +external+ "cg:external")
(define-constant +depends-on+ "cg:dependsOn")
(define-constant +lambda-list+ "cg:lambdaList")
(define-constant +docstring+ "cg:docstring")
(define-constant +source-file+ "cg:sourceFile")
(define-constant +expands-macro+ "cg:expandsMacro")
(define-constant +reads-var+ "cg:readsVar")
(define-constant +writes-var+ "cg:writesVar")
(define-constant +value+ "cg:value")
(define-constant +slot-of+ "cg:slotOf")

;;; Symbol classification

(defun classify-symbol (sym)
  "Return a keyword classifying SYM."
  (cond
    ((find-class sym nil) :class)
    ((and (fboundp sym)
          (typep (fdefinition sym) 'generic-function))
     :generic-function)
    ((macro-function sym) :macro)
    ((fboundp sym) :function)
    ((constantp sym) :constant)
    ((boundp sym) :special-variable)
    (t :other)))

;;; Node naming

(defun symbol-uri (sym)
  "Return a string URI for SYM. Uses :: for internal symbols, : for external."
  (let* ((pkg (symbol-package sym))
         (sep (if (eq (nth-value 1 (find-symbol (symbol-name sym) pkg)) :external)
                  ":" "::")))
    (format nil "~(~A~A~A~)" (package-name pkg) sep (symbol-name sym))))

;;; Graph building

(defun build-graph (package-designator &key graph-name include-external-calls include-internal)
  "Build and return an Ariadne graph representing the code structure of PACKAGE-DESIGNATOR."
  (let ((pkg (find-package package-designator)))
    (when (null pkg)
      (error "Package ~A not found" package-designator))
    (let* ((name (or graph-name (format nil "codegraph/~(~A~)" (package-name pkg))))
           (g (ariadne:make-graph :name name)))
      (index-package g pkg include-external-calls include-internal)
      g)))

(defun rebuild-graph (graph package-designator &key include-external-calls include-internal)
  "Clear GRAPH and rebuild it from PACKAGE-DESIGNATOR."
  (let ((pkg (find-package package-designator)))
    (when (null pkg)
      (error "Package ~A not found" package-designator))
    (ariadne:clear-graph graph)
    (index-package graph pkg include-external-calls include-internal)
    graph))

;;; Internal indexing

(defun index-package (graph pkg include-external-calls include-internal)
  "Walk symbols of PKG and add triples to GRAPH."
  (let ((pkg-uri (format nil "pkg:~(~A~)" (package-name pkg)))
        (exported-symbols '())
        (all-symbols '()))
    (do-external-symbols (sym pkg)
      (push sym exported-symbols))
    (if include-internal
        (do-symbols (sym pkg)
          (when (eq (symbol-package sym) pkg)
            (push sym all-symbols)))
        (setf all-symbols exported-symbols))
    ;; Index each symbol
    (dolist (sym all-symbols)
      (let ((uri (symbol-uri sym))
            (kind (classify-symbol sym))
            (externalp (member sym exported-symbols)))
        ;; Skip :other symbols unless exported (they're just interned names)
        (when (or (not (eq kind :other)) externalp)
          (ariadne:add-triple graph uri +type+ (string-downcase (symbol-name kind)))
          (ariadne:add-triple graph uri +in-package+ pkg-uri)
          (when externalp
            (ariadne:add-triple graph pkg-uri +exports+ uri))
          (when (and include-internal (not externalp))
            (ariadne:add-triple graph uri "cg:internal" "true"))
          (case kind
            (:class (index-class graph sym uri))
            (:generic-function (index-generic graph sym uri)))
          (index-metadata graph sym uri kind)
          (index-macro-var-deps graph sym uri kind all-symbols))))
    ;; Methods on foreign generics specialized on our classes
    (index-foreign-methods graph pkg pkg-uri all-symbols)
    ;; Call relationships
    (index-call-graph graph all-symbols pkg include-external-calls)
    ;; Accessor calls (inlined by SBCL, missed by find-function-callees)
    (index-accessor-calls graph all-symbols)
    ;; Init-form calls (defparameter/defconstant init-forms calling functions —
    ;; invisible to find-function-callees since there's no compiled function object)
    (index-init-form-calls graph all-symbols)))

(defun index-class (graph sym uri)
  "Add class hierarchy and slot triples for class named by SYM."
  (let ((class (find-class sym)))
    (dolist (super (sb-mop:class-direct-superclasses class))
      (let ((super-name (class-name super)))
        (unless (member super-name '(t standard-object))
          (ariadne:add-triple graph uri +subclass-of+ (symbol-uri super-name)))))
    (dolist (slot (sb-mop:class-direct-slots class))
      (let ((slot-name (sb-mop:slot-definition-name slot)))
        (ariadne:add-triple graph uri +has-slot+
                            (format nil "~A.~(~A~)" uri (symbol-name slot-name)))))))

(defun index-generic (graph sym uri)
  "Add method and specializer triples for generic function SYM."
  (let ((gf (fdefinition sym)))
    (dolist (method (sb-mop:generic-function-methods gf))
      (let* ((specializers (sb-mop:method-specializers method))
             (method-uri (format nil "~A/method~{/~(~A~)~}"
                                 uri
                                 (mapcar (lambda (s)
                                           (if (typep s 'sb-mop:eql-specializer)
                                               (format nil "eql-~A" (sb-mop:eql-specializer-object s))
                                               (symbol-name (class-name s))))
                                         specializers))))
        (ariadne:add-triple graph method-uri +method-of+ uri)
        (dolist (spec specializers)
          (when (typep spec 'class)
            (let ((spec-name (class-name spec)))
              (unless (eq spec-name t)
                (ariadne:add-triple graph method-uri +specializes-on+
                                    (symbol-uri spec-name))))))))))

(defun index-foreign-methods (graph pkg pkg-uri all-symbols)
  "Index methods on foreign generics that specialize on classes from PKG."
  (dolist (sym all-symbols)
    (when (find-class sym nil)
      (let ((class (find-class sym)))
        (dolist (method (sb-mop:specializer-direct-methods class))
          (let* ((gf (sb-mop:method-generic-function method))
                 (gf-name (sb-mop:generic-function-name gf)))
            (when (and (symbolp gf-name)
                       (not (eq (symbol-package gf-name) pkg)))
              (let* ((specializers (sb-mop:method-specializers method))
                     (gf-uri (symbol-uri gf-name))
                     (method-uri (format nil "~A/method~{/~(~A~)~}"
                                         gf-uri
                                         (mapcar (lambda (s)
                                                   (if (typep s 'sb-mop:eql-specializer)
                                                       (format nil "eql-~A" (sb-mop:eql-specializer-object s))
                                                       (symbol-name (class-name s))))
                                                 specializers))))
                (ariadne:add-triple graph method-uri +method-of+ gf-uri)
                (ariadne:add-triple graph method-uri +in-package+ pkg-uri)
                (ariadne:add-triple graph method-uri +type+ "method")
                (dolist (spec specializers)
                  (when (typep spec 'class)
                    (let ((spec-name (class-name spec)))
                      (unless (eq spec-name t)
                        (ariadne:add-triple graph method-uri +specializes-on+
                                            (symbol-uri spec-name))))))
                ;; Source file from method definition
                (handler-case
                    (let ((source (sb-introspect:find-definition-source method)))
                      (when (and source (sb-introspect:definition-source-pathname source))
                        (ariadne:add-triple graph method-uri +source-file+
                                            (make-literal (namestring
                                                           (sb-introspect:definition-source-pathname source))))))
                  (error () nil))))))))))

(defun make-literal (value)
  "Wrap VALUE as an RDF literal for storage in the graph."
  (ariadne:intern-literal value ariadne:+xsd-string+))

(defun index-metadata (graph sym uri kind)
  "Add lambda-list, docstring, and source-file triples for SYM."
  ;; Lambda list (for functions, generics, macros)
  (when (member kind '(:function :generic-function :macro))
    (let ((ll (ignore-errors (sb-introspect:function-lambda-list sym))))
      (when ll
        (ariadne:add-triple graph uri +lambda-list+
                            (make-literal (string-upcase (princ-to-string ll)))))))
  ;; Docstring
  (let ((doc (cond
               ((member kind '(:function :generic-function :macro))
                (documentation sym 'function))
               ((eq kind :class)
                (documentation (find-class sym) t))
               ((member kind '(:special-variable :constant))
                (documentation sym 'variable)))))
    (when doc
      (ariadne:add-triple graph uri +docstring+ (make-literal doc))))
  ;; Value (for constants and variables)
  (when (member kind '(:constant :special-variable))
    (when (boundp sym)
      (ariadne:add-triple graph uri +value+
                          (make-literal
                           (let ((*print-length* 10) (*print-level* 3))
                             (prin1-to-string (symbol-value sym)))))))
  ;; Source location
  (let* ((type (case kind
                 ((:function :generic-function) :function)
                 ;; sb-introspect has a dedicated :macro type; looking macros up
                 ;; as :function finds nothing, so macros got no cg:sourceFile.
                 (:macro :macro)
                 (:class :class)
                 (:special-variable :variable)
                 ;; defconstant is indexed by sb-introspect under :constant, NOT
                 ;; :variable — looking it up as :variable finds no source, so the
                 ;; node ends up with no cg:sourceFile and can't be assigned to a
                 ;; module downstream. Use the correct type.
                 (:constant :constant)))
         (sources (when type
                    (or (ignore-errors
                         (sb-introspect:find-definition-sources-by-name sym type))
                        ;; Conditions are classes but need :condition type for source lookup
                        (when (eq type :class)
                          (ignore-errors
                           (sb-introspect:find-definition-sources-by-name sym :condition)))))))
    (when (and sources (sb-introspect:definition-source-pathname (first sources)))
      (ariadne:add-triple graph uri +source-file+
                          (make-literal (namestring (sb-introspect:definition-source-pathname (first sources))))))))

(defun index-macro-var-deps (graph sym uri kind exported-symbols)
  "Add macro-expansion and variable read/write dependency triples."
  ;; who-macroexpands: for each exported macro, find which exported fns expand it
  (when (eq kind :macro)
    (dolist (entry (sb-introspect:who-macroexpands sym))
      (let ((user (car entry)))
        (when (and (symbolp user) (member user exported-symbols))
          (ariadne:add-triple graph (symbol-uri user) +expands-macro+ uri)))))
  ;; who-references / who-sets: for exported specials and constants, find readers/writers
  (when (member kind '(:special-variable :constant))
    (dolist (entry (sb-introspect:who-references sym))
      (let ((reader (car entry)))
        (when (and (symbolp reader) (member reader exported-symbols))
          (ariadne:add-triple graph (symbol-uri reader) +reads-var+ uri))))
    (dolist (entry (sb-introspect:who-sets sym))
      (let ((writer (car entry)))
        (when (and (symbolp writer) (member writer exported-symbols))
          (ariadne:add-triple graph (symbol-uri writer) +writes-var+ uri))))))

(defun function-name-of (fn)
  "Get the symbol name of a function object, or nil."
  (when (functionp fn)
    (nth-value 2 (function-lambda-expression fn))))

(defun index-call-graph (graph all-symbols pkg include-external-calls)
  "Add cg:calls and cg:calledBy triples using find-function-callees.
For generic functions, supplements with who-calls on exported symbols only (fast)."
  (let ((sym-set (make-hash-table :test 'eq))
        (pkg-uri (format nil "pkg:~(~A~)" (package-name pkg)))
        (dep-packages (make-hash-table :test 'equal))
        (exported '()))
    (dolist (sym all-symbols)
      (setf (gethash sym sym-set) t))
    (do-external-symbols (sym pkg)
      (push sym exported))
    ;; Forward pass: find-function-callees
    (dolist (caller all-symbols)
      (when (fboundp caller)
        (let ((caller-uri (symbol-uri caller)))
          (dolist (callee-fn (callees-of caller))
            (let ((callee-name (function-name-of callee-fn)))
              (when (and (symbolp callee-name) (symbol-package callee-name))
                (cond
                  ((gethash callee-name sym-set)
                   (unless (eq callee-name caller)
                     (let ((callee-uri (symbol-uri callee-name)))
                       (ariadne:add-triple graph caller-uri +calls+ callee-uri)
                       (ariadne:add-triple graph callee-uri +called-by+ caller-uri))))
                  ((and include-external-calls
                        (not (eq (symbol-package callee-name) (find-package :cl))))
                   (let ((callee-uri (symbol-uri callee-name))
                         (ext-pkg-uri (format nil "pkg:~(~A~)"
                                             (package-name (symbol-package callee-name)))))
                     (ariadne:add-triple graph caller-uri +calls+ callee-uri)
                     (ariadne:add-triple graph callee-uri +called-by+ caller-uri)
                     (ariadne:add-triple graph callee-uri +type+
                                         (string-downcase (symbol-name (classify-symbol callee-name))))
                     (ariadne:add-triple graph callee-uri +external+ "true")
                     (setf (gethash ext-pkg-uri dep-packages) t))))))))))
    (when include-external-calls
      (maphash (lambda (ext-pkg-uri _)
                 (declare (ignore _))
                 (ariadne:add-triple graph pkg-uri +depends-on+ ext-pkg-uri))
               dep-packages))
    ;; Per-method call edges for GFs
    (dolist (caller all-symbols)
      (when (and (fboundp caller) (typep (fdefinition caller) 'generic-function))
        (dolist (entry (method-callees-alist caller))
          (let ((method-uri (car entry)))
            (dolist (callee-fn (cdr entry))
              (let ((callee-name (function-name-of callee-fn)))
                (when (and (symbolp callee-name)
                           (symbol-package callee-name)
                           (gethash callee-name sym-set))
                  (ariadne:add-triple graph method-uri +calls+
                                      (symbol-uri callee-name)))))))))))

(defun build-accessor-table (all-symbols)
  "Build a hash table mapping accessor symbols to their struct/class owner symbol.
Computed once per package to avoid O(n²) scanning."
  (let ((table (make-hash-table :test 'eq)))
    ;; Struct accessors
    (dolist (sym all-symbols)
      (let ((dd (ignore-errors (sb-kernel:find-defstruct-description sym nil))))
        (when dd
          (dolist (slot (sb-kernel:dd-slots dd))
            (let* ((accessor-name (format nil "~A-~A"
                                          (sb-kernel:dd-name dd)
                                          (sb-kernel:dsd-name slot)))
                   (accessor-sym (find-symbol accessor-name (symbol-package sym))))
              (when accessor-sym
                (setf (gethash accessor-sym table) sym)))))))
    ;; CLOS slot readers
    (dolist (sym all-symbols)
      (when (find-class sym nil)
        (let ((class (find-class sym)))
          (dolist (slot (ignore-errors (sb-mop:class-direct-slots class)))
            (dolist (reader (sb-mop:slot-definition-readers slot))
              (setf (gethash reader table) sym))))))
    table))

(defun accessor-p (sym &optional accessor-table)
  "Return the struct/class name if SYM is a struct accessor or class slot reader, nil otherwise."
  (when (and (fboundp sym) accessor-table)
    (gethash sym accessor-table)))

(defun index-accessor-calls (graph all-symbols)
  "Use who-calls on accessor functions to find callers (inlined by SBCL).
Also adds cg:slotOf triples."
  (let ((sym-set (make-hash-table :test 'eq))
        (accessor-table (build-accessor-table all-symbols)))
    (dolist (sym all-symbols)
      (setf (gethash sym sym-set) t))
    (dolist (sym all-symbols)
      (let ((class-sym (accessor-p sym accessor-table)))
        (when class-sym
          ;; Add slotOf triple
          (ariadne:add-triple graph (symbol-uri sym) +slot-of+ (symbol-uri class-sym))
          ;; Use who-calls to find callers within the package
          (let ((uri (symbol-uri sym)))
            (dolist (entry (sb-introspect:who-calls sym))
              (let ((caller (car entry)))
                (when (and (symbolp caller)
                           (gethash caller sym-set)
                           (not (eq caller sym)))
                  (ariadne:add-triple graph (symbol-uri caller) +calls+ uri)
                  (ariadne:add-triple graph uri +called-by+ (symbol-uri caller)))))))))))

;;; Init-form call detection
;;;
;;; A defparameter/defvar/defconstant init-form is evaluated once at load/compile
;;; time and then discarded -- the symbol ends up boundp but never fboundp, so
;;; index-call-graph's forward pass (which requires a compiled function object via
;;; find-function-callees) never sees it. This pass reads the actual source form
;;; (via sb-introspect source location + read-all-forms, so in-package context is
;;; tracked correctly) and walks the init-form expression for symbols in call
;;; position, restricted to this package's symbol set.
;;;
;;; Scope (v1): package-local calls only. A call to a function in another package
;;; is intentionally not edged -- see README/CHANGELOG for the rationale and the
;;; follow-up note about include-external-calls parity.

(defun collect-call-symbols (form sym-set &optional acc)
  "Walk FORM, collecting symbols present in SYM-SET that appear in call position
(the car of a cons). Recurses into the whole form, not just the top call, so
nested calls inside progn/when/let/etc. are found too. Returns a list (may
contain duplicates; caller should remove-duplicates)."
  (cond
    ((and (consp form) (symbolp (car form)))
     (let ((acc (if (gethash (car form) sym-set) (cons (car form) acc) acc)))
       (dolist (sub (cdr form))
         (setf acc (collect-call-symbols sub sym-set acc)))
       acc))
    ((consp form)
     (dolist (sub form)
       (setf acc (collect-call-symbols sub sym-set acc)))
     acc)
    (t acc)))

(defun cached-file-forms (pathname cache)
  "Read and parse PATHNAME via read-all-forms, memoized in CACHE for the
duration of a single index-init-form-calls pass (avoids re-reading/re-parsing
the same file once per variable/constant it defines)."
  (multiple-value-bind (cached present) (gethash pathname cache)
    (if present
        cached
        (setf (gethash pathname cache)
              (ignore-errors
               (let ((source (with-open-file (f pathname)
                               (let ((s (make-string (file-length f))))
                                 (read-sequence s f)
                                 s))))
                 (read-all-forms source)))))))

(defun init-form-of (sym kind cache)
  "Return the init-form expression for a defparameter/defvar/defconstant SYM,
or nil if source is unavailable (REPL-defined, no debug info, unreadable file,
etc.) CACHE is a hash-table of pathname -> parsed forms, shared across calls
within one indexing pass."
  (let* ((type (case kind (:constant :constant) (:special-variable :variable)))
         (sources (when type
                    (ignore-errors (sb-introspect:find-definition-sources-by-name sym type))))
         (src (first sources))
         (pathname (when src (sb-introspect:definition-source-pathname src)))
         (form-path (when src (sb-introspect:definition-source-form-path src))))
    (when (and pathname form-path)
      (let ((forms (cached-file-forms pathname cache)))
        (let ((top-form (ignore-errors (nth (first form-path) forms))))
          (when (and (consp top-form)
                     (member (car top-form) '(defparameter defvar defconstant)))
            (third top-form)))))))

(defun index-init-form-calls (graph all-symbols)
  "Add cg:calls/cg:calledBy edges from special-variable/constant init-forms to
the package-local functions they call. Best-effort: symbols without
file-backed source are silently skipped."
  (let ((sym-set (make-hash-table :test 'eq))
        (cache (make-hash-table :test 'equal)))
    (dolist (sym all-symbols)
      (setf (gethash sym sym-set) t))
    (dolist (sym all-symbols)
      (let ((kind (classify-symbol sym)))
        (when (member kind '(:special-variable :constant))
          (let ((init-form (ignore-errors (init-form-of sym kind cache))))
            (when init-form
              (let ((callees (remove-duplicates
                              (collect-call-symbols init-form sym-set)
                              :test #'eq))
                    (var-uri (symbol-uri sym)))
                (dolist (callee callees)
                  (unless (eq callee sym)
                    (let ((callee-uri (symbol-uri callee)))
                      (ariadne:add-triple graph var-uri +calls+ callee-uri)
                      (ariadne:add-triple graph callee-uri +called-by+ var-uri))))))))))))

(defun callees-of (sym)
  "Return all function objects called by SYM. For GFs, walks method fast-functions."
  (let ((fns '())
        (def (fdefinition sym)))
    (dolist (f (ignore-errors (sb-introspect:find-function-callees def)))
      (push f fns))
    (when (typep def 'generic-function)
      (let ((fast-fn-accessor (find-symbol "SAFE-METHOD-FAST-FUNCTION" :sb-pcl)))
        (when (and fast-fn-accessor (fboundp fast-fn-accessor))
          (dolist (method (sb-mop:generic-function-methods def))
            (let ((fast (ignore-errors (funcall fast-fn-accessor method))))
              (when fast
                (dolist (f (ignore-errors (sb-introspect:find-function-callees fast)))
                  (push f fns))))))))
    fns))

(defun method-callees-alist (sym)
  "For a GF SYM, return alist of (method-uri . (callee-fn ...)) per method.
Returns nil for non-GFs."
  (let ((def (fdefinition sym)))
    (when (typep def 'generic-function)
      (let ((fast-fn-accessor (find-symbol "SAFE-METHOD-FAST-FUNCTION" :sb-pcl))
            (result '()))
        (when (and fast-fn-accessor (fboundp fast-fn-accessor))
          (dolist (method (sb-mop:generic-function-methods def))
            (let* ((specializers (sb-mop:method-specializers method))
                   (method-uri (format nil "~A/method~{/~(~A~)~}"
                                       (symbol-uri sym)
                                       (mapcar (lambda (s)
                                                 (if (typep s 'sb-mop:eql-specializer)
                                                     (format nil "eql-~A" (sb-mop:eql-specializer-object s))
                                                     (symbol-name (class-name s))))
                                               specializers)))
                   (fast (ignore-errors (funcall fast-fn-accessor method)))
                   (callees (when fast
                              (ignore-errors (sb-introspect:find-function-callees fast)))))
              (when callees
                (push (cons method-uri callees) result)))))
        result))))

;;; Multi-package

(defun build-multi-graph (package-designators &key graph-name include-internal)
  "Build a unified graph spanning multiple packages. Cross-package calls between
the listed packages are automatically captured."
  (let* ((name (or graph-name (format nil "codegraph/multi")))
         (g (ariadne:make-graph :name name))
         (all-syms '())
         (sym-set (make-hash-table :test 'eq)))
    ;; Collect all symbols from all packages
    (dolist (pd package-designators)
      (let ((pkg (find-package pd)))
        (when pkg
          (if include-internal
              (do-symbols (sym pkg)
                (when (eq (symbol-package sym) pkg)
                  (push sym all-syms)
                  (setf (gethash sym sym-set) t)))
              (do-external-symbols (sym pkg)
                (push sym all-syms)
                (setf (gethash sym sym-set) t))))))
    ;; Index each package's symbols
    (dolist (pd package-designators)
      (let ((pkg (find-package pd)))
        (when pkg
          (let ((pkg-uri (format nil "pkg:~(~A~)" (package-name pkg))))
            (dolist (sym all-syms)
              (when (eq (symbol-package sym) pkg)
                (let ((uri (symbol-uri sym))
                      (kind (classify-symbol sym))
                      (externalp (eq (nth-value 1 (find-symbol (symbol-name sym) pkg)) :external)))
                  (when (or (not (eq kind :other)) externalp)
                    (ariadne:add-triple g uri +type+ (string-downcase (symbol-name kind)))
                    (ariadne:add-triple g uri +in-package+ pkg-uri)
                    (when externalp
                      (ariadne:add-triple g pkg-uri +exports+ uri))
                    (when (and include-internal (not externalp))
                      (ariadne:add-triple g uri "cg:internal" "true"))
                    (case kind
                      (:class (index-class g sym uri))
                      (:generic-function (index-generic g sym uri)))
                    (index-metadata g sym uri kind)
                    (index-macro-var-deps g sym uri kind all-syms)))))))))
    ;; Call graph across all symbols
    (index-call-graph g all-syms (find-package (first package-designators)) nil)
    g))

(defun build-system-graph (system-designator &key include-internal)
  "Build a graph for an ASDF system. Finds the primary package by system name."
  (asdf:load-system system-designator)
  (let* ((sys-name (string-downcase (string system-designator)))
         (pkg (find-package (string-upcase sys-name))))
    (if pkg
        (build-graph (make-symbol (package-name pkg))
                     :graph-name (format nil "codegraph/system/~A" sys-name)
                     :include-internal include-internal)
        (error "Could not find package for system ~A" system-designator))))