Permalink
Browse files

Fix invoke-apply multimethod. Test for (apply hash-map ..)

  • Loading branch information...
1 parent dd2cf6b commit c446ac40ffd3bbc500e646176fc8974d68a06bf2 @frenchy64 frenchy64 committed Mar 6, 2014
@@ -1347,7 +1347,7 @@
(u/add-defmethod-generator invoke-special)
(defmulti invoke-apply (fn [expr & args]
- (when-let [var (-> expr :fexpr :var)]
+ (when-let [var (-> expr :args first :var)]
(u/var->symbol var))))
(u/add-defmethod-generator invoke-apply)
@@ -2217,15 +2217,16 @@
(assoc expr
expr-type (ret (c/KwArgsSeq->HMap (-> (expr-type (last cargs)) ret-t))))
- (and ((some-fn r/HeterogeneousVector? r/HeterogeneousList? r/HeterogeneousSeq?)
- (expr-type (last cargs)))
+ (and (seq cargs)
+ ((some-fn r/HeterogeneousVector? r/HeterogeneousList? r/HeterogeneousSeq?)
+ (ret-t (expr-type (last cargs))))
;; every key must be a Value
- (every? r/Value? (keys (apply hash-map (concat (map expr-type (butlast cargs))
- (mapcat vector (:types (expr-type (last cargs)))))))))
+ (every? r/Value? (keys (apply hash-map (concat (map (comp ret-t expr-type) (butlast cargs))
+ (mapcat vector (:types (ret-t (expr-type (last cargs))))))))))
(assoc expr
expr-type (ret (c/-complete-hmap
- (apply hash-map (concat (map expr-type (butlast cargs))
- (mapcat vector (:types (expr-type (last cargs)))))))))
+ (apply hash-map (concat (map (comp ret-t expr-type) (butlast cargs))
+ (mapcat vector (:types (ret-t (expr-type (last cargs))))))))))
:else ::not-special)))
(defn invoke-nth [{:keys [args] :as expr} expected & {:keys [cargs]}]
@@ -3008,6 +3008,13 @@
String)
String))
+(deftest apply-hmap-test
+ (is-cf (apply hash-map [:a 1 :b 2])
+ (HMap :mandatory {:a Number
+ :b Number}
+ :complete? true)))
+
+
;(deftest collect-on-eval-test
; (is (do (ann foo-bar Number)
; (cf (def foo-bar 1))

0 comments on commit c446ac4

Please sign in to comment.