From 59b3d5f6fe90cd12326328e5b3550c448bc4a0c5 Mon Sep 17 00:00:00 2001
From: Sergiu Ivanov <sivanov@colimite.fr>
Date: Tue, 21 Jun 2022 00:42:56 +0200
Subject: [PATCH] Add for/first/typed and for*/first/typed.

---
 scribblings/utils.scrbl | 22 ++++++++++++++++++++++
 utils.rkt               | 34 +++++++++++++++++++++++++++++++++-
 2 files changed, 55 insertions(+), 1 deletion(-)

diff --git a/scribblings/utils.scrbl b/scribblings/utils.scrbl
index 5ee9660..841a6bc 100644
--- a/scribblings/utils.scrbl
+++ b/scribblings/utils.scrbl
@@ -66,6 +66,28 @@ typing} either via a direct @racket[if] check using a predicate, or using
 (eval:error (assert-type some-number Zero1))
 ]}
 
+@deftogether[(@defform[(for/first/typed type-ann (for-clause ...) expr ...+)])
+              @defform[(for*/first/typed type-ann (for-clause ...) expr ...+)]]{
+
+Typed versions of @racket[for/first] and @racket[for*/first].
+
+@ex[
+(for/first/typed : (Option Integer)
+                 ([i (in-range 1 10)]
+                  #:when (zero? (modulo i 5)))
+  (* i 3))
+(for*/first/typed : (Option (Pairof Integer Integer))
+                  ([i (in-range 1 10)]
+                   [j (in-range 1 10)]
+                   #:when (> (+ i j) 5))
+  (cons i j))
+]
+
+The implementation of these macros is a simplified version the definition of
+@hyperlink["https://github.com/racket/typed-racket/blob/9d3264c97aa63b6a7163a219937b88a612add8ab/typed-racket-lib/typed-racket/base-env/prims.rkt#L512"]{@racket[define-for/acc:-variant]}.
+
+}
+
 @section{Hashtable injection}
 
 This section defines some utilities to streamline the usage of hash tables
diff --git a/utils.rkt b/utils.rkt
index efd1d99..4cc5421 100644
--- a/utils.rkt
+++ b/utils.rkt
@@ -6,7 +6,7 @@
 (provide
  Variable VariableMapping GeneralPair
 
- assert-type
+ assert-type for/first/typed for*/first/typed
  eval-with eval1-with auto-hash-ref/explicit auto-hash-ref/:
  extract-symbols any->string stringify-variable-mapping string->any
  handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
@@ -29,6 +29,38 @@
 (define-syntax-parse-rule (assert-type e:expr type:expr)
   (assert e (make-predicate type)))
 
+(define-for-syntax (make-for/first/typed-variant folder)
+  (syntax-parser
+    #:literals (:)
+    [(_ :
+        ty:expr ; These should probably be more specific.
+        clauses:expr
+        c ...)
+     #`(#,folder : ty
+        ([result : ty #f])
+        clauses
+        #:break (not (equal? result #f))
+        c ...)]))
+
+(define-syntax for/first/typed (make-for/first/typed-variant 'for/fold))
+(define-syntax for*/first/typed (make-for/first/typed-variant 'for*/fold))
+
+(module+ test
+  (test-case "for/first/typed, for/first/typed*"
+    (check-equal? (for/first/typed : (Option Integer)
+                                   ([i (in-range 1 10)]
+                                    #:when (zero? (modulo i 5)))
+                    (* i 3))
+                  15)
+    (check-equal? (for*/first/typed : (Option (Pairof Integer Integer))
+                                    ([i (in-range 1 10)]
+                                     [j (in-range 1 10)]
+                                     #:when (> (+ i j) 5)
+                                     #:when (even? i)
+                                     #:when (even? j))
+                    (cons i j))
+                  '(2 . 4))))
+
 (: eval-with (-> (VariableMapping Any) Any AnyValues))
 (define (eval-with ht expr)
   (parameterize ([current-namespace (make-base-namespace)])