guile-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: PATCH - Add cooperative REPL server module


From: Mark H Weaver
Subject: Re: PATCH - Add cooperative REPL server module
Date: Sun, 19 Jan 2014 19:52:24 -0500
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/24.3 (gnu/linux)

Hi David,

David Thompson <address@hidden> 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 <address@hidden>
> Date: Sun, 19 Jan 2014 13:16:02 -0500
> Subject: [PATCH] Add cooperative REPL server module.
>
> * module/system/repl/coop-server.scm: New module.

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
> address@hidden
> -(use-modules (system repl server))
> address@hidden 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:
> address@hidden
> +(use-modules (system repl server))
> address@hidden 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.

> address@hidden {Scheme Procedure} run-coop-server [server-socket]
> address@hidden {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.
> +
> address@hidden runs the server in the current thread, whereas
> address@hidden runs the server in a new thread.
> address@hidden deffn
> +
> address@hidden {Scheme Procedure} poll-coop-server

How about 'poll-coop-repl-server'?

> +Poll the server and evaluate a pending expression if there is one.
> address@hidden 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))))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]