aboutsummaryrefslogtreecommitdiffhomepage
path: root/plugins/extraction
diff options
context:
space:
mode:
authorGravatar Maxime Dénès <mail@maximedenes.fr>2017-03-22 14:09:41 +0100
committerGravatar Maxime Dénès <mail@maximedenes.fr>2017-03-22 14:09:41 +0100
commit6e0ca299c407125a8d65f54ab424bdae3667125e (patch)
tree2f968c31b85b22190d4ce9f2472f4cb6cd0a6ad9 /plugins/extraction
parent051ef20a9f9c496fc6a5143de97450ccf7786c5b (diff)
parentaa9e94275ccac92311a6bdac563b61a6c7876cec (diff)
Merge PR#390: Updates to the Pretty Printing Infrastructure
Diffstat (limited to 'plugins/extraction')
-rw-r--r--plugins/extraction/common.ml4
-rw-r--r--plugins/extraction/extract_env.ml9
-rw-r--r--plugins/extraction/ocaml.ml8
3 files changed, 14 insertions, 7 deletions
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 0a591e786..fc8d5356c 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -67,7 +67,9 @@ let pp_boxed_tuple f = function
blocks is less that a line length. To avoid this awkward situation,
we attach a big virtual size to [fnl] newlines. *)
-let fnl () = stras (1000000,"") ++ fnl ()
+(* EG: This looks quite suspicious... but beware of bugs *)
+(* let fnl () = stras (1000000,"") ++ fnl () *)
+let fnl () = fnl ()
let fnl2 () = fnl () ++ fnl ()
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index e019bb3c2..2b12462ad 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -472,13 +472,14 @@ let formatter dry file =
if dry then Format.make_formatter (fun _ _ _ -> ()) (fun _ -> ())
else
match file with
- | Some f -> Pp_control.with_output_to f
+ | Some f -> Topfmt.with_output_to f
| None -> Format.formatter_of_buffer buf
in
+ (* XXX: Fixme, this shouldn't depend on Topfmt *)
(* We never want to see ellipsis ... in extracted code *)
Format.pp_set_max_boxes ft max_int;
(* We reuse the width information given via "Set Printing Width" *)
- (match Pp_control.get_margin () with
+ (match Topfmt.get_margin () with
| None -> ()
| Some i ->
Format.pp_set_margin ft i;
@@ -518,8 +519,10 @@ let print_structure_to_file (fn,si,mo) dry struc =
set_phase Impl;
pp_with ft (d.preamble mo comment opened unsafe_needs);
pp_with ft (d.pp_struct struc);
+ Format.pp_print_flush ft ();
Option.iter close_out cout;
with reraise ->
+ Format.pp_print_flush ft ();
Option.iter close_out cout; raise reraise
end;
if not dry then Option.iter info_file fn;
@@ -532,8 +535,10 @@ let print_structure_to_file (fn,si,mo) dry struc =
set_phase Intf;
pp_with ft (d.sig_preamble mo comment opened unsafe_needs);
pp_with ft (d.pp_sig (signature_of_structure struc));
+ Format.pp_print_flush ft ();
close_out cout;
with reraise ->
+ Format.pp_print_flush ft ();
close_out cout; raise reraise
end;
info_file si)
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index d89bf95ee..d8e382155 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -66,7 +66,7 @@ let pp_header_comment = function
| None -> mt ()
| Some com -> pp_comment com ++ fnl2 ()
-let then_nl pp = if Pp.is_empty pp then mt () else pp ++ fnl ()
+let then_nl pp = if Pp.ismt pp then mt () else pp ++ fnl ()
let pp_tdummy usf =
if usf.tdummy || usf.tunknown then str "type __ = Obj.t" ++ fnl () else mt ()
@@ -618,7 +618,7 @@ and pp_module_type params = function
push_visible mp params;
let try_pp_specif l x =
let px = pp_specif x in
- if Pp.is_empty px then l else px::l
+ if Pp.ismt px then l else px::l
in
(* We cannot use fold_right here due to side effects in pp_specif *)
let l = List.fold_left try_pp_specif [] sign in
@@ -696,7 +696,7 @@ and pp_module_expr params = function
push_visible mp params;
let try_pp_structure_elem l x =
let px = pp_structure_elem x in
- if Pp.is_empty px then l else px::l
+ if Pp.ismt px then l else px::l
in
(* We cannot use fold_right here due to side effects in pp_structure_elem *)
let l = List.fold_left try_pp_structure_elem [] sel in
@@ -714,7 +714,7 @@ let rec prlist_sep_nonempty sep f = function
| h::t ->
let e = f h in
let r = prlist_sep_nonempty sep f t in
- if Pp.is_empty e then r
+ if Pp.ismt e then r
else e ++ sep () ++ r
let do_struct f s =