core: Simplify lookup.
* reader.c (lookup_): Rename from lookup. Remove all lookups except for numbers and symbols. Update callers. * mes.c (make_symbol_): Rename from internal_make_symbol. Update callers. * module/mes/read-0.mes (lookup): New function. (read-word): Remove all lookup calls, except for numbers and symbols.
This commit is contained in:
Jan Nieuwenhuizen
parent
6f60e12d76
commit
18ba10e2ae
|
|
@ -51,16 +51,18 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
|||
|
||||
(define (function-scm-name f)
|
||||
(or (assoc-ref (.annotation f) 'name)
|
||||
((compose
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "^builtin_" "")
|
||||
(regexp-replace "_to_" "->")
|
||||
(regexp-replace "_x$" "!")
|
||||
(regexp-replace "_p$" "?"))
|
||||
(.name f))))
|
||||
(let ((name ((compose
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "_" "-")
|
||||
(regexp-replace "^builtin_" "")
|
||||
(regexp-replace "_to_" "->")
|
||||
(regexp-replace "_x$" "!")
|
||||
(regexp-replace "_p$" "?"))
|
||||
(.name f))))
|
||||
(if (not (string-suffix? "-" name)) name
|
||||
(string-append "core:" (string-drop-right name 1))))))
|
||||
|
||||
(define %builtin-prefix% "scm_")
|
||||
(define (function-builtin-name f)
|
||||
|
|
|
|||
11
mes.c
11
mes.c
|
|
@ -32,7 +32,6 @@
|
|||
#define FIXED_PRIMITIVES 1
|
||||
|
||||
int ARENA_SIZE = 100000;
|
||||
|
||||
int MAX_ARENA_SIZE = 20000000;
|
||||
int GC_SAFETY = 100;
|
||||
|
||||
|
|
@ -697,8 +696,8 @@ make_function (SCM name, SCM id, SCM arity)
|
|||
SCM
|
||||
make_keyword (SCM s)
|
||||
{
|
||||
SCM x = internal_lookup_symbol (s);
|
||||
x = x ? x : internal_make_symbol (s);
|
||||
SCM x = lookup_symbol_ (s);
|
||||
x = x ? x : make_symbol_ (s);
|
||||
g_cells[tmp_num].value = KEYWORD;
|
||||
return make_cell (tmp_num, STRING (x), 0);
|
||||
}
|
||||
|
|
@ -749,7 +748,7 @@ null_p (SCM x)
|
|||
}
|
||||
|
||||
SCM
|
||||
internal_make_symbol (SCM s)
|
||||
make_symbol_ (SCM s)
|
||||
{
|
||||
g_cells[tmp_num].value = SYMBOL;
|
||||
SCM x = make_cell (tmp_num, s, 0);
|
||||
|
|
@ -760,8 +759,8 @@ internal_make_symbol (SCM s)
|
|||
SCM
|
||||
make_symbol (SCM s)
|
||||
{
|
||||
SCM x = internal_lookup_symbol (s);
|
||||
return x ? x : internal_make_symbol (s);
|
||||
SCM x = lookup_symbol_ (s);
|
||||
return x ? x : make_symbol_ (s);
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
|
|||
|
|
@ -245,11 +245,17 @@
|
|||
((eq? c -1) (display (quote EOF-in-string)) (newline) (exit 1))
|
||||
(#t (read-string (read-byte) (peek-byte) (append-char s c)))))
|
||||
(list->string (read-string (read-byte) (peek-byte) (list))))
|
||||
|
||||
|
||||
(define (map1 f lst)
|
||||
(if (null? lst) (list)
|
||||
(cons (f (car lst)) (map1 f (cdr lst)))))
|
||||
|
||||
(define (lookup w a)
|
||||
(core:lookup (map1 integer->char w) a))
|
||||
|
||||
(define (read-word c w a)
|
||||
(cond
|
||||
((eq? c 32) (if (null? w) (read-word (read-byte) (list) a)
|
||||
(lookup w a)))
|
||||
((eq? c 32) (if (null? w) (read-word (read-byte) (list) a) (lookup w a)))
|
||||
((eq? c 10) (read-word 32 w a))
|
||||
((eq? c 9) (read-word 32 w a))
|
||||
((eq? c 12) (read-word 32 w a))
|
||||
|
|
@ -269,40 +275,41 @@
|
|||
(read-byte)
|
||||
(cond ((eq? (peek-byte) 64)
|
||||
(read-byte)
|
||||
(cons (lookup (symbol->list (quote unsyntax-splicing)) a)
|
||||
(cons (quote unsyntax-splicing)
|
||||
(cons (read-word (read-byte) w a) (list))))
|
||||
(#t
|
||||
(cons (lookup (symbol->list (quote unsyntax)) a)
|
||||
(cons (quote unsyntax)
|
||||
(cons (read-word (read-byte) w a) (list))))))
|
||||
((eq? (peek-byte) 39) (read-byte)
|
||||
(cons (lookup (cons (integer->char 35) (cons (integer->char 39) (list))) a)
|
||||
(cons (read-word (read-byte) w a) (list))))
|
||||
(cons (quote syntax) (cons (read-word (read-byte) w a) (list))))
|
||||
((eq? (peek-byte) 58) (read-byte)
|
||||
(make-keyword (symbol->list (read-word (read-byte) (list) a))))
|
||||
((eq? (peek-byte) 59) (read-byte)
|
||||
(read-word (read-byte) w a)
|
||||
(read-word (read-byte) w a))
|
||||
((eq? (peek-byte) 96) (read-byte)
|
||||
(cons (lookup (cons (integer->char 35) (cons (integer->char 96) (list))) a)
|
||||
(cons (quote quasisyntax)
|
||||
(cons (read-word (read-byte) w a) (list))))
|
||||
(#t (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a))))
|
||||
((eq? c 39) (if (null? w) (cons (lookup (cons (integer->char c) (list)) a)
|
||||
(#t (read-word (read-byte) (append2 w (cons c (list))) a))))
|
||||
((eq? c 39) (if (null? w) (cons (quote quote)
|
||||
(cons (read-word (read-byte) w a) (list)))
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 40) (if (null? w) (read-list a)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 41) (if (null? w) (cons (lookup (cons (integer->char c) (list)) a)
|
||||
(cons (read-word (read-byte) w a) (list)))
|
||||
((eq? c 41) (if (null? w) (quote *FOOBAR*)
|
||||
(begin (unread-byte c) (lookup w a))))
|
||||
((eq? c 44) (cond
|
||||
((eq? (peek-byte) 64) (begin (read-byte)
|
||||
(cons
|
||||
(lookup (symbol->list (quote unquote-splicing)) a)
|
||||
(cons (read-word (read-byte) w a) (list)))))
|
||||
(#t (cons (quote unquote) (cons (read-word (read-byte) w a)
|
||||
(list))))))
|
||||
((eq? (peek-byte) 64)
|
||||
(begin (read-byte)
|
||||
(cons
|
||||
(quote unquote-splicing)
|
||||
(cons (read-word (read-byte) w a) (list)))))
|
||||
(#t (cons (quote unquote)
|
||||
(cons (read-word (read-byte) w a) (list))))))
|
||||
((eq? c 96) (cons (quote quasiquote) (cons (read-word (read-byte) w a) (list))))
|
||||
((eq? c 59) (read-line-comment c) (read-word 10 w a))
|
||||
((eq? c -1) (list))
|
||||
(#t (read-word (read-byte) (append2 w (cons (integer->char c) (list))) a))))
|
||||
(#t (read-word (read-byte) (append2 w (cons c (list))) a))))
|
||||
|
||||
((lambda (p)
|
||||
(begin-env p (current-module)))
|
||||
|
|
|
|||
37
reader.c
37
reader.c
|
|
@ -51,12 +51,12 @@ read_word (int c, SCM w, SCM a)
|
|||
if (c == '\f') return read_word ('\n', w, a);
|
||||
if (c == '\n' && w == cell_nil) return read_word (getchar (), w, a);
|
||||
if (c == '\n' && VALUE (car (w)) == '.' && cdr (w) == cell_nil) return cell_dot;
|
||||
if (c == EOF || c == '\n') return lookup (w, a);
|
||||
if (c == EOF || c == '\n') return lookup_ (w, a);
|
||||
if (c == ' ') return read_word ('\n', w, a);
|
||||
if (c == '(' && w == cell_nil) return read_list (a);
|
||||
if (c == '(') {ungetchar (c); return lookup (w, a);}
|
||||
if (c == '(') {ungetchar (c); return lookup_ (w, a);}
|
||||
if (c == ')' && w == cell_nil) {ungetchar (c); return cell_nil;}
|
||||
if (c == ')') {ungetchar (c); return lookup (w, a);}
|
||||
if (c == ')') {ungetchar (c); return lookup_ (w, a);}
|
||||
if (c == ';') {read_line_comment (c); return read_word ('\n', w, a);}
|
||||
return read_word (getchar (), append2 (w, cons (make_char (c), cell_nil)), a);
|
||||
}
|
||||
|
|
@ -88,7 +88,7 @@ read_env (SCM a)
|
|||
}
|
||||
|
||||
SCM
|
||||
lookup (SCM s, SCM a)
|
||||
lookup_ (SCM s, SCM a)
|
||||
{
|
||||
if (isdigit (VALUE (car (s))) || (VALUE (car (s)) == '-' && cdr (s) != cell_nil)) {
|
||||
SCM p = s;
|
||||
|
|
@ -106,31 +106,8 @@ lookup (SCM s, SCM a)
|
|||
if (p == cell_nil) return make_number (n * sign);
|
||||
}
|
||||
|
||||
if (VALUE (car (s)) == '#' && VALUE (cadr (s)) == ':') return make_keyword (cddr (s));
|
||||
|
||||
SCM x = internal_lookup_symbol (s);
|
||||
if (x) return x;
|
||||
|
||||
if (cdr (s) == cell_nil) {
|
||||
if (VALUE (car (s)) == '\'') return cell_symbol_quote;
|
||||
if (VALUE (car (s)) == '`') return cell_symbol_quasiquote;
|
||||
if (VALUE (car (s)) == ',') return cell_symbol_unquote;
|
||||
}
|
||||
else if (cddr (s) == cell_nil) {
|
||||
if (VALUE (car (s)) == ',' && VALUE (cadr (s)) == '@') return cell_symbol_unquote_splicing;
|
||||
if (VALUE (car (s)) == '#' && VALUE (cadr (s)) == '\'') return cell_symbol_syntax;
|
||||
if (VALUE (car (s)) == '#' && VALUE (cadr (s)) == '`') return cell_symbol_quasisyntax;
|
||||
if (VALUE (car (s)) == '#' && VALUE (cadr (s)) == ',') return cell_symbol_unsyntax;
|
||||
}
|
||||
else if (cdddr (s) == cell_nil) {
|
||||
if (VALUE (car (s)) == '#' && VALUE (cadr (s)) == ',' && VALUE (caddr (s)) == '@') return cell_symbol_unsyntax_splicing;
|
||||
if (VALUE (car (s)) == 'E' && VALUE (cadr (s)) == 'O' && VALUE (caddr (s)) == 'F') {
|
||||
fprintf (stderr, "mes: got EOF\n");
|
||||
return cell_nil; // `EOF': eval program, which may read stdin
|
||||
}
|
||||
}
|
||||
|
||||
return internal_make_symbol (s);
|
||||
SCM x = lookup_symbol_ (s);
|
||||
return x ? x : make_symbol_ (s);
|
||||
}
|
||||
|
||||
SCM
|
||||
|
|
@ -146,7 +123,7 @@ list_of_char_equal_p (SCM a, SCM b)
|
|||
}
|
||||
|
||||
SCM
|
||||
internal_lookup_symbol (SCM s)
|
||||
lookup_symbol_ (SCM s)
|
||||
{
|
||||
SCM x = g_symbols;
|
||||
while (x) {
|
||||
|
|
|
|||
Loading…
Reference in New Issue