srfi-1 remove: move from C to Scheme

The Scheme implementation is an adapted version of the approach used by
delete-duplicates, which allows sharing any common tail.

* libguile/srfi-1.c (scm_srfi1_remove): delete.
* libguile/srfi-1.h (scm_srfi1_remove): delete.
* module/srfi/srfi-1.scm: add remove.

libguile/srfi-1.c

@@ -772,37 +772,6 @@ SCM_DEFINE (scm_srfi1_partition_x, "partition!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
-SCM_DEFINE (scm_srfi1_remove, "remove", 2, 0, 0,
-	    (SCM pred, SCM list),
-	    "Return a list containing all elements from @var{list} which do\n"
-	    "not satisfy the predicate @var{pred}.  The elements in the\n"
-	    "result list have the same order as in @var{list}.  The order in\n"
-	    "which @var{pred} is applied to the list elements is not\n"
-	    "specified.")
-#define FUNC_NAME s_scm_srfi1_remove
-{
-  SCM walk;
-  SCM *prev;
-  SCM res = SCM_EOL;
-  SCM_VALIDATE_PROC (SCM_ARG1, pred);
-  SCM_VALIDATE_LIST (2, list);
-  
-  for (prev = &res, walk = list;
-       scm_is_pair (walk);
-       walk = SCM_CDR (walk))
-    {
-      if (scm_is_false (scm_call_1 (pred, SCM_CAR (walk))))
-	{
-	  *prev = scm_cons (SCM_CAR (walk), SCM_EOL);
-	  prev = SCM_CDRLOC (*prev);
-	}
-    }
-
-  return res;
-}
-#undef FUNC_NAME
-
-
 SCM_DEFINE (scm_srfi1_remove_x, "remove!", 2, 0, 0,
 	    (SCM pred, SCM list),
 	    "Return a list containing all elements from @var{list} which do\n"

libguile/srfi-1.h

@@ -37,7 +37,6 @@ SCM_INTERNAL SCM scm_srfi1_length_plus (SCM lst);
 SCM_INTERNAL SCM scm_srfi1_lset_difference_x (SCM equal, SCM lst, SCM rest);
 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_remove (SCM pred, SCM list);
 SCM_INTERNAL SCM scm_srfi1_remove_x (SCM pred, SCM list);
 
 SCM_INTERNAL void scm_register_srfi_1 (void);

module/srfi/srfi-1.scm

@@ -735,6 +735,53 @@ the list returned."
 	  (apply f l)
 	  (lp (map cdr l)))))))
 
+
+;;; Filtering & partitioning
+
+(define (list-prefix-and-tail lst stop)
+  (when (eq? lst stop)
+    (error "Prefix cannot be empty"))
+  (let ((rl (list (car lst))))
+    (let lp ((lst (cdr lst)) (tail rl))
+      (if (eq? lst stop)
+          (values rl tail)
+          (let ((new-tail (list (car lst))))
+            (set-cdr! tail new-tail)
+            (lp (cdr lst) new-tail))))))
+
+(define (remove pred lst)
+  "Return a list containing all elements from @var{list} which do not
+satisfy the predicate @var{pred}.  The elements in the result list have
+the same order as in @var{list}.  The order in which @var{pred} is
+applied to the list elements is not specified, and the result may share
+a common tail with @{list}."
+  ;; Traverse the lst, keeping the tail of it, in which we have yet to
+  ;; find a duplicate, in last-kept.  Share that tail with the result
+  ;; (possibly the entire original lst).  Build the result by
+  ;; destructively appending unique values to its tail, and henever we
+  ;; find a duplicate, copy the pending last-kept prefix into the result
+  ;; and move last-kept forward to the current position in lst.
+  (if (null? lst)
+      lst
+      (let ((result (list #f)))
+        (let lp ((lst lst)
+                 (last-kept lst)
+                 (tail result))
+          (if (null? lst)
+              (begin
+                (set-cdr! tail last-kept)
+                (cdr result))
+              (let ((item (car lst)))
+                (if (pred item)
+                    (if (eq? last-kept lst)
+                        (lp (cdr lst) (cdr lst) tail)
+                        (call-with-values
+                            (lambda () (list-prefix-and-tail last-kept lst))
+                          (lambda (prefix new-tail)
+                            (set-cdr! tail prefix)
+                            (lp (cdr lst) (cdr lst) new-tail))))
+                    (lp (cdr lst) last-kept tail))))))))
+
 
 ;;; Searching