Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Detect non-overlapping classes

  • Loading branch information...
commit b25bd31a9f112fcbb8e91f0f5a765e8f9edbf9e3 1 parent 66a6a81
@frenchy64 authored
Showing with 33 additions and 7 deletions.
  1. +26 −5 src/typed/core.clj
  2. +7 −2 test/typed/test/core.clj
View
31 src/typed/core.clj
@@ -10,6 +10,7 @@
LazySeq))
(:require [analyze.core :refer [ast] :as analyze]
[clojure.set :as set]
+ [clojure.reflect :as reflect]
[clojure.string :as str]
[clojure.repl :refer [pst]]
[clojure.pprint :refer [pprint]]
@@ -510,6 +511,9 @@
(declare-type RClass)
+(defn RClass->Class [rcls]
+ (Class/forName (str (.the-class rcls))))
+
(declare RESTRICTED-CLASS instantiate-poly Class->symbol)
(defn RClass-of
@@ -1412,6 +1416,14 @@
(defn overlap [t1 t2]
(cond
(= t1 t2) true
+ ;if both are Classes, and at least one isn't an interface, then they must be subtypes to have overlap
+ (and (RClass? t1)
+ (RClass? t2)
+ (let [{t1-flags :flags} (reflect/type-reflect (RClass->Class t1))
+ {t2-flags :flags} (reflect/type-reflect (RClass->Class t2))]
+ (some (complement :interface) [t1-flags t2-flags])))
+ (or (subtype? t1 t2)
+ (subtype? t2 t1))
(or (Value? t1)
(Value? t2)) (or (subtype? t1 t2)
(subtype? t2 t1))
@@ -6172,6 +6184,7 @@
IFn [Number -> a]
IPersistentStack (IPersistentStack a)
ILookup (ILookup Number a)
+ IMeta (IMeta Any)
Associative (Associative Number a)})
(alter-class Cons [[a :variance :covariant]]
@@ -6457,6 +6470,8 @@
(ann clojure.core/set? (predicate (IPersistentSet Any)))
(ann clojure.core/vector? (predicate (IPersistentVector Any)))
(ann clojure.core/nil? (predicate nil))
+(ann clojure.core/nil? [Any -> boolean :filters {:then (is nil 0)
+ :else (! nil 0)}])
(ann clojure.core/meta (All [x]
(Fn [(IMeta x) -> x]
@@ -6668,9 +6683,13 @@
(declare ret-t ret-f ret-o)
(defn unparse-TCResult [r]
- [(unparse-type (ret-t r))
- (unparse-filter-set (ret-f r))
- (unparse-object (ret-o r))])
+ (let [t (unparse-type (ret-t r))
+ fs (unparse-filter-set (ret-f r))
+ o (unparse-object (ret-o r))]
+ (if (and (= (-FS -top -top) fs)
+ (= o -empty))
+ t
+ [t fs o])))
(defn ret
"Convenience function for returning the type of an expression"
@@ -9307,9 +9326,11 @@
(defmacro cf
"Type check a form and return its type"
([form]
- `(-> (ast ~form) check expr-type unparse-TCResult))
+ `(tc-ignore
+ (-> (ast ~form) check expr-type unparse-TCResult)))
([form expected]
- `(-> (ast (ann-form ~form ~expected)) (#(check % (ret (parse-type '~expected)))) expr-type unparse-TCResult)))
+ `(tc-ignore
+ (-> (ast (ann-form ~form ~expected)) (#(check % (ret (parse-type '~expected)))) expr-type unparse-TCResult))))
(defn check-ns
([] (check-ns (ns-name *ns*)))
View
9 test/typed/test/core.clj
@@ -703,7 +703,13 @@
(deftest overlap-test
(is (not (overlap -false -true)))
- (is (not (overlap (-val :a) (-val :b)))))
+ (is (not (overlap (-val :a) (-val :b))))
+ (is (overlap (RClass-of Number) (RClass-of Integer)))
+ (is (not (overlap (RClass-of Number) (RClass-of clojure.lang.Symbol))))
+ (is (not (overlap (RClass-of Number) (RClass-of String))))
+ (is (overlap (RClass-of clojure.lang.Seqable [-any]) (RClass-of clojure.lang.IMeta [-any])))
+ (is (overlap (RClass-of clojure.lang.Seqable [-any]) (RClass-of clojure.lang.PersistentVector [-any])))
+ )
(def-alias SomeMap (U (HMap {:a (Value :b)})
(HMap {:b (Value :c)})))
@@ -1045,4 +1051,3 @@
(deftest prims-test
(is (= (ret-t (tc-t (Math/sqrt 1)))
(parse-type 'double))))
-

0 comments on commit b25bd31

Please sign in to comment.
Something went wrong with that request. Please try again.