1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489(**************************************************************************)(* *)(* OCaml *)(* *)(* Pierre Weis, projet Cristal, INRIA Rocquencourt *)(* *)(* Copyright 1996 Institut National de Recherche en Informatique et *)(* en Automatique. *)(* *)(* All rights reserved. This file is distributed under the terms of *)(* the GNU Lesser General Public License version 2.1, with the *)(* special exception on linking described in the file LICENSE. *)(* *)(**************************************************************************)(* A pretty-printing facility and definition of formatters for 'parallel'
(i.e. unrelated or independent) pretty-printing on multiple out channels. *)(*
The pretty-printing engine internal data structures.
*)letidx=x(* A devoted type for sizes to avoid confusion
between sizes and mere integers. *)moduleSize:sigtypetvalto_int:t->intvalof_int:int->tvalzero:tvalunknown:tvalis_known:t->boolend=structtypet=intletto_int=idletof_int=idletzero=0letunknown=-1letis_knownn=n>=0end(* The pretty-printing boxes definition:
a pretty-printing box is either
- hbox: horizontal box (no line splitting)
- vbox: vertical box (every break hint splits the line)
- hvbox: horizontal/vertical box
(the box behaves as an horizontal box if it fits on
the current line, otherwise the box behaves as a vertical box)
- hovbox: horizontal or vertical compacting box
(the box is compacting material, printing as much material as possible
on every lines)
- box: horizontal or vertical compacting box with enhanced box structure
(the box behaves as an horizontal or vertical box but break hints split
the line if splitting would move to the left)
*)typebox_type=CamlinternalFormatBasics.block_type=|Pp_hbox|Pp_vbox|Pp_hvbox|Pp_hovbox|Pp_box|Pp_fits(* The pretty-printing tokens definition:
are either text to print or pretty printing
elements that drive indentation and line splitting. *)typepp_token=|Pp_textofstring(* normal text *)|Pp_breakof{(* complete break *)fits:string*int*string;(* line is not split *)breaks:string*int*string;(* line is split *)}|Pp_tbreakofint*int(* go to next tabulation *)|Pp_stab(* set a tabulation *)|Pp_beginofint*box_type(* beginning of a box *)|Pp_end(* end of a box *)|Pp_tbeginoftbox(* beginning of a tabulation box *)|Pp_tend(* end of a tabulation box *)|Pp_newline(* to force a newline inside a box *)|Pp_if_newline(* to do something only if this very
line has been broken *)|Pp_open_tagofstag(* opening a tag name *)|Pp_close_tag(* closing the most recently open tag *)andstag=..andtbox=Pp_tboxofintlistref(* Tabulation box *)typetag=stringtypestag+=String_tagoftag(* The pretty-printer queue:
pretty-printing material is not written in the output as soon as emitted;
instead, the material is simply recorded in the pretty-printer queue,
until the enclosing box has a known computed size and proper splitting
decisions can be made.
The pretty-printer queue contains formatting elements to be printed.
Each formatting element is a tuple (size, token, length), where
- length is the declared length of the token,
- size is effective size of the token when it is printed
(size is set when the size of the box is known, so that size of break
hints are definitive). *)typepp_queue_elem={mutablesize:Size.t;token:pp_token;length:int;}(* The pretty-printer queue definition. *)typepp_queue=pp_queue_elemQueue.t(* The pretty-printer scanning stack. *)(* The pretty-printer scanning stack: scanning element definition. *)typepp_scan_elem={left_total:int;(* Value of pp_left_total when the element was enqueued. *)queue_elem:pp_queue_elem}(* The pretty-printer formatting stack:
the formatting stack contains the description of all the currently active
boxes; the pretty-printer formatting stack is used to split the lines
while printing tokens. *)(* The pretty-printer formatting stack: formatting stack element definition.
Each stack element describes a pretty-printing box. *)typepp_format_elem={box_type:box_type;width:int}(* The formatter definition.
Each formatter value is a pretty-printer instance with all its
machinery. *)typeformatter={(* The pretty-printer scanning stack. *)pp_scan_stack:pp_scan_elemStack.t;(* The pretty-printer formatting stack. *)pp_format_stack:pp_format_elemStack.t;pp_tbox_stack:tboxStack.t;(* The pretty-printer semantics tag stack. *)pp_tag_stack:stagStack.t;pp_mark_stack:stagStack.t;(* Value of right margin. *)mutablepp_margin:int;(* Minimal space left before margin, when opening a box. *)mutablepp_min_space_left:int;(* Maximum value of indentation:
no box can be opened further. *)mutablepp_max_indent:int;(* Space remaining on the current line. *)mutablepp_space_left:int;(* Current value of indentation. *)mutablepp_current_indent:int;(* True when the line has been broken by the pretty-printer. *)mutablepp_is_new_line:bool;(* Total width of tokens already printed. *)mutablepp_left_total:int;(* Total width of tokens ever put in queue. *)mutablepp_right_total:int;(* Current number of open boxes. *)mutablepp_curr_depth:int;(* Maximum number of boxes which can be simultaneously open. *)mutablepp_max_boxes:int;(* Ellipsis string. *)mutablepp_ellipsis:string;(* Output function. *)mutablepp_out_string:string->int->int->unit;(* Flushing function. *)mutablepp_out_flush:unit->unit;(* Output of new lines. *)mutablepp_out_newline:unit->unit;(* Output of break hints spaces. *)mutablepp_out_spaces:int->unit;(* Output of indentation of new lines. *)mutablepp_out_indent:int->unit;(* Are tags printed ? *)mutablepp_print_tags:bool;(* Are tags marked ? *)mutablepp_mark_tags:bool;(* Find opening and closing markers of tags. *)mutablepp_mark_open_tag:stag->string;mutablepp_mark_close_tag:stag->string;mutablepp_print_open_tag:stag->unit;mutablepp_print_close_tag:stag->unit;(* The pretty-printer queue. *)pp_queue:pp_queue;}(* The formatter specific tag handling functions. *)typeformatter_stag_functions={mark_open_stag:stag->string;mark_close_stag:stag->string;print_open_stag:stag->unit;print_close_stag:stag->unit;}(* The formatter functions to output material. *)typeformatter_out_functions={out_string:string->int->int->unit;out_flush:unit->unit;out_newline:unit->unit;out_spaces:int->unit;out_indent:int->unit;}(*
Auxiliaries and basic functions.
*)(* Enter a token in the pretty-printer queue. *)letpp_enqueuestatetoken=state.pp_right_total<-state.pp_right_total+token.length;Queue.addtokenstate.pp_queueletpp_clear_queuestate=state.pp_left_total<-1;state.pp_right_total<-1;Queue.clearstate.pp_queue(* Pp_infinity: large value for default tokens size.
Pp_infinity is documented as being greater than 1e10; to avoid
confusion about the word 'greater', we choose pp_infinity greater
than 1e10 + 1; for correct handling of tests in the algorithm,
pp_infinity must be even one more than 1e10 + 1; let's stand on the
safe side by choosing 1.e10+10.
Pp_infinity could probably be 1073741823 that is 2^30 - 1, that is
the minimal upper bound for integers; now that max_int is defined,
this limit could also be defined as max_int - 1.
However, before setting pp_infinity to something around max_int, we
must carefully double-check all the integer arithmetic operations
that involve pp_infinity, since any overflow would wreck havoc the
pretty-printing algorithm's invariants. Given that this arithmetic
correctness check is difficult and error prone and given that 1e10
+ 1 is in practice large enough, there is no need to attempt to set
pp_infinity to the theoretically maximum limit. It is not worth the
burden ! *)letpp_infinity=1000000010(* Output functions for the formatter. *)letpp_output_stringstates=state.pp_out_strings0(String.lengths)andpp_output_newlinestate=state.pp_out_newline()andpp_output_spacesstaten=state.pp_out_spacesnandpp_output_indentstaten=state.pp_out_indentn(* Format a textual token *)letformat_pp_textstatesizetext=state.pp_space_left<-state.pp_space_left-size;pp_output_stringstatetext;state.pp_is_new_line<-false(* Format a string by its length, if not empty *)letformat_stringstates=ifs<>""thenformat_pp_textstate(String.lengths)s(* To format a break, indenting a new line. *)letbreak_new_linestate(before,offset,after)width=format_stringstatebefore;pp_output_newlinestate;state.pp_is_new_line<-true;letindent=state.pp_margin-width+offsetin(* Don't indent more than pp_max_indent. *)letreal_indent=Int.minstate.pp_max_indentindentinstate.pp_current_indent<-real_indent;state.pp_space_left<-state.pp_margin-state.pp_current_indent;pp_output_indentstatestate.pp_current_indent;format_stringstateafter(* To force a line break inside a box: no offset is added. *)letbreak_linestatewidth=break_new_linestate("",0,"")width(* To format a break that fits on the current line. *)letbreak_same_linestate(before,width,after)=format_stringstatebefore;state.pp_space_left<-state.pp_space_left-width;pp_output_spacesstatewidth;format_stringstateafter(* To indent no more than pp_max_indent, if one tries to open a box
beyond pp_max_indent, then the box is rejected on the left
by simulating a break. *)letpp_force_break_linestate=matchStack.top_optstate.pp_format_stackwith|None->pp_output_newlinestate|Some{box_type;width}->ifwidth>state.pp_space_leftthenmatchbox_typewith|Pp_fits|Pp_hbox->()|Pp_vbox|Pp_hvbox|Pp_hovbox|Pp_box->break_linestatewidth(* To skip a token, if the previous line has been broken. *)letpp_skip_tokenstate=matchQueue.take_optstate.pp_queuewith|None->()(* print_if_newline must have been the last printing command *)|Some{size;length;_}->state.pp_left_total<-state.pp_left_total-length;state.pp_space_left<-state.pp_space_left+Size.to_intsize(*
The main pretty printing functions.
*)(* Formatting a token with a given size. *)letformat_pp_tokenstatesize=function|Pp_texts->format_pp_textstatesizes|Pp_begin(off,ty)->letinsertion_point=state.pp_margin-state.pp_space_leftinifinsertion_point>state.pp_max_indentthen(* can not open a box right there. *)beginpp_force_break_linestateend;letwidth=state.pp_space_left-offinletbox_type=matchtywith|Pp_vbox->Pp_vbox|Pp_hbox|Pp_hvbox|Pp_hovbox|Pp_box|Pp_fits->ifsize>state.pp_space_leftthentyelsePp_fitsinStack.push{box_type;width}state.pp_format_stack|Pp_end->Stack.pop_optstate.pp_format_stack|>ignore|Pp_tbegin(Pp_tbox_astbox)->Stack.pushtboxstate.pp_tbox_stack|Pp_tend->Stack.pop_optstate.pp_tbox_stack|>ignore|Pp_stab->beginmatchStack.top_optstate.pp_tbox_stackwith|None->()(* No open tabulation box. *)|Some(Pp_tboxtabs)->letrecadd_tabn=function|[]->[n]|x::lasls->ifn<xthenn::lselsex::add_tabnlintabs:=add_tab(state.pp_margin-state.pp_space_left)!tabsend|Pp_tbreak(n,off)->letinsertion_point=state.pp_margin-state.pp_space_leftinbeginmatchStack.top_optstate.pp_tbox_stackwith|None->()(* No open tabulation box. *)|Some(Pp_tboxtabs)->lettab=match!tabswith|[]->insertion_point|first::_->letrecfind=function|head::tail->ifhead>=insertion_pointthenheadelsefindtail|[]->firstinfind!tabsinletoffset=tab-insertion_pointinifoffset>=0thenbreak_same_linestate("",offset+n,"")elsebreak_new_linestate("",tab+off,"")state.pp_marginend|Pp_newline->beginmatchStack.top_optstate.pp_format_stackwith|None->pp_output_newlinestate(* No open box. *)|Some{width;_}->break_linestatewidthend|Pp_if_newline->ifstate.pp_current_indent!=state.pp_margin-state.pp_space_leftthenpp_skip_tokenstate|Pp_break{fits;breaks}->letbefore,off,_=breaksinbeginmatchStack.top_optstate.pp_format_stackwith|None->()(* No open box. *)|Some{box_type;width}->beginmatchbox_typewith|Pp_hovbox->ifsize+String.lengthbefore>state.pp_space_leftthenbreak_new_linestatebreakswidthelsebreak_same_linestatefits|Pp_box->(* Have the line just been broken here ? *)ifstate.pp_is_new_linethenbreak_same_linestatefitselseifsize+String.lengthbefore>state.pp_space_leftthenbreak_new_linestatebreakswidthelse(* break the line here leads to new indentation ? *)ifstate.pp_current_indent>state.pp_margin-width+offthenbreak_new_linestatebreakswidthelsebreak_same_linestatefits|Pp_hvbox->break_new_linestatebreakswidth|Pp_fits->break_same_linestatefits|Pp_vbox->break_new_linestatebreakswidth|Pp_hbox->break_same_linestatefitsendend|Pp_open_tagtag_name->letmarker=state.pp_mark_open_tagtag_nameinpp_output_stringstatemarker;Stack.pushtag_namestate.pp_mark_stack|Pp_close_tag->beginmatchStack.pop_optstate.pp_mark_stackwith|None->()(* No more tag to close. *)|Sometag_name->letmarker=state.pp_mark_close_tagtag_nameinpp_output_stringstatemarkerend(* Print if token size is known else printing is delayed.
Printing is delayed when the text waiting in the queue requires
more room to format than exists on the current line. *)letrecadvance_leftstate=matchQueue.peek_optstate.pp_queuewith|None->()(* No tokens to print *)|Some{size;token;length}->letpending_count=state.pp_right_total-state.pp_left_totalinifSize.is_knownsize||pending_count>=state.pp_space_leftthenbeginQueue.takestate.pp_queue|>ignore;(* Not empty: we peek into it *)letsize=ifSize.is_knownsizethenSize.to_intsizeelsepp_infinityinformat_pp_tokenstatesizetoken;state.pp_left_total<-length+state.pp_left_total;(advance_left[@tailcall])stateend(* To enqueue a token : try to advance. *)letenqueue_advancestatetok=pp_enqueuestatetok;advance_leftstate(* To enqueue strings. *)letenqueue_string_asstatesizes=enqueue_advancestate{size;token=Pp_texts;length=Size.to_intsize}letenqueue_stringstates=enqueue_string_asstate(Size.of_int(String.lengths))s(* Routines for scan stack
determine size of boxes. *)(* The scan_stack is never empty. *)letinitialize_scan_stackstack=Stack.clearstack;letqueue_elem={size=Size.unknown;token=Pp_text"";length=0}inStack.push{left_total=-1;queue_elem}stack(* Setting the size of boxes on scan stack:
if ty = true then size of break is set else size of box is set;
in each case pp_scan_stack is popped.
Note:
Pattern matching on scan stack is exhaustive, since scan_stack is never
empty.
Pattern matching on token in scan stack is also exhaustive,
since scan_push is used on breaks and opening of boxes. *)letset_sizestatety=matchStack.top_optstate.pp_scan_stackwith|None->()(* scan_stack is never empty. *)|Some{left_total;queue_elem}->letsize=Size.to_intqueue_elem.sizein(* test if scan stack contains any data that is not obsolete. *)ifleft_total<state.pp_left_totaltheninitialize_scan_stackstate.pp_scan_stackelsematchqueue_elem.tokenwith|Pp_break_|Pp_tbreak(_,_)->iftythenbeginqueue_elem.size<-Size.of_int(state.pp_right_total+size);Stack.pop_optstate.pp_scan_stack|>ignoreend|Pp_begin(_,_)->ifnottythenbeginqueue_elem.size<-Size.of_int(state.pp_right_total+size);Stack.pop_optstate.pp_scan_stack|>ignoreend|Pp_text_|Pp_stab|Pp_tbegin_|Pp_tend|Pp_end|Pp_newline|Pp_if_newline|Pp_open_tag_|Pp_close_tag->()(* scan_push is only used for breaks and boxes. *)(* Push a token on pretty-printer scanning stack.
If b is true set_size is called. *)letscan_pushstatebtoken=pp_enqueuestatetoken;ifbthenset_sizestatetrue;letelem={left_total=state.pp_right_total;queue_elem=token}inStack.pushelemstate.pp_scan_stack(* To open a new box :
the user may set the depth bound pp_max_boxes
any text nested deeper is printed as the ellipsis string. *)letpp_open_box_genstateindentbr_ty=state.pp_curr_depth<-state.pp_curr_depth+1;ifstate.pp_curr_depth<state.pp_max_boxesthenletsize=Size.of_int(-state.pp_right_total)inletelem={size;token=Pp_begin(indent,br_ty);length=0}inscan_pushstatefalseelemelseifstate.pp_curr_depth=state.pp_max_boxesthenenqueue_stringstatestate.pp_ellipsis(* The box which is always open. *)letpp_open_sys_boxstate=pp_open_box_genstate0Pp_hovbox(* Close a box, setting sizes of its sub boxes. *)letpp_close_boxstate()=ifstate.pp_curr_depth>1thenbeginifstate.pp_curr_depth<state.pp_max_boxesthenbeginpp_enqueuestate{size=Size.zero;token=Pp_end;length=0};set_sizestatetrue;set_sizestatefalseend;state.pp_curr_depth<-state.pp_curr_depth-1;end(* Open a tag, pushing it on the tag stack. *)letpp_open_stagstatetag_name=ifstate.pp_print_tagsthenbeginStack.pushtag_namestate.pp_tag_stack;state.pp_print_open_tagtag_nameend;ifstate.pp_mark_tagsthenlettoken=Pp_open_tagtag_nameinpp_enqueuestate{size=Size.zero;token;length=0}(* Close a tag, popping it from the tag stack. *)letpp_close_stagstate()=ifstate.pp_mark_tagsthenpp_enqueuestate{size=Size.zero;token=Pp_close_tag;length=0};ifstate.pp_print_tagsthenmatchStack.pop_optstate.pp_tag_stackwith|None->()(* No more tag to close. *)|Sometag_name->state.pp_print_close_tagtag_nameletpp_set_print_tagsstateb=state.pp_print_tags<-bletpp_set_mark_tagsstateb=state.pp_mark_tags<-bletpp_get_print_tagsstate()=state.pp_print_tagsletpp_get_mark_tagsstate()=state.pp_mark_tagsletpp_set_tagsstateb=pp_set_print_tagsstateb;pp_set_mark_tagsstateb(* Handling tag handling functions: get/set functions. *)letpp_get_formatter_stag_functionsstate()={mark_open_stag=state.pp_mark_open_tag;mark_close_stag=state.pp_mark_close_tag;print_open_stag=state.pp_print_open_tag;print_close_stag=state.pp_print_close_tag;}letpp_set_formatter_stag_functionsstate{mark_open_stag=mot;mark_close_stag=mct;print_open_stag=pot;print_close_stag=pct;}=state.pp_mark_open_tag<-mot;state.pp_mark_close_tag<-mct;state.pp_print_open_tag<-pot;state.pp_print_close_tag<-pct(* Initialize pretty-printer. *)letpp_rinitstate=pp_clear_queuestate;initialize_scan_stackstate.pp_scan_stack;Stack.clearstate.pp_format_stack;Stack.clearstate.pp_tbox_stack;Stack.clearstate.pp_tag_stack;Stack.clearstate.pp_mark_stack;state.pp_current_indent<-0;state.pp_curr_depth<-0;state.pp_space_left<-state.pp_margin;pp_open_sys_boxstateletclear_tag_stackstate=Stack.iter(fun_->pp_close_stagstate())state.pp_tag_stack(* Flushing pretty-printer queue. *)letpp_flush_queuestate~end_with_newline=clear_tag_stackstate;whilestate.pp_curr_depth>1dopp_close_boxstate()done;state.pp_right_total<-pp_infinity;advance_leftstate;ifend_with_newlinethenpp_output_newlinestate;pp_rinitstate(*
Procedures to format values and use boxes.
*)(* To format a string. *)letpp_print_as_sizestatesizes=ifstate.pp_curr_depth<state.pp_max_boxesthenenqueue_string_asstatesizesletpp_print_asstateisizes=pp_print_as_sizestate(Size.of_intisize)sletpp_print_stringstates=pp_print_asstate(String.lengths)sletpp_print_bytesstates=pp_print_asstate(Bytes.lengths)(Bytes.to_strings)(* To format an integer. *)letpp_print_intstatei=pp_print_stringstate(Int.to_stringi)(* To format a float. *)letpp_print_floatstatef=pp_print_stringstate(string_of_floatf)(* To format a boolean. *)letpp_print_boolstateb=pp_print_stringstate(string_of_boolb)(* To format a char. *)letpp_print_charstatec=pp_print_asstate1(String.make1c)letpp_print_nothing_state()=()(* Opening boxes. *)letpp_open_hboxstate()=pp_open_box_genstate0Pp_hboxandpp_open_vboxstateindent=pp_open_box_genstateindentPp_vboxandpp_open_hvboxstateindent=pp_open_box_genstateindentPp_hvboxandpp_open_hovboxstateindent=pp_open_box_genstateindentPp_hovboxandpp_open_boxstateindent=pp_open_box_genstateindentPp_box(* Printing queued text.
[pp_print_flush] prints all pending items in the pretty-printer queue and
then flushes the low level output device of the formatter to actually
display printing material.
[pp_print_newline] behaves as [pp_print_flush] after printing an additional
new line. *)letpp_print_newlinestate()=pp_flush_queuestate~end_with_newline:true;state.pp_out_flush()andpp_print_flushstate()=pp_flush_queuestate~end_with_newline:false;state.pp_out_flush()(* To get a newline when one does not want to close the current box. *)letpp_force_newlinestate()=ifstate.pp_curr_depth<state.pp_max_boxesthenenqueue_advancestate{size=Size.zero;token=Pp_newline;length=0}(* To format something, only in case the line has just been broken. *)letpp_print_if_newlinestate()=ifstate.pp_curr_depth<state.pp_max_boxesthenenqueue_advancestate{size=Size.zero;token=Pp_if_newline;length=0}(* Generalized break hint that allows printing strings before/after
same-line offset (width) or new-line offset *)letpp_print_custom_breakstate~fits~breaks=letbefore,width,after=fitsinifstate.pp_curr_depth<state.pp_max_boxesthenletsize=Size.of_int(-state.pp_right_total)inlettoken=Pp_break{fits;breaks}inletlength=String.lengthbefore+width+String.lengthafterinletelem={size;token;length}inscan_pushstatetrueelem(* Printing break hints:
A break hint indicates where a box may be broken.
If line is broken then offset is added to the indentation of the current
box else (the value of) width blanks are printed. *)letpp_print_breakstatewidthoffset=pp_print_custom_breakstate~fits:("",width,"")~breaks:("",offset,"")(* Print a space :
a space is a break hint that prints a single space if the break does not
split the line;
a cut is a break hint that prints nothing if the break does not split the
line. *)letpp_print_spacestate()=pp_print_breakstate10andpp_print_cutstate()=pp_print_breakstate00(* Tabulation boxes. *)letpp_open_tboxstate()=state.pp_curr_depth<-state.pp_curr_depth+1;ifstate.pp_curr_depth<state.pp_max_boxesthenletsize=Size.zeroinletelem={size;token=Pp_tbegin(Pp_tbox(ref[]));length=0}inenqueue_advancestateelem(* Close a tabulation box. *)letpp_close_tboxstate()=ifstate.pp_curr_depth>1thenbeginifstate.pp_curr_depth<state.pp_max_boxesthenletelem={size=Size.zero;token=Pp_tend;length=0}inenqueue_advancestateelem;state.pp_curr_depth<-state.pp_curr_depth-1end(* Print a tabulation break. *)letpp_print_tbreakstatewidthoffset=ifstate.pp_curr_depth<state.pp_max_boxesthenletsize=Size.of_int(-state.pp_right_total)inletelem={size;token=Pp_tbreak(width,offset);length=width}inscan_pushstatetrueelemletpp_print_tabstate()=pp_print_tbreakstate00letpp_set_tabstate()=ifstate.pp_curr_depth<state.pp_max_boxesthenletelem={size=Size.zero;token=Pp_stab;length=0}inenqueue_advancestateelem(*
Procedures to control the pretty-printers
*)(* Set_max_boxes. *)letpp_set_max_boxesstaten=ifn>1thenstate.pp_max_boxes<-n(* To know the current maximum number of boxes allowed. *)letpp_get_max_boxesstate()=state.pp_max_boxesletpp_over_max_boxesstate()=state.pp_curr_depth=state.pp_max_boxes(* Ellipsis. *)letpp_set_ellipsis_textstates=state.pp_ellipsis<-sandpp_get_ellipsis_textstate()=state.pp_ellipsis(* To set the margin of pretty-printer. *)letpp_limitn=ifn<pp_infinitythennelsepredpp_infinity(* Internal pretty-printer functions. *)letpp_set_min_space_leftstaten=ifn>=1thenletn=pp_limitninstate.pp_min_space_left<-n;state.pp_max_indent<-state.pp_margin-state.pp_min_space_left;pp_rinitstate(* Initially, we have :
pp_max_indent = pp_margin - pp_min_space_left, and
pp_space_left = pp_margin. *)letpp_set_max_indentstaten=ifn>1thenpp_set_min_space_leftstate(state.pp_margin-n)letpp_get_max_indentstate()=state.pp_max_indentletpp_set_marginstaten=ifn>=1thenletn=pp_limitninstate.pp_margin<-n;letnew_max_indent=(* Try to maintain max_indent to its actual value. *)ifstate.pp_max_indent<=state.pp_marginthenstate.pp_max_indentelse(* If possible maintain pp_min_space_left to its actual value,
if this leads to a too small max_indent, take half of the
new margin, if it is greater than 1. *)Int.max(Int.max(state.pp_margin-state.pp_min_space_left)(state.pp_margin/2))1in(* Rebuild invariants. *)pp_set_max_indentstatenew_max_indent(** Geometry functions and types *)typegeometry={max_indent:int;margin:int}letvalidate_geometry{margin;max_indent}=ifmax_indent<2thenError"max_indent < 2"elseifmargin<=max_indentthenError"margin <= max_indent"elseifmargin>=pp_infinitythenError"margin >= pp_infinity"elseOk()letcheck_geometrygeometry=matchvalidate_geometrygeometrywith|Ok()->true|Error_->falseletpp_get_marginstate()=state.pp_marginletpp_set_full_geometrystate{margin;max_indent}=pp_set_marginstatemargin;pp_set_max_indentstatemax_indent;()letpp_set_geometrystate~max_indent~margin=letgeometry={max_indent;margin}inmatchvalidate_geometrygeometrywith|Errormsg->raise(Invalid_argument("Format.pp_set_geometry: "^msg))|Ok()->pp_set_full_geometrystategeometryletpp_safe_set_geometrystate~max_indent~margin=letgeometry={max_indent;margin}inmatchvalidate_geometrygeometrywith|Error_msg->()|Ok()->pp_set_full_geometrystategeometryletpp_get_geometrystate()={margin=pp_get_marginstate();max_indent=pp_get_max_indentstate()}letpp_update_geometrystateupdate=letgeometry=pp_get_geometrystate()inpp_set_full_geometrystate(updategeometry)(* Setting a formatter basic output functions. *)letpp_set_formatter_out_functionsstate{out_string=f;out_flush=g;out_newline=h;out_spaces=i;out_indent=j;}=state.pp_out_string<-f;state.pp_out_flush<-g;state.pp_out_newline<-h;state.pp_out_spaces<-i;state.pp_out_indent<-jletpp_get_formatter_out_functionsstate()={out_string=state.pp_out_string;out_flush=state.pp_out_flush;out_newline=state.pp_out_newline;out_spaces=state.pp_out_spaces;out_indent=state.pp_out_indent;}(* Setting a formatter basic string output and flush functions. *)letpp_set_formatter_output_functionsstatefg=state.pp_out_string<-f;state.pp_out_flush<-gletpp_get_formatter_output_functionsstate()=(state.pp_out_string,state.pp_out_flush)(* The default function to output new lines. *)letdisplay_newlinestate()=state.pp_out_string"\n"01(* The default function to output spaces. *)letblank_line=String.make80' 'letrecdisplay_blanksstaten=ifn>0thenifn<=80thenstate.pp_out_stringblank_line0nelsebeginstate.pp_out_stringblank_line080;display_blanksstate(n-80)end(* The default function to output indentation of new lines. *)letdisplay_indent=display_blanks(* Setting a formatter basic output functions as printing to a given
[Stdlib.out_channel] value. *)letpp_set_formatter_out_channelstateoc=state.pp_out_string<-output_substringoc;state.pp_out_flush<-(fun()->flushoc);state.pp_out_newline<-display_newlinestate;state.pp_out_spaces<-display_blanksstate;state.pp_out_indent<-display_indentstate(*
Defining specific formatters
*)letdefault_pp_mark_open_tag=function|String_tags->"<"^s^">"|_->""letdefault_pp_mark_close_tag=function|String_tags->"</"^s^">"|_->""letdefault_pp_print_open_tag=ignoreletdefault_pp_print_close_tag=ignore(* Building a formatter given its basic output functions.
Other fields get reasonable default values. *)letpp_make_formatterfghij=(* The initial state of the formatter contains a dummy box. *)letpp_queue=Queue.create()inletsys_tok={size=Size.unknown;token=Pp_begin(0,Pp_hovbox);length=0}inQueue.addsys_tokpp_queue;letscan_stack=Stack.create()ininitialize_scan_stackscan_stack;Stack.push{left_total=1;queue_elem=sys_tok}scan_stack;letpp_margin=78andpp_min_space_left=10in{pp_scan_stack=scan_stack;pp_format_stack=Stack.create();pp_tbox_stack=Stack.create();pp_tag_stack=Stack.create();pp_mark_stack=Stack.create();pp_margin=pp_margin;pp_min_space_left=pp_min_space_left;pp_max_indent=pp_margin-pp_min_space_left;pp_space_left=pp_margin;pp_current_indent=0;pp_is_new_line=true;pp_left_total=1;pp_right_total=1;pp_curr_depth=1;pp_max_boxes=max_int;pp_ellipsis=".";pp_out_string=f;pp_out_flush=g;pp_out_newline=h;pp_out_spaces=i;pp_out_indent=j;pp_print_tags=false;pp_mark_tags=false;pp_mark_open_tag=default_pp_mark_open_tag;pp_mark_close_tag=default_pp_mark_close_tag;pp_print_open_tag=default_pp_print_open_tag;pp_print_close_tag=default_pp_print_close_tag;pp_queue=pp_queue;}(* Build a formatter out of its out functions. *)letformatter_of_out_functionsout_funs=pp_make_formatterout_funs.out_stringout_funs.out_flushout_funs.out_newlineout_funs.out_spacesout_funs.out_indent(* Make a formatter with default functions to output spaces,
indentation, and new lines. *)letmake_formatteroutputflush=letppf=pp_make_formatteroutputflushignoreignoreignoreinppf.pp_out_newline<-display_newlineppf;ppf.pp_out_spaces<-display_blanksppf;ppf.pp_out_indent<-display_indentppf;ppf(* Make a formatter writing to a given [Stdlib.out_channel] value. *)letformatter_of_out_channeloc=make_formatter(output_substringoc)(fun()->flushoc)(* Make a formatter writing to a given [Buffer.t] value. *)letformatter_of_bufferb=make_formatter(Buffer.add_substringb)ignore(* Allocating buffer for pretty-printing purposes.
Default buffer size is pp_buffer_size or 512.
*)letpp_buffer_size=512letpp_make_buffer()=Buffer.createpp_buffer_size(* The standard (shared) buffer. *)letstdbuf=pp_make_buffer()(* Predefined formatters standard formatter to print
to [Stdlib.stdout], [Stdlib.stderr], and {!stdbuf}. *)letstd_formatter=formatter_of_out_channelStdlib.stdoutanderr_formatter=formatter_of_out_channelStdlib.stderrandstr_formatter=formatter_of_bufferstdbuf(* Initialise domain local state *)moduleDLS=Domain.DLSletstdbuf_key=DLS.new_keypp_make_bufferlet_=DLS.setstdbuf_keystdbufletstr_formatter_key=DLS.new_key(fun()->formatter_of_buffer(DLS.getstdbuf_key))let_=DLS.setstr_formatter_keystr_formatterletbuffered_out_stringkeystrofslen=Buffer.add_substring(Domain.DLS.getkey)strofslenletbuffered_out_flushockey()=letbuf=Domain.DLS.getkeyinletlen=Buffer.lengthbufinletstr=Buffer.contentsbufinoutput_substringocstr0len;Stdlib.flushoc;Buffer.clearbufletstd_buf_key=Domain.DLS.new_key(fun()->Buffer.createpp_buffer_size)leterr_buf_key=Domain.DLS.new_key(fun()->Buffer.createpp_buffer_size)letstd_formatter_key=DLS.new_key(fun()->letppf=pp_make_formatter(buffered_out_stringstd_buf_key)(buffered_out_flushStdlib.stdoutstd_buf_key)ignoreignoreignoreinppf.pp_out_newline<-display_newlineppf;ppf.pp_out_spaces<-display_blanksppf;ppf.pp_out_indent<-display_indentppf;Domain.at_exit(pp_print_flushppf);ppf)let_=DLS.setstd_formatter_keystd_formatterleterr_formatter_key=DLS.new_key(fun()->letppf=pp_make_formatter(buffered_out_stringerr_buf_key)(buffered_out_flushStdlib.stderrerr_buf_key)ignoreignoreignoreinppf.pp_out_newline<-display_newlineppf;ppf.pp_out_spaces<-display_blanksppf;ppf.pp_out_indent<-display_indentppf;Domain.at_exit(pp_print_flushppf);ppf)let_=DLS.seterr_formatter_keyerr_formatterletget_std_formatter()=DLS.getstd_formatter_keyletget_err_formatter()=DLS.geterr_formatter_keyletget_str_formatter()=DLS.getstr_formatter_keyletget_stdbuf()=DLS.getstdbuf_key(* [flush_buffer_formatter buf ppf] flushes formatter [ppf],
then returns the contents of buffer [buf] that is reset.
Formatter [ppf] is supposed to print to buffer [buf], otherwise this
function is not really useful. *)letflush_buffer_formatterbufppf=pp_flush_queueppf~end_with_newline:false;lets=Buffer.contentsbufinBuffer.resetbuf;s(* Flush [str_formatter] and get the contents of [stdbuf]. *)letflush_str_formatter()=letstdbuf=DLS.getstdbuf_keyinletstr_formatter=DLS.getstr_formatter_keyinflush_buffer_formatterstdbufstr_formatterletmake_synchronized_formatteroutputflush=DLS.new_key(fun()->letbuf=Buffer.createpp_buffer_sizeinletoutput'=Buffer.add_substringbufinletflush'()=output(Buffer.contentsbuf)0(Buffer.lengthbuf);Buffer.clearbuf;flush()inmake_formatteroutput'flush')letsynchronized_formatter_of_out_channeloc=make_synchronized_formatter(output_substringoc)(fun()->flushoc)(*
Symbolic pretty-printing
*)(*
Symbolic pretty-printing is pretty-printing with no low level output.
When using a symbolic formatter, all regular pretty-printing activities
occur but output material is symbolic and stored in a buffer of output
items. At the end of pretty-printing, flushing the output buffer allows
post-processing of symbolic output before low level output operations.
*)typesymbolic_output_item=|Output_flush|Output_newline|Output_stringofstring|Output_spacesofint|Output_indentofinttypesymbolic_output_buffer={mutablesymbolic_output_contents:symbolic_output_itemlist;}letmake_symbolic_output_buffer()={symbolic_output_contents=[]}letclear_symbolic_output_buffersob=sob.symbolic_output_contents<-[]letget_symbolic_output_buffersob=List.revsob.symbolic_output_contentsletflush_symbolic_output_buffersob=letitems=get_symbolic_output_buffersobinclear_symbolic_output_buffersob;itemsletadd_symbolic_output_itemsobitem=sob.symbolic_output_contents<-item::sob.symbolic_output_contentsletformatter_of_symbolic_output_buffersob=letsymbolic_flushsob()=add_symbolic_output_itemsobOutput_flushandsymbolic_newlinesob()=add_symbolic_output_itemsobOutput_newlineandsymbolic_stringsobsin=add_symbolic_output_itemsob(Output_string(String.subsin))andsymbolic_spacessobn=add_symbolic_output_itemsob(Output_spacesn)andsymbolic_indentsobn=add_symbolic_output_itemsob(Output_indentn)inletf=symbolic_stringsobandg=symbolic_flushsobandh=symbolic_newlinesobandi=symbolic_spacessobandj=symbolic_indentsobinpp_make_formatterfghij(*
Basic functions on the 'standard' formatter
(the formatter that prints to [Stdlib.stdout]).
*)letopen_hboxv=pp_open_hbox(DLS.getstd_formatter_key)vandopen_vboxv=pp_open_vbox(DLS.getstd_formatter_key)vandopen_hvboxv=pp_open_hvbox(DLS.getstd_formatter_key)vandopen_hovboxv=pp_open_hovbox(DLS.getstd_formatter_key)vandopen_boxv=pp_open_box(DLS.getstd_formatter_key)vandclose_boxv=pp_close_box(DLS.getstd_formatter_key)vandopen_stagv=pp_open_stag(DLS.getstd_formatter_key)vandclose_stagv=pp_close_stag(DLS.getstd_formatter_key)vandprint_asvw=pp_print_as(DLS.getstd_formatter_key)vwandprint_stringv=pp_print_string(DLS.getstd_formatter_key)vandprint_bytesv=pp_print_bytes(DLS.getstd_formatter_key)vandprint_intv=pp_print_int(DLS.getstd_formatter_key)vandprint_floatv=pp_print_float(DLS.getstd_formatter_key)vandprint_charv=pp_print_char(DLS.getstd_formatter_key)vandprint_boolv=pp_print_bool(DLS.getstd_formatter_key)vandprint_breakvw=pp_print_break(DLS.getstd_formatter_key)vwandprint_cutv=pp_print_cut(DLS.getstd_formatter_key)vandprint_spacev=pp_print_space(DLS.getstd_formatter_key)vandforce_newlinev=pp_force_newline(DLS.getstd_formatter_key)vandprint_flushv=pp_print_flush(DLS.getstd_formatter_key)vandprint_newlinev=pp_print_newline(DLS.getstd_formatter_key)vandprint_if_newlinev=pp_print_if_newline(DLS.getstd_formatter_key)vandopen_tboxv=pp_open_tbox(DLS.getstd_formatter_key)vandclose_tboxv=pp_close_tbox(DLS.getstd_formatter_key)vandprint_tbreakvw=pp_print_tbreak(DLS.getstd_formatter_key)vwandset_tabv=pp_set_tab(DLS.getstd_formatter_key)vandprint_tabv=pp_print_tab(DLS.getstd_formatter_key)vandset_marginv=pp_set_margin(DLS.getstd_formatter_key)vandget_marginv=pp_get_margin(DLS.getstd_formatter_key)vandset_max_indentv=pp_set_max_indent(DLS.getstd_formatter_key)vandget_max_indentv=pp_get_max_indent(DLS.getstd_formatter_key)vandset_geometry~max_indent~margin=pp_set_geometry(DLS.getstd_formatter_key)~max_indent~marginandsafe_set_geometry~max_indent~margin=pp_safe_set_geometry(DLS.getstd_formatter_key)~max_indent~marginandget_geometryv=pp_get_geometry(DLS.getstd_formatter_key)vandupdate_geometryv=pp_update_geometry(DLS.getstd_formatter_key)vandset_max_boxesv=pp_set_max_boxes(DLS.getstd_formatter_key)vandget_max_boxesv=pp_get_max_boxes(DLS.getstd_formatter_key)vandover_max_boxesv=pp_over_max_boxes(DLS.getstd_formatter_key)vandset_ellipsis_textv=pp_set_ellipsis_text(DLS.getstd_formatter_key)vandget_ellipsis_textv=pp_get_ellipsis_text(DLS.getstd_formatter_key)vandset_formatter_out_channelv=pp_set_formatter_out_channel(DLS.getstd_formatter_key)vandset_formatter_out_functionsv=pp_set_formatter_out_functions(DLS.getstd_formatter_key)vandget_formatter_out_functionsv=pp_get_formatter_out_functions(DLS.getstd_formatter_key)vandset_formatter_output_functionsvw=pp_set_formatter_output_functions(DLS.getstd_formatter_key)vwandget_formatter_output_functionsv=pp_get_formatter_output_functions(DLS.getstd_formatter_key)vandset_formatter_stag_functionsv=pp_set_formatter_stag_functions(DLS.getstd_formatter_key)vandget_formatter_stag_functionsv=pp_get_formatter_stag_functions(DLS.getstd_formatter_key)vandset_print_tagsv=pp_set_print_tags(DLS.getstd_formatter_key)vandget_print_tagsv=pp_get_print_tags(DLS.getstd_formatter_key)vandset_mark_tagsv=pp_set_mark_tags(DLS.getstd_formatter_key)vandget_mark_tagsv=pp_get_mark_tags(DLS.getstd_formatter_key)vandset_tagsv=pp_set_tags(DLS.getstd_formatter_key)v(* Convenience functions *)letpp_print_iter?(pp_sep=pp_print_cut)iterpp_vppfv=letis_first=reftrueinletpp_vv=if!is_firstthenis_first:=falseelsepp_sepppf();pp_vppfviniterpp_vv(* To format a list *)letpp_print_list?(pp_sep=pp_print_cut)pp_vppfv=pp_print_iter~pp_sepList.iterpp_vppfv(* To format an array *)letpp_print_array?(pp_sep=pp_print_cut)pp_vppfv=pp_print_iter~pp_sepArray.iterpp_vppfv(* To format a sequence *)letpp_print_seq?(pp_sep=pp_print_cut)pp_vppfseq=pp_print_iter~pp_sepSeq.iterpp_vppfseq(* To format free-flowing text *)letpp_print_textppfs=letlen=String.lengthsinletleft=ref0inletright=ref0inletflush()=pp_print_stringppf(String.subs!left(!right-!left));incrright;left:=!right;inwhile(!right<>len)domatchs.[!right]with|'\n'->flush();pp_force_newlineppf()|' '->flush();pp_print_spaceppf()(* there is no specific support for '\t'
as it is unclear what a right semantics would be *)|_->incrrightdone;if!left<>lenthenflush()letpp_print_option?(none=fun_()->())pp_vppf=function|None->noneppf()|Somev->pp_vppfvletpp_print_result~ok~errorppf=function|Okv->okppfv|Errore->errorppfeletpp_print_either~left~rightppf=function|Either.Leftl->leftppfl|Either.Rightr->rightppfr(**************************************************************)letcompute_tagoutputtag_acc=letbuf=Buffer.create16inletppf=formatter_of_bufferbufinoutputppftag_acc;pp_print_flushppf();letlen=Buffer.lengthbufiniflen<2thenBuffer.contentsbufelseBuffer.subbuf1(len-2)(**************************************************************
Defining continuations to be passed as arguments of
CamlinternalFormat.make_printf.
**************************************************************)openCamlinternalFormatBasicsopenCamlinternalFormat(* Interpret a formatting entity on a formatter. *)letoutput_formatting_litppffmting_lit=matchfmting_litwith|Close_box->pp_close_boxppf()|Close_tag->pp_close_stagppf()|Break(_,width,offset)->pp_print_breakppfwidthoffset|FFlush->pp_print_flushppf()|Force_newline->pp_force_newlineppf()|Flush_newline->pp_print_newlineppf()|Magic_size(_,_)->()|Escaped_at->pp_print_charppf'@'|Escaped_percent->pp_print_charppf'%'|Scan_indicc->pp_print_charppf'@';pp_print_charppfc(* Recursively output an "accumulator" containing a reversed list of
printing entities (string, char, flus, ...) in an output_stream. *)(* Differ from Printf.output_acc by the interpretation of formatting. *)(* Used as a continuation of CamlinternalFormat.make_printf. *)letrecoutput_accppfacc=matchaccwith|Acc_string_literal(Acc_formatting_lit(p,Magic_size(_,size)),s)|Acc_data_string(Acc_formatting_lit(p,Magic_size(_,size)),s)->output_accppfp;pp_print_as_sizeppf(Size.of_intsize)s;|Acc_char_literal(Acc_formatting_lit(p,Magic_size(_,size)),c)|Acc_data_char(Acc_formatting_lit(p,Magic_size(_,size)),c)->output_accppfp;pp_print_as_sizeppf(Size.of_intsize)(String.make1c);|Acc_formatting_lit(p,f)->output_accppfp;output_formatting_litppff;|Acc_formatting_gen(p,Acc_open_tagacc')->output_accppfp;pp_open_stagppf(String_tag(compute_tagoutput_accacc'))|Acc_formatting_gen(p,Acc_open_boxacc')->output_accppfp;let(indent,bty)=open_box_of_string(compute_tagoutput_accacc')inpp_open_box_genppfindentbty|Acc_string_literal(p,s)|Acc_data_string(p,s)->output_accppfp;pp_print_stringppfs;|Acc_char_literal(p,c)|Acc_data_char(p,c)->output_accppfp;pp_print_charppfc;|Acc_delay(p,f)->output_accppfp;fppf;|Acc_flushp->output_accppfp;pp_print_flushppf();|Acc_invalid_arg(p,msg)->output_accppfp;invalid_argmsg;|End_of_acc->()(* Recursively output an "accumulator" containing a reversed list of
printing entities (string, char, flus, ...) in a buffer. *)(* Differ from Printf.bufput_acc by the interpretation of formatting. *)(* Used as a continuation of CamlinternalFormat.make_printf. *)letrecstrput_accppfacc=matchaccwith|Acc_string_literal(Acc_formatting_lit(p,Magic_size(_,size)),s)|Acc_data_string(Acc_formatting_lit(p,Magic_size(_,size)),s)->strput_accppfp;pp_print_as_sizeppf(Size.of_intsize)s;|Acc_char_literal(Acc_formatting_lit(p,Magic_size(_,size)),c)|Acc_data_char(Acc_formatting_lit(p,Magic_size(_,size)),c)->strput_accppfp;pp_print_as_sizeppf(Size.of_intsize)(String.make1c);|Acc_delay(Acc_formatting_lit(p,Magic_size(_,size)),f)->strput_accppfp;pp_print_as_sizeppf(Size.of_intsize)(f());|Acc_formatting_lit(p,f)->strput_accppfp;output_formatting_litppff;|Acc_formatting_gen(p,Acc_open_tagacc')->strput_accppfp;pp_open_stagppf(String_tag(compute_tagstrput_accacc'))|Acc_formatting_gen(p,Acc_open_boxacc')->strput_accppfp;let(indent,bty)=open_box_of_string(compute_tagstrput_accacc')inpp_open_box_genppfindentbty|Acc_string_literal(p,s)|Acc_data_string(p,s)->strput_accppfp;pp_print_stringppfs;|Acc_char_literal(p,c)|Acc_data_char(p,c)->strput_accppfp;pp_print_charppfc;|Acc_delay(p,f)->strput_accppfp;pp_print_stringppf(f());|Acc_flushp->strput_accppfp;pp_print_flushppf();|Acc_invalid_arg(p,msg)->strput_accppfp;invalid_argmsg;|End_of_acc->()(*
Defining [fprintf] and various flavors of [fprintf].
*)letkfprintfkppf(Format(fmt,_))=make_printf(funacc->output_accppfacc;kppf)End_of_accfmtandikfprintfkppf(Format(fmt,_))=make_iprintfkppffmtletifprintf_ppf(Format(fmt,_))=make_iprintfignore()fmtletfprintfppf=kfprintfignoreppfletprintf(Format(fmt,_))=make_printf(funacc->output_acc(DLS.getstd_formatter_key)acc)End_of_accfmtleteprintf(Format(fmt,_))=make_printf(funacc->output_acc(DLS.geterr_formatter_key)acc)End_of_accfmtletkdprintfk(Format(fmt,_))=make_printf(funacc->k(funppf->output_accppfacc))End_of_accfmtletdprintffmt=kdprintf(funi->i)fmtletksprintfk(Format(fmt,_))=letb=pp_make_buffer()inletppf=formatter_of_bufferbinletkacc=strput_accppfacc;k(flush_buffer_formatterbppf)inmake_printfkEnd_of_accfmtletsprintffmt=ksprintfidfmtletkasprintfk(Format(fmt,_))=letb=pp_make_buffer()inletppf=formatter_of_bufferbinletkacc=output_accppfacc;k(flush_buffer_formatterbppf)inmake_printfkEnd_of_accfmtletasprintffmt=kasprintfidfmt(* Flushing standard formatters at end of execution. *)letflush_standard_formatters()=pp_print_flush(DLS.getstd_formatter_key)();pp_print_flush(DLS.geterr_formatter_key)()let()=at_exitflush_standard_formatterslet()=Domain.before_first_spawn(fun()->flush_standard_formatters();letfs=pp_get_formatter_out_functionsstd_formatter()inpp_set_formatter_out_functionsstd_formatter{fswithout_string=buffered_out_stringstd_buf_key;out_flush=buffered_out_flushStdlib.stdoutstd_buf_key};letfs=pp_get_formatter_out_functionserr_formatter()inpp_set_formatter_out_functionserr_formatter{fswithout_string=buffered_out_stringerr_buf_key;out_flush=buffered_out_flushStdlib.stderrerr_buf_key};)