Use the new syntax properties for checking keyword functions.

Previously, some hacks were used to obtain the internal
identifiers that implemented keyword functions directly, and
give them types at startup.  Now, the primary "function"
(eg, `sort`) is given a type, and when used, the residual
syntax properties are used to find `sort` from the real
functions, and then the type of the real function is computed
from the type of `sort`.

Some creativity was required in the types of functions which
take optional arguments that when present, alter the return type,
such as `regexp-match*` and `file->list`.

original commit: a377c4235743296e337db64341c8518fc7dce965

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

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

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

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

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

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) ...)
+                                            keyword<?))))]))
+
+(define-syntax (->optkey 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<?))
+                       ...))))]))
 
 (define (make-arr-dots dom rng dty dbound)
   (make-arr* dom rng #:drest (cons dty dbound)))

collects/typed-racket/types/kw-types.rkt

@@ -0,0 +1,527 @@
+#lang racket/base
+
+(require "convenience.rkt" "../rep/type-rep.rkt"
+         "union.rkt" "abbrev.rkt" "../utils/tc-utils.rkt"
+         racket/list racket/dict racket/set racket/match)
+
+;; convert : [Listof Keyword] [Listof Type] [Listof Type] [Option Type] [Option Type] -> (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))))
+|#