* srfi-1.scm (iota map for-each map-in-order list-index member

delete delete! assoc): Marked as replacements.

* goops.scm (define-extended-generics): New syntax.
(<class> <operator-class> <entity-class> <entity>): Marked as
replacements.

* boot-9.scm (module-override!, make-mutable-parameter,
lookup-duplicates-handlers, default-module-duplicates-handler):
New functions.
(process-duplicates): Don't call duplicates handlers for duplicate
bindings of the same variable.
(process-define-module): Process #:replace.
(compile-interface-spec, resolve-interface): Process #:prefix.

* format.scm (format): Marked as replacement.

* threads.scm (future, future-ref): Marked as replacements.

NEWS

@@ -63,31 +63,54 @@ debugging evaluator gives better error messages.
 
 ** Checking for duplicate bindings in module system
 
-The module system now can check for duplicate imported bindings.
+The module system now checks for duplicate imported bindings.
-The syntax to enable this feature is:
+
+The behavior can be controlled by specifying one or more duplicates
+handlers.  For example, to get back the old behavior (which was to use
+the last imported binding of a certain name), write:
 
 (define-module (foo)
   :use-module (bar)
   :use-module (baz)
-  :duplicates check)
+  :duplicates last)
 
-This will report an error if both (bar) and (baz) exports a binding
+If you want the old behavior without changing your module headers, put
-with the same name.
+the line:
+
+  (default-module-duplicates-handler 'last)
+
+in your .guile init file.
 
 The syntax for the :duplicates option is:
 
   :duplicates HANDLER-NAME | (HANDLER1-NAME HANDLER2-NAME ...)
 
 Specifying multiple handlers is useful since some handlers (such as
-merge-generics) can defer conflict resolution to others.
+replace) can defer conflict resolution to others.  Each handler is
+tried until a binding is selected.
 
 Currently available duplicates handlers are:
 
-  check		  report an error for bindings with a common name
+  check		     report an error for bindings with a common name
-  first		  select the first encountered binding (override)
+  warn		     issue a warning for bindings with a common name
-  last		  select the last encountered binding (override)
+  replace	     replace bindings which have an imported replacement
-  merge-generics  merge generic functions with a common name
+  warn-override-core issue a warning for imports which override core bindings
-		  into an <extended-generic>
+  first		     select the first encountered binding (override)
+  last		     select the last encountered binding (override)
+  merge-generics     merge generic functions with a common name
+		     into an <extended-generic>
+
+The default duplicates handler is:
+
+  (replace warn-override-core check)
+
+** New define-module option: :replace
+
+:replace works as :export, but, in addition, marks the binding as a
+replacement.
+
+A typical example is `format' in (ice-9 format) which is a replacement
+for the core binding `format'.
 
 ** Merging generic functions
 
@@ -99,8 +122,9 @@ Assume that we work with a graphical package which needs to use two
 independent vector packages for 2D and 3D vectors respectively.  If
 both packages export `x' we will encounter a name collision.
 
-This can now be resolved with the duplicates handler `merge-generics'
+This can now be resolved automagically with the duplicates handler
-which merges all generic functions with a common name:
+`merge-generics' which gives the module system license to merge all
+generic functions sharing a common name:
 
 (define-module (math 2D-vectors)
   :use-module (oop goops)
@@ -118,17 +142,27 @@ which merges all generic functions with a common name:
 x in (my-module) will now share methods with x in both imported
 modules.
 
-The detailed rule for method visibility is this:
+There will, in fact, now be three distinct generic functions named
+`x': x in (2D-vectors), x in (3D-vectors), and x in (my-module).  The
+last function will be an <extended-generic>, extending the previous
+two functions.
 
-Let's call the imported generic functions the "ancestor functions".
+Let's call the imported generic functions the "ancestor functions".  x
-x in (my-module) is, in turn, a "descendant function" of the imported
+in (my-module) is, in turn, a "descendant function" of the imported
-functions.  For any generic function gf, the applicable methods are
+functions, extending its ancestors.
-selected from the union of the methods of the descendant functions,
-the methods of gf and the methods of the ancestor functions.
 
-This implies that x in (math 2D-vectors) can see the methods of x in
+For any generic function G, the applicable methods are selected from
-(my-module) and vice versa, while x in (math 2D-vectors) doesn't see
+the union of the methods of the descendant functions, the methods of G
-the methods of x in (math 3D-vectors), thus preserving modularity.
+itself and the methods of the ancestor functions.
+
+This, ancestor functions share methods with their descendants and vice
+versa.  This implies that x in (math 2D-vectors) can will share the
+methods of x in (my-module) and vice versa, while x in (math 2D-vectors)
+doesn't share the methods of x in (math 3D-vectors), thus preserving
+modularity.
+
+Sharing is dynamic, so that adding new methods to a descendant implies
+adding it to the ancestor.
 
 If duplicates checking is desired in the above example, the following
 form of the :duplicates option can be used instead:

ice-9/ChangeLog

@@ -1,3 +1,17 @@
+2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* boot-9.scm (module-override!, make-mutable-parameter,
+	lookup-duplicates-handlers, default-module-duplicates-handler):
+	New functions.
+	(process-duplicates): Don't call duplicates handlers for duplicate
+	bindings of the same variable.
+	(process-define-module): Process #:replace.
+	(compile-interface-spec, resolve-interface): Process #:prefix.
+
+	* format.scm (format): Marked as replacement.
+
+	* threads.scm (future, future-ref): Marked as replacements.
+
 2003-03-07  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	These changes enables checking for duplicate imported bindings.

ice-9/boot-9.scm

@@ -1601,7 +1601,9 @@
 	  (set-module-name! interface (module-name module))
 	  (set-module-kind! interface 'interface)
 	  (set-module-public-interface! module interface)
-	  (set-module-duplicates-info! module (cons #f #f)))))
+	  (set-module-duplicates-info!
+	   module
+	   (cons (default-module-duplicates-handler) #f)))))
   (if (and (not (memq the-scm-module (module-uses module)))
 	   (not (eq? module the-root-module)))
       (set-module-uses! module
@@ -1677,7 +1679,13 @@
 ;;   #:renamer RENAMER
 ;;
 ;; RENAMER is a procedure that takes a symbol and returns its new
-;; name.  The default is to not perform any renaming.
+;; 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.
 ;;
 ;; Signal "no code for module" error if module name is not resolvable
 ;; or its public interface is not available.  Signal "no binding"
@@ -1695,7 +1703,10 @@
 	   def)))
 
   (let* ((select (get-keyword-arg args #:select #f))
-	 (renamer (get-keyword-arg args #:renamer identity))
+	 (renamer (or (get-keyword-arg args #:renamer #f)
+		      (let ((prefix (get-keyword-arg args #:prefix #f)))
+			(and prefix (symbol-prefix-proc prefix)))
+		      identity))
          (module (resolve-module name))
          (public-i (and module (module-public-interface module))))
     (and (or (not module) (not public-i))
@@ -1740,11 +1751,13 @@
     (let loop ((kws kws)
 	       (reversed-interfaces '())
 	       (exports '())
-	       (re-exports '()))
+	       (re-exports '())
+	       (replacements '()))
       (if (null? kws)
 	  (begin
 	    (module-use-interfaces! module (reverse reversed-interfaces))
 	    (module-export! module exports)
+	    (module-replace! module replacements)
 	    (module-re-export! module re-exports))
 	  (case (car kws)
 	    ((#:use-module #:use-syntax)
@@ -1764,7 +1777,8 @@
 	       (loop (cddr kws)
 		     (cons interface reversed-interfaces)
 		     exports
-		     re-exports)))
+		     re-exports
+		     replacements)))
 	    ((#:autoload)
 	     (or (and (pair? (cdr kws)) (pair? (cddr kws)))
 		 (unrecognized kws))
@@ -1774,40 +1788,44 @@
 						  (caddr kws))
 			 reversed-interfaces)
 		   exports
-		   re-exports))
+		   re-exports
+		   replacements))
 	    ((#:no-backtrace)
 	     (set-system-module! module #t)
-	     (loop (cdr kws) reversed-interfaces exports re-exports))
+	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
 	    ((#:pure)
 	     (purify-module! module)
-	     (loop (cdr kws) reversed-interfaces exports re-exports))
+	     (loop (cdr kws) reversed-interfaces exports re-exports replacements))
 	    ((#:duplicates)
 	     (if (not (pair? (cdr kws)))
 		 (unrecognized kws))
 	     (set-car! (module-duplicates-info module)
-		       (map (lambda (handler-name)
+		       (lookup-duplicates-handlers (cadr kws)))
-			      (or (module-symbol-local-binding
+	     (loop (cddr kws) reversed-interfaces exports re-exports replacements))
-				   duplicate-handlers handler-name #f)
-				  (error "invalid duplicate handler name:"
-					 handler-name)))
-			    (if (list? (cadr kws))
-				(cadr kws)
-				(list (cadr kws)))))
-	     (loop (cddr kws) reversed-interfaces exports re-exports))
 	    ((#:export #:export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
 	     (loop (cddr kws)
 		   reversed-interfaces
 		   (append (cadr kws) exports)
-		   re-exports))
+		   re-exports
+		   replacements))
 	    ((#:re-export #:re-export-syntax)
 	     (or (pair? (cdr kws))
 		 (unrecognized kws))
 	     (loop (cddr kws)
 		   reversed-interfaces
 		   exports
-		   (append (cadr kws) re-exports)))
+		   (append (cadr kws) re-exports)
+		   replacements))
+	    ((#:replace #:replace-syntax)
+	     (or (pair? (cdr kws))
+		 (unrecognized kws))
+	     (loop (cddr kws)
+		   reversed-interfaces
+		   exports
+		   re-exports
+		   (append (cadr kws) replacements)))
 	    (else
 	     (unrecognized kws)))))
     (run-hook module-defined-hook module)
@@ -2533,6 +2551,7 @@
   (define keys
     ;; sym     key      quote?
     '((:select #:select #t)
+      (:prefix #:prefix #t)
       (:renamer #:renamer #f)))
   (if (not (pair? (car spec)))
       `(',spec)
@@ -2674,6 +2693,14 @@
 		  (module-add! public-i name var)))
 	      names)))
 
+(define (module-replace! m names)
+  (let ((public-i (module-public-interface m)))
+    (for-each (lambda (name)
+		(let ((var (module-ensure-local-variable! m name)))
+		  (set-object-property! var 'replace #t)
+		  (module-add! public-i name var)))
+	      names)))
+
 ;; Re-export a imported variable
 ;;
 (define (module-re-export! m names)
@@ -2710,6 +2737,24 @@
 
 (define load load-module)
 
+
+;;; {Parameters}
+;;;
+
+(define make-mutable-parameter
+  (let ((make (lambda (fluid converter)
+		(lambda args
+		  (if (null? args)
+		      (fluid-ref fluid)
+		      (fluid-set! fluid (converter (car args))))))))
+    (lambda (init . converter)
+      (let ((fluid (make-fluid))
+	    (converter (if (null? converter)
+			   identity
+			   (car converter))))
+	(fluid-set! fluid (converter init))
+	(make fluid converter)))))
+
 
 ;;; {Handling of duplicate imported bindings}
 ;;;
@@ -2734,26 +2779,77 @@
 
 (define duplicate-handlers
   (let ((m (make-module 7)))
+    
+    (define (check module name int1 val1 int2 val2 var val)
+      (scm-error 'misc-error
+		 #f
+		 "~A: ~A imported from ~A and ~A"
+		 (list (module-name module)
+		       name
+		       (module-name int1)
+		       (module-name int2))
+		 #f))
+    
+     (define (warn module name int1 val1 int2 val2 var val)
+       (format #t
+	       "~A: ~A imported from ~A and ~A\n"
+	       (module-name module)
+	       name
+	       (module-name int1)
+	       (module-name int2))
+       #f)
+     
+    (define (replace module name int1 val1 int2 val2 var val)
+      (let ((old (or (and var (object-property var 'replace) var)
+		     (module-variable int1 name)))
+	    (new (module-variable int2 name)))
+	(if (object-property old 'replace)
+	    (and (or (eq? old new)
+		     (not (object-property new 'replace)))
+		 old)
+	    (and (object-property new 'replace)
+		 new))))
+    
+     (define (warn-override-core module name int1 val1 int2 val2 var val)
+       (and (eq? int1 the-scm-module)
+	    (begin
+	      (format #t
+		      "WARNING: ~A: imported module ~A overrides core binding ~A\n"
+		      (module-name module)
+		      (module-name int2)
+		      name)
+	      (module-local-variable int2 name))))
+     
+     (define (first module name int1 val1 int2 val2 var val)
+       (or var (module-local-variable int1 name)))
+     
+     (define (last module name int1 val1 int2 val2 var val)
+       (module-local-variable int2 name))
+     
     (set-module-name! m 'duplicate-handlers)
     (set-module-kind! m 'interface)
-    (module-define! m 'check
+    (module-define! m 'check check)
-     (lambda (module name int1 val1 int2 val2 var val)
+    (module-define! m 'warn warn)
-       (scm-error 'misc-error
+    (module-define! m 'replace replace)
-		  #f
+    (module-define! m 'warn-override-core warn-override-core)
-		  "module ~A: duplicate binding ~A imported from ~A and ~A"
+    (module-define! m 'first first)
-		  (list (module-name module)
+    (module-define! m 'last last)
-			name
-			(module-name int1)
-			(module-name int2))
-		  #f)))
-    (module-define! m 'first
-     (lambda (module name int1 val1 int2 val2 var val)
-       (or var (module-local-variable int1 name))))
-    (module-define! m 'last
-     (lambda (module name int1 val1 int2 val2 var val)
-       (module-local-variable int2 name)))
     m))
 
+(define (lookup-duplicates-handlers handler-names)
+  (map (lambda (handler-name)
+	 (or (module-symbol-local-binding
+	      duplicate-handlers handler-name #f)
+	     (error "invalid duplicate handler name:"
+		    handler-name)))
+       (if (list? handler-names)
+	   handler-names
+	   (list handler-names))))
+
+(define default-module-duplicates-handler
+  (make-mutable-parameter '(replace warn-override-core check)
+			  lookup-duplicates-handlers))
+
 (define (make-duplicates-interface)
   (let ((m (make-module)))
     (set-module-kind! m 'interface)
@@ -2771,35 +2867,44 @@
 
 (define (process-duplicates module interface)
   (let* ((duplicates-info (module-duplicates-info module))
-	 (handlers (car duplicates-info))
+	 (duplicates-handlers (car duplicates-info))
-	 (d-interface (cdr duplicates-info)))
+	 (duplicates-interface (cdr duplicates-info)))
     (module-for-each
      (lambda (name var)
        (let ((prev-interface (module-symbol-interface module name)))
 	 (if prev-interface
-	     (begin
+	     (let ((var1 (module-local-variable prev-interface name))
-	       (if (not d-interface)
+		   (var2 (module-local-variable interface name)))
+	       (if (not (eq? var1 var2))
 		   (begin
-		     (set! d-interface (make-duplicates-interface))
+		     (if (not duplicates-interface)
-		     (set-cdr! duplicates-info d-interface)))
+			 (begin
-	       (let* ((var (module-local-variable d-interface name))
+			   (set! duplicates-interface
-		      (val (and var (variable-bound? var) (variable-ref var))))
+				 (make-duplicates-interface))
-		 (let loop ((handlers handlers))
+			   (set-cdr! duplicates-info duplicates-interface)))
-		   (cond ((null? handlers))
+		     (let* ((var (module-local-variable duplicates-interface
-			 (((car handlers)
+							name))
-			   module
+			    (val (and var
-			   name
+				      (variable-bound? var)
-			   prev-interface
+				      (variable-ref var))))
-			   (module-symbol-local-binding prev-interface name #f)
+		       (let loop ((duplicates-handlers duplicates-handlers))
-			   interface
+			 (cond ((null? duplicates-handlers))
-			   (module-symbol-local-binding interface name #f)
+			       (((car duplicates-handlers)
-			   var
+				 module
-			   val)
+				 name
-			  =>
+				 prev-interface
-			  (lambda (var)
+				 (and (variable-bound? var1)
-			    (module-add! d-interface name var)))
+				      (variable-ref var1))
-			 (else
+				 interface
-			  (loop (cdr handlers))))))))))
+				 (and (variable-bound? var2)
+				      (variable-ref var2))
+				 var
+				 val)
+				=>
+				(lambda (var)
+				  (module-add! duplicates-interface name var)))
+			       (else
+				(loop (cdr duplicates-handlers))))))))))))
      interface)))
 
 

ice-9/format.scm

@@ -14,12 +14,11 @@
 (define-module (ice-9 format)
   :use-module (ice-9 and-let-star)
   :use-module (ice-9 threads)
-  :autoload (ice-9 pretty-print) (pretty-print))
+  :autoload (ice-9 pretty-print) (pretty-print)
-
+  :replace (format)
-(export format
+  :export (format:symbol-case-conv
-	format:symbol-case-conv
+	   format:iobj-case-conv
-	format:iobj-case-conv
+	   format:expch))
-	format:expch)
 
 ;;; Configuration ------------------------------------------------------------
 

ice-9/threads.scm

@@ -57,18 +57,18 @@
 ;;; Code:
 
 (define-module (ice-9 threads)
-  :export (future-ref
+  :export (par-map
-	   par-map
 	   par-for-each
 	   n-par-map
 	   n-par-for-each)
+  :re-export (future-ref)
   :export-syntax (begin-thread
-		  future
 		  parallel
 		  letpar
 		  make-thread
 		  with-mutex
-		  monitor))
+		  monitor)
+  :re-export-syntax (future))
 
 
 

oop/ChangeLog

@@ -1,3 +1,9 @@
+2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* goops.scm (define-extended-generics): New syntax.
+	(<class> <operator-class> <entity-class> <entity>): Marked as
+	replacements.
+
 2003-03-07  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* goops.scm (equal?): Define default method.

oop/goops.scm

@@ -53,7 +53,7 @@
 (define-module (oop goops)
   :export-syntax (define-class class
 		  define-generic define-accessor define-method
-		  define-extended-generic
+		  define-extended-generic define-extended-generics
 		  method)
   :export (goops-version is-a?
            ensure-metaclass ensure-metaclass-with-supers
@@ -97,6 +97,7 @@
 	   primitive-generic-generic enable-primitive-generic!
 	   method-procedure accessor-method-slot-definition
 	   slot-exists? make find-method get-keyword)
+  :replace (<class> <operator-class> <entity-class> <entity>)
   :re-export (class-of)  ;; from (guile)
   :no-backtrace)
 
@@ -383,6 +384,20 @@
 	       (goops-error "missing expression"))
 	      (else
 	       `(define ,name (make-extended-generic ,(caddr exp) ',name))))))))
+(define define-extended-generics
+  (procedure->memoizing-macro
+    (lambda (exp env)
+      (let ((names (cadr exp))
+	    (prefixes (get-keyword #:prefix (cddr exp) #f)))
+	(if prefixes
+	    `(begin
+	       ,@(map (lambda (name)
+			`(define-extended-generic ,name
+			   (list ,@(map (lambda (prefix)
+					  (symbol-append prefix name))
+					prefixes))))
+		      names))
+	    (goops-error "no prefixes supplied"))))))
 
 (define (make-generic . name)
   (let ((name (and (pair? name) (car name))))

srfi/ChangeLog

@@ -1,3 +1,8 @@
+2003-03-11  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
+
+	* srfi-1.scm (iota map for-each map-in-order list-index member
+	delete delete! assoc): Marked as replacements.
+
 2003-03-06  Mikael Djurfeldt  <djurfeldt@nada.kth.se>
 
 	* srfi-1.c (scm_init_srfi_1): Extend root module map and for-each

srfi/srfi-1.scm

@@ -1,6 +1,6 @@
 ;;; srfi-1.scm --- List Library
 
-;; 	Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;; 	Copyright (C) 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
@@ -59,9 +59,8 @@
 
 (define-module (srfi srfi-1)
   :use-module (ice-9 session)
-  :use-module (ice-9 receive))
+  :use-module (ice-9 receive)
-
+  :export (
-(export
 ;;; Constructors
  ;; cons				<= in the core
  ;; list				<= in the core
@@ -71,7 +70,7 @@
  list-tabulate
  ;; list-copy				<= in the core
  circular-list
- iota					; Extended.
+ ;; iota				; Extended.
 
 ;;; Predicates
  proper-list?
@@ -165,12 +164,12 @@
  reduce-right
  unfold
  unfold-right
- map					; Extended.
+ ;; map					; Extended.
- for-each				; Extended.
+ ;; for-each				; Extended.
  append-map
  append-map!
  map!
- map-in-order				; Extended.
+ ;; map-in-order			; Extended.
  pair-for-each
  filter-map
 
@@ -194,19 +193,19 @@
  break!
  any
  every
- list-index				; Extended.
+ ;; list-index				; Extended.
- member					; Extended.
+ ;; member				; Extended.
  ;; memq				<= in the core
  ;; memv				<= in the core
 
 ;;; Deletion
- delete					; Extended.
+ ;; delete				; Extended.
- delete!				; Extended.
+ ;; delete!				; Extended.
  delete-duplicates
  delete-duplicates!
 
 ;;; Association lists
- assoc					; Extended.
+ ;; assoc				; Extended.
  ;; assq				<= in the core
  ;; assv				<= in the core
  alist-cons
@@ -233,6 +232,9 @@
  ;; set-car!				<= in the core
  ;; set-cdr!				<= in the core
  )
+  :replace (iota map for-each map-in-order list-index member
+	    delete delete! assoc)
+  )
 
 (cond-expand-provide (current-module) '(srfi-1))