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))
(let [{:keys [type path id]} lo
[{fpth-kw :val} & rstpth] path
next-filter (fo/-filter type id rstpth)
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
(c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-filter type id rstpth)))
(:absent-keys t)
(:other-keys? t))
(c/Un
; assume key is present and update value type
(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)))

(and (fl/NotTypeFilter? lo)
(pe/KeyPE? (first (:path lo))))
(cond
(r/HeterogeneousMap? t)
(let [{:keys [type path id]} lo
[{fpth-kw :val} & rstpth] path
fpth (r/-val fpth-kw)
type-at-pth (get (:types t) fpth)]
(if type-at-pth
(c/-hmap (assoc (:types t) fpth (update type-at-pth (fo/-not-filter type id rstpth)))
(pe/KeyPE? (first (:path lo)))
(r/HeterogeneousMap? t))
(let [{:keys [type path id]} lo
[{fpth-kw :val} & rstpth] path
fpth (r/-val fpth-kw)
next-filter (fo/-not-filter type id rstpth)
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 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)
(:other-keys? t))
(c/Un)))
; looking up something that isn't an ILookup, therefore will always result in nil
(not (sub/subtype? t (c/RClass-of clojure.lang.ILookup [r/-any r/-any])))
(update r/-nil (update-in lo [:path] rest))

:else 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)))

; 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)
(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 absent-keys other-keys?]
(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
(seq (set/intersection (set (keys types)) (set absent-keys))))
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
(apply sub/subtype? rs)))

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

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

(deftest path-update-test
(is-clj (clj (= (update (Un -nil (-hmap {(-val :foo) (RClass-of Number)}))
(-not-filter (Un -false -nil) 'id [(->KeyPE :foo)]))
(-hmap {(-val :foo) (RClass-of Number)}))))
(is-clj
(both-subtype? (clj (update (Un -nil (-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
; TODO
#_(is-clj (= (update (-hmap {})
(-filter -nil 'id [(->KeyPE :foo)]))
(make-HMap {} {(-val :foo) -nil}))))
(is-clj (both-subtype? (update (-hmap {})
(-filter -nil 'id [(->KeyPE :foo)]))
(make-HMap {} {(-val :foo) -nil}))))

(deftest multimethod-test
(is (check-ns 'clojure.core.typed.test.mm)))
Expand Down Expand Up @@ -1918,6 +1926,65 @@
(is (cf (map inc [1 2 3])
(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
(deftest absent-keys-test
(is (not (sub? (HMap :mandatory {:a String}
Expand Down

0 comments on commit ad9c176

Please sign in to comment.