suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Corrected problem with cast accepting too many programs (and ==, and cast to dynamic)

Browse Source 
svn: r1585
This commit is contained in:
Kathy Gray 2005-12-11 23:57:06 +00:00
parent 2d34d9a26c
commit 40990e30e3
4 changed files with 99 additions and 213 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/profj/check.ss
View File

@ -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

189
collects/profj/default.jinfo
View File

@ -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")))
()
())
)

7
collects/profj/to-scheme.ss
View File

@ -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)))

79
collects/profj/types.ss
View File

@ -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)