From: Eshel Yaron <me@eshelyaron.com>
Date: Tue, 4 Oct 2022 09:33:08 +0000 (+0300)
Subject: ADDED: new command for signaling Prolog top-level threads
X-Git-Tag: v0.5.0~6
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=77846f044122520f4e6c97fd8c48294280e71311;p=sweep.git

ADDED: new command for signaling Prolog top-level threads

* sweep.pl: sweep_thread_signal/2: new predicate.

* sweeprolog.el:
- sweeprolog-signal-thread: new function, Elisp interface for
sweep_thread_signal/2.
- sweeprolog-top-level-thread-id: new buffer-local variable in
sweeprolog-top-level buffers.
- sweeprolog-top-level-signal: new command.
- sweeprolog-top-level-mode: signal top-level thread with
thread_exit/1 when buffer is killed.
---

diff --git a/sweep.pl b/sweep.pl
index b119f9c..4a1d376 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -56,6 +56,7 @@
             sweep_op_info/2,
             sweep_imenu_index/2,
             sweep_module_path/2,
+            sweep_thread_signal/2,
             sweep_top_level_server/2,
             sweep_top_level_threads/2,
             sweep_accept_top_level_client/2,
@@ -842,5 +843,14 @@ sweep_top_level_client(InStream, OutStream, _) :-
     thread_property(Self, id(Id)),
     retractall(sweep_top_level_thread_buffer(Id, _)).
 
+%!  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_thread_signal([ThreadId|Goal0], _) :-
+    term_string(Goal, Goal0),
+    thread_signal(ThreadId, Goal).
diff --git a/sweeprolog.el b/sweeprolog.el
index c6c1cb4..bd9a9b7 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -1541,6 +1541,45 @@ Interactively, a prefix arg means to prompt for BUFFER."
         (comint-send-input)))))
 
 (defvar-local sweeprolog-top-level-timer nil "Buffer-local timer.")
+(defvar-local sweeprolog-top-level-thread-id nil
+  "Prolog top-level thread ID corresponding to this buffer.")
+
+(defun sweeprolog-top-level--populate-thread-id ()
+  (sweeprolog-open-query "user"
+                         "sweep"
+                         "sweep_top_level_thread_buffer"
+                         (buffer-name)
+                         t)
+  (let ((sol (sweeprolog-next-solution)))
+    (sweeprolog-close-query)
+    (when (sweeprolog-true-p sol)
+      (setq sweeprolog-top-level-thread-id (cdr sol)))))
+
+(defun sweeprolog-signal-thread (tid goal)
+  (sweeprolog-open-query "user"
+                         "sweep"
+                         "sweep_thread_signal"
+                         (cons tid goal))
+  (let ((sol (sweeprolog-next-solution)))
+    (sweeprolog-close-query)
+    sol))
+
+(defun sweeprolog-top-level-signal (buffer goal)
+  "Signal the top-level thread corresponding to BUFFER to run GOAL."
+  (interactive
+   (list (read-buffer "Top-level buffer: "
+                      nil t
+                      (lambda (b)
+                        (let ((bb (or (and (consp b) (car b)) b)))
+                          (with-current-buffer bb
+                            (and (derived-mode-p 'sweeprolog-top-level-mode)
+                                 sweeprolog-top-level-thread-id)))
+                        (eq 'sweeprolog-top-level-mode
+                            (buffer-local-value 'major-mode b))))
+         (read-string "Signal goal: ?- ")))
+  (sweeprolog-signal-thread (buffer-local-value 'sweeprolog-top-level-thread-id
+                                                buffer)
+                            goal))
 
 ;;;###autoload
 (define-derived-mode sweeprolog-top-level-mode comint-mode "sweep Top-level"
@@ -1554,14 +1593,21 @@ Interactively, a prefix arg means to prompt for BUFFER."
                                                   (length s)))
               comint-delimiter-argument-list '(?,)
               comment-start "%")
+  (add-hook 'comint-exec-hook #'sweeprolog-top-level--populate-thread-id nil t)
   (add-hook 'post-self-insert-hook #'sweeprolog-top-level--post-self-insert-function nil t)
   (setq sweeprolog-buffer-module "user")
   (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point-function nil t)
   (setq sweeprolog-top-level-timer (run-with-idle-timer 0.2 t #'sweeprolog-colourise-query (current-buffer)))
+  (add-hook 'kill-buffer-hook
+            (lambda ()
+              (sweeprolog-top-level-signal (current-buffer)
+                                           "thread_exit(0)"))
+            nil t)
   (add-hook 'kill-buffer-hook
             (lambda ()
               (when (timerp sweeprolog-top-level-timer)
-                (cancel-timer sweeprolog-top-level-timer)))))
+                (cancel-timer sweeprolog-top-level-timer)))
+            nil t))
 
 (sweeprolog--ensure-module)
 (when sweeprolog-init-on-load (sweeprolog-init))