refactor: introduce doom-module-context

Where f9201eb introduced a general context system, this one introduces
one for modules, to simplify our let-bind game when interacting with
modules, and to more efficiently expose module state to modulep! (which
gets called at runtime a great deal, so its performance is important).

* lisp/doom-lib.el (doom-log): simplify macro and introduce
  doom-inhibit-log variable.
* lisp/doom-modules.el (modulep!): fix reported file path if modulep!
  fails to find the local module.
* lisp/lib/debug.el (doom-debug-variables): disable doom-inhibit-log
  when debug mode is on.

Ref: f9201eb218
This commit is contained in:
Henrik Lissner 2022-09-24 20:34:13 +02:00
parent 5d2313155c
commit 4efaf6837b
No known key found for this signature in database
GPG key ID: B60957CA074D39A3
8 changed files with 118 additions and 72 deletions

View file

@ -242,23 +242,22 @@ in."
(let (doom-doctor--errors
doom-doctor--warnings)
(condition-case-unless-debug ex
(let ((doom--current-module key)
(doom--current-flags (plist-get plist :flags))
(doctor-file (doom-module-expand-path (car key) (cdr key) "doctor.el"))
(packages-file (doom-module-expand-path (car key) (cdr key) doom-module-packages-file)))
(cl-loop with doom-output-indent = 6
for name in (doom-context-with 'packages
(let* (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)
(mapcar #'car doom-packages)))
unless (or (doom-package-get name :disable)
(eval (doom-package-get name :ignore))
(plist-member (doom-package-get name :recipe) :local-repo)
(locate-library (symbol-name name))
(doom-package-built-in-p name)
(doom-package-installed-p name))
do (print! (error "Missing emacs package: %S") name)))
(doom-module-context-with key
(let ((doctor-file (doom-module-expand-path (car key) (cdr key) "doctor.el"))
(packages-file (doom-module-expand-path (car key) (cdr key) doom-module-packages-file)))
(cl-loop with doom-output-indent = 6
for name in (doom-context-with 'packages
(let* (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)
(mapcar #'car doom-packages)))
unless (or (doom-package-get name :disable)
(eval (doom-package-get name :ignore))
(plist-member (doom-package-get name :recipe) :local-repo)
(locate-library (symbol-name name))
(doom-package-built-in-p name)
(doom-package-installed-p name))
do (print! (error "Missing emacs package: %S") name))))
(let ((inhibit-message t))
(load doctor-file 'noerror 'nomessage))
(file-missing (error! "%s" (error-message-string ex)))

View file

@ -17,29 +17,34 @@
;;
;;; Logging
(defun doom--log (text)
(let ((inhibit-message (not init-file-debug)))
(message "%s" (propertize text 'face 'font-lock-doc-face))))
(defvar doom-inhibit-log (not (or noninteractive init-file-debug))
"If non-nil, suppress `doom-log' output.")
(defmacro doom-log (output &rest args)
(defun doom--log (text &rest args)
(let ((inhibit-message (not init-file-debug))
(absolute? (string-prefix-p ":" text)))
(apply #'message
(propertize (concat "* %.06f:%s" (if (not absolute?) ":") text)
'face 'font-lock-doc-face)
(float-time (time-subtract (current-time) before-init-time))
(mapconcat
(lambda (x) (format "%s" x))
(unless absolute?
(append (cons '* (remq t (reverse doom-context)))
(if (bound-and-true-p doom-module-context)
(let ((key (doom-module-context-key)))
(delq nil (list (car key) (cdr key)))))))
":")
args)))
(defmacro doom-log (message &rest args)
"Log a message in *Messages*.
Does not emit the message in the echo area. This is a macro instead of a
function to prevent the potentially expensive evaluation of its arguments when
debug mode is off."
debug mode is off. Return non-nil."
(declare (debug t))
`(when (or init-file-debug noninteractive)
(doom--log
(with-no-warnings ; suppress 'more args than %-sequences' warning
(let* ((output ,output)
(absolute? (string-prefix-p ":" output)))
(format (concat "* %.06f%s" (if absolute? output (concat ":" output)))
(float-time (time-subtract (current-time) before-init-time))
(let ((context (remq t (reverse doom-context))))
(if (and context (not absolute?))
(concat "::" (mapconcat #'symbol-name context ":"))
""))
,@args))))))
`(unless doom-inhibit-log (doom--log ,message ,@args)))
;;

View file

@ -107,8 +107,56 @@ your `doom!' block, a warning is emitted before replacing it with :emacs vc and
:group 'doom
:type 'hook)
(defvar doom--current-module nil)
(defvar doom--current-flags nil)
;;
;;; `doom-module-context'
(defvar doom-module-context [nil nil nil nil]
"A vector describing the module associated it with the active context.
Contains the following: [:GROUP MODULE FLAGS FEATURES]
Do not directly set this variable, only let-bind it.")
(eval-and-compile
(setplist 'doom-module-context '(group 0 name 1 flags 2 features 3)))
;; DEPRECATED: Remove this when byte-compilation is introduced to Doom core.
(defmacro doom-module--context-field (field) (get 'doom-module-context field))
(defun doom-module-context-get (field &optional context)
"Return the FIELD of CONTEXT.
FIELD should be one of `group', `name', `flags', or `features'.
CONTEXT should be a `doom-module-context' vector. If omitted, defaults to
`doom-module-context'."
(aref (or context doom-module-context) (get 'doom-module-context field)))
(defun doom-module-context (group &optional name)
"Create a `doom-module-context' from a module by GROUP and NAME.
If NAME is omitted, GROUP is treated as a module key cons cell: (GROUP . NAME)."
(declare (side-effect-free t))
(let* ((key (if name (cons group name) group))
(group (or (car-safe key) key))
(name (cdr-safe key))
(data (get group name)))
(vector group name
(aref data (doom-module--context-field flags))
(aref data (doom-module--context-field features)))))
(defun doom-module-context-key (&optional context)
"Return the module of the active `doom-module-context' as a module key."
(declare (side-effect-free t))
(let ((context (or context doom-module-context)))
(cons (aref context (doom-module--context-field group))
(aref context (doom-module--context-field name)))))
(defmacro doom-module-context-with (module-key &rest body)
"Evaluate BODY with `doom-module-context' informed by MODULE-KEY."
(declare (indent 1))
`(let ((doom-module-context (doom-module-context ,module-key)))
(doom-log ":context:module: =%s" doom-module-context)
,@body))
;;
@ -418,19 +466,17 @@ For more about modules and flags, see `doom!'."
;; Doom will byte-compile its core files. At that time, we can use it again.
(and (cond (flag (memq flag (aref (or (get category module) doom--empty-module) 2)))
(module (get category module))
(doom--current-flags (memq category doom--current-flags))
(doom--current-module
(memq category
(aref (or (get (car doom--current-module)
(cdr doom--current-module))
doom--empty-module)
2)))
((if-let (module (doom-module-from-path (macroexpand '(file!))))
(memq category (aref (or (get (car module) (cdr module))
doom--empty-module)
2))
(error "(modulep! %s %s %s) couldn't figure out what module it was called from (in %s)"
category module flag (file!)))))
(doom-module-context (memq category (aref doom-module-context 2)))
((let ((file
;; This must be expanded at the call site, not in
;; `modulep!'s definition, to get the file we want.
(macroexpand '(file!))))
(if-let (module (doom-module-from-path file))
(memq category (aref (or (get (car module) (cdr module))
doom--empty-module)
2))
(error "(modulep! %s %s %s) couldn't figure out what module it was called from (in %s)"
category module flag file)))))
t))

View file

@ -411,13 +411,9 @@ installed."
;;; Package getters
(defun doom-packages--read (file &optional noeval noerror)
(doom-context-with 'packages
(condition-case-unless-debug e
(with-temp-buffer ; prevent buffer-local state from propagating
(let* ((doom--current-module (doom-module-from-path file))
(doom--current-flags
(doom-module-get (car doom--current-module)
(cdr doom--current-module)
:flags)))
(doom-module-context-with (doom-module-from-path file)
(condition-case-unless-debug e
(with-temp-buffer ; prevent buffer-local state from propagating
(if (not noeval)
(load file noerror 'nomessage 'nosuffix)
(when (file-exists-p file)
@ -436,14 +432,14 @@ installed."
(push (cons
name (plist-put
plist :modules
(list doom--current-module)))
doom-packages)))))))))
(user-error
(user-error (error-message-string e)))
(error
(signal 'doom-package-error
(list (doom-module-from-path file)
file e))))))
(list (doom-module-context-key))))
doom-packages))))))))
(user-error
(user-error (error-message-string e)))
(error
(signal 'doom-package-error
(list (doom-module-context-key)
file e)))))))
(defun doom-package-list (&optional module-list)
"Retrieve a list of explicitly declared packages from MODULE-LIST.

View file

@ -399,9 +399,9 @@ Defaults to the profile at `doom-profile-default'."
(init-file doom-module-init-file)
(config-file doom-module-config-file))
(letf! ((defun module-loader (group name file &optional noerror)
`(let ((doom--current-module '(,group . ,name))
(doom--current-flags ',(doom-module-get group name :flags)))
(doom-load ,(abbreviate-file-name (file-name-sans-extension file)))))
(doom-module-context-with (cons group name)
`(let ((doom-module-context ,doom-module-context))
(doom-load ,(abbreviate-file-name (file-name-sans-extension file))))))
(defun module-list-loader (modules file &optional noerror)
(cl-loop for (cat . mod) in modules
if (doom-module-locate-path cat mod file)

View file

@ -9,6 +9,7 @@
(defvar doom-debug-variables
`(;; Doom variables
(doom-print-minimum-level . debug)
(doom-inhibit-log . nil)
;; Emacs variables
async-debug

View file

@ -155,10 +155,9 @@ return NULL-VALUE."
(insert-file-contents file nil 0 256)
(if (re-search-forward (format "^;;;###%s " (regexp-quote (or cookie "if")))
nil t)
(let* ((load-file-name file)
(doom--current-module (doom-module-from-path file))
(doom--current-flags (doom-module-get (car doom--current-module) (cdr doom--current-module) :flags)))
(eval (sexp-at-point) t))
(doom-module-context-with (doom-module-from-path file)
(let ((load-file-name file))
(eval (sexp-at-point) t)))
null-value)))
;;;###autoload

View file

@ -1351,7 +1351,7 @@ between the two."
))
;;; Custom org modules
(dolist (flag doom--current-flags)
(dolist (flag (doom-module-context-get 'flags))
(load! (concat "contrib/" (substring (symbol-name flag) 1)) nil t))
;; Add our general hooks after the submodules, so that any hooks the