(car (benchmark-run 1 (locate-library "magit")))

(car (benchmark-run 1 (locate-library "yow")))

(car (benchmark-run 1 (locate-library "all-the-icons-dired")))

(benchmark-run 1 (locate-library "yow"))

;;;; 高速ライブラリパス解決

(defvar my-locate-library-list nil
  "ファイルのベース名をシンボル化したもののリスト。
後でリセットするためのもの。")

(defvar my-locate-library-load-path nil
  "build時点でのload-path。変更を(簡易的に)検出するためのもの。")

(defconst my-locate-library-file-extensions
  (get-load-suffixes)
  "ロード対象の拡張子リスト")
(defconst my-locate-library-file-regexp
  (concat "\\`\\(.*\\)\\(" (mapconcat #'regexp-quote my-locate-library-file-extensions "\\|") "\\)\\'")
  "ロード対象のファイルにマッチし、ベース名と拡張子を取り出す正規表現。")

(defun my-locate-library-build ()
  "`my-locate-library'関数用のデータを構築する。

`load-path'が確定したら呼び出すこと。"
  ;; load-pathの変更を検出するために構築時のload-pathを保存する。
  ;; my-locate-libraryのたびに厳密な検査は時間がかかりすぎてやりたくないが
  ;; せめて先頭の比較くらいはしたい。
  ;; pushやpopしたくらいなら変更に気づけるので。
  ;; 厳密に判定したいなら、copy-sequenceしておいてequalで判定するくらいか？
  ;; もちろんそれでもファイルが増えたことには気づけない。
  (setq my-locate-library-load-path load-path)

  ;; load-path上の全てのディレクトリを走査する。
  ;; 先頭、つまり優先するものから走査する。
  (dolist (dir load-path)
    ;; 存在するディレクトリであること。
    (when (file-directory-p dir)
      (let (files) ;; filesは(ベース名 . 拡張子)のリスト。
        ;; dirの下にあるロード対象ファイルをリストアップする。
        ;; ファイルのベース名と最も優先する拡張子を求める。
        ;; 例: (foo.el foo.elc bar.el bar.txt aaa.txt) => (foo.elc bar.el)
        ;; directory-filesはソートされたリストを返すので、ベース名が一致
        ;; するファイルは隣接することを利用する。
        (dolist (file (directory-files dir))
          ;; 有効な拡張子を持つファイルであること。
          (when (string-match my-locate-library-file-regexp file)
            ;; ベース名と拡張子を取り出す。
            (let ((curr-base (match-string 1 file))
                  (curr-ext (match-string 2 file)))
              ;; 一つ前のベース名と比較する
              (if (equal (car (car files)) curr-base)
                  ;; 一つ前と同じベース名の場合 (e.g. foo.el and foo.elc)
                  ;; 拡張子の優先順位を比較する
                  ;;@todo .elcのタイムスタンプを考慮すべき？
                  (if (< (my-locate-library-ext-priority curr-ext)
                         (my-locate-library-ext-priority (cdr (car files))))
                      ;; 現在のを取る
                      (setcdr (car files) curr-ext)
                    ;; 一つ前のを取る
                    nil)
                ;; 違うベース名の場合
                (push (cons curr-base curr-ext) files)))))
        ;; シンボルを作りそのプロパティにパスを設定する。
        (dolist (base-ext files)
          (my-locate-library-set-path dir (car base-ext) (cdr base-ext)))))))

(defun my-locate-library-ext-priority (extension)
  "EXTENSIONの優先順位を示す整数値を返す。
例えば.elcの方が.elよりも小さな値を返す。"
  (seq-position my-locate-library-file-extensions extension))

(defun my-locate-library-set-path (dir base ext)
  "BASEをシンボル化し、それにファイルへのパス(DIR/BASE EXT)をプロパティとして設定する。"
  (let ((sym (intern base)))
    (unless (get sym 'my-locate-library-path) ;;上書きするとload-pathで後にある方が優先されてしまうので注意。
      (let ((path (file-name-concat dir (concat base ext))))
        ;;(message "library %s path=%s" sym path)
        (put sym 'my-locate-library-path path)
        (push sym my-locate-library-list)))))

(defun my-locate-library-clean ()
  (dolist (sym my-locate-library-list)
    (put sym 'my-locate-library-path nil))
  (setq my-locate-library-list nil))

(defun my-locate-library-rebuild ()
  (my-locate-library-clean)
  (my-locate-library-build))

(defun my-locate-library (file)
  "FILEで指定したファイルがあればそのパスを返す。

`locate-library'は非常に時間がかかるがこれは短時間でチェックできる。

FILEはシンボルでも良く、文字列を指定するよりも速い。"
  (unless (eq load-path my-locate-library-load-path)
    (warn "load-path change detected on (my-locate-library %s)" file)
    (my-locate-library-rebuild))
  ;; 私の手元ではlocate-libraryに拡張子が付いたファイル名や相対パスを指定するコードは無かったので以下は省略。
  ;;@todo 拡張子を考慮 例:(locate-library "tramp.el.gz")
  ;;@todo ディレクトリ名(相対パス指定)を考慮 例:(locate-library "net/tramp")
  ;; (when (stringp file)
  ;;   (when (file-name-directory file)
  ;;     (warn "directory specified on (my-locate-library %s)" file))
  ;;   (when (file-name-extension file)
  ;;     (warn "extension specified on (my-locate-library %s)" file)))
  (get (if (stringp file) (intern file) file) 'my-locate-library-path))

;; 以下、adviceでlocate-library、require、loadを書き替える。

(defun my-locate-library-advice (orig-fun
                                 library &optional
                                 nosuffix path interactive-call)
  (if (or (not (stringp library))
          (file-name-extension library) ;;2022-12-26:追加 動かないケースを除外する
          (file-name-directory library) ;;2022-12-26:追加 動かないケースを除外する
          nosuffix path interactive-call)
      ;; 想定していない使い方の場合はオリジナルを呼び出す。
      (funcall orig-fun library nosuffix path interactive-call)
    (my-locate-library (intern library))))

(defun my-locate-library-require-advice (orig-fun
                                         feature &optional filename noerror)
  (unless filename
    ;; ファイル名(パス)を補う。
    (setq filename (my-locate-library feature)))
  (funcall orig-fun feature filename noerror))

(defconst my-locate-library-load-suffixes-with-nil
  (cons nil (get-load-suffixes)))

(defun my-locate-library-load-advice (orig-fun
                                      file &optional
                                      noerror nomessage nosuffix must-suffix)
  (funcall orig-fun
           (or (and (stringp file)
                    (not nosuffix)
                    (not must-suffix)
                    (not (file-name-directory file))
                    (member (file-name-extension file)
                            my-locate-library-load-suffixes-with-nil)
                    (my-locate-library (file-name-base file)))
               file)
           noerror nomessage nosuffix must-suffix))

(defun my-locate-library-enable ()
  "`locate-library'や`require'、`load'のパス解決を高速化する。

あらかじめ`load-path'が確定した段階で`my-locate-library-build'を
実行しておくこと。

`my-locate-library-disable'で元に戻せる。"
  (advice-add #'locate-library :around #'my-locate-library-advice)
  (advice-add #'require :around #'my-locate-library-require-advice)
  (advice-add #'load :around #'my-locate-library-load-advice))

(defun my-locate-library-disable ()
  (advice-remove #'locate-library #'my-locate-library-advice)
  (advice-remove #'require #'my-locate-library-require-advice)
  (advice-remove #'load #'my-locate-library-load-advice))

(my-locate-library-build)
(my-locate-library-enable)

(my-locate-library-disable)

(car (benchmark-run 1 (my-locate-library "yow")))

(car (benchmark-run 1 (my-locate-library 'yow)))

(my-locate-library-build)
(my-locate-library-enable)
(prog1 (car (benchmark-run 1 (locate-library "yow")))
  (my-locate-library-disable))

(car (benchmark-run 1 (require 'tramp)))

(car (benchmark-run 1 (require 'tramp)))

(car (benchmark-run 1 (my-locate-library-build)))