diff --git a/lib/angstrom.ml b/lib/angstrom.ml index 241d052..ad5e382 100644 --- a/lib/angstrom.ml +++ b/lib/angstrom.ml @@ -741,3 +741,9 @@ let parse_string ~consume p s = let bs = Bigstringaf.create len in Bigstringaf.unsafe_blit_from_string s ~src_off:0 bs ~dst_off:0 ~len; parse_bigstring ~consume p bs + +let backtrack n = + { run = fun input pos more fail succ -> + if pos - n < Input.(parser_committed_bytes input) + then fail input pos more [] "not enough uncommited bytes to backtrack" + else succ input (pos - n) more () } diff --git a/lib/angstrom.mli b/lib/angstrom.mli index d669595..f263177 100644 --- a/lib/angstrom.mli +++ b/lib/angstrom.mli @@ -686,3 +686,4 @@ end val pos : int t val available : int t +val backtrack : int -> unit t diff --git a/lib_test/test_angstrom.ml b/lib_test/test_angstrom.ml index 7651e4a..a49cb96 100644 --- a/lib_test/test_angstrom.ml +++ b/lib_test/test_angstrom.ml @@ -432,6 +432,41 @@ let consume = ] ;; +let backtrack = + let parse name p res = + let open Angstrom in + Alcotest.(check (result (string) string)) + name + (parse_string ~consume:Prefix p "abcdef") + res + in + [ "backtrack 0 is nop", `Quick, begin fun () -> + parse + "backtracking works" + (char 'a' *> char 'b' *> backtrack 0 *> take 3) + (Ok "cde") + end; + "backtracking works", `Quick, begin fun () -> + parse + "backtracking works" + (char 'a' *> char 'b' *> backtrack 2 *> take 3) + (Ok "abc") + end; + "backtracking past beginning fails", `Quick, begin fun () -> + parse + "backtracking works" + (char 'a' *> char 'b' *> backtrack 3 *> take 3) + (Error ": not enough uncommited bytes to backtrack") + end; + "backtracking past commit point fails", `Quick, begin fun () -> + parse + "backtracking works" + (char 'a' *> commit *> char 'b' *> backtrack 2 *> take 3) + (Error ": not enough uncommited bytes to backtrack") + end + ] +;; + let () = Alcotest.run "test suite" [ "basic constructors" , basic_constructors @@ -446,4 +481,5 @@ let () = ; "choice and commit" , choice_commit ; "input" , input ; "consume" , consume + ; "backtrack" , backtrack ]