Simplify how we add props after tc-if.
This commit is contained in:
parent
1dc33167c2
commit
62b41b39e7
|
@ -34,10 +34,8 @@
|
|||
(let*-values ([(flag+ flag-) (values (box #t) (box #t))])
|
||||
(match-let* ([env-thn (env+ (lexical-env) (list fs+) flag+)]
|
||||
[env-els (env+ (lexical-env) (list fs-) flag-)]
|
||||
[new-thn-props (filter (λ (e) (and (atomic-filter? e) (not (memq e (env-props (lexical-env))))))
|
||||
(env-props env-thn))]
|
||||
[new-els-props (filter (λ (e) (and (atomic-filter? e) (not (memq e (env-props (lexical-env))))))
|
||||
(env-props env-els))])
|
||||
[new-thn-props (env-props env-thn)]
|
||||
[new-els-props (env-props env-els)])
|
||||
|
||||
|
||||
(define results-t (with-lexical-env env-thn (tc thn (unbox flag+))))
|
||||
|
@ -92,8 +90,8 @@
|
|||
-top-filter]
|
||||
[((FilterSet: f2+ f2-) (FilterSet: f3+ f3-))
|
||||
;(printf "f2- ~a f+ ~a\n" f2- fs+)
|
||||
(-FS (-or (apply -and fs+ f2+ new-thn-props) (apply -and fs- f3+ new-els-props))
|
||||
(-or (apply -and fs+ f2- new-thn-props) (apply -and fs- f3- new-els-props)))])]
|
||||
(-FS (-or (apply -and f2+ new-thn-props) (apply -and f3+ new-els-props))
|
||||
(-or (apply -and f2- new-thn-props) (apply -and f3- new-els-props)))])]
|
||||
[type (Un t2 t3)]
|
||||
[object (if (object-equal? o2 o3) o2 -empty-obj)])
|
||||
;(printf "result filter is: ~a\n" filter)
|
||||
|
|
|
@ -128,6 +128,7 @@
|
|||
;; Smart constructor for make-ImpFilter
|
||||
(define (-imp p1 p2)
|
||||
(match* (p1 p2)
|
||||
[(t t) -top]
|
||||
[((Bot:) _) -top]
|
||||
[(_ (Top:)) -top]
|
||||
[((Top:) _) p2]
|
||||
|
|
|
@ -477,7 +477,7 @@
|
|||
[tc-e (let: ([x : Number 5]) x) -Number]
|
||||
[tc-e (let-values ([(x) 4]) (+ x 1)) -PosIndex]
|
||||
[tc-e (let-values ([(#{x : Number} #{y : Boolean}) (values 3 #t)]) (and (= x 1) (not y)))
|
||||
-Boolean]
|
||||
#:ret (ret -Boolean -false-filter)]
|
||||
[tc-e/t (values 3) -PosByte]
|
||||
[tc-e (values) #:ret (ret null)]
|
||||
[tc-e (values 3 #f) #:ret (ret (list -PosByte (-val #f)) (list -true-filter -false-filter))]
|
||||
|
@ -689,11 +689,11 @@
|
|||
[tc-e (let* ([sym 'squarf]
|
||||
[x (if (= 1 2) 3 sym)])
|
||||
(if (eq? x sym) 3 x))
|
||||
-PosByte]
|
||||
#:ret (ret -PosByte -true-filter)]
|
||||
[tc-e (let* ([sym 'squarf]
|
||||
[x (if (= 1 2) 3 sym)])
|
||||
(if (eq? sym x) 3 x))
|
||||
-PosByte]
|
||||
#:ret (ret -PosByte -true-filter)]
|
||||
;; equal? as predicate for symbols
|
||||
[tc-e (let: ([x : (Un 'foo Number) 'foo])
|
||||
(if (equal? x 'foo) 3 x))
|
||||
|
@ -705,11 +705,11 @@
|
|||
[tc-e (let* ([sym 'squarf]
|
||||
[x (if (= 1 2) 3 sym)])
|
||||
(if (equal? x sym) 3 x))
|
||||
-PosByte]
|
||||
#:ret (ret -PosByte -true-filter)]
|
||||
[tc-e (let* ([sym 'squarf]
|
||||
[x (if (= 1 2) 3 sym)])
|
||||
(if (equal? sym x) 3 x))
|
||||
-PosByte]
|
||||
#:ret (ret -PosByte -true-filter)]
|
||||
|
||||
[tc-e (let: ([x : (Listof Symbol)'(a b c)])
|
||||
(cond [(memq 'a x) => car]
|
||||
|
|
Loading…
Reference in New Issue
Block a user