Commit | Line | Data |
---|---|---|
ea9c5dab | 1 | ;;; Repl common routines |
17e90c5e KN |
2 | |
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
5 | ;; This program is free software; you can redistribute it and/or modify | |
6 | ;; it under the terms of the GNU General Public License as published by | |
7 | ;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;; any later version. | |
9 | ;; | |
10 | ;; This program is distributed in the hope that it will be useful, | |
11 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;; GNU General Public License for more details. | |
14 | ;; | |
15 | ;; You should have received a copy of the GNU General Public License | |
16 | ;; along with this program; see the file COPYING. If not, write to | |
17 | ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
18 | ;; Boston, MA 02111-1307, USA. | |
19 | ||
20 | ;;; Code: | |
21 | ||
22 | (define-module (system repl common) | |
17e90c5e | 23 | :use-syntax (system base syntax) |
8f5cfc81 | 24 | :use-module (system base compile) |
17e90c5e | 25 | :use-module (system base language) |
ce0925e1 AW |
26 | :use-module (system vm core) |
27 | :export (<repl> make-repl repl-env repl-options repl-tm-stats | |
28 | repl-gc-stats repl-vm-stats)) | |
17e90c5e KN |
29 | |
30 | \f | |
31 | ;;; | |
8f5cfc81 | 32 | ;;; Repl type |
17e90c5e KN |
33 | ;;; |
34 | ||
ac99cb0c | 35 | (define-record (<repl> env options tm-stats gc-stats vm-stats)) |
f21dfea6 KN |
36 | |
37 | (define repl-default-options | |
24aa2715 | 38 | '((trace . #f))) |
17e90c5e | 39 | |
849cefac | 40 | (define %make-repl make-repl) |
ce0925e1 | 41 | (define (make-repl lang) |
8f5cfc81 KN |
42 | (let ((cenv (make-cenv :vm (the-vm) |
43 | :language (lookup-language lang) | |
44 | :module (current-module)))) | |
849cefac AW |
45 | (%make-repl :env cenv |
46 | :options repl-default-options | |
47 | :tm-stats (times) | |
48 | :gc-stats (gc-stats) | |
44f38a1f | 49 | :vm-stats (vm-stats (cenv-vm cenv))))) |
17e90c5e | 50 | |
8f5cfc81 | 51 | (define-public (repl-welcome repl) |
44f38a1f AW |
52 | (let ((language (cenv-language (repl-env repl)))) |
53 | (format #t "~A interpreter ~A on Guile ~A\n" | |
54 | (language-title language) (language-version language) (version))) | |
17e90c5e KN |
55 | (display "Copyright (C) 2001 Free Software Foundation, Inc.\n\n") |
56 | (display "Enter `,help' for help.\n")) | |
57 | ||
8f5cfc81 | 58 | (define-public (repl-prompt repl) |
44f38a1f AW |
59 | (format #t "~A@~A> " (language-name (cenv-language (repl-env repl))) |
60 | (module-name (cenv-module (repl-env repl)))) | |
61 | (force-output)) | |
17e90c5e | 62 | |
8f5cfc81 | 63 | (define-public (repl-read repl) |
44f38a1f | 64 | ((language-reader (cenv-language (repl-env repl))))) |
17e90c5e | 65 | |
8f5cfc81 | 66 | (define-public (repl-compile repl form . opts) |
44f38a1f AW |
67 | (apply compile-in form (cenv-module (repl-env repl)) |
68 | (cenv-language (repl-env repl)) opts)) | |
17e90c5e | 69 | |
8f5cfc81 | 70 | (define-public (repl-eval repl form) |
44f38a1f | 71 | (let ((eval (language-evaluator (cenv-language (repl-env repl))))) |
cb4cca12 | 72 | (if eval |
44f38a1f AW |
73 | (eval form (cenv-module (repl-env repl))) |
74 | (vm-load (cenv-vm (repl-env repl)) (repl-compile repl form))))) | |
17e90c5e | 75 | |
8f5cfc81 | 76 | (define-public (repl-print repl val) |
17e90c5e | 77 | (if (not (eq? val *unspecified*)) |
8f5cfc81 | 78 | (begin |
44f38a1f | 79 | ((language-printer (cenv-language (repl-env repl))) val) |
8f5cfc81 KN |
80 | (newline)))) |
81 | ||
f21dfea6 | 82 | (define-public (repl-option-ref repl key) |
44f38a1f | 83 | (assq-ref (repl-options repl) key)) |
f21dfea6 KN |
84 | |
85 | (define-public (repl-option-set! repl key val) | |
44f38a1f | 86 | (set! (repl-options repl) (assq-set! (repl-options repl) key val))) |
f21dfea6 | 87 | |
8f5cfc81 KN |
88 | \f |
89 | ;;; | |
90 | ;;; Utilities | |
91 | ;;; | |
92 | ||
93 | (define-public (puts x) (display x) (newline)) | |
94 | ||
95 | (define-public (->string x) | |
96 | (object->string x display)) | |
97 | ||
98 | (define-public (user-error msg . args) | |
99 | (throw 'user-error #f msg args #f)) |