core: Cleanup symbol initialization and lookup.
* build-aux/mes-snarf.scm (symbol->names): New function (function->environment): Initialize symbol. (generate-includes): Also write .symbol-names.i. * mes.c (mes_symbols): Include it. Remove internal_lookup_symbol. * display.c (display): Handle display of nil in symbol list. * reader.c (internal_lookup_symbol): Remove name-fu.
This commit is contained in:
parent
ddfaa05149
commit
aa0aaa58ab
|
@ -79,6 +79,10 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
||||||
(format #f "g_free.value++;\n")
|
(format #f "g_free.value++;\n")
|
||||||
(format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
|
(format #f "g_cells[cell_~a] = scm_~a;\n\n" s s)))
|
||||||
|
|
||||||
|
(define (symbol->names s i)
|
||||||
|
(string-append
|
||||||
|
(format #f "g_cells[cell_~a].car = cstring_to_list (scm_~a.name);\n" s s)))
|
||||||
|
|
||||||
(define (function->header f i)
|
(define (function->header f i)
|
||||||
(let* ((arity (or (assoc-ref (.annotation f) 'arity)
|
(let* ((arity (or (assoc-ref (.annotation f) 'arity)
|
||||||
(if (string-null? (.formals f)) 0
|
(if (string-null? (.formals f)) 0
|
||||||
|
@ -99,7 +103,10 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
||||||
|
|
||||||
(define (function->environment f i)
|
(define (function->environment f i)
|
||||||
(string-append
|
(string-append
|
||||||
(format #f "a = add_environment (a, ~S, ~a);\n" (function-scm-name f) (function-cell-name f))))
|
(format #f "scm_~a.string = cstring_to_list (scm_~a.name);\n" (.name f) (.name f))
|
||||||
|
(format #f "a = acons (make_symbol (scm_~a.string), ~a, a);\n" (.name f) (function-cell-name f))
|
||||||
|
;;(format #f "a = add_environment (a, ~S, ~a);\n" (function-scm-name f) (function-cell-name f))
|
||||||
|
))
|
||||||
|
|
||||||
(define (snarf-symbols string)
|
(define (snarf-symbols string)
|
||||||
(let* ((matches (append (list-matches "\nscm scm_([a-z_0-9]+) = [{](SPECIAL)," string)
|
(let* ((matches (append (list-matches "\nscm scm_([a-z_0-9]+) = [{](SPECIAL)," string)
|
||||||
|
@ -147,8 +154,11 @@ exec ${GUILE-guile} --no-auto-compile -L $HOME/src/mes/build-aux -L build-aux -e
|
||||||
#:content (string-join (map symbol->header symbols (iota (length symbols) %start)) "")))
|
#:content (string-join (map symbol->header symbols (iota (length symbols) %start)) "")))
|
||||||
(symbols.i (make <file>
|
(symbols.i (make <file>
|
||||||
#:name (string-append base-name ".symbols.i")
|
#:name (string-append base-name ".symbols.i")
|
||||||
#:content (string-join (map symbol->source symbols (iota (length symbols))) ""))))
|
#:content (string-join (map symbol->source symbols (iota (length symbols))) "")))
|
||||||
(list header source environment symbols.h symbols.i)))
|
(symbol-names.i (make <file>
|
||||||
|
#:name (string-append base-name ".symbol-names.i")
|
||||||
|
#:content (string-join (map symbol->names symbols (iota (length symbols))) ""))))
|
||||||
|
(list header source environment symbols.h symbols.i symbol-names.i)))
|
||||||
|
|
||||||
(define (file-write file)
|
(define (file-write file)
|
||||||
(with-output-to-file (.name file) (lambda () (display (.content file)))))
|
(with-output-to-file (.name file) (lambda () (display (.content file)))))
|
||||||
|
|
|
@ -92,7 +92,7 @@ display_helper (FILE* f, SCM x, bool cont, char const *sep, bool quote)
|
||||||
fprintf (f, "(*closure* . #-1#)");
|
fprintf (f, "(*closure* . #-1#)");
|
||||||
return cell_unspecified;
|
return cell_unspecified;
|
||||||
}
|
}
|
||||||
if (car (x) == cell_symbol_quote) {
|
if (car (x) == cell_symbol_quote && TYPE (cdr (x)) != PAIR) {
|
||||||
fprintf (f, "'");
|
fprintf (f, "'");
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
if (TYPE (x) != FUNCTION)
|
if (TYPE (x) != FUNCTION)
|
||||||
|
@ -100,10 +100,10 @@ display_helper (FILE* f, SCM x, bool cont, char const *sep, bool quote)
|
||||||
return display_helper (f, x, cont, "", true);
|
return display_helper (f, x, cont, "", true);
|
||||||
}
|
}
|
||||||
if (!cont) fprintf (f, "(");
|
if (!cont) fprintf (f, "(");
|
||||||
display_ (f, car (x));
|
if (x && x!= cell_nil) display_ (f, car (x));
|
||||||
if (cdr (x) && TYPE (cdr (x)) == PAIR)
|
if (cdr (x) && TYPE (cdr (x)) == PAIR)
|
||||||
display_helper (f, cdr (x), true, " ", false);
|
display_helper (f, cdr (x), true, " ", false);
|
||||||
else if (cdr (x) != cell_nil) {
|
else if (cdr (x) && cdr (x) != cell_nil) {
|
||||||
fprintf (f, " . ");
|
fprintf (f, " . ");
|
||||||
display_ (f, cdr (x));
|
display_ (f, cdr (x));
|
||||||
}
|
}
|
||||||
|
|
9
mes.c
9
mes.c
|
@ -82,10 +82,7 @@ scm scm_undefined = {SPECIAL, "*undefined*"};
|
||||||
scm scm_unspecified = {SPECIAL, "*unspecified*"};
|
scm scm_unspecified = {SPECIAL, "*unspecified*"};
|
||||||
scm scm_closure = {SPECIAL, "*closure*"};
|
scm scm_closure = {SPECIAL, "*closure*"};
|
||||||
scm scm_circular = {SPECIAL, "*circular*"};
|
scm scm_circular = {SPECIAL, "*circular*"};
|
||||||
#if BOOT
|
scm scm_label = {SPECIAL, "label"};
|
||||||
scm scm_label = {
|
|
||||||
SPECIAL, "label"};
|
|
||||||
#endif
|
|
||||||
scm scm_begin = {SPECIAL, "*begin*"};
|
scm scm_begin = {SPECIAL, "*begin*"};
|
||||||
|
|
||||||
scm scm_symbol_lambda = {SYMBOL, "lambda"};
|
scm scm_symbol_lambda = {SYMBOL, "lambda"};
|
||||||
|
@ -1101,6 +1098,8 @@ mes_symbols () ///((internal))
|
||||||
|
|
||||||
SCM a = cell_nil;
|
SCM a = cell_nil;
|
||||||
|
|
||||||
|
#include "mes.symbol-names.i"
|
||||||
|
|
||||||
#if BOOT
|
#if BOOT
|
||||||
a = acons (cell_symbol_label, cell_t, a);
|
a = acons (cell_symbol_label, cell_t, a);
|
||||||
#endif
|
#endif
|
||||||
|
@ -1108,8 +1107,6 @@ mes_symbols () ///((internal))
|
||||||
a = add_environment (a, "sc-expand", cell_f);
|
a = add_environment (a, "sc-expand", cell_f);
|
||||||
a = acons (cell_closure, a, a);
|
a = acons (cell_closure, a, a);
|
||||||
|
|
||||||
internal_lookup_symbol (cell_nil);
|
|
||||||
|
|
||||||
return a;
|
return a;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -38,7 +38,7 @@
|
||||||
(lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
|
(lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma
|
||||||
=
|
=
|
||||||
Identifier NumericLiteral StringLiteral
|
Identifier NumericLiteral StringLiteral
|
||||||
break case continue goto label
|
break case continue goto Label
|
||||||
return switch
|
return switch
|
||||||
for
|
for
|
||||||
If else
|
If else
|
||||||
|
|
7
reader.c
7
reader.c
|
@ -159,13 +159,6 @@ internal_lookup_symbol (SCM s)
|
||||||
{
|
{
|
||||||
SCM x = g_symbols;
|
SCM x = g_symbols;
|
||||||
while (x) {
|
while (x) {
|
||||||
// .string and .name is the same field; .name is used as a handy
|
|
||||||
// static field initializer. A string can only be mistaken for a
|
|
||||||
// cell with type == PAIR for the one character long, zero-padded
|
|
||||||
// #\etx.
|
|
||||||
SCM p = STRING (car (x));
|
|
||||||
if (p < 0 || p >= g_free.value || TYPE (p) != PAIR)
|
|
||||||
STRING (car (x)) = cstring_to_list (NAME (car (x)));
|
|
||||||
if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
|
if (list_of_char_equal_p (STRING (car (x)), s) == cell_t) break;
|
||||||
x = cdr (x);
|
x = cdr (x);
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue