Coverage report: /home/ellis/comp/core/std/defsys.lisp
Kind | Covered | All | % |
expression | 0 | 49 | 0.0 |
branch | 0 | 2 | 0.0 |
Key
Not instrumented
Conditionalized out
Executed
Not executed
Both branches taken
One branch taken
Neither branch taken
1
;;; defsys.lisp --- defsystem extension macros
3
;; Intended to serve as a replacement for asdf:system utilities and quicklisp.
8
;; - default to asdf (wrap)
9
;; - replace quicklisp (will need to be in lib/sys)
10
;; - share resources between system and dependency manager
11
;; - integrate with lib/packy (package distributor)
12
;; - multi-threaded by default
13
;; - parallel compilation (completely short-circuiting asdf)
16
(in-package :std/defsys)
17
(declaim (optimize speed))
19
(define-condition defsys-error (error) ())
20
(define-condition simple-defsys-error (simple-error) ())
21
(defun defsys-error (format &rest args)
22
(error 'simple-defsys-error :format-control format :format-arguments args))
29
(defclass sysdef () ())
31
(defmacro defsys (name &body body)
32
`(defsystem ,name ,@body))
38
(defparameter *core-module-table* (make-hash-table :test 'equal))
40
(defclass core-module () ())
42
(defun load-core-module (name)
43
(let ((cmod (gethash name *core-module-table*)))
44
(with-slots (load-hook exit-hook) cmod
46
(pushnew exit-hook sb-ext:*exit-hooks*))
47
(funcall load-hook))))
49
(defmacro load-module (name)
50
"Load module NAME from the global list *MODULES*."
51
(let ((mod (find name *modules* :test 'string-equal)))
52
(if (null mod) (warn "Module not found: ~A" name)
53
(let ((core-mod (gethash mod *core-module-table*)))
55
`(load-core-module ,core-mod)
58
(defun unload-module () (setf *module* nil))
60
(defun module-provide-core (name)
61
"Provide a CORE-MODULE, adding valid entries to the *MODULES*
62
variable. The function USE should be called in order to load and activate a
63
module, but the deprecated PROVIDE function is also supported."
64
(load-core-module name))
66
(defmacro with-module (name &body body)
67
"Load the module named NAME, binding it to *MODULE* and eval BODY."
68
`(let ((*module* (or (load-module ,name) ,name)))
71
;; (with-eval-after-load (module &body body))