summaryrefslogtreecommitdiff
path: root/libguile
diff options
context:
space:
mode:
authorMikael Djurfeldt <djurfeldt@nada.kth.se>1998-11-03 16:08:28 +0000
committerMikael Djurfeldt <djurfeldt@nada.kth.se>1998-11-03 16:08:28 +0000
commit82dc9f574f55ad92fb216257f145594d61348d2c (patch)
tree155bfb612a6be4eeb939f7ae2b0c74d20dd8b4da /libguile
parent83336ffd60f1b3a3b6c8a04a840b56ea00aecdfe (diff)
downloadguile-82dc9f574f55ad92fb216257f145594d61348d2c.tar.gz
* list.c (scm_sloppy_memq): Removed sloppy_mem_check.
(scm_memq, scm_memv, scm_member): Do argument checking *before* starting to search the list. Removed call to sloppy_mem_check. * list.c, list.h (scm_delq1_x, scm_delv1_x, scm_delete1_x): New procedures: Same as scm_delq_x et al, but delete maximally one element.
Diffstat (limited to 'libguile')
-rw-r--r--libguile/list.c94
1 files changed, 81 insertions, 13 deletions
diff --git a/libguile/list.c b/libguile/list.c
index afec4a3db..4bd73d635 100644
--- a/libguile/list.c
+++ b/libguile/list.c
@@ -420,16 +420,6 @@ scm_list_copy (lst)
static void sloppy_mem_check SCM_P ((SCM obj, char * where, char * why));
-static void
-sloppy_mem_check (obj, where, why)
- SCM obj;
- char * where;
- char * why;
-{
- SCM_ASSERT ((scm_ilength (obj) >= 0), obj, where, why);
-}
-
-
SCM_PROC (s_sloppy_memq, "sloppy-memq", 2, 0, 0, scm_sloppy_memq);
SCM
scm_sloppy_memq(x, lst)
@@ -483,8 +473,8 @@ scm_memq(x, lst)
SCM lst;
{
SCM answer;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memq);
answer = scm_sloppy_memq (x, lst);
- sloppy_mem_check (answer, (char *)SCM_ARG2, s_memq);
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
@@ -497,8 +487,8 @@ scm_memv(x, lst)
SCM lst;
{
SCM answer;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_memv);
answer = scm_sloppy_memv (x, lst);
- sloppy_mem_check (answer, (char *)SCM_ARG2, s_memv);
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
@@ -510,8 +500,8 @@ scm_member(x, lst)
SCM lst;
{
SCM answer;
+ SCM_ASSERT (scm_ilength (lst) >= 0, lst, SCM_ARG2, s_member);
answer = scm_sloppy_member (x, lst);
- sloppy_mem_check (answer, (char *)SCM_ARG2, s_member);
return (answer == SCM_EOL) ? SCM_BOOL_F : answer;
}
@@ -629,6 +619,84 @@ scm_delete (item, lst)
}
+SCM_PROC(s_delq1_x, "delq1!", 2, 0, 0, scm_delq1_x);
+SCM
+scm_delq1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
+
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_CAR (walk) == item)
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
+SCM_PROC(s_delv1_x, "delv1!", 2, 0, 0, scm_delv1_x);
+SCM
+scm_delv1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
+
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_BOOL_F != scm_eqv_p (SCM_CAR (walk), item))
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
+SCM_PROC(s_delete1_x, "delete1!", 2, 0, 0, scm_delete1_x);
+SCM
+scm_delete1_x (item, lst)
+ SCM item;
+ SCM lst;
+{
+ SCM walk;
+ SCM *prev;
+
+ for (prev = &lst, walk = lst;
+ SCM_NIMP (walk) && SCM_CONSP (walk);
+ walk = SCM_CDR (walk))
+ {
+ if (SCM_BOOL_F != scm_equal_p (SCM_CAR (walk), item))
+ {
+ *prev = SCM_CDR (walk);
+ break;
+ }
+ else
+ prev = SCM_CDRLOC (walk);
+ }
+
+ return lst;
+}
+
+
void
scm_init_list ()