unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* PATCH - Add cooperative REPL server module
@ 2014-01-19 19:39 David Thompson
  2014-01-20  0:52 ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: David Thompson @ 2014-01-19 19:39 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 1196 bytes --]


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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-cooperative-REPL-server-module.patch --]
[-- Type: text/x-diff, Size: 10770 bytes --]

From 6c23c19610c1ab884d0a8ba2f3d1a94d72022303 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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 <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 (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


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: PATCH - Add cooperative REPL server module
  2014-01-19 19:39 PATCH - Add cooperative REPL server module David Thompson
@ 2014-01-20  0:52 ` Mark H Weaver
       [not found]   ` <874n4yoc5b.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me>
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-20  0:52 UTC (permalink / raw)
  To: David Thompson; +Cc: guile-devel

Hi David,

David Thompson <dthompson2@worcester.edu> writes:

> Attached is a patch to add a "cooperative" REPL server to Guile.  [...]
>
> 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.

Excellent!  This is a great start.

One thing I'd like to see is support for multiple coop-servers, possibly
each running in a different thread.  In other words, instead of using
global variables, it would be good if (spawn-coop-server) returned a
<coop-repl-server> object, which would then be passed to
'pool-coop-server'.

Does 'stop-server-and-clients!' work on these cooperative repl servers?

See below for comments.

> From 6c23c19610c1ab884d0a8ba2f3d1a94d72022303 Mon Sep 17 00:00:00 2001
> From: David Thompson <dthompson2@worcester.edu>
> Date: Sun, 19 Jan 2014 13:16:02 -0500
> Subject: [PATCH] Add cooperative REPL server module.
>
> * module/system/repl/coop-server.scm: New module.

This new file should be added to SYSTEM_SOURCES in module/Makefile.am.

>
> * 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

If the coop-server procedures are in their own module, then I think they
should be documented in their own node, separate from REPL Servers.
Alternatively, perhaps the new procedures should go in (system repl
servers).  What do you think?

> @@ -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.

Instead of what you wrote above, how about something like this:

  Whereas REPL servers run in their own threads, 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.

> +@deffn {Scheme Procedure} run-coop-server [server-socket]
> +@deffnx {Scheme Procedure} spawn-coop-server [server-socket]

How about 'run-coop-repl-server' and 'spawn-coop-repl-server'?

> +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

How about 'poll-coop-repl-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 should be 2014.

> +
> +;; 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 <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 (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))))))

This procedure is confusingly named.  It doesn't do what one would
expect from a procedure of that name.

> +
> +(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)))

Fluids and parameters are best avoided (except where it would be painful
to do so), because they don't play well with many other programming
techniques such as lazy evaluation.

In this case, they can be easily avoided.  'current-coop-repl' is
accessed from only one procedure: 'coop-reader'.  Please use a lexical
environment instead.  Change (define (coop-reader repl) ...) to
something like:

  (define (make-coop-reader coop-repl)
    (lambda (repl)
      ...))

and then, see below...

> +
> +(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))))

Change this 'parameterize' form to:

  (start-repl* lang debug (make-coop-reader coop-repl))

> +
> +(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))))



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Fwd: PATCH - Add cooperative REPL server module
       [not found]       ` <874n4ynsbw.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me>
@ 2014-01-20 23:36         ` Thompson, David
  2014-01-21  4:21           ` Mark H Weaver
  0 siblings, 1 reply; 8+ messages in thread
From: Thompson, David @ 2014-01-20 23:36 UTC (permalink / raw)
  To: guile-devel

[-- Attachment #1: Type: text/plain, Size: 2153 bytes --]

Forgot to CC the list about my updated patch. Forwarding instead. My apologies.

- Dave


---------- Forwarded message ----------
From: David Thompson <dthompson2@worcester.edu>
Date: Mon, Jan 20, 2014 at 6:31 PM
Subject: Re: PATCH - Add cooperative REPL server module
To: Mark H Weaver <mhw@netris.org>


Mark H Weaver <mhw@netris.org> writes:

> That means that they'll all run in the same thread.  A great benefit of
> the cooperative REPL is being able to safely access and mutate data
> structures belonging to a particular thread.  A program may have more
> than one thread, and may want REPLs for each.
>
> Also, remember that Guile is a library, and may be used by multiple
> libraries within a larger program.  Each of those libguile-using
> libraries may want to provide their own coop REPL server, each run at
> their own chosen safe-points.
>
> As a general rule, in _any_ library, it's generally a bad idea to have
> global settings.  For example, the GMP library that Guile uses for big
> integers offers global settings to specify custom memory allocation
> functions, and Guile needs to set these.  However, this can lead to
> conflicts when other libraries linked with libguile (or the main
> program) also use GMP and want to install their own custom allocators.

Good points. Thanks for the explanation.

> Okay.  I wouldn't expect it to work without modifications.

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.

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?

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.

- Dave

[-- Attachment #2: 0001-Add-cooperative-REPL-server-module.patch --]
[-- Type: text/x-diff, Size: 13464 bytes --]

From 7e183c5316ab997041cf6ec83192e7a32e49e0fa Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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        |  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
+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.
+
+@deffn {Scheme Procedure} make-coop-repl-server
+Return a newly allocated cooperative REPL server.
+@end deffn
+
+@deffn {Scheme Procedure} coop-repl-server? obj
+Return @code{#t} if @var{obj} is a cooperative REPL server, otherwise
+return @code{#f}.
+@end deffn
+
+@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
+
+@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}.  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.
+@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)
+  #:export (make-coop-repl-server
+            coop-repl-server?
+            run-coop-repl-server
+            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)
+  "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.
 
 ;; 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)
   (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..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))))
-- 
1.8.5.2


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: Fwd: PATCH - Add cooperative REPL server module
  2014-01-20 23:36         ` Fwd: " Thompson, David
@ 2014-01-21  4:21           ` Mark H Weaver
  2014-01-22  1:51             ` David Thompson
  0 siblings, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-21  4:21 UTC (permalink / raw)
  To: Thompson, David; +Cc: guile-devel

Hi David,

"Thompson, David" <dthompson2@worcester.edu> 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 <dthompson2@worcester.edu>
> 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 <coop-repl-server> 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 <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)
> +  "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))))



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Fwd: PATCH - Add cooperative REPL server module
  2014-01-21  4:21           ` Mark H Weaver
@ 2014-01-22  1:51             ` David Thompson
  2014-01-22  3:36               ` Mark H Weaver
  2014-01-22  4:20               ` 'stop-server-and-clients!' can cause crash (was PATCH - Add cooperative REPL server module) Mark H Weaver
  0 siblings, 2 replies; 8+ messages in thread
From: David Thompson @ 2014-01-22  1:51 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

[-- Attachment #1: Type: text/plain, Size: 5634 bytes --]

Mark H Weaver <mhw@netris.org> writes:

> Interesting.  Does it happen with unmodified stable-2.0?  If so, I think
> we can treat this as an independent bug.

Yes, exact same problem on stable-2.0.

> 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.

Here's the output from gdb:

Program received signal SIGSEGV, Segmentation fault.
[Switching to Thread 0x7ffff4ea2700 (LWP 13122)]
get_codepoint (port=port@entry=0xe13ff0, codepoint=codepoint@entry=0x7ffff4ea1334, buf=buf@entry=0x7ffff4ea1330 "(%`", 
    len=len@entry=0x7ffff4ea1338) at ports.c:1460
1460	      update_port_lf (*codepoint, port);
(gdb) bt
#0  get_codepoint (port=port@entry=0xe13ff0, codepoint=codepoint@entry=0x7ffff4ea1334, buf=buf@entry=0x7ffff4ea1330 "(%`", 
    len=len@entry=0x7ffff4ea1338) at ports.c:1460
#1  0x00007ffff7ae93ea in scm_peek_char (port=0xe13ff0) at ports.c:2008
#2  0x00007ffff7b3274d in vm_regular_engine (vm=<optimized out>, program=0x7ffff7dbc958 <scm_peek_char__subr_raw_cell>, argv=<optimized out>, 
    nargs=1) at vm-i-system.c:852
#3  0x00007ffff7b32738 in vm_regular_engine (vm=<optimized out>, program=0x6d27c0, argv=<optimized out>, nargs=2) at vm-i-system.c:855
#4  0x00007ffff7aa9723 in scm_call_4 (proc=0x7ae570, arg1=arg1@entry=0x404, arg2=<optimized out>, arg3=<optimized out>, arg4=<optimized out>)
    at eval.c:507
#5  0x00007ffff7b1c854 in scm_catch_with_pre_unwind_handler (key=key@entry=0x404, thunk=<optimized out>, handler=<optimized out>, 
    pre_unwind_handler=<optimized out>) at throw.c:86
#6  0x00007ffff7b1ca2f in scm_c_catch (tag=tag@entry=0x404, body=body@entry=0x7ffff7aa03f0 <scm_body>, body_data=body_data@entry=0x7ffff4ea1810, 
    handler=handler@entry=0x7ffff7aa03d0 <scm_handler>, handler_data=handler_data@entry=0x7ffff4ea1810, 
    pre_unwind_handler=pre_unwind_handler@entry=0x7ffff7aa0290 <pre_unwind_handler>, 
    pre_unwind_handler_data=pre_unwind_handler_data@entry=0x6d8eb0) at throw.c:213
#7  0x00007ffff7aa086f in scm_i_with_continuation_barrier (body=body@entry=0x7ffff7aa03f0 <scm_body>, body_data=body_data@entry=0x7ffff4ea1810, 
    handler=handler@entry=0x7ffff7aa03d0 <scm_handler>, handler_data=handler_data@entry=0x7ffff4ea1810, 
    pre_unwind_handler=pre_unwind_handler@entry=0x7ffff7aa0290 <pre_unwind_handler>, pre_unwind_handler_data=0x6d8eb0) at continuations.c:449
#8  0x00007ffff7aa08c0 in scm_with_continuation_barrier (proc=<optimized out>) at continuations.c:589
#9  0x00007ffff7b3274d in vm_regular_engine (vm=<optimized out>, program=0x7ffff7db4fc0 <scm_with_continuation_barrier__subr_raw_cell>, 
    argv=<optimized out>, nargs=1) at vm-i-system.c:852
#10 0x00007ffff7aa96de in scm_call_3 (proc=0x7ae570, arg1=arg1@entry=0x404, arg2=arg2@entry=0xe11f00, arg3=arg3@entry=0xcc6440) at eval.c:500
#11 0x00007ffff7b1c7bd in scm_catch (key=key@entry=0x404, thunk=thunk@entry=0xe11f00, handler=handler@entry=0xcc6440) at throw.c:73
#12 0x00007ffff7b1a9f5 in really_launch (d=0x7ffff5ea3780) at threads.c:1009
#13 0x00007ffff7aa013a in c_body (d=0x7ffff4ea1d40) at continuations.c:511
#14 0x00007ffff7b32738 in vm_regular_engine (vm=<optimized out>, program=0x6d27c0, argv=<optimized out>, nargs=2) at vm-i-system.c:855
#15 0x00007ffff7aa9723 in scm_call_4 (proc=0x7ae570, arg1=arg1@entry=0x404, arg2=<optimized out>, arg3=<optimized out>, arg4=<optimized out>)
    at eval.c:507
#16 0x00007ffff7b1c854 in scm_catch_with_pre_unwind_handler (key=key@entry=0x404, thunk=<optimized out>, handler=<optimized out>, 
    pre_unwind_handler=<optimized out>) at throw.c:86
#17 0x00007ffff7b1ca2f in scm_c_catch (tag=tag@entry=0x404, body=body@entry=0x7ffff7aa0130 <c_body>, body_data=body_data@entry=0x7ffff4ea1d40, 
    handler=handler@entry=0x7ffff7aa04e0 <c_handler>, handler_data=handler_data@entry=0x7ffff4ea1d40, 
    pre_unwind_handler=pre_unwind_handler@entry=0x7ffff7aa0290 <pre_unwind_handler>, 
    pre_unwind_handler_data=pre_unwind_handler_data@entry=0x6d8eb0) at throw.c:213
#18 0x00007ffff7aa086f in scm_i_with_continuation_barrier (body=body@entry=0x7ffff7aa0130 <c_body>, body_data=body_data@entry=0x7ffff4ea1d40, 
    handler=handler@entry=0x7ffff7aa04e0 <c_handler>, handler_data=handler_data@entry=0x7ffff4ea1d40, 
    pre_unwind_handler=pre_unwind_handler@entry=0x7ffff7aa0290 <pre_unwind_handler>, pre_unwind_handler_data=0x6d8eb0) at continuations.c:449
#19 0x00007ffff7aa0905 in scm_c_with_continuation_barrier (func=<optimized out>, data=<optimized out>) at continuations.c:545
#20 0x00007ffff7b1a21c in with_guile_and_parent (base=0x7ffff4ea1da0, data=0x7ffff4ea1dd0) at threads.c:908
#21 0x00007ffff6cf3e72 in GC_call_with_stack_base () from /usr/lib/x86_64-linux-gnu/libgc.so.1
#22 0x00007ffff7b19bdc in scm_i_with_guile_and_parent (parent=<optimized out>, data=0x7ffff5ea3780, func=0x7ffff7b1a990 <really_launch>)
    at threads.c:951
---Type <return> to continue, or q <return> to quit---
#23 launch_thread (d=0x7ffff5ea3780) at threads.c:1019
#24 0x00007ffff6cf8b83 in GC_inner_start_routine () from /usr/lib/x86_64-linux-gnu/libgc.so.1
#25 0x00007ffff6cf3e72 in GC_call_with_stack_base () from /usr/lib/x86_64-linux-gnu/libgc.so.1
#26 0x00007ffff72fae0e in start_thread (arg=0x7ffff4ea2700) at pthread_create.c:311
#27 0x00007ffff70300fd in clone () at ../sysdeps/unix/sysv/linux/x86_64/clone.S:113

> Please see below for comments.

Thanks for the further review.  Updated patch attached.  My technical
writing skills aren't what they should be, so an extra thanks for
helping with the documentation.

- Dave


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-cooperative-REPL-server-module.patch --]
[-- Type: text/x-diff, Size: 12671 bytes --]

From 952e2b3f199031896996b33bc058e42586cbc69e Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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 | 156 +++++++++++++++++++++++++++++++++++++
 module/system/repl/repl.scm        |  11 ++-
 module/system/repl/server.scm      |   5 +-
 5 files changed, 216 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..4c8dc77
--- /dev/null
+++ b/module/system/repl/coop-server.scm
@@ -0,0 +1,156 @@
+;;; 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)
+  "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)
+  "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)))
+  "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..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


^ permalink raw reply related	[flat|nested] 8+ messages in thread

* Re: Fwd: PATCH - Add cooperative REPL server module
  2014-01-22  1:51             ` David Thompson
@ 2014-01-22  3:36               ` Mark H Weaver
  2014-01-22 12:17                 ` David Thompson
  2014-01-22  4:20               ` 'stop-server-and-clients!' can cause crash (was PATCH - Add cooperative REPL server module) Mark H Weaver
  1 sibling, 1 reply; 8+ messages in thread
From: Mark H Weaver @ 2014-01-22  3:36 UTC (permalink / raw)
  To: David Thompson; +Cc: guile-devel

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.

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 :)

   Thanks again!
       Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: 'stop-server-and-clients!' can cause crash (was PATCH - Add cooperative REPL server module)
  2014-01-22  1:51             ` David Thompson
  2014-01-22  3:36               ` Mark H Weaver
@ 2014-01-22  4:20               ` Mark H Weaver
  1 sibling, 0 replies; 8+ messages in thread
From: Mark H Weaver @ 2014-01-22  4:20 UTC (permalink / raw)
  To: David Thompson; +Cc: guile-devel

David Thompson <dthompson2@worcester.edu> writes:

> Mark H Weaver <mhw@netris.org> writes:
>
>> Interesting.  Does it happen with unmodified stable-2.0?  If so, I think
>> we can treat this as an independent bug.
>
> Yes, exact same problem on stable-2.0.
>
>> 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.
>
> Here's the output from gdb:
>
> Program received signal SIGSEGV, Segmentation fault.
> [Switching to Thread 0x7ffff4ea2700 (LWP 13122)]
> get_codepoint (port=port@entry=0xe13ff0, codepoint=codepoint@entry=0x7ffff4ea1334, buf=buf@entry=0x7ffff4ea1330 "(%`", 
>     len=len@entry=0x7ffff4ea1338) at ports.c:1460
> 1460	      update_port_lf (*codepoint, port);

Ah yes, this makes sense.  Ports in stable-2.0 are not thread-safe even
for normal operations, and in this case 'stop-server-and-clients!' is
_closing_ a port that's currently in use by another thread.

In other words, 'stop-server-and-clients!' is fundamentally unsafe in
the way it works, and probably has been since it was introduced.

Thanks for the debugging.  I'll think about how best to fix this.

     Mark



^ permalink raw reply	[flat|nested] 8+ messages in thread

* Re: Fwd: PATCH - Add cooperative REPL server module
  2014-01-22  3:36               ` Mark H Weaver
@ 2014-01-22 12:17                 ` David Thompson
  0 siblings, 0 replies; 8+ messages in thread
From: David Thompson @ 2014-01-22 12:17 UTC (permalink / raw)
  To: Mark H Weaver; +Cc: guile-devel

[-- Attachment #1: Type: text/plain, Size: 543 bytes --]

Mark H Weaver <mhw@netris.org> 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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Add-cooperative-REPL-server-module.patch --]
[-- Type: text/x-diff, Size: 12944 bytes --]

From 9ec93726bf96c38ff1a6b704269578f1a1081962 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
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 <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


^ permalink raw reply related	[flat|nested] 8+ messages in thread

end of thread, other threads:[~2014-01-22 12:17 UTC | newest]

Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2014-01-19 19:39 PATCH - Add cooperative REPL server module David Thompson
2014-01-20  0:52 ` Mark H Weaver
     [not found]   ` <874n4yoc5b.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me>
     [not found]     ` <87d2jmpn4e.fsf@netris.org>
     [not found]       ` <874n4ynsbw.fsf@izanagi.i-did-not-set--mail-host-address--so-tickle-me>
2014-01-20 23:36         ` Fwd: " Thompson, David
2014-01-21  4:21           ` Mark H Weaver
2014-01-22  1:51             ` David Thompson
2014-01-22  3:36               ` Mark H Weaver
2014-01-22 12:17                 ` David Thompson
2014-01-22  4:20               ` 'stop-server-and-clients!' can cause crash (was PATCH - Add cooperative REPL server module) Mark H Weaver

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).