[nucl] fix eof issues and add reading the line of objects

This commit is contained in:
Daniel Kochmański 2025-05-28 18:17:00 +02:00
parent 816e741e00
commit f993eda32f

View file

@ -247,18 +247,26 @@ nucl_stack_to_hexnum(void)
return ecl_make_fixnum((cl_fixnum)acc);
}
/* Yeah! */
cl_object nucl_call_word(int narg, cl_object op) {
const cl_env_ptr the_env = ecl_process_env();
printf(">>> nucl_call_word: %p!\n", op);
ecl_return1(the_env, op);
}
ecl_def_function(_nucl_call_word, nucl_call_word, static, const);
/* Our dictionary is based on symbols. Each symbol in a dictionary has a name
and a value. We may need to rethink it at some point. */
#define make_dict_entry(name,value) \
ecl_cast_ptr(cl_object, &ecl_constexpr_symbol(ecl_stp_special, name, value))
static cl_object nucl_dt = make_dict_entry("*DT*", ECL_NIL); /* ha! */
static cl_object nucl_dictionary_default_entries[] = {
make_dict_entry(":", ECL_NIL),
make_dict_entry("!", ECL_NIL),
make_dict_entry(":", _nucl_call_word),
make_dict_entry("!", _nucl_call_word),
NULL,
};
@ -324,6 +332,8 @@ nucl_extend_dictionary(cl_object name, cl_object value)
/* -- Lali-ho I/O starts here ----------------------------------------------- */
#define ECL_EOF ECL_DUMMY_TAG
cl_object
nucl_write_cstr(cl_object strm, const char *s)
{
@ -485,6 +495,7 @@ default_reader(int narg, cl_object strm, cl_object ch)
si_unread_char(strm, ch);
return;
case cat_whitespace:
si_unread_char(strm, ch);
return;
default:
ecl_internal_error("Expecting too much, aren't we?");
@ -492,19 +503,18 @@ default_reader(int narg, cl_object strm, cl_object ch)
}
}
static void
static cl_object
limited_reader(cl_object strm, cl_object delim)
{
cl_object object;
do {
object = nucl_accept(strm, delim);
if(Null(object))
ecl_internal_error("Unexpected end of file");
else if(ecl_eql(object, delim))
break;
if(object == ECL_EOF || ecl_eql(object, delim))
return object;
else
nucl_stack_push(object);
} while(1);
return ECL_NIL;
}
static cl_object
@ -632,8 +642,8 @@ skip_whitespace(cl_object strm, cl_object delim)
struct ecl_readtable_entry *entry = NULL;
cl_object ch = ECL_NIL;
do {
ch = si_read_char(strm, ECL_DUMMY_TAG);
if (ch == ECL_DUMMY_TAG || ecl_eql(ch, delim)) return ch;
ch = si_read_char(strm, 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) {
return ch;
@ -649,7 +659,7 @@ nucl_accept(cl_object strm, cl_object delim)
cl_object ch = ECL_NIL;
cl_object result = ECL_NIL;
ch = skip_whitespace(strm, delim);
if (ch == ECL_DUMMY_TAG || ecl_eql(delim, ch)) {
if (ch == ECL_EOF || ecl_eql(delim, ch)) {
close_nucl_frame(frame);
return ch;
}
@ -706,25 +716,29 @@ smoke_accept (void)
/* -- REPL ------------------------------------------------------------------ */
cl_object nucl_read_command (cl_object istrm)
{
return limited_reader(istrm, ECL_CODE_CHAR('\n'));
}
void nucl_repl (void)
{
cl_object ostrm = ecl_make_nucl_stream(stdout);
cl_object istrm = ecl_make_nucl_stream(stdin);
cl_object result = ECL_NIL;
cl_object delim = ECL_CODE_CHAR('\n');
cl_object result = ECL_NIL, command = ECL_NIL;
init_nucl_reader();
init_nucl_dictionary();
do {
open_nucl_frame(frame); /* top level frame */
nucl_write_cstr(ostrm, "nucl> ");
do { result = nucl_accept(istrm, delim); } while (ecl_eql(result,delim));
if (result==ECL_DUMMY_TAG) {
nucl_write_cstr(ostrm, "... exit\n");
break;
}
result = nucl_read_command(istrm);
command = nucl_stack_to_list();
nucl_write_cstr(ostrm, "... ");
nucl_write_object(ostrm, result);
nucl_write_object(ostrm, command);
nucl_write_cstr(ostrm, "\n");
} while(1);
close_nucl_frame(frame);
} while(result != ECL_EOF);
nucl_write_cstr(ostrm, "... exit\n");
}
void nucl_test (void)