From 3e61fbdd08320e0f40e0c9254245765fc263db85 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sat, 16 Sep 2023 20:50:47 +0200 Subject: [PATCH] Improve top-level threads management and cleanup * sweep.pl (sweep_top_level_thread_buffer/2): Remove predicate. (sweep_top_level_threads/2): Remove in favor of... (sweep_list_threads/2): New predicate. (sweep_accept_top_level_client/2) (sweep_top_level_start_pty/2): Return new thread id. (sweep_cleanup_threads/0,2) (sweep_create_thread/2,3) (sweep_thread_start/0) (sweep_thread_at_exit/0) (sweep_supervisor_start/1) (sweep_supervisor_loop/1) (sweep_kill_thread/2) (sweep_cleanup_thread/1): New predicates. * sweeprolog.el (sweeprolog-init): Arrange for Sweep to shutdown gracefully when Emacs is killed. (sweeprolog-maybe-kill-top-levels) (sweeprolog-maybe-shutdown) (sweeprolog-shutdown) (sweeprolog-top-level-maybe-delete-process) (sweeprolog-top-level-delete-process): New functions. (sweeprolog-restart) (sweeprolog-top-level-buffer): Adapt. (sweeprolog-top-level--populate-thread-id): Remove function. --- sweep.pl | 149 ++++++++++++++++++++++++++++++-------------- sweeprolog.el | 169 ++++++++++++++++++++++++++++++++------------------ 2 files changed, 211 insertions(+), 107 deletions(-) diff --git a/sweep.pl b/sweep.pl index efffccb..0ba7b69 100644 --- a/sweep.pl +++ b/sweep.pl @@ -52,7 +52,6 @@ sweep_module_path/2, sweep_thread_signal/2, sweep_top_level_server/2, - sweep_top_level_threads/2, sweep_accept_top_level_client/2, sweep_local_predicate_export_comment/2, write_sweep_module_location/0, @@ -96,7 +95,10 @@ sweep_compound_functors_collection/2, sweep_term_variable_names/2, sweep_goal_may_cut/2, - sweep_top_level_start_pty/2 + sweep_top_level_start_pty/2, + sweep_cleanup_threads/2, + sweep_kill_thread/2, + sweep_list_threads/2 ]). :- use_module(library(pldoc)). @@ -126,8 +128,7 @@ :- meta_predicate with_buffer_stream(-, +, 0). -:- dynamic sweep_top_level_thread_buffer/2, - sweep_open_buffer/3, +:- dynamic sweep_open_buffer/3, sweep_current_comment/3. :- multifile prolog:xref_source_time/2, @@ -164,9 +165,9 @@ prolog:xref_close_source(Source, Stream) :- close(Stream), free_memory_file(H). -sweep_top_level_threads(_, Ts) :- +sweep_list_threads(IdBufferPairs, Ts) :- findall([Id, Buffer, Status, Stack, CPUTime], - ( sweep_top_level_thread_buffer(Id, Buffer), + ( member([Buffer|Id], IdBufferPairs), thread_property(Id, status(Status0)), term_string(Status0, Status), thread_statistics(Id, stack, Stack), @@ -773,10 +774,9 @@ write_sweep_module_location :- format('M ~w~n', Path). :- endif. -sweep_top_level_start_pty([Name|Buffer], _) :- - thread_create(sweep_top_level_pty_client(Name), T, [detached(true)]), - thread_property(T, id(Id)), - asserta(sweep_top_level_thread_buffer(Id, Buffer)). +sweep_top_level_start_pty(Name, Id) :- + sweep_create_thread(sweep_top_level_pty_client(Name), T), + thread_property(T, id(Id)). sweep_top_level_pty_client(Name) :- open(Name, read, InStream, [eof_action(reset)]), @@ -789,15 +789,9 @@ sweep_top_level_server(_, Port) :- tcp_bind(ServerSocket, Port), tcp_listen(ServerSocket, 5), thread_self(Self), - thread_create(sweep_top_level_server_start(Self, ServerSocket), T, + sweep_create_thread(sweep_top_level_server_start(Self, ServerSocket), _, [ alias(sweep_top_level_server) ]), - at_halt(( is_thread(T), - thread_property(T, status(running)) - -> thread_signal(T, thread_exit(0)), - thread_join(T, _) - ; true - )), thread_get_message(sweep_top_level_server_started). sweep_top_level_server_start(Caller, ServerSocket) :- @@ -808,15 +802,15 @@ sweep_top_level_server_loop(ServerSocket) :- thread_get_message(Message), sweep_top_level_server_loop_(Message, ServerSocket). -sweep_top_level_server_loop_(accept(Buffer), ServerSocket) :- +sweep_top_level_server_loop_(accept(From), ServerSocket) :- !, tcp_accept(ServerSocket, Slave, Peer), tcp_open_socket(Slave, InStream, OutStream), set_stream(InStream, close_on_abort(false)), set_stream(OutStream, close_on_abort(false)), - thread_create(sweep_top_level_client(InStream, OutStream, Peer), T, [detached(true)]), + sweep_create_thread(sweep_top_level_client(InStream, OutStream, Peer), T), thread_property(T, id(Id)), - asserta(sweep_top_level_thread_buffer(Id, Buffer)), + thread_send_message(From, client(Id)), sweep_top_level_server_loop(ServerSocket). sweep_top_level_server_loop_(_, _). @@ -832,29 +826,23 @@ sweep_top_level_client(InStream, OutStream, ip(127,0,0,1)) :- set_stream(user_input, newline(detect)), set_stream(user_output, newline(dos)), set_stream(user_error, newline(dos)), - thread_self(Self), - thread_property(Self, id(Id)), - thread_at_exit(retractall(sweep_top_level_thread_buffer(Id, _))), - call_cleanup(prolog, - ( close(InStream, [force(true)]), - close(OutStream, [force(true)]) - )). + thread_at_exit(( catch(format("~nSweep top-level thread exited~n"), + _, true), + close(InStream, [force(true)]), + close(OutStream, [force(true)]) + )), + prolog. sweep_top_level_client(InStream, OutStream, _) :- close(InStream), - close(OutStream), - thread_self(Self), - thread_property(Self, id(Id)), - retractall(sweep_top_level_thread_buffer(Id, _)). + close(OutStream). -%! sweep_accept_top_level_client(+Buffer, -Result) is det. -% -% Signal the top-level server thread to accept a new TCP connection -% from buffer Buffer. - -sweep_accept_top_level_client(Buffer, _) :- - thread_send_message(sweep_top_level_server, accept(Buffer)). +sweep_accept_top_level_client(_, Id) :- + thread_self(S), + thread_send_message(sweep_top_level_server, accept(S)), + thread_get_message(client(Id)). sweep_thread_signal([ThreadId|Goal0], _) :- + is_thread(ThreadId), term_string(Goal, Goal0), thread_signal(ThreadId, Goal). @@ -1345,18 +1333,87 @@ sweep_predicate_dependencies([To0|From0], Deps) :- ), Deps). +sweep_cleanup_threads(_,_) :- + sweep_cleanup_threads. + +sweep_cleanup_threads :- + is_thread(sweep_supervisor), + !, + thread_send_message(sweep_supervisor, cleanup), + thread_join(sweep_supervisor, _). +sweep_cleanup_threads. + +:- meta_predicate sweep_create_thread(0, -). +:- meta_predicate sweep_create_thread(0, -, +). + +sweep_create_thread(Goal, T) :- + sweep_create_thread(Goal, T, []). + +sweep_create_thread(Goal, T, Options) :- + ( is_thread(sweep_supervisor) + -> true + ; thread_self(S), + thread_create(sweep_supervisor_start(S), _, [alias(sweep_supervisor)]), + thread_get_message(sweep_supervisor_started) + ), + thread_create((sweep_thread_start, Goal), T, + [at_exit(sweep_thread_at_exit)|Options]). + +sweep_thread_start :- + thread_self(T), + thread_send_message(sweep_supervisor, new(T)). + +sweep_thread_at_exit :- + ( is_thread(sweep_supervisor) + -> thread_self(T), + catch(thread_send_message(sweep_supervisor, exit(T)), _, true) + ; true + ). + +sweep_supervisor_start(Caller) :- + thread_send_message(Caller, sweep_supervisor_started), + sweep_supervisor_loop([]). + +sweep_supervisor_loop(Threads) :- + thread_get_message(Message), + sweep_supervisor_loop_(Message, Threads). + +sweep_supervisor_loop_(cleanup, Ts) => + maplist(cleanup_thread, Ts). +sweep_supervisor_loop_(new(T), Ts) => + sweep_supervisor_loop([T|Ts]). +sweep_supervisor_loop_(exit(T), Ts0) => + cleanup_thread(T), + select(T, Ts0, Ts), + sweep_supervisor_loop(Ts). +sweep_supervisor_loop_(_, Ts) => + sweep_supervisor_loop(Ts). + +sweep_kill_thread(T, _) :- + cleanup_thread(T). + +cleanup_thread(T) :- + is_thread(T), + !, + catch(cleanup_thread_(T), _, true). +cleanup_thread(_). + +cleanup_thread_(T) :- + thread_property(T, detached(false)), + !, + thread_detach(T), + ( thread_property(T, status(running)) + -> thread_signal(T, thread_exit(0)) + ; true + ). +cleanup_thread_(T) :- + thread_signal(T, thread_exit(0)). + sweep_async_goal([GoalString|FD], TId) :- term_string(Goal, GoalString), random_between(1, 1024, Cookie), thread_self(Self), - thread_create(sweep_start_async_goal(Self, Cookie, Goal, FD), T, - [detached(true)]), - at_halt(( is_thread(T), - thread_property(T, status(running)) - -> thread_signal(T, thread_exit(0)), - thread_join(T, _) - ; true - )), + sweep_create_thread(sweep_start_async_goal(Self, Cookie, Goal, FD), T), thread_get_message(sweep_async_goal_started(Cookie)), thread_property(T, id(TId)). diff --git a/sweeprolog.el b/sweeprolog.el index b2fbcd5..7b31ab0 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -705,14 +705,44 @@ pack completion candidates." If specified, ARGS should be a list of string passed to Prolog as extra initialization arguments." (unless sweeprolog--initialized + (message "Starting Sweep.") (apply #'sweeprolog-initialize (cons (or sweeprolog-swipl-path (executable-find "swipl")) (append sweeprolog-init-args (append sweeprolog--extra-init-args args)))) (setq sweeprolog--initialized t) + (add-hook 'kill-emacs-query-functions #'sweeprolog-maybe-kill-top-levels) + (add-hook 'kill-emacs-hook #'sweeprolog-shutdown) (sweeprolog-setup-message-hook))) +(defun sweeprolog-maybe-kill-top-levels () + (let ((top-levels (seq-filter (lambda (buffer) + (with-current-buffer buffer + (and (derived-mode-p 'sweeprolog-top-level-mode) + sweeprolog-top-level-thread-id))) + (buffer-list)))) + (or (not top-levels) + (and (let ((num (length top-levels))) + (y-or-n-p (if (< 1 num) + (format "Stop %d running Sweep top-levels?" num) + "Stop running Sweep top-level?"))) + (prog1 t + (dolist (buffer top-levels) + (sweeprolog-top-level-delete-process buffer))))))) + +(defun sweeprolog-shutdown () + (message "Stopping Sweep.") + (sweeprolog--query-once "sweep" "sweep_cleanup_threads" nil) + (sweeprolog-cleanup) + (setq sweeprolog--initialized nil + sweeprolog-prolog-server-port nil)) + +(defun sweeprolog-maybe-shutdown () + (when (sweeprolog-maybe-kill-top-levels) + (sweeprolog-shutdown) + t)) + (defun sweeprolog-restart (&rest args) "Restart the embedded Prolog runtime. @@ -727,22 +757,11 @@ Otherwise set ARGS to nil." current-prefix-arg (fboundp 'split-string-shell-command) (split-string-shell-command (read-string "swipl arguments: ")))) - (when-let ((top-levels (seq-filter (lambda (buffer) - (with-current-buffer buffer - (derived-mode-p 'sweeprolog-top-level-mode))) - (buffer-list)))) - (if (y-or-n-p "Stop running sweep top-level processes?") - (dolist (buffer top-levels) - (let ((process (get-buffer-process buffer))) - (when (process-live-p process) - (delete-process process)))) - (user-error "Cannot restart sweep with running top-level processes"))) - (message "Stoping sweep.") - (sweeprolog-cleanup) - (setq sweeprolog--initialized nil - sweeprolog-prolog-server-port nil) - (message "Starting sweep.") - (apply #'sweeprolog-init args)) + (if (sweeprolog-maybe-shutdown) + (progn + (sit-for 1) + (apply #'sweeprolog-init args)) + (user-error "Cannot restart Sweep with running top-levels"))) (defun sweeprolog--open-query (ctx mod fun arg &optional rev) "Ensure that Prolog is initialized and execute a new query. @@ -3113,6 +3132,26 @@ function with PROC and MSG." (comint-write-input-ring) (internal-default-process-sentinel proc msg)) +(defun sweeprolog-top-level-maybe-delete-process () + (let ((process (get-buffer-process (current-buffer)))) + (or (not process) + (not (memq (process-status process) '(run stop open listen))) + (and (yes-or-no-p + (format "Buffer %S has a running top-level; kill it? " + (buffer-name (current-buffer)))) + (prog1 t + (sweeprolog-top-level-delete-process)))))) + +(defun sweeprolog-top-level-delete-process (&optional buffer) + (setq buffer (or buffer (current-buffer))) + (when sweeprolog-top-level-thread-id + (sweeprolog--query-once "sweep" "sweep_kill_thread" + sweeprolog-top-level-thread-id)) + (when-let ((process (get-buffer-process buffer))) + (process-send-eof process) + (delete-process process)) + (setq sweeprolog-top-level-thread-id nil)) + (defun sweeprolog-top-level-setup-history (buf) "Setup `comint-input-ring-file-name' for top-level buffer BUF." (with-current-buffer buf @@ -3149,27 +3188,47 @@ top-level." (unless (process-live-p (get-buffer-process buf)) (with-current-buffer buf (unless (derived-mode-p 'sweeprolog-top-level-mode) - (sweeprolog-top-level-mode))) - (if sweeprolog-top-level-use-pty - (progn - (make-comint-in-buffer "sweeprolog-top-level" buf nil) - (process-send-eof (get-buffer-process buf)) - (sweeprolog--query-once "sweep" "sweep_top_level_start_pty" - (cons (process-tty-name - (get-buffer-process buf)) - (buffer-name buf)))) - (unless sweeprolog-prolog-server-port - (sweeprolog-start-prolog-server)) - (sweeprolog--query-once "sweep" "sweep_accept_top_level_client" - (buffer-name buf)) - (make-comint-in-buffer "sweeprolog-top-level" - buf - (cons "localhost" - sweeprolog-prolog-server-port))) - (unless comint-last-prompt - (accept-process-output (get-buffer-process buf) 1)) - (sweeprolog-top-level-setup-history buf) - (sweeprolog-top-level--populate-thread-id)) + (sweeprolog-top-level-mode)) + (setq sweeprolog-top-level-thread-id + (if sweeprolog-top-level-use-pty + (progn + (make-comint-in-buffer "sweeprolog-top-level" buf nil) + (process-send-eof (get-buffer-process buf)) + (sweeprolog--query-once "sweep" "sweep_top_level_start_pty" + (process-tty-name (get-buffer-process buf)))) + (unless sweeprolog-prolog-server-port + (sweeprolog-start-prolog-server)) + (make-comint-in-buffer "sweeprolog-top-level" + buf + (cons "localhost" + sweeprolog-prolog-server-port)) + (sweeprolog--query-once "sweep" "sweep_accept_top_level_client" nil))) + ;; (sweeprolog-top-level-setup-history buf) + (let ((proc (get-buffer-process buf))) + (set-process-filter proc + (lambda (process string) + (comint-output-filter process string) + (when (string-match (rx "Sweep top-level thread exited") string) + (delete-process process) + (setq sweeprolog-top-level-thread-id nil)))) + (unless comint-last-prompt buf (accept-process-output proc 1)) + (set-process-query-on-exit-flag proc nil) + (setq-local comint-input-ring-file-name + (pcase sweeprolog-top-level-persistent-history + ((pred stringp) + sweeprolog-top-level-persistent-history) + ((pred functionp) + (funcall sweeprolog-top-level-persistent-history)) + (`(project . ,rel-def) + (if-let ((project (project-current))) + (expand-file-name (car rel-def) + (project-root project)) + (cadr rel-def))))) + (comint-read-input-ring t) + (set-process-sentinel proc #'sweeprolog-top-level-sentinel) + (add-hook 'kill-buffer-hook #'comint-write-input-ring nil t) + (add-hook 'kill-buffer-query-functions #'sweeprolog-top-level-maybe-delete-process nil t) + ))) buf)) ;;;###autoload @@ -3227,11 +3286,6 @@ appropriate buffer." (not (string= "| " prompt))) (comint-send-input))))) -(defun sweeprolog-top-level--populate-thread-id () - (setq sweeprolog-top-level-thread-id - (sweeprolog--query-once "sweep" "sweep_top_level_thread_buffer" - (buffer-name) t))) - (defun sweeprolog-signal-thread (tid goal) (sweeprolog--query-once "sweep" "sweep_thread_signal" (cons tid goal))) @@ -3260,23 +3314,7 @@ GOAL. Otherwise, GOAL is set to a default value specified by (read-string "Signal goal: ?- " nil 'sweeprolog-top-level-signal-goal-history) sweeprolog-top-level-signal-default-goal))) - (unless sweeprolog-top-level-thread-id - (sweeprolog-top-level--populate-thread-id)) - (when (and (or (not sweeprolog-top-level-thread-id) - (eq (condition-case error - (sweeprolog-signal-thread sweeprolog-top-level-thread-id goal) - (prolog-exception - (pcase error - (`(prolog-exception - compound "error" - (compound "existence_error" (atom . "thread") ,_) - . - ,_) - 'no-thread)))) - 'no-thread)) - sweeprolog-top-level-use-pty) - (delete-process (get-buffer-process - (current-buffer))))) + (sweeprolog-signal-thread sweeprolog-top-level-thread-id goal)) ;;;###autoload (define-derived-mode sweeprolog-top-level-mode comint-mode "Sweep Top-level" @@ -5068,7 +5106,16 @@ accordingly." (sz (number-to-string (nth 3 th))) (ct (number-to-string (nth 4 th)))) (list id (vector bn st sz ct)))) - (sweeprolog--query-once "sweep" "sweep_top_level_threads" nil))) + (sweeprolog--query-once + "sweep" "sweep_list_threads" + (delq nil + (mapcar (lambda (buffer) + (when-let + ((thread + (buffer-local-value 'sweeprolog-top-level-thread-id + buffer))) + (cons (buffer-name buffer) thread))) + (buffer-list)))))) (defun sweeprolog-top-level-menu--refresh () (tabulated-list-init-header) @@ -6827,7 +6874,7 @@ as a comment in the source location where you invoked (goto-char marker) (insert example) (comment-region marker (point)))) - (delete-process (get-buffer-process top-level-buffer)) + (sweeprolog-top-level-delete-process top-level-buffer) (kill-buffer top-level-buffer)))) (defun sweeprolog-make-example-usage-comment (point) -- 2.39.5