From d2a4b87d4d92aa86b2522227c71b61dbe3218749 Mon Sep 17 00:00:00 2001
From: Ben Greenman <benjaminlgreenman@gmail.com>
Date: Mon, 13 Jun 2016 20:42:20 -0400
Subject: [PATCH] [private] rx: add annotation, to avoid prevent contract
 errors

---
 test/regexp-fail.rkt       | 10 +++++++++-
 trivial/private/regexp.rkt | 18 ++++++++++--------
 2 files changed, 19 insertions(+), 9 deletions(-)

diff --git a/test/regexp-fail.rkt b/test/regexp-fail.rkt
index 578d6c8..25b904a 100644
--- a/test/regexp-fail.rkt
+++ b/test/regexp-fail.rkt
@@ -48,8 +48,16 @@
   ;; -- expected String, given Bytes
   (with-input-from-string "hello"
     (lambda ()
-      (define m (regexp-match #rx#"lang" (current-input-port)))
+      (define m (regexp-match: #rx#"lang" (current-input-port)))
       (and m (string=? (car m) "lang"))))
+
+  ;; ---- is raising a type error, which is GOOD, but throwing during test
+  ;;; -- return type assumed to be String, but really is Bytes
+  ;;;    (ugly, but at least we catch it statically)
+  ;(with-input-from-file "test/regexp-fail.rkt"
+  ;  (lambda ()
+  ;    (define m (regexp-match: #rx"lang" (current-input-port)))
+  ;    (and m (bytes=? #;string=? (car m) #"lang"))))
 )
 
 ;; 2016-06-13 : these really should be errors, just no-opts
diff --git a/trivial/private/regexp.rkt b/trivial/private/regexp.rkt
index 949329d..19183a0 100644
--- a/trivial/private/regexp.rkt
+++ b/trivial/private/regexp.rkt
@@ -239,9 +239,9 @@
           (or (eq? pattern-sym 'String)
               (eq? pattern-sym 'Regexp))
           (or (syntax-parse arg-stx
-                ((x:str) #t)
-                ((x) #:when (bytes? (syntax-e #'x)) #f)
-                ;; TODO ;; ((x) #:when (port? (syntax-e #'x)) #f)
+                ((x:str arg* ...) #t)
+                ((x arg* ...) #:when (bytes? (syntax-e #'x)) #f)
+                ;; TODO ;; ((x arg* ...) #:when (port? (syntax-e #'x)) #f)
                 (_ #t))))
       'String
       'Bytes))
@@ -276,16 +276,18 @@
            (syntax/loc stx pat.evidence)
     #:with return-type
            (format-id stx "~a" (infer-return-type (syntax-e #'type-sym) #'(arg* ...)))
-    #:with (group-type* ...)
+    #:with (exact-group-type* ...)
            (let ([stx-never-fail (syntax/loc stx return-type)]
                  [stx-may-fail (syntax/loc stx (U #f return-type))])
              (for/list ([c-stx (in-list (syntax-e #'capture?*))])
-               (if (syntax-e c-stx)
-                 stx-never-fail
-                 stx-may-fail)))
+               (if (syntax-e c-stx) stx-never-fail stx-may-fail)))
     (syntax/loc stx
       (let ([maybe-match (regexp-match pat.expanded arg* ...)])
         (if maybe-match
-          (cast maybe-match (List return-type group-type* ...))
+          (cast ;; -- use `ann` to validate return type assumption & `cast` to remove #f
+                ;; 2016-06-13: ideally we should be typechecking `arg` instead of guessing
+            (ann maybe-match (Pairof return-type (Listof (U #f return-type))))
+            (List return-type exact-group-type* ...))
           #f)))]
    [_ #f]))))
+