From 0e5331e20446ba3318fd6ab0aabbcc40a4b4a5ab Mon Sep 17 00:00:00 2001 From: Dmitry Bogatov Date: Tue, 22 Oct 2013 15:56:43 +0400 Subject: [PATCH] Uniq Scheme lists in C Signed-off-by: Dmitry Bogatov --- doc/ref/api-utility.texi | 29 ++++++++++++++- libguile/Makefile.am | 4 +++ libguile/init.c | 2 ++ libguile/uniq.c | 93 ++++++++++++++++++++++++++++++++++++++++++++++++ libguile/uniq.h | 39 ++++++++++++++++++++ 5 files changed, 166 insertions(+), 1 deletion(-) create mode 100644 libguile/uniq.c create mode 100644 libguile/uniq.h diff --git a/doc/ref/api-utility.texi b/doc/ref/api-utility.texi index 76c50b2..22ffb27 100644 --- a/doc/ref/api-utility.texi +++ b/doc/ref/api-utility.texi @@ -18,6 +18,7 @@ applications, they are collected in a @dfn{utility} chapter. * Object Properties:: A modern interface to object properties. * Sorting:: Sort utility procedures. * Copying:: Copying deep structures. +* Uniqueing:: Uniqueing lists. * General Conversion:: Converting objects to strings. * Hooks:: User-customizable event lists. @end menu @@ -256,7 +257,7 @@ to @var{value}. @end deffn -@node Sorting +@node Sorting, Copying, Object Properties, Utility Functions @subsection Sorting @c FIXME::martin: Review me! @@ -372,6 +373,32 @@ the range of the vector which gets sorted. The return value is not specified. @end deffn +@node Uniqueing + +@cindex uniqueing +@cindex uniqueing lists + +Another common operation is getting unique elements of +sequence. Following procedures perform action, analogous to +@code{uniq}(1) program --- delete adjanced equal elements. If you need +remove all duplicates, @var{sort} or @var{sort!} it before. Since this +operation change length of sequence, vectors are not supported. + +@c snarfed from uniq.c:40 +@deffn {Scheme Procedure} uniq! items eq +Uniquify the list @var{items}, by deleting equal adjanced +elements. @var{eq} is used for comparing the sequence +elements. The sorting is destructive, that means that +the input sequence is modified to produce the sorted result. + +@end deffn + +@c snarfed from uniq.c:72 +@deffn {Scheme Procedure} uniq items eq +Uniquify the list @var{items}, by deleting equal adjanced +elements. @var{eq} is used for comparing the sequence +elements. +@end deffn @node Copying @subsection Copying Deep Structures diff --git a/libguile/Makefile.am b/libguile/Makefile.am index ce437e4..2928843 100644 --- a/libguile/Makefile.am +++ b/libguile/Makefile.am @@ -221,6 +221,7 @@ libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES = \ version.c \ vm.c \ vports.c \ + uniq.c \ weak-set.c \ weak-table.c \ weak-vector.c @@ -319,6 +320,7 @@ DOT_X_FILES = \ vectors.x \ version.x \ vports.x \ + uniq.x \ weak-set.x \ weak-table.x \ weak-vector.x @@ -422,6 +424,7 @@ DOT_DOC_FILES = \ vectors.doc \ version.doc \ vports.doc \ + uniq.doc \ weak-set.doc \ weak-table.doc \ weak-vector.doc @@ -642,6 +645,7 @@ modinclude_HEADERS = \ vm-expand.h \ vm.h \ vports.h \ + uniq.h \ weak-set.h \ weak-table.h \ weak-vector.h diff --git a/libguile/init.c b/libguile/init.c index 6787483..51698c4 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -111,6 +111,7 @@ #include "libguile/smob.h" #include "libguile/socket.h" #include "libguile/sort.h" +#include "libguile/uniq.h" #include "libguile/srcprop.h" #include "libguile/stackchk.h" #include "libguile/stacks.h" @@ -465,6 +466,7 @@ scm_i_init_guile (void *base) scm_init_socket (); #endif scm_init_sort (); + scm_init_uniq (); scm_init_srcprop (); /* requires smob_prehistory */ scm_init_stackchk (); diff --git a/libguile/uniq.c b/libguile/uniq.c new file mode 100644 index 0000000..4cc2b86 --- /dev/null +++ b/libguile/uniq.c @@ -0,0 +1,93 @@ +/* Copyright (C) 2013 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + +#ifdef HAVE_CONFIG_H +# include +#endif + +#include "libguile/_scm.h" +#include "libguile/eval.h" +#include "libguile/arrays.h" +#include "libguile/array-map.h" +#include "libguile/feature.h" +#include "libguile/vectors.h" +#include "libguile/async.h" +#include "libguile/dynwind.h" + +#include "libguile/uniq.h" + + +SCM_DEFINE (scm_uniq_x, "uniq!", 2, 0, 0, + (SCM items, SCM eq), + "Uniquify the list @var{items}, by deleting equal adjanced\n" + "elements. @var{eq} is used for comparing the sequence\n" + "elements. The sorting is destructive, that means that\n" + "the input sequence is modified to produce the sorted result.\n") +#define FUNC_NAME s_scm_uniq_x +{ + int len; + SCM it = items; + + if (SCM_NULL_OR_NIL_P (items)) + return items; + + SCM_VALIDATE_LIST_COPYLEN(1, items, len); + + while (!SCM_NULL_OR_NIL_P(SCM_CDR(it))) + { + SCM cur = SCM_CAR(it); + SCM next = SCM_CADR(it); + if (scm_is_true (scm_call_2 (eq, cur, next))) + { + SCM_SETCDR(it, SCM_CDDR(it)); + } + else + { + it = SCM_CDR(it); + } + } + return items; +} +#undef FUNC_NAME + +SCM_DEFINE (scm_uniq, "uniq", 2, 0, 0, + (SCM items, SCM eq), + "Uniquify the list @var{items}, by deleting equal adjanced\n" + "elements. @var{eq} is used for comparing the sequence \n" + "elements.") +#define FUNC_NAME s_scm_uniq +{ + if (SCM_NULL_OR_NIL_P (items)) + return items; + + return scm_uniq_x(scm_list_copy(items), eq); +} +#undef FUNC_NAME + + +void +scm_init_uniq (void) +{ +#include "libguile/uniq.x" +} + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ diff --git a/libguile/uniq.h b/libguile/uniq.h new file mode 100644 index 0000000..6926d01 --- /dev/null +++ b/libguile/uniq.h @@ -0,0 +1,39 @@ +/* classes: h_files */ + +#ifndef SCM_UNIQ_H +#define SCM_UNIQ_H + +/* Copyright (C) 2013 Free Software Foundation, Inc. + * + * This library is free software; you can redistribute it and/or + * modify it under the terms of the GNU Lesser General Public License + * as published by the Free Software Foundation; either version 3 of + * the License, or (at your option) any later version. + * + * This library is distributed in the hope that it will be useful, but + * WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + * Lesser General Public License for more details. + * + * You should have received a copy of the GNU Lesser General Public + * License along with this library; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA + * 02110-1301 USA + */ + + + +#include "libguile/__scm.h" + + +SCM_API SCM scm_uniq_x(SCM items, SCM eq); +SCM_API SCM scm_uniq(SCM items, SCM eq); +SCM_INTERNAL void scm_init_uniq(void); + +#endif /* SCM_UNIQ_H */ + +/* + Local Variables: + c-file-style: "gnu" + End: +*/ -- Recipients list generated via git-blame. Tell me, if you object.