[Guile-commits] GNU Guile branch, master, updated. release_1-9-12-41-g194865d

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=194865d2f7df43aec742c7cdd658050bb4caeb94

The branch, master has been updated
       via  194865d2f7df43aec742c7cdd658050bb4caeb94 (commit)
       via  cd99e21cd469bb3abaa09055d30f0d5e98ab6f1c (commit)
      from  e3667576595f16efbadaad18876a6e8f6e5777a2 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit 194865d2f7df43aec742c7cdd658050bb4caeb94
Author: Ludovic Courtès <address@hidden>
Date:   Mon Sep 20 00:00:44 2010 +0200

    SRFI-1: Rewrite `alist-copy' in Scheme.
    
    This partially reverts commit b1fff4e793619b20342cba0015b9367680d3a0bd
    (Sat Apr 2 2005).
    
    * libguile/srfi-1.c (scm_srfi1_alist_copy): Remove.
    * libguile/srfi-1.h (scm_srfi1_alist_copy): Remove declaration.
    
    * module/srfi/srfi-1.scm (alist-copy): New procedure.

commit cd99e21cd469bb3abaa09055d30f0d5e98ab6f1c
Author: Ludovic Courtès <address@hidden>
Date:   Sun Sep 19 23:41:17 2010 +0200

    Remove the SRFI-1 C proxies.
    
    * libguile/srfi-1.c (srfi1_module, CACHE_VAR): Remove.
      (scm_srfi1_break, scm_srfi1_break_x, scm_srfi1_car_plus_cdr,
      scm_srfi1_drop_right_x, scm_srfi1_drop_while, scm_srfi1_eighth,
      scm_srfi1_fifth, scm_srfi1_fold, scm_srfi1_last, scm_srfi1_list_index,
      scm_srfi1_list_tabulate, scm_srfi1_lset_adjoin, scm_srfi1_ninth,
      scm_srfi1_not_pair_p, scm_srfi1_reduce, scm_srfi1_reduce_right,
      scm_srfi1_seventh, scm_srfi1_sixth, scm_srfi1_span, scm_srfi1_span_x,
      scm_srfi1_take_x, scm_srfi1_take_while, scm_srfi1_take_while_x,
      scm_srfi1_tenth, scm_srfi1_xcons): Remove.
    
    * libguile/srfi-1.h: Remove the corresponding declarations.

-----------------------------------------------------------------------

Summary of changes:
 libguile/srfi-1.c      |  232 ------------------------------------------------
 libguile/srfi-1.h      |   26 ------
 module/srfi/srfi-1.scm |    9 ++
 3 files changed, 9 insertions(+), 258 deletions(-)

diff --git a/libguile/srfi-1.c b/libguile/srfi-1.c
index 96715dc..2fb677a 100644
--- a/libguile/srfi-1.c
+++ b/libguile/srfi-1.c
@@ -44,25 +44,6 @@
  */
 
 
-/* The `(srfi srfi-1)' module.  */
-static SCM srfi1_module = SCM_BOOL_F;
-
-/* Cache variable NAME in C variable VAR.  */
-#define CACHE_VAR(var, name)                                           \
-  static SCM var = SCM_BOOL_F;                                         \
-  if (scm_is_false (var))                                              \
-    {                                                                  \
-      if (SCM_UNLIKELY (scm_is_false (srfi1_module)))                  \
-       srfi1_module = scm_c_resolve_module ("srfi srfi-1");            \
-                                                                       \
-      var = scm_module_variable (srfi1_module,                         \
-                                 scm_from_locale_symbol (name));       \
-      if (SCM_UNLIKELY (scm_is_false (var)))                           \
-        abort ();                                                      \
-                                                                       \
-      var = SCM_VARIABLE_REF (var);                                    \
-    }
-
 static long
 srfi1_ilength (SCM sx)
 {
@@ -123,41 +104,6 @@ list_copy_part (SCM lst, int count, SCM *dst)
 #undef FUNC_NAME
 
 
-SCM_DEFINE (scm_srfi1_alist_copy, "alist-copy", 1, 0, 0,
-            (SCM alist),
-           "Return a copy of @var{alist}, copying both the pairs comprising\n"
-           "the list and those making the associations.")
-#define FUNC_NAME s_scm_srfi1_alist_copy
-{
-  SCM  ret, *p, elem, c;
-
-  /* ret is the list to return.  p is where to append to it, initially &ret
-     then SCM_CDRLOC of the last pair.  */
-  ret = SCM_EOL;
-  p = &ret;
-
-  for ( ; scm_is_pair (alist); alist = SCM_CDR (alist))
-    {
-      elem = SCM_CAR (alist);
-
-      /* each element of alist must be a pair */
-      SCM_ASSERT_TYPE (scm_is_pair (elem), alist, SCM_ARG1, FUNC_NAME,
-                       "association list");
-
-      c = scm_cons (scm_cons (SCM_CAR (elem), SCM_CDR (elem)), SCM_EOL);
-      *p = c;
-      p = SCM_CDRLOC (c);
-    }
-
-  /* alist must be a proper list */
-  SCM_ASSERT_TYPE (SCM_NULL_OR_NIL_P (alist), alist, SCM_ARG1, FUNC_NAME,
-                   "association list");
-  return ret;
-}
-#undef FUNC_NAME
-
-
-
 SCM_DEFINE (scm_srfi1_append_reverse, "append-reverse", 2, 0, 0,
             (SCM revhead, SCM tail),
            "Reverse @var{rev-head}, append @var{tail} to it, and return the\n"
@@ -215,27 +161,6 @@ SCM_DEFINE (scm_srfi1_append_reverse_x, "append-reverse!", 
2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_break (SCM pred, SCM lst)
-{
-  CACHE_VAR (break_proc, "break");
-  return scm_call_2 (break_proc, pred, lst);
-}
-
-SCM
-scm_srfi1_break_x (SCM pred, SCM lst)
-{
-  CACHE_VAR (break_x, "break!");
-  return scm_call_2 (break_x, pred, lst);
-}
-
-SCM
-scm_srfi1_car_plus_cdr (SCM pair)
-{
-  CACHE_VAR (car_plus_cdr, "car+cdr");
-  return scm_call_1 (car_plus_cdr, pair);
-}
-
 SCM_DEFINE (scm_srfi1_concatenate, "concatenate", 1, 0, 0,
             (SCM lstlst),
            "Construct a list by appending all lists in @var{lstlst}.\n"
@@ -691,35 +616,6 @@ SCM_DEFINE (scm_srfi1_drop_right, "drop-right", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_drop_right_x (SCM lst, SCM n)
-{
-  CACHE_VAR (drop_right_x, "drop-right!");
-  return scm_call_2 (drop_right_x, lst, n);
-}
-
-SCM
-scm_srfi1_drop_while (SCM pred, SCM lst)
-{
-  CACHE_VAR (drop_while, "drop-while");
-  return scm_call_2 (drop_while, pred, lst);
-}
-
-SCM
-scm_srfi1_eighth (SCM lst)
-{
-  CACHE_VAR (eighth, "eighth");
-  return scm_call_1 (eighth, lst);
-}
-
-SCM
-scm_srfi1_fifth (SCM lst)
-{
-  CACHE_VAR (fifth, "fifth");
-  return scm_call_1 (fifth, lst);
-}
-
-
 SCM_DEFINE (scm_srfi1_filter_map, "filter-map", 2, 0, 1,
             (SCM proc, SCM list1, SCM rest),
            "Apply @var{proc} to to the elements of @var{list1} @dots{} and\n"
@@ -869,20 +765,6 @@ SCM_DEFINE (scm_srfi1_find_tail, "find-tail", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_fold (SCM proc, SCM init, SCM list1, SCM rest)
-{
-  CACHE_VAR (fold, "fold");
-  return scm_apply_3 (fold, proc, init, list1, rest);
-}
-
-SCM
-scm_srfi1_last (SCM lst)
-{
-  CACHE_VAR (last, "last");
-  return scm_call_1 (last, lst);
-}
-
 SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
             (SCM lst),
            "Return the length of @var{lst}, or @code{#f} if @var{lst} is\n"
@@ -895,13 +777,6 @@ SCM_DEFINE (scm_srfi1_length_plus, "length+", 1, 0, 0,
 #undef FUNC_NAME
 
 
-SCM
-scm_srfi1_list_index (SCM pred, SCM list1, SCM rest)
-{
-  CACHE_VAR (list_index, "list-index");
-  return scm_apply_2 (list_index, pred, list1, rest);
-}
-
 /* This routine differs from the core list-copy in allowing improper lists.
    Maybe the core could allow them similarly.  */
 
@@ -934,20 +809,6 @@ SCM_DEFINE (scm_srfi1_list_copy, "list-copy", 1, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_list_tabulate (SCM n, SCM proc)
-{
-  CACHE_VAR (list_tabulate, "list-tabulate");
-  return scm_call_2 (list_tabulate, n, proc);
-}
-
-SCM
-scm_srfi1_lset_adjoin (SCM equal, SCM lst, SCM rest)
-{
-  CACHE_VAR (lset_adjoin, "lset-adjoin");
-  return scm_apply_1 (lset_adjoin, lst, rest);
-}
-
 SCM_DEFINE (scm_srfi1_lset_difference_x, "lset-difference!", 2, 0, 1,
             (SCM equal, SCM lst, SCM rest),
            "Return @var{lst} with any elements in the lists in @var{rest}\n"
@@ -1271,21 +1132,6 @@ SCM_DEFINE (scm_srfi1_assoc, "assoc", 2, 1, 0,
 }
 #undef FUNC_NAME
 
-
-SCM
-scm_srfi1_ninth (SCM lst)
-{
-  CACHE_VAR (ninth, "ninth");
-  return scm_call_1 (ninth, lst);
-}
-
-SCM
-scm_srfi1_not_pair_p (SCM obj)
-{
-  CACHE_VAR (not_pair_p, "not-pair?");
-  return scm_call_1 (not_pair_p, obj);
-}
-
 SCM_DEFINE (scm_srfi1_partition, "partition", 2, 0, 0,
            (SCM pred, SCM list),
            "Partition the elements of @var{list} with predicate @var{pred}.\n"
@@ -1386,20 +1232,6 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_reduce (SCM proc, SCM def, SCM lst)
-{
-  CACHE_VAR (reduce, "reduce");
-  return scm_call_3 (reduce, proc, def, lst);
-}
-
-SCM
-scm_srfi1_reduce_right (SCM proc, SCM def, SCM lst)
-{
-  CACHE_VAR (reduce_right, "reduce-right");
-  return scm_call_3 (reduce_right, proc, def, lst);
-}
-
 SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
            (SCM pred, SCM list),
            "Return a list containing all elements from @var{lst} which do\n"
@@ -1461,34 +1293,6 @@ SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
 #undef FUNC_NAME
 
 
-SCM
-scm_srfi1_seventh (SCM lst)
-{
-  CACHE_VAR (seventh, "seventh");
-  return scm_call_1 (seventh, lst);
-}
-
-SCM
-scm_srfi1_sixth (SCM lst)
-{
-  CACHE_VAR (sixth, "sixth");
-  return scm_call_1 (sixth, lst);
-}
-
-SCM
-scm_srfi1_span (SCM pred, SCM lst)
-{
-  CACHE_VAR (span, "span");
-  return scm_call_2 (span, pred, lst);
-}
-
-SCM
-scm_srfi1_span_x (SCM pred, SCM lst)
-{
-  CACHE_VAR (span_x, "span!");
-  return scm_call_2 (span_x, pred, lst);
-}
-
 SCM_DEFINE (scm_srfi1_split_at, "split-at", 2, 0, 0,
             (SCM lst, SCM n),
            "Return two values (multiple values), being a list of the\n"
@@ -1539,13 +1343,6 @@ SCM_DEFINE (scm_srfi1_split_at_x, "split-at!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM
-scm_srfi1_take_x (SCM lst, SCM n)
-{
-  CACHE_VAR (take_x, "take!");
-  return scm_call_2 (take_x, lst, n);
-}
-
 SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
             (SCM lst, SCM n),
            "Return the a list containing the @var{n} last elements of\n"
@@ -1563,35 +1360,6 @@ SCM_DEFINE (scm_srfi1_take_right, "take-right", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-
-SCM
-scm_srfi1_take_while (SCM pred, SCM lst)
-{
-  CACHE_VAR (take_while, "take-while");
-  return scm_call_2 (take_while, pred, lst);
-}
-
-SCM
-scm_srfi1_take_while_x (SCM pred, SCM lst)
-{
-  CACHE_VAR (take_while_x, "take-while!");
-  return scm_call_2 (take_while_x, pred, lst);
-}
-
-SCM
-scm_srfi1_tenth (SCM lst)
-{
-  CACHE_VAR (tenth, "tenth");
-  return scm_call_1 (tenth, lst);
-}
-
-SCM
-scm_srfi1_xcons (SCM d, SCM a)
-{
-  CACHE_VAR (xcons, "xcons");
-  return scm_call_2 (xcons, d, a);
-}
-
 
 void
 scm_register_srfi_1 (void)
diff --git a/libguile/srfi-1.h b/libguile/srfi-1.h
index 020de34..ddc8d0a 100644
--- a/libguile/srfi-1.h
+++ b/libguile/srfi-1.h
@@ -24,12 +24,8 @@
 
 #include "libguile/__scm.h"
 
-SCM_INTERNAL SCM scm_srfi1_alist_copy (SCM alist);
 SCM_INTERNAL SCM scm_srfi1_append_reverse (SCM revhead, SCM tail);
 SCM_INTERNAL SCM scm_srfi1_append_reverse_x (SCM revhead, SCM tail);
-SCM_INTERNAL SCM scm_srfi1_break (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_break_x (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_car_plus_cdr (SCM pair);
 SCM_INTERNAL SCM scm_srfi1_concatenate (SCM lstlst);
 SCM_INTERNAL SCM scm_srfi1_concatenate_x (SCM lstlst);
 SCM_INTERNAL SCM scm_srfi1_count (SCM pred, SCM list1, SCM rest);
@@ -38,45 +34,23 @@ SCM_INTERNAL SCM scm_srfi1_delete_x (SCM x, SCM lst, SCM 
pred);
 SCM_INTERNAL SCM scm_srfi1_delete_duplicates (SCM lst, SCM pred);
 SCM_INTERNAL SCM scm_srfi1_delete_duplicates_x (SCM lst, SCM pred);
 SCM_INTERNAL SCM scm_srfi1_drop_right (SCM lst, SCM n);
-SCM_INTERNAL SCM scm_srfi1_drop_right_x (SCM lst, SCM n);
-SCM_INTERNAL SCM scm_srfi1_drop_while (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_eighth (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_fifth (SCM lst);
 SCM_INTERNAL SCM scm_srfi1_filter_map (SCM proc, SCM list1, SCM rest);
 SCM_INTERNAL SCM scm_srfi1_find (SCM pred, SCM lst);
 SCM_INTERNAL SCM scm_srfi1_find_tail (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_fold (SCM proc, SCM init, SCM list1, SCM rest);
-SCM_INTERNAL SCM scm_srfi1_last (SCM lst);
 SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_lset_adjoin (SCM equal, SCM lst, SCM rest);
 SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
 SCM_INTERNAL SCM scm_srfi1_list_copy (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_list_index (SCM pred, SCM list1, SCM rest);
-SCM_INTERNAL SCM scm_srfi1_list_tabulate (SCM n, SCM proc);
 SCM_INTERNAL SCM scm_srfi1_map (SCM proc, SCM arg1, SCM args);
 SCM_INTERNAL SCM scm_srfi1_for_each (SCM proc, SCM arg1, SCM args);
 SCM_INTERNAL SCM scm_srfi1_member (SCM obj, SCM ls, SCM pred);
-SCM_INTERNAL SCM scm_srfi1_ninth (SCM lst);
 SCM_INTERNAL SCM scm_srfi1_assoc (SCM key, SCM alist, SCM pred);
-SCM_INTERNAL SCM scm_srfi1_not_pair_p (SCM obj);
 SCM_INTERNAL SCM scm_srfi1_partition (SCM pred, SCM list);
 SCM_INTERNAL SCM scm_srfi1_partition_x (SCM pred, SCM list);
-SCM_INTERNAL SCM scm_srfi1_reduce (SCM proc, SCM def, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_reduce_right (SCM proc, SCM def, SCM lst);
 SCM_INTERNAL SCM scm_srfi1_remove (SCM pred, SCM list);
 SCM_INTERNAL SCM scm_srfi1_remove_x (SCM pred, SCM list);
-SCM_INTERNAL SCM scm_srfi1_seventh (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_sixth (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_span (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_span_x (SCM pred, SCM lst);
 SCM_INTERNAL SCM scm_srfi1_split_at (SCM lst, SCM n);
 SCM_INTERNAL SCM scm_srfi1_split_at_x (SCM lst, SCM n);
-SCM_INTERNAL SCM scm_srfi1_take_x (SCM lst, SCM n);
 SCM_INTERNAL SCM scm_srfi1_take_right (SCM lst, SCM n);
-SCM_INTERNAL SCM scm_srfi1_take_while (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_take_while_x (SCM pred, SCM lst);
-SCM_INTERNAL SCM scm_srfi1_tenth (SCM lst);
-SCM_INTERNAL SCM scm_srfi1_xcons (SCM d, SCM a);
 
 SCM_INTERNAL void scm_register_srfi_1 (void);
 SCM_INTERNAL void scm_init_srfi_1 (void);
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 5eaf8ea..d7ef6bb 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -664,6 +664,15 @@ CLIST1 ... CLISTN, that satisfies PRED."
 
 (define alist-cons acons)
 
+(define (alist-copy alist)
+  "Return a copy of ALIST, copying both the pairs comprising the list
+and those making the associations."
+  (let lp ((a  alist)
+           (rl '()))
+    (if (null? a)
+        (reverse! rl)
+        (lp (cdr a) (alist-cons (caar a) (cdar a) rl)))))
+
 (define* (alist-delete key alist #:optional (k= equal?))
   (let lp ((a alist) (rl '()))
     (if (null? a)


hooks/post-receive
-- 
GNU Guile