altos/scheme: ao_scheme__cons -> ao_scheme_cons

[fw/altos] / src / scheme / ao_scheme_read.c

diff --git a/src/scheme/ao_scheme_read.c b/src/scheme/ao_scheme_read.c
index 30e29441ff29aa0ccdf41a52e6e143bba3ef37b5..e93466fc688eff4142989f308d01b592e8985eaf 100644 (file)
--- a/src/scheme/ao_scheme_read.c
+++ b/src/scheme/ao_scheme_read.c
@@ -62,7 +62,7 @@ static const uint16_t lex_classes[128] = {
        PRINTABLE|SPECIAL,      /* ) */
        PRINTABLE,              /* * */
        PRINTABLE|SIGN,         /* + */
-       PRINTABLE|SPECIAL,      /* , */
+       PRINTABLE|SPECIAL_QUASI,        /* , */
        PRINTABLE|SIGN,         /* - */
        PRINTABLE|DOTC|FLOATC,  /* . */
        PRINTABLE,              /* / */
@@ -114,7 +114,7 @@ static const uint16_t       lex_classes[128] = {
        PRINTABLE,              /*  ] */
        PRINTABLE,              /*  ^ */
        PRINTABLE,              /*  _ */
-       PRINTABLE|SPECIAL,      /*  ` */
+       PRINTABLE|SPECIAL_QUASI,        /*  ` */
        PRINTABLE,              /*  a */
        PRINTABLE,              /*  b */
        PRINTABLE,              /*  c */
@@ -244,12 +244,13 @@ lex_quoted(void)
        }
 }
 
+#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)
@@ -265,6 +266,9 @@ static inline void end_token(void) {
        token_string[token_len] = '\0';
 }
 
+#ifdef AO_SCHEME_FEATURE_FLOAT
+static float   token_float;
+
 struct namedfloat {
        const char      *name;
        float           value;
@@ -278,6 +282,7 @@ static const struct namedfloat namedfloats[] = {
 };
 
 #define NUM_NAMED_FLOATS       (sizeof namedfloats / sizeof namedfloats[0])
+#endif
 
 static int
 _lex(void)
@@ -315,6 +320,7 @@ _lex(void)
                                return QUOTE;
                        case '.':
                                return DOT;
+#ifdef AO_SCHEME_FEATURE_QUASI
                        case '`':
                                return QUASIQUOTE;
                        case ',':
@@ -327,6 +333,7 @@ _lex(void)
                                        lex_unget(c);
                                        return UNQUOTE;
                                }
+#endif
                        }
                }
                if (lex_class & POUND) {
@@ -340,6 +347,10 @@ _lex(void)
                                add_token(c);
                                end_token();
                                return BOOL;
+#ifdef AO_SCHEME_FEATURE_VECTOR
+                       case '(':
+                               return OPEN_VECTOR;
+#endif
                        case '\\':
                                for (;;) {
                                        int alphabetic;
@@ -391,23 +402,23 @@ _lex(void)
                        }
                }
                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 &&
@@ -416,8 +427,10 @@ _lex(void)
                                                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') {
@@ -426,6 +439,7 @@ _lex(void)
                                                else
                                                        epos = token_len + 1;
                                        }
+#endif
                                        if (lex_class & DIGIT) {
                                                hasdigit = 1;
                                                if (isint)
@@ -434,8 +448,14 @@ _lex(void)
                                }
                                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);
@@ -445,6 +465,7 @@ _lex(void)
                                                        token_int = -token_int;
                                                return NUM;
                                        }
+#ifdef AO_SCHEME_FEATURE_FLOAT
                                        if (isfloat && hasdigit) {
                                                token_float = strtof(token_string, NULL);
                                                return FLOAT;
@@ -454,6 +475,7 @@ _lex(void)
                                                        token_float = namedfloats[u].value;
                                                        return FLOAT;
                                                }
+#endif
                                        return NAME;
                                }
                        }
@@ -474,10 +496,12 @@ int                       ao_scheme_read_list;
 struct ao_scheme_cons  *ao_scheme_read_cons;
 struct ao_scheme_cons  *ao_scheme_read_cons_tail;
 struct ao_scheme_cons  *ao_scheme_read_stack;
+static int             ao_scheme_read_state;
 
 #define READ_IN_QUOTE  0x01
 #define READ_SAW_DOT   0x02
 #define READ_DONE_DOT  0x04
+#define READ_SAW_VECTOR        0x08
 
 static int
 push_read_stack(int read_state)
@@ -486,11 +510,12 @@ push_read_stack(int read_state)
        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;
-       }
+       } else
+               ao_scheme_read_state = read_state;
        ao_scheme_read_cons = NULL;
        ao_scheme_read_cons_tail = NULL;
        return 1;
@@ -513,17 +538,24 @@ pop_read_stack(void)
                ao_scheme_read_cons = 0;
                ao_scheme_read_cons_tail = 0;
                ao_scheme_read_stack = 0;
+               read_state = ao_scheme_read_state;
        }
        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;
 
@@ -532,7 +564,11 @@ ao_scheme_read(void)
        ao_scheme_read_cons = ao_scheme_read_cons_tail = ao_scheme_read_stack = 0;
        for (;;) {
                parse_token = lex();
-               while (parse_token == OPEN) {
+               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++;
@@ -557,9 +593,11 @@ ao_scheme_read(void)
                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;
@@ -567,16 +605,18 @@ ao_scheme_read(void)
                                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++;
@@ -585,6 +625,7 @@ ao_scheme_read(void)
                        case QUOTE:
                                v = _ao_scheme_atom_quote;
                                break;
+#ifdef AO_SCHEME_FEATURE_QUASI
                        case QUASIQUOTE:
                                v = _ao_scheme_atom_quasiquote;
                                break;
@@ -594,6 +635,7 @@ ao_scheme_read(void)
                        case UNQUOTE_SPLICING:
                                v = _ao_scheme_atom_unquote2dsplicing;
                                break;
+#endif
                        }
                        break;
                case CLOSE:
@@ -604,6 +646,10 @@ ao_scheme_read(void)
                        v = ao_scheme_cons_poly(ao_scheme_read_cons);
                        --ao_scheme_read_list;
                        read_state = pop_read_stack();
+#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)));
+#endif
                        break;
                case DOT:
                        if (!ao_scheme_read_list) {