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 (ice-9 match)
  21   #:export (send-repl-response
  22             machine-repl))
  23
  24 ;;; Commentary:
  25 ;;;
  26 ;;; This module implements the "machine-readable" REPL provided by
  27 ;;; 'guix repl -t machine'.  It's a lightweight module meant to be
  28 ;;; embedded in any Guile process providing REPL functionality.
  29 ;;;
  30 ;;; Code:
  31
  32 (define (self-quoting? x)
  33   "Return #t if X is self-quoting."
  34   (letrec-syntax ((one-of (syntax-rules ()
  35                             ((_) #f)
  36                             ((_ pred rest ...)
  37                              (or (pred x)
  38                                  (one-of rest ...))))))
  39     (one-of symbol? string? keyword? pair? null? array?
  40             number? boolean? char?)))
  41
  42 (define (send-repl-response exp output)
  43   "Write the response corresponding to the evaluation of EXP to PORT, an
  44 output port."
  45   (define (value->sexp value)
  46     (if (self-quoting? value)
  47         `(value ,value)
  48         `(non-self-quoting ,(object-address value)
  49                            ,(object->string value))))
  50
  51   (catch #t
  52     (lambda ()
  53       (let ((results (call-with-values
  54                          (lambda ()
  55                            (primitive-eval exp))
  56                        list)))
  57         (write `(values ,@(map value->sexp results))
  58                output)
  59         (newline output)
  60         (force-output output)))
  61     (lambda (key . args)
  62       (write `(exception ,key ,@(map value->sexp args)))
  63       (newline output)
  64       (force-output output))))
  65
  66 (define* (machine-repl #:optional
  67                        (input (current-input-port))
  68                        (output (current-output-port)))
  69   "Run a machine-usable REPL over ports INPUT and OUTPUT.
  70
  71 The protocol of this REPL is meant to be machine-readable and provides proper
  72 support to represent multiple-value returns, exceptions, objects that lack a
  73 read syntax, and so on.  As such it is more convenient and robust than parsing
  74 Guile's REPL prompt."
  75   (write `(repl-version 0 0) output)
  76   (newline output)
  77   (force-output output)
  78
  79   (let loop ()
  80     (match (read input)
  81       ((? eof-object?) #t)
  82       (exp
  83        (send-repl-response exp output)
  84        (loop)))))