[nongnu] elpa/sweeprolog 3e61fbdd08 09/13: Improve top-level threads management and cleanup

[ELPA Syncer]

branch: elpa/sweeprolog
commit 3e61fbdd08320e0f40e0c9254245765fc263db85
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    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 efffccb597..0ba7b696d7 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 b2fbcd5a61..7b31ab0a62 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)