Subtyping bugs, add more *current-expr* bindings, some anns

README.md

@@ -16,6 +16,9 @@ See `LICENSE`.
 
 # Changelog
 
+0.1.6-SNAPSHOT
+- Ensure `Result` is not introduced when performing type inference on drest fn apps
+
 0.1.5
 - Better errors for Java methods and polymorphic function applications, borrow error messages from Typed Racket
 - Change `ann-datatype`, `ann-protocol`, `ann-pprotocol` syntax to be flatter

project.clj

@@ -1,6 +1,6 @@
-(defproject typed "0.1.5"
+(defproject typed "0.1.6-SNAPSHOT"
   :description "Gradual typing for Clojure"
-  :dependencies [[analyze "0.2.4"]
+  :dependencies [[analyze "0.2.5-SNAPSHOT"]
                  [net.intensivesystems/arrows "1.3.0"
                   :exclusions [org.clojure/clojure]] ;for testing conduit, lein test wants it here?
                  [trammel "0.7.0"

src/typed/ann.clj

@@ -31,6 +31,22 @@
                            [[x -> Any :filters {:else (is y 0)}] (Option (Seqable x)) -> (Seqable y)]))
 
 
+(ann clojure.core/take-while (All [x y]
+                               [[x -> Any :filters {:then (is y 0)}] (Option (Seqable x)) -> (Seqable y)]))
+(ann clojure.core/drop-while (All [x]
+                               [[x -> Any] (Option (Seqable x)) -> (Seqable x)]))
+
+(ann clojure.core/split-with 
+     (All [x y z] [[x -> Any :filters {:then (is y 0), :else (is z 0)}] (tc/Option (Seqable x)) 
+                   -> '[(Seqable y) (Seqable z)]]))
+
+
+(ann clojure.core/repeatedly 
+     (All [x]
+          (Fn [[-> x] -> (LazySeq x)]
+              [[-> x] tc/AnyInteger -> (LazySeq x)])))
+
+
 (ann clojure.core/some (All [x y] [[x -> y] (Option (Seqable x)) -> (Option y)]))
 
 (ann clojure.core/concat (All [x] [(Option (Seqable x)) * -> (Seqable x)]))
@@ -42,14 +58,6 @@
 (ann clojure.core/not [Any -> boolean])
 (ann clojure.core/constantly (All [x y] [x -> [y * -> x]]))
 
-(ann clojure.core/take-while 
-     (All [x] 
-          [[x -> Any] (Option (Seqable x)) -> (Seqable x)]))
-
-(ann clojure.core/drop-while
-     (All [x] 
-          [[x -> Any] (Option (Seqable x)) -> (Seqable x)]))
-
 (ann clojure.core/disj
      (All [x]
           (Fn [(I (APersistentSet x) Sorted) Any Any * -> (I (APersistentSet x) Sorted)]
@@ -62,6 +70,10 @@
        (Fn [(IPersistentMap b c) b c -> (IPersistentMap b c)]
            [(IPersistentVector d) AnyInteger d -> (IPersistentVector d)])))
 
+(ann clojure.core/zipmap
+     (All [k v]
+       [(U nil (Seqable k)) (U nil (Seqable v)) -> (APersistentMap k v)]))
+
 (comment
   (aget my-array 0 1 2)
   (aget (aget my-array 0) 1 2)

src/typed/check.clj

@@ -733,7 +733,7 @@
                                      ;; in filters/objects).
                                      (let [substitution (cond
                                                           drest (infer-dots (zipmap fixed-vars fixed-bnds) dotted-var dotted-bnd
-                                                                            arg-types dom (:pre-type drest) rng (fv rng)
+                                                                            arg-types dom (.pre-type drest) (Result-type* rng) (fv rng)
                                                                             :expected (and expected (ret-t expected)))
                                                           rest (infer-vararg (zipmap fixed-vars fixed-bnds) {dotted-var dotted-bnd}
                                                                              arg-types dom rest (Result-type* rng)
@@ -1341,6 +1341,7 @@
       :else ::not-special)))
 
 ;assoc
+; TODO handle unions of hmaps as the target
 (defmethod invoke-special #'clojure.core/assoc
   [{:keys [args] :as expr} & [expected]]
   {:post [(-> % expr-type TCResult?)]}
@@ -1370,6 +1371,7 @@
         ckeyvals (doall (map check keyvals))
         keypair-types (partition 2 (map (comp ret-t expr-type) ckeyvals))
 
+        ; TODO handle unions of hmaps without promoting to IPersistentMap
         new-hmaps (mapv #(reduce (fn [hmap [kt vt]]
                                    (let [is-vec (subtype? hmap (RClass-of IPersistentVector [-any]))
                                          is-map (subtype? hmap (RClass-of IPersistentMap [-any -any]))]
@@ -1409,7 +1411,7 @@
                         hmaps)]
     (assoc expr
            expr-type (ret (apply Un new-hmaps)
-                          (-FS -top -bot)
+                          (-FS -top -bot) ;assoc never returns nil
                           -empty))))
 
 
@@ -1954,8 +1956,13 @@
 (defmethod check :do
   [{:keys [exprs] :as expr} & [expected]]
   {:post [(TCResult? (expr-type %))]}
-  (let [cexprs (concat (mapv check (butlast exprs))
-                       [(check (last exprs) expected)])]
+  (let [cexprs (concat (doall
+                         (for [stmtexpr (butlast exprs)]
+                           (binding [*current-expr* stmtexpr]
+                             (check stmtexpr))))
+                       (let [lexpr (last exprs)]
+                         (binding [*current-expr* lexpr]
+                           [(check lexpr  expected)])))]
     (assoc expr
            :exprs cexprs
            expr-type (-> cexprs last expr-type)))) ;should be a ret already
@@ -2215,9 +2222,10 @@
                        :post [(PropEnv? env)]}
                       (let [{:keys [t fl o]} (->
                                                (expr-type
-                                                 (with-lexical-env env
-                                                   (*check-let-checkfn* init (when is-loop
-                                                                               (ret expected-bnd)))))
+                                                 (binding [*current-expr* init]
+                                                   (with-lexical-env env
+                                                     (*check-let-checkfn* init (when is-loop
+                                                                                 (ret expected-bnd))))))
                                                ;substitute previous references to sym with an empty object,
                                                ;as old binding is shadowed
                                                (update-in [:t] subst-type sym -empty true)
@@ -2256,7 +2264,8 @@
                 (if is-loop
                   (binding [*recur-target* (->RecurTarget expected-bnds nil nil nil)]
                     (*check-let-checkfn* body expected))
-                  (*check-let-checkfn* body expected)))
+                  (binding [*current-expr* body]
+                    (*check-let-checkfn* body expected))))
 
         ;now we return a result to the enclosing scope, so we
         ;erase references to any bindings this scope introduces
@@ -2605,7 +2614,7 @@
 (defmethod check :if
   [{:keys [test then else] :as expr} & [expected]]
   {:post [(-> % expr-type TCResult?)]}
-  (let [ctest (binding [*current-expr* expr]
+  (let [ctest (binding [*current-expr* test]
                 (check test))]
     (assoc expr
            expr-type (binding [*check-if-checkfn* check]

src/typed/subtype.clj

@@ -483,37 +483,25 @@
                                       polyl?
                                       polyr?))))))))
 
-; Class -> {:up Class :down Class}
-; up : is it safe to use this primitive type in place of up
-; down : whereever down is, we can replace it with primitive
-(def primitive-coersions
-  {Byte/TYPE {:up #{Byte}
-              :down #{Byte}}
-   Short/TYPE {:up #{Short Integer Long Float Double}
-               :down #{Short Integer Long}}
-   Integer/TYPE {:up #{Short Integer Long Float Double}
-                 :down #{Short Integer Long}}
-   Long/TYPE {:up #{Short Integer Long Float Double Double/TYPE}
-              :down #{Short Integer Long}}
-   Float/TYPE {:up #{Float Double}
-               :down #{Float Double}}
-   Double/TYPE {:up #{Float Double}
-                :down #{Float Double}}
-   Character/TYPE {:up #{Character}
-                   :down #{Character}}
-   Boolean/TYPE {:up #{Boolean}
-                 :down #{Boolean}}})
+(def boxed-primitives
+  {Byte/TYPE Byte
+   Short/TYPE Short
+   Integer/TYPE Integer
+   Long/TYPE Long
+   Float/TYPE Float
+   Double/TYPE Double
+   Character/TYPE Character
+   Boolean/TYPE Boolean})
 
 (defn coerse-RClass-primitive
   [s t]
-  (let [scls (symbol->Class (:the-class s))
-        tcls (symbol->Class (:the-class t))]
-    (cond
-      (.isPrimitive ^Class scls)
-      (-> (primitive-coersions scls) :up (get tcls))
-
-      (.isPrimitive ^Class tcls)
-      (-> (primitive-coersions tcls) :down (get scls)))))
+  (let [spcls (symbol->Class (:the-class s))
+        tpcls (symbol->Class (:the-class t))
+        scls (or (boxed-primitives spcls)
+                 spcls)
+        tcls (or (boxed-primitives tpcls)
+                  tpcls)]
+    (isa? scls tcls)))
 
 (defmethod subtype* [RClass RClass ::clojure]
   [{polyl? :poly? :as s}

test/typed/test/core.clj

@@ -240,7 +240,7 @@
   (is (subtype? (ety
                   ((typed.core/fn> [[a :- (clojure.lang.IPersistentMap Any Number)] [b :- Number]] 
                                    ((typed.core/inst get Number) a b))
-                     {:a 1} 1))
+                     (zipmap [1] [2]) 1))
                 (parse-type '(U nil Number)))))
 
 (deftest get-special-test
@@ -263,8 +263,8 @@
          (ret (->Value 1) (-FS -top -bot) (->EmptyObject)))))
 
 (deftest empty-fn-test
-  (is (do (prn "empty-fn-test" @typed.core/TYPED-IMPL)
-        (= (tc-t (fn []))
+  (is (do (prn *ns*)
+        (= (tc-t (clojure.core/fn []))
            (ret (make-FnIntersection
                   (->Function [] (make-Result -nil
                                               (-FS -bot -top)
@@ -733,6 +733,7 @@
          (ret (-hmap {(->Value :a) (->Value :b)})
               (-FS -top -bot)
               -empty)))
+  ;see `invoke-special` for assoc for TODO
   (is (= (-> (tc-t (-> (fn [m]
                          (assoc m :c 1))
                      (typed.core/ann-form [typed.test.core/SomeMap -> (U '{:a ':b :c '1}
@@ -932,7 +933,7 @@
   (is (= (tc-t (Exception. "a"))
          (ret (RClass-of Exception)
               (-FS -top -bot)
-              (->NoObject)))))
+              (->EmptyObject)))))
 
 (deftest tc-throw-test
   (is (= (:t (tc-t (throw (Exception. "a"))))
@@ -1063,3 +1064,7 @@
 
 (deftest hmap-subtype
   (is (cf {} (clojure.lang.APersistentMap Any Any))))
+
+(comment
+(run-tests)
+  )