diff --git a/parsec.carp b/parsec.carp index 5227b16..6fc7683 100644 --- a/parsec.carp +++ b/parsec.carp @@ -550,166 +550,91 @@ fails if `p` succeeds. Useful for negative assertions.") (Reply.ErrConsumed _) (Reply.OkEmpty () @cur) (Reply.ErrEmpty _) (Reply.OkEmpty () @cur))))) + (private repeat-loop) + (hidden repeat-loop) + ; Shared engine for the repetition combinators. Runs `p` between `lo` + ; and `hi` times from `start-cur`: the first `lo` applications are + ; mandatory (an empty success counts toward the minimum, a failure + ; aborts), after which `p` is applied greedily up to `hi` total — + ; `hi < 0` means unbounded — stopping on an empty success or empty + ; failure (the same guard as `many`). A consumed failure always + ; aborts and keeps the consumed bit set. + (defn repeat-loop [p src len start-cur lo hi] + (let-do [c start-cur + acc [] + err (the (Maybe ParseErr) (Maybe.Nothing)) + consumed-any false + i 0 + going true] + (while-do (and going (Int.< i lo)) + (match (~(Parser.run p) src len &c) + (Reply.OkConsumed v c2) + (do + (set! acc (Array.push-back acc v)) + (set! c c2) + (set! consumed-any true)) + (Reply.OkEmpty v c2) + (do (set! acc (Array.push-back acc v)) (set! c c2)) + (Reply.ErrEmpty e) (do (set! err (Maybe.Just e)) (set! going false)) + (Reply.ErrConsumed e) + (do + (set! err (Maybe.Just e)) + (set! consumed-any true) + (set! going false))) + (set! i (Int.inc i))) + (while-do (and going (or (Int.< hi 0) (Int.< i hi))) + (match (~(Parser.run p) src len &c) + (Reply.OkConsumed v c2) + (do + (set! acc (Array.push-back acc v)) + (set! c c2) + (set! consumed-any true)) + (Reply.OkEmpty _ _) (set! going false) + (Reply.ErrEmpty _) (set! going false) + (Reply.ErrConsumed e) + (do + (set! err (Maybe.Just e)) + (set! consumed-any true) + (set! going false))) + (set! i (Int.inc i))) + (match err + (Maybe.Just e) + (if consumed-any (Reply.ErrConsumed e) (Reply.ErrEmpty e)) + (Maybe.Nothing) + (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))) + (doc count "runs `p` exactly `n` times, collecting results into an `Array`. If any iteration fails, propagates with appropriate consumption.") (defn count [n p] - (Parser.init - (fn [src len cur] - (let-do [acc [] - c @cur - err (the (Maybe ParseErr) (Maybe.Nothing)) - consumed-any false - i 0 - going true] - (while-do (and going (Int.< i n)) - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty v c2) - (do (set! acc (Array.push-back acc v)) (set! c c2)) - (Reply.ErrEmpty e) - (do (set! err (Maybe.Just e)) (set! going false)) - (Reply.ErrConsumed e) - (do (set! err (Maybe.Just e)) (set! going false))) - (set! i (Int.inc i))) - (match err - (Maybe.Just e) - (if consumed-any (Reply.ErrConsumed e) (Reply.ErrEmpty e)) - (Maybe.Nothing) - (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur n n)))) (doc at-most "runs `p` up to `n` times, collecting results into an `Array`. Stops early if `p` fails empty or succeeds without consuming (same guard as `many`). Consumed failures propagate. Use `count` for exactly `n` repetitions that may succeed empty.") (defn at-most [n p] - (Parser.init - (fn [src len cur] - (let-do [acc [] - c @cur - err (the (Maybe ParseErr) (Maybe.Nothing)) - consumed-any false - i 0 - going true] - (while-do (and going (Int.< i n)) - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty _ _) (set! going false) - (Reply.ErrEmpty _) (set! going false) - (Reply.ErrConsumed e) - (do (set! err (Maybe.Just e)) (set! going false))) - (set! i (Int.inc i))) - (match err - (Maybe.Just e) (Reply.ErrConsumed e) - (Maybe.Nothing) - (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur 0 n)))) (doc at-least "runs `p` at least `n` times, then continues greedily like `many`. Fails if `p` doesn't match at least `n` times. After the minimum, stops on empty failure or empty success to avoid infinite recursion.") (defn at-least [n p] - (Parser.init - (fn [src len cur] - (let-do [acc [] - c @cur - err (the (Maybe ParseErr) (Maybe.Nothing)) - consumed-any false - i 0 - going true] - (while-do (and going (Int.< i n)) - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty v c2) - (do (set! acc (Array.push-back acc v)) (set! c c2)) - (Reply.ErrEmpty e) - (do (set! err (Maybe.Just e)) (set! going false)) - (Reply.ErrConsumed e) - (do (set! err (Maybe.Just e)) (set! going false))) - (set! i (Int.inc i))) - (while-do going - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty _ _) (set! going false) - (Reply.ErrEmpty _) (set! going false) - (Reply.ErrConsumed e2) - (do (set! err (Maybe.Just e2)) (set! going false)))) - (match err - (Maybe.Just e) - (if consumed-any (Reply.ErrConsumed e) (Reply.ErrEmpty e)) - (Maybe.Nothing) - (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur n -1)))) (doc many "runs `p` zero or more times, collecting results. Stops on empty failure of `p`. If `p` succeeds without consuming, the loop stops to avoid infinite recursion (do not use `many` with an empty-success parser).") (defn many [p] - (Parser.init - (fn [src len cur] - (let-do [acc [] - c @cur - err (the (Maybe ParseErr) (Maybe.Nothing)) - consumed-any false - going true] - (while-do going - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty _ _) (set! going false) - (Reply.ErrEmpty _) (set! going false) - (Reply.ErrConsumed e2) - (do (set! err (Maybe.Just e2)) (set! going false)))) - (match err - (Maybe.Just e) (Reply.ErrConsumed e) - (Maybe.Nothing) - (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur 0 -1)))) (doc many1 "runs `p` one or more times. Fails (with same consumption as `p`'s first failure) if `p` doesn't match at least once.") (defn many1 [p] - (Parser.init - (fn [src len cur] - (match (~(Parser.run &p) src len cur) - (Reply.ErrEmpty e) (Reply.ErrEmpty e) - (Reply.ErrConsumed e) (Reply.ErrConsumed e) - (Reply.OkConsumed v1 c1) - (let-do [acc [v1] - c c1 - err (the (Maybe ParseErr) (Maybe.Nothing)) - going true] - (while-do going - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do (set! acc (Array.push-back acc v)) (set! c c2)) - (Reply.OkEmpty _ _) (set! going false) - (Reply.ErrEmpty _) (set! going false) - (Reply.ErrConsumed e2) - (do (set! err (Maybe.Just e2)) (set! going false)))) - (match err - (Maybe.Just e) (Reply.ErrConsumed e) - (Maybe.Nothing) (Reply.OkConsumed acc c))) - (Reply.OkEmpty v1 c1) (Reply.OkEmpty [v1] c1))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur 1 -1)))) (doc skip-many "runs `p` zero or more times, discarding all results. Returns `()`. Avoids building an `Array`, saving @@ -1683,47 +1608,7 @@ mandatory; after that, `p` is applied greedily up to `hi` times total, stopping on empty failure or empty success (same guard as `many`).") (defn range [lo hi p] - (Parser.init - (fn [src len cur] - (let-do [acc [] - c @cur - err (the (Maybe ParseErr) (Maybe.Nothing)) - consumed-any false - i 0 - going true] - ; Phase 1: mandatory (first lo iterations) - (while-do (and going (Int.< i lo)) - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty v c2) - (do (set! acc (Array.push-back acc v)) (set! c c2)) - (Reply.ErrEmpty e) - (do (set! err (Maybe.Just e)) (set! going false)) - (Reply.ErrConsumed e) - (do (set! err (Maybe.Just e)) (set! going false))) - (set! i (Int.inc i))) - ; Phase 2: optional (up to hi - lo more) - (while-do (and going (Int.< i hi)) - (match (~(Parser.run &p) src len &c) - (Reply.OkConsumed v c2) - (do - (set! acc (Array.push-back acc v)) - (set! c c2) - (set! consumed-any true)) - (Reply.OkEmpty _ _) (set! going false) - (Reply.ErrEmpty _) (set! going false) - (Reply.ErrConsumed e) - (do (set! err (Maybe.Just e)) (set! going false))) - (set! i (Int.inc i))) - (match err - (Maybe.Just e) - (if consumed-any (Reply.ErrConsumed e) (Reply.ErrEmpty e)) - (Maybe.Nothing) - (if consumed-any (Reply.OkConsumed acc c) (Reply.OkEmpty acc c))))))) + (Parser.init (fn [src len cur] (repeat-loop &p src len @cur lo hi)))) (defmodule Lexer (doc line-comment "skips a line comment: matches the literal prefix diff --git a/test/parsec.carp b/test/parsec.carp index 0d86e10..dc32f54 100644 --- a/test/parsec.carp +++ b/test/parsec.carp @@ -278,6 +278,57 @@ _ false) "many1 collects when at least one match") + ; The repetition combinators must keep the consumed bit when the + ; underlying parser fails after consuming input, so that `alt` does + ; not backtrack past a partial match. `(then (byte a) (byte b))` on + ; "ac" consumes the 'a' and then fails: a consumed failure. The + ; right branch would consume the whole input if it were tried, so + ; the parse succeeds iff `alt` (wrongly) backtracks. + (assert-true test + (err? + &(Parser.parse + (Parser.alt + (Parser.count 2 (Parser.then (Parser.byte \a) (Parser.byte \b))) + (Parser.many1 (Parser.any-byte))) + "ac")) + "count: a consumed failure is not backtrackable in alt") + + (assert-true test + (err? + &(Parser.parse + (Parser.alt + (Parser.many1 (Parser.then (Parser.byte \a) (Parser.byte \b))) + (Parser.many1 (Parser.any-byte))) + "ac")) + "many1: a consumed failure is not backtrackable in alt") + + (assert-true test + (err? + &(Parser.parse + (Parser.alt + (Parser.at-least 2 (Parser.then (Parser.byte \a) (Parser.byte \b))) + (Parser.many1 (Parser.any-byte))) + "ac")) + "at-least: a consumed failure in the mandatory phase is not backtrackable") + + (assert-true test + (err? + &(Parser.parse + (Parser.alt + (Parser.range 2 4 (Parser.then (Parser.byte \a) (Parser.byte \b))) + (Parser.many1 (Parser.any-byte))) + "ac")) + "range: a consumed failure in the mandatory phase is not backtrackable") + + ; A purely empty failure (nothing consumed) must still backtrack. + (assert-true test + (ok? + &(Parser.parse + (Parser.alt (Parser.count 2 (Parser.byte \a)) + (Parser.count 1 (Parser.byte \b))) + "b")) + "count: an empty failure still backtracks in alt") + (assert-true test (ok? &(Parser.parse