diff --git a/build-aux/mes-snarf.scm b/build-aux/mes-snarf.scm index a34d48fe..1b962060 100755 --- a/build-aux/mes-snarf.scm +++ b/build-aux/mes-snarf.scm @@ -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_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) (let* ((arity (or (assoc-ref (.annotation f) 'arity) (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) (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) (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)) ""))) (symbols.i (make #:name (string-append base-name ".symbols.i") - #:content (string-join (map symbol->source symbols (iota (length symbols))) "")))) - (list header source environment symbols.h symbols.i))) + #:content (string-join (map symbol->source symbols (iota (length symbols))) ""))) + (symbol-names.i (make + #: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) (with-output-to-file (.name file) (lambda () (display (.content file))))) diff --git a/display.c b/display.c index 10b8417f..4592e1d3 100644 --- a/display.c +++ b/display.c @@ -92,7 +92,7 @@ display_helper (FILE* f, SCM x, bool cont, char const *sep, bool quote) fprintf (f, "(*closure* . #-1#)"); return cell_unspecified; } - if (car (x) == cell_symbol_quote) { + if (car (x) == cell_symbol_quote && TYPE (cdr (x)) != PAIR) { fprintf (f, "'"); x = cdr (x); 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); } if (!cont) fprintf (f, "("); - display_ (f, car (x)); + if (x && x!= cell_nil) display_ (f, car (x)); if (cdr (x) && TYPE (cdr (x)) == PAIR) display_helper (f, cdr (x), true, " ", false); - else if (cdr (x) != cell_nil) { + else if (cdr (x) && cdr (x) != cell_nil) { fprintf (f, " . "); display_ (f, cdr (x)); } diff --git a/mes.c b/mes.c index ba143d7e..722db4f0 100644 --- a/mes.c +++ b/mes.c @@ -82,10 +82,7 @@ scm scm_undefined = {SPECIAL, "*undefined*"}; scm scm_unspecified = {SPECIAL, "*unspecified*"}; scm scm_closure = {SPECIAL, "*closure*"}; scm scm_circular = {SPECIAL, "*circular*"}; -#if BOOT -scm scm_label = { - SPECIAL, "label"}; -#endif +scm scm_label = {SPECIAL, "label"}; scm scm_begin = {SPECIAL, "*begin*"}; scm scm_symbol_lambda = {SYMBOL, "lambda"}; @@ -1101,6 +1098,8 @@ mes_symbols () ///((internal)) SCM a = cell_nil; +#include "mes.symbol-names.i" + #if BOOT a = acons (cell_symbol_label, cell_t, a); #endif @@ -1108,8 +1107,6 @@ mes_symbols () ///((internal)) a = add_environment (a, "sc-expand", cell_f); a = acons (cell_closure, a, a); - internal_lookup_symbol (cell_nil); - return a; } diff --git a/module/language/c/parser.mes b/module/language/c/parser.mes index 034cb65f..a876a275 100644 --- a/module/language/c/parser.mes +++ b/module/language/c/parser.mes @@ -38,7 +38,7 @@ (lbrace rbrace lparen rparen lbracket rbracket semicolon colon dot comma = Identifier NumericLiteral StringLiteral - break case continue goto label + break case continue goto Label return switch for If else diff --git a/reader.c b/reader.c index de062b22..1ed80af5 100644 --- a/reader.c +++ b/reader.c @@ -159,13 +159,6 @@ internal_lookup_symbol (SCM s) { SCM x = g_symbols; 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; x = cdr (x); }