@@ -562,52 +562,72 @@ let emitDoc
562562 loopCont 0 d (fun x -> () )
563563
564564
565- (* Print a document on a channel *)
566- let fprint (chn : out_channel ) ~(width : int ) doc =
567- let doc = if ! flattenBeforePrint then flatten Nil doc else doc in
565+ let print_with_state ~width f =
568566 (* Save some parameters, to allow for nested calls of these routines. *)
567+ let old_maxCol = ! maxCol in
569568 maxCol := width;
570569 let old_breaks = ! breaks in
571570 breaks := [] ;
572- let old_alignDepth = ! alignDepth in
573- alignDepth := 0 ;
574571 let old_activeMarkups = ! activeMarkups in
575572 activeMarkups := [] ;
576- ignore (scan 0 doc);
577- breaks := List. rev ! breaks;
578- ignore (emitDoc
579- (fun s nrcopies ->
580- for _ = 1 to nrcopies do
581- output_string chn s
582- done ) doc);
583- activeMarkups := old_activeMarkups;
584- alignDepth := old_alignDepth;
585- breaks := old_breaks (* We must do this especially if we don't do emit
586- (which consumes breaks) because otherwise we waste
587- memory *)
573+ let old_alignDepth = ! alignDepth in
574+ alignDepth := 0 ;
575+ let old_aligns = ! aligns in
576+ aligns := [{ gainBreak = 0 ; isTaken = ref false ; deltaFromPrev = ref 0 ; deltaToNext = ref 0 ; }];
577+ let old_topAlignAbsCol = ! topAlignAbsCol in
578+ topAlignAbsCol := 0 ;
579+ let old_breakAllMode = ! breakAllMode in
580+ breakAllMode := false ;
581+
582+ let finally () =
583+ maxCol := old_maxCol;
584+ (* We must do this especially if we don't do emit
585+ (which consumes breaks) because otherwise we waste
586+ memory *)
587+ breaks := old_breaks;
588+ activeMarkups := old_activeMarkups;
589+ alignDepth := old_alignDepth;
590+ aligns := old_aligns;
591+ topAlignAbsCol := old_topAlignAbsCol;
592+ breakAllMode := old_breakAllMode
593+ in
594+
595+ match f () with
596+ | r ->
597+ finally () ;
598+ r
599+ | exception e ->
600+ let bt = Printexc. get_raw_backtrace () in
601+ finally () ;
602+ Printexc. raise_with_backtrace e bt
603+
604+ (* Print a document on a channel *)
605+ let fprint (chn : out_channel ) ~(width : int ) doc =
606+ let doc = if ! flattenBeforePrint then flatten Nil doc else doc in
607+ print_with_state ~width (fun () ->
608+ ignore (scan 0 doc);
609+ breaks := List. rev ! breaks;
610+ emitDoc (fun s nrcopies ->
611+ for _ = 1 to nrcopies do
612+ output_string chn s
613+ done
614+ ) doc
615+ )
588616
589617(* Print the document to a string *)
590618let sprint ~(width : int ) doc : string =
591619 let doc = if ! flattenBeforePrint then flatten Nil doc else doc in
592- maxCol := width;
593- let old_breaks = ! breaks in
594- breaks := [] ;
595- let old_activeMarkups = ! activeMarkups in
596- activeMarkups := [] ;
597- let old_alignDepth = ! alignDepth in
598- alignDepth := 0 ;
599- ignore (scan 0 doc);
600- breaks := List. rev ! breaks;
601- let buf = Buffer. create 1024 in
602- let rec add_n_strings str num =
603- if num < = 0 then ()
604- else begin Buffer. add_string buf str; add_n_strings str (num - 1 ) end
605- in
606- emitDoc add_n_strings doc;
607- breaks := old_breaks;
608- activeMarkups := old_activeMarkups;
609- alignDepth := old_alignDepth;
610- Buffer. contents buf
620+ print_with_state ~width (fun () ->
621+ ignore (scan 0 doc);
622+ breaks := List. rev ! breaks;
623+ let buf = Buffer. create 1024 in
624+ let rec add_n_strings str num =
625+ if num < = 0 then ()
626+ else begin Buffer. add_string buf str; add_n_strings str (num - 1 ) end
627+ in
628+ emitDoc add_n_strings doc;
629+ Buffer. contents buf
630+ )
611631
612632
613633 (* The rest is based on printf.ml *)
0 commit comments