Commit | Line | Data |
---|---|---|
ea9c5dab | 1 | ;;; Repl common routines |
17e90c5e KN |
2 | |
3 | ;; Copyright (C) 2001 Free Software Foundation, Inc. | |
4 | ||
e1203ea0 LC |
5 | ;;; This library is free software; you can redistribute it and/or |
6 | ;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;; License as published by the Free Software Foundation; either | |
8 | ;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;; | |
10 | ;;; This library 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 GNU | |
13 | ;;; Lesser General Public License for more details. | |
14 | ;;; | |
15 | ;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;; License along with this library; if not, write to the Free Software | |
17 | ;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
17e90c5e KN |
18 | |
19 | ;;; Code: | |
20 | ||
21 | (define-module (system repl common) | |
8239263f | 22 | #:use-module (system base syntax) |
1a1a10d3 AW |
23 | #:use-module (system base compile) |
24 | #:use-module (system base language) | |
25 | #:use-module (system vm vm) | |
26 | #:export (<repl> make-repl repl-vm repl-language repl-options | |
b0b180d5 AW |
27 | repl-tm-stats repl-gc-stats repl-vm-stats |
28 | repl-welcome repl-prompt repl-read repl-compile repl-eval | |
29 | repl-parse repl-print repl-option-ref repl-option-set! | |
30 | puts ->string user-error)) | |
17e90c5e KN |
31 | |
32 | \f | |
33 | ;;; | |
8f5cfc81 | 34 | ;;; Repl type |
17e90c5e KN |
35 | ;;; |
36 | ||
d9d671f7 | 37 | (define-record/keywords <repl> vm language options tm-stats gc-stats vm-stats) |
f21dfea6 KN |
38 | |
39 | (define repl-default-options | |
02ed0d3d AW |
40 | '((trace . #f) |
41 | (interp . #f))) | |
17e90c5e | 42 | |
849cefac | 43 | (define %make-repl make-repl) |
ce0925e1 | 44 | (define (make-repl lang) |
1a1a10d3 AW |
45 | (%make-repl #:vm (the-vm) |
46 | #:language (lookup-language lang) | |
47 | #:options repl-default-options | |
48 | #:tm-stats (times) | |
49 | #:gc-stats (gc-stats) | |
50 | #:vm-stats (vm-stats (the-vm)))) | |
17e90c5e | 51 | |
f116f923 | 52 | (define (repl-welcome repl) |
db917b41 | 53 | (let ((language (repl-language repl))) |
44f38a1f AW |
54 | (format #t "~A interpreter ~A on Guile ~A\n" |
55 | (language-title language) (language-version language) (version))) | |
db917b41 | 56 | (display "Copyright (C) 2001-2008 Free Software Foundation, Inc.\n\n") |
17e90c5e KN |
57 | (display "Enter `,help' for help.\n")) |
58 | ||
f116f923 | 59 | (define (repl-prompt repl) |
db917b41 AW |
60 | (format #f "~A@~A> " (language-name (repl-language repl)) |
61 | (module-name (current-module)))) | |
17e90c5e | 62 | |
f116f923 | 63 | (define (repl-read repl) |
db917b41 | 64 | ((language-reader (repl-language repl)))) |
17e90c5e | 65 | |
f116f923 | 66 | (define (repl-compile repl form . opts) |
b0b180d5 AW |
67 | (let ((to (lookup-language (cond ((memq #:e opts) 'scheme) |
68 | ((memq #:t opts) 'ghil) | |
69 | ((memq #:c opts) 'glil) | |
70 | (else 'objcode))))) | |
71 | (compile form #:from (repl-language repl) #:to to #:opts opts))) | |
72 | ||
73 | (define (repl-parse repl form) | |
74 | (let ((parser (language-parser (repl-language repl)))) | |
75 | (if parser (parser form) form))) | |
17e90c5e | 76 | |
f116f923 | 77 | (define (repl-eval repl form) |
db917b41 | 78 | (let ((eval (language-evaluator (repl-language repl)))) |
02ed0d3d | 79 | (if (and eval |
b0b180d5 | 80 | (or (null? (language-compilers (repl-language repl))) |
02ed0d3d | 81 | (assq-ref (repl-options repl) 'interp))) |
b0b180d5 AW |
82 | (eval form (current-module)) |
83 | (vm-load (repl-vm repl) (repl-compile repl form '()))))) | |
17e90c5e | 84 | |
f116f923 | 85 | (define (repl-print repl val) |
17e90c5e | 86 | (if (not (eq? val *unspecified*)) |
8f5cfc81 | 87 | (begin |
f38624b3 AW |
88 | ;; The result of an evaluation is representable in scheme, and |
89 | ;; should be printed with the generic printer, `write'. The | |
90 | ;; language-printer is something else: it prints expressions of | |
91 | ;; a given language, not the result of evaluation. | |
92 | (write val) | |
8f5cfc81 KN |
93 | (newline)))) |
94 | ||
f116f923 | 95 | (define (repl-option-ref repl key) |
44f38a1f | 96 | (assq-ref (repl-options repl) key)) |
f21dfea6 | 97 | |
f116f923 | 98 | (define (repl-option-set! repl key val) |
44f38a1f | 99 | (set! (repl-options repl) (assq-set! (repl-options repl) key val))) |
f21dfea6 | 100 | |
8f5cfc81 KN |
101 | \f |
102 | ;;; | |
103 | ;;; Utilities | |
104 | ;;; | |
105 | ||
f116f923 | 106 | (define (puts x) (display x) (newline)) |
8f5cfc81 | 107 | |
f116f923 | 108 | (define (->string x) |
8f5cfc81 KN |
109 | (object->string x display)) |
110 | ||
f116f923 | 111 | (define (user-error msg . args) |
8f5cfc81 | 112 | (throw 'user-error #f msg args #f)) |