Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Start on generating local type arguments

  • Loading branch information...
commit 9649a7ae87d18aec6d89f1bd122d3b90057e45e5 1 parent 22aadd2
@frenchy64 authored
Showing with 39 additions and 10 deletions.
  1. +1 −1  src/typed/base.clj
  2. +19 −1 src/typed/core.clj
  3. +19 −8 test/typed/test/core.clj
View
2  src/typed/base.clj
@@ -11,7 +11,7 @@
(+T clojure.core/import [& (U Symbol IPersistentList) * -> nil])
(+T clojure.core/find-ns [Symbol -> (U nil Namespace)])
(+T clojure.core/swap! (All [x y]
- [(Atom x) [x & y * -> x] & y * -> x]))
+ [Atom [x & y * -> x] & y * -> x]))
;(+T clojure.core/swap! [Atom [Any & Any * -> Nothing] & Any * -> Nothing])
(+T clojure.core/resolve
(Fun [Symbol -> (U nil Var Class)]
View
20 src/typed/core.clj
@@ -349,7 +349,7 @@
the-type
(throw (Exception. (str "No type for " sym)))))))
-(declare ParameterisedType?)
+(declare ->ParameterisedType ParameterisedType?)
(defn typed-classes-var-contract [a]
(and (map? @a)
@@ -2516,6 +2516,24 @@
" do not match any arity in "
(unp fun-type)))
+ xs (-> fun-type tvar-binding set)
+ _ (assert (empty?
+ (set/intersection
+ (set (mapcat #(free-vars (:bnd %)) xs))
+ xs))
+ "xs cannot occur in bounds")
+
+ bnd-cons (map #(constraint-gen #{} xs % (:bnd %)) xs)
+ dom-cons (map #(constraint-gen #{} xs %1 %2)
+ arg-types
+ (concat (:dom mtched-arities)
+ (repeat (:rest-type mtched-arities))))
+
+ subst (gen-substitution mtched-arity xs (apply intersect-constraint-sets
+ (concat bnd-cons dom-cons)))
+
+ _ (prn subst)
+
_ (debug "invoke type" (unp mtched-arity))
_ (doall (map assert-subtype arg-types (concat (:dom mtched-arity)
View
27 test/typed/test/core.clj
@@ -337,6 +337,25 @@
variance)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Polymorphic calls
+
+(defmacro tc [form]
+ `(binding [*ns* (find-ns 'typed.test.core)]
+ (tc-expr (ast ~form))))
+
+(defmacro with-env [& body]
+ `(binding [*ns* (find-ns 'typed.test.core)]
+ (with-type-anns ~@body)))
+
+(deftest poly-call-test
+ (is (= (with-env
+ {id (All [x] [x -> x])}
+ (tc
+ (do (declare id)
+ (id 1))))
+ (parse 1))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Equality
(deftest eq-tvar
@@ -710,14 +729,6 @@
(is (subfrm (do 2 1)
1)))
-(defmacro tc [form]
- `(binding [*ns* (find-ns 'typed.test.core)]
- (tc-expr (ast ~form))))
-
-(defmacro with-env [& body]
- `(binding [*ns* (find-ns 'typed.test.core)]
- (with-type-anns ~@body)))
-
(deftest tc-expr-def
(is (subfrm (def a)
Var))
Please sign in to comment.
Something went wrong with that request. Please try again.