[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: Fwd: PATCH - Add cooperative REPL server module
From: |
David Thompson |
Subject: |
Re: Fwd: PATCH - Add cooperative REPL server module |
Date: |
Wed, 22 Jan 2014 07:17:57 -0500 |
User-agent: |
Notmuch/0.17 (http://notmuchmail.org) Emacs/24.3.1 (x86_64-pc-linux-gnu) |
Mark H Weaver <address@hidden> 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
>From 9ec93726bf96c38ff1a6b704269578f1a1081962 Mon Sep 17 00:00:00 2001
From: David Thompson <address@hidden>
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
address@hidden Cooperative REPL Servers
address@hidden Cooperative REPL Servers
+
address@hidden Cooperative REPL server
+
+The procedures in this section are provided by
address@hidden
+(use-modules (system repl coop-server))
address@hidden 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
address@hidden 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.
+
address@hidden {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
address@hidden be called periodically on the returned
+server object.
address@hidden deffn
+
address@hidden {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}.
address@hidden 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 <coop-repl-server>
+ (%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 <coop-repl>
+ (%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
- PATCH - Add cooperative REPL server module, David Thompson, 2014/01/19
- Re: PATCH - Add cooperative REPL server module, Mark H Weaver, 2014/01/19
- Message not available
- Message not available
- Message not available
- Fwd: PATCH - Add cooperative REPL server module, Thompson, David, 2014/01/20
- Re: Fwd: PATCH - Add cooperative REPL server module, Mark H Weaver, 2014/01/20
- Re: Fwd: PATCH - Add cooperative REPL server module, David Thompson, 2014/01/21
- Re: Fwd: PATCH - Add cooperative REPL server module, Mark H Weaver, 2014/01/21
- Re: Fwd: PATCH - Add cooperative REPL server module,
David Thompson <=
- Re: 'stop-server-and-clients!' can cause crash (was PATCH - Add cooperative REPL server module), Mark H Weaver, 2014/01/21