mes: Move assoc to core.
authorJan Nieuwenhuizen <janneke@gnu.org>
Fri, 19 Oct 2018 20:38:19 +0000 (22:38 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Fri, 19 Oct 2018 20:38:19 +0000 (22:38 +0200)
* mes/mes.c (assoc_string, assoc): New function.
* mes/module/mes/scm.mes (assoc): Remove.  Gains 12% performance for
MesCC.

mes/module/mes/scm.mes
src/mes.c

index 0c994714223ed12dbcad0c511df6076eadb1c287..bc58b53c62bb35d1e820ee58c181d28fd042d210 100644 (file)
 (define assv assq)
 (define assv-ref assq-ref)
 
-(define (assoc key alist)
-  (if (not (pair? alist)) #f
-      (if (equal? key (caar alist)) (car alist)
-          (assoc key (cdr alist)))))
-
 (define (assoc-ref alist key)
   (let ((entry (assoc key alist)))
     (if entry (cdr entry)
index 9e570b946812a1288eca85e8f14cf61d6402c094..f4f8686d3e2f337d435477788a9e7073e9f3c227 100644 (file)
--- a/src/mes.c
+++ b/src/mes.c
@@ -423,6 +423,14 @@ list_of_char_equal_p (SCM a, SCM b) ///((internal))
   return (a == cell_nil && b == cell_nil) ? cell_t : cell_f;
 }
 
+SCM
+assoc_string (SCM x, SCM a) ///((internal))
+{
+  while (a != cell_nil && list_of_char_equal_p (STRING (x), STRING (CAAR (a))) == cell_f)
+    a = CDR (a);
+  return a != cell_nil ? CAR (a) : cell_f;
+}
+
 SCM
 list_to_symbol (SCM s)
 {
@@ -857,6 +865,16 @@ assq (SCM x, SCM a)
   return a != cell_nil ? CAR (a) : cell_f;
 }
 
+SCM
+assoc (SCM x, SCM a)
+{
+  if (TYPE (x) == TSTRING)
+    return assoc_string (x, a);
+  while (a != cell_nil && equal2_p (x, CAAR (a)) == cell_f)
+    a = CDR (a);
+  return a != cell_nil ? CAR (a) : cell_f;
+}
+
 SCM
 set_car_x (SCM x, SCM e)
 {