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: Re: Fwd: PATCH - Add cooperative REPL server module Date: Wed, 22 Jan 2014 07:17:57 -0500 Message-ID: <87fvog5hxm.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> 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> <87zjmqnevz.fsf@netris.org> <871u00u6kv.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me> <8761pcofgi.fsf@netris.org> NNTP-Posting-Host: plane.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: ger.gmane.org 1390399295 10780 80.91.229.3 (22 Jan 2014 14:01:35 GMT) X-Complaints-To: usenet@ger.gmane.org NNTP-Posting-Date: Wed, 22 Jan 2014 14:01:35 +0000 (UTC) Cc: guile-devel@gnu.org To: Mark H Weaver Original-X-From: guile-devel-bounces+guile-devel=m.gmane.org@gnu.org Wed Jan 22 15:01:39 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 1W5yN7-0002jA-Dk for guile-devel@m.gmane.org; Wed, 22 Jan 2014 15:01:37 +0100 Original-Received: from localhost ([::1]:35111 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5yN7-000719-2m for guile-devel@m.gmane.org; Wed, 22 Jan 2014 09:01:37 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:53210) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5yMw-0006tr-AR for guile-devel@gnu.org; Wed, 22 Jan 2014 09:01:32 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1W5yMp-0004An-DT for guile-devel@gnu.org; Wed, 22 Jan 2014 09:01:26 -0500 Original-Received: from na3sys009aog101.obsmtp.com ([74.125.149.67]:38631) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1W5yMo-0004A3-U4 for guile-devel@gnu.org; Wed, 22 Jan 2014 09:01:19 -0500 Original-Received: from mail-qc0-f176.google.com ([209.85.216.176]) (using TLSv1) by na3sys009aob101.postini.com ([74.125.148.12]) with SMTP ID DSNKUt/PLYBCtl45/0yenw1KcqNhXpu3DsKS@postini.com; Wed, 22 Jan 2014 06:01:18 PST Original-Received: by mail-qc0-f176.google.com with SMTP id e16so482703qcx.21 for ; Wed, 22 Jan 2014 06:01:16 -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:cc:subject:in-reply-to:references :user-agent:date:message-id:mime-version:content-type; bh=5C9yJFBWWBkAIgTHH/4EONKxfZe6mpLtSqPyAGlwwA8=; b=B4V8aLsrTZbSNPfkbkGpuBe81zbaZSbABb4BDWw+1y+eg9Pq1dfV2x+zIsU9x7MnmM ydJ9BxuuCTaej1U4ZS1fnC97WcjxGBNfwZniHBoPhDtTxf0jm4fhVntJuC39qFFM+ht5 W5ShJqOebhbUNwJaPCylHjiqeMvDjcsS3NxjR1ShaQ0dPFrllDbaeIPErvylp184DYAi ht0V2lkv+4RLM462jw6bj9u77GipGlcDUVt9HUZzaa1njCKQK0M4HoqetyDEPrjLMni9 bqvtyG29GATx+GqppRzMGJeB8SfAwCOvbz+DJAAKNIHwMx4I3xh1BKoJArRRX6I9DRb/ oSEg== X-Received: by 10.224.113.204 with SMTP id b12mr1594604qaq.35.1390393080927; Wed, 22 Jan 2014 04:18:00 -0800 (PST) X-Gm-Message-State: ALoCoQnYw245YlkfTxmzupTnkwJ/5PG88FxtpbYvBX1cwxGZR7BrhP9NNeofgtGx/eS5MHJz2DMwHmGy0VEDB9uEjOygL72XeeA3Wp+eyuQf9cTm0Lr0gf2rrD1POqhus0/yVpykVxBTx4Np5f4Ryjw6cQZqWCOKgA== X-Received: by 10.224.113.204 with SMTP id b12mr1594591qaq.35.1390393080844; Wed, 22 Jan 2014 04:18:00 -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 l8sm13327543qaz.14.2014.01.22.04.17.58 for (version=TLSv1.2 cipher=RC4-SHA bits=128/128); Wed, 22 Jan 2014 04:17:59 -0800 (PST) In-Reply-To: <8761pcofgi.fsf@netris.org> 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.67 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:16830 Archived-At: --=-=-= Content-Type: text/plain Mark H Weaver writes: > Hi David, > > Your latest patch looks great to me. I have only one request: > please update the docstrings of 'spawn-coop-repl-server' and > 'poll-coop-repl-server' to match their current descriptions in > the manual, except without texinfo markup, as usual. Done. Updated patch attached. > Other than that, I think the patch is ready to push, although of course > MVars have to go in first. Now it's my turn to write docs, and tests > :) Yay! Thanks. > Thanks again! > Mark - Dave --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Add-cooperative-REPL-server-module.patch >From 9ec93726bf96c38ff1a6b704269578f1a1081962 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. (run-repl): Extract body to run-repl*. (run-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. * module/Makefile.am: Add system/repl/coop-server.scm to SYSTEM_SOURCES. --- doc/ref/api-evaluation.texi | 45 +++++++++++ module/Makefile.am | 3 +- module/system/repl/coop-server.scm | 160 +++++++++++++++++++++++++++++++++++++ module/system/repl/repl.scm | 11 ++- module/system/repl/server.scm | 5 +- 5 files changed, 220 insertions(+), 4 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 7d67d9a..27585e6 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 @@ -1281,6 +1282,50 @@ 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 ordinary REPL servers run in their own threads (@pxref{REPL +Servers}), sometimes it is more 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. + +Although the REPLs are run in the thread that calls +@code{spawn-coop-repl-server} and @code{poll-coop-repl-server}, +dedicated threads are spawned so that the calling thread is not blocked. +The spawned threads read input for the REPLs and to listen for new +connections. + +Cooperative REPL servers must be polled periodically to evaluate any +pending expressions by calling @code{poll-coop-repl-server} with the +object returned from @code{spawn-coop-repl-server}. The thread that +calls @code{poll-coop-repl-server} will be blocked for as long as the +expression takes to be evaluated or if the debugger is entered. + +@deffn {Scheme Procedure} spawn-coop-repl-server [server-socket] +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. +@end deffn + +@deffn {Scheme Procedure} poll-coop-repl-server coop-server +Poll the cooperative REPL server @var{coop-server} and apply a pending +operation if there is one, such as evaluating an expression typed at the +REPL prompt. This procedure must be called from the same thread that +called @code{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..41759c9 --- /dev/null +++ b/module/system/repl/coop-server.scm @@ -0,0 +1,160 @@ +;;; 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!)) + #:export (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) + "Poll the cooperative REPL server COOP-SERVER and apply a pending +operation if there is one, such as evaluating an expression typed at the +REPL prompt. This procedure must be called from the same thread that +called spawn-coop-repl-server." + (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) + "Start a new cooperative REPL process for COOP-SERVER." + ;; 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* (current-language) #f (make-coop-reader coop-repl))))) + +(define (run-coop-repl-server coop-server 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))) + "Create and return a new cooperative REPL server object, and spawn a +new thread to listen for connections on SERVER-SOCKET. Proper +functioning of the REPL server requires that poll-coop-repl-server be +called periodically on the returned server object." + (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..20309e3 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -1,6 +1,7 @@ ;;; 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. ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -129,10 +130,13 @@ ;;; (define* (start-repl #:optional (lang (current-language)) #:key debug) + (start-repl* lang debug prompting-meta-read)) + +(define (start-repl* lang debug prompting-meta-read) ;; ,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) prompting-meta-read))) ;; (put 'abort-on-error 'scheme-indent-function 1) (define-syntax-rule (abort-on-error string exp) @@ -144,6 +148,9 @@ (abort)))) (define (run-repl repl) + (run-repl* repl prompting-meta-read)) + +(define (run-repl* repl prompting-meta-read) (define (with-stack-and-prompt thunk) (call-with-prompt (default-prompt-tag) (lambda () (start-stack #t (thunk))) diff --git a/module/system/repl/server.scm b/module/system/repl/server.scm index 2df7564..cfa1261 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 @@ -68,6 +68,9 @@ sock)) (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 () (accept server-socket)) -- 1.8.5.2 --=-=-=--