diff mbox series

[bug#36162,2/4] Add (guix repl).

Message ID 20190610214130.19378-2-ludo@gnu.org
State Accepted
Headers show
Series [bug#36162,1/4] gexp: Add 'lower-gexp' and express'gexp->derivation' in terms of it. | expand

Checks

Context Check Description
cbaines/applying patch success Successfully applied

Commit Message

Ludovic Courtès June 10, 2019, 9:41 p.m. UTC
* guix/scripts/repl.scm: Use (guix repl).
(self-quoting?, machine-repl): Remove.
* guix/repl.scm: New file.
* Makefile.am (MODULES): Add it.
---
 Makefile.am           |  1 +
 guix/repl.scm         | 86 +++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/repl.scm | 56 ++--------------------------
 3 files changed, 90 insertions(+), 53 deletions(-)
 create mode 100644 guix/repl.scm
diff mbox series

Patch

diff --git a/Makefile.am b/Makefile.am
index 80be73e4bf..0aa92ecfb9 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -90,6 +90,7 @@  MODULES =					\
   guix/nar.scm					\
   guix/derivations.scm				\
   guix/grafts.scm				\
+  guix/repl.scm					\
   guix/inferior.scm				\
   guix/describe.scm				\
   guix/channels.scm				\
diff --git a/guix/repl.scm b/guix/repl.scm
new file mode 100644
index 0000000000..5cff5c71e9
--- /dev/null
+++ b/guix/repl.scm
@@ -0,0 +1,86 @@ 
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix 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 General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix repl)
+  #:use-module (rnrs bytevectors)
+  #:use-module (ice-9 match)
+  #:export (send-repl-response
+            machine-repl))
+
+;;; Commentary:
+;;;
+;;; This module implements the "machine-readable" REPL provided by
+;;; 'guix repl -t machine'.  It's a lightweight module meant to be
+;;; embedded in any Guile process providing REPL functionality.
+;;;
+;;; Code:
+
+(define (self-quoting? x)
+  "Return #t if X is self-quoting."
+  (letrec-syntax ((one-of (syntax-rules ()
+                            ((_) #f)
+                            ((_ pred rest ...)
+                             (or (pred x)
+                                 (one-of rest ...))))))
+    (one-of symbol? string? pair? null? vector?
+            bytevector? number? boolean?)))
+
+
+(define (send-repl-response exp output)
+  "Write the response corresponding to the evaluation of EXP to PORT, an
+output port."
+  (define (value->sexp value)
+    (if (self-quoting? value)
+        `(value ,value)
+        `(non-self-quoting ,(object-address value)
+                           ,(object->string value))))
+
+  (catch #t
+    (lambda ()
+      (let ((results (call-with-values
+                         (lambda ()
+                           (primitive-eval exp))
+                       list)))
+        (write `(values ,@(map value->sexp results))
+               output)
+        (newline output)
+        (force-output output)))
+    (lambda (key . args)
+      (write `(exception ,key ,@(map value->sexp args)))
+      (newline output)
+      (force-output output))))
+
+(define* (machine-repl #:optional
+                       (input (current-input-port))
+                       (output (current-output-port)))
+  "Run a machine-usable REPL over ports INPUT and OUTPUT.
+
+The protocol of this REPL is meant to be machine-readable and provides proper
+support to represent multiple-value returns, exceptions, objects that lack a
+read syntax, and so on.  As such it is more convenient and robust than parsing
+Guile's REPL prompt."
+  (write `(repl-version 0 0) output)
+  (newline output)
+  (force-output output)
+
+  (let loop ()
+    (match (read input)
+      ((? eof-object?) #t)
+      (exp
+       (send-repl-response exp output)
+       (loop)))))
diff --git a/guix/scripts/repl.scm b/guix/scripts/repl.scm
index 02169e8004..e1cc759fc8 100644
--- a/guix/scripts/repl.scm
+++ b/guix/scripts/repl.scm
@@ -1,5 +1,5 @@ 
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,6 +19,7 @@ 
 (define-module (guix scripts repl)
   #:use-module (guix ui)
   #:use-module (guix scripts)
+  #:use-module (guix repl)
   #:use-module (guix utils)
   #:use-module (guix packages)
   #:use-module (gnu packages)
@@ -29,8 +30,7 @@ 
   #:autoload   (system repl repl) (start-repl)
   #:autoload   (system repl server)
                   (make-tcp-server-socket make-unix-domain-server-socket)
-  #:export (machine-repl
-            guix-repl))
+  #:export (guix-repl))
 
 ;;; Commentary:
 ;;;
@@ -68,62 +68,12 @@  Start a Guile REPL in the Guix execution environment.\n"))
   (newline)
   (show-bug-report-information))
 
-(define (self-quoting? x)
-  "Return #t if X is self-quoting."
-  (letrec-syntax ((one-of (syntax-rules ()
-                            ((_) #f)
-                            ((_ pred rest ...)
-                             (or (pred x)
-                                 (one-of rest ...))))))
-    (one-of symbol? string? pair? null? vector?
-            bytevector? number? boolean?)))
-
 (define user-module
   ;; Module where we execute user code.
   (let ((module (resolve-module '(guix-user) #f #f #:ensure #t)))
     (beautify-user-module! module)
     module))
 
-(define* (machine-repl #:optional
-                       (input (current-input-port))
-                       (output (current-output-port)))
-  "Run a machine-usable REPL over ports INPUT and OUTPUT.
-
-The protocol of this REPL is meant to be machine-readable and provides proper
-support to represent multiple-value returns, exceptions, objects that lack a
-read syntax, and so on.  As such it is more convenient and robust than parsing
-Guile's REPL prompt."
-  (define (value->sexp value)
-    (if (self-quoting? value)
-        `(value ,value)
-        `(non-self-quoting ,(object-address value)
-                           ,(object->string value))))
-
-  (write `(repl-version 0 0) output)
-  (newline output)
-  (force-output output)
-
-  (let loop ()
-    (match (read input)
-      ((? eof-object?) #t)
-      (exp
-       (catch #t
-         (lambda ()
-           (let ((results (call-with-values
-                              (lambda ()
-
-                                (primitive-eval exp))
-                            list)))
-             (write `(values ,@(map value->sexp results))
-                    output)
-             (newline output)
-             (force-output output)))
-         (lambda (key . args)
-           (write `(exception ,key ,@(map value->sexp args)))
-           (newline output)
-           (force-output output)))
-       (loop)))))
-
 (define (call-with-connection spec thunk)
   "Dynamically-bind the current input and output ports according to SPEC and
 call THUNK."