From patchwork Mon Jun 10 21:41:28 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 14283 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id E4D2217064; Mon, 10 Jun 2019 22:44:43 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00 autolearn=ham autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 6058C1704B for ; Mon, 10 Jun 2019 22:44:43 +0100 (BST) Received: from localhost ([::1]:49924 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1haS5q-0005Cv-Vk for patchwork@mira.cbaines.net; Mon, 10 Jun 2019 17:44:42 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]:35133) by lists.gnu.org with esmtp (Exim 4.86_2) (envelope-from ) id 1haS3I-0003QE-5R for guix-patches@gnu.org; Mon, 10 Jun 2019 17:42:06 -0400 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1haS3G-0001K4-EB for guix-patches@gnu.org; Mon, 10 Jun 2019 17:42:04 -0400 Received: from debbugs.gnu.org ([209.51.188.43]:44040) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1haS3G-0001Jv-9D for guix-patches@gnu.org; Mon, 10 Jun 2019 17:42:02 -0400 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1haS3G-0006Jm-5o for guix-patches@gnu.org; Mon, 10 Jun 2019 17:42:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#36162] [PATCH 2/4] Add (guix repl). Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Mon, 10 Jun 2019 21:42:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 36162 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 36162@debbugs.gnu.org Received: via spool by 36162-submit@debbugs.gnu.org id=B36162.156020291324251 (code B ref 36162); Mon, 10 Jun 2019 21:42:02 +0000 Received: (at 36162) by debbugs.gnu.org; 10 Jun 2019 21:41:53 +0000 Received: from localhost ([127.0.0.1]:57579 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1haS36-0006J4-Cs for submit@debbugs.gnu.org; Mon, 10 Jun 2019 17:41:52 -0400 Received: from eggs.gnu.org ([209.51.188.92]:54461) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1haS33-0006IS-NU for 36162@debbugs.gnu.org; Mon, 10 Jun 2019 17:41:50 -0400 Received: from fencepost.gnu.org ([2001:470:142:3::e]:60153) by eggs.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1haS2y-00017C-FS; Mon, 10 Jun 2019 17:41:44 -0400 Received: from [2a01:e0a:1d:7270:af76:b9b:ca24:c465] (port=33892 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:DHE_RSA_AES_256_CBC_SHA1:256) (Exim 4.82) (envelope-from ) id 1haS2u-0001fJ-Ve; Mon, 10 Jun 2019 17:41:42 -0400 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Mon, 10 Jun 2019 23:41:28 +0200 Message-Id: <20190610214130.19378-2-ludo@gnu.org> X-Mailer: git-send-email 2.21.0 In-Reply-To: <20190610214130.19378-1-ludo@gnu.org> References: <20190610214130.19378-1-ludo@gnu.org> MIME-Version: 1.0 X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 --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 +;;; +;;; 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 . + +(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 +;;; Copyright © 2018, 2019 Ludovic Courtès ;;; ;;; 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."