mescc: Mes C Library: Add buffered read.
[mes.git] / mes / module / mes / repl.mes
1 ;;; -*-scheme-*-
2
3 ;;; GNU Mes --- Maxwell Equations of Software
4 ;;; Copyright © 2016,2017,2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
5 ;;;
6 ;;; This file is part of GNU Mes.
7 ;;;
8 ;;; GNU Mes is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
12 ;;;
13 ;;; GNU Mes is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;;; GNU General Public License for more details.
17 ;;;
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Commentary:
22
23 ;;; repl.mes defines repl, a repl for Mes.
24
25 ;;; Code:
26
27 (mes-use-module (mes scm))
28 (mes-use-module (srfi srfi-14))
29
30 (define welcome
31   (string-append "GNU Mes " %version "
32 Copyright (C) 2016,2017,2018,2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
33
34 GNU Mes comes with ABSOLUTELY NO WARRANTY; for details type `,show w'.
35 This program is free software, and you are welcome to redistribute it
36 under certain conditions; type `,show c' for details.
37
38 Enter `,help' for help.
39 "))
40
41 (define warranty
42 "GNU Mes is distributed WITHOUT ANY WARRANTY.  The following
43 sections from the GNU General Public License, version 3, should
44 make that clear.
45
46   15. Disclaimer of Warranty.
47
48   THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
49 APPLICABLE LAW.  EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
50 HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM \"AS IS\" WITHOUT WARRANTY
51 OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
52 THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
53 PURPOSE.  THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
54 IS WITH YOU.  SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
55 ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
56
57   16. Limitation of Liability.
58
59   IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
60 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
61 THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
62 GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
63 USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
64 DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
65 PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
66 EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
67 SUCH DAMAGES.
68
69   17. Interpretation of Sections 15 and 16.
70
71   If the disclaimer of warranty and limitation of liability provided
72 above cannot be given local legal effect according to their terms,
73 reviewing courts shall apply local law that most closely approximates
74 an absolute waiver of all civil liability in connection with the
75 Program, unless a warranty or assumption of liability accompanies a
76 copy of the Program in return for a fee.
77
78 See <http://www.gnu.org/licenses/gpl.html>, for more details.
79 ")
80
81 (define copying
82 "GNU Mes is free software; you can redistribute it and/or modify it
83 under the terms of the GNU General Public License as published by
84 the Free Software Foundation; either version 3 of the License, or (at
85 your option) any later version.
86
87 GNU Mes is distributed in the hope that it will be useful, but
88 WITHOUT ANY WARRANTY; without even the implied warranty of
89 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
90 GNU General Public License for more details.
91
92 You should have received a copy of the GNU General Public License
93 along with GNU Mes.  If not, see <http://www.gnu.org/licenses/>.
94 ")
95
96 (define help-commands
97   "Help Commands:
98
99   ,expand SEXP         - Expand SEXP
100   ,help                - Show this help
101   ,quit                - Quit this session
102   ,show TOPIC          - Show info on TOPIC [c, w]
103   ,use MODULE          - load MODULE
104 ")
105
106 (define show-commands
107   "Show commands:
108
109   ,show c              - Show details on licensing; GNU GPLv3+
110   ,show w              - Show details on the lack of warranty
111 ")
112
113 (define (repl)
114   (let ((count 0)
115         (print-sexp? #t))
116
117     (define (expand a)
118       (lambda ()
119         (let ((sexp (read)))
120           (when #t print-sexp?
121                 (display "[sexp=")
122                 (display sexp)
123                 (display "]")
124                 (newline))
125           (core:macro-expand sexp))))
126
127     (define (help . x) (display help-commands) *unspecified*)
128     (define (show . x)
129       (define topic-alist `((#\newline . ,show-commands)
130                             (#\c . ,copying)
131                             (#\w . ,warranty)))
132       (let* ((word (read-env '()))
133              (topic (find (negate char-whitespace?) (symbol->list word))))
134         (display (assoc-ref topic-alist topic))
135         *unspecified*))
136     (define (quit . x)
137       (exit 0))
138     (define (use a)
139       (lambda ()
140         (let ((module (read)))
141           (mes-load-module-env module a))))
142     (define (meta command a)
143       (let ((command-alist `((expand . ,(expand a))
144                              (help . ,help)
145                              (quit . ,quit)
146                              (show . ,show)
147                              (use . ,(use a)))))
148         ((or (assoc-ref command-alist command)
149              (lambda () #f)))))
150
151     (display welcome)
152     (let loop ((a (current-module)))
153       (display "mes> ")
154       (force-output)
155       (catch #t
156         (lambda ()
157           (let ((sexp (read-env a)))
158             (when (not (eq? sexp '()))
159               (when print-sexp?
160                 (display "[sexp=")
161                 (display sexp)
162                 (display "]")
163                 (newline))
164               (if (and (pair? sexp) (eq? (car sexp) 'mes-use-module))
165                   (loop (mes-load-module-env (cadr sexp) a))
166                   (let ((e (if (and (pair? sexp) (eq? (car sexp) (string->symbol "unquote")))
167                                (meta (cadr sexp) a)
168                                (core:eval sexp a))))
169                     (if (eq? e *unspecified*) (loop a)
170                         (let ((id (string->symbol (string-append "$" (number->string count)))))
171                           (set! count (+ count 1))
172                           (display id)
173                           (display " = ")
174                           (write e)
175                           (newline)
176                           (loop (acons id e a)))))))))
177         (lambda (key . args)
178           (if (defined? 'with-output-to-string)
179               (simple-format (current-error-port) "exception:~a:~a\n" key args)
180               (begin
181                 (display "exception:" (current-error-port))
182                 (display key (current-error-port))
183                 (display ":" (current-error-port))
184                 (display args (current-error-port))
185                 (newline (current-error-port))))
186           (loop a))))))