changeset 469: | 7354623e5b54 |
parent: | 121a0253aa3c |
child: | c9b69040cb23 |
author: | Richard Westhaver <ellis@rwest.io> |
date: | Sat, 22 Jun 2024 19:45:19 -0400 |
permissions: | -rw-r--r-- |
description: | define-alien-enum, zstd, skel, and pod work |
162 | 1 | ;;; lib/skel/comp/asd.lisp --- ASDF System Definition Compiler |
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 | |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
15 | (defclass sk-lisp-system (skel asdf:system) |
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 | ||
34 | (defun find-sk-system (system) |
|
35 | (to-sk-system (asdf:find-system system))) |
|
36 | ||
37 | (defun parse-sk-system (name path &optional opts) |
|
38 | (to-sk-system (asdf::parse-component-form nil (list* :system name :pathname path opts)))) |
|
39 | ||
40 | (defmethod sk-load ((self sk-lisp-system) &key force force-not verbose version) |
|
41 | (asdf:load-system self :force force :force-not force-not :verbose verbose :version version)) |
|
162 | 42 | |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
43 | ;; (defmethod sk-compile ((self sk-lisp-system) stream &key &allow-other-keys)) |
162 | 44 | |
468 | 45 | (defun sk-write-asd-components (module) |
46 | (etypecase module |
|
47 | (asdf:file-component |
|
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
48 | `(,(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
|
49 | ,(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
|
50 | ,@(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
|
51 | `(:if-feature ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
52 | ,@(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
|
53 | `(:depends-on ,x)))) |
468 | 54 | (asdf:module |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
55 | `(:module |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
56 | ,(asdf:component-name module) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
57 | ,@(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
|
58 | `(:if-feature ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
59 | ,@(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
|
60 | `(:depends-on ,x)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
61 | ,@(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
|
62 | `(:components ,(mapcar #'sk-write-asd-components x))))))) |
162 | 63 | |
468 | 64 | (defmethod sk-write-file ((self sk-lisp-system) &key path) |
65 | (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
|
66 | (with-open-file (s path |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
67 | :direction :output |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
68 | :if-does-not-exist :create) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
69 | (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
|
70 | (let ((*print-case* :downcase)) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
71 | (pprint `(defsystem ,name |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
72 | :class sk-lisp-system |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
73 | ,@(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
|
74 | ,@(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
|
75 | ,@(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
|
76 | ,@(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
|
77 | ,@(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
|
78 | ,@(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
|
79 | ,@(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
|
80 | ,@(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
|
81 | ,@(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
|
82 | ,@(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
|
83 | ,@(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
|
84 | ,@(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
|
85 | ,@(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
|
86 | ,@(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
|
87 | ,@(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
|
88 | ,@(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
|
89 | ,@(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
|
90 | :components ,(mapcar #'sk-write-asd-components |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
91 | (asdf:module-components self))) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
92 | s) |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
93 | (terpri s))))) |
468 | 94 | |
469
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
95 | ;; (sk-write-file (find-sk-system :obj) :path "test") |
7354623e5b54
define-alien-enum, zstd, skel, and pod work
Richard Westhaver <ellis@rwest.io>
parents:
468
diff
changeset
|
96 | ;; (describe (parse-sk-system "skel" "/home/ellis/comp/core/lisp/lib/")) |
468 | 97 | |
98 | (defmethod sk-read-file ((self sk-lisp-system) path) |
|
99 | (parse-sk-system (pathname-name path) (pathname-directory path))) |