mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-09 22:50:34 -07:00
[nucl] don't modify VALUES vector and use dynamic STDIN/STDOUT vals
This commit is contained in:
Daniel Kochmański
parent
422dfbcc2e
commit
b5fdebc811
1 changed files with 140 additions and 116 deletions
256
src/c/nucl.c
256
src/c/nucl.c
|
|
@ -139,7 +139,7 @@ nucl_alloc_symbol(cl_object name, cl_object value)
|
|||
x->symbol.plist = ECL_NIL;
|
||||
x->symbol.hpack = ECL_NIL;
|
||||
x->symbol.stype = ecl_stp_ordinary;
|
||||
#ifdef NUCL
|
||||
#ifndef ECL_NUCL
|
||||
/* Rethink finalization(!) */
|
||||
ecl_set_finalizer_unprotected(x, ECL_T);
|
||||
#endif
|
||||
|
|
@ -230,8 +230,6 @@ nucl_stack_pop(void)
|
|||
return ecl_stack_frame_pop(frame);
|
||||
}
|
||||
|
||||
/* FIXME these functions work as expected, but if we use nucl_write_object, it
|
||||
calls in turn si_nucl_write using ecl_return1 that changes values vector. */
|
||||
static cl_object
|
||||
nucl_stack_from_values(void)
|
||||
{
|
||||
|
|
@ -371,26 +369,63 @@ nucl_stdin(void)
|
|||
}
|
||||
|
||||
cl_object
|
||||
nucl_write_cstr(cl_object strm, const char *s)
|
||||
nucl_write_cstr(const char *s)
|
||||
{
|
||||
cl_object strm = nucl_stdout();
|
||||
while(*s != '\0')
|
||||
si_write_char(strm, ECL_CODE_CHAR(*s++));
|
||||
ecl_write_char(*s++, strm);
|
||||
}
|
||||
|
||||
/* Ad-hoc printer */
|
||||
void
|
||||
nucl_write_string(cl_object strm, cl_object s)
|
||||
cl_object
|
||||
nucl_write_char(const char ch)
|
||||
{
|
||||
int aux;
|
||||
for(aux=0; aux<s->string.fillp; aux++)
|
||||
cl_object strm = nucl_stdout();
|
||||
ecl_write_char(ch, strm);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_read_char(cl_object eof_value)
|
||||
{
|
||||
cl_object strm = nucl_stdin();
|
||||
ecl_character ch = ecl_read_char(strm);
|
||||
return (ch==EOF) ? eof_value : ECL_CODE_CHAR(ch);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_unread_char(cl_object ch)
|
||||
{
|
||||
cl_object strm = nucl_stdin();
|
||||
if (ecl_unlikely(!ECL_CHARACTERP(ch))) {
|
||||
return ECL_NIL;
|
||||
}
|
||||
ecl_unread_char(ECL_CHAR_CODE(ch), strm);
|
||||
return ch;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_peek_char(cl_object eof_value)
|
||||
{
|
||||
cl_object strm = nucl_stdin();
|
||||
ecl_character ch = ecl_peek_char(strm);
|
||||
return (ch==EOF) ? eof_value : ECL_CODE_CHAR(ch);
|
||||
}
|
||||
|
||||
/* -- Ad-hoc writer --------------------------------------------------------- */
|
||||
void
|
||||
nucl_write_string(cl_object s)
|
||||
{
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_index aux = 0;
|
||||
for(; aux < s->string.fillp; aux++)
|
||||
(s->d.t == t_string)
|
||||
? si_write_char(strm, ECL_CODE_CHAR(s->string.self[aux]))
|
||||
: si_write_char(strm, ECL_CODE_CHAR(s->base_string.self[aux]));
|
||||
? ecl_write_char(s->string.self[aux], strm)
|
||||
: ecl_write_char(s->base_string.self[aux], strm);
|
||||
}
|
||||
|
||||
void
|
||||
nucl_write_fixnum(cl_object strm, cl_object s)
|
||||
nucl_write_fixnum(cl_object s)
|
||||
{
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_object frame = open_nucl_frame();
|
||||
cl_object c=ECL_NIL;
|
||||
cl_fixnum value = ecl_fixnum(s), dig;
|
||||
|
|
@ -403,94 +438,95 @@ nucl_write_fixnum(cl_object strm, cl_object s)
|
|||
if(ecl_fixnum(s) < 0)
|
||||
nucl_stack_push(ECL_CODE_CHAR('-'));
|
||||
loop_across_frame_filo(elt, frame) {
|
||||
si_write_char(strm, elt);
|
||||
nucl_write_char(ECL_CHAR_CODE(elt));
|
||||
} end_loop_across_frame();
|
||||
close_nucl_frame();
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_write_object(cl_object strm, cl_object self)
|
||||
nucl_write_object(cl_object self)
|
||||
{
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_type t = ecl_t_of(self);
|
||||
cl_object reg = ECL_NIL;
|
||||
int aux = 0;
|
||||
switch (t) {
|
||||
case t_character:
|
||||
nucl_write_cstr(strm, "#\\");
|
||||
if(ECL_CHAR_CODE(self) == '\n')
|
||||
nucl_write_cstr(strm, "Newline");
|
||||
else
|
||||
si_write_char(strm, self);
|
||||
nucl_write_cstr("#\\");
|
||||
switch(ECL_CHAR_CODE(self)) {
|
||||
case '\n': nucl_write_cstr("Newline"); break;
|
||||
case ' ': nucl_write_cstr("Space"); break;
|
||||
default: nucl_write_char(ECL_CHAR_CODE(self)); }
|
||||
break;
|
||||
case t_fixnum:
|
||||
nucl_write_fixnum(strm, self);
|
||||
nucl_write_fixnum(self);
|
||||
break;
|
||||
case t_base_string:
|
||||
case t_string:
|
||||
nucl_write_cstr(strm, "\"");
|
||||
nucl_write_string(strm, self);
|
||||
nucl_write_cstr(strm, "\"");
|
||||
nucl_write_char('"');
|
||||
nucl_write_string(self);
|
||||
nucl_write_char('"');
|
||||
break;
|
||||
case t_symbol: /* ignores packages, introduce t_token? */
|
||||
reg = self->symbol.name;
|
||||
nucl_write_string(strm, reg);
|
||||
nucl_write_string(reg);
|
||||
break;
|
||||
case t_vector:
|
||||
nucl_write_cstr(strm, "[");
|
||||
nucl_write_char('[');
|
||||
loop_across_stack_fifo(elt, self) {
|
||||
nucl_write_object(strm, elt);
|
||||
nucl_write_object(elt);
|
||||
if(++aux < self->vector.fillp)
|
||||
nucl_write_cstr(strm, " ");
|
||||
nucl_write_char(' ');
|
||||
} end_loop_across_stack();
|
||||
nucl_write_cstr(strm, "]");
|
||||
nucl_write_char(']');
|
||||
break;
|
||||
case t_list:
|
||||
nucl_write_cstr(strm, "(");
|
||||
nucl_write_char('(');
|
||||
loop_for_on_unsafe(self) {
|
||||
reg = ECL_CONS_CAR(self);
|
||||
nucl_write_object(strm, reg);
|
||||
nucl_write_object(reg);
|
||||
reg = ECL_CONS_CDR(self);
|
||||
if (ECL_CONSP(reg)) {
|
||||
nucl_write_cstr(strm, " ");
|
||||
nucl_write_char(' ');
|
||||
} else if (!Null(reg)) {
|
||||
nucl_write_cstr(strm, " . ");
|
||||
nucl_write_object(strm, reg);
|
||||
nucl_write_cstr(" . ");
|
||||
nucl_write_object(reg);
|
||||
}
|
||||
} end_loop_for_on_unsafe(self);
|
||||
nucl_write_cstr(strm, ")");
|
||||
nucl_write_char(')');
|
||||
break;
|
||||
default:
|
||||
{
|
||||
const char *name = ecl_type_info[t].name;
|
||||
nucl_write_cstr(strm, "#<");
|
||||
nucl_write_cstr(strm, name);
|
||||
nucl_write_cstr(strm, ">");
|
||||
nucl_write_cstr("#<");
|
||||
nucl_write_cstr(name);
|
||||
nucl_write_cstr(">");
|
||||
return ECL_NIL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Ad-hoc reader */
|
||||
/* -- Ad-hoc reader --------------------------------------------------------- */
|
||||
void
|
||||
nucl_read_until(cl_object strm, cl_fixnum delim)
|
||||
nucl_read_until(cl_fixnum delim)
|
||||
{
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_object ch = ECL_NIL;
|
||||
while (!Null(ch = si_read_char(strm, ECL_NIL))) {
|
||||
while (!Null(ch = nucl_read_char(ECL_NIL))) {
|
||||
nucl_stack_push(ch);
|
||||
if(ECL_CHAR_CODE(ch) == delim) break;
|
||||
}
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_read_line(cl_object strm)
|
||||
nucl_read_line()
|
||||
{
|
||||
nucl_read_until(strm, '\n');
|
||||
nucl_read_until('\n');
|
||||
return nucl_stack_to_string();
|
||||
}
|
||||
|
||||
static cl_object rtable = ECL_NIL;
|
||||
static cl_object nucl_accept(cl_object strm, cl_object delim);
|
||||
static cl_object nucl_accept(cl_object delim);
|
||||
|
||||
void
|
||||
nucl_readtable_set(cl_object self, cl_fixnum c, enum ecl_chattrib cat,
|
||||
|
|
@ -513,7 +549,7 @@ nucl_readtable_get(cl_object self, cl_fixnum ch)
|
|||
}
|
||||
|
||||
static void
|
||||
default_reader(int narg, cl_object strm, cl_object ch)
|
||||
default_reader(int narg, cl_object ch)
|
||||
{
|
||||
/* This reader reads either a token (symbol) or a number (fixnum). Common Lisp
|
||||
concerns itself with read-base, but we are going to ditch it in favor of a
|
||||
|
|
@ -521,17 +557,17 @@ default_reader(int narg, cl_object strm, cl_object ch)
|
|||
If the first digit is 0, then it must be a hexadecimal number, i.e 0xff. */
|
||||
struct ecl_readtable_entry *entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
nucl_stack_push(ch);
|
||||
while (!Null(ch = si_read_char(strm, ECL_NIL))) {
|
||||
while (!Null(ch = nucl_read_char(ECL_NIL))) {
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
switch (entry->syntax_type) {
|
||||
case cat_constituent:
|
||||
nucl_stack_push(ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
si_unread_char(strm, ch);
|
||||
nucl_unread_char(ch);
|
||||
return;
|
||||
case cat_whitespace:
|
||||
si_unread_char(strm, ch);
|
||||
nucl_unread_char(ch);
|
||||
return;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
|
|
@ -540,11 +576,11 @@ default_reader(int narg, cl_object strm, cl_object ch)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
limited_reader(cl_object strm, cl_object delim)
|
||||
limited_reader(cl_object delim)
|
||||
{
|
||||
cl_object object;
|
||||
do {
|
||||
object = nucl_accept(strm, delim);
|
||||
object = nucl_accept(delim);
|
||||
if(object == ECL_EOF || ecl_eql(object, delim))
|
||||
return object;
|
||||
else
|
||||
|
|
@ -554,23 +590,23 @@ limited_reader(cl_object strm, cl_object delim)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
lparen_reader(int narg, cl_object strm, cl_object c)
|
||||
lparen_reader(int narg, cl_object c)
|
||||
{
|
||||
limited_reader(strm, ECL_CODE_CHAR(')'));
|
||||
limited_reader(ECL_CODE_CHAR(')'));
|
||||
return nucl_stack_to_list();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
rparen_reader(int narg, cl_object strm, cl_object c)
|
||||
rparen_reader(int narg, cl_object c)
|
||||
{
|
||||
ecl_internal_error("rparen reader");
|
||||
}
|
||||
|
||||
static cl_object
|
||||
symbol_reader(int narg, cl_object strm, cl_object c)
|
||||
symbol_reader(int narg, cl_object c)
|
||||
{
|
||||
cl_object string, symbol;
|
||||
default_reader(2, strm, c);
|
||||
default_reader(1, c);
|
||||
nucl_stack_to_string();
|
||||
string = nucl_stack_pop();
|
||||
symbol = nucl_alloc_symbol(string, OBJNULL);
|
||||
|
|
@ -578,31 +614,31 @@ symbol_reader(int narg, cl_object strm, cl_object c)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
string_reader(int narg, cl_object strm, cl_object c)
|
||||
string_reader(int narg, cl_object c)
|
||||
{
|
||||
nucl_read_until(strm, ECL_CHAR_CODE(c));
|
||||
nucl_read_until(ECL_CHAR_CODE(c));
|
||||
nucl_stack_pop(); /* remove delimiter */
|
||||
return nucl_stack_to_string();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
fixnum_reader(int narg, cl_object strm, cl_object c)
|
||||
fixnum_reader(int narg, cl_object c)
|
||||
{
|
||||
default_reader(2, strm, c);
|
||||
default_reader(1, c);
|
||||
return nucl_stack_to_fixnum();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
hexnum_reader(int narg, cl_object strm, cl_object c)
|
||||
hexnum_reader(int narg, cl_object c)
|
||||
{
|
||||
cl_object ch = si_read_char(strm, ECL_NIL);
|
||||
cl_object ch = nucl_read_char(ECL_NIL);
|
||||
if (Null(ch)) {
|
||||
return ecl_make_fixnum(0);
|
||||
} else if (ECL_CHAR_CODE(ch) != 'x' && ECL_CHAR_CODE(ch) != 'X') {
|
||||
si_unread_char(strm, ch);
|
||||
nucl_unread_char(ch);
|
||||
return ecl_make_fixnum(0);
|
||||
} else {
|
||||
default_reader(2, strm, c);
|
||||
default_reader(1, c);
|
||||
return nucl_stack_to_hexnum();
|
||||
}
|
||||
}
|
||||
|
|
@ -618,18 +654,18 @@ ecl_def_function(_hexnum_reader, hexnum_reader, static, const);
|
|||
either parse a symbol, a fixnum or a hexnum, where the first character in the
|
||||
case of numbers specifies the sign. */
|
||||
static cl_object
|
||||
mixnum_reader(int narg, cl_object strm, cl_object c)
|
||||
mixnum_reader(int narg, cl_object c)
|
||||
{
|
||||
cl_object reg = si_read_char(strm, ECL_NIL);
|
||||
cl_object reg = nucl_read_char(ECL_NIL);
|
||||
struct ecl_readtable_entry *entry
|
||||
= nucl_readtable_get(rtable, ECL_CHAR_CODE(reg));
|
||||
if(entry->dispatch == _fixnum_reader || entry->dispatch == _hexnum_reader) {
|
||||
reg = _ecl_funcall3(entry->dispatch, strm, reg);
|
||||
reg = _ecl_funcall2(entry->dispatch, reg);
|
||||
return ecl_eql(c, ECL_CODE_CHAR('-'))
|
||||
? ecl_make_fixnum(-ecl_fixnum(reg))
|
||||
: reg;
|
||||
}
|
||||
return symbol_reader(2, strm, c);
|
||||
return symbol_reader(1, c);
|
||||
}
|
||||
ecl_def_function(_mixnum_reader, mixnum_reader, static, const);
|
||||
|
||||
|
|
@ -663,12 +699,12 @@ init_nucl_reader(void)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
skip_whitespace(cl_object strm, cl_object delim)
|
||||
skip_whitespace(cl_object delim)
|
||||
{
|
||||
struct ecl_readtable_entry *entry = NULL;
|
||||
cl_object ch = ECL_NIL;
|
||||
do {
|
||||
ch = si_read_char(strm, ECL_EOF);
|
||||
ch = nucl_read_char(ECL_EOF);
|
||||
if (ch == ECL_EOF || ecl_eql(ch, delim)) return ch;
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
if (entry->syntax_type != cat_whitespace) {
|
||||
|
|
@ -678,13 +714,13 @@ skip_whitespace(cl_object strm, cl_object delim)
|
|||
}
|
||||
|
||||
static cl_object
|
||||
nucl_accept(cl_object strm, cl_object delim)
|
||||
nucl_accept(cl_object delim)
|
||||
{
|
||||
cl_object frame = open_nucl_frame();
|
||||
struct ecl_readtable_entry *entry = NULL;
|
||||
cl_object ch = ECL_NIL;
|
||||
cl_object result = ECL_NIL;
|
||||
ch = skip_whitespace(strm, delim);
|
||||
ch = skip_whitespace(delim);
|
||||
if (ch == ECL_EOF || ecl_eql(delim, ch)) {
|
||||
close_nucl_frame();
|
||||
return ch;
|
||||
|
|
@ -696,12 +732,12 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
associated dispatch function, then we use it instead of a default
|
||||
reader. In our case this always happens. */
|
||||
if(Null(entry->dispatch))
|
||||
default_reader(2, strm, ch);
|
||||
default_reader(1, ch);
|
||||
else
|
||||
result = _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
result = _ecl_funcall2(entry->dispatch, ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
result = _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
result = _ecl_funcall2(entry->dispatch, ch);
|
||||
break;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
|
|
@ -785,41 +821,37 @@ nucl_append_dictionary(cl_object symbol, cl_object value)
|
|||
cl_object nucl_word_def(int narg, cl_object op) {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
cl_object cmpp = ECL_SYM_VAL(the_env, nucl_cmpp);
|
||||
cl_object strm = nucl_stdout();
|
||||
if(Null(cmpp)) {
|
||||
ECL_SETQ(the_env, nucl_cmpp, ECL_T);
|
||||
open_nucl_frame();
|
||||
return ECL_NIL;
|
||||
}
|
||||
if (!nucl_cstrcmp(op->symbol.name, ";", 1)) {
|
||||
ECL_SETQ(the_env, nucl_cmpp, ECL_NIL);
|
||||
if (cmpp == ECL_T)
|
||||
nucl_write_cstr(strm, "$$$ error: empty definition");
|
||||
else {
|
||||
nucl_append_dictionary(cmpp, nucl_stack_to_list());
|
||||
nucl_stack_pop();
|
||||
}
|
||||
(cmpp == ECL_T)
|
||||
? nucl_write_cstr("$$$ error: empty definition")
|
||||
: nucl_append_dictionary(cmpp, nucl_stack_to_list());
|
||||
close_nucl_frame();
|
||||
} else if (!nucl_cstrcmp(op->symbol.name, ":", 1)) {
|
||||
nucl_write_cstr(strm, "$$$ error: nested compilation");
|
||||
nucl_write_cstr("$$$ error: nested compilation");
|
||||
} else if (cmpp == ECL_T) {
|
||||
ECL_SETQ(the_env, nucl_cmpp, op);
|
||||
} else {
|
||||
cl_object word = nucl_search_dictionary(op->symbol.name);
|
||||
(word == ECL_UNBOUND)
|
||||
? nucl_write_cstr(strm, "$$$ error: undefined word")
|
||||
? nucl_write_cstr("$$$ error: undefined word")
|
||||
: nucl_stack_push(word);
|
||||
}
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
cl_object nucl_word_fed(int narg, cl_object op) {
|
||||
cl_object strm = nucl_stdout();
|
||||
nucl_write_cstr(strm, "$$$ error: not compiling");
|
||||
nucl_write_cstr("$$$ error: not compiling");
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
cl_object nucl_eval_word(int narg, cl_object word) {
|
||||
cl_object value = word->symbol.value;
|
||||
cl_object strm = nucl_stdout();
|
||||
switch(ecl_t_of(value)) {
|
||||
case t_list:
|
||||
loop_for_on_unsafe(value) {
|
||||
|
|
@ -839,13 +871,11 @@ cl_object nucl_eval_word(int narg, cl_object word) {
|
|||
|
||||
cl_object nucl_call_word(int narg, cl_object op) {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_object cmpp = ECL_SYM_VAL(the_env, nucl_cmpp);
|
||||
if(Null(cmpp)) {
|
||||
cl_object word = nucl_search_dictionary(op->symbol.name);
|
||||
cl_object strm = nucl_stdout();
|
||||
(word == ECL_UNBOUND)
|
||||
? nucl_write_cstr(strm, ">>> error: undefined word")
|
||||
? nucl_write_cstr(">>> error: undefined word")
|
||||
: nucl_eval_word(1, word);
|
||||
} else {
|
||||
nucl_word_def(1, op);
|
||||
|
|
@ -857,16 +887,15 @@ ecl_def_function(_nucl_word_def, nucl_word_def, static, const);
|
|||
ecl_def_function(_nucl_word_fed, nucl_word_fed, static, const);
|
||||
|
||||
cl_object nucl_word_ps(int narg, cl_object op) {
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_object frame = nucl_stack_frame();
|
||||
cl_index ssize = nucl_stack_size();
|
||||
cl_object size = ecl_make_fixnum(ssize);
|
||||
nucl_write_cstr(strm, "[");
|
||||
nucl_write_object(strm, size);
|
||||
nucl_write_cstr(strm, "] ");
|
||||
nucl_write_cstr("[");
|
||||
nucl_write_object(size);
|
||||
nucl_write_cstr("] ");
|
||||
loop_across_frame_fifo(elt, frame) {
|
||||
nucl_write_object(strm, elt);
|
||||
nucl_write_cstr(strm, " ");
|
||||
nucl_write_object(elt);
|
||||
nucl_write_cstr(" ");
|
||||
} end_loop_across_frame();
|
||||
return size;
|
||||
}
|
||||
|
|
@ -874,28 +903,26 @@ cl_object nucl_word_ps(int narg, cl_object op) {
|
|||
cl_object nucl_word_pd(int narg, cl_object op) {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
cl_object dict = ECL_SYM_VAL(the_env, nucl_dt);
|
||||
cl_object strm = nucl_stdout();
|
||||
loop_across_stack_fifo(elt, dict) {
|
||||
nucl_write_object(strm, elt);
|
||||
nucl_write_cstr(strm, " ");
|
||||
nucl_write_object(elt);
|
||||
nucl_write_cstr(" ");
|
||||
} end_loop_across_stack();
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
cl_object nucl_word_dp(int narg, cl_object op) {
|
||||
cl_object strm = nucl_stdout();
|
||||
cl_index ssize = nucl_stack_size();
|
||||
/* cl_object size = ecl_make_fixnum(ssize); */
|
||||
/* nucl_write_cstr(strm, "["); */
|
||||
/* nucl_write_object(strm, size); */
|
||||
/* nucl_write_cstr(strm, "] "); */
|
||||
/* nucl_write_cstr("["); */
|
||||
/* nucl_write_object(size); */
|
||||
/* nucl_write_cstr("] "); */
|
||||
if(ssize == 0) {
|
||||
nucl_write_cstr(strm, "error: stack underflow");
|
||||
nucl_write_cstr("error: stack underflow");
|
||||
return ECL_NIL;
|
||||
} else {
|
||||
cl_object elt = nucl_stack_pop();
|
||||
nucl_write_object(strm, elt);
|
||||
nucl_write_cstr(strm, " ");
|
||||
nucl_write_object(elt);
|
||||
nucl_write_cstr(" ");
|
||||
return elt;
|
||||
}
|
||||
}
|
||||
|
|
@ -930,9 +957,9 @@ void init_nucl_dictionary_entries()
|
|||
}
|
||||
}
|
||||
|
||||
cl_object nucl_read_command (cl_object istrm)
|
||||
cl_object nucl_read_command ()
|
||||
{
|
||||
cl_object result = limited_reader(istrm, ECL_CODE_CHAR('\n'));
|
||||
cl_object result = limited_reader(ECL_CODE_CHAR('\n'));
|
||||
nucl_stack_to_list();
|
||||
return result;
|
||||
}
|
||||
|
|
@ -953,30 +980,27 @@ cl_object nucl_execute_command (cl_object command)
|
|||
void nucl_repl (void)
|
||||
{
|
||||
const cl_env_ptr the_env = ecl_process_env();
|
||||
cl_object result, command, ostrm, istrm;
|
||||
cl_object result, command;
|
||||
cl_index idx;
|
||||
init_nucl_io();
|
||||
init_nucl_reader();
|
||||
init_nucl_dictionary();
|
||||
init_nucl_dictionary_entries();
|
||||
|
||||
ostrm = nucl_stdout();
|
||||
istrm = nucl_stdin();
|
||||
|
||||
cl_object frame = open_nucl_frame(); /* top level frame */
|
||||
do {
|
||||
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
|
||||
nucl_write_cstr(ostrm, "nucl> ");
|
||||
nucl_write_cstr("nucl> ");
|
||||
else
|
||||
nucl_write_cstr(ostrm, "... ");
|
||||
result = nucl_read_command(istrm);
|
||||
nucl_write_cstr("... ");
|
||||
result = nucl_read_command();
|
||||
command = nucl_stack_pop();
|
||||
nucl_execute_command(command);
|
||||
if(Null(ECL_SYM_VAL(the_env, nucl_cmpp)))
|
||||
nucl_write_cstr(ostrm, "... ok\n");
|
||||
nucl_write_cstr("... ok\n");
|
||||
} while(result != ECL_EOF);
|
||||
close_nucl_frame();
|
||||
nucl_write_cstr(ostrm, "... bye\n");
|
||||
nucl_write_cstr("... bye\n");
|
||||
}
|
||||
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue