From a25191dbcc8c4bfb377ec816f1b0c4151a98d12a Mon Sep 17 00:00:00 2001 From: Kaz Kylheku Date: Sun, 5 Apr 2020 10:19:08 -0700 Subject: tags: follow loads and define needed packages. * tags.tl (*fake-load-path*): New special variable. (process-package-influencing-form, fake-load): New functions. (process-form): Pass each compound form to process-package-influencing-form in case it might be a defpackage or load. (collect-tags-tl): Bind *fake-load-path* to the file's path so fake-load will resolve relative paths relative to the file's own directory, similarly to how load works with *load-path*. --- tags.tl | 25 ++++++++++++++++++++++++- 1 file changed, 24 insertions(+), 1 deletion(-) diff --git a/tags.tl b/tags.tl index 785aa38d..720a60a8 100755 --- a/tags.tl +++ b/tags.tl @@ -58,6 +58,8 @@ (defvarl err-ret (gensym)) +(defvar *fake-load-path*) + (defun get-pat (lines form) (tree-case (source-loc form) ((line . file) (escape [lines line])))) @@ -84,10 +86,30 @@ ,*(if pattern-obj ^(expattern t))))) ,*body)) +(defun process-package-influencing-form (form) + (caseq (car form) + (load (fake-load (cadr form))) + (load-for (each ((clause (cdr form))) + (fake-load (caddr clause)))) + (defpackage (make-package (symbol-name (cadr form)))))) + +(defun fake-load (path) + (unless (abs-path-p path) + (set path (path-cat (dir-name *fake-load-path*) path)) + (let ((*fake-load-path* path) + (stream (if (ends-with ".tl" path) + (open-file path) + (or (ignerr (open-file `@path.tl`)))))) + (whilet ((obj (read stream *stderr* err-ret path)) + ((neq obj err-ret))) + (when (consp obj) + (process-package-influencing-form obj)))))) + (defun process-form (path lines obj) (build (with-tag-shorthand-macro (ntag path lines obj) (when (consp obj) + (process-package-influencing-form obj) (caseq (car obj) ((progn eval-only compile-only with-dyn-lib) [mapdo (op process-form path lines) (cdr obj)]) @@ -162,7 +184,8 @@ (text (if (starts-with "#!" text) `;@text` text)) (lines (cons "" (spl #\newline text))) (stream (make-string-byte-input-stream text)) - (*rec-source-loc* t)) + (*rec-source-loc* t) + (*fake-load-path* path)) (build (add (new file-tag path path)) -- cgit v1.2.3