Remove lfilters and make true/false-filter have a - prefix.

2013-09-03 07:38:50 -07:00 · 2013-09-03 07:38:50 -07:00 · 7a7e1cbbcc
commit 7a7e1cbbcc
parent 86b3022db0
7 changed files with 27 additions and 35 deletions
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt
@ -191,16 +191,16 @@
      [(quote-syntax ((~literal typecheck-fail-internal) stx msg:str var))
       (explicit-fail #'stx #'msg #'var)]
      ;; data
-      [(quote #f) (ret (-val #f) false-filter)]
-      [(quote #t) (ret (-val #t) true-filter)]
+      [(quote #f) (ret (-val #f) -false-filter)]
+      [(quote #t) (ret (-val #t) -true-filter)]
      [(quote val)
       (match expected
         [(tc-result1: t)
-          (ret (tc-literal #'val t) true-filter)]
+          (ret (tc-literal #'val t) -true-filter)]
         [_
          (ret (tc-literal #'val #f))])]
      ;; syntax
-      [(quote-syntax datum) (ret (-Syntax (tc-literal #'datum)) true-filter)]
+      [(quote-syntax datum) (ret (-Syntax (tc-literal #'datum)) -true-filter)]
      ;; mutation!
      [(set! id val)
       (match-let* ([(tc-result1: id-t) (single-value #'id)]
@ -331,12 +331,12 @@
      [(quote-syntax ((~literal typecheck-fail-internal) stx msg var))
       (explicit-fail #'stx #'msg #'var)]
      ;; data
-      [(quote #f) (ret (-val #f) false-filter)]
-      [(quote #t) (ret (-val #t) true-filter)]
+      [(quote #f) (ret (-val #f) -false-filter)]
+      [(quote #t) (ret (-val #t) -true-filter)]

-      [(quote val)  (ret (tc-literal #'val) true-filter)]
+      [(quote val)  (ret (tc-literal #'val) -true-filter)]
      ;; syntax
-      [(quote-syntax datum) (ret (-Syntax (tc-literal #'datum)) true-filter)]
+      [(quote-syntax datum) (ret (-Syntax (tc-literal #'datum)) -true-filter)]
      ;; w-c-m
      [(with-continuation-mark e1 e2 e3)
       (define key-t (single-value #'e1))
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt
@ -119,9 +119,9 @@
    [((tc-result1: (Param: in out)) (list)) (ret out)]
    [((tc-result1: (Param: in out)) (list (tc-result1: t)))
     (if (subtype t in)
-         (ret -Void true-filter)
+         (ret -Void -true-filter)
         (tc-error/expr
-          #:return (ret -Void true-filter)
+          #:return (ret -Void -true-filter)
          "Wrong argument to parameter - expected ~a and got ~a"
          in t))]
    [((tc-result1: (Param: _ _)) _)
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt
@ -488,8 +488,8 @@
          (match expected
            [(tc-result1: t) (or (Poly? t) (PolyDots? t))]
            [_ #f]))
-      (ret (tc/plambda form (get-poly-tvarss form) formals bodies expected) true-filter)
-      (ret (tc/mono-lambda/type formals bodies expected) true-filter)))
+      (ret (tc/plambda form (get-poly-tvarss form) formals bodies expected) -true-filter)
+      (ret (tc/mono-lambda/type formals bodies expected) -true-filter)))

 ;; tc/lambda : syntax syntax-list syntax-list -> tc-result
 (define (tc/lambda form formals bodies)
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt
@ -297,10 +297,8 @@
    [(t)
     (make-pred-ty (list Univ) -Boolean t 0 null)]))

-(define true-filter (-FS -top -bot))
-(define false-filter (-FS -bot -top))
-(define true-lfilter (-FS -top -bot))
-(define false-lfilter (-FS -bot -top))
+(define -true-filter (-FS -top -bot))
+(define -false-filter (-FS -bot -top))

 (define (opt-fn args opt-args result)
  (apply cl->* (for/list ([i (in-range (add1 (length opt-args)))])
--- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/filter-ops.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/filter-ops.rkt
@ -188,9 +188,7 @@
  (match arr
    [(Function: (list (arr: dom rng rest drest kws)))
     (match rng
-       [(Values: (list (Result: tp (FilterSet: true-filter
-                                               false-filter)
-                                op)))
+       [(Values: (list (Result: tp (FilterSet: -true-filter -false-filter) op)))
        (let ([new-filters (apply -and (build-list (length dom)
                                                   (lambda (i)
                                                     (-filter type i))))])
@ -199,8 +197,8 @@
                  dom
                  (make-Values
                   (list (-result tp
-                                  (-FS (-and true-filter new-filters)
-                                       (-and false-filter new-filters))
+                                  (-FS (-and -true-filter new-filters)
+                                       (-and -false-filter new-filters))
                                  op)))
                  rest drest kws))))])]))

--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt
@ -6,8 +6,6 @@
         (rep type-rep filter-rep object-rep)
         (for-syntax (rename-in (types utils union numeric-tower abbrev filter-ops)
                                [Un t:Un]
-                                [true-lfilter -true-lfilter]
-                                [true-filter -true-filter]
                                [-> t:->]))
         (utils tc-utils utils)
         (utils mutated-vars)
--- a/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
+++ b/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/unit-tests/typecheck-tests.rkt
@ -17,8 +17,6 @@
         (rep type-rep filter-rep object-rep)
         (rename-in (types utils union numeric-tower abbrev filter-ops)
                    [Un t:Un]
-                    [true-lfilter -true-lfilter]
-                    [true-filter -true-filter]
                    [-> t:->])
         (utils tc-utils utils)
         (utils mutated-vars)
@ -240,10 +238,10 @@
        (tc-err (let: ([z : 4611686018427387903 4611686018427387903]) z)) ; unsafe
        (tc-e (let: ([z : 4611686018427387904 4611686018427387904]) z) (-val 4611686018427387904))

-        [tc-e/t (lambda: () 3) (t:-> -PosByte : -true-lfilter)]
-        [tc-e/t (lambda: ([x : Number]) 3) (t:-> N -PosByte : -true-lfilter)]
-        [tc-e/t (lambda: ([x : Number] [y : Boolean]) 3) (t:-> N B -PosByte : -true-lfilter)]
-        [tc-e/t (lambda () 3) (t:-> -PosByte : -true-lfilter)]
+        [tc-e/t (lambda: () 3) (t:-> -PosByte : -true-filter)]
+        [tc-e/t (lambda: ([x : Number]) 3) (t:-> N -PosByte : -true-filter)]
+        [tc-e/t (lambda: ([x : Number] [y : Boolean]) 3) (t:-> N B -PosByte : -true-filter)]
+        [tc-e/t (lambda () 3) (t:-> -PosByte : -true-filter)]
        [tc-e (values 3 4) #:ret (ret (list -PosByte -PosByte) (list -true-filter -true-filter))]
        [tc-e (cons 3 4) (-pair -PosByte -PosByte)]
        [tc-e (cons 3 (ann '() : (Listof Integer))) (make-Listof -Integer)]
@ -593,7 +591,7 @@
        [tc-e/t (let* ([z 1]
                       [p? (lambda: ([x : Any]) (number? z))])
                  (lambda: ([x : Any]) (if (p? x) 11 12)))
-                (t:-> Univ -PosByte : -true-lfilter)]
+                (t:-> Univ -PosByte : -true-filter)]
        [tc-e/t (let* ([z 1]
                       [p? (lambda: ([x : Any]) (number? z))])
                  (lambda: ([x : Any]) (if (p? x) x 12)))
@ -605,7 +603,7 @@
        [tc-e/t (let* ([z 1]
                       [p? (lambda: ([x : Any]) (not (number? z)))])
                  (lambda: ([x : Any]) (if (p? x) x 12)))
-                (t:-> Univ -PosByte : -true-lfilter)]
+                (t:-> Univ -PosByte : -true-filter)]
        [tc-e/t (let* ([z 1]
                       [p? (lambda: ([x : Any]) z)])
                  (lambda: ([x : Any]) (if (p? x) x 12)))
@ -788,7 +786,7 @@

        ;; instantiating dotted terms
        [tc-e/t (inst (plambda: (a ...) [xs : a ... a] 3) Integer Boolean Integer)
-                (-Integer B -Integer . t:-> . -PosByte : -true-lfilter)]
+                (-Integer B -Integer . t:-> . -PosByte : -true-filter)]
        [tc-e/t (inst (plambda: (a ...) [xs : (a ... a -> Integer) ... a] 3) Integer Boolean Integer)
                ((-Integer B -Integer . t:-> . -Integer)
                 (-Integer B -Integer . t:-> . -Integer)
@ -873,13 +871,13 @@
                   (lambda: ([y : (a ... a -> Number)])
                     (apply y zs))
                   ys)))
-              (-polydots (a) ((list) ((list) (a a) . ->... . N) . ->* . ((list) (a a) . ->... . (-lst N)) : -true-lfilter))]
+              (-polydots (a) ((list) ((list) (a a) . ->... . N) . ->* . ((list) (a a) . ->... . (-lst N)) : -true-filter))]
        [tc-e/t (plambda: (a ...) [ys : (a ... a -> Number) *]
                (lambda: [zs : a ... a]
                  (map (lambda: ([y : (a ... a -> Number)])
                         (apply y zs))
                       ys)))
-              (-polydots (a) ((list) ((list) (a a) . ->... . N) . ->* . ((list) (a a) . ->... . (-lst N)) : -true-lfilter))]
+              (-polydots (a) ((list) ((list) (a a) . ->... . N) . ->* . ((list) (a a) . ->... . (-lst N)) : -true-filter))]

        [tc-e/t (lambda: ((x : (All (t) t)))
                       ((inst (inst x (All (t) (t -> t)))
@ -1685,7 +1683,7 @@
          (case-lambda
            [w 'result]
            [(x) (add1 "hello")])
-          (->* (list) Univ (-val 'result) : -true-lfilter)]
+          (->* (list) Univ (-val 'result) : -true-filter)]

        [tc-e
           (opt-lambda: ((x : Symbol 'a)) x)