Commit | Line | Data |
---|---|---|
92a4087b LC |
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))))) |