diff --git a/collects/profj/check.ss b/collects/profj/check.ss index 0569e33206..f317c2fb88 100644 --- a/collects/profj/check.ss +++ b/collects/profj/check.ss @@ -1519,16 +1519,10 @@ ((or (and (prim-numeric-type? l) (prim-numeric-type? r)) (and (eq? 'boolean l) (eq? 'boolean r))) 'boolean) - ((and (reference-type? l) (reference-type? r)) - (let* ((dl? (dynamic-val? l)) - (dr? (dynamic-val? r)) - (dlt (when dl? (dynamic-val-type l))) - (drt (when dr? (dynamic-val-type r))) - (right-to-left (assignment-conversion l r type-recs)) - (left-to-right (assignment-conversion r l type-recs))) - (when (and dl? (not dlt)) (set-dynamic-val-type! l #f)) - (when (and dr? (not drt)) (set-dynamic-val-type! r #f)) - (cond + ((and (reference-or-array-type? l) (reference-or-array-type? r)) + (let ((right-to-left (castable? l r type-recs)) + (left-to-right (castable? r l type-recs))) + (cond ((or right-to-left left-to-right) 'boolean) (else (bin-op-equality-error 'both op l r src))))) (else @@ -2472,8 +2466,18 @@ (set-dynamic-val-type! exp-type type) type) ((eq? 'dynamic type) (make-dynamic-val #f)) - ((and (reference-type? exp-type) (reference-type? type)) type) - ((and (not (reference-type? exp-type)) (not (reference-type? type))) type) + ((and (reference-or-array-type? exp-type) (reference-or-array-type? type)) + (unless (castable? exp-type type type-recs) (cast-error 'incompatible exp-type type src)) + type) + ((and (not (reference-type? exp-type)) (not (reference-type? type))) + (unless (or (and (prim-numeric-type? exp-type) + (prim-numeric-type? type) + (or (widening-prim-conversion exp-type type) + (widening-prim-conversion type exp-type))) + (and (eq? 'boolean type) + (eq? 'boolean exp-type))) + (cast-error 'incompatible-prim exp-type type src)) + type) ((reference-type? exp-type) (cast-error 'from-prim exp-type type src)) (else (cast-error 'from-ref exp-type type src))) (type/env-e exp-type/env)))) @@ -2627,7 +2631,7 @@ op (case type ((both) - (format "~a expects one argument to be assignable to the other, neither ~a nor ~a can be" op lt rt)) + (format "~a expects one argument to be castable to the other, neither ~a nor ~a can be" op lt rt)) (else (format "~a expects its arguments to be equivalent types, given non-equivalent ~a and ~a" op lt rt))) @@ -3182,7 +3186,12 @@ (let ((line1 (format "Illegal cast from class or interface ~a to primitive, ~a." (type->ext-name exp) (type->ext-name cast))) (line2 "Class or interface types may not be cast to non-class or interface types")) - (format "~a~n~a" line1 line2)))) + (format "~a~n~a" line1 line2))) + ((incompatible) + (format "Illegal cast from class or interface ~a to class or interface ~a, incompatible types" + (type->ext-name exp) (type->ext-name cast))) + ((incompatible-prim) + (format "Illegal cast from ~a to ~a, incompatible types" (type->ext-name exp) (type->ext-name cast)))) 'cast src)) ;;Instanceof errors diff --git a/collects/profj/default.jinfo b/collects/profj/default.jinfo deleted file mode 100644 index 323f2b7f68..0000000000 --- a/collects/profj/default.jinfo +++ /dev/null @@ -1,189 +0,0 @@ -( -(class ("Object" "java" "lang") - (public) - () - (("Object" (public) ctor () () ("Object" "java" "lang")) - ("clone" (protected) ("Object" "java" "lang") () (("CloneNotSupportedException" "java" "lang"))("Object" "java" "lang")) - ("equals" (public) boolean (("Object" "java" "lang")) () ("Object" "java" "lang")) - ("finalize" (protected) void () () ("Object" "java" "lang")) - ("getClass" (public final) ("Class" "java" "lang") () () ("Object" "java" "lang")) - ("hashCode" (public) int () () ("Object" "java" "lang")) - ("notify" (public final) void () () ("Object" "java" "lang")) - ("notifyAll" (public final) void () () ("Object" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("Object" "java" "lang")) - ("wait" (public final) void () (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long) (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long int) (("InterruptedException" "java" "lang")) ("Object" "java" "lang"))) - (("Object" "java" "lang")) - ()) - -(class ("Throwable" "java" "lang") - (public) - () - (("Throwable" (public) ctor () () ("Throwable" "java" "lang")) - ("Throwable" (public) ctor (("String" "java" "lang")) () ("Throwable" "java" "lang")) - ("Throwable" (public) ctor (("String" "java" "lang") ("Throwable" "java" "lang")) () ("Throwable" "java" "lang")) - ("Throwable" (public) ctor (("Throwable" "java" "lang")) () ("Throwable" "java" "lang")) - - ("fillInStackTrace" (public) ("Throwable" "java" "lang") () () ("Throwable" "java" "lang")) - ("initCause" (public) ("Throwable" "java" "lang") (("Throwable" "java" "lang")) () ("Throwable" "java" "lang")) - ("getCause" (public) ("Throwable" "java" "lang") () () ("Throwable" "java" "lang")) - ("getLocalizedMessage" (public) ("String" "java" "lang") () () ("Throwable" "java" "lang")) - ("getMessage" (public) ("String" "java" "lang") () () ("Throwable" "java" "lang")) - ("getStackTrace" (public) (1 ("StackTraceElement" "java" "lang")) () () ("Throwable" "java" "lang")) - ("printStackTrace" (public) void () () ("Throwable" "java" "lang")) - ("printStackTrace" (public) void (("PrintString" "java" "io")) () ("Throwable" "java" "lang")) - ("printStackTrace" (public) void (("PrintWriter" "java" "io")) () ("Throwable" "java" "lang")) - ("setStackTrace" (public) void ((1 ("StackTraceElement" "java" "lang"))) () ("Throwable" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("Throwable" "java" "lang")) - - ("Object" (public) ctor () () ("Object" "java" "lang")) - ("clone" (protected) ("Object" "java" "lang") () (("CloneNotSupportedException" "java" "lang"))("Object" "java" "lang")) - ("equals" (public) boolean (("Object" "java" "lang")) () ("Object" "java" "lang")) - ("finalize" (protected) void () () ("Object" "java" "lang")) - ("getClass" (public final) ("Class" "java" "lang") () () ("Object" "java" "lang")) - ("hashCode" (public) int () () ("Object" "java" "lang")) - ("notify" (public final) void () () ("Object" "java" "lang")) - ("notifyAll" (public final) void () () ("Object" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("Object" "java" "lang")) - ("wait" (public final) void () (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long) (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long int) (("InterruptedException" "java" "lang")) ("Object" "java" "lang"))) - - (("Object" "java" "lang")) - (("Serializable" "java" "io"))) - -(class ("Class" "java" "lang") - (public final) - () - (("Class" (public) ctor () () ("Class" "java" "lang"))) - (("Object" "java" "lang")) - ()) - -(class ("String" "java" "lang") - (public final) - (("CASE_INSENSITIVE_ORDER" (public static final) - ("String" "java" "lang") - ("Comparator" "java" "util"))) - (("String" (public) ctor () () ("String" "java" "lang")) - ("String" (public) ctor (("String" "java" "lang")) () ("String" "java" "lang")) - ("String" (public) ctor ((1 char)) () ("String" "java" "lang")) - ("String" (public) ctor ((1 char) int int) () ("String" "java" "lang")) - ("String" (public) ctor ((1 byte) int int ("String" "java" "lang")) (("UnsupportedEncodingException" "java" "io")) ("String" "java" "lang")) - ("String" (public) ctor ((1 byte) ("String" "java" "lang")) (("UnsupportedEncodingException" "java" "io")) ("String" "java" "lang")) - ("String" (public) ctor ((1 byte) int int) () ("String" "java" "lang")) - ("String" (public) ctor ((1 byte)) () ("String" "java" "lang")) - ("String" (public) ctor (("StringBuffer" "java" "lang")) () ("String" "java" "lang")) - - ("length" (public) int () () ("String" "java" "lang")) - ("charAt" (public) char (int) () ("String" "java" "lang")) - ("getChars" (public) void (int int (1 char) int) () ("String" "java" "lang")) - ("getBytes" (public) (1 byte) (("String" "java" "lang")) (("UnsupportedEncodingException" "java" "io")) ("String" "java" "lang")) - ("getBytes" (public) (1 byte) () () ("String" "java" "lang")) - ("equals" (public) boolean (("Object" "java" "lang")) () ("String" "java" "lang")) - ("contentEquals" (public) boolean (("StringBuffer" "java" "lang")) () ("String" "java" "lang")) - ("equalsIgnoreCase" (public) boolean (("String" "java" "lang")) () ("String" "java" "lang")) - ("compareTo" (public) int (("String" "java" "lang")) () ("String" "java" "lang")) - ("compareTo" (public) int (("Object" "java" "lang")) () ("String" "java" "lang")) - ("compareToIgnoreCase" (public) int (("String" "java" "lang")) () ("String" "java" "lang")) - ("regionMatches" (public) boolean (int ("String" "java" "lang") int int) () ("String" "java" "lang")) - ("regionMatches" (public) boolean (boolean int ("String" "java" "lang") int int) () ("String" "java" "lang")) - ("startsWith" (public) boolean (("String" "java" "lang") int) () ("String" "java" "lang")) - ("startsWith" (public) boolean (("String" "java" "lang")) () ("String" "java" "lang")) - ("endsWith" (public) boolean (("String" "java" "lang")) () ("String" "java" "lang")) - ("hashCode" (public) int () () ("String" "java" "lang")) - ("indexOf" (public) int (int) () ("String" "java" "lang")) - ("indexOf" (public) int (int int) () ("String" "java" "lang")) - ("lastIndexOf" (public) int (int) () ("String" "java" "lang")) - ("lastIndexOf" (public) int (int int) () ("String" "java" "lang")) - ("indexOf" (public) int (("String" "java" "lang")) () ("String" "java" "lang")) - ("indexOf" (public) int (("String" "java" "lang") int) () ("String" "java" "lang")) - ("lastIndexOf" (public) int (("String" "java" "lang")) () ("String" "java" "lang")) - ("lastIndexOf" (public) int (("String" "java" "lang") int) () ("String" "java" "lang")) - ("substring" (public) ("String" "java" "lang") (int) () ("String" "java" "lang")) - ("substring" (public) ("String" "java" "lang") (int int) () ("String" "java" "lang")) - ("subSequence" (public) ("CharSequence" "java" "lang") (int int) () ("String" "java" "lang")) - ("concat" (public) ("String" "java" "lang") (("String" "java" "lang")) () ("String" "java" "lang")) - ("replace" (public) ("String" "java" "lang") (char char) () ("String" "java" "lang")) - ("matches" (public) boolean (("String" "java" "lang")) () ("String" "java" "lang")) - ("replaceFirst" (public) ("String" "java" "lang") (("String" "java" "lang") ("String" "java" "lang")) () ("String" "java" "lang")) - ("replaceAll" (public) ("String" "java" "lang") (("String" "java" "lang")("String" "java" "lang")) () ("String" "java" "lang")) - ("split" (public) (1 ("String" "java" "lang")) (("String" "java" "lang") int) () ("String" "java" "lang")) - ("split" (public) (1 ("String" "java" "lang")) (("String" "java" "lang")) () ("String" "java" "lang")) - ("toLowerCase" (public) ("String" "java" "lang") (("Locale" "java" "util")) () ("String" "java" "lang")) - ("toLowerCase" (public) ("String" "java" "lang") () () ("String" "java" "lang")) - ("toUpperCase" (public) ("String" "java" "lang") (("Locale" "java" "util")) () ("String" "java" "lang")) - ("toUpperCase" (public) ("String" "java" "lang") () () ("String" "java" "lang")) - ("trim" (public) ("String" "java" "lang") () () ("String" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("String" "java" "lang")) - ("toCharArray" (public) (1 char) () () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (("Object" "java" "lang")) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") ((1 char)) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") ((1 char) int int) () ("String" "java" "lang")) - ("copyValueOf" (public static) ("String" "java" "lang") ((1 char) int int) () ("String" "java" "lang")) - ("copyValueOf" (public static) ("String" "java" "lang") ((1 char)) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (boolean) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (char) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (int) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (long) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (float) () ("String" "java" "lang")) - ("valueOf" (public static) ("String" "java" "lang") (double) () ("String" "java" "lang")) - ("intern" (public) ("String" "java" "lang") () () ("String" "java" "lang")) - - ("Object" (public) ctor () () ("Object" "java" "lang")) - ("clone" (protected) ("Object" "java" "lang") () (("CloneNotSupportedException" "java" "lang"))("Object" "java" "lang")) - ("equals" (public) boolean (("Object" "java" "lang")) () ("Object" "java" "lang")) - ("finalize" (protected) void () () ("Object" "java" "lang")) - ("getClass" (public final) ("Class" "java" "lang") () () ("Object" "java" "lang")) - ("hashCode" (public) int () () ("Object" "java" "lang")) - ("notify" (public final) void () () ("Object" "java" "lang")) - ("notifyAll" (public final) void () () ("Object" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("Object" "java" "lang")) - ("wait" (public final) void () (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long) (("InterruptedException" "java" "lang"))("Object" "java" "lang")) - ("wait" (public final) void (long int) (("InterruptedException" "java" "lang")) ("Object" "java" "lang"))) - - (("Object" "java" "lang")) - (("Serializable" "java" "io") ("Comparable" "java" "lang") ("CharSequence" "java" "lang"))) - -(interface ("Serializable" "java" "io") - (public) - () - () - () - ()) - -(interface ("Cloneable" "java" "lang") - (public) - () - () - () - ()) - -(interface ("Comparable" "java" "lang") - (public) - () - (("compareTo" (public) int (("Object" "java" "lang")) () ("Comparable" "java" "lang"))) - () - ()) - -(interface ("Runnable" "java" "lang") - (public) - () - (("run" (public) void () () ("Runnable" "java" "lang"))) - () - ()) - -(interface ("CharSequence" "java" "lang") - (public) - () - (("length" (public) int () () ("CharSequence" "java" "lang")) - ("charAt" (public) char (int) () ("CharSequence" "java" "lang")) - ("subSequence" (public) ("CharSequence" "java" "lang") (int int) () ("CharSequence" "java" "lang")) - ("toString" (public) ("String" "java" "lang") () () ("CharSequence" "java" "lang"))) - () - ()) - -) - - diff --git a/collects/profj/to-scheme.ss b/collects/profj/to-scheme.ss index d2895c5df8..555faaacfc 100644 --- a/collects/profj/to-scheme.ss +++ b/collects/profj/to-scheme.ss @@ -729,8 +729,6 @@ (let* ((wrapped-methods (filter (lambda (m) - #;(printf "~a (~a : ~a ~a)~n" (method-record-name m) (method-record-class m) class-name - (method-record-override m)) (and (not (eq? (method-record-rtype m) 'ctor)) (equal? (car (method-record-class m)) class-name) (not (method-record-override m)))) @@ -1977,7 +1975,8 @@ (expr-src expr))) ((cast? expr) (translate-cast (cast-type expr) (translate-expression (cast-expr expr)) - (expr-types expr) + (expr-types (cast-expr expr)) + ;(expr-types expr) (expr-src expr))) ((instanceof? expr) (translate-instanceof (translate-expression (instanceof-expr expr)) (instanceof-type expr) @@ -2541,7 +2540,7 @@ (create-syntax #f `(c:contract ,(type->contract expr-type #t) ,expr (quote ,(string->symbol (class-name))) '||) (build-src src)) expr-type) - (build-src src))) + (build-src src))) ((symbol? (type-spec-name type)) (make-syntax #f `(javaRuntime:cast-primitive ,expr (quote ,(type-spec-name type)) ,(type-spec-dim type)) (build-src src))) diff --git a/collects/profj/types.ss b/collects/profj/types.ss index 75621cf562..04e69ad865 100644 --- a/collects/profj/types.ss +++ b/collects/profj/types.ss @@ -1,10 +1,12 @@ (module types mzscheme - (require (lib "etc.ss") - (lib "pretty.ss") - (lib "list.ss") - (lib "class.ss") - "ast.ss") + (require + (only (lib "1.ss" "srfi") lset-intersection) + (lib "etc.ss") + (lib "pretty.ss") + (lib "list.ss") + (lib "class.ss") + "ast.ss") (provide (all-defined-except sort number-assign-conversions remove-dups meth-member? generate-require-spec)) @@ -57,6 +59,11 @@ (unknown-ref? x) (ref-type? x) (memq x `(null string))))) + + ;;reference-or-array-type: 'a -> boolean + (define (reference-or-array-type? x) + (or (reference-type? x) + (array-type? x))) ;;is-string?: 'a -> boolean (define (is-string-type? s) @@ -162,6 +169,64 @@ (else (widening-ref-conversion to from type-recs)))) + ;castable?: reference-type reference-type type-records -> boolean + (define (castable? from to type-recs) + (or (dynamic-val? from) + (dynamic-val? to) + (eq? 'dynamic to) + (eq? 'null from) + (eq? 'null to) + (let ((from-record (and (not (array-type? from)) (send type-recs get-class-record from))) + (to-record (and (not (array-type? to)) + (get-record (send type-recs get-class-record to) type-recs)))) + (cond + ((and to-record from-record + (class-record-class? from-record) + (class-record-class? to-record)) + (or (is-eq-subclass? from to type-recs) + (is-eq-subclass? to from type-recs))) + ((and to-record from-record (class-record-class? from-record)) + (or (not (memq 'final (class-record-modifiers from-record))) + (implements? from to type-recs))) + ((and (not to-record) from-record (class-record-class? from-record)) + (type=? object-type from)) + ((and to-record from-record (class-record-class? to-record)) + (or (not (memq 'final (class-record-modifiers to-record))) + (implements? to from type-recs))) + ((and to-record from-record (not (class-record-class? to-record))) + (not (signature-conflicts? (class-record-methods to-record) + (class-record-methods from-record)))) + ((and (not from-record) to-record (class-record-class? to-record)) + (type=? object-type to)) + ((and (not from-record) to-record) + (or (type=? serializable-type to type-recs) + (type=? cloneable-type to type-recs))) + (else + (or (type=? (array-type-type to) (array-type-type from)) + (castable? (array-type-type from) + (array-type-type to)))))))) + + ;Do the two lists of method signatures have conflicting methods + ;signature-conflicts? (list method-record) (list method-record) -> bool + (define (signature-conflicts? methods1 methods2) + (let ((same-sigs (lset-intersection signature-equals? methods1 methods2)) + (same-rets (lset-intersection full-signature-equals? methods1 methods2))) + (not (= (length same-sigs) (length same-rets))))) + + ;Do the two methods have same name and argument types + ;signature-equals? method-record method-record -> bool + (define (signature-equals? m1 m2) + (and (equal? (method-record-name m1) + (method-record-name m2)) + (= (length (method-record-atypes m1)) + (length (method-record-atypes m2))) + (andmap type=? (method-record-atypes m1) (method-record-atypes m2)))) + ;Do the two methods have the same name, arguments and return types + ;full-signagure-equals? method-record method-record -> bool + (define (full-signature-equals? m1 m2) + (and (signature-equals? m1 m2) + (type=? (method-record-rtype m1) (method-record-rtype m2)))) + ;; type-spec-to-type: type-spec (U #f (list string) symbol type-records -> type (define (type-spec-to-type ts container-class level type-recs) (let* ((ts-name (type-spec-name ts)) @@ -196,12 +261,14 @@ (member (cons (ref-type-class/iface c2) (ref-type-path c2)) (class-record-parents cr)))) - ;; subclass?: (U type (list string) 'string) ref-type type-records -> boolean + ;Does c1 implement c2? + ;; implements?: (U type (list string) 'string) ref-type type-records -> boolean (define (implements? c1 c2 type-recs) (let ((cr (get-record (send type-recs get-class-record c1) type-recs))) (member (cons (ref-type-class/iface c2) (ref-type-path c2)) (class-record-ifaces cr)))) + ;;Is class1 a subclass or equal to class2? ;is-eq-subclass: type type type-records -> boolean (define (is-eq-subclass? class1 class2 type-recs) (or (type=? class1 class2)