Implement captureAs for racket

scheme-libs/racket/unison/pattern.rkt

@@ -36,6 +36,7 @@
           [join* (-> chunked-list? pattern?)]
           [choice (-> pattern? pattern? ... pattern?)]
           [capture (-> pattern? pattern?)]
+          [capture-as (-> any/c pattern? pattern?)]
           [many (-> pattern? pattern?)]
           [replicate (-> pattern? exact-nonnegative-integer? exact-nonnegative-integer? pattern?)]
           ;; Only valid pattern? in the functions below is p:char
@@ -56,6 +57,7 @@
 (struct p:join (pats) #:transparent)
 (struct p:or (left right) #:transparent)
 (struct p:capture (pat) #:transparent)
+(struct p:capture-as (cap pat) #:transparent)
 (struct p:many (pat) #:transparent)
 (struct p:replicate (pat min-count count))
 
@@ -124,6 +126,8 @@
            (p:or (pattern-pat pat) (loop pats))])))]))
 
 (define (capture pat) (make-pattern (p:capture (pattern-pat pat))))
+(define (capture-as cap pat)
+  (make-pattern (p:capture-as cap (pattern-pat pat))))
 (define (many pat) (make-pattern (p:many (pattern-pat pat))))
 (define (replicate pat n m) (make-pattern (p:replicate (pattern-pat pat) n m)))
 
@@ -219,6 +223,20 @@
                 [else
                  (fail)]))])]
 
+        [(p:capture-as cap pat)
+         (cond
+           [in-capture?
+             (recur pat #t ok)]
+           [else
+             (define pat-m (recur pat #t done))
+             (λ (cstr captures)
+               (define-values [cstr* captures*] (pat-m cstr captures))
+               (cond
+                 [cstr*
+                  (ok cstr* (chunked-list-add-last captures* cap))]
+                 [else
+                  (fail)]))])]
+
         [(p:many (p:char 'any))
          (λ (cstr captures)
            (ok empty-chunked-string captures))]

scheme-libs/racket/unison/primops.ss

@@ -236,6 +236,8 @@
 
     builtin-Char.Class.is
     builtin-Char.Class.is:termlink
+    builtin-Pattern.captureAs
+    builtin-Pattern.captureAs:termlink
     builtin-Pattern.isMatch
     builtin-Pattern.isMatch:termlink
     builtin-IO.fileExists.impl.v3
@@ -708,6 +710,7 @@
   (define-builtin-link Universal.<=)
   (define-builtin-link Universal.compare)
   (define-builtin-link Universal.murmurHash)
+  (define-builtin-link Pattern.captureAs)
   (define-builtin-link Pattern.isMatch)
   (define-builtin-link Char.Class.is)
 
@@ -820,6 +823,9 @@
     (define-unison (builtin-Char.Class.is cc c)
       (pattern-match? cc (string->chunked-string (string c))))
 
+    (define-unison (builtin-Pattern.captureAs c p)
+      (capture-as c p))
+
     (define-unison (builtin-Pattern.isMatch p s)
       (pattern-match? p s))
 

unison-src/builtin-tests/interpreter-tests.md

@@ -54,6 +54,7 @@ to `Tests.check` and `Tests.checkEqual`).
 ```
 
 ```ucm:hide
+.> alias.term ##Pattern.captureAs Pattern.captureAs
 .> load unison-src/builtin-tests/text-tests.u
 .> add
 ```

unison-src/builtin-tests/jit-tests.md

@@ -56,6 +56,7 @@ to `Tests.check` and `Tests.checkEqual`).
 ```
 
 ```ucm:hide
+.> alias.term ##Pattern.captureAs Pattern.captureAs
 .> load unison-src/builtin-tests/text-tests.u
 .> add
 ```

unison-src/builtin-tests/text-tests.u

@@ -203,6 +203,9 @@ text.matching.tests = do
   checkEqual "Pattern api (22)"  (isMatch (join [many letter, eof]) "aaaaabbbb") true
   checkEqual "Pattern api (23)"  (isMatch (join [many letter, eof]) "aaaaabbbb1") false
   checkEqual "Pattern api (24)"  (isMatch (join [literal "abra", many (literal "cadabra")]) "abracadabracadabra") true
+  checkEqual "Pattern api (25)"
+    (run (captureAs "goodbye" (literal "hello")) "hello")
+    (Some (["goodbye"], ""))
 
 char.class.tests = do
   check "Char.Class: any" do Char.Class.is Class.any ?a