/[guile]/guile/guile-core/ice-9/boot-9.scm
ViewVC logotype

Diff of /guile/guile-core/ice-9/boot-9.scm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.301 by mdj, Mon Mar 10 23:16:45 2003 UTC revision 1.302 by mdj, Tue Mar 11 15:57:56 2003 UTC
# Line 2837  Line 2837 
2837      m))      m))
2838    
2839  (define (lookup-duplicates-handlers handler-names)  (define (lookup-duplicates-handlers handler-names)
2840    (map (lambda (handler-name)    (and handler-names
2841           (or (module-symbol-local-binding         (map (lambda (handler-name)
2842                duplicate-handlers handler-name #f)                (or (module-symbol-local-binding
2843               (error "invalid duplicate handler name:"                     duplicate-handlers handler-name #f)
2844                      handler-name)))                    (error "invalid duplicate handler name:"
2845         (if (list? handler-names)                           handler-name)))
2846             handler-names              (if (list? handler-names)
2847             (list handler-names))))                  handler-names
2848                    (list handler-names)))))
2849    
2850  (define default-module-duplicates-handler  (define default-module-duplicates-handler
2851    (make-mutable-parameter '(replace warn-override-core check)    (make-mutable-parameter '(replace warn-override-core check)
# Line 2856  Line 2857 
2857      (set-module-name! m 'duplicates)      (set-module-name! m 'duplicates)
2858      m))      m))
2859    
 (define (module-symbol-interface module sym)  
   (or-map (lambda (interface)  
             (module-search (lambda (interface sym)  
                              (and (module-local-variable interface sym)  
                                   interface))  
                            interface  
                            sym))  
           (module-uses module)))  
   
2860  (define (process-duplicates module interface)  (define (process-duplicates module interface)
2861    (let* ((duplicates-info (module-duplicates-info module))    (let* ((duplicates-info (module-duplicates-info module))
2862           (duplicates-handlers (car duplicates-info))           (duplicates-handlers (car duplicates-info))
2863           (duplicates-interface (cdr duplicates-info)))           (duplicates-interface (cdr duplicates-info)))
2864      (module-for-each      (module-for-each
2865       (lambda (name var)       (lambda (name var)
2866         (let ((prev-interface (module-symbol-interface module name)))         (cond ((module-import-interface module name)
2867           (if prev-interface                =>
2868               (let ((var1 (module-local-variable prev-interface name))                (lambda (prev-interface)
2869                     (var2 (module-local-variable interface name)))                  (let ((var1 (module-local-variable prev-interface name))
2870                 (if (not (eq? var1 var2))                        (var2 (module-local-variable interface name)))
2871                     (begin                    (if (not (eq? var1 var2))
2872                       (if (not duplicates-interface)                        (begin
2873                           (begin                          (if (not duplicates-interface)
2874                             (set! duplicates-interface                              (begin
2875                                   (make-duplicates-interface))                                (set! duplicates-interface
2876                             (set-cdr! duplicates-info duplicates-interface)))                                      (make-duplicates-interface))
2877                       (let* ((var (module-local-variable duplicates-interface                                (set-cdr! duplicates-info duplicates-interface)))
2878                                                          name))                          (let* ((var (module-local-variable duplicates-interface
2879                              (val (and var                                                             name))
2880                                        (variable-bound? var)                                 (val (and var
2881                                        (variable-ref var))))                                           (variable-bound? var)
2882                         (let loop ((duplicates-handlers duplicates-handlers))                                           (variable-ref var))))
2883                           (cond ((null? duplicates-handlers))                            (let loop ((duplicates-handlers duplicates-handlers))
2884                                 (((car duplicates-handlers)                              (cond ((null? duplicates-handlers))
2885                                   module                                    (((car duplicates-handlers)
2886                                   name                                      module
2887                                   prev-interface                                      name
2888                                   (and (variable-bound? var1)                                      prev-interface
2889                                        (variable-ref var1))                                      (and (variable-bound? var1)
2890                                   interface                                           (variable-ref var1))
2891                                   (and (variable-bound? var2)                                      interface
2892                                        (variable-ref var2))                                      (and (variable-bound? var2)
2893                                   var                                           (variable-ref var2))
2894                                   val)                                      var
2895                                  =>                                      val)
2896                                  (lambda (var)                                     =>
2897                                    (module-add! duplicates-interface name var)))                                     (lambda (var)
2898                                 (else                                       (module-add! duplicates-interface name var)))
2899                                  (loop (cdr duplicates-handlers))))))))))))                                    (else
2900                                       (loop (cdr duplicates-handlers)))))))))))))
2901       interface)))       interface)))
2902    
2903    

Legend:
Removed from v.1.301  
changed lines
  Added in v.1.302

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26