/* [<][>][^][v][top][bottom][index][help] */
DEFINITIONS
This source file includes following definitions.
- repl_print_cc
- repl_eval_cc
- repl_read_cc
- repl_prompt_cc
- repl_main
- repl_error_handle
- repl_loop_cc
- Scm_VMRepl
- repl_proc
- Scm_Repl
- Scm__InitRepl
1 /*
2 * repl.c - repl
3 *
4 * Copyright (c) 2000-2004 Shiro Kawai, All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * 1. Redistributions of source code must retain the above copyright
11 * notice, this list of conditions and the following disclaimer.
12 *
13 * 2. Redistributions in binary form must reproduce the above copyright
14 * notice, this list of conditions and the following disclaimer in the
15 * documentation and/or other materials provided with the distribution.
16 *
17 * 3. Neither the name of the authors nor the names of its contributors
18 * may be used to endorse or promote products derived from this
19 * software without specific prior written permission.
20 *
21 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
22 * "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
23 * LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
24 * A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
25 * OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
26 * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
27 * TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
28 * PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
29 * LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
30 * NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
31 * SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
32 *
33 * $Id: repl.c,v 1.33 2005/05/17 04:33:09 shirok Exp $
34 */
35
36 #define LIBGAUCHE_BODY
37 #include "gauche.h"
38 #include "gauche/vm.h"
39
40 /*
41 * Conceptually, repl can be described by the following Scheme code.
42 *
43 * (define (repl reader evaluator printer prompter)
44 * (let loop1 ()
45 * (and
46 * (with-error-handler
47 * (lambda (e) (report-error e) #t)
48 * (lambda ()
49 * (prompter)
50 * (let loop2 ((exp (reader)))
51 * (if (eof-object? loop2)
52 * #f
53 * (begin
54 * (call-with-values
55 * (lambda () (evaluator exp (current-module)))
56 * printer)
57 * (loop2 (reader)))))))
58 * (loop1))))
59 *
60 * It is implemented using trampoline so that it can run without crossing
61 * C -> Scheme boundary.
62 *
63 * VMRepl -> VMWithErrorHandler -> repl_main -> prompter
64 * -> repl_prompt_cc -> reader -> repl_read_cc -> evaluator
65 * -> repl_eval_cc -> printer -> repl_print_cc -> repl_main
66 */
67
68 ScmObj Scm_VMRepl(ScmObj reader, ScmObj evaluator,
69 ScmObj printer, ScmObj prompter);
70 static ScmObj repl_main(ScmObj *args, int nargs, void *data);
71
72 /* trampolines */
73 static ScmObj repl_print_cc(ScmObj result, void **data)
74 {
75 return repl_main(NULL, 0, data);
76 }
77
78 static ScmObj repl_eval_cc(ScmObj result, void **data)
79 {
80 ScmObj *closure = (ScmObj *)data;
81 ScmObj printer = closure[2];
82 ScmVM *vm = Scm_VM();
83 if (SCM_PROCEDUREP(printer)) {
84 Scm_VMPushCC(repl_print_cc, data, 4);
85 if (vm->numVals == 1) {
86 return Scm_VMApply1(printer, result);
87 } else {
88 return Scm_VMApply(printer, Scm_VMGetResult(vm));
89 }
90 } else {
91 ScmObj result = Scm_VMGetResult(vm), cp;
92 SCM_FOR_EACH(cp, result) {
93 #if 0
94 Scm_Write(SCM_CAR(cp), SCM_OBJ(SCM_CUROUT), SCM_WRITE_WRITE);
95 #else
96 Scm_Write(SCM_CAR(cp), SCM_OBJ(SCM_CUROUT), SCM_WRITE_SHARED);
97 #endif
98 Scm_Putc('\n', SCM_CUROUT);
99 }
100 Scm_Flush(SCM_CUROUT);
101 return repl_main(NULL, 0, (void*)data);
102 }
103 }
104
105 static ScmObj repl_read_cc(ScmObj result, void **data)
106 {
107 ScmObj *closure = (ScmObj*)data;
108 ScmObj evaluator = closure[1];
109 if (SCM_EOFP(result)) {
110 return SCM_FALSE;
111 } else if (SCM_PROCEDUREP(evaluator)) {
112 Scm_VMPushCC(repl_eval_cc, data, 4);
113 return Scm_VMApply2(evaluator, result, SCM_OBJ(SCM_CURRENT_MODULE()));
114 } else {
115 Scm_VMPushCC(repl_eval_cc, data, 4);
116 return Scm_VMEval(result, SCM_FALSE);
117 }
118 }
119
120 static ScmObj repl_prompt_cc(ScmObj result, void **data)
121 {
122 ScmObj *closure = (ScmObj*)data;
123 ScmObj reader = closure[0];
124 if (SCM_PROCEDUREP(reader)) {
125 Scm_VMPushCC(repl_read_cc, data, 4);
126 return Scm_VMApply0(reader);
127 } else {
128 ScmObj exp = Scm_Read(SCM_OBJ(SCM_CURIN));
129 return repl_read_cc(exp, data);
130 }
131 }
132
133 static ScmObj repl_main(ScmObj *args, int nargs, void *data)
134 {
135 ScmObj *closure = (ScmObj*)data;
136 ScmObj prompter = closure[3];
137 if (SCM_PROCEDUREP(prompter)) {
138 Scm_VMPushCC(repl_prompt_cc, data, 4);
139 return Scm_VMApply0(prompter);
140 } else {
141 Scm_Write(SCM_MAKE_STR("gosh> "),
142 SCM_OBJ(SCM_CUROUT), SCM_WRITE_DISPLAY);
143 Scm_Flush(SCM_CUROUT);
144 return repl_prompt_cc(SCM_UNDEFINED, (void**)data);
145 }
146 }
147
148 static ScmObj repl_error_handle(ScmObj *args, int nargs, void *data)
149 {
150 SCM_ASSERT(nargs == 1);
151 Scm_ReportError(args[0]);
152 return SCM_TRUE;
153 }
154
155 static ScmObj repl_loop_cc(ScmObj result, void **data)
156 {
157 if (SCM_TRUEP(result)) {
158 ScmObj *closure = (ScmObj*)data;
159 return Scm_VMRepl(closure[0], closure[1], closure[2], closure[3]);
160 } else {
161 return SCM_FALSE;
162 }
163 }
164
165 ScmObj Scm_VMRepl(ScmObj reader, ScmObj evaluator,
166 ScmObj printer, ScmObj prompter)
167 {
168 ScmObj ehandler, reploop;
169 ScmObj *packet = SCM_NEW_ARRAY(ScmObj, 4);
170 packet[0] = reader;
171 packet[1] = evaluator;
172 packet[2] = printer;
173 packet[3] = prompter;
174 ehandler = Scm_MakeSubr(repl_error_handle, packet, 1, 0, SCM_FALSE);
175 reploop = Scm_MakeSubr(repl_main, packet, 0, 0, SCM_FALSE);
176 Scm_VMPushCC(repl_loop_cc, (void**)packet, 4);
177 return Scm_VMWithErrorHandler(ehandler, reploop);
178 }
179
180 static ScmObj repl_proc(ScmObj *args, int nargs, void *data)
181 {
182 int argc = Scm_Length(args[0]);
183 ScmObj reader = (argc >= 1? SCM_CAR(args[0]) : SCM_FALSE);
184 ScmObj evaluator = (argc >= 2? SCM_CADR(args[0]) : SCM_FALSE);
185 ScmObj printer = (argc >= 3? SCM_CAR(SCM_CDDR(args[0])) : SCM_FALSE);
186 ScmObj prompter = (argc >= 4? SCM_CADR(SCM_CDDR(args[0])) : SCM_FALSE);
187 return Scm_VMRepl(reader, evaluator, printer, prompter);
188 }
189
190 static SCM_DEFINE_STRING_CONST(repl_NAME, "read-eval-print-loop", 20, 20);
191 static SCM_DEFINE_SUBR(repl_STUB, 0, 1, SCM_OBJ(&repl_NAME), repl_proc, NULL, NULL);
192
193 void Scm_Repl(ScmObj reader, ScmObj evaluator, ScmObj printer,
194 ScmObj prompter)
195 {
196 Scm_Apply(SCM_OBJ(&repl_STUB),
197 SCM_LIST4(reader, evaluator, printer, prompter));
198 }
199
200 void Scm__InitRepl(void)
201 {
202 Scm_Define(Scm_GaucheModule(),
203 SCM_SYMBOL(Scm_Intern(&repl_NAME)),
204 SCM_OBJ(&repl_STUB));
205 }