core: Use hash table for symbols.
authorJan Nieuwenhuizen <janneke@gnu.org>
Thu, 18 Oct 2018 16:50:09 +0000 (18:50 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Thu, 18 Oct 2018 16:50:09 +0000 (18:50 +0200)
* src/mes.c (mes_symbols): Use hash table for symbols.  Update users.

scaffold/mini-mes.c
src/mes.c

index b8909658a1cb144d28ce9023d47e24d60483cb9c..961b705137898ea80ed140582d4069192b9b4e02 100644 (file)
@@ -341,15 +341,15 @@ list_of_char_equal_p (SCM a, SCM b) ///((internal))
 }
 
 SCM
-list_to_symbol (SCM s)
+list_to_symbol (SCM lst)
 {
   SCM x = g_symbols;
   while (x) {
-    if (list_of_char_equal_p (STRING (CAR (x)), s) == cell_t) break;
+    if (list_of_char_equal_p (STRING (CAR (x)), lst) == cell_t) break;
     x = CDR (x);
   }
   if (x) x = CAR (x);
-  if (!x) x = make_symbol_ (s);
+  if (!x) x = make_symbol_ (lst);
   return x;
 }
 
@@ -646,9 +646,8 @@ call (SCM fn, SCM x)
 SCM
 assq (SCM x, SCM a)
 {
-  //FIXME: move into fast-non eq_p-ing assq core:assq?
-  //while (a != cell_nil && x != CAAR (a)) a = CDR (a);
-  while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f) a = CDR (a);
+  while (a != cell_nil && eq_p (x, CAAR (a)) == cell_f)
+    a = CDR (a);
   return a != cell_nil ? CAR (a) : cell_f;
 }
 
@@ -710,11 +709,8 @@ make_closure_ (SCM args, SCM body, SCM a) ///((internal))
 }
 
 SCM
-lookup_macro_ (SCM x, SCM a) ///((internal))
+macro_get_handle (SCM name)
 {
-  if (TYPE (x) != TSYMBOL) return cell_f;
-  SCM m = assq_ref_env (x, a);
-  if (TYPE (m) == TMACRO) return MACRO (m);
   return cell_f;
 }
 
index 3d489be37a9a8c4123ef8ba431c038f92db669e4..71cd8afb7cfeef798a4dbd5398578100bcc0437e 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -409,23 +409,29 @@ make_cell_ (SCM type, SCM car, SCM cdr)
 }
 
 SCM
-make_symbol_ (SCM s) ///((internal))
+make_symbol_ (SCM string) ///((internal))
 {
-  SCM x = make_cell__ (TSYMBOL, s, 0);
-  g_symbols = cons (x, g_symbols);
+  SCM x = make_cell__ (TSYMBOL, STRING (string), 0);
+  hash_set_x (g_symbols, string, x);
+
+  if (g_debug > 3)
+    hash_table_printer (g_symbols);
+
   return x;
 }
 
 SCM
 list_of_char_equal_p (SCM a, SCM b) ///((internal))
 {
-  while (a != cell_nil && b != cell_nil && VALUE (CAR (a)) == VALUE (CAR (b)))
-    {
-      assert (TYPE (CAR (a)) == TCHAR);
-      assert (TYPE (CAR (b)) == TCHAR);
-      a = CDR (a);
-      b = CDR (b);
-    }
+  assert (TYPE (CAR (a)) == TCHAR);
+  if (TYPE (CAR (b)) == TCHAR)
+    while (a != cell_nil && b != cell_nil && VALUE (CAR (a)) == VALUE (CAR (b)))
+      {
+        assert (TYPE (CAR (a)) == TCHAR);
+        assert (TYPE (CAR (b)) == TCHAR);
+        a = CDR (a);
+        b = CDR (b);
+      }
   return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
 }
 
@@ -438,19 +444,12 @@ assoc_string (SCM x, SCM a) ///((internal))
 }
 
 SCM
-list_to_symbol (SCM s)
+list_to_symbol (SCM lst)
 {
-  SCM x = g_symbols;
-  while (x)
-    {
-      if (list_of_char_equal_p (STRING (CAR (x)), s) == cell_t)
-        break;
-      x = CDR (x);
-    }
-  if (x)
-    x = CAR (x);
-  if (!x)
-    x = make_symbol_ (s);
+  SCM key = MAKE_STRING (lst);
+  SCM x = hash_ref (g_symbols, key, cell_f);
+  if (x == cell_f)
+    x = make_symbol_ (key);
   return x;
 }
 
@@ -851,22 +850,25 @@ assq (SCM x, SCM a)
   if (TYPE (a) != TPAIR)
     return cell_f;
   int t = TYPE (x);
-  if (t == TCHAR
-      || t == TNUMBER)
+  if (t == TSYMBOL
+      || t == TSPECIAL)
+    while (a != cell_nil && x != CAAR (a))
+      a = CDR (a);
+  else if (t == TCHAR
+           || t == TNUMBER)
       {
         SCM v = VALUE (x);
         while (a != cell_nil && v != VALUE (CAAR (a)))
           a = CDR (a);
       }
-    else if (t == TKEYWORD)
-      {
-        SCM v = STRING (x);
-        while (a != cell_nil && v != STRING (CAAR (a)))
-          a = CDR (a);
-      }
-  // else if (t == TSYMBOL)
-  // else if (t == TSPECIAL)
+  else if (t == TKEYWORD)
+    {
+      SCM v = STRING (x);
+      while (a != cell_nil && v != STRING (CAAR (a)))
+        a = CDR (a);
+    }
   else
+    /* pointer equality, e.g. on strings. */
     while (a != cell_nil && x != CAAR (a))
       a = CDR (a);
   return a != cell_nil ? CAR (a) : cell_f;
@@ -935,26 +937,26 @@ make_variable_ (SCM var) ///((internal))
 }
 
 SCM
-macro_ref (SCM table, SCM name) ///((internal))
+macro_get_handle (SCM name)
 {
   if (TYPE (name) == TSYMBOL)
-    return hashq_get_handle (table, name, cell_nil);
+    return hashq_get_handle (g_macros, name, cell_nil);
   return cell_f;
 }
 
 SCM
-get_macro (SCM table, SCM name) ///((internal))
+get_macro (SCM name) ///((internal))
 {
-  SCM m = macro_ref (table, name);
+  SCM m = macro_get_handle (name);
   if (m != cell_f)
     return MACRO (CDR (m));
   return cell_f;
 }
 
 SCM
-macro_set_x (SCM table, SCM name, SCM value) ///((internal))
+macro_set_x (SCM name, SCM value) ///((internal))
 {
-  return hashq_set_x (table, name, value);
+  return hashq_set_x (g_macros, name, value);
 }
 
 SCM
@@ -1326,7 +1328,7 @@ eval_apply ()
                     {
                       entry = assq (name, g_macros);
                       if (entry == cell_f)
-                        macro_set_x (g_macros, name, cell_f);
+                        macro_set_x (name, cell_f);
                     }
                   else
                     {
@@ -1359,7 +1361,7 @@ eval_apply ()
                 name = CAR (name);
               if (macro_p)
                 {
-                  entry = macro_ref (g_macros, name);
+                  entry = macro_get_handle (name);
                   r1 = MAKE_MACRO (name, r1);
                   set_cdr_x (entry, r1);
                 }
@@ -1434,7 +1436,7 @@ eval_apply ()
       }
 
     if (TYPE (r1) == TPAIR
-        && (macro = get_macro (g_macros, CAR (r1))) != cell_f)
+        && (macro = get_macro (CAR (r1))) != cell_f)
       {
         r1 = cons (macro, CDR (r1));
         push_cc (r1, cell_nil, r0, cell_vm_macro_expand);
@@ -1472,7 +1474,7 @@ eval_apply ()
     if (TYPE (r1) == TPAIR
         && TYPE (CAR (r1)) == TSYMBOL
         && CAR (r1) != cell_symbol_begin
-        && ((macro = macro_ref (g_macros, cell_symbol_portable_macro_expand)) != cell_f)
+        && ((macro = macro_get_handle (cell_symbol_portable_macro_expand)) != cell_f)
         && ((expanders = module_ref (r0, cell_symbol_sc_expander_alist)) != cell_undefined)
         && ((macro = assq (CAR (r1), expanders)) != cell_f))
       {
@@ -1998,13 +2000,7 @@ g_cells[cell_test] = scm_test;
 #include "mes.symbols.i"
 #endif
 
-
   g_symbol_max = g_free++;
-  g_symbols = 0;
-  for (int i=1; i<g_symbol_max; i++)
-    g_symbols = cons (i, g_symbols);
-
-  SCM a = cell_nil;
 
 #if MES_MINI
 
@@ -2118,6 +2114,11 @@ g_cells[cell_vm_return].car = cstring_to_list (scm_vm_return.car);
 #include "mes.symbol-names.i"
 #endif
 
+  g_symbols = make_hash_table_ (500);
+  for (int i=1; i<g_symbol_max; i++)
+    hash_set_x (g_symbols, MAKE_STRING (STRING (i)), i);
+
+  SCM a = cell_nil;
   a = acons (cell_symbol_call_with_values, cell_symbol_call_with_values, a);
   a = acons (cell_symbol_boot_module, cell_symbol_boot_module, a);
   a = acons (cell_symbol_current_module, cell_symbol_current_module, a);
@@ -2494,13 +2495,7 @@ bload_env () ///((internal))
   if (g_debug > 3)
     {
       eputs ("symbols: ");
-      SCM s = g_symbols;
-      while (s && s != cell_nil)
-        {
-          display_error_ (CAR (s));
-          eputs (" ");
-          s = CDR (s);
-        }
+      write_error_ (g_symbols);
       eputs ("\n");
       eputs ("functions: ");
       eputs (itoa (g_function));