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.

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 <file>
                       #: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 <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)
   (with-output-to-file (.name file) (lambda () (display (.content file)))))

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));
         }

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;
 }
 

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

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);
   }