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,
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)).
:- 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,
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),
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)]),
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) :-
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_(_, _).
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).
),
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)).
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.
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.
(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
(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
(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)))
(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"
(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)
(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)
projects / sweep.git / commitdiff