mirror of
https://gitlab.com/embeddable-common-lisp/ecl.git
synced 2025-12-15 15:21:03 -08:00
[nucl] parse fixnums and hexnums
This commit is contained in:
Daniel Kochmański
parent
0bd275dd30
commit
e47f37a104
1 changed files with 99 additions and 16 deletions
115
src/c/nucl.c
115
src/c/nucl.c
|
|
@ -98,7 +98,7 @@ nucl_alloc_base_string(cl_index s)
|
|||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_base_string(cl_object stack)
|
||||
nucl_stack_to_string(cl_object stack)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object self = nucl_alloc_base_string(size);
|
||||
|
|
@ -118,6 +118,58 @@ nucl_stack_to_list(cl_object stack)
|
|||
return self;
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_fixnum(cl_object stack)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object self = ECL_NIL;
|
||||
intmax_t acc = 0;
|
||||
int dig;
|
||||
loop_across_stack_fifo(elt, stack) {
|
||||
acc *= 10;
|
||||
switch(ECL_CHAR_CODE(elt)) {
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
acc += ECL_CHAR_CODE(elt) - '0';
|
||||
break;
|
||||
default:
|
||||
ecl_internal_error("Character is not a digit!");
|
||||
}
|
||||
if (acc>MOST_POSITIVE_FIXNUM)
|
||||
ecl_internal_error("Integer is too big!");
|
||||
} end_loop_across_stack();
|
||||
return ecl_make_fixnum((cl_fixnum)acc);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_stack_to_hexnum(cl_object stack)
|
||||
{
|
||||
cl_index size = stack->vector.fillp, idx;
|
||||
cl_object self = ECL_NIL;
|
||||
intmax_t acc = 0;
|
||||
int dig;
|
||||
loop_across_stack_fifo(elt, stack) {
|
||||
acc *= 16;
|
||||
switch(ECL_CHAR_CODE(elt)) {
|
||||
case '0': case '1': case '2': case '3': case '4':
|
||||
case '5': case '6': case '7': case '8': case '9':
|
||||
acc += ECL_CHAR_CODE(elt) - '0';
|
||||
break;
|
||||
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
|
||||
acc += 10 + (ECL_CHAR_CODE(elt) - 'a');
|
||||
break;
|
||||
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
|
||||
acc += 10 + (ECL_CHAR_CODE(elt) - 'A');
|
||||
break;
|
||||
default:
|
||||
ecl_internal_error("Character is not a digit!");
|
||||
}
|
||||
if (acc>MOST_POSITIVE_FIXNUM)
|
||||
ecl_internal_error("Integer is too big!");
|
||||
} end_loop_across_stack();
|
||||
return ecl_make_fixnum((cl_fixnum)acc);
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_write_cstr(cl_object strm, const char *s)
|
||||
{
|
||||
|
|
@ -126,7 +178,7 @@ nucl_write_cstr(cl_object strm, const char *s)
|
|||
}
|
||||
|
||||
void
|
||||
nucl_write_lstr(cl_object strm, cl_object s)
|
||||
nucl_write_string(cl_object strm, cl_object s)
|
||||
{
|
||||
int aux;
|
||||
for(aux=0; aux<s->string.fillp; aux++)
|
||||
|
|
@ -135,6 +187,24 @@ nucl_write_lstr(cl_object strm, cl_object s)
|
|||
: si_write_char(strm, ECL_CODE_CHAR(s->base_string.self[aux]));
|
||||
}
|
||||
|
||||
void
|
||||
nucl_write_fixnum(cl_object strm, cl_object s)
|
||||
{
|
||||
cl_object stack = ecl_make_stack(0), c=ECL_NIL;
|
||||
cl_fixnum value = ecl_fixnum(s), dig;
|
||||
if(value<0) value = -value;
|
||||
do {
|
||||
dig = value%10;
|
||||
ecl_stack_push(stack, ECL_CODE_CHAR(dig+'0'));
|
||||
value /= 10;
|
||||
} while(value!=0);
|
||||
if(ecl_fixnum(s) < 0)
|
||||
ecl_stack_push(stack, ECL_CODE_CHAR('-'));
|
||||
loop_across_stack_filo(elt, stack) {
|
||||
si_write_char(strm, elt);
|
||||
} end_loop_across_stack();
|
||||
}
|
||||
|
||||
cl_object
|
||||
nucl_read_until(cl_object strm, cl_fixnum delim)
|
||||
{
|
||||
|
|
@ -150,7 +220,7 @@ cl_object
|
|||
nucl_read_line(cl_object strm)
|
||||
{
|
||||
cl_object stack = nucl_read_until(strm, '\n');
|
||||
return nucl_stack_to_base_string(stack);
|
||||
return nucl_stack_to_string(stack);
|
||||
}
|
||||
|
||||
/* Ad-hoc printer */
|
||||
|
|
@ -166,20 +236,18 @@ nucl_write_object(cl_object strm, cl_object self)
|
|||
si_write_char(strm, self);
|
||||
break;
|
||||
case t_fixnum:
|
||||
(ecl_fixnum(self) < 0)
|
||||
? nucl_write_cstr(strm, "#<negative fixnum>")
|
||||
: nucl_write_cstr(strm, "#<positive fixnum>");
|
||||
nucl_write_fixnum(strm, self);
|
||||
break;
|
||||
case t_base_string:
|
||||
case t_string:
|
||||
nucl_write_cstr(strm, "\"");
|
||||
nucl_write_lstr(strm, self);
|
||||
nucl_write_string(strm, self);
|
||||
nucl_write_cstr(strm, "\"");
|
||||
break;
|
||||
case t_symbol: /* ignores packages, introduce t_token? */
|
||||
reg = self->symbol.name;
|
||||
for(aux=0; aux<reg->string.fillp; aux++)
|
||||
nucl_write_lstr(strm, reg);
|
||||
nucl_write_string(strm, reg);
|
||||
break;
|
||||
case t_vector:
|
||||
nucl_write_cstr(strm, "[");
|
||||
|
|
@ -277,8 +345,12 @@ comment_reader(int narg, cl_object strm, cl_object c)
|
|||
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);
|
||||
/* xxx broken recursive read */
|
||||
/* cl_object stack = nucl_accept(strm, ECL_CODE_CHAR(')')); */
|
||||
/* return nucl_stack_to_list(stack); */
|
||||
cl_object stack = nucl_read_until(strm, ')');
|
||||
ecl_stack_popu(stack);
|
||||
return ecl_cons(ECL_CODE_CHAR('L'), nucl_stack_to_string(stack));
|
||||
}
|
||||
|
||||
static cl_object
|
||||
|
|
@ -291,7 +363,7 @@ static cl_object
|
|||
symbol_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
cl_object stack = default_reader(2, strm, c);
|
||||
cl_object string = nucl_stack_to_base_string(stack);
|
||||
cl_object string = nucl_stack_to_string(stack);
|
||||
return ecl_cons(ECL_CODE_CHAR('T'), string);
|
||||
}
|
||||
|
||||
|
|
@ -300,19 +372,31 @@ string_reader(int narg, cl_object strm, cl_object c)
|
|||
{
|
||||
cl_object stack = nucl_read_until(strm, ECL_CHAR_CODE(c));
|
||||
ecl_stack_popu(stack);
|
||||
return nucl_stack_to_base_string(stack);
|
||||
return nucl_stack_to_string(stack);
|
||||
}
|
||||
|
||||
static cl_object
|
||||
fixnum_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
return ecl_make_fixnum(42);
|
||||
cl_object stack = default_reader(2, strm, c);
|
||||
cl_object result = nucl_stack_to_fixnum(stack);
|
||||
return result;
|
||||
}
|
||||
|
||||
static cl_object
|
||||
hexnum_reader(int narg, cl_object strm, cl_object c)
|
||||
{
|
||||
return ecl_make_fixnum(0x42);
|
||||
cl_object ch = si_read_char(strm, 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);
|
||||
return ecl_make_fixnum(0);
|
||||
} else {
|
||||
cl_object stack = default_reader(2, strm, c);
|
||||
cl_object result = nucl_stack_to_hexnum(stack);
|
||||
return result;
|
||||
}
|
||||
}
|
||||
|
||||
/* ecl_def_function(_default_reader, default_reader, static, const); */
|
||||
|
|
@ -386,7 +470,7 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
cl_object result = ECL_NIL;
|
||||
ch = si_read_char(strm, delim);
|
||||
if (ecl_eql(delim, ch)) {
|
||||
return stack;
|
||||
return OBJNULL;
|
||||
}
|
||||
entry = nucl_readtable_get(rtable, ECL_CHAR_CODE(ch));
|
||||
switch (entry->syntax_type) {
|
||||
|
|
@ -407,7 +491,6 @@ nucl_accept(cl_object strm, cl_object delim)
|
|||
default:
|
||||
ecl_internal_error("Expecting too much, aren't we?");
|
||||
}
|
||||
|
||||
return result;
|
||||
}
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue