Skip to content
Browse files

Add cases to subtype relation for Object

  • Loading branch information...
1 parent 8fd34d5 commit d61d1b7e9d8926145ef85a7bedf14ab9b479c34d @frenchy64 committed Apr 18, 2012
Showing with 62 additions and 26 deletions.
  1. +42 −22 src/typed/core.clj
  2. +20 −4 test/typed/test/core.clj
View
64 src/typed/core.clj
@@ -10,23 +10,24 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Type Annotation
-;(+T *add-type-ann-fn* [Symbol Any -> nil])
-(def ^:dynamic
- *add-type-ann-fn*
- (fn [sym type-syn]
- [sym :- type-syn]))
-
(defmacro +T [nme type-syn]
`(*add-type-ann-fn*
~(if (namespace nme)
`'~nme
`(symbol (-> *ns* ns-name name) (name '~nme)))
'~type-syn))
+(def ^:dynamic
+ *add-type-ann-fn*
+ (fn [sym type-syn]
+ [sym :- type-syn]))
+
+(+T *add-type-ann-fn* [Symbol Any -> nil])
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typed require
-;(+T type-db-var-contract [clojure.lang.IPersistentMap -> Boolean])
+(+T type-db-var-contract [clojure.lang.IPersistentMap -> Boolean])
(defn ns-deps-contract [m]
(and (every? symbol? (keys m))
(every? set? (vals m))
@@ -895,7 +896,7 @@
;; TODO Type variables
-(declare supertype-of-all subtype-of-all supertype-of-one)
+(declare supertype-of-all subtype-of-all supertype-of-one subtype-of-one)
(defmulti subtype?* (fn [s t]
[(class s) (class t)]))
@@ -920,7 +921,7 @@
(defmethod subtype?* [Type Union]
[s t]
- (subtype-of-all s (:types t)))
+ (subtype-of-one s (:types t)))
(defmethod subtype?* [Union Type]
[s t]
@@ -980,8 +981,9 @@
(defmethod subtype?* [PrimitiveClass ClassType]
[{s-pclass :the-class :as s}
{t-class :the-class :as t}]
- (-> (coersions s-pclass)
- (contains? t-class)))
+ (or (subtype? (->ClassType Object) t)
+ (-> (coersions s-pclass)
+ (contains? t-class))))
(defmethod subtype?* [ClassType PrimitiveClass]
[{s-class :the-class :as s}
@@ -992,8 +994,8 @@
;function
(defmethod subtype?* [Fun ClassType]
- [s {t-class :the-class :as t}]
- (isa? t-class clojure.lang.IFn))
+ [s t]
+ (subtype? (->ClassType clojure.lang.IFn) t))
(defmethod subtype?* [Fun Fun]
[{s-arities :arities} {t-arities :arities}]
@@ -1093,8 +1095,8 @@
(derive c AnyMap))
(defmethod subtype?* [AnyMap ClassType]
- [s {t-class :the-class :as t}]
- (isa? t-class IPersistentMap))
+ [s t]
+ (subtype? (->ClassType IPersistentMap) t))
(defmethod subtype?* [Map Map]
[{s-ktype :ktype s-vtype :vtype :as s}
@@ -1131,10 +1133,15 @@
[s t]
false)
+(defn subtype-of-one
+ "True if s is a subtype to at least one ts"
+ [s ts]
+ (boolean (some #(subtype? s %) ts)))
+
(defn supertype-of-one
"True if t is a supertype to at least one ss"
[t ss]
- (some #(subtype? % t) ss))
+ (boolean (some #(subtype? % t) ss)))
(defn subtype-of-all
"True if s is subtype of all ts"
@@ -1326,7 +1333,7 @@
(defn- invoke-type [arg-types {:keys [arities] :as fun-type}]
(let [dummy-arity (map->arity
{:dom arg-types
- :rng Nothing})
+ :rng Any})
mtched-arity (first (filter #(subtype? % dummy-arity)
arities))
@@ -1386,8 +1393,7 @@
;static-method
-(defmethod tc-expr :static-method
- [{:keys [method] :as expr} & opts]
+(defn tc-method [{:keys [method] :as expr}]
(let [method-type (method->Fun method)
{cargs :args
:as expr}
@@ -1397,6 +1403,18 @@
type-key (invoke-type (map type-key cargs)
method-type))))
+(defmethod tc-expr :static-method
+ [{:keys [method method-name] :as expr} & opts]
+ (assert method (str "Unresolvable static method " method-name))
+ (tc-method expr))
+
+;instance-method
+
+(defmethod tc-expr :instance-method
+ [{:keys [method method-name] :as expr} & opts]
+ (assert method (str "Unresolvable instance method " method-name))
+ (tc-method expr))
+
;static-field
;(+T field->Type [java.lang.reflect.Field -> Type]
@@ -1407,14 +1425,16 @@
(->ClassType cls))))
(defmethod tc-expr :static-field
- [{:keys [field] :as expr} & opts]
+ [{:keys [field field-name] :as expr} & opts]
+ (assert field (str "Unresolvable static field " field-name))
(assoc expr
type-key (field->Type field)))
;instance-field
(defmethod tc-expr :instance-field
- [{:keys [field] :as expr} & opts]
+ [{:keys [field field-name] :as expr} & opts]
+ (assert field (str "Unresolvable instance field " field-name))
(assoc expr
type-key (field->Type field)))
;map
@@ -1477,6 +1497,6 @@
(tc-expr (+ 1 1))
- (check-namespace 'typed-clojure.example.typed)
+ (check-namespace 'typed.example.typed)
)
View
24 test/typed/test/core.clj
@@ -18,6 +18,16 @@
(deftest subtype-unit
(is (sub? Unit Unit)))
+(deftest subtype-any
+ (is (sub? [1 -> 1] Any))
+ (is (sub? Long Any)))
+
+(deftest subtype-object
+ (is (sub? [1 -> 1] Object))
+ (is (sub? long Object))
+ (is (sub? float Object))
+ (is (sub? Object Object)))
+
(deftest subtype-classes
(is (sub? Long Long))
(is (sub? Long Object))
@@ -65,7 +75,10 @@
(is (sub? [Long -> 1]
[1 -> Long]))
(is (sub? [Object Long -> 1]
- [Long Long -> Long])))
+ [Long Long -> Long]))
+ (is (sub? [Long -> Long]
+ [1 -> Any]
+ )))
(deftest subtype-varargs
(is (sub? [Number & Object * -> Boolean]
@@ -330,10 +343,13 @@
(. Integer TYPE)
Class)))
-(deftest tc-instance-field
+(deftest tc-instance-method
(is (subfrm
- (.getClass 1)
- Class)))
+ (.getClass "a")
+ (U nil Class))))
+
+;; TODO find instance field to test
+(deftest tc-instance-field)
(deftest tc-map
(is (subfrm

0 comments on commit d61d1b7

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