From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Stefan Monnier Newsgroups: gmane.emacs.devel Subject: Re: emacs-29 8bf4cdcf79: Avoid recursive process filters in lisp/jsonrpc.el (bug#60088) Date: Sun, 18 Dec 2022 09:32:12 -0500 Message-ID: References: <167118072395.30479.8819833637573037468@vcs2.savannah.gnu.org> <20221216085204.43B07C04961@vcs2.savannah.gnu.org> <87h6xufv4v.fsf@neverwas.me> <877cypbth9.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="6386"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: "F. Jason Park" , emacs-devel@gnu.org To: =?windows-1252?B?Sm/jbyBU4XZvcmE=?= Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Sun Dec 18 15:32:59 2022 Return-path: Envelope-to: ged-emacs-devel@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1p6uin-0001N9-Om for ged-emacs-devel@m.gmane-mx.org; Sun, 18 Dec 2022 15:32:58 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1p6uiE-00023O-HL; Sun, 18 Dec 2022 09:32:22 -0500 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1p6uiC-00022v-BX for emacs-devel@gnu.org; Sun, 18 Dec 2022 09:32:20 -0500 Original-Received: from mailscanner.iro.umontreal.ca ([132.204.25.50]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1p6uiA-0008TZ-9j for emacs-devel@gnu.org; Sun, 18 Dec 2022 09:32:20 -0500 Original-Received: from pmg2.iro.umontreal.ca (localhost.localdomain [127.0.0.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 74DF7808D4; Sun, 18 Dec 2022 09:32:15 -0500 (EST) Original-Received: from mail01.iro.umontreal.ca (unknown [172.31.2.1]) by pmg2.iro.umontreal.ca (Proxmox) with ESMTP id 6F0B68087E; Sun, 18 Dec 2022 09:32:13 -0500 (EST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=iro.umontreal.ca; s=mail; t=1671373933; bh=L+waZyOUpuIgD0ID5qAYztH1Ak/SOVEWoRpjrzW52AU=; h=From:To:Cc:Subject:In-Reply-To:References:Date:From; b=H83tmhK5xmU/Qr6mME+TNautCKFbjeBJZ2oCnb2gJkHEZWFMndW1c1J3Vo09YDn5c mvoqE5XGqRj7I4RtLuQcJl9l8Su9PUNT3sINV6pZJmI5wQCwLOLdrfKkq/1ddhMu7L kvd66ieeskwO63u9rK1mOHXHTzlyrYhSu3TZj3PnJkwVWAvMukF7J6xn7FP9fa+rMU uipvsXBgxhirDbXjOrxKWCcIcswaqBrr3nfW3BujHM0Vf2OaJs2YfnFAxzk9LDKuwl oWhtHEzWgTIGlwqOJ4rlbzDDUNdG4VLnms6t+JxgHDDVb8IrjZFqtGfmlINDHImYzh 0bUH29ofsQInA== Original-Received: from pastel (unknown [45.72.200.228]) by mail01.iro.umontreal.ca (Postfix) with ESMTPSA id 31474120306; Sun, 18 Dec 2022 09:32:13 -0500 (EST) In-Reply-To: (=?windows-1252?Q?=22Jo=E3o_T=E1vora=22's?= message of "Sun, 18 Dec 2022 04:08:42 +0000") Received-SPF: pass client-ip=132.204.25.50; envelope-from=monnier@iro.umontreal.ca; helo=mailscanner.iro.umontreal.ca X-Spam_score_int: -42 X-Spam_score: -4.3 X-Spam_bar: ---- X-Spam_report: (-4.3 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, RCVD_IN_DNSWL_MED=-2.3, SPF_HELO_NONE=0.001, SPF_PASS=-0.001 autolearn=ham autolearn_force=no X-Spam_action: no action X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Original-Sender: emacs-devel-bounces+ged-emacs-devel=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.devel:301610 Archived-At: --=-=-= Content-Type: text/plain > Yes, it's process-send-string. I talked earlier about how I think > sit-for and accept-process-output are two primitives that could just > error when called from within a process filter, because there's no > possible reasonable use for them, because they lead to recursive > filters and recursive filters are arguably "unreasonable". I agree with the sentiment, but it's not realistic given the amount of existing code which does that, I think (and the amount of work to fix them). We could have maybe warnings or somesuch to detect those places and start fixing them, but I think we also need to up our game in terms of the infrastucture we provide to help write "correct" async code (see `futur.el` below which exposes my current ideas). > But process-send-string (without output-acceptance) in a filter > makes sense. You mean "non-blocking"? Yes, we need a non-blocking variant of `process-send-string`. > I agree, but process-send-string is never blocking, is it? It is, currently (which is why it can accept process output in the mean time). > And anyway if we go your 'spawn' or 'run-asap' way, we don't need to > change process-send-string's output-acceptance semantics at all. We do, because when that timer triggers, your Emacs will be unresponsive while `process-send-string` is running (which can take arbitrarily long if the process is busy doing other things than reading our string). Stefan --=-=-= Content-Type: application/emacs-lisp Content-Disposition: attachment; filename=futur.el Content-Transfer-Encoding: quoted-printable ;;; futur.el --- Future/promise-based async library -*- lexical-binding: t= ; -*- ;; Copyright (C) 2022 Stefan Monnier ;; Author: Stefan Monnier ;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;; A library to try and make async programming a bit easier. ;; This is inspired from Javscript's async/await, Haskell's monads, ;; and ConcurrentML's events. ;; You can create trivial futures with `futur-pure'. ;; You can create a "process future" with `futur-process-make'. ;; And the main way to use futures is to compose them with `futur-let*', ;; which can be used as follows: ;; (futur-let* ;; ((cmd (build-arg-list)) ;; (exitcode <- (futur-process-make :command cmd :buffer t)) ;; (out (buffer-string)) ;; Get the process's output. ;; (cmd2 (build-second-arg-list exitcode out)) ;; (otherexit <- (futur-process-make :command cmd :buffer t))) ;; (futur-pure (buffer-string))) ;; This example builds a future which runs two commands in sequence. ;; For those rare cases where you really do want to block everything ;; else and wait for a future to complete, you can use`futur-get'. ;; New kinds of futures can be constructed from: ;; - `futur-waiting' to create the actual future. ;; - `futur-deliver' to deliver the value to the future created earlier ;; with `futur-waiting'. ;;; Code: ;; TODO: ;; - Handle exceptions. (require 'cl-lib) ;;;; The `futur' data structure (cl-defstruct (futur (:conc-name futur--) (:predicate futur--p) (:constructor nil) (:constructor futur--pure (value &aux (clients 't))) (:constructor futur--waiting (&optional value))) "A promise/future. A future has 3 states: - Done: in that state, `clients' is `t', and `value' holds the result. - Error: in that state, `clients' is `error', and `value' holds the error. - Waiting: in that state, `clients' is a list of \"callbacks\" waiting for the value or the error, and `value' holds the object that will deliver the value (can be another future, a process, a thread, a list (of futures), or possibly other objects with a `futur-wait' method)." (clients nil) (value nil)) (defun futur--waiting-p (futur) (listp (futur--clients futur))) (defun futur-deliver (futur val) (cl-assert (futur--waiting-p futur)) (setf (futur--value futur) val) ;; Don't run the clients directly from here, so we don't nest. (let ((args (list val))) (dolist (client (prog1 (futur--clients futur) (setf (futur--clients futur) t))) (funcall-later client args)))) (defun futur-fail (futur error) (cl-assert (futur--waiting-p futur)) (setf (futur--value futur) error) ;; Don't run the clients directly from here, so we don't nest. ;; FIXME: Don't run them the same way we run them when we deliver! (let ((args (list error))) (dolist (client (prog1 (futur--clients futur) (setf (futur--clients futur) t))) (funcall-later client args)))) (defun futur-pure (val) "Build a trivial future which returns VAL." (futur--pure val)) (defun futur-new (builder) "Build a future. BUILDER is a function that will be called with one argument \(the new `futur' object, not yet fully initialized) and it should return the object on which the future is waiting. The code creating this future needs to call `futur-deliver' when the object has done the needed work. The object can be any object for which there is a `futur-wait' method." (let ((f (futur--waiting)) (x (funcall builder f))) (cl-assert (futur--waiting-p f)) (cl-assert (not (futur--value f))) (setf (futur--value f) x) f)) ;;;; Composing futures (defun futur--bind (futur fun) "Compose FUTUR with FUN. Calls FUN with FUTUR's value when it becomes available, and throws away its return value." (if (not (futur--waiting-p futur)) (funcall fun (futur--value futur)) (push fun (futur--clients futur))) nil) (defun futur--join (oldpro newpro) (cl-assert (futur--waiting-p oldpro)) (setf (futur--value oldpro) newpro) ;Update the object we're waiting for. (futur--bind newpro (lambda (val) (futur-deliver oldpro val)))) (defun futur-bind (futur fun) "Build a new future by composition. FUN will be called with the return value of FUTUR and should return a new future." (if (not (futur--waiting-p futur)) (funcall fun (futur--value futur)) (let ((new (futur--waiting futur))) (push (lambda (val) (if (futur--p val) ;; FIXME: During the execution of FUN, `new' says it's ;; waiting for `futur', yet `futur' is already done! (futur--join new (funcall fun val)) (futur-deliver new val))) (futur--clients futur)) new))) (defun futur-get (futur) "Wait for FUTUR to deliver and then return its value." (futur-wait futur) (cl-assert (not (futur--waiting-p futur))) (futur--value futur)) (cl-defgeneric futur-wait (object &optional futur) "Wait for OBJECT to deliver. OBJECT is an object for which FUTUR is waiting.") (cl-defmethod futur-wait ((futur futur) &optional _) (let (object) ;; Loops since the object may change, e.g. in `futur-bind' we first ;; wait for one future and then for another. (while (and (futur--waiting-p futur) (not (eq object (setq object (futur--value futur))))) (futur-wait object futur))) (cl-assert (not (futur--waiting-p futur)))) (cl-defmethod futur-wait :before (o &optional f) (cl-assert (futur--p (or f o)) nil "%S %S" o f) (cl-assert (futur--waiting-p (or f o)))) (cl-defmethod futur-wait :after (o &optional f) (cl-assert (not (futur--waiting-p (or f o))))) (define-error 'futur-aborted "Future aborted") (cl-defgeneric futur-abort (futur &optional error) "Abort processing of FUTUR and all of its clients. If it had not been computed yet, then make it fail with ERROR.") (cl-defmethod futur-abort ((futur futur) &optional error) (if (not (futur--waiting-p futur)) () ;; Do nothing. (futur-abort (futur--value futur) error))) (defmacro futur-let* (bindings &rest body) "Sequence asynchronous operations via futures. BINDINGS can contain the usual (VAR EXP) bindings of `let*' but also \(VAR <- EXP) bindings where EXP should return a future, in which case the rest of the code is executed only once the future terminates, binding the result in VAR. BODY is executed at the very end and should return a future." (declare (indent 1) (debug ((&rest (sexp . [&or ("<-" form) (form)])) bod= y))) (cl-assert lexical-binding) ;; FIXME: Should we allow pcase patterns in the bindings, like `pcase-let= *'? (pcase-exhaustive bindings ('() (macroexp-progn body)) (`((,var ,exp) . ,bindings) `(let ((,var ,exp)) (futur-let* ,bindings ,@body))) (`((,var <- ,exp) . ,bindings) `(futur-bind ,exp (lambda (,var) (futur-let* ,bindings ,@body)))))) ;;;; Processes (defun futur--process-sentinel (proc futur) (when (memq (process-status proc) '(exit signal closed failed)) (futur-deliver futur (process-exit-status proc)))) (defun futur-process-make (&rest args) "Create a process and return a future that delivers its exit code. The ARGS are like those of `make-process' except that they can't include `:sentinel' because that is used internally." (futur-new (lambda (f) (apply #'make-process :sentinel (lambda (proc _state) (futur--process-sentinel proc f)) args)))) (defun futur-process-exit-status (proc) "Create a future that returns the exit code of the process PROC." (if (memq (process-status proc) '(exit signal closed failed)) (futur-pure (process-exit-status proc)) (futur-new (lambda (f) ;; FIXME: If the process's sentinel signals an error, it won't run u= s :-( (add-function :after (process-sentinel proc) (lambda (proc _state) (futur--process-sentinel proc f))) proc)))) (cl-defmethod futur-wait ((proc process) &optional futur) (while (and (futur--waiting-p futur) (accept-process-output proc 1.0)) (sit-for 0))) ;; Just redisplay every 1s if needed. (cl-defmethod futur-abort ((proc process)) (let ((futur (process-get proc 'futur))) (delete-process proc) (setf (futur--clients futur) t))) (defun future-process-send (proc string) ;; FIXME: This is quite inefficient. Our C code should instead provide ;; a non-blocking `(process-send-string PROC STRING CALLBACK)'. (futur-new (lambda (f) (make-thread (lambda () (futur-deliver f (process-send-string proc string))))= ))) (cl-defmethod futur-wait ((th thread) &optional _futur) (thread-join th)) (cl-defmethod futur-abort ((th thread) &optional futur) ;; FIXME: This doesn't guarantee that the thread is aborted. (thread-signal th 'error "Abort future") (setf (futur--clients futur) t)) ;;;; Multi futures: Futures that are waiting for several other futures. (defun futur-multi-bind (futurs fun) "Build a new future by composition. FUTURS is a list of `futur's. FUN will be called with the return values of FUTURS (one argument per future) and should return a new future." (if (null futurs) (funcall fun) (let* ((new (futur--waiting futurs)) (count (length futurs)) (args (make-list count nil)) (i 0)) (dolist (futur futurs) (futur--bind futur (let ((cell (nthcdr i args))) (lambda (val) (cl-assert (null (car cell))) (setf (car cell) val) (setq count (1- count)) (when (zerop count) (futur--join new (apply fun args)))))) (setq i (1+ i))) new))) (cl-defmethod futur-wait ((futurs cons) &optional _) (mapc #'futur-wait futurs)) (cl-defmethod futur-abort ((futurs cons)) (mapc #'futur-abort futurs)) (provide 'futur) ;;; futur.el ends here --=-=-=--