changeset 663: | cc89b337384b |
parent: | e6c6713c17ff |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Sat, 21 Sep 2024 22:58:22 -0400 |
permissions: | -rw-r--r-- |
description: | skel upgrades, added skel/net |
478 | 1 | ;;; lib/skel/comp/asd.lisp --- ASDF Components |
162 | 2 | |
3 | ;; ASDF/PARSE-DEFSYSTEM may come in handy for testing. |
|
4 | ||
468 | 5 | ;; The problem with ASD files is that they're read-only afaik - eg there's no |
6 | ;; 'write' methods implemented on ASD:SYSTEM objects. This makes it a bit |
|
7 | ;; tedious because we obviously want to transform SK-LISP-SYSTEM objects |
|
8 | ;; directly to SYSTEM, but also need to be able to write them out as discrete |
|
9 | ;; files for portability. Probably will end up violating all that is DRY and |
|
10 | ;; holy. |
|
162 | 11 | |
12 | ;;; Code: |
|
384 | 13 | (in-package :skel/comp/asd) |
18 | 14 | |
663
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
15 | (defclass sk-lisp-system (sk-mod asdf:system) |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
16 | ;; these slots are inferred in ASDF:SYSTEM. Since we are primarily concerned |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
17 | ;; with generating ASDF:SYSTEM definitions rather than parsing them we restore them here. |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
18 | ((serial :initform nil :type boolean :accessor sk-lisp-system-serial) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
19 | (perform :initform nil :type list :accessor sk-lisp-system-perform))) |
468 | 20 | |
21 | (defun read-system-definitions (system) |
|
22 | (with-open-file (file (asdf:system-source-file system)) |
|
23 | (loop for x = (read file nil) |
|
24 | while x |
|
25 | collect x))) |
|
162 | 26 | |
468 | 27 | (defun to-sk-system (system) |
28 | (let ((sys (change-class system 'sk-lisp-system))) |
|
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
29 | (setf (sk-lisp-system-serial sys) nil |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
30 | (sk-lisp-system-perform sys) nil) |
468 | 31 | (id:update-id sys) |
32 | sys)) |
|
33 | ||
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
34 | (defmethod sk-convert ((self asdf:system)) |
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
35 | (to-sk-system self)) |
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
36 | |
468 | 37 | (defun find-sk-system (system) |
38 | (to-sk-system (asdf:find-system system))) |
|
39 | ||
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
40 | (defun parse-sk-lisp-system (name path &optional opts) |
468 | 41 | (to-sk-system (asdf::parse-component-form nil (list* :system name :pathname path opts)))) |
42 | ||
43 | (defmethod sk-load ((self sk-lisp-system) &key force force-not verbose version) |
|
44 | (asdf:load-system self :force force :force-not force-not :verbose verbose :version version)) |
|
162 | 45 | |
663
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
46 | (defmethod sk-load-component ((kind (eql :asd)) (form pathname) &optional (path *default-pathname-defaults*)) |
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
47 | (declare (ignore kind)) |
663
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
48 | (let* ((type (pathname-type form)) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
49 | (name (namestring (if type (pathname-name form) form))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
50 | (fname (if type form (make-pathname :name name :type "asd")))) |
cc89b337384b
skel upgrades, added skel/net
Richard Westhaver <ellis@rwest.io>
parents:
559
diff
changeset
|
51 | (parse-sk-lisp-system name (merge-pathnames fname path)))) |
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
52 | |
516
f68a5996a2b1
skel updates, sketch of sk-path parser
Richard Westhaver <ellis@rwest.io>
parents:
478
diff
changeset
|
53 | (defmethod sk-compile ((self sk-lisp-system) &key force force-not verbose version &allow-other-keys) |
f68a5996a2b1
skel updates, sketch of sk-path parser
Richard Westhaver <ellis@rwest.io>
parents:
478
diff
changeset
|
54 | (asdf:compile-system self :force force :force-not force-not :verbose verbose :version version)) |
162 | 55 | |
468 | 56 | (defun sk-write-asd-components (module) |
57 | (etypecase module |
|
58 | (asdf:file-component |
|
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
59 | `(,(keywordicate (string-upcase (asdf:file-type module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
60 | ,(pathname-name (asdf:component-relative-pathname module)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
61 | ,@(when-let ((x (asdf::component-if-feature module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
62 | `(:if-feature ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
63 | ,@(when-let ((x (asdf::component-depends-on nil module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
64 | `(:depends-on ,x)))) |
468 | 65 | (asdf:module |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
66 | `(:module |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
67 | ,(asdf:component-name module) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
68 | ,@(when-let ((x (asdf::component-if-feature module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
69 | `(:if-feature ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
70 | ,@(when-let ((x (asdf::component-depends-on nil module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
71 | `(:depends-on ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
72 | ,@(when-let ((x (asdf:module-components module))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
73 | `(:components ,(mapcar #'sk-write-asd-components x))))))) |
162 | 74 | |
468 | 75 | (defmethod sk-write-file ((self sk-lisp-system) &key path) |
76 | (let ((name (asdf:component-name self))) |
|
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
77 | (with-open-file (s path |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
78 | :direction :output |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
79 | :if-does-not-exist :create) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
80 | (format s ";;; ASDF definition for system ~A" name) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
81 | (let ((*print-case* :downcase)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
82 | (pprint `(defsystem ,name |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
83 | :class sk-lisp-system |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
84 | ,@(when-let ((x (asdf:component-version self))) `(:version ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
85 | ,@(when-let ((x (asdf:system-depends-on self))) `(:depends-on ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
86 | ,@(when-let ((x (asdf:system-description self))) `(:description ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
87 | ,@(when-let ((x (asdf:system-long-description self))) `(:long-description ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
88 | ,@(when-let ((x (asdf:system-author self))) `(:author ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
89 | ,@(when-let ((x (asdf:system-maintainer self))) `(:maintainer ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
90 | ,@(when-let ((x (asdf:system-mailto self))) `(:mailto ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
91 | ,@(when-let ((x (asdf::system-license self))) `(:license ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
92 | ,@(when-let ((x (asdf:system-homepage self))) `(:homepage ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
93 | ,@(when-let ((x (asdf:system-bug-tracker self))) `(:bug-tracker ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
94 | ,@(when-let ((x (asdf:system-source-control self))) `(:source-control ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
95 | ,@(when-let ((x (asdf::component-in-order-to self))) `(:in-order-to ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
96 | ,@(when-let ((x (asdf::component-build-pathname self))) `(:build-pathname ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
97 | ,@(when-let ((x (asdf::component-build-operation self))) `(:build-operation ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
98 | ,@(when-let ((x (asdf::component-entry-point self))) `(:entry-point ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
99 | ,@(when-let ((x (sk-lisp-system-perform self))) `(:perform ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
100 | ,@(when-let ((x (sk-lisp-system-serial self))) `(:serial ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
101 | :components ,(mapcar #'sk-write-asd-components |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
102 | (asdf:module-components self))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
103 | s) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
104 | (terpri s))))) |
468 | 105 | |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
106 | ;; (sk-write-file (find-sk-system :obj) :path "test") |
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
107 | ;; (describe (parse-sk-lisp-system "skel" "/home/ellis/comp/core/lisp/lib/")) |
468 | 108 | |
109 | (defmethod sk-read-file ((self sk-lisp-system) path) |
|
477
c9b69040cb23
skel updates - lisp and rust systems
Richard Westhaver <ellis@rwest.io>
parents:
469
diff
changeset
|
110 | (parse-sk-lisp-system (pathname-name path) (pathname-directory path))) |