diff --git a/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt b/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt index 5da1cb2e..c0a0717a 100644 --- a/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/special-env-typecheck-tests.rkt @@ -33,7 +33,7 @@ [(_ expr ty) (syntax/loc stx (tc-e expr #:ret (ret ty)))] [(_ a #:ret b) (quasisyntax/loc stx - (check-tc-result-equal? (format "~a ~a" #,(syntax-line stx) 'expr) + (check-tc-result-equal? (format "~a ~a" #,(syntax-line stx) 'a) #,(let ([ex (local-expand #'a 'expression null)]) (parameterize ([mutated-vars (find-mutated-vars ex)]) (tc-expr ex))) @@ -41,7 +41,7 @@ (define (typecheck-special-tests) (test-suite - "Typechecker tests" + "Special Typechecker tests" ;; should work but don't -- need expected type #| [tc-e (for/list ([(k v) (in-hash #hash((1 . 2)))]) 0) (-lst -Zero)] diff --git a/collects/typed-racket/base-env/base-env.rkt b/collects/typed-racket/base-env/base-env.rkt index 3f198c66..10219a6b 100644 --- a/collects/typed-racket/base-env/base-env.rkt +++ b/collects/typed-racket/base-env/base-env.rkt @@ -2577,3 +2577,264 @@ ;; reader graphs [make-reader-graph (-> Univ Univ)] + +;; keyword functions moved back to here: + +[file->string + (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)] +(file->bytes (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes)) +(file->value (->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ)) +(file->lines + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:line-mode + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + #f + (-lst -String))) +(file->bytes-lines + (->key + -Pathlike + #:line-mode + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + #f + #:mode + (one-of/c 'binary 'text) + #f + (-lst -Bytes))) +(display-to-file + (->key + Univ + -Pathlike + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + -Void)) +(display-lines-to-file + (->key + (-lst Univ) + -Pathlike + #:separator + Univ + #f + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + -Void)) +(write-to-file + (->key + Univ + -Pathlike + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + -Void)) +(file->list + (-poly (a) + (cl->* + (->optkey -Pathlike [(-> -Input-Port (Un))] #:mode (one-of/c 'binary 'text) #f (-lst Univ)) + (->optkey -Pathlike [(-> -Input-Port a)] #:mode (one-of/c 'binary 'text) #f (-lst a))))) +(get-preference + (let ((use-lock-type Univ) + (timeout-lock-there-type (-opt (-> -Path Univ))) + (lock-there-type (-opt (-> -Path Univ)))) + (cl->* + (->key + -Symbol + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + Univ + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + Univ + (-opt -Pathlike) + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ)))) +(make-handle-get-preference-locked + (let ((lock-there-type (-opt (-> -Path Univ))) + (max-delay-type -Real)) + (->optkey -Real -Symbol [(-> Univ) Univ (-opt -Pathlike)] + #:lock-there lock-there-type #f #:max-delay max-delay-type #f + (-> -Pathlike Univ)))) +(call-with-file-lock/timeout + (-poly + (a) + (->key + (-opt -Pathlike) + (one-of/c 'shared 'exclusive) + (-> a) + (-> a) + #:lock-file + (-opt -Pathlike) + #f + #:delay + -Real + #f + #:max-delay + -Real + #f + a))) +(sort + (-poly + (a b) + (cl->* + (->key (-lst a) (-> a a -Boolean) #:key (-> a a) #f #:cache-keys? -Boolean #f (-lst a)) + (->key (-lst a) (-> b b -Boolean) #:key (-> a b) #f #:cache-keys? -Boolean #f (-lst a))))) +(remove-duplicates + (-poly + (a b) + (cl->* + (->optkey (-lst a) ((-> a a Univ)) #:key (-> a a) #f (-lst a)) + (->optkey (-lst a) ((-> b b Univ)) #:key (-> a b) #f (-lst a))))) +(open-input-file (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Input-Port)) +(open-output-file + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + -Output-Port)) +(open-input-output-file + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + (-values (list -Input-Port -Output-Port)))) +(call-with-input-file + (-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a))) +(call-with-output-file + (-poly (a) + (->key + -Pathlike + (-> -Output-Port a) + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate) + #f + #:mode + (one-of/c 'binary 'text) + #f + a))) +(call-with-input-file* (-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a))) +(call-with-output-file* + (-poly + (a) + (->key + -Pathlike + (-> -Output-Port a) + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate) + #f + #:mode + (one-of/c 'binary 'text) + #f + a))) +(with-input-from-file (-poly (a) (->key -Pathlike (-> a) #:mode (Un (-val 'binary) (-val 'text)) #f a))) +(with-output-to-file + (-poly + (a) + (->key + -Pathlike + (-> a) + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + a))) +(port->lines + (->optkey [-Input-Port] #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String))) +(port->bytes-lines + (->optkey [-Input-Port] #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes))) +(display-lines + (->optkey (-lst Univ) [-Output-Port] #:separator Univ #f -Void)) +(find-relative-path (->key -SomeSystemPathlike -SomeSystemPathlike #:more-than-root? Univ #f -SomeSystemPath)) +(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)) + (sel (λ (t) (-opt (-> (-lst t) t))))) + (cl->* + (->optkey -StrRx -StrInput (N ?N -Bytes) + #:match-select (sel -String) #f #:gap-select Univ #f + (-lst -String)) + (->optkey -BtsRx (Un -StrInput -BtsInput) (N ?N -Bytes) + #:match-select (sel -Bytes) #f #:gap-select Univ #f + (-lst -Bytes)) + (->optkey -Pattern -BtsInput (N ?N -Bytes) + #:match-select (sel -Bytes) #f #:gap-select Univ #f + (-lst -Bytes))))) +(regexp-match-positions* + (let* ((?outp (-opt -Output-Port)) + (B -Boolean) + (N -Integer) + (?N (-opt -Integer)) + (ind-pair (-pair -Index -Index)) + (sel (-> (-lst (-opt ind-pair)) (-opt ind-pair))) + (output (-opt (-pair ind-pair (-lst (-opt ind-pair))))) + (-Input (Un -String -Input-Port -Bytes -Path))) + (->optkey -Pattern -Input (N ?N -Bytes) #:match-select sel #f output))) \ No newline at end of file diff --git a/collects/typed-racket/base-env/base-special-env.rkt b/collects/typed-racket/base-env/base-special-env.rkt index 0f63180d..70f18ef0 100644 --- a/collects/typed-racket/base-env/base-special-env.rkt +++ b/collects/typed-racket/base-env/base-special-env.rkt @@ -17,12 +17,10 @@ (define-syntax (define-initial-env stx) (syntax-parse stx - [(_ initialize-env [id-expr ty] ... #:middle [id-expr* ty*] ...) + [(_ initialize-env [id-expr ty] ...) #`(begin (define initial-env (make-env [id-expr (λ () ty)] ... )) - (do-time "finished special types") - (define initial-env* (make-env [id-expr* (λ () ty*)] ...)) - (define (initialize-env) (initialize-type-env initial-env) (initialize-type-env initial-env*)) + (define (initialize-env) (initialize-type-env initial-env)) (provide initialize-env))])) (define (make-template-identifier what where) @@ -41,7 +39,6 @@ ;; make-promise [(make-template-identifier 'delay 'racket/private/promise) (-poly (a) (-> (-> a) (-Promise a)))] - ;; language [(make-template-identifier 'language 'string-constants/string-constant) -Symbol] @@ -133,390 +130,7 @@ ;; same [(make-template-identifier 'with-syntax-fail 'racket/private/with-stx) (-> (-Syntax Univ) (Un))] - - + ;; from the expansion of `make-temp-file` [(make-template-identifier 'make-temporary-file/proc 'racket/file) (->opt [-String (Un -Pathlike (-val 'directory) (-val #f)) (-opt -Pathlike)] -Path)] - - ;; below here: keyword-argument functions from the base environment - ;; FIXME: abstraction to remove duplication here - #:middle - - [((kw-expander-proc (syntax-local-value #'file->string))) - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String)] - [((kw-expander-impl (syntax-local-value #'file->string))) - (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -String)] - - [((kw-expander-proc (syntax-local-value #'file->bytes))) - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes)] - [((kw-expander-impl (syntax-local-value #'file->bytes))) - (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -Bytes)] - - [((kw-expander-proc (syntax-local-value #'file->value))) - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ)] - [((kw-expander-impl (syntax-local-value #'file->value))) - (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ)] - - [((kw-expander-proc (syntax-local-value #'file->lines))) - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f - #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f - (-lst -String))] - [((kw-expander-impl (syntax-local-value #'file->lines))) - (-> (Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean - (Un (-val #f) (one-of/c 'binary 'text)) -Boolean - -Pathlike (-lst -String))] - - [((kw-expander-proc (syntax-local-value #'file->bytes-lines))) - (->key -Pathlike - #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f - #:mode (one-of/c 'binary 'text) #f - (-lst -Bytes))] - [((kw-expander-impl (syntax-local-value #'file->bytes-lines))) - (-> (Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean - (Un (-val #f) (one-of/c 'binary 'text)) -Boolean - -Pathlike (-lst -Bytes))] - - [((kw-expander-proc (syntax-local-value #'display-to-file))) - (->key Univ -Pathlike - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - #:mode (one-of/c 'binary 'text) #f - -Void)] - [((kw-expander-impl (syntax-local-value #'display-to-file))) - (-> (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) -Boolean - (Un (-val #f) (one-of/c 'binary 'text)) -Boolean - Univ -Pathlike -Void)] - - [((kw-expander-proc (syntax-local-value #'display-lines-to-file))) - (->key (-lst Univ) -Pathlike - #:separator Univ #f - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - -Void)] - [((kw-expander-impl (syntax-local-value #'display-lines-to-file))) - (-> (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) -Boolean - (Un (-val #f) (one-of/c 'binary 'text)) -Boolean - (Un (-val #f) Univ) -Boolean - (-lst Univ) -Pathlike -Void)] - - [((kw-expander-proc (syntax-local-value #'write-to-file))) - (->key Univ -Pathlike - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - #:mode (one-of/c 'binary 'text) #f - -Void)] - [((kw-expander-impl (syntax-local-value #'write-to-file))) - (-> (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) -Boolean - (Un (-val #f) (one-of/c 'binary 'text)) -Boolean - Univ -Pathlike -Void)] - - [((kw-expander-proc (syntax-local-value #'file->list))) - (-poly (a) - (cl->* (->key -Pathlike #:mode (one-of/c 'binary 'text) #f (-lst Univ)) - (->key -Pathlike (-> -Input-Port a) #:mode (one-of/c 'binary 'text) #f (-lst a))))] - [((kw-expander-impl (syntax-local-value #'file->list))) - (-poly (a) - (cl->* (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) (-val #t) (-lst a)) - (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ -Boolean (-lst Univ))))] - - [((kw-expander-proc (syntax-local-value #'get-preference))) - (let ((use-lock-type Univ) - (timeout-lock-there-type (-opt (-> -Path Univ))) - (lock-there-type (-opt (-> -Path Univ)))) - (cl->* - (->key -Symbol - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key -Symbol (-> Univ) - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key -Symbol (-> Univ) Univ - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ) - (->key -Symbol (-> Univ) Univ (-opt -Pathlike) - #:use-lock? use-lock-type #f #:timeout-lock-there timeout-lock-there-type #f #:lock-there lock-there-type #f - Univ)))] - [((kw-expander-impl (syntax-local-value #'get-preference))) - (let ((use-lock-type Univ) - (timeout-lock-there-type (-opt (-> -Path Univ))) - (lock-there-type (-opt (-> -Path Univ)))) - (-> (-opt lock-there-type) -Boolean - (-opt timeout-lock-there-type) -Boolean - (-opt use-lock-type) -Boolean - -Symbol - (-opt (-> Univ)) (-opt Univ) (-opt (-opt -Pathlike)) - -Boolean -Boolean -Boolean - Univ))] - [((kw-expander-proc (syntax-local-value #'make-handle-get-preference-locked))) - (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real)) - (cl->* - (->key -Real -Symbol - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real -Symbol (-> Univ) - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real -Symbol (-> Univ) Univ - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ)) - (->key -Real -Symbol (-> Univ) Univ (-opt -Pathlike) - #:lock-there lock-there-type #f #:max-delay max-delay-type #f - (-> -Pathlike Univ))))] - [((kw-expander-impl (syntax-local-value #'make-handle-get-preference-locked))) - (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real)) - (-> (-opt lock-there-type) -Boolean - (-opt max-delay-type) -Boolean - -Real -Symbol - (-opt (-> Univ)) (-opt Univ) (-opt (-opt -Pathlike)) - -Boolean -Boolean -Boolean - (-> -Pathlike Univ)))] - - [((kw-expander-proc (syntax-local-value #'call-with-file-lock/timeout))) - (-poly (a) - (->key (-opt -Pathlike) - (one-of/c 'shared 'exclusive) - (-> a) - (-> a) - #:lock-file (-opt -Pathlike) #f - #:delay -Real #f - #:max-delay -Real #f - a))] - [((kw-expander-impl (syntax-local-value #'call-with-file-lock/timeout))) - (-poly (a) - (-> (-opt -Real) -Boolean - (-opt (-opt -Pathlike)) -Boolean - (-opt -Real) -Boolean - (-opt -Pathlike) - (one-of/c 'shared 'exclusive) - (-> a) - (-> a) - a))] - - [((kw-expander-proc (syntax-local-value #'sort))) - (-poly (a b) (cl->* ((-lst a) (a a . -> . -Boolean) - #:cache-keys? -Boolean #f - . ->key . (-lst a)) - ((-lst a) (b b . -> . -Boolean) - #:key (a . -> . b) #t - #:cache-keys? -Boolean #f - . ->key . (-lst a))))] - [((kw-expander-impl (syntax-local-value #'sort))) - (-poly (a b) - (cl->* - ;; #:key not provided - (-> - -Boolean -Boolean Univ (-val #f) - (-lst a) (a a . -> . -Boolean) - (-lst a)) - ;; #:key provided - (-> - -Boolean -Boolean (a . -> . b) (-val #t) - (-lst a) (b b . -> . -Boolean) - (-lst a))))] - - [((kw-expander-proc (syntax-local-value #'remove-duplicates))) - (-poly (a b) (cl->* - ((-lst a) . -> . (-lst a)) - ((-lst a) (a a . -> . Univ) - . -> . (-lst a)) - ((-lst a) #:key (a . -> . b) #f - . ->key . (-lst a)) - ((-lst a) (b b . -> . Univ) - #:key (a . -> . b) #t - . ->key . (-lst a))))] - [((kw-expander-impl (syntax-local-value #'remove-duplicates))) - (-poly (a b) - (cl->* - (Univ (-val #f) ;; no key - (-lst a) (-val #f) -Boolean - . -> . (-lst a)) - (Univ (-val #f) ;; no key - (-lst a) (-> a a Univ) -Boolean - . -> . (-lst a)) - ((a . -> . b) (-val #t) ;; no key - (-lst a) (-opt (-> b b Univ)) -Boolean - . -> . (-lst a))))] - - [((kw-expander-proc (syntax-local-value #'open-input-file))) - (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Input-Port)] - [((kw-expander-impl (syntax-local-value #'open-input-file))) - (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike -Input-Port)] - - [((kw-expander-proc (syntax-local-value #'open-output-file))) - (->key -Pathlike - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace) - #f - -Output-Port)] - [((kw-expander-impl (syntax-local-value #'open-output-file))) - (-> (-opt (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace)) - -Boolean - (-opt (one-of/c 'binary 'text)) -Boolean - -Pathlike - -Output-Port)] - - [((kw-expander-proc (syntax-local-value #'open-input-output-file))) - (->key -Pathlike - #:mode (one-of/c 'binary 'text) #f - #:exists (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace) - #f - (-values (list -Input-Port -Output-Port)))] - [((kw-expander-impl (syntax-local-value #'open-input-output-file))) - (-> (-opt (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace)) - -Boolean - (-opt (one-of/c 'binary 'text)) -Boolean - -Pathlike - (-values (list -Input-Port -Output-Port)))] - - [((kw-expander-proc (syntax-local-value #'call-with-input-file))) - (-poly (a) (-Pathlike (-Input-Port . -> . a) #:mode (Un (-val 'binary) (-val 'text)) #f . ->key . a))] - [((kw-expander-impl (syntax-local-value #'call-with-input-file))) - (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-Input-Port . -> . a) a))] - - [((kw-expander-proc (syntax-local-value #'call-with-output-file))) - (-poly (a) (-Pathlike (-Output-Port . -> . a) - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - #:mode (one-of/c 'binary 'text) #f - . ->key . a))] - [((kw-expander-impl (syntax-local-value #'call-with-output-file))) - (-poly (a) (-> (-opt (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace)) - -Boolean - (-opt (one-of/c 'binary 'text)) -Boolean - -Pathlike (-Output-Port . -> . a) - a))] - - ;; - - [((kw-expander-proc (syntax-local-value #'call-with-input-file*))) - (-poly (a) (-Pathlike (-Input-Port . -> . a) #:mode (Un (-val 'binary) (-val 'text)) #f . ->key . a))] - [((kw-expander-impl (syntax-local-value #'call-with-input-file*))) - (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-Input-Port . -> . a) a))] - - [((kw-expander-proc (syntax-local-value #'call-with-output-file*))) - (-poly (a) (-Pathlike (-Output-Port . -> . a) - #:exists (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) #f - #:mode (one-of/c 'binary 'text) #f - . ->key . a))] - [((kw-expander-impl (syntax-local-value #'call-with-output-file*))) - (-poly (a) (-> (-opt (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace)) - -Boolean - (-opt (one-of/c 'binary 'text)) -Boolean - -Pathlike (-Output-Port . -> . a) - a))] - ;; - [((kw-expander-proc (syntax-local-value #'with-input-from-file))) - (-poly (a) (-Pathlike (-> a) #:mode (Un (-val 'binary) (-val 'text)) #f . ->key . a))] - [((kw-expander-impl (syntax-local-value #'with-input-from-file))) - (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> a) a))] - - [((kw-expander-proc (syntax-local-value #'with-output-to-file))) - (-poly (a) (->key -Pathlike (-> a) - #:exists (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace) - #f - #:mode (one-of/c 'binary 'text) #f - a))] - [((kw-expander-impl (syntax-local-value #'with-output-to-file))) - (-poly (a) (-> (-opt (one-of/c 'error 'append 'update 'can-update - 'replace 'truncate - 'must-truncate 'truncate/replace)) - -Boolean - (-opt (one-of/c 'binary 'text)) -Boolean - -Pathlike (-> a) - a))] - - - [((kw-expander-proc (syntax-local-value #'port->lines))) - (cl->* - (->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String)) - (->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String)))] - [((kw-expander-impl (syntax-local-value #'port->lines))) - ((-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean - (-opt -Input-Port) -Boolean - . -> . - (-lst -String))] - - - [((kw-expander-proc (syntax-local-value #'port->bytes-lines))) - (cl->* - (->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes)) - (->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes)))] - [((kw-expander-impl (syntax-local-value #'port->bytes-lines))) - ((-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean - (-opt -Input-Port) -Boolean - . -> . - (-lst -Bytes))] - - - [((kw-expander-proc (syntax-local-value #'display-lines))) - (cl->* - ((-lst Univ) #:separator Univ #f . ->key . -Void) - ((-lst Univ) -Output-Port #:separator Univ #f . ->key . -Void))] - [((kw-expander-impl (syntax-local-value #'display-lines))) - ((-opt Univ) -Boolean - (-lst Univ) - (-opt -Output-Port) -Boolean - . -> . -Void)] - ; [find-relative-path (-SomeSystemPathlike -SomeSystemPathlike . -> . -SomeSystemPath)] - [((kw-expander-proc (syntax-local-value #'find-relative-path))) - (-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))] - - ) diff --git a/collects/typed-racket/env/lexical-env.rkt b/collects/typed-racket/env/lexical-env.rkt index 20eb9543..91c4cec7 100644 --- a/collects/typed-racket/env/lexical-env.rkt +++ b/collects/typed-racket/env/lexical-env.rkt @@ -9,7 +9,9 @@ (require "../utils/utils.rkt" "type-env-structs.rkt" "global-env.rkt" + "../types/kw-types.rkt" syntax/id-table + racket/keyword-transform racket/list (for-syntax syntax/parse syntax/parse/experimental/contract racket/base) (only-in scheme/contract ->* -> or/c any/c listof cons/c) (utils tc-utils mutated-vars) @@ -40,7 +42,21 @@ ;; find the type of identifier i, looking first in the lexical env, then in the top-level env ;; identifier -> Type (define (lookup-type/lexical i [env (lexical-env)] #:fail [fail #f]) - (lookup env i (λ (i) (lookup-type i (λ () ((or fail lookup-fail) i)))))) + (lookup env i (λ (i) (lookup-type i (λ () + (cond + [(syntax-procedure-alias-property i) + => (λ (prop) + (define orig (car (flatten prop))) + (define t (lookup-type/lexical orig env)) + (register-type i t) + t)] + [(syntax-procedure-converted-arguments-property i) + => (λ (prop) + (define orig (car (flatten prop))) + (define t (kw-convert (lookup-type/lexical orig env))) + (register-type i t) + t)] + [else ((or fail lookup-fail) i)])))))) ;; refine the type of i in the lexical env ;; (identifier type -> type) identifier -> environment diff --git a/collects/typed-racket/rep/type-rep.rkt b/collects/typed-racket/rep/type-rep.rkt index 6abbd38b..6f970194 100644 --- a/collects/typed-racket/rep/type-rep.rkt +++ b/collects/typed-racket/rep/type-rep.rkt @@ -233,6 +233,19 @@ (combine-frees (map free-idxs* (cons dty rs))))] [#:fold-rhs (*ValuesDots (map type-rec-id rs) (type-rec-id dty) dbound)]) +;; lazy-arr is NOT a Type +(def-type lazy-arr ([mand (listof Type/c)] + [opt (listof Type/c)] + [rng (or/c Values? ValuesDots?)] + [rest (or/c #f Type/c)] + [drest #f] ;; to be extended later + [kws (listof Keyword?)]) + [#:intern (list (map Rep-seq mand) (map Rep-seq opt) (Rep-seq rng) (and rest (Rep-seq rest)) + (and drest (cons (Rep-seq (car drest)) (cdr drest))) + (map Rep-seq kws))] + [#:frees (λ _ (int-err "lazy-arr frees"))] + [#:fold-rhs (int-err "lazy-arr fold")]) + ;; arr is NOT a Type (def-type arr ([dom (listof Type/c)] [rng (or/c Values? ValuesDots?)] diff --git a/collects/typed-racket/types/abbrev.rkt b/collects/typed-racket/types/abbrev.rkt index ed3ead09..8149d259 100644 --- a/collects/typed-racket/types/abbrev.rkt +++ b/collects/typed-racket/types/abbrev.rkt @@ -14,7 +14,7 @@ racket/udp (except-in racket/contract/base ->* ->) (prefix-in c: racket/contract/base) - (for-syntax racket/base syntax/parse) + (for-syntax racket/base syntax/parse racket/list) (for-template racket/base racket/contract/base racket/promise racket/tcp racket/flonum) racket/pretty racket/udp racket/place ;; for base type predicates @@ -399,7 +399,25 @@ (list (make-arr* (list ty ...) rng - #:kws (list (make-Keyword 'k kty opt) ...))))])) + #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw]) + (list (make-Keyword 'k kty opt) ...) + keywordoptkey stx) + (syntax-parse stx + [(_ ty:expr ... [oty:expr ...] (~seq k:keyword kty:expr opt:boolean) ... rng) + (let ([l (syntax->list #'(oty ...))]) + (with-syntax ([((extra ...) ...) + (for/list ([i (in-range (add1 (length l)))]) + (take l i))]) + #'(make-Function + (list + (make-arr* (list ty ... extra ...) + rng + #:kws (sort #:key (match-lambda [(Keyword: kw _ _) kw]) + (list (make-Keyword 'k kty opt) ...) + keyword (values Type Type) +(define (convert kw-t plain-t opt-t rng rest drest) + (define-values (mand-kw-t opt-kw-t) (partition (match-lambda [(Keyword: _ _ m) m]) kw-t)) + (define arities + (for/list ([i (length opt-t)]) + (make-arr* (append plain-t (take opt-t i)) + rng + #:kws kw-t + #:rest rest + #:drest drest))) + (define ts + (flatten + (list + mand-kw-t + (for/list ([k (in-list opt-kw-t)]) + (match k + [(Keyword: _ t _) (list (-opt t) -Boolean)])) + plain-t + (for/list ([t (in-list opt-t)]) (-opt t)) + (for/list ([t (in-list opt-t)]) -Boolean)))) + (make-Function (list (make-arr* ts rng #:rest rest #:drest drest)))) + +(define (prefix-of a b) + (define (drest-equal? a b) + (match* (a b) + [((list t b) (list t* b*)) (and (type-equal? t t*) (equal? b b*))] + [(_ _) #f])) + (define (kw-equal? a b) + (and (equal? (length a) (length b)) + (for/and ([k1 a] [k2 b]) + (type-equal? k1 k2)))) + (match* (a b) + [((arr: args result rest drest kws) + (arr: args* result* rest* drest* kws*)) + (and (< (length args) (length args*)) + (or (equal? rest rest*) (type-equal? rest rest*)) + (or (equal? drest drest*) (drest-equal? drest drest*)) + (type-equal? result result*) + (or (equal? kws kws*) (kw-equal? kws kws*)) + (for/and ([p args] [p* args*]) + (type-equal? p p*)))])) + +(define (arity-length a) + (match a + [(arr: args result rest drest kws) (length args)])) + + +(define (arg-diff a1 a2) + (match a2 + [(arr: args _ _ _ _) (drop args (arity-length a1))])) + +(define (find-prefixes l) + (define l* (sort l < #:key arity-length)) + (for/fold ([d (list)]) ([e (in-list l*)]) + (define prefix (for/or ([p (in-dict-keys d)]) + (and (prefix-of p e) p))) + (if prefix + (dict-set d prefix (arg-diff prefix e)) + (dict-set d e empty)))) + +(define (kw-convert ft) + (match ft + [(Function: arrs) + (define table (find-prefixes arrs)) + (define fns + (for/list ([(k v) (in-dict table)]) + (match k + [(arr: mand rng rest drest kws) + (convert kws mand v rng rest drest)]))) + (apply cl->* fns)] + [(Poly-names: names (Function: arrs)) + (define table (find-prefixes arrs)) + (define fns + (for/list ([(k v) (in-dict table)]) + (match k + [(arr: mand rng rest drest kws) + (convert kws mand v rng rest drest)]))) + (make-Poly names (apply cl->* fns))] + [_ (int-err 'kw-convert "non-function type" ft)])) + +(provide kw-convert) + +#| +(define pre + (list + (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -String) + (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Bytes) + (->key -Pathlike #:mode (one-of/c 'binary 'text) #f Univ) + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:line-mode + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + #f + (-lst -String)) + (->key + -Pathlike + #:line-mode + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + #f + #:mode + (one-of/c 'binary 'text) + #f + (-lst -Bytes)) + (->key + Univ + -Pathlike + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + -Void) + (->key + (-lst Univ) + -Pathlike + #:separator + Univ + #f + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + -Void) + (->key + Univ + -Pathlike + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + -Void) + (-poly + (a) + (cl->* + (->optkey -Pathlike [(-> -Input-Port a)] #:mode (one-of/c 'binary 'text) #f (-lst a)) + (->optkey -Pathlike [(-> -Input-Port Univ)] #:mode (one-of/c 'binary 'text) #f (-lst Univ)))) + (let ((use-lock-type Univ) (timeout-lock-there-type (-opt (-> -Path Univ))) (lock-there-type (-opt (-> -Path Univ)))) + (cl->* + (->key + -Symbol + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + Univ + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ) + (->key + -Symbol + (-> Univ) + Univ + (-opt -Pathlike) + #:use-lock? + use-lock-type + #f + #:timeout-lock-there + timeout-lock-there-type + #f + #:lock-there + lock-there-type + #f + Univ))) + (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real)) + (cl->* + (->key -Real -Symbol #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ)) + (->key -Real -Symbol (-> Univ) #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ)) + (->key -Real -Symbol (-> Univ) Univ #:lock-there lock-there-type #f #:max-delay max-delay-type #f (-> -Pathlike Univ)) + (->key + -Real + -Symbol + (-> Univ) + Univ + (-opt -Pathlike) + #:lock-there + lock-there-type + #f + #:max-delay + max-delay-type + #f + (-> -Pathlike Univ)))) + (-poly + (a) + (->key + (-opt -Pathlike) + (one-of/c 'shared 'exclusive) + (-> a) + (-> a) + #:lock-file + (-opt -Pathlike) + #f + #:delay + -Real + #f + #:max-delay + -Real + #f + a)) + (-poly + (a b) + (cl->* + (->key (-lst a) (-> a a -Boolean) #:key (-> a a) #f #:cache-keys? -Boolean #f (-lst a)) + (->key (-lst a) (-> b b -Boolean) #:key (-> a b) #f #:cache-keys? -Boolean #f (-lst a)))) + (-poly + (a b) + (cl->* + (->optkey (-lst a) [(-> a a Univ)] #:key (-> a a) #f (-lst a)) + (->optkey (-lst a) [(-> b b Univ)] #:key (-> a b) #f (-lst a)))) + (->key -Pathlike #:mode (one-of/c 'binary 'text) #f -Input-Port) + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + -Output-Port) + (->key + -Pathlike + #:mode + (one-of/c 'binary 'text) + #f + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + (-values (list -Input-Port -Output-Port))) + (-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a)) + (-poly + (a) + (->key + -Pathlike + (-> -Output-Port a) + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate) + #f + #:mode + (one-of/c 'binary 'text) + #f + a)) + (-poly (a) (->key -Pathlike (-> -Input-Port a) #:mode (Un (-val 'binary) (-val 'text)) #f a)) + (-poly + (a) + (->key + -Pathlike + (-> -Output-Port a) + #:exists + (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace 'can-update 'must-truncate) + #f + #:mode + (one-of/c 'binary 'text) + #f + a)) + (-poly (a) (->key -Pathlike (-> a) #:mode (Un (-val 'binary) (-val 'text)) #f a)) + (-poly + (a) + (->key + -Pathlike + (-> a) + #:exists + (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace) + #f + #:mode + (one-of/c 'binary 'text) + #f + a)) + (cl->* + (->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String)) + (->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -String))) + (cl->* + (->key #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes)) + (->key -Input-Port #:line-mode (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) #f (-lst -Bytes))) + (cl->* (->key (-lst Univ) #:separator Univ #f -Void) (->key (-lst Univ) -Output-Port #:separator Univ #f -Void)) + (->key -SomeSystemPathlike -SomeSystemPathlike #:more-than-root? Univ #f -SomeSystemPath) + (let ((N -Integer) + (?N (-opt -Integer)) + (-StrRx (Un -String -Regexp)) + (-BtsRx (Un -Bytes -Byte-Regexp)) + (-StrInput (Un -String -Path)) + (-BtsInput (Un -Input-Port -Bytes)) + (sel (λ (t) (-opt (-> (-lst t) t))))) + (cl->* + (->optkey -StrRx -StrInput (N ?N -Bytes) + #:match-select (sel -String) #f #:gap-select Univ #f + (-lst -String)) + (->optkey -BtsRx (Un -StrInput -BtsInput) (N ?N -Bytes) + #:match-select (sel -Bytes) #f #:gap-select Univ #f + (-lst -Bytes)) + (->optkey -Pattern -BtsInput (N ?N -Bytes) + #:match-select (sel -Bytes) #f #:gap-select Univ #f + (-lst -Bytes)))) + (let* ((?outp (-opt -Output-Port)) + (B -Boolean) + (N -Integer) + (?N (-opt -Integer)) + (ind-pair (-pair -Index -Index)) + (sel (-> (-lst (-opt ind-pair)) (-opt ind-pair))) + (output (-opt (-pair ind-pair (-lst (-opt ind-pair))))) + (-Input (Un -String -Input-Port -Bytes -Path))) + (->optkey -Pattern -Input [N ?N -Bytes] #:match-select sel #f output)))) + +(define post + (list (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -String) + (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike -Bytes) + (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ) + (-> + (Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) + -Boolean + (Un (-val #f) (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-lst -String)) + (-> + (Un (-val #f) (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) + -Boolean + (Un (-val #f) (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-lst -Bytes)) + (-> + (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) + -Boolean + (Un (-val #f) (one-of/c 'binary 'text)) + -Boolean + Univ + -Pathlike + -Void) + (-> + (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) + -Boolean + (Un (-val #f) (one-of/c 'binary 'text)) + -Boolean + (Un (-val #f) Univ) + -Boolean + (-lst Univ) + -Pathlike + -Void) + (-> + (Un (-val #f) (one-of/c 'error 'append 'update 'replace 'truncate 'truncate/replace)) + -Boolean + (Un (-val #f) (one-of/c 'binary 'text)) + -Boolean + Univ + -Pathlike + -Void) + (-poly + (a) + (cl->* + (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) (-val #t) (-lst a)) + (-> (Un (-val #f) (one-of/c 'binary 'text)) -Boolean -Pathlike Univ -Boolean (-lst Univ)))) + (let ((use-lock-type Univ) (timeout-lock-there-type (-opt (-> -Path Univ))) (lock-there-type (-opt (-> -Path Univ)))) + (-> + (-opt lock-there-type) + -Boolean + (-opt timeout-lock-there-type) + -Boolean + (-opt use-lock-type) + -Boolean + -Symbol + (-opt (-> Univ)) + (-opt Univ) + (-opt (-opt -Pathlike)) + -Boolean + -Boolean + -Boolean + Univ)) + (let ((lock-there-type (-opt (-> -Path Univ))) (max-delay-type -Real)) + (-> + (-opt lock-there-type) + -Boolean + (-opt max-delay-type) + -Boolean + -Real + -Symbol + (-opt (-> Univ)) + (-opt Univ) + (-opt (-opt -Pathlike)) + -Boolean + -Boolean + -Boolean + (-> -Pathlike Univ))) + (-poly + (a) + (-> + (-opt -Real) + -Boolean + (-opt (-opt -Pathlike)) + -Boolean + (-opt -Real) + -Boolean + (-opt -Pathlike) + (one-of/c 'shared 'exclusive) + (-> a) + (-> a) + a)) + (-poly + (a b) + (cl->* + (-> -Boolean -Boolean Univ (-val #f) (-lst a) (-> a a -Boolean) (-lst a)) + (-> -Boolean -Boolean (-> a b) (-val #t) (-lst a) (-> b b -Boolean) (-lst a)))) + (-poly + (a b) + (cl->* + (-> Univ (-val #f) (-lst a) (-val #f) -Boolean (-lst a)) + (-> Univ (-val #f) (-lst a) (-> a a Univ) -Boolean (-lst a)) + (-> (-> a b) (-val #t) (-lst a) (-opt (-> b b Univ)) -Boolean (-lst a)))) + (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike -Input-Port) + (-> + (-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)) + -Boolean + (-opt (one-of/c 'binary 'text)) + -Boolean + -Pathlike + -Output-Port) + (-> + (-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)) + -Boolean + (-opt (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-values (list -Input-Port -Output-Port))) + (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) a)) + (-poly + (a) + (-> + (-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)) + -Boolean + (-opt (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-> -Output-Port a) + a)) + (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> -Input-Port a) a)) + (-poly + (a) + (-> + (-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)) + -Boolean + (-opt (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-> -Output-Port a) + a)) + (-poly (a) (-> (-opt (one-of/c 'binary 'text)) -Boolean -Pathlike (-> a) a)) + (-poly + (a) + (-> + (-opt (one-of/c 'error 'append 'update 'can-update 'replace 'truncate 'must-truncate 'truncate/replace)) + -Boolean + (-opt (one-of/c 'binary 'text)) + -Boolean + -Pathlike + (-> a) + a)) + (-> (-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean (-opt -Input-Port) -Boolean (-lst -String)) + (-> (-opt (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one)) -Boolean (-opt -Input-Port) -Boolean (-lst -Bytes)) + (-> (-opt Univ) -Boolean (-lst Univ) (-opt -Output-Port) -Boolean -Void) + (-> Univ -Boolean -SomeSystemPathlike -SomeSystemPathlike -SomeSystemPath) + (let ((N -Integer) + (B -Boolean) + (?N (-opt -Integer)) + (-StrRx (Un -String -Regexp)) + (-BtsRx (Un -Bytes -Byte-Regexp)) + (-StrInput (Un -String -Path)) + (sel (λ (t) (-opt (-> (-lst t) t)))) + (-BtsInput (Un -Input-Port -Bytes))) + (cl->* + (-> Univ B (sel -String) B -StrRx -StrInput + (-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -String)) + (-> Univ B (sel -Bytes) B -BtsRx (Un -StrInput -BtsInput) + (-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -Bytes)) + (-> Univ B (sel -Bytes) B -Pattern -BtsInput + (-opt N) (-opt ?N) (-opt -Bytes) B B B (-lst -Bytes)))) + + (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))))] + (sel (-> (-lst (-opt ind-pair)) (-opt ind-pair))) + [-Input (Un -String -Input-Port -Bytes -Path)]) + (-> (-opt sel) B -Pattern -Input (-opt N) (-opt ?N) (-opt -Bytes) B B B output)))) +|# \ No newline at end of file