diff options
author | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-11-03 16:08:28 +0000 |
---|---|---|
committer | Mikael Djurfeldt <djurfeldt@nada.kth.se> | 1998-11-03 16:08:28 +0000 |
commit | 82dc9f574f55ad92fb216257f145594d61348d2c (patch) | |
tree | 155bfb612a6be4eeb939f7ae2b0c74d20dd8b4da /libguile | |
parent | 83336ffd60f1b3a3b6c8a04a840b56ea00aecdfe (diff) | |
download | guile-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.c | 94 |
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 () |