Skip to content

Commit

Permalink
Merge pull request inhabitedtype#218 from kencole/master
Browse files Browse the repository at this point in the history
exposed fix_lazy
  • Loading branch information
Spiros Eliopoulos committed Sep 21, 2021
2 parents b0e7849 + 0cea598 commit 5536d1d
Show file tree
Hide file tree
Showing 3 changed files with 14 additions and 6 deletions.
9 changes: 4 additions & 5 deletions lib/angstrom.ml
Original file line number Diff line number Diff line change
Expand Up @@ -461,8 +461,7 @@ let fix_direct f =
in
r

let fix_lazy f =
let max_steps = 20 in
let fix_lazy ~max_steps f =
let steps = ref max_steps in
let rec p = lazy (f r)
and r = { run = fun buf pos more fail succ ->
Expand All @@ -480,7 +479,7 @@ let fix_lazy f =
let fix = match Sys.backend_type with
| Native -> fix_direct
| Bytecode -> fix_direct
| Other _ -> fix_lazy
| Other _ -> fun f -> fix_lazy ~max_steps:20 f

let option x p =
p <|> return x
Expand All @@ -493,9 +492,9 @@ let rec list ps =
| p::ps -> lift2 cons p (list ps)

let count n p =
if n < 0
if n < 0
then fail "count: n < 0"
else
else
let rec loop = function
| 0 -> return []
| n -> lift2 cons p (loop (n - 1))
Expand Down
9 changes: 9 additions & 0 deletions lib/angstrom.mli
Original file line number Diff line number Diff line change
Expand Up @@ -348,6 +348,15 @@ val fix : ('a t -> 'a t) -> 'a t
let obj = char '{' *> ... json ... <* char '}' in
choice [str; num; arr json, ...])]} *)

(** [fix_lazy] is like [fix], but after the function reaches [max_steps]
deep, it wraps up the remaining computation and yields
back to the root of the parsing loop where it continues from there.
This is an effective way to break up the stack trace into more managable
chunks, which is important for Js_of_ocaml due to the lack of tailrec
optimizations for CPS-style tail calls. When compiling for Js_of_ocaml,
[fix] itself is defined as [fix_lazy ~max_steps:20]. *)
val fix_lazy : max_steps:int -> ('a t -> 'a t) -> 'a t

(** {2 Alternatives} *)

Expand Down
2 changes: 1 addition & 1 deletion lib_test/test_json.ml
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,6 @@ let read f =

let () =
let twitter_big = read Sys.argv.(1) in
match Angstrom.(parse_bigstring RFC7159.json twitter_big) with
match Angstrom.(parse_bigstring ~consume:Consume.Prefix RFC7159.json twitter_big) with
| Ok _ -> ()
| Error err -> failwith err

0 comments on commit 5536d1d

Please sign in to comment.