Skip to content

Commit 13fdf00

Browse files
Fuco1Fuco1
committed
feat(core): add parallel processing of dependencies
1 parent 2cec802 commit 13fdf00

File tree

5 files changed

+272
-44
lines changed

5 files changed

+272
-44
lines changed

‎Cask

+1
Original file line numberDiff line numberDiff line change
@@ -12,6 +12,7 @@
1212
(depends-on "lsp-mode")
1313
(depends-on "ansi")
1414
(depends-on "cl-lib")
15+
(depends-on "async")
1516

1617
(development
1718
(depends-on "elsa")

‎Eask

+1
Original file line numberDiff line numberDiff line change
@@ -21,6 +21,7 @@
2121
(depends-on "lsp-mode")
2222
(depends-on "ansi")
2323
(depends-on "cl-lib")
24+
(depends-on "async")
2425

2526
(development
2627
(depends-on "elsa")

‎elsa-dependencies.el

+88-43
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,52 @@
1+
(require 'dash)
2+
3+
(defun elsa--get-deps-with-no-deps (deps)
4+
"Return dependencies from DEPS with zero dependencies.
5+
6+
DEPS is an alist of (LIBRARY . DEPENDENCIES). Here we select all
7+
those DEPENDENCIES which themselves are not present in the
8+
alist."
9+
(let ((scanned-files (mapcar #'car deps))
10+
(deps-all (-mapcat #'cdr deps)))
11+
(->> deps-all
12+
(-uniq)
13+
(--remove (member it scanned-files))
14+
(--remove (string-match-p ":" it)))))
15+
16+
(defun elsa--alist-to-layers (deps)
17+
"Transform the dependencies alist DEPS to list of layers.
18+
19+
Each layer can be processed in parallel because it only depends
20+
on the lower layers.
21+
22+
The bottom layer is the last in the list."
23+
(let* (;; initial files with no dependencies
24+
(empty-deps (elsa--get-deps-with-no-deps deps))
25+
(processed nil)
26+
(layers nil)
27+
(current-layer)
28+
(remaining-deps (append deps (mapcar #'list empty-deps)))
29+
(i 0))
30+
(catch 'done
31+
(while t
32+
(cl-incf i)
33+
(when (= i 1000) (error "Dependency resolution overflow"))
34+
35+
(setq current-layer (apply #'append (--filter (= 1 (length it)) remaining-deps)))
36+
37+
(unless current-layer
38+
(throw 'done layers))
39+
(push current-layer layers)
40+
(setq processed (-uniq (append current-layer processed)))
41+
42+
;; remove current layer because those are heads with no dependencies
43+
(setq remaining-deps (--remove (member (car it) current-layer) remaining-deps))
44+
;; remove current layer from remaining packages' dependencies
45+
(setq remaining-deps
46+
(mapcar (-lambda ((head . tail))
47+
(cons head (--remove (member it processed) tail)))
48+
remaining-deps))))))
49+
150
;; (elsa-get-dep-tree :: (function (string) mixed))
251
(defun elsa-get-dep-tree (file)
352
"Recursively crawl require forms starting from FILE.
@@ -7,20 +56,18 @@ Only top-level `require' forms are considered."
756
(plist-get (elsa--get-dep-alist file) :deps)
857
file))
958

10-
;; (elsa-get-dependencies :: (function (string (or int nil)) mixed))
11-
(defun elsa-get-dependencies (file &optional min-depth)
59+
;; (elsa-get-dependencies :: (function (string) mixed))
60+
(defun elsa-get-dependencies (file)
1261
"Get all recursive dependencies of FILE.
1362
1463
The order is such that if we load the features in order we will
15-
satisfy all inclusion relationships.
16-
17-
MIN-DEPTH will fold all the dependencies of greater depth only."
18-
(setq min-depth (or min-depth 0))
64+
satisfy all inclusion relationships."
1965
(let ((folded-deps (elsa-get-dep-tree file)))
20-
(if (> min-depth 0)
21-
(--map (elsa-topo-sort (elsa-tree-to-deps it) (car it))
22-
(cdr folded-deps))
23-
(elsa-topo-sort (elsa-tree-to-deps folded-deps) file))))
66+
(elsa-topo-sort (elsa-tree-to-deps folded-deps) file)))
67+
68+
(defun elsa-get-dependencies-as-layers (file)
69+
(let ((deps (plist-get (elsa--get-dep-alist file) :deps)))
70+
(elsa--alist-to-layers deps)))
2471

2572
;; (elsa--find-dependency :: (function (string) (or nil string)))
2673
(defun elsa--find-dependency (library-name)
@@ -45,43 +92,41 @@ Return the state."
4592
(unless state
4693
(setq state (list :visited nil :deps nil)))
4794
(setq current-library (or current-library file))
48-
(with-temp-buffer
49-
(let ((jka-compr-verbose nil)) (insert-file-contents file))
50-
(emacs-lisp-mode)
51-
(goto-char (point-min))
52-
(while (re-search-forward
53-
(rx
54-
"(" (*? whitespace)
55-
"require" (*? whitespace)
56-
"'" (group (+? (or word (syntax symbol))))
57-
(*? whitespace) ")")
58-
nil t)
59-
(unless (nth 4 (syntax-ppss))
60-
(let* ((library-name (match-string 1))
61-
(library (elsa--find-dependency library-name))
62-
(library-name-sanitized
63-
;; This require does not happen right away but lazily
64-
;; when some function is called. This is a "soft
65-
;; require" and we will first analyze the file without
66-
;; it, then re-analyze later once this dependency was
67-
;; resolved. (do we want to reanalyze?)
68-
(if (and (< 0 (car (syntax-ppss)))
95+
;; (var this-file-requires :: (string string))
96+
(let ((this-file-requires nil))
97+
(with-temp-buffer
98+
(let ((jka-compr-verbose nil)) (insert-file-contents file))
99+
(let ((emacs-lisp-mode-hook nil)) (emacs-lisp-mode))
100+
(goto-char (point-min))
101+
(while (re-search-forward
102+
(rx
103+
"(" (*? whitespace)
104+
"require" (*? whitespace)
105+
"'" (group (+? (or word (syntax symbol))))
106+
(*? whitespace) ")")
107+
nil t)
108+
(unless (or (nth 4 (syntax-ppss))
109+
(and (< 0 (car (syntax-ppss)))
69110
(not (and (= 1 (car (syntax-ppss)))
70111
(save-excursion
71112
(backward-up-list)
72113
(down-list)
73-
(looking-at-p "eval-")))))
74-
(concat library-name ":" current-library)
75-
library-name)))
76-
(when library
77-
(let ((deps (plist-get state :deps)))
78-
(push library-name-sanitized (alist-get current-library deps nil nil #'equal))
79-
(setq state (plist-put state :deps deps)))
80-
(unless (member library (plist-get state :visited))
81-
(setq state (plist-put state :visited
82-
(cons library (plist-get state :visited))))
83-
(setq state (elsa--get-dep-alist library library-name state)))))))
84-
state))
114+
(looking-at-p "eval-"))))) )
115+
(let* ((library-name (match-string 1))
116+
(library (elsa--find-dependency library-name)))
117+
(when library
118+
(push (list library library-name) this-file-requires))))))
119+
(dolist (req (nreverse this-file-requires))
120+
(let ((library (car req))
121+
(library-name (cadr req)))
122+
(let ((deps (plist-get state :deps)))
123+
(push library-name (alist-get current-library deps nil nil #'equal))
124+
(setq state (plist-put state :deps deps)))
125+
(unless (member library (plist-get state :visited))
126+
(setq state (plist-put state :visited
127+
(cons library (plist-get state :visited))))
128+
(setq state (elsa--get-dep-alist library library-name state))))))
129+
state)
85130

86131
(defun elsa-topo-sort (deps start)
87132
"Topologically sort DEPS starting at START node."

‎elsa-parallel.el

+181
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,181 @@
1+
;;; elsa-parallel.el --- -*- lexical-binding: t -*-
2+
3+
;; Copyright (C) 2023 Matúš Goljer
4+
5+
;; Author: Matúš Goljer <[email protected]>
6+
;; Maintainer: Matúš Goljer <[email protected]>
7+
;; Version: 0.0.1
8+
;; Created: 9th March 2023
9+
;; Keywords:
10+
11+
;; This program is free software; you can redistribute it and/or
12+
;; modify it under the terms of the GNU General Public License
13+
;; as published by the Free Software Foundation; either version 3
14+
;; of the License, or (at your option) any later version.
15+
16+
;; This program is distributed in the hope that it will be useful,
17+
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18+
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19+
;; GNU General Public License for more details.
20+
21+
;; You should have received a copy of the GNU General Public License
22+
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23+
24+
;;; Commentary:
25+
26+
;;; Code:
27+
28+
(require 'async)
29+
30+
(defun elsa--worker-function-factory (worker-id project-directory)
31+
"Return function running in the Elsa analysis worker."
32+
(let ((load--path load-path))
33+
(lambda ()
34+
(setq load-path load--path)
35+
(setq elsa-is-language-server nil)
36+
(setq ansi-inhibit-ansi t)
37+
(require 'elsa)
38+
(require 'async)
39+
(let ((msg nil))
40+
(setq elsa-global-state (elsa-global-state))
41+
(oset elsa-global-state project-directory project-directory)
42+
(oset elsa-global-state number-of-files 1)
43+
(oset elsa-global-state processed-file-index 1)
44+
(catch 'done
45+
(while t
46+
(setq msg (async-receive))
47+
(let ((op (plist-get msg :op)))
48+
(cond
49+
((equal op "analyze")
50+
(let* ((dep (plist-get msg :file))
51+
(library (file-truename
52+
(if (f-exists? dep) dep
53+
(elsa--find-dependency dep))))
54+
(current-time (current-time)))
55+
(when library
56+
(condition-case err
57+
(let ((state (elsa-process-file library elsa-global-state)))
58+
;; `subr' has no provide for some circular
59+
;; dependency "bootstrap" issues. We add it here
60+
;; artificially.
61+
(when (equal dep "subr")
62+
(oset state provide (list 'subr)))
63+
;; (elsa-save-cache state elsa-global-state)
64+
)
65+
(error (async-send :ack "error" :error err))))
66+
(async-send :ack "ok" :op op
67+
:worker-id worker-id :file dep
68+
:duration (float-time
69+
(time-subtract
70+
(current-time) current-time)))))
71+
((equal op "load-from-cache")
72+
(let ((files (plist-get msg :files)))
73+
(dolist (file files) (load (f-no-ext file) t t))
74+
(async-send :ack "ok" :op op :worker-id worker-id)))
75+
((equal op "quit")
76+
(throw 'done t))))))))))
77+
78+
(defun elsa--parent-function-factory (worker-id workers-state global-state)
79+
"Function handling child-to-parent messages and worker exit."
80+
(lambda (result)
81+
(if (async-message-p result)
82+
(let* ((worker-id (plist-get result :worker-id))
83+
(worker-state (assoc worker-id workers-state))
84+
(op (plist-get result :op)))
85+
(cond
86+
((equal op "analyze")
87+
(let ((file (plist-get result :file))
88+
(duration (plist-get result :duration)))
89+
(elsa-log
90+
(with-ansi
91+
(green "[%s]" (elsa-global-state-get-counter global-state))
92+
(format " (worker %d) Processing file %s ... " worker-id file)
93+
(green "done")
94+
" after "
95+
(cond
96+
((> duration 5)
97+
(bright-red "%.3fs" duration))
98+
((> duration 2)
99+
(bright-yellow "%.3fs" duration))
100+
(t (green "%.3fs" duration))))))
101+
(cl-incf (oref global-state processed-file-index))
102+
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))
103+
((equal op "load-from-cache")
104+
;; (message "Worker %s loaded all cache files for this layer" worker-id)
105+
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))))
106+
;; (message "Async process done in worker %d, result: %s" worker-id result)
107+
t
108+
)))
109+
110+
111+
(defun elsa--wait-for-all (get-worker-states)
112+
(catch 'all-workers-ready
113+
(while t
114+
(when (--all? (plist-get (cdr it) :ready) (funcall get-worker-states))
115+
(throw 'all-workers-ready t))
116+
(sleep-for 0.2))))
117+
118+
(defun elsa-analyse-file-parallel (file global-state &optional already-loaded)
119+
"Analyse FILE with GLOBAL-STATE.
120+
121+
Optional argument ALREADY-LOADED is used to skip dependencies which
122+
are already loaded in the currently running Emacs process. This is
123+
used by the LSP server to not reload already processed files."
124+
(my-with-elapsed-timer "process dependencies"
125+
(let* ((dependencies (reverse
126+
(append
127+
(my-with-elapsed-timer "resolving dependencies"
128+
(elsa-get-dependencies-as-layers file))
129+
'(("subr")))))
130+
(visited nil)
131+
(file-state nil)
132+
;; alist from worker ID to state
133+
(workers-state (--map (list it :ready t) (-iota 5)))
134+
(workers (--map (async-start
135+
(elsa--worker-function-factory it (f-parent file))
136+
(elsa--parent-function-factory it workers-state global-state)
137+
;;(lambda (result) (message "result %s" result))
138+
)
139+
(-iota 5)))
140+
(i 0))
141+
(oset global-state project-directory (f-parent file))
142+
(oset global-state processed-file-index 1)
143+
(oset global-state number-of-files (length (-flatten dependencies)))
144+
(elsa-log "Processing dependency layers: %s" dependencies)
145+
(dolist (layer dependencies)
146+
(cl-incf i)
147+
;; (elsa-log "processing layer %s" i)
148+
(while layer
149+
(-each workers-state
150+
(-lambda ((state &as worker-id . (&plist :ready)))
151+
(when (and ready layer)
152+
;(elsa-log "Worker %s is ready, submitting dependency %s" worker-id (car layer))
153+
(setf (cdr state) (plist-put (cdr state) :ready nil))
154+
(let ((worker (nth worker-id workers)))
155+
(async-send worker :op "analyze" :file (pop layer))))))
156+
(sleep-for 0.2))
157+
;(elsa-log "All work for layer %s was distributed" i)
158+
(elsa--wait-for-all (lambda () workers-state))
159+
;; (catch 'all-workers-ready
160+
;; (while t
161+
;; (when (--all? (plist-get (cdr it) :ready) workers-state)
162+
;; (throw 'all-workers-ready t))
163+
;; (sleep-for 0.2)))
164+
;(elsa-log "All workers finished processing layer %s" i)
165+
(let ((cache-files (mapcar
166+
(lambda (dep)
167+
(elsa--get-cache-file-name global-state dep))
168+
layer)))
169+
(-each workers-state
170+
(-lambda ((state &as worker-id))
171+
(setf (cdr state) (plist-put (cdr state) :ready nil))
172+
(let ((worker (nth worker-id workers)))
173+
(async-send worker :op "load-from-cache" :files cache-files)))))
174+
(elsa--wait-for-all (lambda () workers-state))
175+
;(elsa-log "All workers updated global state for layer %s" i)
176+
)
177+
(--each workers
178+
(async-send it :op "quit")))))
179+
180+
(provide 'elsa-parallel)
181+
;;; elsa-parallel.el ends here

‎elsa.el

+1-1
Original file line numberDiff line numberDiff line change
@@ -6,7 +6,7 @@
66
;; Maintainer: Matúš Goljer <[email protected]>
77
;; Created: 23rd March 2017
88
;; Version: 0.1.0
9-
;; Package-Requires: ((emacs "26.1") (trinary "0") (f "0") (dash "2.14") (cl-lib "0.3") (lsp-mode "0") (ansi "0"))
9+
;; Package-Requires: ((emacs "26.1") (trinary "0") (f "0") (dash "2.14") (cl-lib "0.3") (lsp-mode "0") (ansi "0") ("async" "1.9.7"))
1010
;; URL: https://github.com/emacs-elsa/Elsa
1111
;; Keywords: languages, lisp
1212

0 commit comments

Comments
 (0)