Skip to content

Commit 7216f4b

Browse files
Fuco1Fuco1
committed
feat(core): handle errors from workers
1 parent fc270d2 commit 7216f4b

File tree

1 file changed

+135
-84
lines changed

1 file changed

+135
-84
lines changed

‎elsa.el‎

Lines changed: 135 additions & 84 deletions
Original file line numberDiff line numberDiff line change
@@ -279,97 +279,144 @@ GLOBAL-STATE is the initial configuration."
279279
(concat file " ...")))
280280
(bright-black "(skipped, already loaded)")))))
281281

282+
;; This is heavily inspired by `buttercup--debugger'.
283+
(defun elsa--worker-debugger (&rest args)
284+
"Retrieve the backtrace from the point of error."
285+
(setq num-nonmacro-input-events (1+ num-nonmacro-input-events))
286+
(throw 'elsa-debugger-continue
287+
(list
288+
'failed
289+
(let ((frames nil)
290+
(i 0)
291+
(in-program-stack nil))
292+
(dolist (frame (backtrace-frames))
293+
(when in-program-stack
294+
(push frame frames))
295+
(when (eq (elt frame 1) 'elsa--worker-debugger)
296+
(setq in-program-stack t)))
297+
(mapconcat
298+
;; Frame is EVALD FUNC ARGS FLAGS. Flags is
299+
;; useless so we drop it.
300+
(lambda (frame)
301+
(->>
302+
(if (car frame)
303+
(format " %S%s"
304+
(cadr frame)
305+
(if (nth 2 frame)
306+
(cl-prin1-to-string (nth 2 frame))
307+
"()"))
308+
(format " (%S %s)"
309+
(cadr frame)
310+
(mapconcat
311+
(lambda (x) (format "%S" x))
312+
(nth 2 frame)
313+
" ")))
314+
(replace-regexp-in-string "\n" "\\\\n")
315+
(replace-regexp-in-string "%" "%%")))
316+
(nreverse frames)
317+
"\n")))))
318+
282319
(defun elsa--worker-function-factory (worker-id project-directory)
283320
"Return function running in the Elsa analysis worker."
284321
(let ((load--path load-path))
285322
(lambda ()
286-
(condition-case err
287-
(progn
288-
(setq load-path load--path)
289-
(setq elsa-is-language-server nil)
290-
(setq ansi-inhibit-ansi t)
291-
(require 'elsa)
292-
(require 'async)
293-
(require 'lgr)
294-
(-> (lgr-get-logger "elsa")
295-
(lgr-reset-appenders)
296-
(lgr-add-appender
297-
(-> (elsa-worker-appender)
298-
(lgr-set-layout (elsa-plain-layout))))
299-
(lgr-set-threshold lgr-level-info))
300-
(let ((msg nil)
301-
(lgr (lgr-get-logger "elsa.analyse.worker")))
302-
(setq elsa-global-state (elsa-global-state))
303-
(oset elsa-global-state project-directory project-directory)
304-
(oset elsa-global-state number-of-files 1)
305-
(oset elsa-global-state processed-file-index 1)
306-
(catch 'done
307-
(while t
308-
(setq msg (async-receive))
309-
(let ((op (plist-get msg :op)))
310-
(cond
311-
((equal op "analyze")
312-
(let* ((dep (plist-get msg :dep))
313-
(library (plist-get msg :file))
314-
(current-time (current-time))
315-
(elsa-cache-file (elsa--get-cache-file-name elsa-global-state dep)))
316-
(elsa--autoload-types elsa-global-state dep)
317-
(elsa--autoload-extension elsa-global-state dep)
318-
(lgr-debug lgr "Starting analysis of %s" dep)
319-
(let ((state (elsa-process-file library elsa-global-state)))
320-
;; `subr' has no provide for some circular
321-
;; dependency "bootstrap" issues. We add it here
322-
;; artificially.
323-
(lgr-debug lgr "Analysis of %s done" dep)
324-
(when (equal dep "subr")
325-
(oset state provide (list 'subr)))
326-
(elsa-save-cache state elsa-global-state)
327-
(lgr-debug lgr "Finished saving cache for %s" dep))
328-
(async-send :ack "ok" :op op
329-
:dep dep
330-
:file library
331-
:duration (float-time
332-
(time-subtract
333-
(current-time) current-time)))))
334-
((equal op "load-from-cache")
335-
(let ((files (plist-get msg :files)))
336-
(dolist (file files) (load (f-no-ext file) t t))
337-
(async-send :ack "ok" :op op)))
338-
((equal op "quit")
339-
(throw 'done t))))))))
340-
(error (async-send :ack "error" :error err :trace (progn (require 'backtrace) (backtrace-to-string))))))))
323+
(setq load-path load--path)
324+
(require 'elsa)
325+
(-> (lgr-get-logger "elsa")
326+
(lgr-reset-appenders)
327+
(lgr-add-appender
328+
(-> (elsa-worker-appender)
329+
(lgr-set-layout (lgr-layout-format :format "[%K] %m"))))
330+
(lgr-set-threshold lgr-level-warn))
331+
(let ((result nil))
332+
(let ((lgr (lgr-get-logger "elsa.analyse.worker"))
333+
(msg nil)
334+
;; this debugger stuff is used to reconstruct the
335+
;; backtrace to the point of error
336+
(debugger #'elsa--worker-debugger)
337+
(debug-on-error t))
338+
(setq
339+
result
340+
(catch 'elsa-debugger-continue
341+
(setq elsa-is-language-server nil)
342+
(setq ansi-inhibit-ansi t)
343+
(setq elsa-global-state (elsa-global-state))
344+
(oset elsa-global-state project-directory project-directory)
345+
(oset elsa-global-state number-of-files 1)
346+
(oset elsa-global-state processed-file-index 1)
347+
(catch 'elsa-worker-done
348+
(while t
349+
(setq msg (async-receive))
350+
(let ((op (plist-get msg :op)))
351+
(cond
352+
((equal op "analyze")
353+
(let* ((dep (plist-get msg :dep))
354+
(library (plist-get msg :file))
355+
(current-time (current-time))
356+
(elsa-cache-file (elsa--get-cache-file-name elsa-global-state dep)))
357+
(elsa--autoload-types elsa-global-state dep)
358+
(elsa--autoload-extension elsa-global-state dep)
359+
(lgr-debug lgr "Starting analysis of %s" dep)
360+
(let ((state (elsa-process-file library elsa-global-state)))
361+
;; `subr' has no provide for some circular
362+
;; dependency "bootstrap" issues. We add it here
363+
;; artificially.
364+
(lgr-debug lgr "Analysis of %s done" dep)
365+
(when (equal dep "subr")
366+
(oset state provide (list 'subr)))
367+
(elsa-save-cache state elsa-global-state)
368+
(lgr-debug lgr "Finished saving cache for %s" dep))
369+
(async-send :ack "ok" :op op
370+
:dep dep
371+
:file library
372+
:duration (float-time
373+
(time-subtract
374+
(current-time) current-time)))))
375+
((equal op "load-from-cache")
376+
(let ((files (plist-get msg :files)))
377+
(dolist (file files) (load (f-no-ext file) t t))
378+
(async-send :ack "ok" :op op)))
379+
((equal op "quit")
380+
(lgr-warn lgr "Received signal to quit")
381+
(throw 'elsa-worker-done t)))))))))
382+
(when (and (listp result)
383+
(eq (car result) 'failed))
384+
(async-send :ack "error" :error (cadr result)))
385+
result))))
341386

342387
(defun elsa--parent-function-factory (worker-id workers-state max-file-name-length global-state)
343388
"Function handling child-to-parent messages and worker exit."
344389
(let ((lgr (lgr-get-logger "elsa.analyse.parent")))
345390
(lambda (result)
346-
(if (async-message-p result)
347-
(let* ((worker-state (assoc worker-id workers-state))
348-
(op (plist-get result :op))
349-
(ack (plist-get result :ack)))
350-
(cond
351-
((equal ack "error")
352-
(error "Error in child process %d %s" worker-id (plist-get result :error)))
353-
((equal op "echo")
354-
(elsa-log
355-
(with-ansi
356-
(red "Worker %d said: " worker-id)
357-
(yellow (plist-get result :message)))))
358-
((equal op "analyze")
359-
(let* ((dep (plist-get result :dep))
360-
(file (plist-get result :file))
361-
(duration (plist-get result :duration))
362-
(elsa-cache-file (elsa--get-cache-file-name global-state dep)))
363-
(elsa-log
364-
(elsa--processing-line global-state "done" file worker-id duration))
365-
(load (f-no-ext elsa-cache-file) t t))
366-
(cl-incf (oref global-state processed-file-index))
367-
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))
368-
((equal op "load-from-cache")
369-
(lgr-debug lgr "Worker %s loaded all cache files for this layer" worker-id)
370-
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))))
371-
(lgr-debug lgr "Async process done in worker %d, result: %s" worker-id result)
372-
t))))
391+
(let ((worker-state (assoc worker-id workers-state)))
392+
(if (async-message-p result)
393+
(let* ((op (plist-get result :op))
394+
(ack (plist-get result :ack)))
395+
(cond
396+
((equal ack "error")
397+
(lgr-fatal lgr (plist-get result :error))
398+
(kill-emacs 1))
399+
((equal op "echo")
400+
(lgr-debug lgr
401+
(with-ansi
402+
(red "Worker %d said: " worker-id)
403+
(yellow (plist-get result :message)))))
404+
((equal op "analyze")
405+
(let* ((dep (plist-get result :dep))
406+
(file (plist-get result :file))
407+
(duration (plist-get result :duration))
408+
(elsa-cache-file (elsa--get-cache-file-name global-state dep)))
409+
(elsa-log
410+
(elsa--processing-line global-state "done" file worker-id duration))
411+
(load (f-no-ext elsa-cache-file) t t))
412+
(cl-incf (oref global-state processed-file-index))
413+
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))
414+
((equal op "load-from-cache")
415+
(lgr-debug lgr "Worker %s loaded all cache files for this layer" worker-id)
416+
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t)))))
417+
(lgr-debug lgr "Async process done in worker %d, result: %s" worker-id result)
418+
(setf (cdr worker-state) (plist-put (cdr worker-state) :ready t))
419+
t)))))
373420

374421
(defun elsa--wait-for-all (get-worker-states)
375422
(catch 'all-workers-ready
@@ -473,8 +520,12 @@ used by the LSP server to not reload already processed files."
473520
(elsa--wait-for-all (lambda () workers-state))
474521
(lgr-debug lgr "All workers updated global state for layer %s" i))
475522

476-
(--each workers
477-
(async-send it :op "quit"))
523+
(-each workers-state
524+
(-lambda ((state &as worker-id))
525+
(setf (cdr state) (plist-put (cdr state) :ready nil))
526+
(let ((worker (nth worker-id workers)))
527+
(async-send worker :op "quit"))))
528+
(elsa--wait-for-all (lambda () workers-state))
478529
(lgr-debug lgr "All workers quit")
479530

480531
(let ((start-time (current-time))

0 commit comments

Comments
 (0)