guile/guile-core NEWS libguile/ChangeLog libgui...

[Dirk Herrmann]

CVSROOT:        /cvs
Module name:    guile
Changes by:     Dirk Herrmann <address@hidden>  00/12/01 09:57:42

Modified files:
        guile-core     : NEWS 
        guile-core/libguile: ChangeLog goops.c goops.h list.c list.h 

Log message:
        * Added scm_c_memq as a fast C level alternative for scm_memq.

CVSWeb URLs:
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/NEWS.diff?r1=1.222&r2=1.223
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/ChangeLog.diff?r1=1.1183&r2=1.1184
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/goops.c.diff?r1=1.7&r2=1.8
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/goops.h.diff?r1=1.4&r2=1.5
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/list.c.diff?r1=1.46&r2=1.47
http://subversions.gnu.org/cgi-bin/cvsweb/guile/guile-core/libguile/list.h.diff?r1=1.16&r2=1.17

Patches:
Index: guile/guile-core/NEWS
diff -u guile/guile-core/NEWS:1.222 guile/guile-core/NEWS:1.223
--- guile/guile-core/NEWS:1.222 Wed Nov 29 13:27:13 2000
+++ guile/guile-core/NEWS       Fri Dec  1 09:57:42 2000
@@ -170,7 +170,7 @@
 
 ** Deprecated: scm_sloppy_memq, scm_sloppy_memv, scm_sloppy_member
 
-Instead, use scm_memq, scm_memv, scm_member.
+Instead, use scm_c_memq or scm_memq, scm_memv, scm_member.
 
 ** New function: port? X
 
@@ -230,6 +230,16 @@
 amount of smob memory you free.  The previous method, which involved
 calling scm_done_malloc with negative argument, was somewhat
 unintuitive (and is still available, of course).
+
+** New function: scm_c_memq (SCM obj, SCM list)
+
+This function provides a fast C level alternative for scm_memq for the case
+that the list parameter is known to be a proper list.  The function is a
+replacement for scm_sloppy_memq, but is stricter in its requirements on its
+list input parameter, since for anything else but a proper list the function's
+behaviour is undefined - it may even crash or loop endlessly.  Further, for
+the case that the object is not found in the list, scm_c_memq returns #f which
+is similar to scm_memq, but different from scm_sloppy_memq's behaviour.
 
 ** New global variable scm_gc_running_p introduced.
 
Index: guile/guile-core/libguile/ChangeLog
diff -u guile/guile-core/libguile/ChangeLog:1.1183 
guile/guile-core/libguile/ChangeLog:1.1184
--- guile/guile-core/libguile/ChangeLog:1.1183  Fri Dec  1 08:05:33 2000
+++ guile/guile-core/libguile/ChangeLog Fri Dec  1 09:57:42 2000
@@ -1,5 +1,15 @@
 2000-12-01  Dirk Herrmann  <address@hidden>
 
+       * list.[ch] (scm_c_memq):  Added as a fast C level alternative for
+       scm_memq for the case that the list parameter is known to be a
+       proper list.
+
+       * goops.c (filter_cpl, remove_duplicate_slots, applicablep),
+       goops.h (SCM_SUBCLASSP):  Use scm_c_memq if we are sure that we
+       pass proper lists. 
+
+2000-12-01  Dirk Herrmann  <address@hidden>
+
        * goops.c (scm_sys_compute_slots, scm_i_get_keyword,
        scm_get_keyword, scm_slot_ref_using_class,
        scm_slot_set_using_class_x):  Update the code to match guile's
Index: guile/guile-core/libguile/goops.c
diff -u guile/guile-core/libguile/goops.c:1.7 
guile/guile-core/libguile/goops.c:1.8
--- guile/guile-core/libguile/goops.c:1.7       Fri Dec  1 08:05:33 2000
+++ guile/guile-core/libguile/goops.c   Fri Dec  1 09:57:42 2000
@@ -218,7 +218,7 @@
   while (SCM_NIMP (ls))
     {
       SCM el = SCM_CAR (ls);
-      if (SCM_FALSEP (scm_memq (el, res)))
+      if (SCM_FALSEP (scm_c_memq (el, res)))
        res = scm_cons (el, res);
       ls = SCM_CDR (ls);
     }
@@ -259,7 +259,7 @@
                    "bad slot name ~S",
                    SCM_LIST1 (tmp));
   
-  if (SCM_FALSEP (scm_memq (tmp, slots_already_seen))) {
+  if (SCM_FALSEP (scm_c_memq (tmp, slots_already_seen))) {
     res               = scm_cons (SCM_CAR (l), res);
     slots_already_seen = scm_cons (tmp, slots_already_seen);
   }
@@ -1674,23 +1674,8 @@
 static int
 applicablep (SCM actual, SCM formal)
 {
-  register SCM ptr;
-
-  /* We test that (memq formal (slot-ref actual 'cpl))
-   * However, we don't call memq here since we already know that
-   * the list is well formed 
-   */
-  for (ptr=SCM_SLOT(actual, scm_si_cpl); SCM_NNULLP(ptr); ptr = SCM_CDR(ptr)) 
{ 
-    if (SCM_NIMP (ptr) && SCM_CONSP (ptr)) {
-      if (SCM_CAR (ptr) == formal)
-       return 1;
-    }
-    else 
-      scm_misc_error (0,
-                     "Internal error in applicable: bad list ~S",
-                     SCM_LIST1 (actual));
-  }
-  return 0;
+  /* We already know that the cpl is well formed. */
+  return !SCM_FALSEP (scm_c_memq (formal, SCM_SLOT (actual, scm_si_cpl)));
 }
 
 static int
Index: guile/guile-core/libguile/goops.h
diff -u guile/guile-core/libguile/goops.h:1.4 
guile/guile-core/libguile/goops.h:1.5
--- guile/guile-core/libguile/goops.h:1.4       Fri Nov 24 06:43:41 2000
+++ guile/guile-core/libguile/goops.h   Fri Dec  1 09:57:42 2000
@@ -134,7 +134,7 @@
                                   | SCM_CLASSF_SIMPLE_METHOD))
 
 #define SCM_SLOT(x, i)         (SCM_INST(x)[i])
-#define SCM_SUBCLASSP(c1, c2)  (!SCM_FALSEP (scm_memq (c2, SCM_SLOT (c1, 
scm_si_cpl))))
+#define SCM_SUBCLASSP(c1, c2)  (!SCM_FALSEP (scm_c_memq (c2, SCM_SLOT (c1, 
scm_si_cpl))))
 #define SCM_IS_A_P(x, c)       (SCM_NIMP (x) \
                                && SCM_INSTANCEP (x) \
                                && SCM_SUBCLASSP (SCM_CLASS_OF (x), c))
Index: guile/guile-core/libguile/list.c
diff -u guile/guile-core/libguile/list.c:1.46 
guile/guile-core/libguile/list.c:1.47
--- guile/guile-core/libguile/list.c:1.46       Fri Nov 17 08:25:04 2000
+++ guile/guile-core/libguile/list.c    Fri Dec  1 09:57:42 2000
@@ -558,6 +558,25 @@
 
 #endif /* DEPRECATED */
 
+/* The function scm_c_memq returns the first sublist of list whose car is
+ * 'eq?' obj, where the sublists of list are the non-empty lists returned by
+ * (list-tail list k) for k less than the length of list.  If obj does not
+ * occur in list, then #f (not the empty list) is returned.  (r5rs)
+ * List must be a proper list, otherwise scm_c_memq may crash or loop
+ * endlessly.
+ */
+SCM
+scm_c_memq (SCM obj, SCM list)
+{
+  for (; !SCM_NULLP (list); list = SCM_CDR (list))
+    {
+      if (SCM_EQ_P (SCM_CAR (list), obj))
+       return list;
+    }
+  return SCM_BOOL_F;
+}
+
+
 SCM_DEFINE (scm_memq, "memq", 2, 0, 0,
            (SCM x, SCM lst),
             "Return the first sublist of LST whose car is `eq?' to X\n"
@@ -568,12 +587,7 @@
 #define FUNC_NAME s_scm_memq
 {
   SCM_VALIDATE_LIST (2, lst);
-  for (; !SCM_NULLP (lst); lst = SCM_CDR (lst))
-    {
-      if (SCM_EQ_P (SCM_CAR (lst), x))
-       return lst;
-    }
-  return SCM_BOOL_F;
+  return scm_c_memq (x, lst);
 }
 #undef FUNC_NAME
 
Index: guile/guile-core/libguile/list.h
diff -u guile/guile-core/libguile/list.h:1.16 
guile/guile-core/libguile/list.h:1.17
--- guile/guile-core/libguile/list.h:1.16       Fri Oct 13 00:55:24 2000
+++ guile/guile-core/libguile/list.h    Fri Dec  1 09:57:42 2000
@@ -83,6 +83,7 @@
 extern SCM scm_list_cdr_set_x (SCM lst, SCM k, SCM val);
 extern SCM scm_last_pair (SCM sx);
 extern SCM scm_list_tail (SCM lst, SCM k);
+extern SCM scm_c_memq (SCM x, SCM lst);
 extern SCM scm_memq (SCM x, SCM lst);
 extern SCM scm_memv (SCM x, SCM lst);
 extern SCM scm_member (SCM x, SCM lst);