Fix keyword function type conversion in TR

Makes rest arguments work properly and handles
keywords passed in by sorted order.

original commit: c8554e2489beaab392fe46c9b3eafeb0bf8c2d22

pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt

@@ -19,6 +19,8 @@
                  #:kws kw-t
                  #:rest rest
                  #:drest drest)))
+  ;; the kw function protocol passes rest args as an explicit list
+  (define rest-type (if rest (-lst rest) empty))
   (define ts 
     (flatten
      (list
@@ -31,39 +33,38 @@
       plain-t
       (for/list ([t (in-list opt-t)]) (-opt t))
       (for/list ([t (in-list opt-t)]) -Boolean)
-      ;; the kw function protocol passes rest args as an explicit list
-      (if rest (-lst rest) empty))))
+      rest-type)))
+  ;; the kw protocol puts the arguments in keyword-sorted order in the
+  ;; function header, so we need to sort the types to match
+  (define sorted-kws
+    (sort kw-t keyword<? #:key (match-lambda [(Keyword: kw _ _) kw])))
   (define ts/true
     (flatten
      (list
-      (for/list ([k (in-list mand-kw-t)])
+      (for/list ([k (in-list sorted-kws)])
         (match k
-          [(Keyword: _ t _) t]))
-      (for/list ([k (in-list opt-kw-t)])
-        (match k
-          [(Keyword: _ t _) (list t (-val #t))]))
+          [(Keyword: _ t #t) t]
+          [(Keyword: _ t #f) (list t (-val #t))]))
       plain-t
       (for/list ([t (in-list opt-t)]) t)
       (for/list ([t (in-list opt-t)]) (-val #t))
-      ;; the kw function protocol passes rest args as an explicit list
-      (if rest (-lst rest) empty))))
+      rest-type)))
   (define ts/false
     (flatten
      (list
-      (for/list ([k (in-list mand-kw-t)])
+      (for/list ([k (in-list sorted-kws)])
         (match k
-          [(Keyword: _ t _) t]))
-      (for/list ([k (in-list opt-kw-t)])
-        (match k
-          [(Keyword: _ t _) (list (-val #f) (-val #f))]))
+          [(Keyword: _ t #t) t]
+          [(Keyword: _ t #f) (list (-val #f) (-val #f))]))
       plain-t
       (for/list ([t (in-list opt-t)]) (-val #f))
-      (for/list ([t (in-list opt-t)]) (-val #f)))))
+      (for/list ([t (in-list opt-t)]) (-val #f))
+      rest-type)))
   (make-Function
     (if split?
         (remove-duplicates
-          (list (make-arr* ts/true rng #:rest rest #:drest drest)
-                (make-arr* ts/false rng #:rest rest #:drest drest)))
+          (list (make-arr* ts/true rng #:drest drest)
+                (make-arr* ts/false rng #:drest drest)))
         (list (make-arr* ts rng #:rest rest #:drest drest)))))
 
 (define (prefix-of a b)

pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/kw-def.rkt

@@ -32,3 +32,56 @@
 
 (g 0 #:k 1)
 (g2 0 #:k 1)
+
+;; Additional keyword function tests
+;; FIXME: These really belong in the unit tests, but for some reason
+;;        the unit tests don't work well with keywords.
+(: f0:a (#:a String -> (List String)))
+(define (f0:a #:a a) (list a))
+
+(: f1:a (Symbol #:a String -> (List Symbol String)))
+(define (f1:a x #:a a) (list x a))
+
+(: f1:a? (Symbol [#:a String] -> (List Symbol String)))
+(define (f1:a? x #:a [a "a"]) (list x a))
+
+(: f1+:a (String #:a String String * -> (Listof String)))
+(define (f1+:a x #:a a . args) (cons x (cons a args)))
+
+(: f1+:a? (String [#:a String] String * -> (Listof String)))
+(define (f1+:a? x #:a [a "a"] . args) (cons x (cons a args)))
+
+(: f0:a:b (#:a String #:b Symbol -> (List String Symbol)))
+(define (f0:a:b #:a a #:b b) (list a b))
+
+(: f0:a?:b ([#:a String] #:b Symbol -> (List String Symbol)))
+(define (f0:a?:b #:a [a "a"] #:b b) (list a b))
+
+(: f1:a:b (String #:a String #:b Symbol -> (List String String Symbol)))
+(define (f1:a:b x #:a a #:b b) (list x a b))
+
+(: f1:a?:b (String [#:a String] #:b Symbol -> (List String String Symbol)))
+(define (f1:a?:b x #:a [a "a"] #:b b) (list x a b))
+
+(: f1+:a:b (String #:a String #:b String String * -> (Listof String)))
+(define (f1+:a:b x #:a a #:b b . args) (cons x (cons a (cons b args))))
+
+(: f0:a:b? (#:a String [#:b Symbol] -> (List String Symbol)))
+(define (f0:a:b? #:a a #:b [b 'b]) (list a b))
+
+(: f0:a?:b? ([#:a String] [#:b Symbol] -> (List String Symbol)))
+(define (f0:a?:b? #:a [a "a"] #:b [b 'b]) (list a b))
+
+(: f1:a:b? (String #:a String [#:b Symbol] -> (List String String Symbol)))
+(define (f1:a:b? x #:a a #:b [b 'b]) (list x a b))
+
+(: f1:a?:b? (String [#:a String] [#:b Symbol] -> (List String String Symbol)))
+(define (f1:a?:b? x #:a [a "a"] #:b [b 'b]) (list x a b))
+
+(: f1+:a:b? (String #:a String [#:b String] String * -> (Listof String)))
+(define (f1+:a:b? x #:a a #:b [b "b"] . args)
+  (cons x (cons a (cons b args))))
+
+(: f1+:a?:b? (String [#:a String] [#:b String] String * -> (Listof String)))
+(define (f1+:a?:b? x #:a [a "a"] #:b [b "b"] . args)
+  (cons x (cons a (cons b args))))