From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!not-for-mail From: David Thompson Newsgroups: gmane.lisp.guile.devel Subject: PATCH - Add cooperative REPL server module Date: Sun, 19 Jan 2014 14:39:07 -0500 Message-ID: <877g9vbw2s.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1390160367 4754 80.91.229.3 (19 Jan 2014 19:39:27 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Sun, 19 Jan 2014 19:39:27 +0000 (UTC) To: guile-devel@gnu.org Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Sun Jan 19 20:39:30 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 1W4yDS-0007aa-5y for guile-devel@m.gmane.org; Sun, 19 Jan 2014 20:39:30 +0100 Original-Received: from localhost ([::1]:47413 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W4yDR-00054b-Re for guile-devel@m.gmane.org; Sun, 19 Jan 2014 14:39:29 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:43407) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W4yDI-000505-Ca for guile-devel@gnu.org; Sun, 19 Jan 2014 14:39:27 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1W4yDB-0004h2-75 for guile-devel@gnu.org; Sun, 19 Jan 2014 14:39:20 -0500 Original-Received: from na3sys009aog129.obsmtp.com ([74.125.149.142]:60610) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W4yDA-0004gm-Q6 for guile-devel@gnu.org; Sun, 19 Jan 2014 14:39:13 -0500 Original-Received: from mail-qe0-f41.google.com ([209.85.128.41]) (using TLSv1) by na3sys009aob129.postini.com ([74.125.148.12]) with SMTP ID DSNKUtwp3uhSoLhZO69uKFL77nm1271eTvc6@postini.com; Sun, 19 Jan 2014 11:39:12 PST Original-Received: by mail-qe0-f41.google.com with SMTP id gc15so2450156qeb.14 for ; Sun, 19 Jan 2014 11:39:09 -0800 (PST) X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:subject:user-agent:date:message-id :mime-version:content-type; bh=qTwPVi3rPeOm7JTIe4Z7z9JKmZIpupPY7Lp6vuIHDLk=; b=ErroEuvNZ1uye8aSYi2Ay4VWfWwNKUDChMuoZRRzzKFNM03Nb/l0MVyo9kCOCxVHmi luuEmzG6qU4qwUxj8OzlNDAq7je5jdfpd67a6KXwUKUNPlYkvWcanwD1nbGLKI7uTZol WcYoE26mm8BOJF6NSS+aVPZoCSOo/WgQ3l8bvLcRDSfJ9OFtIUduQPbJqPcyJ7hRmtbh 7Fox76kH8bbU8LM5+ohLZYldsiEEAtj3jZuG9OFqYLb9l/c7EKcdD4tyqAYACt2B9Pco TKqcpvj/BC6Pn2KNuLKQt4KbA9UkPGhZ8lcKfbADHRmXEmHHsFOjkiezxVWXPw42TRd7 n42g== X-Gm-Message-State: ALoCoQleAJNCS2Tc/+o9+JknBzcZYzjx2975HZvCVfAo3zZFuAEdAy0RAS6WYwDL4Bw5IUeeNH8lg0BuQauUgFsuJvogTOIspcnMUL3ISV+qgEO3hVhnMrxskkTXSKILEbQU5DUZyQgZzWldnCOX2LkGpyDR4BB09Q== X-Received: by 10.229.126.9 with SMTP id a9mr22342236qcs.0.1390160349963; Sun, 19 Jan 2014 11:39:09 -0800 (PST) X-Received: by 10.229.126.9 with SMTP id a9mr22342225qcs.0.1390160349819; Sun, 19 Jan 2014 11:39:09 -0800 (PST) Original-Received: from izanagi (209-6-40-86.c3-0.smr-ubr1.sbo-smr.ma.cable.rcn.com. [209.6.40.86]) by mx.google.com with ESMTPSA id 80sm2090821qgx.12.2014.01.19.11.39.07 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Sun, 19 Jan 2014 11:39:08 -0800 (PST) User-Agent: Notmuch/0.17 (http://notmuchmail.org) Emacs/24.3.1 (x86_64-pc-linux-gnu) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.4.x X-Received-From: 74.125.149.142 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:16818 Archived-At: --=-=-= Content-Type: text/plain Hey all, Attached is a patch to add a "cooperative" REPL server to Guile. This new type of REPL server allows programs that run an event loop (like a game or a simulation) to make use of a REPL server that doesn't present a common pitfall of multithreaded programs: Crashing when 2 threads write to the same resource at the same time. The cooperative REPL ensures that evaluation only happens within the context of a single thread, and the user can control when evaluation is allowed to happen. By cooperative, I mean that the client REPL's are run as coroutines using prompts. All of the REPL's run within the same thread, the thread that calls (spawn-coop-server) and later (poll-coop-server). Reading user input is passed off to another thread and the REPL prompt is aborted. To actually evaluate code, the user must call (poll-coop-server) periodically. Only one REPL can evaluate code at a time. Things seem to be working well. I did basic tests by connecting to the server via telnet and later (when I was confident that I wouldn't crash Emacs) via Geiser. This patch is built on top of Mark Weaver's patch to add the (ice-9 mvars) module. What do you think? - Dave Thompson --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Add-cooperative-REPL-server-module.patch >From 6c23c19610c1ab884d0a8ba2f3d1a94d72022303 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. * module/system/repl/server.scm (run-server): Extract body to run-server*. (run-server*): New procedure. * doc/ref/api-evaluation.texi: Add docs. --- doc/ref/api-evaluation.texi | 46 +++++++++++-- module/system/repl/coop-server.scm | 133 +++++++++++++++++++++++++++++++++++++ module/system/repl/repl.scm | 9 ++- module/system/repl/server.scm | 3 + 4 files changed, 183 insertions(+), 8 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..2fa3e62 100644 --- a/doc/ref/api-evaluation.texi +++ b/doc/ref/api-evaluation.texi @@ -1234,11 +1234,6 @@ to evaluate an installed file from source, instead of relying on the @cindex REPL server -The procedures in this section are provided by -@lisp -(use-modules (system repl server)) -@end lisp - When an application is written in Guile, it is often convenient to allow the user to be able to interact with it by evaluating Scheme expressions in a REPL. @@ -1248,6 +1243,11 @@ which permits interaction over a local or TCP connection. Guile itself uses them internally to implement the @option{--listen} switch, @ref{Command-line Options}. +To use the REPL server, include the following module: +@lisp +(use-modules (system repl server)) +@end lisp + @deffn {Scheme Procedure} make-tcp-server-socket [#:host=#f] @ [#:addr] [#:port=37146] Return a stream socket bound to a given address @var{addr} and port @@ -1275,6 +1275,42 @@ with no arguments. Closes the connection on all running server sockets. @end deffn +For some programs, the regular REPL server may be inadequate. For +example, the main thread of a realtime simulation runs a loop that +processes user input and integrates the simulation. Using the regular +REPL server, the main thread and a REPL client thread could attempt to +write to the same resource at the same time, causing the program to +crash. Additionally, some programs rely on thread-specific context, so +evaluating code in another thread does not have the desired effect. The +cooperative REPL server solves this problem by running all of the client +REPLs within the same thread. In order to prevent blocking, the +responsibility of reading user input is passed to another thread. To +integrate this server within a loop, the loop must poll the server +periodically to evaluate any pending expressions. + +The interface is essentially the same as the regular REPL server module, +but with slightly different procedure names. + +To use the cooperative REPL server, include the following module: +@lisp +(use-modules (system repl coop-server)) +@end lisp + +@deffn {Scheme Procedure} run-coop-server [server-socket] +@deffnx {Scheme Procedure} spawn-coop-server [server-socket] +Create and run a cooperative REPL server, 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. + +@code{run-coop-server} runs the server in the current thread, whereas +@code{spawn-coop-server} runs the server in a new thread. +@end deffn + +@deffn {Scheme Procedure} poll-coop-server +Poll the server and evaluate a pending expression if there is one. +@end deffn + @c Local Variables: @c TeX-master: "guile.texi" @c End: diff --git a/module/system/repl/coop-server.scm b/module/system/repl/coop-server.scm new file mode 100644 index 0000000..63dda7e --- /dev/null +++ b/module/system/repl/coop-server.scm @@ -0,0 +1,133 @@ +;;; Cooperative REPL server + +;; Copyright (C) 2013 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) + #:export (run-coop-server + spawn-coop-server + poll-coop-server)) + +(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 (set-coop-repl-cont! cont coop-repl) + "Set the partial continuation CONT for 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 the cooperative REPL." + (call-with-prompt 'coop-coop-repl-prompt thunk set-coop-repl-cont!)) + +(define current-coop-repl (make-parameter #f)) + +(define coop-repl-eval-mvar (new-empty-mvar)) + +(define (coop-repl-eval opcode . args) + "Put a new instruction into the evaluation mvar." + (put-mvar coop-repl-eval-mvar (cons opcode args))) + +(define (coop-reader repl) + (put-mvar (coop-repl-read-mvar (current-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-coop-repl-prompt (current-coop-repl))) + +(define (reader-loop coop-repl) + "Run an unbounded loop that reads an expression for COOP-REPL and +stores the expression for later evaluation." + (coop-repl-eval 'eval coop-repl (coop-repl-read coop-repl)) + (reader-loop coop-repl)) + +(define (poll-coop-server) + "Test if there is an cooperative REPL expression waiting to be +evaluated if so, apply it." + (receive (op success?) + (try-take-mvar coop-repl-eval-mvar) + (when success? + (match op + (('new-repl client) + (start-repl-client client)) + (('eval coop-repl exp) + ((coop-repl-cont coop-repl) exp)))))) + +(define* (start-coop-repl #:optional (lang (current-language)) #:key debug) + (let ((coop-repl (make-coop-repl))) + (call-with-new-thread + (lambda () + (reader-loop coop-repl))) + (parameterize ((current-coop-repl coop-repl)) + (start-repl* lang debug coop-reader)))) + +(define* (run-coop-server #:optional (server-socket (make-tcp-server-socket))) + (run-server* server-socket serve-coop-client)) + +(define* (spawn-coop-server #:optional (server-socket (make-tcp-server-socket))) + (make-thread run-coop-server server-socket)) + +(define (serve-coop-client client addr) + "Schedule the creation of a new cooperative REPL for CLIENT. +ADDR is unused." + (coop-repl-eval 'new-repl client)) + +(define (start-repl-client client) + "Create a new prompt and run the cooperative REPL within it. All +input and output happens 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 start-coop-repl)))))))) + (close-socket! client)))))) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index 1649556..1565f2a 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -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) (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))) (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..469226d 100644 --- a/module/system/repl/server.scm +++ b/module/system/repl/server.scm @@ -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)))) -- 1.8.5.2 --=-=-=--