From b54d8dc04a602aba3070bc893bd1fe5d847e48c0 Mon Sep 17 00:00:00 2001 From: Alexis King Date: Wed, 25 Mar 2015 16:44:42 -0700 Subject: [PATCH] Strengthen the types for member, memv, memq, and memf Fixes #61. --- typed-racket-lib/typed-racket/base-env/base-env.rkt | 10 +++++----- typed-racket-test/unit-tests/typecheck-tests.rkt | 9 +++++---- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/typed-racket-lib/typed-racket/base-env/base-env.rkt b/typed-racket-lib/typed-racket/base-env/base-env.rkt index 4ec61fec..148209c9 100644 --- a/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -624,13 +624,13 @@ [kernel:reverse (-poly (a) (-> (-lst a) (-lst a)))] [append (-poly (a) (->* (list) (-lst a) (-lst a)))] [length (-poly (a) (-> (-lst a) -Index))] -[memq (-poly (a) (-> Univ (-lst a) (-opt (-lst a))))] -[memv (-poly (a) (-> Univ (-lst a) (-opt (-lst a))))] -[memf (-poly (a) ((a . -> . Univ) (-lst a) . -> . (-opt (-lst a))))] +[memq (-poly (a) (-> Univ (-lst a) (-opt (-ne-lst a))))] +[memv (-poly (a) (-> Univ (-lst a) (-opt (-ne-lst a))))] +[memf (-poly (a) ((a . -> . Univ) (-lst a) . -> . (-opt (-ne-lst a))))] [member (-poly (a) - (cl->* (Univ (-lst a) . -> . (-opt (-lst a))) + (cl->* (Univ (-lst a) . -> . (-opt (-ne-lst a))) (Univ (-lst a) (-> a a Univ) - . -> . (-opt (-lst a)))))] + . -> . (-opt (-ne-lst a)))))] [findf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt a)))] [assq (-poly (a b) (Univ (-lst (-pair a b)) . -> . (-opt (-pair a b))))] diff --git a/typed-racket-test/unit-tests/typecheck-tests.rkt b/typed-racket-test/unit-tests/typecheck-tests.rkt index f4a160d2..9d8d0123 100644 --- a/typed-racket-test/unit-tests/typecheck-tests.rkt +++ b/typed-racket-test/unit-tests/typecheck-tests.rkt @@ -2325,10 +2325,11 @@ ;; test functions which do lookup with the "wrong type", where the ;; result type shouldn't be widened to include that type - [tc-e (memq 3 '(a b c)) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))] - [tc-e (memv 3 '(a b c)) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))] - [tc-e (member 3 '(a b c)) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))] - [tc-e (member 3 '(a b c) equal?) (t:Un (-val #f) (-lst (one-of/c 'a 'b 'c)))] + [tc-e (memq 3 '(a b c)) (t:Un (-val #f) (-ne-lst (one-of/c 'a 'b 'c)))] + [tc-e (memv 3 '(a b c)) (t:Un (-val #f) (-ne-lst (one-of/c 'a 'b 'c)))] + [tc-e (member 3 '(a b c)) (t:Un (-val #f) (-ne-lst (one-of/c 'a 'b 'c)))] + [tc-e (member 3 '(a b c) equal?) (t:Un (-val #f) (-ne-lst (one-of/c 'a 'b 'c)))] + [tc-e (memf symbol? '(a b c)) (t:Un (-val #f) (-ne-lst (one-of/c 'a 'b 'c)))] [tc-e (assq 3 '((a . 5) (b . 7))) (t:Un (-val #f) (-pair (one-of/c 'a 'b) -PosByte))] [tc-e (assv 3 '((a . 5) (b . 7))) (t:Un (-val #f) (-pair (one-of/c 'a 'b) -PosByte))] [tc-e (assoc 3 '((a . 5) (b . 7))) (t:Un (-val #f) (-pair (one-of/c 'a 'b) -PosByte))]