From 0e02b13d2851718a86a4edc1855a7002dd62502b Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 20 Nov 2013 14:51:13 -0500 Subject: [PATCH] Add types for remaining `in-foo` functions Also fixed `in-directory` type Please merge into 6.0 original commit: 249427afb41907fc974993f7ce310e9014d4938e --- .../typed-racket/base-env/base-env.rkt | 21 +++++++++++++++++-- .../base-env/base-special-env.rkt | 20 ++++++++++++++++++ .../special-env-typecheck-tests.rkt | 20 +++++++++++++++++- 3 files changed, 58 insertions(+), 3 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt index e2a15edb..5c5eab71 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -762,9 +762,26 @@ [make-weak-custom-hash (->opt (-> Univ Univ Univ) (-> Univ -Nat) [(-> Univ -Nat)] Univ)] ;; Section 4.14 (Sequences and Streams) -[in-directory (-> (-seq -Path))] - [sequence? (make-pred-ty (-seq Univ))] +[in-sequences + (-poly (a) (->* (list) (-seq a) (-seq a)))] +[in-cycle + (-poly (a) (->* (list) (-seq a) (-seq a)))] +[in-parallel + (-poly (a b c) + (cl->* (-> (-seq a) (-seq a)) + (-> (-seq a) (-seq b) (-seq a b)) + (-> (-seq a) (-seq b) (-seq c) (-seq a b c))))] +[in-values-sequence + (-poly (a b c) + (cl->* (-> (-seq a) (-seq (-pair a (-val null)))) + (-> (-seq a b) (-seq (-pair a (-pair b (-val null))))) + (-> (-seq a b c) (-seq (-pair a (-pair b (-pair c (-val null))))))))] +[in-values*-sequence + (-poly (a b c) + (cl->* (-> (-seq a) (-seq a)) + (-> (-seq a b) (-seq (-pair a (-pair b (-val null))))) + (-> (-seq a b c) (-seq (-pair a (-pair b (-pair c (-val null))))))))] [stop-before (-poly (a) ((-seq a) (a . -> . Univ) . -> . (-seq a)))] [stop-after (-poly (a) ((-seq a) (a . -> . Univ) . -> . (-seq a)))] [make-do-sequence (-poly (a b) ((-> (-values (list (a . -> . b) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-special-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-special-env.rkt index b1aaa8d9..fea04e93 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-special-env.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-special-env.rkt @@ -96,6 +96,9 @@ ;; in-list [(make-template-identifier 'in-list 'racket/private/for) (-poly (a) (-> (-lst a) (-seq a)))] + ;; in-mlist + [(make-template-identifier 'in-mlist 'racket/private/for) + (-poly (a) (-> (-mlst a) (-seq a)))] ;; in-vector [(make-template-identifier 'in-vector 'racket/private/for) (-poly (a) @@ -139,6 +142,23 @@ ;; in-bytes-lines [(make-template-identifier 'in-bytes-lines 'racket/private/for) (->opt [-Input-Port -Symbol] (-seq -Bytes))] + ;; in-directory + [(make-template-identifier '*in-directory 'racket/private/for) + (->opt [(Un (-val #f) -Pathlike)] (-seq -Path))] + ;; in-producer + [(make-template-identifier 'in-producer 'racket/private/for) + (-polydots (a b) + (cl->* (-> (-> a) (-seq a)) + (->... (list (->... '() [b b] a) + (-> a -Boolean)) + [b b] + (-seq a))))] + ;; in-value + [(make-template-identifier 'in-value 'racket/private/for) + (-poly (a) (-> a (-seq a)))] + ;; in-indexed + [(make-template-identifier 'in-indexed 'racket/private/for) + (-poly (a) (-> (-seq a) (-seq a -Nat)))] ;; in-set [(make-template-identifier 'in-set 'racket/private/set) (-poly (a) (-> (-set a) (-seq a)))] diff --git 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 index 64fad2de..0618e080 100644 --- 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 @@ -115,7 +115,25 @@ (tc-e (make-temporary-file "ee~a" 'directory) -Path) (tc-e (make-temporary-file "ee~a" "temp" "here") -Path) - + ;; more sequences + [tc-e (sequence-ref (in-directory) 0) -Path] + [tc-e (in-mlist (ann (mcons 'a null) (MListof 'a))) (-seq (-val 'a))] + [tc-e (in-producer (λ () 'hi)) (-seq (-val 'hi))] + [tc-e (in-producer (λ: ([x : String]) 'hi) symbol? "foo") + (-seq (-val 'hi))] + [tc-e (in-value 'hi) (-seq (-val 'hi))] + [tc-e (in-indexed '(a b c)) (-seq (one-of/c 'a 'b 'c) -Nat)] + [tc-e (in-sequences '(a b) '(z y)) (-seq (one-of/c 'a 'b 'z 'y))] + [tc-e (in-cycle '(a b) '(z y)) (-seq (one-of/c 'a 'b 'z 'y))] + [tc-e (in-parallel '(a b) '(z y)) (-seq (one-of/c 'a 'b) (one-of/c 'z 'y))] + [tc-e (in-values-sequence (in-parallel '(a b) '(z y))) + (-seq (-pair (one-of/c 'a 'b) (-pair (one-of/c 'z 'y) (-val null))))] + [tc-e (in-values-sequence '(a b c)) + (-seq (-pair (one-of/c 'a 'b 'c) (-val null)))] + [tc-e (in-values*-sequence (in-parallel '(a b) '(z y))) + (-seq (-pair (one-of/c 'a 'b) (-pair (one-of/c 'z 'y) (-val null))))] + [tc-e (in-values*-sequence '(a b c)) + (-seq (one-of/c 'a 'b 'c))] ))