guix/repl.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (guix repl)
  20   #:use-module (rnrs bytevectors)
  21   #:use-module (ice-9 match)
  22   #:export (send-repl-response
  23             machine-repl))
  24
  25 ;;; Commentary:
  26 ;;;
  27 ;;; This module implements the "machine-readable" REPL provided by
  28 ;;; 'guix repl -t machine'.  It's a lightweight module meant to be
  29 ;;; embedded in any Guile process providing REPL functionality.
  30 ;;;
  31 ;;; Code:
  32
  33 (define (self-quoting? x)
  34   "Return #t if X is self-quoting."
  35   (letrec-syntax ((one-of (syntax-rules ()
  36                             ((_) #f)
  37                             ((_ pred rest ...)
  38                              (or (pred x)
  39                                  (one-of rest ...))))))
  40     (one-of symbol? string? pair? null? vector?
  41             bytevector? number? boolean?)))
  42
  43
  44 (define (send-repl-response exp output)
  45   "Write the response corresponding to the evaluation of EXP to PORT, an
  46 output port."
  47   (define (value->sexp value)
  48     (if (self-quoting? value)
  49         `(value ,value)
  50         `(non-self-quoting ,(object-address value)
  51                            ,(object->string value))))
  52
  53   (catch #t
  54     (lambda ()
  55       (let ((results (call-with-values
  56                          (lambda ()
  57                            (primitive-eval exp))
  58                        list)))
  59         (write `(values ,@(map value->sexp results))
  60                output)
  61         (newline output)
  62         (force-output output)))
  63     (lambda (key . args)
  64       (write `(exception ,key ,@(map value->sexp args)))
  65       (newline output)
  66       (force-output output))))
  67
  68 (define* (machine-repl #:optional
  69                        (input (current-input-port))
  70                        (output (current-output-port)))
  71   "Run a machine-usable REPL over ports INPUT and OUTPUT.
  72
  73 The protocol of this REPL is meant to be machine-readable and provides proper
  74 support to represent multiple-value returns, exceptions, objects that lack a
  75 read syntax, and so on.  As such it is more convenient and robust than parsing
  76 Guile's REPL prompt."
  77   (write `(repl-version 0 0) output)
  78   (newline output)
  79   (force-output output)
  80
  81   (let loop ()
  82     (match (read input)
  83       ((? eof-object?) #t)
  84       (exp
  85        (send-repl-response exp output)
  86        (loop)))))