artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: Rewrite reader to create less garbage.

Browse source 
* src/reader.c (reader_read_line_comment): Rename from read_line_comment.
(reader_identifier_p): New function.
(reader_end_of_word_p): New function.
(reader_read_identifier_or_number): New function.
(reader_read_sexp_): Rewrite.  Update callers.
(reader_read_list): Rewrite.
(reader_lookup_): Remove.
This commit is contained in:
Jan Nieuwenhuizen 2018-04-09 08:41:30 +02:00
parent 25907f514c
commit 72fc46a572
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
2 changed files with 115 additions and 100 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
module/mes/repl.mes
View file

@ -25,6 +25,7 @@
;;; Code: ;;; Code:
(mes-use-module (mes scm)) (mes-use-module (mes scm))
(mes-use-module (srfi srfi-14))
(define welcome (define welcome
(string-append "Mes " %version " (string-append "Mes " %version "
@ -127,7 +128,8 @@ along with Mes. If not, see <http://www.gnu.org/licenses/>.
(define topic-alist `((#\newline . ,show-commands) (define topic-alist `((#\newline . ,show-commands)
(#\c . ,copying) (#\c . ,copying)
(#\w . ,warranty))) (#\w . ,warranty)))
(let ((topic (read-char))) (let* ((word (read-env '()))
(topic (find (negate char-whitespace?) (symbol->list word))))
(display (assoc-ref topic-alist topic)) (display (assoc-ref topic-alist topic))
*unspecified*)) *unspecified*))
(define (use a) (define (use a)

203
src/reader.c
View file

@ -42,132 +42,146 @@ read_input_file_env (SCM a)
int int
reader_read_line_comment (int c) reader_read_line_comment (int c)
{ {
if (c == '\n') return c; if (c == '\n')
return c;
return reader_read_line_comment (getchar ()); return reader_read_line_comment (getchar ());
} }
SCM reader_read_block_comment (int s, int c); SCM reader_read_block_comment (int s, int c);
SCM read_hash (int c, SCM w, SCM a); SCM reader_read_hash (int c, SCM a);
SCM reader_read_list (int c, SCM a); SCM reader_read_list (int c, SCM a);
SCM int
reader_read_sexp_ (int c, SCM s, SCM a) reader_identifier_p (int c)
{ {
return (c > ' ' && c <= '~' && c != '"' && c != ';' && c != '(' && c != ')' && c != EOF);
}
int
reader_end_of_word_p (int c)
{
return (c == '"' || c == ';' || c == '(' || c == ')' || isspace (c) || c == EOF);
}
SCM
reader_read_identifier_or_number (int c)
{
char buf[1024];
int i = 0;
int n = 0;
int negative_p = 0;
if (c == '+' && isdigit (peekchar ()))
c = getchar ();
else if (c == '-' && isdigit (peekchar ()))
{
negative_p = 1;
c = getchar ();
}
while (isdigit (c))
{
buf[i++] = c;
n *= 10;
n += c - '0';
c = getchar ();
}
if (reader_end_of_word_p (c))
{
ungetchar (c);
if (negative_p)
n = 0 - n;
return MAKE_NUMBER (n);
}
while (!reader_end_of_word_p (c))
{
buf[i++] = c;
c = getchar ();
}
ungetchar (c);
buf[i] = 0;
return lookup_symbol_ (cstring_to_list (buf));
}
SCM
reader_read_sexp_ (int c, SCM a)
{
SCM s = cell_nil;
switch (c) switch (c)
{ {
case ' ': case EOF:
return reader_read_sexp_ ('\n', s, a); return cell_nil;
case '\f':
return reader_read_sexp_ ('\n', s, a);
case '\t':
return reader_read_sexp_ ('\n', s, a);
case ';': case ';':
reader_read_line_comment (c); reader_read_line_comment (c);
return reader_read_sexp_ ('\n', s, a); case ' ':
case '\t':
case '\n':
case '\f':
return reader_read_sexp_ (getchar (), a);
case '(':
return reader_read_list (getchar (), a);
case ')':
return cell_nil;
case '#': case '#':
return read_hash (getchar (), s, a); return reader_read_hash (getchar (), a);
case '`': case '`':
return cons (cell_symbol_quasiquote, return cons (cell_symbol_quasiquote,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
case ',': case ',':
if (peekchar () == '@') if (peekchar () == '@')
{ {
getchar (); getchar ();
return cons (cell_symbol_unquote_splicing, return cons (cell_symbol_unquote_splicing,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
} }
return cons (cell_symbol_unquote, return cons (cell_symbol_unquote,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
default:
if (s == cell_nil)
switch (c)
{
case EOF:
return cell_nil;
case '\n':
return reader_read_sexp_ (getchar (), s, a);
case '(':
return reader_read_list (getchar (), a);
case ')':
ungetchar (c);
return cell_nil;
case '\'': case '\'':
return cons (cell_symbol_quote, return cons (cell_symbol_quote,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
case '"': case '"':
return reader_read_string (); return reader_read_string ();
} case '.':
else if (!reader_identifier_p (peekchar ()))
switch (c)
{
case EOF:
return reader_lookup_ (s, a);
case '\n':
if (CAR (s) == cell_dot && CDR (s) == cell_nil)
return cell_dot; return cell_dot;
else default:
return reader_lookup_ (s, a); return reader_read_identifier_or_number (c);
case '(':
ungetchar (c);
return reader_lookup_ (s, a);
case ')':
ungetchar (c);
return reader_lookup_ (s, a);
case '"':
ungetchar (c);
return reader_lookup_ (s, a);
} }
} }
return reader_read_sexp_ (getchar (),
append2 (s, cons (MAKE_CHAR (c), cell_nil)), a);
}
int int
eat_whitespace (int c) reader_eat_whitespace (int c)
{ {
while (c == ' ' || c == '\t' || c == '\n' || c == '\f') c = getchar (); while (isspace (c))
if (c == ';') return eat_whitespace (reader_read_line_comment (c)); c = getchar ();
if (c == '#' && (peekchar () == '!' || peekchar () == '|')) {c=getchar (); reader_read_block_comment (c, getchar ()); return eat_whitespace (getchar ());} if (c == ';')
return reader_eat_whitespace (reader_read_line_comment (c));
if (c == '#' && (peekchar () == '!' || peekchar () == '|'))
{
c=getchar ();
reader_read_block_comment (c, getchar ());
return reader_eat_whitespace (getchar ());
}
return c; return c;
} }
SCM SCM
reader_read_list (int c, SCM a) reader_read_list (int c, SCM a)
{ {
c = eat_whitespace (c); c = reader_eat_whitespace (c);
if (c == ')') return cell_nil; if (c == ')')
SCM s = reader_read_sexp_ (c, cell_nil, a); return cell_nil;
if (c == EOF)
error (cell_symbol_not_a_pair, MAKE_STRING (cstring_to_list ("EOF in list")));
//return cell_nil;
SCM s = reader_read_sexp_ (c, a);
if (s == cell_dot) if (s == cell_dot)
return car (reader_read_list (getchar (), a)); return CAR (reader_read_list (getchar (), a));
return cons (s, reader_read_list (getchar (), a)); return cons (s, reader_read_list (getchar (), a));
} }
SCM SCM
read_env (SCM a) read_env (SCM a)
{ {
return reader_read_sexp_ (getchar (), cell_nil, a); return reader_read_sexp_ (getchar (), a);
}
SCM
reader_lookup_ (SCM s, SCM a)
{
if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
SCM p = s;
int sign = 1;
if (VALUE (car (s)) == '-') {
sign = -1;
p = cdr (s);
}
int n = 0;
while (p != cell_nil && isdigit (VALUE (car (p)))) {
n *= 10;
n += VALUE (car (p)) - '0';
p = cdr (p);
}
if (p == cell_nil) return MAKE_NUMBER (n * sign);
}
return lookup_symbol_ (s);
} }
SCM SCM
@ -178,16 +192,16 @@ reader_read_block_comment (int s, int c)
} }
SCM SCM
read_hash (int c, SCM s, SCM a) reader_read_hash (int c, SCM a)
{ {
switch (c) switch (c)
{ {
case '!': case '!':
reader_read_block_comment (c, getchar ()); reader_read_block_comment (c, getchar ());
return reader_read_sexp_ (getchar (), s, a); return reader_read_sexp_ (getchar (), a);
case '|': case '|':
reader_read_block_comment (c, getchar ()); reader_read_block_comment (c, getchar ());
return reader_read_sexp_ (getchar (), s, a); return reader_read_sexp_ (getchar (), a);
case 'f': case 'f':
return cell_f; return cell_f;
case 't': case 't':
@ -197,19 +211,19 @@ read_hash (int c, SCM s, SCM a)
{ {
getchar (); getchar ();
return cons (cell_symbol_unsyntax_splicing, return cons (cell_symbol_unsyntax_splicing,
cons (reader_read_sexp_ (getchar (), s, a), cons (reader_read_sexp_ (getchar (), a),
cell_nil)); cell_nil));
} }
return cons (cell_symbol_unsyntax, return cons (cell_symbol_unsyntax,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
case '\'': case '\'':
return cons (cell_symbol_syntax, return cons (cell_symbol_syntax,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
case '`': case '`':
return cons (cell_symbol_quasisyntax, return cons (cell_symbol_quasisyntax,
cons (reader_read_sexp_ (getchar (), s, a), cell_nil)); cons (reader_read_sexp_ (getchar (), a), cell_nil));
case ':': case ':':
return MAKE_KEYWORD (CAR (reader_read_sexp_ (getchar (), cell_nil, a))); return MAKE_KEYWORD (CAR (reader_read_sexp_ (getchar (), a)));
case 'o': case 'o':
return reader_read_octal (); return reader_read_octal ();
case 'x': case 'x':
@ -219,17 +233,16 @@ read_hash (int c, SCM s, SCM a)
case '(': case '(':
return list_to_vector (reader_read_list (getchar (), a)); return list_to_vector (reader_read_list (getchar (), a));
case ';': case ';':
reader_read_sexp_ (getchar (), s, a); reader_read_sexp_ (getchar (), a);
return reader_read_sexp_ (getchar (), s, a); return reader_read_sexp_ (getchar (), a);
} }
return reader_read_sexp_ (getchar (), return reader_read_sexp_ (getchar (), a);
append2 (s, cons (MAKE_CHAR (c), cell_nil)), a);
} }
SCM SCM
reader_read_sexp (SCM c, SCM s, SCM a) reader_read_sexp (SCM c, SCM s, SCM a)
{ {
return reader_read_sexp_ (VALUE (c), s, a); return reader_read_sexp_ (VALUE (c), a);
} }
SCM SCM