Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Fix filter conjunction constructor. Closes CTYP-23

  • Loading branch information...
commit 87040592b383436bf37bd3908727335f3d29e2b3 1 parent 9f5b432
@frenchy64 frenchy64 authored
View
126 src/main/clojure/clojure/core/typed/filter_ops.clj
@@ -306,69 +306,71 @@
; A ^ (B v ...) -> (simplify A (B v ...))
-(defn -and [& args]
- ;flatten direct internal AndFilters
- (let [flat (apply concat
- (for [fl args]
- (if (AndFilter? fl)
- (:fs fl)
- [fl])))
- fs (set flat)]
- (cond
- (empty? fs) -bot
- (fs -bot) -bot
- (or (= 1 (count fs))
- (= 1 (count (disj fs -top)))) (or (first (disj fs -top))
- (first fs))
- :else (->AndFilter (disj fs -top)))))
-
;(defn -and [& args]
-; {:pre [(every? Filter? args)]
-; :post [(Filter? %)]}
-; (letfn [(mk [& fs]
-; {:pre [(every? Filter? fs)]
-; :post [(Filter? %)]}
-; (cond
-; (empty? fs) -top
-; (= 1 (count fs)) (first fs)
-; :else (->AndFilter fs)))]
-; (loop [fs (set args)
-; result nil]
-; (if (empty? fs)
-; (cond
-; (empty? result) -top
-; (= 1 (count result)) (first result)
-; ;; don't think this is useful here
-; (= 2 (count result)) (let [[f1 f2] result]
-; (if (opposite? f1 f2)
-; -bot
-; (if (= f1 f2)
-; f1
-; (apply mk (compact [f1 f2] false)))))
-; :else
-; ;; first, remove anything implied by the atomic propositions
-; ;; We commonly see: (And (Or P Q) (Or P R) (Or P S) ... P), which this fixes
-; (let [{atomic true not-atomic false} (group-by atomic-filter? result)
-; not-atomic* (for [p not-atomic
-; :when (some (fn [a] (implied-atomic? p a)) atomic)]
-; p)]
-; ;; `compact' takes care of implications between atomic props
-; (apply mk (compact (concat not-atomic* atomic) false))))
-; (let [ffs (first fs)]
-; (cond
-; (BotFilter? ffs) ffs
-; (AndFilter? ffs) (let [fs* (:fs ffs)]
-; (recur (next fs) (concat fs* result)))
-; (TopFilter? ffs) (recur (next fs) result)
-; :else (let [t ffs]
-; (cond
-; (some (fn [f] (opposite? f ffs)) (concat (rest fs) result))
-; -bot
-; (some (fn [f] (or (= f t)
-; (implied-atomic? t f))) result)
-; (recur (rest fs) result)
-; :else
-; (recur (rest fs) (cons t result))))))))))
+; ;flatten direct internal AndFilters
+; (let [flat (apply concat
+; (for [fl args]
+; (if (AndFilter? fl)
+; (:fs fl)
+; [fl])))
+; fs (set flat)]
+; (cond
+; (empty? fs) -bot
+; (fs -bot) -bot
+; (or (= 1 (count fs))
+; (= 1 (count (disj fs -top)))) (or (first (disj fs -top))
+; (first fs))
+; :else (->AndFilter (disj fs -top)))))
+
+(declare implied-atomic?)
+
+(defn -and [& args]
+ {:pre [(every? Filter? args)]
+ :post [(Filter? %)]}
+ (letfn [(mk [& fs]
+ {:pre [(every? Filter? fs)]
+ :post [(Filter? %)]}
+ (cond
+ (empty? fs) -top
+ (= 1 (count fs)) (first fs)
+ :else (->AndFilter (set fs))))]
+ (loop [fs (set args)
+ result nil]
+ (if (empty? fs)
+ (cond
+ (empty? result) -top
+ (= 1 (count result)) (first result)
+ ;; don't think this is useful here
+ (= 2 (count result)) (let [[f1 f2] result]
+ (if (opposite? f1 f2)
+ -bot
+ (if (= f1 f2)
+ f1
+ (apply mk (compact [f1 f2] false)))))
+ :else
+ ;; first, remove anything implied by the atomic propositions
+ ;; We commonly see: (And (Or P Q) (Or P R) (Or P S) ... P), which this fixes
+ (let [{atomic true not-atomic false} (group-by atomic-filter? result)
+ not-atomic* (for [p not-atomic
+ :when (some (fn [a] (implied-atomic? p a)) atomic)]
+ p)]
+ ;; `compact' takes care of implications between atomic props
+ (apply mk (compact (concat not-atomic* atomic) false))))
+ (let [ffs (first fs)]
+ (cond
+ (BotFilter? ffs) ffs
+ (AndFilter? ffs) (let [fs* (:fs ffs)]
+ (recur (next fs) (concat fs* result)))
+ (TopFilter? ffs) (recur (next fs) result)
+ :else (let [t ffs]
+ (cond
+ (some (fn [f] (opposite? f ffs)) (concat (rest fs) result))
+ -bot
+ (some (fn [f] (or (= f t)
+ (implied-atomic? t f))) result)
+ (recur (rest fs) result)
+ :else
+ (recur (rest fs) (cons t result))))))))))
(defn -FS [+ -]
{:pre [(Filter? +)
View
3  src/test/clojure/clojure/core/typed/test/core.clj
@@ -1216,8 +1216,7 @@
(adder [_ i] (Accumulator. (+ t i))))))))
;;;;
-;TODO CTYP-23
-#_(deftest let-filter-unscoping-test
+(deftest let-filter-unscoping-test
(is (cf (fn [a]
(and (< 1 2) a))
[(U nil Number) -> Any :filters {:then (is Number 0)}])))
Please sign in to comment.
Something went wrong with that request. Please try again.