core: Prepare for M2-Planet: reader.c.
* src/reader.c: Rewrite C constructs not supported by M2-Planet.
This commit is contained in:
parent
9a453ec38a
commit
3daaab5f50
107
src/reader.c
107
src/reader.c
|
@ -77,31 +77,33 @@ reader_read_identifier_or_number (int c)
|
||||||
int i = 0;
|
int i = 0;
|
||||||
long n = 0;
|
long n = 0;
|
||||||
int negative_p = 0;
|
int negative_p = 0;
|
||||||
if (c == '+' && isdigit (peekchar ()))
|
if (c == '+' && isdigit (peekchar ()) != 0)
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
else if (c == '-' && isdigit (peekchar ()))
|
else if (c == '-' && (isdigit (peekchar ()) != 0))
|
||||||
{
|
{
|
||||||
negative_p = 1;
|
negative_p = 1;
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
}
|
}
|
||||||
while (isdigit (c))
|
while (isdigit (c) != 0)
|
||||||
{
|
{
|
||||||
g_buf[i++] = c;
|
g_buf[i] = c;
|
||||||
n *= 10;
|
i = i + 1;
|
||||||
n += c - '0';
|
n = n * 10;
|
||||||
|
n = n + c - '0';
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
}
|
}
|
||||||
if (reader_end_of_word_p (c))
|
if (reader_end_of_word_p (c))
|
||||||
{
|
{
|
||||||
unreadchar (c);
|
unreadchar (c);
|
||||||
if (negative_p)
|
if (negative_p != 0)
|
||||||
n = 0 - n;
|
n = 0 - n;
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
}
|
}
|
||||||
/* Fallthrough: Note that `4a', `+1b' are identifiers */
|
/* Fallthrough: Note that `4a', `+1b' are identifiers */
|
||||||
while (!reader_end_of_word_p (c))
|
while (reader_end_of_word_p (c) == 0)
|
||||||
{
|
{
|
||||||
g_buf[i++] = c;
|
g_buf[i] = c;
|
||||||
|
i = i + 1;
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
}
|
}
|
||||||
unreadchar (c);
|
unreadchar (c);
|
||||||
|
@ -146,7 +148,7 @@ reset_reader:
|
||||||
return cons (cell_symbol_quote, cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
return cons (cell_symbol_quote, cons (reader_read_sexp_ (readchar (), a), cell_nil));
|
||||||
if (c == '"')
|
if (c == '"')
|
||||||
return reader_read_string ();
|
return reader_read_string ();
|
||||||
if (c == '.' && (!reader_identifier_p (peekchar ())))
|
if (c == '.' && (reader_identifier_p (peekchar ()) == 0))
|
||||||
return cell_dot;
|
return cell_dot;
|
||||||
return reader_read_identifier_or_number (c);
|
return reader_read_identifier_or_number (c);
|
||||||
}
|
}
|
||||||
|
@ -154,7 +156,7 @@ reset_reader:
|
||||||
int
|
int
|
||||||
reader_eat_whitespace (int c)
|
reader_eat_whitespace (int c)
|
||||||
{
|
{
|
||||||
while (isspace (c))
|
while (isspace (c) != 0)
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
if (c == ';')
|
if (c == ';')
|
||||||
return reader_eat_whitespace (reader_read_line_comment (c));
|
return reader_eat_whitespace (reader_read_line_comment (c));
|
||||||
|
@ -175,7 +177,6 @@ reader_read_list (int c, SCM a)
|
||||||
return cell_nil;
|
return cell_nil;
|
||||||
if (c == EOF)
|
if (c == EOF)
|
||||||
error (cell_symbol_not_a_pair, MAKE_STRING0 ("EOF in list"));
|
error (cell_symbol_not_a_pair, MAKE_STRING0 ("EOF in list"));
|
||||||
//return cell_nil;
|
|
||||||
SCM s = reader_read_sexp_ (c, a);
|
SCM s = reader_read_sexp_ (c, a);
|
||||||
if (s == cell_dot)
|
if (s == cell_dot)
|
||||||
return CAR (reader_read_list (readchar (), a));
|
return CAR (reader_read_list (readchar (), a));
|
||||||
|
@ -270,8 +271,8 @@ reader_read_character ()
|
||||||
c = c - '0';
|
c = c - '0';
|
||||||
while (p >= '0' && p <= '7')
|
while (p >= '0' && p <= '7')
|
||||||
{
|
{
|
||||||
c <<= 3;
|
c = c << 3;
|
||||||
c += readchar () - '0';
|
c = c + readchar () - '0';
|
||||||
p = peekchar ();
|
p = peekchar ();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -284,7 +285,7 @@ reader_read_character ()
|
||||||
}
|
}
|
||||||
else if (((c >= 'a' && c <= 'z') || c == '*') && ((p >= 'a' && p <= 'z') || p == '*'))
|
else if (((c >= 'a' && c <= 'z') || c == '*') && ((p >= 'a' && p <= 'z') || p == '*'))
|
||||||
{
|
{
|
||||||
char buf[10];
|
char *buf = __reader_read_char_buf;
|
||||||
buf[i] = c;
|
buf[i] = c;
|
||||||
i = i + 1;
|
i = i + 1;
|
||||||
while ((p >= 'a' && p <= 'z') || p == '*')
|
while ((p >= 'a' && p <= 'z') || p == '*')
|
||||||
|
@ -294,58 +295,45 @@ reader_read_character ()
|
||||||
p = peekchar ();
|
p = peekchar ();
|
||||||
}
|
}
|
||||||
buf[i] = 0;
|
buf[i] = 0;
|
||||||
if (!strcmp (buf, "*eof*"))
|
if (strcmp (buf, "*eof*") == 0)
|
||||||
c = EOF;
|
c = EOF;
|
||||||
else if (!strcmp (buf, "nul"))
|
else if (strcmp (buf, "nul") == 0)
|
||||||
c = '\0';
|
c = '\0';
|
||||||
else if (!strcmp (buf, "alarm"))
|
else if (strcmp (buf, "alarm") == 0)
|
||||||
c = '\a';
|
c = '\a';
|
||||||
else if (!strcmp (buf, "backspace"))
|
else if (strcmp (buf, "backspace") == 0)
|
||||||
c = '\b';
|
c = '\b';
|
||||||
else if (!strcmp (buf, "tab"))
|
else if (strcmp (buf, "tab") == 0)
|
||||||
c = '\t';
|
c = '\t';
|
||||||
else if (!strcmp (buf, "linefeed"))
|
else if (strcmp (buf, "linefeed") == 0)
|
||||||
c = '\n';
|
c = '\n';
|
||||||
else if (!strcmp (buf, "newline"))
|
else if (strcmp (buf, "newline") == 0)
|
||||||
c = '\n';
|
c = '\n';
|
||||||
else if (!strcmp (buf, "vtab"))
|
else if (strcmp (buf, "vtab") == 0)
|
||||||
c = '\v';
|
c = '\v';
|
||||||
else if (!strcmp (buf, "page"))
|
else if (strcmp (buf, "page") == 0)
|
||||||
c = '\f';
|
c = '\f';
|
||||||
#if 1 //__MESC__
|
else if (strcmp (buf, "return") == 0)
|
||||||
//Nyacc bug
|
/* Nyacc bug
|
||||||
else if (!strcmp (buf, "return"))
|
c = '\r'; */
|
||||||
c = 13;
|
c = 13;
|
||||||
else if (!strcmp (buf, "esc"))
|
else if (strcmp (buf, "esc") == 0)
|
||||||
c = 27;
|
c = 27;
|
||||||
#else
|
else if (strcmp (buf, "space") == 0)
|
||||||
else if (!strcmp (buf, "return"))
|
|
||||||
c = '\r';
|
|
||||||
//Nyacc crash else if (!strcmp (buf, "esc")) c = '\e';
|
|
||||||
#endif
|
|
||||||
else if (!strcmp (buf, "space"))
|
|
||||||
c = ' ';
|
c = ' ';
|
||||||
|
/* Nyacc uses old abbrevs */
|
||||||
#if 1 // Nyacc uses old abbrevs
|
else if (strcmp (buf, "bel") == 0)
|
||||||
else if (!strcmp (buf, "bel"))
|
|
||||||
c = '\a';
|
c = '\a';
|
||||||
else if (!strcmp (buf, "bs"))
|
else if (strcmp (buf, "bs") == 0)
|
||||||
c = '\b';
|
c = '\b';
|
||||||
else if (!strcmp (buf, "ht"))
|
else if (strcmp (buf, "ht") == 0)
|
||||||
c = '\t';
|
c = '\t';
|
||||||
else if (!strcmp (buf, "vt"))
|
else if (strcmp (buf, "vt") == 0)
|
||||||
c = '\v';
|
c = '\v';
|
||||||
|
else if (strcmp (buf, "cr") == 0)
|
||||||
#if 1 //__MESC__
|
/* Nyacc bug
|
||||||
//Nyacc bug
|
c = '\r'; */
|
||||||
else if (!strcmp (buf, "cr"))
|
|
||||||
c = 13;
|
c = 13;
|
||||||
#else
|
|
||||||
else if (!strcmp (buf, "cr"))
|
|
||||||
c = '\r';
|
|
||||||
#endif
|
|
||||||
#endif // Nyacc uses old abbrevs
|
|
||||||
|
|
||||||
else
|
else
|
||||||
{
|
{
|
||||||
eputs ("char not supported: ");
|
eputs ("char not supported: ");
|
||||||
|
@ -376,7 +364,7 @@ reader_read_binary ()
|
||||||
readchar ();
|
readchar ();
|
||||||
c = peekchar ();
|
c = peekchar ();
|
||||||
}
|
}
|
||||||
if (negative_p)
|
if (negative_p != 0)
|
||||||
n = 0 - n;
|
n = 0 - n;
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
}
|
}
|
||||||
|
@ -400,7 +388,7 @@ reader_read_octal ()
|
||||||
readchar ();
|
readchar ();
|
||||||
c = peekchar ();
|
c = peekchar ();
|
||||||
}
|
}
|
||||||
if (negative_p)
|
if (negative_p != 0)
|
||||||
n = 0 - n;
|
n = 0 - n;
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
}
|
}
|
||||||
|
@ -429,7 +417,7 @@ reader_read_hex ()
|
||||||
readchar ();
|
readchar ();
|
||||||
c = peekchar ();
|
c = peekchar ();
|
||||||
}
|
}
|
||||||
if (negative_p)
|
if (negative_p != 0)
|
||||||
n = 0 - n;
|
n = 0 - n;
|
||||||
return MAKE_NUMBER (n);
|
return MAKE_NUMBER (n);
|
||||||
}
|
}
|
||||||
|
@ -450,7 +438,7 @@ reader_read_string ()
|
||||||
{
|
{
|
||||||
c = readchar ();
|
c = readchar ();
|
||||||
if (c == '\\' || c == '"')
|
if (c == '\\' || c == '"')
|
||||||
;
|
0;
|
||||||
else if (c == '0')
|
else if (c == '0')
|
||||||
c = '\0';
|
c = '\0';
|
||||||
else if (c == 'a')
|
else if (c == 'a')
|
||||||
|
@ -466,17 +454,18 @@ reader_read_string ()
|
||||||
else if (c == 'f')
|
else if (c == 'f')
|
||||||
c = '\f';
|
c = '\f';
|
||||||
else if (c == 'r')
|
else if (c == 'r')
|
||||||
// Nyacc bug
|
/* Nyacc bug
|
||||||
// c = '\r';
|
c = '\r'; */
|
||||||
c = 13;
|
c = 13;
|
||||||
else if (c == 'e')
|
else if (c == 'e')
|
||||||
// Nyacc bug
|
/* Nyacc bug
|
||||||
// c = '\e';
|
c = '\e'; */
|
||||||
c = 27;
|
c = 27;
|
||||||
else if (c == 'x')
|
else if (c == 'x')
|
||||||
c = VALUE (reader_read_hex ());
|
c = VALUE (reader_read_hex ());
|
||||||
}
|
}
|
||||||
g_buf[i++] = c;
|
g_buf[i] = c;
|
||||||
|
i = i + 1;
|
||||||
}
|
}
|
||||||
while (1);
|
while (1);
|
||||||
g_buf[i] = 0;
|
g_buf[i] = 0;
|
||||||
|
|
Loading…
Reference in New Issue