From 7d25bb6ba536c7e36fb9d3ed106065afdc20eebf Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Mon, 19 Mar 2012 15:57:20 -0400 Subject: [PATCH] Fix types for `regexp-match*' and `regexp-match-positions*'. Note that the keyword arguments themselves are not yet typed. original commit: 56120d9697756be22b19ec346a0c3d14d3238ad6 --- .../typed-racket/succeed/regexp-match-kw.rkt | 6 +++ .../unit-tests/typecheck-tests.rkt | 8 +--- .../base-env/base-env-indexing-abs.rkt | 25 ---------- .../base-env/base-special-env.rkt | 46 +++++++++++++++++++ 4 files changed, 53 insertions(+), 32 deletions(-) create mode 100644 collects/tests/typed-racket/succeed/regexp-match-kw.rkt diff --git a/collects/tests/typed-racket/succeed/regexp-match-kw.rkt b/collects/tests/typed-racket/succeed/regexp-match-kw.rkt new file mode 100644 index 00000000..3469e6cf --- /dev/null +++ b/collects/tests/typed-racket/succeed/regexp-match-kw.rkt @@ -0,0 +1,6 @@ +#lang typed/racket + +(ann (regexp-match* "foo" "foobar") (Listof String)) +(ann (regexp-match* "foo" #"foobar") (Listof Bytes)) +(ann (regexp-match* #"foo" "foobar") (Listof Bytes)) +(ann (regexp-match* #"foo" #"foobar") (Listof Bytes)) diff --git a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt index 59f3ceac..a61db9db 100644 --- a/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/typecheck-tests.rkt @@ -35,7 +35,7 @@ (provide typecheck-tests g tc-expr/expand) -(b:init) (n:init) (initialize-structs) (initialize-indexing) +(b:init) (n:init) (initialize-structs) (initialize-indexing) (define N -Number) (define B -Boolean) @@ -1013,12 +1013,6 @@ (tc-e (regexp-match "foo" (open-input-string "tmp")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) (tc-e (regexp-match #"foo" (open-input-string "tmp")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) - (tc-e (regexp-match* "foo" "foobar") (-lst -String)) - (tc-e (regexp-match* "foo" #"foobar") (-lst -Bytes)) - (tc-e (regexp-match* #"foo" "foobar") (-lst -Bytes)) - (tc-e (regexp-match* #"foo" #"foobar") (-lst -Bytes)) - - (tc-err (regexp-try-match "foo" "foobar")) (tc-e (regexp-try-match "foo" (open-input-string "foobar")) (-opt (-pair -Bytes (-lst (-opt -Bytes))))) diff --git a/collects/typed-racket/base-env/base-env-indexing-abs.rkt b/collects/typed-racket/base-env/base-env-indexing-abs.rkt index 23c12c1e..1de569c9 100644 --- a/collects/typed-racket/base-env/base-env-indexing-abs.rkt +++ b/collects/typed-racket/base-env/base-env-indexing-abs.rkt @@ -75,18 +75,6 @@ (-BtsRx (Un -StrInput -BtsInput) [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes)) (-Pattern -BtsInput [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes))))] - [regexp-match* - (let ([N index-type] - [?N (-opt index-type)] - [-StrRx (Un -String -Regexp)] - [-BtsRx (Un -Bytes -Byte-Regexp)] - [-StrInput (Un -String -Path)] - [-BtsInput (Un -Input-Port -Bytes)]) - (cl->* - (-StrRx -StrInput [N ?N -Bytes] . ->opt . (-lst -String)) - (-BtsRx (Un -StrInput -BtsInput) [N ?N -Bytes] . ->opt . (-lst -Bytes)) - (-Pattern -BtsInput [N ?N -Bytes] . ->opt . (-lst -Bytes))))] - [regexp-try-match (let ([?outp (-opt -Output-Port)] [N index-type] @@ -106,17 +94,6 @@ [-Input (Un -String -Input-Port -Bytes -Path)]) (->opt -Pattern -Input [N ?N ?outp -Bytes] output))] - - [regexp-match-positions* - (let* ([?outp (-opt -Output-Port)] - [N index-type] - [?N (-opt index-type)] - [ind-pair (-pair -Index -Index)] - [output (-lst ind-pair)] - [-Input (Un -String -Input-Port -Bytes -Path)]) - (->opt -Pattern -Input [N ?N ?outp -Bytes] output))] - - [regexp-match? (let ([?outp (-opt -Output-Port)] [N index-type] @@ -125,8 +102,6 @@ (-Pattern -Input [N ?N ?outp -Bytes] . ->opt . B))] - - [regexp-match-peek (let ([progress (-val #f)] [N index-type] diff --git a/collects/typed-racket/base-env/base-special-env.rkt b/collects/typed-racket/base-env/base-special-env.rkt index 9cab8a88..0f63180d 100644 --- a/collects/typed-racket/base-env/base-special-env.rkt +++ b/collects/typed-racket/base-env/base-special-env.rkt @@ -473,4 +473,50 @@ (-SomeSystemPathlike -SomeSystemPathlike #:more-than-root? Univ #f . ->key . -SomeSystemPath)] [((kw-expander-impl (syntax-local-value #'find-relative-path))) (Univ -Boolean -SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)] + + ;; FIXME -- the below function do not actually support their keyword arguments + [((kw-expander-proc (syntax-local-value #'regexp-match*))) + (let ([N -Integer] + [?N (-opt -Integer)] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-StrInput (Un -String -Path)] + [-BtsInput (Un -Input-Port -Bytes)]) + (cl->* + (-StrRx -StrInput [N ?N -Bytes] . ->opt . (-lst -String)) + (-BtsRx (Un -StrInput -BtsInput) [N ?N -Bytes] . ->opt . (-lst -Bytes)) + (-Pattern -BtsInput [N ?N -Bytes] . ->opt . (-lst -Bytes))))] + [((kw-expander-impl (syntax-local-value #'regexp-match*))) + (let ([N -Integer] + [B -Boolean] + [?N (-opt -Integer)] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-StrInput (Un -String -Path)] + [-BtsInput (Un -Input-Port -Bytes)]) + (cl->* + (Univ (-val #f) Univ (-val #f) -StrRx -StrInput (-opt N) B (-opt ?N) B (-opt -Bytes) B . -> . (-lst -String)) + (Univ (-val #f) Univ (-val #f) -BtsRx (Un -StrInput -BtsInput) (-opt N) B (-opt ?N) B (-opt -Bytes) B . -> . (-lst -Bytes)) + (Univ (-val #f) Univ (-val #f) -Pattern -BtsInput (-opt N) B (-opt ?N) B (-opt -Bytes) B . -> . (-lst -Bytes))))] + + [((kw-expander-proc (syntax-local-value #'regexp-match-positions*))) + (let* ([?outp (-opt -Output-Port)] + [B -Boolean] + [N -Integer] + [?N (-opt -Integer)] + [ind-pair (-pair -Index -Index)] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (->opt -Pattern -Input [N ?N ?outp -Bytes] output))] + [((kw-expander-impl (syntax-local-value #'regexp-match-positions*))) + (let* ([?outp (-opt -Output-Port)] + [B -Boolean] + [N -Integer] + [?N (-opt -Integer)] + [ind-pair (-pair -Index -Index)] + [output (-opt (-pair ind-pair (-lst (-opt ind-pair))))] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (-> Univ (-val #f) Univ (-val #f) -Pattern -Input (-opt N) B (-opt ?N) B (-opt ?outp) B (-opt -Bytes) B output))] + + )