aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGaëtan Gilbert2019-01-19 22:16:06 +0000
committerGaëtan Gilbert2019-01-22 14:09:34 +0100
commit4baa950b79589c6617770b5612bd082fde9c9255 (patch)
treed117039329fd5459d4770b2af93d71abbfd9a41f
parentb2877df2c79147bd2e26e53e43291b9b29a2aab8 (diff)
Make prvect tail recursive (fix #9355)
Using a unit test as it's way faster than messing with universes. You can test with universes by ~~~coq Set Universe Polymorphism. Definition x1@{i} := True. Definition x2 := x1 -> x1. Definition x3 := x2 -> x2. Definition x4 := x3 -> x3. Definition x5 := x4 -> x4. Definition x6 := x5 -> x5. Definition x7 := x6 -> x6. Definition x8 := x7 -> x7. Definition x9 := x8 -> x8. Definition x10 := x9 -> x9. Definition x11 := x10 -> x10. Definition x12 := x11 -> x11. Definition x13 := x12 -> x12. Definition x14 := x13 -> x13. Definition x15 := x14 -> x14. Definition x16 := x15 -> x15. Definition x17 := x16 -> x16. Definition x18 := x17 -> x17. Definition x19 := x18 -> x18. About x19. (* 262144 universes *) ~~~ Note on my machine `About x18.` did not overflow even before this commit.
-rw-r--r--lib/pp.ml13
-rw-r--r--test-suite/unit-tests/lib/pp_big_vect.ml14
2 files changed, 19 insertions, 8 deletions
diff --git a/lib/pp.ml b/lib/pp.ml
index d68f5ac5e3..cdde60f051 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -284,15 +284,12 @@ let pr_vertical_list pr = function
[pr 0 a0 ++ sep() ++ ... ++ sep() ++ pr n an] *)
let prvecti_with_sep sep elem v =
- let rec pr i =
- if Int.equal i 0 then
- elem 0 v.(0)
- else
- let r = pr (i-1) and s = sep () and e = elem i v.(i) in
- r ++ s ++ e
+ let v = CArray.mapi (fun i x ->
+ let pp = if i = 0 then mt() else sep() in
+ pp ++ elem i x)
+ v
in
- let n = Array.length v in
- if Int.equal n 0 then mt () else pr (n - 1)
+ seq (Array.to_list v)
(* [prvecti pr [|a0 ; ... ; an|]] outputs [pr 0 a0 ++ ... ++ pr n an] *)
diff --git a/test-suite/unit-tests/lib/pp_big_vect.ml b/test-suite/unit-tests/lib/pp_big_vect.ml
new file mode 100644
index 0000000000..e1cdd290e2
--- /dev/null
+++ b/test-suite/unit-tests/lib/pp_big_vect.ml
@@ -0,0 +1,14 @@
+open OUnit
+open Pp
+
+let pr_big_vect =
+ let n = "pr_big_vect" in
+ n >:: (fun () ->
+ let v = Array.make (1 lsl 20) () in
+ let pp = prvecti_with_sep spc (fun _ _ -> str"x") v in
+ let str = string_of_ppcmds pp in
+ ignore(str))
+
+let tests = [pr_big_vect]
+
+let () = Utest.run_tests __FILE__ (Utest.open_log_out_ch __FILE__) tests