From 8587e782a7a912bc5cff3ed38807a856ea6b892e Mon Sep 17 00:00:00 2001
From: Kathy Gray <kathryn.gray@cl.cam.ac.uk>
Date: Fri, 16 Jun 2006 02:31:54 +0000
Subject: [PATCH] Correction to error with interfaces and resolving of method
 overloading/resolution

svn: r3372
---
 collects/profj/types.ss | 32 +++++++++++++++++++++++++-------
 1 file changed, 25 insertions(+), 7 deletions(-)

diff --git a/collects/profj/types.ss b/collects/profj/types.ss
index 68ec269f38..7102b118cc 100644
--- a/collects/profj/types.ss
+++ b/collects/profj/types.ss
@@ -618,28 +618,46 @@
                             (method-record-atypes (car methods)))
              (meth-member? meth (cdr methods)))))
 
-  ;depth: 'a (listof 'a) -> int
+  ;depth: 'a (listof 'a) -> (U int #f)
   ;The position in elt-list that elt is at, starting with 1
   (define (depth elt elt-list)
     (letrec ((d 
               (lambda (elt-list cnt)
                 #;(printf "d: elt ~a elt-list ~a~n" elt elt-list)
                 (cond
+                  ((null? (cdr elt-list)) +inf.0)
                   ((equal? (car elt-list) elt) cnt)
                   (else (d (cdr elt-list) (add1 cnt)))))))
       (d elt-list 1)))                   
   
+  ;iface-depth: (list string) (list (list string)) type-records -> int
+  (define (iface-depth elt ifaces type-recs)
+    (if (= 1 (length ifaces))
+        1
+        (let ([iface-tree (map (lambda (iface)
+                                 (cons iface
+                                       (class-record-parents 
+                                        (send type-recs get-class-record iface)))))])
+          (apply min (map (lambda (i-list) (depth elt i-list)) iface-tree)))))
+                          
+  
   ;conversion-steps: type type -> int
   (define (conversion-steps from to type-recs)
     #;(printf "conversion-steps ~a ~a~n" from to)
     (cond
       ((ref-type? from)
-       (let* ((from-class (send type-recs get-class-record from))
-              (from-class-parents (class-record-parents from-class)))
-         (if (eq? to 'dynamic)
-             (sub1 (length from-class-parents))
-             (depth (cons (ref-type-class/iface to) (ref-type-path to))
-                    from-class-parents))))
+       (let* ((to-name (cons (ref-type-class/iface to) (ref-type-path to)))
+              (from-class (send type-recs get-class-record from))
+              (from-class-parents (class-record-parents from-class))
+              (from-class-ifaces (class-record-ifaces from-class)))
+         (cond
+           ((eq? to 'dynamic) (length from-class-parents))
+           ((null? from-class-parents) 
+            (iface-depth to-name from-class-ifaces type-recs))
+           ((null? from-class-ifaces)
+            (depth to-name from-class-parents))
+           (else (min (depth to-name from-class-parents)
+                      (iface-depth to-name from-class-ifaces type-recs))))))
       ((array-type? from)
        (cond
          ((array-type? to)