* srfi-1.scm (filter, filter!): Removed. (Now implemented in the core.)

* goops/util.scm (filter): Removed.  (Now supplied by core.)

* list.c, list.h (scm_filter, scm_filter_x): New functions.

* debugger/command-loop.scm: Prefix all commands imported from
(ice-9 debugger command-loop) with debugger:.

* boot-9.scm (resolve-interface): Process #:hide; Name custom interfaces
appropriately.
(module-use!, module-use-interfaces!): Remove existing interfaces
on the use-list based on module name rather than interface
identity so that custom interfaces truly replaces their previous
version.

ice-9/ChangeLog

@@ -1,7 +1,16 @@
 2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
+	* debugger/command-loop.scm: Prefix all commands imported from
+	(ice-9 debugger command-loop) with debugger:.
+
 	* boot-9.scm (process-duplicates): Use module-import-interface.
 	(module-symbol-interface): Removed.
+	(resolve-interface): Process #:hide; Name custom interfaces
+	appropriately.
+	(module-use!, module-use-interfaces!): Remove existing interfaces
+	on the use-list based on module name rather than interface
+	identity so that custom interfaces truly replaces their previous
+	version.
 
 	* boot-9.scm (module-override!, make-mutable-parameter,
 	lookup-duplicates-handlers, default-module-duplicates-handler):

ice-9/boot-9.scm

@@ -1444,7 +1444,11 @@
 ;;
 (define (module-use! module interface)
   (set-module-uses! module
-		    (cons interface (delq! interface (module-uses module))))
+		    (cons interface
+			  (filter (lambda (m)
+				    (not (equal? (module-name m)
+						 (module-name interface))))
+				  (module-uses module))))
   (module-modified module))
 
 ;; MODULE-USE-INTERFACES! module interfaces
@@ -1459,7 +1463,11 @@
     (set! uses (delq! (cdr duplicates-info) uses))
     ;; remove interfaces to be added
     (for-each (lambda (interface)
-		(set! uses (delq! interface uses)))
+		(set! uses
+		      (filter (lambda (m)
+				(not (equal? (module-name m)
+					     (module-name interface))))
+			      uses)))
 	      interfaces)
     ;; add interfaces to use list
     (set-module-uses! module uses)
@@ -1663,7 +1671,7 @@
 ;; Return a module that is an interface to the module designated by
 ;; NAME.
 ;;
-;; `resolve-interface' takes two keyword arguments:
+;; `resolve-interface' takes four keyword arguments:
 ;;
 ;;   #:select SELECTION
 ;;
@@ -1676,17 +1684,20 @@
 ;; are made available in the interface.  Bindings that are added later
 ;; are not picked up.
 ;;
-;;   #:renamer RENAMER
+;;   #:hide BINDINGS
 ;;
-;; RENAMER is a procedure that takes a symbol and returns its new
+;; BINDINGS is a list of bindings which should not be imported.
-;; name.  The default is to append a specified prefix (see below) or
-;; not perform any renaming.
 ;;
 ;;   #:prefix PREFIX
 ;;
 ;; PREFIX is a symbol that will be appended to each exported name.
 ;; The default is to not perform any renaming.
 ;;
+;;   #:renamer RENAMER
+;;
+;; RENAMER is a procedure that takes a symbol and returns its new
+;; name.  The default is not perform any renaming.
+;;
 ;; Signal "no code for module" error if module name is not resolvable
 ;; or its public interface is not available.  Signal "no binding"
 ;; error if selected binding does not exist in the used module.
@@ -1703,6 +1714,7 @@
 	   def)))
 
   (let* ((select (get-keyword-arg args #:select #f))
+	 (hide (get-keyword-arg args #:hide '()))
 	 (renamer (or (get-keyword-arg args #:renamer #f)
 		      (let ((prefix (get-keyword-arg args #:prefix #f)))
 			(and prefix (symbol-prefix-proc prefix)))
@@ -1711,27 +1723,40 @@
          (public-i (and module (module-public-interface module))))
     (and (or (not module) (not public-i))
          (error "no code for module" name))
-    (if (and (not select) (eq? renamer identity))
+    (if (and (not select) (null? hide) (eq? renamer identity))
         public-i
         (let ((selection (or select (module-map (lambda (sym var) sym)
 						public-i)))
               (custom-i (make-module 31)))
-          (set-module-kind! custom-i 'interface)
+          (set-module-kind! custom-i 'custom-interface)
+	  (set-module-name! custom-i name)
 	  ;; XXX - should use a lazy binder so that changes to the
 	  ;; used module are picked up automatically.
           (for-each (lambda (bspec)
                       (let* ((direct? (symbol? bspec))
                              (orig (if direct? bspec (car bspec)))
-                             (seen (if direct? bspec (cdr bspec))))
+                             (seen (if direct? bspec (cdr bspec)))
-                        (module-add! custom-i (renamer seen)
+			     (var (or (module-local-variable public-i orig)
-                                     (or (module-local-variable public-i orig)
+				      (module-local-variable module orig)
-                                         (module-local-variable module orig)
+				      (error
-                                         (error
+				       ;; fixme: format manually for now
-                                          ;; fixme: format manually for now
+				       (simple-format
-                                          (simple-format
+					#f "no binding `~A' in module ~A"
-                                           #f "no binding `~A' in module ~A"
+					orig name)))))
-                                           orig name))))))
+			(if (memq orig hide)
+			    (set! hide (delq! orig hide))
+			    (module-add! custom-i
+					 (renamer seen)
+					 var))))
                     selection)
+	  ;; Check that we are not hiding bindings which don't exist
+	  (for-each (lambda (binding)
+		      (if (not (module-local-variable public-i binding))
+			  (error
+			   (simple-format
+			    #f "no binding `~A' to hide in module ~A"
+			    binding name))))
+		    hide)
           custom-i))))
 
 (define (symbol-prefix-proc prefix)
@@ -2551,6 +2576,7 @@
   (define keys
     ;; sym     key      quote?
     '((:select #:select #t)
+      (:hide   #:hide	#t)
       (:prefix #:prefix #t)
       (:renamer #:renamer #f)))
   (if (not (pair? (car spec)))
@@ -2853,7 +2879,7 @@
 
 (define (make-duplicates-interface)
   (let ((m (make-module)))
-    (set-module-kind! m 'interface)
+    (set-module-kind! m 'custom-interface)
     (set-module-name! m 'duplicates)
     m))
 

ice-9/debugger/command-loop.scm

@@ -1,6 +1,6 @@
 ;;;; Guile Debugger command loop
 
-;;; Copyright (C) 1999, 2001, 2002 Free Software Foundation, Inc.
+;;; Copyright (C) 1999, 2001, 2002, 2003 Free Software Foundation, Inc.
 ;;;
 ;;; This program is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU General Public License as
@@ -42,7 +42,7 @@
 ;;; If you do not wish that, delete this exception notice.
 
 (define-module (ice-9 debugger command-loop)
-  #:use-module (ice-9 debugger commands)
+  #:use-module ((ice-9 debugger commands) :prefix debugger:)
   #:export (debugger-command-loop
 	    debugger-command-loop-error
 	    debugger-command-loop-quit)
@@ -538,21 +538,21 @@
 	       (error "Unknown value from lookup-command:" value)))))
     state))
 
-(define-command "frame" '('optional exact-nonnegative-integer) frame)
+(define-command "frame" '('optional exact-nonnegative-integer) debugger:frame)
 
-(define-command "position" '() position)
+(define-command "position" '() debugger:position)
 
-(define-command "up" '('optional exact-integer) up)
+(define-command "up" '('optional exact-integer) debugger:up)
 
-(define-command "down" '('optional exact-integer) down)
+(define-command "down" '('optional exact-integer) debugger:down)
 
-(define-command "backtrace" '('optional exact-integer) backtrace)
+(define-command "backtrace" '('optional exact-integer) debugger:backtrace)
 
-(define-command "evaluate" '(object) evaluate)
+(define-command "evaluate" '(object) debugger:evaluate)
 
-(define-command '("info" "args") '() info-args)
+(define-command '("info" "args") '() debugger:info-args)
 
-(define-command '("info" "frame") '() info-frame)
+(define-command '("info" "frame") '() debugger:info-frame)
 
 (define-command "quit" '()
   (lambda (state)
@@ -567,12 +567,12 @@
 (define-command-alias '("info" "stack") "backtrace")
 
 
-(define-command "continue" '() continue)
+(define-command "continue" '() debugger:continue)
 
-(define-command "finish" '() finish)
+(define-command "finish" '() debugger:finish)
 
-(define-command "trace-finish" '() trace-finish)
+(define-command "trace-finish" '() debugger:trace-finish)
 
-(define-command "step" '('optional exact-integer) step)
+(define-command "step" '('optional exact-integer) debugger:step)
 
-(define-command "next" '('optional exact-integer) next)
+(define-command "next" '('optional exact-integer) debugger:next)

libguile/ChangeLog

@@ -1,5 +1,7 @@
 2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
+	* list.c, list.h (scm_filter, scm_filter_x): New functions.
+
 	* modules.c (scm_module_import_interface): New function.
 
 	* goops.c, goops.h (scm_class_accessor_method): Renamed from

libguile/list.c

@@ -1,4 +1,4 @@
-/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc.
  * 
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -47,6 +47,7 @@
 
 #include "libguile/validate.h"
 #include "libguile/list.h"
+#include "libguile/eval.h"
 
 #ifdef __STDC__
 #include <stdarg.h>
@@ -830,6 +831,64 @@ SCM_DEFINE (scm_delete1_x, "delete1!", 2, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_filter, "filter", 2, 0, 0,
+	    (SCM pred, SCM list),
+	    "Return all the elements of 2nd arg @var{list} that satisfy predicate @var{pred}.\n"
+	    "The list is not disordered -- elements that appear in the result list occur\n"
+	    "in the same order as they occur in the argument list. The returned list may\n"
+	    "share a common tail with the argument list. The dynamic order in which the\n"
+	    "various applications of pred are made is not specified.\n\n"
+	    "@lisp\n"
+	    "(filter even? '(0 7 8 8 43 -4)) => (0 8 8 -4)\n"
+	    "@end lisp")
+#define FUNC_NAME s_scm_filter
+{
+  scm_t_trampoline_1 call = scm_trampoline_1 (pred);
+  SCM walk;
+  SCM *prev;
+  SCM res = SCM_EOL;
+  SCM_ASSERT (call, pred, 1, FUNC_NAME);
+  SCM_VALIDATE_LIST (2, list);
+  
+  for (prev = &res, walk = list;
+       SCM_CONSP (walk);
+       walk = SCM_CDR (walk))
+    {
+      if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
+	{
+	  *prev = scm_cons (SCM_CAR (walk), SCM_EOL);
+	  prev = SCM_CDRLOC (*prev);
+	}
+    }
+
+  return res;
+}
+#undef FUNC_NAME
+
+SCM_DEFINE (scm_filter_x, "filter!", 2, 0, 0,
+	    (SCM pred, SCM list),
+	    "Linear-update variant of @code{filter}.")
+#define FUNC_NAME s_scm_filter_x
+{
+  scm_t_trampoline_1 call = scm_trampoline_1 (pred);
+  SCM walk;
+  SCM *prev;
+  SCM_ASSERT (call, pred, 1, FUNC_NAME);
+  SCM_VALIDATE_LIST (2, list);
+  
+  for (prev = &list, walk = list;
+       SCM_CONSP (walk);
+       walk = SCM_CDR (walk))
+    {
+      if (!SCM_FALSEP (call (pred, SCM_CAR (walk))))
+	prev = SCM_CDRLOC (walk);
+      else
+	*prev = SCM_CDR (walk);
+    }
+
+  return list;
+}
+#undef FUNC_NAME
 
 
 void

libguile/list.h

@@ -3,7 +3,7 @@
 #ifndef SCM_LIST_H
 #define SCM_LIST_H
 
-/* Copyright (C) 1995,1996,1997,2000,2001 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,1997,2000,2001, 2003 Free Software Foundation, Inc.
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -86,6 +86,8 @@ SCM_API SCM scm_delete (SCM item, SCM lst);
 SCM_API SCM scm_delq1_x (SCM item, SCM lst);
 SCM_API SCM scm_delv1_x (SCM item, SCM lst);
 SCM_API SCM scm_delete1_x (SCM item, SCM lst);
+SCM_API SCM scm_filter (SCM pred, SCM list);
+SCM_API SCM scm_filter_x (SCM pred, SCM list);
 SCM_API void scm_init_list (void);
 
 #endif  /* SCM_LIST_H */

oop/ChangeLog

@@ -1,5 +1,7 @@
 2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
+	* goops/util.scm (filter): Removed.  (Now supplied by core.)
+
 	* goops.scm (define-extended-generics): New syntax.
 	(<class> <operator-class> <entity-class> <entity>): Marked as
 	replacements.

oop/goops/util.scm

@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1999, 2000, 2001, 2003 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -42,7 +42,7 @@
 
 
 (define-module (oop goops util)
-  :export (any every filter
+  :export (any every
 	   mapappend find-duplicate top-level-env top-level-env?
 	   map* for-each* length* improper->proper)
   :no-backtrace
@@ -85,11 +85,6 @@
                   (and (apply pred heads)
                        (loop (map car tails) (map cdr tails)))))))))
 
-(define (filter test? list)
-  (cond ((null? list) '())
-	((test? (car list)) (cons (car list) (filter test? (cdr list))))
-	(else (filter test? (cdr list)))))
-
 (define (mapappend func . args)
   (if (memv '()  args)
       '()

srfi/ChangeLog

@@ -1,7 +1,8 @@
 2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
-	* srfi-1.scm (iota map for-each map-in-order list-index member
+	* srfi-1.scm (iota, map, for-each, map-in-order, list-index,
-	delete delete! assoc): Marked as replacements.
+	member, delete, delete!, assoc): Marked as replacements.
+	(filter, filter!): Removed.  (Now implemented in the core.)
 
 2003-03-06  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 

srfi/srfi-1.scm

@@ -174,10 +174,10 @@
  filter-map
 
 ;;; Filtering & partitioning
- filter
+ ;; filter				<= in the core
  partition
  remove
- filter!
+ ;; filter!				<= in the core
  partition!
  remove!
 
@@ -687,18 +687,6 @@
 
 ;;; Filtering & partitioning
 
-(define (filter pred list)
-  (check-arg-type list? list "filter")  ; reject circular lists.
-  (letrec ((filiter (lambda (pred rest result)
-		      (if (null? rest)
-			  (reverse! result)
-			  (filiter pred (cdr rest)
-				   (cond ((pred (car rest))
-					  (cons (car rest) result))
-					 (else
-					  result)))))))
-    (filiter pred list '())))
-
 (define (partition pred list)
   (if (null? list)
     (values '() '())
@@ -711,9 +699,6 @@
 (define (remove pred list)
   (filter (lambda (x) (not (pred x))) list))
 
-(define (filter! pred list)
-  (filter pred list))			; XXX:optimize
-
 (define (partition! pred list)
   (partition pred list))		; XXX:optimize