suzanne.soy/typed-racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix types for regexp-match*' and regexp-match-positions*'.

Browse Source 
Note that the keyword arguments themselves are not yet typed.

original commit: 56120d9697756be22b19ec346a0c3d14d3238ad6
This commit is contained in:
Sam Tobin-Hochstadt 2012-03-19 15:57:20 -04:00
parent d33be1917d
commit 7d25bb6ba5
4 changed files with 53 additions and 32 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/tests/typed-racket/succeed/regexp-match-kw.rkt Normal file
View File

@ -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))

8
collects/tests/typed-racket/unit-tests/typecheck-tests.rkt
View File

@ -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)))))

25
collects/typed-racket/base-env/base-env-indexing-abs.rkt
View File

@ -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]

46
collects/typed-racket/base-env/base-special-env.rkt
View File

@ -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))]
)