PRINTABLE|WHITE, /* */
PRINTABLE, /* ! */
PRINTABLE|STRINGC, /* " */
- PRINTABLE|POUND, /* # */
+ PRINTABLE, /* # */
PRINTABLE, /* $ */
PRINTABLE, /* % */
PRINTABLE, /* & */
PRINTABLE|SPECIAL, /* ) */
PRINTABLE, /* * */
PRINTABLE|SIGN, /* + */
- PRINTABLE|SPECIAL, /* , */
+ PRINTABLE|SPECIAL_QUASI, /* , */
PRINTABLE|SIGN, /* - */
PRINTABLE|DOTC|FLOATC, /* . */
PRINTABLE, /* / */
PRINTABLE, /* > */
PRINTABLE, /* ? */
PRINTABLE, /* @ */
- PRINTABLE, /* A */
- PRINTABLE, /* B */
- PRINTABLE, /* C */
- PRINTABLE, /* D */
- PRINTABLE|FLOATC, /* E */
- PRINTABLE, /* F */
+ PRINTABLE|HEX_LETTER, /* A */
+ PRINTABLE|HEX_LETTER, /* B */
+ PRINTABLE|HEX_LETTER, /* C */
+ PRINTABLE|HEX_LETTER, /* D */
+ PRINTABLE|FLOATC|HEX_LETTER,/* E */
+ PRINTABLE|HEX_LETTER, /* F */
PRINTABLE, /* G */
PRINTABLE, /* H */
PRINTABLE, /* I */
PRINTABLE, /* ] */
PRINTABLE, /* ^ */
PRINTABLE, /* _ */
- PRINTABLE|SPECIAL, /* ` */
- PRINTABLE, /* a */
- PRINTABLE, /* b */
- PRINTABLE, /* c */
- PRINTABLE, /* d */
- PRINTABLE|FLOATC, /* e */
- PRINTABLE, /* f */
+ PRINTABLE|SPECIAL_QUASI, /* ` */
+ PRINTABLE|HEX_LETTER, /* a */
+ PRINTABLE|HEX_LETTER, /* b */
+ PRINTABLE|HEX_LETTER, /* c */
+ PRINTABLE|HEX_LETTER, /* d */
+ PRINTABLE|FLOATC|HEX_LETTER,/* e */
+ PRINTABLE|HEX_LETTER, /* f */
PRINTABLE, /* g */
PRINTABLE, /* h */
PRINTABLE, /* i */
}
}
+#ifndef AO_SCHEME_TOKEN_MAX
#define AO_SCHEME_TOKEN_MAX 128
+#endif
static char token_string[AO_SCHEME_TOKEN_MAX];
static int32_t token_int;
static int token_len;
-static float token_float;
static inline void add_token(int c) {
if (c && token_len < AO_SCHEME_TOKEN_MAX - 1)
token_string[token_len] = '\0';
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
+static float token_float;
+
struct namedfloat {
const char *name;
float value;
};
#define NUM_NAMED_FLOATS (sizeof namedfloats / sizeof namedfloats[0])
+#endif
+
+static int
+parse_int(int base)
+{
+ int cval;
+ int c;
+
+ token_int = 0;
+ for (;;) {
+ c = lexc();
+ if ((lex_class & HEX_DIGIT) == 0) {
+ lex_unget(c);
+ end_token();
+ return NUM;
+ }
+ add_token(c);
+ if ('0' <= c && c <= '9')
+ cval = c - '0';
+ else
+ cval = (c | ('a' - 'A')) - 'a' + 10;
+ token_int = token_int * base + cval;
+ }
+ return NUM;
+}
static int
_lex(void)
return QUOTE;
case '.':
return DOT;
+#ifdef AO_SCHEME_FEATURE_QUASI
case '`':
return QUASIQUOTE;
case ',':
lex_unget(c);
return UNQUOTE;
}
+#endif
}
}
- if (lex_class & POUND) {
+ if (c == '#') {
c = lexc();
switch (c) {
case 't':
add_token(c);
end_token();
return BOOL;
+#ifdef AO_SCHEME_FEATURE_VECTOR
case '(':
return OPEN_VECTOR;
+#endif
case '\\':
for (;;) {
int alphabetic;
continue;
}
return NUM;
+ case 'x':
+ return parse_int(16);
+ case 'o':
+ return parse_int(8);
+ case 'b':
+ return parse_int(2);
}
}
if (lex_class & STRINGC) {
}
}
if (lex_class & PRINTABLE) {
- int isfloat;
- int hasdigit;
- int isneg;
- int isint;
- int epos;
-
- isfloat = 1;
- isint = 1;
- hasdigit = 0;
+#ifdef AO_SCHEME_FEATURE_FLOAT
+ int isfloat = 1;
+ int epos = 0;
+#endif
+ int hasdigit = 0;
+ int isneg = 0;
+ int isint = 1;
+
token_int = 0;
- isneg = 0;
- epos = 0;
for (;;) {
if (!(lex_class & NUMBER)) {
isint = 0;
+#ifdef AO_SCHEME_FEATURE_FLOAT
isfloat = 0;
+#endif
} else {
+#ifdef AO_SCHEME_FEATURE_FLOAT
if (!(lex_class & INTEGER))
isint = 0;
if (token_len != epos &&
isint = 0;
isfloat = 0;
}
+#endif
if (c == '-')
isneg = 1;
+#ifdef AO_SCHEME_FEATURE_FLOAT
if (c == '.' && epos != 0)
isfloat = 0;
if (c == 'e' || c == 'E') {
else
epos = token_len + 1;
}
+#endif
if (lex_class & DIGIT) {
hasdigit = 1;
if (isint)
}
add_token (c);
c = lexc ();
- if ((lex_class & (NOTNAME)) && (c != '.' || !isfloat)) {
+ if ((lex_class & (NOTNAME))
+#ifdef AO_SCHEME_FEATURE_FLOAT
+ && (c != '.' || !isfloat)
+#endif
+ ) {
+#ifdef AO_SCHEME_FEATURE_FLOAT
unsigned int u;
+#endif
// if (lex_class & ENDOFFILE)
// clearerr (f);
lex_unget(c);
token_int = -token_int;
return NUM;
}
+#ifdef AO_SCHEME_FEATURE_FLOAT
if (isfloat && hasdigit) {
token_float = strtof(token_string, NULL);
return FLOAT;
token_float = namedfloats[u].value;
return FLOAT;
}
+#endif
return NAME;
}
}
static inline int lex(void)
{
int parse_token = _lex();
- RDBGI("token %d (%s)\n", parse_token, token_string);
+ RDBGI("token %d \"%s\"\n", parse_token, token_string);
return parse_token;
}
RDBG_IN();
if (ao_scheme_read_list) {
ao_scheme_read_stack = ao_scheme_cons_cons(ao_scheme_cons_poly(ao_scheme_read_cons),
- ao_scheme__cons(ao_scheme_int_poly(read_state),
+ ao_scheme_cons(ao_scheme_int_poly(read_state),
ao_scheme_cons_poly(ao_scheme_read_stack)));
if (!ao_scheme_read_stack)
return 0;
ao_scheme_read_cons_tail = ao_scheme_poly_cons(ao_scheme_read_cons_tail->cdr))
;
} else {
- ao_scheme_read_cons = 0;
- ao_scheme_read_cons_tail = 0;
- ao_scheme_read_stack = 0;
read_state = ao_scheme_read_state;
+ ao_scheme_read_cons = NULL;
+ ao_scheme_read_cons_tail = NULL;
+ ao_scheme_read_stack = NULL;
+ ao_scheme_read_state = 0;
}
RDBG_OUT();
RDBGI("pop read stack %p %d\n", ao_scheme_read_cons, read_state);
return read_state;
}
+#ifdef AO_SCHEME_FEATURE_VECTOR
+#define is_open(t) ((t) == OPEN || (t) == OPEN_VECTOR)
+#else
+#define is_open(t) ((t) == OPEN)
+#endif
+
ao_poly
ao_scheme_read(void)
{
struct ao_scheme_atom *atom;
- char *string;
+ struct ao_scheme_string *string;
int read_state;
ao_poly v = AO_SCHEME_NIL;
ao_scheme_read_list = 0;
read_state = 0;
- ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
+ ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = NULL;
for (;;) {
parse_token = lex();
- while (parse_token == OPEN || parse_token == OPEN_VECTOR) {
+ while (is_open(parse_token)) {
+#ifdef AO_SCHEME_FEATURE_VECTOR
if (parse_token == OPEN_VECTOR)
read_state |= READ_SAW_VECTOR;
+#endif
if (!push_read_stack(read_state))
return AO_SCHEME_NIL;
ao_scheme_read_list++;
case NUM:
v = ao_scheme_integer_poly(token_int);
break;
+#ifdef AO_SCHEME_FEATURE_FLOAT
case FLOAT:
v = ao_scheme_float_get(token_float);
break;
+#endif
case BOOL:
if (token_string[0] == 't')
v = _ao_scheme_bool_true;
v = _ao_scheme_bool_false;
break;
case STRING:
- string = ao_scheme_string_copy(token_string);
+ string = ao_scheme_string_make(token_string);
if (string)
v = ao_scheme_string_poly(string);
else
v = AO_SCHEME_NIL;
break;
case QUOTE:
+#ifdef AO_SCHEME_FEATURE_QUASI
case QUASIQUOTE:
case UNQUOTE:
case UNQUOTE_SPLICING:
+#endif
if (!push_read_stack(read_state))
return AO_SCHEME_NIL;
ao_scheme_read_list++;
case QUOTE:
v = _ao_scheme_atom_quote;
break;
+#ifdef AO_SCHEME_FEATURE_QUASI
case QUASIQUOTE:
v = _ao_scheme_atom_quasiquote;
break;
case UNQUOTE_SPLICING:
v = _ao_scheme_atom_unquote2dsplicing;
break;
+#endif
}
break;
case CLOSE:
v = ao_scheme_cons_poly(ao_scheme_read_cons);
--ao_scheme_read_list;
read_state = pop_read_stack();
- if (read_state & READ_SAW_VECTOR)
+#ifdef AO_SCHEME_FEATURE_VECTOR
+ if (read_state & READ_SAW_VECTOR) {
v = ao_scheme_vector_poly(ao_scheme_list_to_vector(ao_scheme_poly_cons(v)));
+ read_state &= ~READ_SAW_VECTOR;
+ }
+#endif
break;
case DOT:
if (!ao_scheme_read_list) {