mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2026-03-09 22:50:34 -07:00
[nucl] add a proto-repl without eval step
This commit is contained in:
Daniel Kochmański
parent
3db21bec37
commit
7426a3cfed
1 changed files with 76 additions and 40 deletions
116
src/c/nucl.c
116
src/c/nucl.c
|
|
@ -82,7 +82,7 @@ void smoke_bytecodes (void)
|
|||
|
||||
cl_object ecl_make_nucl_stream(FILE *f);
|
||||
|
||||
/* -- Lali-ho I/O starts here ----------------------------------------------- */
|
||||
/* -- Since now on we will often use the stack, so here are some operators - */
|
||||
|
||||
/* GC won't catch pointers from constexpr symbols unless registered as root. */
|
||||
static cl_object nucl_fp = ecl_cast_ptr(cl_object,&(ecl_constexpr_symbol(ecl_stp_special, "*FP*", ECL_NIL)));
|
||||
|
|
@ -129,6 +129,8 @@ nucl_stack_pop(void)
|
|||
return ECL_STACK_POP_UNSAFE(frame->frame.env);
|
||||
}
|
||||
|
||||
/* And constructors */
|
||||
|
||||
cl_object
|
||||
nucl_alloc_base_string(cl_index s)
|
||||
{
|
||||
|
|
@ -221,6 +223,8 @@ nucl_stack_to_hexnum(void)
|
|||
return ecl_make_fixnum((cl_fixnum)acc);
|
||||
}
|
||||
|
||||
/* -- Lali-ho I/O starts here ----------------------------------------------- */
|
||||
|
||||
cl_object
|
||||
nucl_write_cstr(cl_object strm, const char *s)
|
||||
{
|
||||
|
|
@ -286,7 +290,10 @@ nucl_write_object(cl_object strm, cl_object self)
|
|||
switch (t) {
|
||||
case t_character:
|
||||
nucl_write_cstr(strm, "#\\");
|
||||
si_write_char(strm, self);
|
||||
if(ECL_CHAR_CODE(self) == '\n')
|
||||
nucl_write_cstr(strm, "Newline");
|
||||
else
|
||||
si_write_char(strm, self);
|
||||
break;
|
||||
case t_fixnum:
|
||||
nucl_write_fixnum(strm, self);
|
||||
|
|
@ -361,7 +368,7 @@ nucl_readtable_get(cl_object self, cl_fixnum ch)
|
|||
return self->readtable.table+ch;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
static void
|
||||
default_reader(int narg, cl_object strm, cl_object ch)
|
||||
{
|
||||
/* This reader reads either a token (symbol) or a number (fixnum). Common Lisp
|
||||
|
|
@ -378,14 +385,28 @@ default_reader(int narg, cl_object strm, cl_object ch)
|
|||
break;
|
||||
case cat_terminating:
|
||||
si_unread_char(strm, ch);
|
||||
return ECL_NIL;
|
||||
return;
|
||||
case cat_whitespace:
|
||||
return ECL_NIL;
|
||||
return;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
}
|
||||
return ECL_NIL;
|
||||
}
|
||||
|
||||
static void
|
||||
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;
|
||||
else
|
||||
nucl_stack_push(object);
|
||||
} while(1);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -397,21 +418,8 @@ comment_reader(int narg, cl_object strm, cl_object c)
|
|||
static cl_object
|
||||
lparen_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
open_nucl_frame(frame);
|
||||
cl_object object;
|
||||
cl_object delim = ECL_CODE_CHAR(')');
|
||||
do {
|
||||
object = nucl_accept(strm, delim);
|
||||
if(Null(object))
|
||||
ecl_internal_error("Unexpected end of file");
|
||||
else if(ecl_eql(object, delim))
|
||||
break;
|
||||
else
|
||||
nucl_stack_push(object);
|
||||
} while(1);
|
||||
object = nucl_stack_to_list();
|
||||
close_nucl_frame(frame);
|
||||
return object;
|
||||
limited_reader(strm, ECL_CODE_CHAR(')'));
|
||||
return nucl_stack_to_list();
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -526,8 +534,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, delim);
|
||||
if (Null(ch) || ecl_eql(ch, delim)) return ch;
|
||||
ch = si_read_char(strm, ECL_UNBOUND);
|
||||
if (ch == ECL_UNBOUND || ecl_eql(ch, delim)) return ch;
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
if (entry->syntax_type != cat_whitespace) {
|
||||
return ch;
|
||||
|
|
@ -543,7 +551,8 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
cl_object ch = ECL_NIL;
|
||||
cl_object result = ECL_NIL;
|
||||
ch = skip_whitespace(strm, delim);
|
||||
if (Null(ch) || ecl_eql(delim, ch)) {
|
||||
if (ch == ECL_UNBOUND || ecl_eql(delim, ch)) {
|
||||
close_nucl_frame(frame);
|
||||
return ch;
|
||||
}
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
|
|
@ -552,9 +561,10 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
/* Here's some nuance -- if the first constituent character has an
|
||||
associated dispatch function, then we use it instead of a default
|
||||
reader. In our case this always happens. */
|
||||
result = Null(entry->dispatch)
|
||||
? default_reader(2, strm, ch)
|
||||
: _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
if(Null(entry->dispatch))
|
||||
default_reader(2, strm, ch);
|
||||
else
|
||||
result = _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
result = _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
|
|
@ -566,8 +576,6 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
return result;
|
||||
}
|
||||
|
||||
/* -- Lali-ho I/O ends here ------------------------------------------------- */
|
||||
|
||||
void
|
||||
smoke_stream (void)
|
||||
{
|
||||
|
|
@ -597,14 +605,34 @@ smoke_accept (void)
|
|||
printf("\n");
|
||||
}
|
||||
|
||||
int main() {
|
||||
/* -- Forth-like dictionary ------------------------------------------------- */
|
||||
|
||||
/* Our dictionary is based on symbols. Each symbol in a dictionary has a name
|
||||
and a value. */
|
||||
|
||||
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');
|
||||
init_nucl_reader();
|
||||
do {
|
||||
nucl_write_cstr(ostrm, "nucl> ");
|
||||
do { result = nucl_accept(istrm, delim); } while (ecl_eql(result,delim));
|
||||
if (result==ECL_UNBOUND) {
|
||||
nucl_write_cstr(ostrm, "... exit\n");
|
||||
break;
|
||||
}
|
||||
nucl_write_cstr(ostrm, "... ");
|
||||
nucl_write_object(ostrm, result);
|
||||
nucl_write_cstr(ostrm, "\n");
|
||||
} while(1);
|
||||
}
|
||||
|
||||
void nucl_test (void)
|
||||
{
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
ecl_boot();
|
||||
ecl_add_module(ecl_module_process);
|
||||
ecl_add_module(ecl_module_stacks);
|
||||
|
||||
printf("Hello ECL! %p\n", the_env);
|
||||
|
||||
printf("\n[:handler t :restart t] -----------------------\n");
|
||||
ECL_CATCH_BEGIN(the_env, ecl_ct_resume_tag); {
|
||||
ecl_call_with_handler(_nucl_extinguisher, _nucl_flamethrower);
|
||||
|
|
@ -619,7 +647,6 @@ int main() {
|
|||
nucl_flamethrower(0);
|
||||
printf("-----------------------------------------------\n\n");
|
||||
|
||||
/* Just install the handler. */
|
||||
cl_object handlers = ecl_cons_stack(_nucl_extinguisher, ECL_NIL);
|
||||
ECL_SETQ(the_env, ECL_SIGNAL_HANDLERS, handlers);
|
||||
|
||||
|
|
@ -627,14 +654,23 @@ int main() {
|
|||
smoke_bytecodes();
|
||||
printf("-----------------------------------------------\n\n");
|
||||
|
||||
/* printf("\n[:stream t] --------------------------------\n"); */
|
||||
/* smoke_stream(); */
|
||||
/* printf("-----------------------------------------------\n\n"); */
|
||||
printf("\n[:stream t] --------------------------------\n");
|
||||
smoke_stream();
|
||||
printf("-----------------------------------------------\n\n");
|
||||
|
||||
printf("\n[:accept t] --------------------------------\n");
|
||||
smoke_accept();
|
||||
printf("-----------------------------------------------\n\n");
|
||||
}
|
||||
|
||||
int main() {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
ecl_boot();
|
||||
ecl_add_module(ecl_module_process);
|
||||
ecl_add_module(ecl_module_stacks);
|
||||
|
||||
printf("Hello ECL! %p\n", the_env);
|
||||
nucl_repl();
|
||||
printf("Good bye ECL! %p\n", the_env);
|
||||
|
||||
ecl_halt();
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue