Merge pull request #4846 from unisonweb/topic/many-rollback

Split corrected many pattern into two patterns

parser-typechecker/src/Unison/Builtin.hs

@@ -506,6 +506,7 @@ builtinsSrc =
     B "Text.patterns.notCharIn" $ list char --> pat text,
     -- Pattern.many : Pattern a -> Pattern a
     B "Pattern.many" $ forall1 "a" (\a -> pat a --> pat a),
+    B "Pattern.many.corrected" $ forall1 "a" (\a -> pat a --> pat a),
     B "Pattern.replicate" $ forall1 "a" (\a -> nat --> nat --> pat a --> pat a),
     B "Pattern.capture" $ forall1 "a" (\a -> pat a --> pat a),
     B "Pattern.captureAs" $ forall1 "a" (\a -> a --> pat a --> pat a),

parser-typechecker/src/Unison/Runtime/Builtin.hs

@@ -3103,7 +3103,9 @@ declareForeigns = do
       _ -> die "Text.patterns.notCharIn: non-character closure"
     evaluate . TPat.cpattern . TPat.Char . TPat.Not $ TPat.CharSet cs
   declareForeign Untracked "Pattern.many" boxDirect . mkForeign $
-    \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many p
+    \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many False p
+  declareForeign Untracked "Pattern.many.corrected" boxDirect . mkForeign $
+    \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Many True p
   declareForeign Untracked "Pattern.capture" boxDirect . mkForeign $
     \(TPat.CP p _) -> evaluate . TPat.cpattern $ TPat.Capture p
   declareForeign Untracked "Pattern.captureAs" boxBoxDirect . mkForeign $

parser-typechecker/src/Unison/Util/Text/Pattern.hs

@@ -12,7 +12,7 @@ data Pattern
   | Or Pattern Pattern -- left-biased choice: tries second pattern only if first fails
   | Capture Pattern -- capture all the text consumed by the inner pattern, discarding its subcaptures
   | CaptureAs Text Pattern -- capture the given text, discarding its subcaptures, and name the capture
-  | Many Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p])
+  | Many Bool Pattern -- zero or more repetitions (at least 1 can be written: Join [p, Many p]); boolean determines whether it's the correct version (True) or the original (False).
   | Replicate Int Int Pattern -- m to n occurrences of a pattern, optional = 0-1
   | Eof -- succeed if given the empty text, fail otherwise
   | Literal Text -- succeed if input starts with the given text, advance by that text
@@ -128,7 +128,7 @@ compile (CaptureAs t p) !err !success = go
     success' _ rem acc0 _ = success (pushCapture t acc0) rem
     compiled = compile p err' success'
     go acc t = compiled acc t acc t
-compile (Capture (Many (Char Any))) !_ !success = \acc t -> success (pushCapture t acc) Text.empty
+compile (Capture (Many _ (Char Any))) !_ !success = \acc t -> success (pushCapture t acc) Text.empty
 compile (Capture c) !err !success = go
   where
     err' _ _ acc0 t0 = err acc0 t0
@@ -152,12 +152,13 @@ compile (Char cp) !err !success = go
     go acc t = case Text.uncons t of
       Just (ch, rem) | ok ch -> success acc rem
       _ -> err acc t
-compile (Many p) !_ !success = case p of
+compile (Many correct p) !_ !success = case p of
   Char Any -> (\acc _ -> success acc Text.empty)
   Char cp -> walker (charPatternPred cp)
   p -> go
     where
-      go = try "Many" (compile p) success success'
+      go | correct = try "Many" (compile p) success success'
+         | otherwise = compile p success success'
       success' acc rem
         | Text.size rem == 0 = success acc rem
         | otherwise = go acc rem

parser-typechecker/tests/Unison/Test/Util/Text.hs

@@ -114,12 +114,12 @@ test =
         expect' (P.run (P.Char (P.CharSet "0123")) "3ab" == Just ([], "ab"))
         expect' (P.run (P.Char (P.Not (P.CharSet "0123"))) "a3b" == Just ([], "3b"))
         expect' (P.run (P.Capture (P.Char (P.Not (P.CharSet "0123")))) "a3b" == Just (["a"], "3b"))
-        expect' (P.run (P.Many (P.Char (P.CharSet "abcd"))) "babbababac123" == Just ([], "123"))
-        expect' (P.run (P.Capture (P.Many (P.Char (P.CharSet "abcd")))) "babbababac123" == Just (["babbababac"], "123"))
-        expect' (P.run (P.Capture (P.Many (P.Char (P.CharClass P.Number)))) "012345abc" == Just (["012345"], "abc"))
-        expect' (P.run (P.Join [P.Capture (P.Many (P.Char (P.CharClass P.Number))), P.Literal ",", P.Capture (P.Many (P.Char P.Any))]) "012345,abc" == Just (["012345", "abc"], ""))
+        expect' (P.run (P.Many True (P.Char (P.CharSet "abcd"))) "babbababac123" == Just ([], "123"))
+        expect' (P.run (P.Capture (P.Many True (P.Char (P.CharSet "abcd")))) "babbababac123" == Just (["babbababac"], "123"))
+        expect' (P.run (P.Capture (P.Many True (P.Char (P.CharClass P.Number)))) "012345abc" == Just (["012345"], "abc"))
+        expect' (P.run (P.Join [P.Capture (P.Many True (P.Char (P.CharClass P.Number))), P.Literal ",", P.Capture (P.Many True (P.Char P.Any))]) "012345,abc" == Just (["012345", "abc"], ""))
         expect'
-          ( P.run (P.Many (P.Join [P.Capture (P.Many (P.Char (P.CharClass P.Number))), P.Many (P.Char (P.CharClass P.Whitespace))])) "01 10 20 1123 292 110 10"
+          ( P.run (P.Many True (P.Join [P.Capture (P.Many True (P.Char (P.CharClass P.Number))), P.Many True (P.Char (P.CharClass P.Whitespace))])) "01 10 20 1123 292 110 10"
               == Just (["01", "10", "20", "1123", "292", "110", "10"], "")
           )
         expect' $

scheme-libs/racket/unison/primops.ss

@@ -248,6 +248,8 @@
     builtin-Char.Class.is:termlink
     builtin-Pattern.captureAs
     builtin-Pattern.captureAs:termlink
+    builtin-Pattern.many.corrected
+    builtin-Pattern.many.corrected:termlink
     builtin-Pattern.isMatch
     builtin-Pattern.isMatch:termlink
     builtin-IO.fileExists.impl.v3
@@ -740,6 +742,7 @@
   (define-builtin-link Universal.compare)
   (define-builtin-link Universal.murmurHash)
   (define-builtin-link Pattern.captureAs)
+  (define-builtin-link Pattern.many.corrected)
   (define-builtin-link Pattern.isMatch)
   (define-builtin-link Char.Class.is)
   (define-builtin-link Scope.bytearrayOf)
@@ -862,6 +865,8 @@
     (define-unison (builtin-Pattern.captureAs c p)
       (capture-as c p))
 
+    (define-unison (builtin-Pattern.many.corrected p) (many p))
+
     (define-unison (builtin-Pattern.isMatch p s)
       (pattern-match? p s))
 
@@ -1457,5 +1462,6 @@
   (declare-builtin-link builtin-Pattern.isMatch)
   (declare-builtin-link builtin-Scope.bytearrayOf)
   (declare-builtin-link builtin-Char.Class.is)
+  (declare-builtin-link builtin-Pattern.many.corrected)
   (declare-builtin-link builtin-unsafe.coerceAbilities)
   )