From 029651b9eeaed6b4cecb800da2c01fa6cbed1270 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 15 Jun 2011 16:42:37 -0400 Subject: [PATCH] Added types for regexp operations. Changed Regexp to correspond to regexp?. --- .../base-env/base-env-indexing-abs.rkt | 217 ++++++++++++++---- collects/typed-scheme/base-env/base-env.rkt | 67 ++++-- collects/typed-scheme/types/abbrev.rkt | 38 ++- 3 files changed, 252 insertions(+), 70 deletions(-) diff --git a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt index ebbe9a1709..4e87bd5e0a 100644 --- a/collects/typed-scheme/base-env/base-env-indexing-abs.rkt +++ b/collects/typed-scheme/base-env/base-env-indexing-abs.rkt @@ -66,63 +66,194 @@ [list-ref (-poly (a) ((-lst a) index-type . -> . a))] [list-tail (-poly (a) ((-lst a) index-type . -> . (-lst a)))] + + [regexp-match (let ([?outp (-opt -Output-Port)] [N index-type] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-lst (-opt t))))] - [-StrRx (Un -String -Regexp -PRegexp)] - [-BtsRx (Un -Bytes -Byte-Regexp -Byte-PRegexp)] - [-InpBts (Un -Input-Port -Bytes)]) + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) (cl->* - (-StrRx -String [N ?N ?outp] . ->opt . (optlist -String)) - (-BtsRx -String [N ?N ?outp] . ->opt . (optlist -Bytes)) - (-Pattern -InpBts [N ?N ?outp] . ->opt . (optlist -Bytes))))] + (-StrRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -String)) + (-BtsRx -Input [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)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N -Bytes] . ->opt . (-lst -String)) + (-BtsRx -Input [N ?N -Bytes] . ->opt . (-lst -Bytes))))] + [regexp-try-match + (let ([?outp (-opt -Output-Port)] + [N index-type] + [?N (-opt index-type)] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -String)) + (-BtsRx -Input [N ?N ?outp -Bytes] . ->opt . (optlist -Bytes))))] + + + [regexp-match-positions + (let* ([?outp (-opt -Output-Port)] + [N index-type] + [?N (-opt index-type)] + [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))] + + + [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] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-lst (-opt t))))] - [-StrRx (Un -String -Regexp -PRegexp)] - [-BtsRx (Un -Bytes -Byte-Regexp -Byte-PRegexp)] - [-InpBts (Un -Input-Port -Bytes)]) - (cl->* - (-StrRx -String [N ?N ?outp] . ->opt . -Boolean) - (-BtsRx -String [N ?N ?outp] . ->opt . -Boolean) - (-Pattern -InpBts [N ?N ?outp] . ->opt . -Boolean)))] - [regexp-match* - (let ([N index-type] - [?N (-opt index-type)] - [-StrRx (Un -String -Regexp -PRegexp)] - [-BtsRx (Un -Bytes -Byte-Regexp -Byte-PRegexp)] - [-InpBts (Un -Input-Port -Bytes)]) - (cl->* - (-StrRx -String [N ?N] . ->opt . (-lst -String)) - (-BtsRx -String [N ?N] . ->opt . (-lst -Bytes)) - (-Pattern -InpBts [N ?N] . ->opt . (-lst -Bytes))))] - [regexp-try-match - (let ([?outp (-opt -Output-Port)] - [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-lst (-opt t))))]) - (->opt -Pattern -Input-Port [index-type ?N ?outp] (optlist -Bytes)))] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (-Pattern -Input [N ?N ?outp -Bytes] . ->opt . -Boolean))] - [regexp-match-positions + + + + [regexp-match-peek + (let ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N progress -Bytes] . ->opt . (optlist -String)) + (-BtsRx -Input [N ?N progress -Bytes] . ->opt . (optlist -Bytes))))] + + + [regexp-match-peek-positions + (let* ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [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 progress -Bytes] output))] + + + [regexp-match-peek-immediate + (let ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N progress -Bytes] . ->opt . (optlist -String)) + (-BtsRx -Input [N ?N progress -Bytes] . ->opt . (optlist -Bytes))))] + + + [regexp-match-peek-positions-immediate + (let* ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [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 progress -Bytes] output))] + + + + [regexp-match-peek-positions* + (let* ([progress (-val #f)] + [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 progress -Bytes] output))] + + + [regexp-match/end (let ([?outp (-opt -Output-Port)] [N index-type] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-lst (-opt t))))] - [-StrRx (Un -String -Regexp -PRegexp)] - [-BtsRx (Un -Bytes -Byte-Regexp -Byte-PRegexp)] - [-InpBts (Un -Input-Port -Bytes)]) - (->opt -Pattern (Un -String -InpBts) [N ?N ?outp] (optlist (-pair -Index -Index))))] - [regexp-match-positions* - (let ([?outp (-opt -Output-Port)] + [optlist (lambda (t) (-opt (-pair t (-lst (-opt t)))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -String) (-opt -Bytes)))) + (-BtsRx -Input [N ?N ?outp -Bytes N] . ->opt . (-values (list (optlist -Bytes) (-opt -Bytes))))))] + + + [regexp-match-positions/end + (let* ([?outp (-opt -Output-Port)] + [N index-type] + [?N (-opt index-type)] + [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 -Bytes N] (-values (list output (-opt -Bytes)))))] + + + + + [regexp-match-peek-positions/end + (let* ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [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 progress -Bytes N] (-values (list output (-opt -Bytes)))))] + + + [regexp-match-peek-positions-immediate/end + (let* ([progress (-val #f)] + [N index-type] + [?N (-opt index-type)] + [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 progress -Bytes N] (-values (list output (-opt -Bytes)))))] + + + + [regexp-split + (let ([N index-type] [?N (-opt index-type)] - [optlist (lambda (t) (-opt (-lst (-opt t))))] - [-StrRx (Un -String -Regexp -PRegexp)] - [-BtsRx (Un -Bytes -Byte-Regexp -Byte-PRegexp)] - [-InpBts (Un -Input-Port -Bytes)]) - (->opt -Pattern (Un -String -InpBts) [index-type ?N ?outp] (-lst (-pair -Index -Index))))] + [output (lambda (t) (-opt (-pair t (-lst t))))] + [-StrRx (Un -String -Regexp)] + [-BtsRx (Un -Bytes -Byte-Regexp)] + [-Input (Un -String -Input-Port -Bytes -Path)]) + (cl->* + (-StrRx -Input [N ?N -Bytes] . ->opt . (output -String)) + (-BtsRx -Input [N ?N -Bytes] . ->opt . (output -Bytes))))] + + + + + + + + + + [take (-poly (a) ((-lst a) index-type . -> . (-lst a)))] diff --git a/collects/typed-scheme/base-env/base-env.rkt b/collects/typed-scheme/base-env/base-env.rkt index 48d4d5de97..7eabff0bf5 100644 --- a/collects/typed-scheme/base-env/base-env.rkt +++ b/collects/typed-scheme/base-env/base-env.rkt @@ -537,33 +537,73 @@ [read-decimal-as-inexact (-Param B B)] [current-command-line-arguments (-Param (-vec -String) (-vec -String))] -;; regexp stuff + +;; Section 3.7 +;; Regular Expressions + [regexp? (make-pred-ty -Regexp)] [pregexp? (make-pred-ty -PRegexp)] [byte-regexp? (make-pred-ty -Byte-Regexp)] [byte-pregexp? (make-pred-ty -Byte-PRegexp)] -[regexp (-String . -> . -Regexp)] +[regexp (-String . -> . -Base-Regexp)] [pregexp (-String . -> . -PRegexp)] -[byte-regexp (-Bytes . -> . -Byte-Regexp)] +[byte-regexp (-Bytes . -> . -Byte-Base-Regexp)] [byte-pregexp (-Bytes . -> . -Byte-PRegexp)] -[regexp-match-exact? - (-Pattern (Un -String -Bytes -Input-Port) . -> . B)] - - -#; -[regexp-match-peek-positions*] -#; -[regexp-split] - [regexp-quote (cl->* (->opt -String [Univ] -String) (->opt -Bytes [Univ] -Bytes))] + +[regexp-max-lookbehind (-> (Un -Regexp -Byte-Regexp) -Nat)] + +;In Index +;regexp-match +;regexp-match* +;regexp-try-match +;regexp-match-positions +;regexp-match? + + + + + + +[regexp-match-exact? (-> -Pattern (Un -String -Bytes -Path) B)] + +;In Index +;regexp-match-peek +;regexp-match-peek-positions +;regexp-match-peek-immediate +;regexp-match-peek-positions-immediate +;regexp-match-peek-positions* +;regexp-match/end +;regexp-match-positions/end +;regexp-match-peek-positions/end +;regexp-match-peek-positions-immediate/end + + +[regexp-replace + (cl->* + (->opt (Un -String -Regexp) -String (Un -String (->* (list -String) -String -String)) [-Bytes] -String) + (->opt (Un -Bytes -Byte-Regexp) (Un -Bytes -String) (Un -Bytes -String (->* (list -Bytes) -Bytes -Bytes)) [-Bytes] -Bytes) + (->opt -Pattern -Bytes (Un -Bytes -String (->* (list -Bytes) -Bytes -Bytes)) [-Bytes] -Bytes))] + +[regexp-replace* + (cl->* + (->opt (Un -String -Regexp) -String (Un -String (->* (list -String) -String -String)) [-Bytes] -String) + (->opt (Un -Bytes -Byte-Regexp) (Un -Bytes -String) (Un -Bytes -String (->* (list -Bytes) -Bytes -Bytes)) [-Bytes] -Bytes) + (->opt -Pattern -Bytes (Un -Bytes -String (->* (list -Bytes) -Bytes -Bytes)) [-Bytes] -Bytes))] + + [regexp-replace-quote (cl->* [-> -String -String] [-> -Bytes -Bytes])] + + + + [number->string (->opt N [N] -String)] [string->number (->opt -String [N] (Un (-val #f) N))] @@ -790,9 +830,6 @@ [copy-file (-> -Pathlike -Pathlike -Void)] [force (-poly (a) (-> (-Promise a) a))] -[regexp-replace* - (cl->* (-Pattern -String -String . -> . -String) - (-Pattern (Un -Bytes -String) (Un -Bytes -String) . -> . -Bytes))] [make-directory (-> -Pathlike -Void)] diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index a59eef4018..d7076fd24a 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -122,20 +122,35 @@ (lambda (x) (equal? (letrec ([y y]) y) x)) #'-Undefined)) (define -Bytes (make-Base 'Bytes #'bytes? bytes? #'-Bytes)) -(define -Regexp (make-Base 'Regexp - #'(and/c regexp? (not/c pregexp?) (not/c byte-regexp?)) - (conjoin regexp? (negate pregexp?) (negate byte-regexp?)) - #'-Regexp)) +(define -String (make-Base 'String #'string? string? #'-String)) + + +(define -Base-Regexp (make-Base 'Base-Regexp + #'(and/c regexp? (not/c pregexp?)) + (conjoin regexp? (negate pregexp?)) + #'-Regexp)) (define -PRegexp (make-Base 'PRegexp - #'(and/c pregexp? (not/c byte-pregexp?)) - (conjoin pregexp? (negate byte-pregexp?)) - #'-PRegexp)) -(define -Byte-Regexp (make-Base 'Byte-Regexp + #'pregexp? + pregexp? + #'-PRegexp)) +(define -Regexp (*Un -PRegexp -Base-Regexp)) + +(define -Byte-Base-Regexp (make-Base 'Byte-Regexp #'(and/c byte-regexp? (not/c byte-pregexp?)) (conjoin byte-regexp? (negate byte-pregexp?)) - #'-Byte-Regexp)) -(define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp)) -(define -String (make-Base 'String #'string? string? #'-String)) + #'-Byte-Regexp)) +(define -Byte-PRegexp (make-Base 'Byte-PRegexp #'byte-pregexp? byte-pregexp? #'-Byte-PRegexp)) +(define -Byte-Regexp (*Un -Byte-Base-Regexp -Byte-PRegexp)) + +(define -Pattern (*Un -Bytes -Regexp -Byte-Regexp -String)) + + + + + + + + (define -Keyword (make-Base 'Keyword #'keyword? keyword? #'-Keyword)) (define -Char (make-Base 'Char #'char? char? #'-Char)) (define -Thread (make-Base 'Thread #'thread? thread? #'-Thread)) @@ -177,7 +192,6 @@ (define -SomeSystemPathlike* (*Un -String -SomeSystemPath(-val 'up) (-val 'same))) (define -PathConventionType (*Un (-val 'unix) (-val 'windows))) -(define -Pattern (*Un -Bytes -Regexp -PRegexp -Byte-Regexp -Byte-PRegexp -String)) (define -Struct-Type-Property (make-Base 'Struct-Type-Property #'struct-type-property? struct-type-property? #'Struct-Type-Property))