Browse Source

Merge pull request #218 from kencole/master

exposed fix_lazy
Spiros Eliopoulos 9 months ago
parent
commit
5536d1da71
3 changed files with 14 additions and 6 deletions
  1. 4 5
      lib/angstrom.ml
  2. 9 0
      lib/angstrom.mli
  3. 1 1
      lib_test/test_json.ml

+ 4 - 5
lib/angstrom.ml

@@ -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 ->
@@ -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
@@ -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))

+ 9 - 0
lib/angstrom.mli

@@ -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} *)
 

+ 1 - 1
lib_test/test_json.ml

@@ -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