Permalink
Browse files

Fix type resolution when checking a different namespace (CTYP-19)

  • Loading branch information...
1 parent 70d3fa0 commit 0d195fbc879f5e62051ec922ffbd2c8ada4a194a @frenchy64 frenchy64 committed Mar 29, 2013
View
@@ -1,3 +1,7 @@
+0.1.11
+- Type resolution works correctly when checking namespaces other than
+ the current one
+
0.1.10
- Added: doseq>, for>, dotimes>
- Recognise filters from macroexpansion of `and`
View
@@ -40,7 +40,7 @@
<dependency>
<groupId>org.clojure</groupId>
<artifactId>jvm.tools.analyzer</artifactId>
- <version>0.3.2</version>
+ <version>0.3.3</version>
</dependency>
<!-- for algo.monads -->
<dependency>
View
@@ -3,7 +3,7 @@
:license {:name "Eclipse Public License"
:url "http://www.eclipse.org/legal/epl-v10.html"}
- :dependencies [[org.clojure/jvm.tools.analyzer "0.3.2"
+ :dependencies [[org.clojure/jvm.tools.analyzer "0.3.3"
:exclusions [org.clojure/clojure]]
[org.clojure/core.contracts "0.0.3"
:exclusions [org.clojure/clojure]]
@@ -5,7 +5,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Checker
-(declare ret-t ret-f ret-o)
+(declare ret-t ret-f ret-o expr-ns)
;[TCResult -> Any]
(defn unparse-TCResult [r]
@@ -943,12 +943,16 @@
[javat-syn cljt-syn coll-expr] (if has-java-syn?
args
(cons nil args))
- javat (let [c (-> (or (when has-java-syn? (:val javat-syn)) ; generalise javat-syn if provided, otherwise cljt-syn
- (:val cljt-syn))
- parse-type Type->array-member-Class)]
+ javat (let [syn (or (when has-java-syn? (:val javat-syn)) ; generalise javat-syn if provided, otherwise cljt-syn
+ (:val cljt-syn))
+ c (->
+ (binding [*parse-type-in-ns* (expr-ns expr)]
+ (parse-type syn))
+ Type->array-member-Class)]
(assert (class? c))
c)
- cljt (parse-type (:val cljt-syn))
+ cljt (binding [*parse-type-in-ns* (expr-ns expr)]
+ (parse-type (:val cljt-syn)))
ccoll (check coll-expr (ret (Un -nil (RClass-of Seqable [cljt]))))]
(assoc expr
expr-type (ret (->PrimitiveArray javat cljt cljt)))))
@@ -1186,7 +1190,8 @@
(resolve-Name t)
t))
_ (assert ((some-fn Poly? PolyDots?) ptype))
- targs (doall (map parse-type (:val targs-exprs)))]
+ targs (binding [*parse-type-in-ns* (expr-ns expr)]
+ (doall (map parse-type (:val targs-exprs))))]
(assoc expr
expr-type (ret (manual-inst ptype targs)))))
@@ -1196,7 +1201,8 @@
;manual instantiation for calls to polymorphic constructors
(defmethod invoke-special #'inst-poly-ctor
[{[ctor-expr targs-exprs] :args :as expr} & [expected]]
- (let [targs (mapv parse-type (:val targs-exprs))
+ (let [targs (binding [*parse-type-in-ns* (expr-ns expr)]
+ (mapv parse-type (:val targs-exprs)))
cexpr (binding [*inst-ctor-types* targs]
(check ctor-expr))]
(assoc expr
@@ -1239,14 +1245,23 @@
;unsafe form annotation
(defmethod invoke-special #'unsafe-ann-form*
[{[frm {tsyn :val}] :args :as expr} & [expected]]
- (let [parsed-ty (parse-type tsyn)]
+ (let [parsed-ty (binding [*parse-type-in-ns* (expr-ns expr)]
+ (parse-type tsyn))]
(assoc expr
expr-type (ret parsed-ty))))
+(defn- expr-ns [expr]
+ (let [nsym (-> expr :env :ns :name symbol)
+ _ (assert nsym (str "Bug! " (:op expr) " expr has no associated namespace"))
+ ns (find-ns nsym)
+ _ (assert ns)]
+ ns))
+
;form annotation
(defmethod invoke-special #'ann-form*
[{[frm {tsyn :val}] :args :as expr} & [expected]]
- (let [parsed-ty (parse-type tsyn)
+ (let [parsed-ty (binding [*parse-type-in-ns* (expr-ns expr)]
+ (parse-type tsyn))
cty (check frm (ret parsed-ty))
checked-type (ret-t (expr-type cty))
_ (binding [*current-expr* frm]
@@ -1262,14 +1277,15 @@
[{:keys [fexpr args] :as expr} & [expected]]
(let [[fexpr {type-syns :val}] args
expected
- (apply
- make-FnIntersection
- (doall
- (for [{:keys [dom-syntax has-rng? rng-syntax]} type-syns]
- (make-Function (mapv parse-type dom-syntax)
- (if has-rng?
- (parse-type rng-syntax)
- -any)))))]
+ (binding [*parse-type-in-ns* (expr-ns expr)]
+ (apply
+ make-FnIntersection
+ (doall
+ (for [{:keys [dom-syntax has-rng? rng-syntax]} type-syns]
+ (make-Function (mapv parse-type dom-syntax)
+ (if has-rng?
+ (parse-type rng-syntax)
+ -any))))))]
(check fexpr (ret expected))))
;polymorphic fn literal
@@ -1279,12 +1295,13 @@
(let [[fexpr {poly-decl :val} {method-types-syn :val}] args
frees-with-bounds (map parse-free poly-decl)
method-types (with-bounded-frees frees-with-bounds
- (doall
- (for [{:keys [dom-syntax has-rng? rng-syntax]} method-types-syn]
- {:dom (doall (map parse-type dom-syntax))
- :rng (if has-rng?
- (parse-type rng-syntax)
- -any)})))
+ (binding [*parse-type-in-ns* (expr-ns expr)]
+ (doall
+ (for [{:keys [dom-syntax has-rng? rng-syntax]} method-types-syn]
+ {:dom (doall (map parse-type dom-syntax))
+ :rng (if has-rng?
+ (parse-type rng-syntax)
+ -any)}))))
cexpr (-> (check-anon-fn fexpr method-types :poly frees-with-bounds)
(update-in [expr-type :t] (fn [fin] (Poly* (map first frees-with-bounds)
(map second frees-with-bounds)
@@ -1312,10 +1329,9 @@
;loop
(defmethod invoke-special #'loop>-ann
- [{:keys [args env] :as expr} & [expected]]
+ [{:keys [args] :as expr} & [expected]]
(let [[expr {expected-bnds-syn :val}] args
- expected-bnds (binding [*ns* (or (-> env :ns :name find-ns)
- *ns*)]
+ expected-bnds (binding [*parse-type-in-ns* (expr-ns expr)]
(mapv parse-type expected-bnds-syn))]
;loop may be nested, type the first loop found
(binding [*loop-bnd-anns* expected-bnds]
@@ -1324,8 +1340,8 @@
;don't type check
(defmethod invoke-special #'tc-ignore-forms*
[{:keys [fexpr args] :as expr} & [expected]]
- (assoc (first args)
- expr-type (ret (->Top))))
+ (assoc expr
+ expr-type (ret -any)))
;seq
(defmethod invoke-special #'clojure.core/seq
@@ -2,6 +2,8 @@
(in-ns 'clojure.core.typed)
+(def ^:dynamic *parse-type-in-ns* nil)
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Type syntax
@@ -300,11 +302,17 @@
[[_ mandatory & {:keys [optional]}]]
(syn-to-hmap mandatory optional))
+(defn- parse-in-ns []
+ (or *parse-type-in-ns* *ns*))
+
+(defn- resolve-type [sym]
+ (ns-resolve (parse-in-ns) sym))
+
(defn parse-RClass [cls-sym params-syn]
- (let [cls (resolve cls-sym)
+ (let [cls (resolve-type cls-sym)
_ (assert (class? cls) (str cls-sym " cannot be resolved"))
tparams (doall (map parse-type params-syn))]
- (RClass-of (Class->symbol cls) tparams)))
+ (RClass-of cls tparams)))
(defmethod parse-type-list 'Value
[[_Value_ syn]]
@@ -330,7 +338,8 @@
(defmethod parse-type-list :default
[[n & args :as syn]]
- (let [res (resolve n)
+ (let [current-nstr (-> (parse-in-ns) ns-name name)
+ res (resolve-type n)
rsym (cond
(class? res) (Class->symbol res)
(var? res) (var->symbol res))]
@@ -354,8 +363,8 @@
(class? res) (RClass-of (Class->symbol res) (mapv parse-type args))
:else
;unqualified declared protocols and datatypes
- (if-let [s (let [svar (symbol (name (ns-name *ns*)) (name n))
- scls (symbol (munge (str (ns-name *ns*) \. (name n))))]
+ (if-let [s (let [svar (symbol current-nstr (name n))
+ scls (symbol (munge (str current-nstr \. (name n))))]
(some #(and (@TYPE-NAME-ENV %)
%)
[svar scls]))]
@@ -386,12 +395,13 @@
[sym]
(if-let [f (free-in-scope sym)]
f
- (let [qsym (if (namespace sym)
+ (let [current-nstr (-> (parse-in-ns) ns-name name)
+ qsym (if (namespace sym)
sym
- (symbol (-> *ns* ns-name name) (name sym)))
+ (symbol current-nstr (name sym)))
clssym (if (some #(= \. %) (str sym))
sym
- (symbol (str (munge (-> *ns* ns-name name)) \. (name sym))))]
+ (symbol (str (munge current-nstr) \. (name sym))))]
(cond
(primitives sym) (primitives sym)
(@TYPE-NAME-ENV qsym) (->Name qsym)
@@ -1259,20 +1259,9 @@
(deftest dotimes>-test
(is-cf (clojure.core.typed/dotimes> [i 100] (inc i)) nil))
-;; Records
+(defmacro is-check-ns [& args]
+ `(is (do (check-ns ~@args)
+ true)))
-(deftest typed-record-test
- (is
- (do
- ;ensure annotating in current namespace
- (ann-record MyRecord [a :- Number])
- (cf (clojure.core/defrecord MyRecord [a]
- Object
- (toString [this] nil)))))
- (is (thrown? Exception
- (clojure.core/defrecord MyRecord [a]
- Object
- (toString [this] nil))))
- (is-cf (.a ^MyRecord (->MyRecord 1)) Number)
- (is-cf (:a (->MyRecord 1)) Number)
- (is-cf (map->MyRecord {:a 2}) MyRecord))
+(deftest records-test
+ (is-check-ns 'clojure.core.typed.test.records))
@@ -1,4 +1,19 @@
(ns clojure.core.typed.test.records
- (:require [clojure.core.typed :refer [check-ns ann-record cf]]
+ (:require [clojure.core.typed :refer [check-ns ann-record ann-form]]
+ [clojure.tools.analyzer :refer [ast]]
[clojure.repl :refer [pst]]))
+(set! *warn-on-reflection* true)
+
+(ann-record MyRecord [a :- Number])
+
+(clojure.core/defrecord MyRecord [a]
+ Object
+ (toString [this] nil))
+
+(ann-form (:a (->MyRecord 1)) Number)
+(ann-form (map->MyRecord {:a 2}) MyRecord)
+
+(ann-form (let [^MyRecord r (MyRecord. 1)]
+ (.a r))
+ Number)

0 comments on commit 0d195fb

Please sign in to comment.