mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-06 02:40:26 -08:00
[nucl] add barebones reader
This commit is contained in:
Daniel Kochmański
parent
da85aeb104
commit
361a65e0b5
1 changed files with 229 additions and 33 deletions
262
src/c/nucl.c
262
src/c/nucl.c
|
|
@ -98,33 +98,35 @@ nucl_alloc_base_string(cl_index s)
|
|||
}
|
||||
|
||||
cl_object
|
||||
nucl_write(const char *s, cl_object strm)
|
||||
nucl_stack_to_base_string(cl_object stack)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object self = nucl_alloc_base_string(size);
|
||||
for(idx=0; idx<size; idx++)
|
||||
self->base_string.self[idx] = ECL_CHAR_CODE(stack->vector.self.t[idx]);
|
||||
return self;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_list(cl_object stack)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object self = ECL_NIL;
|
||||
loop_across_stack_filo(elt, stack) {
|
||||
self = ecl_cons(elt, self);
|
||||
} end_loop_across_stack();
|
||||
return self;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_write_cstr(cl_object strm, const char *s)
|
||||
{
|
||||
while(*s != '\0')
|
||||
si_write_char(strm, ECL_CODE_CHAR(*s++));
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_print(cl_object self, cl_object strm)
|
||||
{
|
||||
cl_type t = ecl_t_of(self);
|
||||
switch (t) {
|
||||
case t_base_string:
|
||||
nucl_write(self->base_string.self, strm);
|
||||
break;
|
||||
default:
|
||||
{
|
||||
const char *name = ecl_type_info[t].name;
|
||||
nucl_write("#<", strm);
|
||||
nucl_write(name, strm);
|
||||
nucl_write(">", strm);
|
||||
return ECL_NIL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_readl(cl_object self, cl_object strm)
|
||||
nucl_read_line(cl_object strm)
|
||||
{
|
||||
cl_object stack = ecl_make_stack(0), c=ECL_NIL;
|
||||
cl_index idx, size;
|
||||
|
|
@ -132,16 +134,194 @@ nucl_readl(cl_object self, cl_object strm)
|
|||
ecl_stack_push(stack, c);
|
||||
if(ECL_CHAR_CODE(c) == '\n') break;
|
||||
}
|
||||
size = stack->vector.fillp;
|
||||
if(Null(self)) {
|
||||
self = nucl_alloc_base_string(size);
|
||||
} else {
|
||||
self->base_string.self[size] = '\0';
|
||||
}
|
||||
for(idx=0; idx<size; idx++)
|
||||
self->base_string.self[idx] = ECL_CHAR_CODE(stack->vector.self.t[idx]);
|
||||
return self;
|
||||
return nucl_stack_to_base_string(stack);
|
||||
}
|
||||
|
||||
/* Ad-hoc printer */
|
||||
cl_object
|
||||
nucl_display(cl_object strm, cl_object self)
|
||||
{
|
||||
cl_type t = ecl_t_of(self);
|
||||
switch (t) {
|
||||
case t_character:
|
||||
si_write_char(strm, self);
|
||||
break;
|
||||
case t_base_string:
|
||||
nucl_write_cstr(strm, self->base_string.self);
|
||||
break;
|
||||
case t_vector:
|
||||
nucl_write_cstr(strm, "[");
|
||||
loop_across_stack_fifo(elt, self) {
|
||||
nucl_display(strm, elt);
|
||||
} end_loop_across_stack();
|
||||
nucl_write_cstr(strm, "]");
|
||||
break;
|
||||
default:
|
||||
{
|
||||
const char *name = ecl_type_info[t].name;
|
||||
nucl_write_cstr(strm, "#<");
|
||||
nucl_write_cstr(strm, name);
|
||||
nucl_write_cstr(strm, ">");
|
||||
return ECL_NIL;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
/* Ad-hoc reader */
|
||||
static cl_object rtable = ECL_NIL;
|
||||
static cl_object nucl_accept(cl_object strm, cl_object delim);
|
||||
|
||||
void
|
||||
nucl_readtable_set(cl_object self, cl_fixnum c, enum ecl_chattrib cat,
|
||||
cl_object macro)
|
||||
{
|
||||
if (c >= RTABSIZE) {
|
||||
ecl_internal_error("Character is too big!");
|
||||
}
|
||||
self->readtable.table[c].dispatch = macro;
|
||||
self->readtable.table[c].syntax_type = cat;
|
||||
}
|
||||
|
||||
struct ecl_readtable_entry *
|
||||
nucl_readtable_get(cl_object self, cl_fixnum ch)
|
||||
{
|
||||
if (ch >= RTABSIZE) {
|
||||
ecl_internal_error("Character is too big!");
|
||||
}
|
||||
return self->readtable.table+ch;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
default_reader(int narg, cl_object strm, cl_object ch)
|
||||
{
|
||||
/* This reader reads either a token (symbol) or a number (fixnum). */
|
||||
struct ecl_readtable_entry *entry = NULL;
|
||||
cl_object stack = ecl_make_stack(0);
|
||||
ecl_stack_push(stack, ch);
|
||||
while (!Null(ch = si_read_char(strm, ECL_NIL))) {
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
switch (entry->syntax_type) {
|
||||
case cat_constituent:
|
||||
ecl_stack_push(stack, ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
si_unread_char(strm, ch);
|
||||
return stack;
|
||||
case cat_whitespace:
|
||||
return stack;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
}
|
||||
return stack;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
comment_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
ecl_internal_error("comment reader");
|
||||
}
|
||||
|
||||
static cl_object
|
||||
lparen_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object stack = nucl_accept(strm, ECL_CODE_CHAR(')'));
|
||||
return nucl_stack_to_list(stack);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
rparen_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
ecl_internal_error("rparen reader");
|
||||
}
|
||||
|
||||
static cl_object
|
||||
symbol_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
ecl_internal_error("symbol reader");
|
||||
}
|
||||
|
||||
static cl_object
|
||||
string_reader(int narg, cl_object strm, cl_object ch)
|
||||
{
|
||||
ecl_internal_error("string reader");
|
||||
}
|
||||
|
||||
static cl_object
|
||||
fixnum_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
ecl_internal_error("fixnum reader");
|
||||
}
|
||||
|
||||
/* ecl_def_function(_default_reader, default_reader, static, const); */
|
||||
ecl_def_function(_comment_reader, comment_reader, static, const);
|
||||
ecl_def_function(_lparen_reader, lparen_reader, static, const);
|
||||
ecl_def_function(_rparen_reader, rparen_reader, static, const);
|
||||
ecl_def_function(_symbol_reader, symbol_reader, static, const);
|
||||
ecl_def_function(_string_reader, string_reader, static, const);
|
||||
ecl_def_function(_fixnum_reader, fixnum_reader, static, const);
|
||||
|
||||
void
|
||||
init_nucl_reader(void)
|
||||
{
|
||||
rtable = ecl_alloc_object(t_readtable);
|
||||
struct ecl_readtable_entry *rtab = (struct ecl_readtable_entry *)
|
||||
ecl_alloc(RTABSIZE * sizeof(struct ecl_readtable_entry));
|
||||
rtable->readtable.locked = 0;
|
||||
rtable->readtable.read_case = ecl_case_preserve; /* enum ecl_readtable_case */
|
||||
rtable->readtable.table = rtab;
|
||||
for (int i = 0; i < RTABSIZE; i++) {
|
||||
rtab[i].syntax_type = cat_constituent; /* enum ecl_chattrib */
|
||||
rtab[i].dispatch = ECL_NIL;
|
||||
}
|
||||
#ifdef ECL_UNICODE
|
||||
rtable->readtable.hash = ECL_NIL;
|
||||
#endif
|
||||
|
||||
nucl_readtable_set(rtable, '\t', cat_whitespace, ECL_NIL);
|
||||
nucl_readtable_set(rtable, '\n', cat_whitespace, ECL_NIL);
|
||||
nucl_readtable_set(rtable, '\f', cat_whitespace, ECL_NIL);
|
||||
nucl_readtable_set(rtable, '\r', cat_whitespace, ECL_NIL);
|
||||
nucl_readtable_set(rtable, ' ', cat_whitespace, ECL_NIL);
|
||||
|
||||
nucl_readtable_set(rtable, '"', cat_terminating, _string_reader);
|
||||
nucl_readtable_set(rtable, '(', cat_terminating, _lparen_reader);
|
||||
nucl_readtable_set(rtable, ')', cat_terminating, _rparen_reader);
|
||||
nucl_readtable_set(rtable, ';', cat_terminating, _comment_reader);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
nucl_accept(cl_object strm, cl_object delim)
|
||||
{
|
||||
struct ecl_readtable_entry *entry = NULL;
|
||||
cl_object stack = ecl_make_stack(0);
|
||||
cl_object ch = ECL_NIL;
|
||||
cl_object result = ECL_NIL;
|
||||
while (!Null(ch = si_read_char(strm, ECL_NIL))) {
|
||||
if (ecl_eql(delim, ch)) {
|
||||
return stack;
|
||||
}
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
switch (entry->syntax_type) {
|
||||
case cat_constituent:
|
||||
result = default_reader(2, strm, ch);
|
||||
break;
|
||||
case cat_terminating:
|
||||
result = _ecl_funcall3(entry->dispatch, strm, ch);
|
||||
break;
|
||||
case cat_whitespace:
|
||||
result = OBJNULL;
|
||||
break;
|
||||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
if (result!=OBJNULL) {
|
||||
ecl_stack_push(stack, result);
|
||||
}
|
||||
}
|
||||
return stack;
|
||||
}
|
||||
|
||||
/* -- Lali-ho I/O ends here ------------------------------------------------- */
|
||||
|
||||
void
|
||||
|
|
@ -153,12 +333,25 @@ smoke_stream (void)
|
|||
char *string = "Hello World> ", c;
|
||||
int i;
|
||||
printf(">>> smoke_stream: stream is %p\n", ostrm);
|
||||
nucl_write(string, ostrm);
|
||||
line = nucl_readl(ECL_NIL, istrm);
|
||||
nucl_print(line, ostrm);
|
||||
nucl_write_cstr(ostrm, string);
|
||||
line = nucl_read_line(istrm);
|
||||
nucl_display(ostrm, line);
|
||||
ecl_dealloc(line);
|
||||
}
|
||||
|
||||
void
|
||||
smoke_accept (void)
|
||||
{
|
||||
cl_object ostrm = ecl_make_nucl_stream(stdout);
|
||||
cl_object istrm = ecl_make_nucl_stream(stdin);
|
||||
cl_object result = ECL_NIL;
|
||||
init_nucl_reader();
|
||||
printf(">>> smoke_accept: readtable is %p\n", rtable);
|
||||
nucl_write_cstr(ostrm, "token> ");
|
||||
result = nucl_accept(istrm, ECL_NIL);
|
||||
nucl_display(ostrm, result);
|
||||
}
|
||||
|
||||
int main() {
|
||||
cl_env_ptr the_env = ecl_core.first_env;
|
||||
ecl_boot();
|
||||
|
|
@ -193,6 +386,9 @@ int main() {
|
|||
smoke_stream();
|
||||
printf("-----------------------------------------------\n\n");
|
||||
|
||||
printf("\n[:accept t] --------------------------------\n");
|
||||
smoke_accept();
|
||||
printf("-----------------------------------------------\n\n");
|
||||
|
||||
printf("Good bye ECL! %p\n", the_env);
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue