From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: Mark H Weaver Newsgroups: gmane.lisp.guile.devel Subject: Re: Fwd: PATCH - Add cooperative REPL server module Date: Mon, 20 Jan 2014 23:21:52 -0500 Message-ID: <87zjmqnevz.fsf@netris.org> References: <877g9vbw2s.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> <87ha8zpj93.fsf@netris.org> <874n4yoc5b.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> <87d2jmpn4e.fsf@netris.org> <874n4ynsbw.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: ger.gmane.org 1390278299 28750 80.91.229.3 (21 Jan 2014 04:24:59 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Tue, 21 Jan 2014 04:24:59 +0000 (UTC) Cc: guile-devel To: "Thompson\, David" Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Tue Jan 21 05:25:05 2014 Return-path: Envelope-to: guile-devel@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by plane.gmane.org with esmtp (Exim 4.69) (envelope-from ) id 1W5Stc-0004V8-Ru for guile-devel@m.gmane.org; Tue, 21 Jan 2014 05:25:05 +0100 Original-Received: from localhost ([::1]:55655 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5Stc-0006JC-2I for guile-devel@m.gmane.org; Mon, 20 Jan 2014 23:25:04 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53747) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5StT-0006Ht-9W for guile-devel@gnu.org; Mon, 20 Jan 2014 23:25:01 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1W5StN-0003Qa-E5 for guile-devel@gnu.org; Mon, 20 Jan 2014 23:24:55 -0500 Original-Received: from world.peace.net ([96.39.62.75]:55359) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5StM-0003Oq-Sw for guile-devel@gnu.org; Mon, 20 Jan 2014 23:24:49 -0500 Original-Received: from 209-6-91-212.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com ([209.6.91.212] helo=yeeloong) by world.peace.net with esmtpsa (TLS1.0:DHE_RSA_AES_128_CBC_SHA1:16) (Exim 4.72) (envelope-from ) id 1W5Sst-0005xt-Lz; Mon, 20 Jan 2014 23:24:21 -0500 In-Reply-To: (David Thompson's message of "Mon, 20 Jan 2014 18:36:05 -0500") User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-Received-From: 96.39.62.75 X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.1.14 Precedence: list List-Id: "Developers list for Guile, the GNU extensibility library" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Original-Sender: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Xref: news.gmane.org gmane.lisp.guile.devel:16821 Archived-At: Hi David, "Thompson, David" writes: > I have wrapped the body of 'start-coop-repl' with 'false-if-exception' > to prevent the program from crashing with 'stop-server-and-clients!' is > called from a REPL. I did not have to do the same for 'close-socket!' > in 'start-repl-client' because trying to close an a port that has > already been closed is a no-op. Ah, okay. > However, something unexpected happened when I tried to call > 'stop-server-and-clients!' from my test program's main loop: There was a > segfault once I pressed the enter key in my telnet REPL session. I > tested this again with the regular REPL server and got the same bad > results. Thoughts? Interesting. Does it happen with unmodified stable-2.0? If so, I think we can treat this as an independent bug. Can you reproduce the segfault while running meta/gdb-uninstalled-guile and get a backtrace? Alternatively, if you provide enough detail to reproduce the segfault, I can track it down. > In any case, attached is an updated patch for review. Multiple > cooperative REPL servers are now supported and the global evaluation > mvar has been removed. Sounds good! We're getting closer. Please see below for comments. > From 7e183c5316ab997041cf6ec83192e7a32e49e0fa Mon Sep 17 00:00:00 2001 > From: David Thompson > Date: Sun, 19 Jan 2014 13:16:02 -0500 > Subject: [PATCH] Add cooperative REPL server module. > > * module/system/repl/coop-server.scm: New module. > > * module/system/repl/repl.scm (start-repl): Extract body to start-repl*. > (start-repl*): New procedure. This last line should be indented 2 spaces. > > * module/system/repl/server.scm (run-server): Extract body to > run-server*. > (run-server*): New procedure. > > * doc/ref/api-evaluation.texi: Add docs. The commit log should describe the change to module/Makefile.am. > --- > doc/ref/api-evaluation.texi | 47 +++++++++++ > module/Makefile.am | 3 +- > module/system/repl/coop-server.scm | 163 +++++++++++++++++++++++++++++++++++++ > module/system/repl/repl.scm | 11 ++- > module/system/repl/server.scm | 5 +- > 5 files changed, 223 insertions(+), 6 deletions(-) > create mode 100644 module/system/repl/coop-server.scm > > diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi > index 63b1d60..d366aa1 100644 > --- a/doc/ref/api-evaluation.texi > +++ b/doc/ref/api-evaluation.texi > @@ -23,6 +23,7 @@ loading, evaluating, and compiling Scheme code at run time. > * Local Evaluation:: Evaluation in a local lexical environment. > * Local Inclusion:: Compile-time inclusion of one file in another. > * REPL Servers:: Serving a REPL over a socket. > +* Cooperative REPL Servers:: REPL server for single-threaded applications. > @end menu > > > @@ -1275,6 +1276,52 @@ with no arguments. > Closes the connection on all running server sockets. > @end deffn > > +@node Cooperative REPL Servers > +@subsection Cooperative REPL Servers > + > +@cindex Cooperative REPL server > + > +The procedures in this section are provided by > +@lisp > +(use-modules (system repl coop-server)) > +@end lisp > + > +Whereas REPL servers run in their own threads, sometimes it is more Now that this is in a different node, it might be better to start with: Whereas ordinary REPL servers run in their own threads (@pxref{REPL Servers}), [...] > +convenient to provide REPLs that run at specified times within an > +existing thread, for example in programs utilizing an event loop or in > +single-threaded programs. This allows for safe access and mutation of a > +program's data structures from the REPL, without concern for thread > +synchronization. The server must be polled periodically to evaluate any > +pending expressions. Instead of that last sentence being part of the above paragraph, how about making it part of another paragraph that explains briefly how to use these cooperative REPLs? In between those two paragraphs, it might also be helpful to briefly explain that although the REPLs are run in the thread that calls 'spawn-coop-repl-server' and 'poll-coop-repl-server', dedicated threads are spawned to read input for the REPLs and to listen for new connections. We should probably also mention somewhere that if the debugger is entered, or if a long-running expression is evaluated by the REPL, the thread that calls 'poll-coop-repl-server' will block. > + > +@deffn {Scheme Procedure} make-coop-repl-server > +Return a newly allocated cooperative REPL server. > +@end deffn I don't think this procedure should be exported. > + > +@deffn {Scheme Procedure} coop-repl-server? obj > +Return @code{#t} if @var{obj} is a cooperative REPL server, otherwise > +return @code{#f}. > +@end deffn I'm not sure we need this one either. > + > +@deffn {Scheme Procedure} run-coop-repl-server coop-server [server-socket] > +Run the given cooperative REPL server @var{coop-server} in the current > +thread, making it available over the given @var{server-socket}. If > +@var{server-socket} is not provided, it defaults to the socket created > +by calling @code{make-tcp-server-socket} with no arguments. > +@end deffn I'm not sure this procedure should be exported either. I don't see why a user would ever want to use it. However, if we do keep it, then I think it should handle creating the object itself, rather than taking it as an argument. > + > +@deffn {Scheme Procedure} spawn-coop-repl-server [server-socket] > +Return a newly allocated cooperative REPL server and run the server in a > +new thread, making it available over the given @var{server-socket}. I'm worried that the mention of running the server "in a new thread", without further explanation, is likely to confuse readers, given that the whole point of these cooperative REPL servers is to run the REPLs in an existing thread. Also, I don't think we need to emphasize that it's "newly allocated". How about something like this: Create and return a new cooperative REPL server object, and spawn a new thread to listen for connections on @var{server-socket}. Proper functioning of the REPL server requires that @code{poll-coop-repl-server} be called periodically on the returned server object. If > +@var{server-socket} is not provided, it defaults to the socket created > +by calling @code{make-tcp-server-socket} with no arguments. > +@end deffn > + > +@deffn {Scheme Procedure} poll-coop-repl-server coop-server > +Poll the cooperative REPL server COOP-SERVER and evaluate a pending > +expression if there is one. s/COOP-SERVER/@var{coop-server}/. Evaluating pending expressions is not the only thing 'pool-coop-repl-server' can do. It can create new REPLs, spawn new reader threads, and run meta commands. We probably shouldn't be too specific about what this procedure can do, since it might conceivably do more jobs in the future. However, it's probably helpful to say that evaluating pending expressions is one of the things it does. Also, we should specify that 'pool-coop-repl-server' must be called from the same thread that called 'spawn-coop-repl-server'. > +@end deffn > + > @c Local Variables: > @c TeX-master: "guile.texi" > @c End: > diff --git a/module/Makefile.am b/module/Makefile.am > index 8a7befd..b7960dc 100644 > --- a/module/Makefile.am > +++ b/module/Makefile.am > @@ -360,7 +360,8 @@ SYSTEM_SOURCES = \ > system/repl/common.scm \ > system/repl/command.scm \ > system/repl/repl.scm \ > - system/repl/server.scm > + system/repl/server.scm \ > + system/repl/coop-server.scm > > LIB_SOURCES = \ > statprof.scm \ > diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm > new file mode 100644 > index 0000000..466b8ae > --- /dev/null > +++ b/module/system/repl/coop-server.scm > @@ -0,0 +1,163 @@ > +;;; Cooperative REPL server > + > +;; Copyright (C) 2014 Free Software Foundation, Inc. > + > +;; This library is free software; you can redistribute it and/or > +;; modify it under the terms of the GNU Lesser General Public > +;; License as published by the Free Software Foundation; either > +;; version 3 of the License, or (at your option) any later version. > +;; > +;; This library 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 > +;; Lesser General Public License for more details. > +;; > +;; You should have received a copy of the GNU Lesser General Public > +;; License along with this library; if not, write to the Free Software > +;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA > +;; 02110-1301 USA > + > +;;; Code: > + > +(define-module (system repl coop-server) > + #:use-module (ice-9 match) > + #:use-module (ice-9 mvars) > + #:use-module (ice-9 receive) > + #:use-module (ice-9 threads) > + #:use-module (srfi srfi-9) > + #:use-module ((system repl repl) > + #:select (start-repl* prompting-meta-read)) > + #:use-module ((system repl server) > + #:select (run-server* make-tcp-server-socket close-socket!)) > + #:use-module (system repl error-handling) Is (system repl error-handling) needed here? I suspect not. > + #:export (make-coop-repl-server > + coop-repl-server? > + run-coop-repl-server As suggested above, I don't think we need to export the above three procedures. The following two should be enough, no? > + spawn-coop-repl-server > + poll-coop-repl-server)) > + > +(define-record-type > + (%make-coop-repl-server eval-mvar) > + coop-repl-server? > + (eval-mvar coop-repl-server-eval-mvar)) > + > +(define (make-coop-repl-server) > + (%make-coop-repl-server (new-empty-mvar))) > + > +(define (coop-repl-server-eval coop-server opcode . args) > + "Put a new instruction with the symbolic name OPCODE and an arbitrary > +number of arguments into the evaluation mvar of COOP-SERVER." > + (put-mvar (coop-repl-server-eval-mvar coop-server) > + (cons opcode args))) > + > +(define-record-type > + (%make-coop-repl read-mvar cont) > + coop-repl? > + (read-mvar coop-repl-read-mvar) > + (cont coop-repl-cont set-coop-repl-cont!)) > + > +(define (make-coop-repl) > + (%make-coop-repl (new-empty-mvar) #f)) > + > +(define (coop-repl-read coop-repl) > + "Read an expression via the thunk stored in COOP-REPL." > + ((take-mvar (coop-repl-read-mvar coop-repl)))) > + > +(define (store-repl-cont cont coop-repl) > + "Save the partial continuation CONT within COOP-REPL." > + (set-coop-repl-cont! coop-repl > + (lambda (exp) > + (coop-repl-prompt > + (lambda () (cont exp)))))) > + > +(define (coop-repl-prompt thunk) > + "Apply THUNK within a prompt for cooperative REPLs." > + (call-with-prompt 'coop-repl-prompt thunk store-repl-cont)) > + > +(define (make-coop-reader coop-repl) > + "Return a new procedure for reading user input from COOP-REPL. The > +generated procedure passes the responsibility of reading input to > +another thread via an mvar and aborts the cooperative REPL prompt." > + (lambda (repl) > + (put-mvar (coop-repl-read-mvar coop-repl) > + ;; Need to preserve the REPL stack and current module across > + ;; threads. > + (let ((stack (fluid-ref *repl-stack*)) > + (module (current-module))) > + (lambda () > + (with-fluids ((*repl-stack* stack)) > + (set-current-module module) > + (prompting-meta-read repl))))) > + (abort-to-prompt 'coop-repl-prompt coop-repl))) > + > +(define (reader-loop coop-server coop-repl) > + "Run an unbounded loop that reads an expression for COOP-REPL and > +stores the expression within COOP-SERVER for later evaluation." > + (coop-repl-server-eval coop-server 'eval coop-repl > + (coop-repl-read coop-repl)) > + (reader-loop coop-server coop-repl)) > + > +(define (poll-coop-repl-server coop-server) > + "Test if there is an expression waiting to be evaluated within > +COOP-SERVER and evaluate it if so." > + (receive (op success?) > + (try-take-mvar (coop-repl-server-eval-mvar coop-server)) > + (when success? > + (match op > + (('new-repl client) > + (start-repl-client coop-server client)) > + (('eval coop-repl exp) > + ((coop-repl-cont coop-repl) exp)))))) > + > +(define* (start-coop-repl coop-server #:optional > + (lang (current-language)) #:key debug) > + "Start a new cooperative REPL process for COOP-SERVER using the > +language LANG." > + ;; Calling stop-server-and-clients! from a REPL will cause an > + ;; exception to be thrown when trying to read from the socket that has > + ;; been closed, so we catch that here. > + (false-if-exception > + (let ((coop-repl (make-coop-repl))) > + (make-thread reader-loop coop-server coop-repl) > + (start-repl* lang debug (make-coop-reader coop-repl))))) > + > +(define* (run-coop-repl-server coop-server #:optional > + (server-socket (make-tcp-server-socket))) > + "Start the cooperative REPL server for COOP-SERVER using the socket > +SERVER-SOCKET." > + (run-server* server-socket (make-coop-client-proc coop-server))) > + > +(define* (spawn-coop-repl-server > + #:optional (server-socket (make-tcp-server-socket))) > + "Return a newly allocated cooperative REPL server and run the server > +in a new thread, making it available over SERVER-SOCKET." > + (let ((coop-server (make-coop-repl-server))) > + (make-thread run-coop-repl-server > + coop-server > + server-socket) > + coop-server)) > + > +(define (make-coop-client-proc coop-server) > + "Return a new procedure that is used to schedule the creation of a new > +cooperative REPL for COOP-SERVER." > + (lambda (client addr) > + (coop-repl-server-eval coop-server 'new-repl client))) > + > +(define (start-repl-client coop-server client) > + "Run a cooperative REPL for COOP-SERVER within a prompt. All input > +and output is sent over the socket CLIENT." > + (with-continuation-barrier > + (lambda () > + (coop-repl-prompt > + (lambda () > + (with-input-from-port client > + (lambda () > + (with-output-to-port client > + (lambda () > + (with-error-to-port client > + (lambda () > + (with-fluids ((*repl-stack* '())) > + (save-module-excursion > + (lambda () > + (start-coop-repl coop-server)))))))))) > + (close-socket! client)))))) > diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm > index 1649556..50a14a7 100644 > --- a/module/system/repl/repl.scm > +++ b/module/system/repl/repl.scm > @@ -1,6 +1,6 @@ > ;;; Read-Eval-Print Loop > > -;; Copyright (C) 2001, 2009, 2010, 2011, 2013 Free Software Foundation, Inc. > +;; Copyright (C) 2001, 2009, 2010, 2011, 2013 2014 Free Software Foundation, Inc. A comma is needed between 2013 and 2014. However, this line will be too long, so "2014 Free Software Foundation, Inc." should be moved to the next line and indented a couple of spaces. > > ;; This library is free software; you can redistribute it and/or > ;; modify it under the terms of the GNU Lesser General Public > @@ -129,10 +129,13 @@ > ;;; > > (define* (start-repl #:optional (lang (current-language)) #:key debug) > + (start-repl* lang debug prompting-meta-read)) > + > +(define (start-repl* lang debug reader) > ;; ,language at the REPL will update the current-language. Make > ;; sure that it does so in a new dynamic scope. > (parameterize ((current-language lang)) > - (run-repl (make-repl lang debug)))) > + (run-repl (make-repl lang debug) reader))) > > ;; (put 'abort-on-error 'scheme-indent-function 1) > (define-syntax-rule (abort-on-error string exp) > @@ -143,7 +146,7 @@ > (print-exception (current-output-port) #f key args) > (abort)))) > > -(define (run-repl repl) > +(define (run-repl repl reader) 'run-repl' is exported, so we can't change its API. Can you rename 'run-repl' to 'run-repl*' and make a new 'run-repl' that takes only the 'repl', similar to what you did with 'start-repl' and 'run-server'? > (define (with-stack-and-prompt thunk) > (call-with-prompt (default-prompt-tag) > (lambda () (start-stack #t (thunk))) > @@ -155,7 +158,7 @@ > (if (null? (cdr (fluid-ref *repl-stack*))) > (repl-welcome repl)) > (let prompt-loop () > - (let ((exp (prompting-meta-read repl))) > + (let ((exp (reader repl))) I'm a bit worried that someone looking at this code will guess that 'reader' is something along the lines of 'read'. How about just calling the argument 'prompting-meta-read' instead of 'reader'? Can you do the same for 'start-repl*'? > (COND > ((eqv? exp *unspecified*)) ; read error or comment, pass > ((eq? exp meta-command-token) > diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm > index ec90677..9b16c9f 100644 > --- a/module/system/repl/server.scm > +++ b/module/system/repl/server.scm > @@ -1,6 +1,6 @@ > ;;; Repl server > > -;; Copyright (C) 2003, 2010, 2011 Free Software Foundation, Inc. > +;; Copyright (C) 2003, 2010, 2011, 2014 Free Software Foundation, Inc. > > ;; This library is free software; you can redistribute it and/or > ;; modify it under the terms of the GNU Lesser General Public > @@ -85,6 +85,9 @@ > (sigaction SIGINT #f)))))))) > > (define* (run-server #:optional (server-socket (make-tcp-server-socket))) > + (run-server* server-socket serve-client)) > + > +(define (run-server* server-socket serve-client) > (define (accept-new-client) > (catch #t > (lambda () (call-with-sigint (lambda () (accept server-socket))))