Skip to content

Commit

Permalink
Fix CTYP-53. HMap is less eager to simplify to Nothing incorrectly.
Browse files Browse the repository at this point in the history
  • Loading branch information
@frenchy64
frenchy64 committed Sep 15, 2013
1 parent 0e6d4c4 commit ad9c176
Show file tree
Hide file tree
Showing 3 changed files with 143 additions and 27 deletions.
87 changes: 68 additions & 19 deletions src/main/clojure/clojure/core/typed/check.clj
View file
Expand Up @@ -3999,33 +3999,82 @@
(r/HeterogeneousMap? t)) (r/HeterogeneousMap? t))
(let [{:keys [type path id]} lo (let [{:keys [type path id]} lo
[{fpth-kw :val} & rstpth] path [{fpth-kw :val} & rstpth] path
next-filter (fo/-filter type id rstpth)
fpth (r/-val fpth-kw) fpth (r/-val fpth-kw)
type-at-pth (get (:types t) fpth)] present? (contains? (:types t) fpth)
absent? (when-not present?
(or ; absent if in :absent-keys
(contains? (:absent-keys t) fpth)
; absent if no other keys
(not (:other-keys? t))))
type-at-pth (or (get (:types t) fpth)
(when-not absent?
r/-any))]
;updating a positive KeyPE should consider 3 cases:
; 1. the key is declared present
; 2. the key is not declared present, and is not declared absent
; 3. the key is declared absent
(if type-at-pth (if type-at-pth
(c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-filter type id rstpth))) (c/Un
(:absent-keys t) ; assume key is present and update value type
(:other-keys? t)) (c/-hmap (assoc (:types t) fpth (update type-at-pth next-filter))
(:absent-keys t)
(:other-keys? t))
(let [val-maybe-nil? (not (r/Bottom? (update r/-nil next-filter)))]
; is there any situation where the value could be nil?
(if val-maybe-nil?
; if yes, assume key is absent.
; handles (:a {}) => nil
(c/-hmap (:types t)
(conj (:absent-keys t) fpth)
(:other-keys? t))
; otherwise, don't add to type
(c/Un))))
(c/Un))) (c/Un)))


(and (fl/NotTypeFilter? lo) (and (fl/NotTypeFilter? lo)
(pe/KeyPE? (first (:path lo)))) (pe/KeyPE? (first (:path lo)))
(cond (r/HeterogeneousMap? t))
(r/HeterogeneousMap? t) (let [{:keys [type path id]} lo
(let [{:keys [type path id]} lo [{fpth-kw :val} & rstpth] path
[{fpth-kw :val} & rstpth] path fpth (r/-val fpth-kw)
fpth (r/-val fpth-kw) next-filter (fo/-not-filter type id rstpth)
type-at-pth (get (:types t) fpth)] present? (contains? (:types t) fpth)
(if type-at-pth absent? (when-not present?
(c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-not-filter type id rstpth))) (or ; absent if in :absent-keys
(contains? (:absent-keys t) fpth)
; absent if no other keys
(not (:other-keys? t))))
type-at-pth (or (get (:types t) fpth)
(when-not absent?
r/-any))]
;updating a negative KeyPE should consider 3 cases:
; 1. the key is declared present
; 2. the key is not declared present, and is not declared absent
; 3. the key is declared absent
(if type-at-pth
(c/Un
; key is present, update corresponding value
(c/-hmap (assoc (:types t) fpth (update type-at-pth next-filter))
(:absent-keys t) (:absent-keys t)
(:other-keys? t)) (:other-keys? t))
(c/Un))) (let [val-maybe-nil? (not (r/Bottom? (update r/-nil next-filter)))]
; looking up something that isn't an ILookup, therefore will always result in nil ; is there any situation where the value could be nil?
(not (sub/subtype? t (c/RClass-of clojure.lang.ILookup [r/-any r/-any]))) (if val-maybe-nil?
(update r/-nil (update-in lo [:path] rest)) ; if yes, assume key is absent.

; handles (:a {}) => nil
:else t) (c/-hmap (:types t)
(conj (:absent-keys t) fpth)
(:other-keys? t))
; otherwise, don't add to type
(c/Un))))
(c/Un)))


; nil returns nil on keyword lookups
(and (fl/NotTypeFilter? lo)
(pe/KeyPE? (first (:path lo)))
(r/Nil? t))
(update r/-nil (update-in lo [:path] rest))


(and (fl/TypeFilter? lo) (and (fl/TypeFilter? lo)
(pe/CountPE? (first (:path lo)))) (pe/CountPE? (first (:path lo))))
Expand Down
2 changes: 1 addition & 1 deletion src/main/clojure/clojure/core/typed/type_ctors.clj
View file
Expand Up @@ -69,7 +69,7 @@
([types other-keys?] (-hmap types #{} other-keys?)) ([types other-keys?] (-hmap types #{} other-keys?))
([types absent-keys other-keys?] ([types absent-keys other-keys?]
(if (or ; simplify to bottom if an entry is bottom (if (or ; simplify to bottom if an entry is bottom
(some #{bottom} (concat (keys types) (vals types))) (some #{bottom} (concat (keys types) (vals types) absent-keys))
; contradictory overlap in present/absent keys ; contradictory overlap in present/absent keys
(seq (set/intersection (set (keys types)) (set absent-keys)))) (seq (set/intersection (set (keys types)) (set absent-keys))))
bottom bottom
Expand Down
81 changes: 74 additions & 7 deletions src/test/clojure/clojure/core/typed/test/core.clj
View file
Expand Up @@ -47,6 +47,10 @@
(impl/with-clojure-impl (impl/with-clojure-impl
(apply sub/subtype? rs))) (apply sub/subtype? rs)))


(defn both-subtype? [s t]
(and (subtype? s t)
(subtype? t s)))

(defn check [& as] (defn check [& as]
(impl/with-clojure-impl (impl/with-clojure-impl
(apply chk/check as))) (apply chk/check as)))
Expand Down Expand Up @@ -1322,14 +1326,18 @@
(RClass-of String)))))) (RClass-of String))))))


(deftest path-update-test (deftest path-update-test
(is-clj (clj (= (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)})) (is-clj
(-not-filter (Un -false -nil) 'id [(->KeyPE :foo)])) (both-subtype? (clj (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
(-hmap {(-val :foo) (RClass-of Number)})))) (-filter (Un -false -nil) 'id [(->KeyPE :foo)])))
-nil))
(is-clj
(both-subtype? (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
(-not-filter (Un -false -nil) 'id [(->KeyPE :foo)]))
(-hmap {(-val :foo) (RClass-of Number)})))
; if (:foo a) is nil, either a has a :foo entry with nil, or no :foo entry ; if (:foo a) is nil, either a has a :foo entry with nil, or no :foo entry
; TODO (is-clj (both-subtype? (update (-hmap {})
#_(is-clj (= (update (-hmap {}) (-filter -nil 'id [(->KeyPE :foo)]))
(-filter -nil 'id [(->KeyPE :foo)])) (make-HMap {} {(-val :foo) -nil}))))
(make-HMap {} {(-val :foo) -nil}))))


(deftest multimethod-test (deftest multimethod-test
(is (check-ns 'clojure.core.typed.test.mm))) (is (check-ns 'clojure.core.typed.test.mm)))
Expand Down Expand Up @@ -1918,6 +1926,65 @@
(is (cf (map inc [1 2 3]) (is (cf (map inc [1 2 3])
(clojure.core.typed/NonEmptyLazySeq Number)))) (clojure.core.typed/NonEmptyLazySeq Number))))


;CTYP-53
(deftest hmap-cast-test
(is (both-subtype?
(ety
(clojure.core.typed/fn>
[m :- (HMap)]
(assert (:foo m))
m))
(parse-clj '['{} ->
'{}
:filters {:then (! (U nil false) 0)
:else (is (U nil false) 0)}
:object {:id 0}])))
(is (both-subtype?
(ety
(clojure.core.typed/fn>
:- (HMap :mandatory {:foo (clojure.core.typed/Vec Any)})
[m :- (HMap)]
(assert (vector? (:foo m)))
m))
(parse-clj '[(HMap) ->
(HMap :mandatory {:foo (clojure.core.typed/Vec Any)})
:filters {:then (! (U nil false) 0)
:else (is (U nil false) 0)}
:object {:id 0}])))
(is (both-subtype?
(ety
(clojure.core.typed/fn>
[m :- (HMap :mandatory {:bar Any})]
(assert (nil? (:foo m)))
m))
(parse-clj '[(HMap :mandatory {:bar Any}) ->
(U (HMap :mandatory {:bar Any, :foo nil})
(HMap :mandatory {:bar Any}
:absent-keys #{:foo}))
:filters {:then (! (U nil false) 0)
:else (is (U nil false) 0)}
:object {:id 0}])))
(is
(both-subtype?
(ety
(clojure.core.typed/fn>
[m :- '{}]
(assert (not (vector? (:foo m))))
m))
(parse-clj '[(HMap) ->
; not sure if this should simplify to (HMap)
(U (HMap :mandatory {:foo Any})
(HMap :absent-keys #{:foo}))
:filters {:then (! (U nil false) 0)
:else (is (U nil false) 0)}
:object {:id 0}])))
(is
(clj
(let [t1 (clj (update (parse-type '(HMap))
(parse-filter '(is (clojure.core.typed/Vec Any) m [(Key :foo)]))))
t2 (clj (parse-type '(HMap :mandatory {:foo (clojure.core.typed/Vec Any)})))]
(both-subtype? t1 t2)))))

;CTYP-60 ;CTYP-60
(deftest absent-keys-test (deftest absent-keys-test
(is (not (sub? (HMap :mandatory {:a String} (is (not (sub? (HMap :mandatory {:a String}
Expand Down

0 comments on commit ad9c176

Please sign in to comment.