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) | |
92a4087b LC |
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 ...)))))) | |
7abd5997 LC |
39 | (one-of symbol? string? keyword? pair? null? array? |
40 | number? boolean?))) | |
92a4087b LC |
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))))) |