diff --git a/scheme-libs/racket/unison/pattern.rkt b/scheme-libs/racket/unison/pattern.rkt index 8986e76c8e..0820d71dc0 100644 --- a/scheme-libs/racket/unison/pattern.rkt +++ b/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))] diff --git a/scheme-libs/racket/unison/primops.ss b/scheme-libs/racket/unison/primops.ss index 828c6a43bd..218bac9ee8 100644 --- a/scheme-libs/racket/unison/primops.ss +++ b/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)) diff --git a/unison-src/builtin-tests/interpreter-tests.md b/unison-src/builtin-tests/interpreter-tests.md index b27b0ab226..3530224d9c 100644 --- a/unison-src/builtin-tests/interpreter-tests.md +++ b/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 ``` diff --git a/unison-src/builtin-tests/jit-tests.md b/unison-src/builtin-tests/jit-tests.md index 073e31addb..71b60982d2 100644 --- a/unison-src/builtin-tests/jit-tests.md +++ b/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 ``` diff --git a/unison-src/builtin-tests/text-tests.u b/unison-src/builtin-tests/text-tests.u index 248009f715..086c78eee8 100644 --- a/unison-src/builtin-tests/text-tests.u +++ b/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