Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file stdlib.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206(* Js_of_ocaml compiler
* http://www.ocsigen.org/js_of_ocaml/
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU Lesser General Public License as published by
* the Free Software Foundation, with linking exception;
* either version 2.1 of the License, or (at your option) any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
*)letopen_in_text=open_inletopen_out_text=open_outmoduleDeprecated:sigvalopen_in:string->in_channel[@@deprecated"use open_int_text/open_int_bin"]valopen_out:string->out_channel[@@deprecated"use open_out_text/open_out_bin"]end=structletopen_in=open_inletopen_out=open_outendincludeDeprecatedmodulePoly=structexternalcompare:'a->'a->int="%compare"externalequal:'a->'a->bool="%equal"moduleHashtbl=HashtblendmoduleInt_replace_polymorphic_compare=structlet(<)(x:int)y=x<ylet(<=)(x:int)y=x<=ylet(<>)(x:int)y=x<>ylet(=)(x:int)y=x=ylet(>)(x:int)y=x>ylet(>=)(x:int)y=x>=yletcompare(x:int)y=compare xyletequal(x:int)y=x=yletmax(x:int)y=ifx>=ythenxelseyletmin(x:int)y=ifx<=ythenxelseyendletphys_equal=(==)let(==)=`use_phys_equallet(!=)=`use_phys_equalincludeInt_replace_polymorphic_compareletfail=reftrueletfailwith_fmt=Printf.ksprintf(funs->if!failthenfailwithselseFormat.eprintf"%s@."s)fmtletraise_exn=if!failthenraiseexnelseFormat.eprintf"%s@."(Printexc.to_stringexn)moduleList=structincludeListLabelslet(mem_assoc[@deprecated"use List.exists"])=List.memlet(assoc[@deprecated"use List.find_map"])=List.assoclet(assoc_opt[@deprecated"use List.find_map"])=List.assoc_optlet(remove_assoc[@deprecated"use List.filter"])=List.remove_assocletrecmem~eqx=function|[]->false|a::l->eqax||mem~eqxlletstring_assocnamel=List.find_map(fun(name',state)->ifString.equalnamename'thenSomestateelseNone)lletrecrev_append_map~flacc=matchlwith|[]->acc|x::xs->rev_append_map~fxs(fx::acc)letslow_mapl~f=rev(rev_map~fl)[@@ifocaml_version<(4,14,0)]letmax_non_tailcall=matchSys.backend_typewith|Sys.Native|Sys.Bytecode->1_000|Sys.Other_->50letreccount_map~flctr=matchlwith|[]->[]|[x1]->letf1=fx1in[f1]|[x1;x2]->letf1=fx1inletf2=fx2in[f1;f2]|[x1;x2;x3]->letf1=fx1inletf2=fx2inletf3=fx3in[f1;f2;f3]|[x1;x2;x3;x4]->letf1=fx1inletf2=fx2inletf3=fx3inletf4=fx4in[f1;f2;f3;f4]|x1::x2::x3::x4::x5::tl->letf1=fx1inletf2=fx2inletf3=fx3inletf4=fx4inletf5=fx5inf1::f2::f3::f4::f5::(ifctr>max_non_tailcallthenslow_map~ftlelsecount_map~ftl(ctr+1))[@@ifocaml_version<(4,14,0)]letmapl~f=count_map~fl0[@@ifocaml_version<(4,14,0)]let[@tail_mod_cons]recmapl~f=matchlwith|[]->[]|x::tl->fx::(map[@tailcall])tl~f[@@ifocaml_version>=(4,14,0)]letrectake'accnl=ifn=0thenacc,lelsematchlwith|[]->acc,[]|x::xs->take'(x::acc)(predn)xslettakenl=letx,xs=take'[]nlinrevx,xsletreclast=function|[]->None|[x]->Somex|_::xs->lastxsletis_empty=function|[]->true|_->false[@@ifocaml_version<(5,1,0)]lettail_appendl1l2=rev_append(revl1)l2[@@ifocaml_version<(5,1,0)]letreccount_appendl1l2count=matchl2with|[]->l1|_->(matchl1with|[]->l2|[x1]->x1::l2|[x1;x2]->x1::x2::l2|[x1;x2;x3]->x1::x2::x3::l2|[x1;x2;x3;x4]->x1::x2::x3::x4::l2|x1::x2::x3::x4::x5::tl->x1::x2::x3::x4::x5::(ifcount>max_non_tailcallthentail_appendtll2elsecount_appendtll2(count+1)))[@@ifocaml_version<(5,1,0)]letappendl1l2=count_appendl1l20[@@ifocaml_version<(5,1,0)]letgroupl~f=letrecloop(l:'alist)(this_group:'alist)(acc:'alistlist):'alistlist=matchlwith|[]->List.rev(List.revthis_group::acc)|x::xs->letpred=List.hdthis_groupiniffxpredthenloopxs(x::this_group)accelseloopxs[x](List.revthis_group::acc)inmatchlwith|[]->[]|x::xs->loopxs[x][]letsplit_lastxs=letrecauxacc=function|[]->None|[x]->Some(revacc,x)|x::xs->aux(x::acc)xsinaux[]xs(* like [List.map] except that it calls the function with
an additional argument to indicate whether we're mapping
over the last element of the list *)letrecmap_last~fl=matchlwith|[]->assertfalse|[x]->[ftruex]|x::xs->ffalsex::map_last~fxs(* like [List.iter] except that it calls the function with
an additional argument to indicate whether we're iterating
over the last element of the list *)letreciter_last~fl=matchlwith|[]->()|[a]->ftruea|a::l->ffalsea;iter_last~flendlet(@)=List.appendmoduleInt32=structincludeInt32external(<):int32->int32->bool="%lessthan"external(<=):int32->int32->bool="%lessequal"external(<>):int32->int32->bool="%notequal"external(=):int32->int32->bool="%equal"external(>):int32->int32->bool="%greaterthan"external(>=):int32->int32->bool="%greaterequal"letwarn_overflowname~to_dec~to_hexii32=Warning.warn`Integer_overflow"%s 0x%s (%s) truncated to 0x%lx (%ld); the generated code might be incorrect.@."name(to_hexi)(to_deci)i32i32letconvert_warning_on_overflowname~to_int32~of_int32~equal~to_dec~to_hexx=leti32=to_int32xinletx'=of_int32i32inifnot(equalx'x)thenwarn_overflowname~to_dec~to_hexxi32;i32letof_nativeint_warning_on_overflown=convert_warning_on_overflow"native integer"~to_int32:Nativeint.to_int32~of_int32:Nativeint.of_int32~equal:Nativeint.equal~to_dec:(Printf.sprintf"%nd")~to_hex:(Printf.sprintf"%nx")nendmoduleInt64=structincludeInt64external(<):int64->int64->bool="%lessthan"external(<=):int64->int64 ->bool="%lessequal"external(<>):int64->int64->bool="%notequal"external(=):int64->int64->bool="%equal"external(>):int64->int64->bool="%greaterthan"external(>=):int64->int64->bool="%greaterequal"endmoduleOption=structincludeOptionletmap~fx=matchxwith|None->None|Somev->Some(fv)letbind~fx=matchxwith|None->None|Somev->fvletiter~fx=matchxwith|None->()|Somev->fvletfilter~fx=matchxwith|None->None|Somev->iffvthenSomevelseNoneletvalue~default=function|None->default|Somes->sendmoduleFloat=structincludeFloatletequal(_:float)(_:float)=`Use_ieee_equal_or_bitwise_equalletieee_equal(a:float)(b:float)=Poly.equalabletbitwise_equal(a:float)(b:float)=Int64.equal(Int64.bits_of_floata)(Int64.bits_of_floatb)external(<):t->t->bool="%lessthan"external(<=):t->t->bool="%lessequal"external(<>):t->t->bool="%notequal"external(=):t->t->bool="%equal"external(>):t->t->bool="%greaterthan"external(>=):t->t->bool="%greaterequal"endmoduleBool=structincludeBoolexternal(<>):bool->bool->bool="%notequal"external(=):bool->bool->bool="%equal"external(>):bool->bool->bool="%greaterthan"endmoduleChar=structincludeCharexternal(<):char->char->bool="%lessthan"external(<=):char->char->bool="%lessequal"external(<>):char->char->bool="%notequal"external(=):char->char->bool="%equal"external(>):char->char->bool="%greaterthan"external(>=):char->char->bool="%greaterequal"letis_letter=function|'a'..'z'|'A'..'Z'->true|_->falseletis_digit=function|'0'..'9'->true|_->falseendmoduleUchar=structincludeUcharmoduleUtf_decode:sigtypeutf_decode[@@immediate](** The type for UTF decode results. Values of this type represent
the result of a Unicode Transformation Format decoding attempt. *)valutf_decode_is_valid:utf_decode->bool(** [utf_decode_is_valid d] is [true] if and only if [d] holds a valid
decode. *)valutf_decode_uchar:utf_decode->t(** [utf_decode_uchar d] is the Unicode character decoded by [d] if
[utf_decode_is_valid d] is [true] and {!Uchar.rep} otherwise. *)valutf_decode_length:utf_decode->int(** [utf_decode_length d] is the number of elements from the source
that were consumed by the decode [d]. This is always strictly
positive and smaller or equal to [4]. The kind of source elements
depends on the actual decoder; for the decoders of the standard
library this function always returns a length in bytes. *)valutf_decode:int->t->utf_decode(** [utf_decode n u] is a valid UTF decode for [u] that consumed [n]
elements from the source for decoding. [n] must be positive and
smaller or equal to [4] (this is not checked by the module). *)valutf_decode_invalid:int->utf_decode(** [utf_decode_invalid n] is an invalid UTF decode that consumed [n]
elements from the source to error. [n] must be positive and
smaller or equal to [4] (this is not checked by the module). The
resulting decode has {!rep} as the decoded Unicode character. *)valutf_8_byte_length:t->int(** [utf_8_byte_length u] is the number of bytes needed to encode
[u] in UTF-8. *)valutf_16_byte_length:t->int(** [utf_16_byte_length u] is the number of bytes needed to encode
[u] in UTF-16. *)end=struct(* UTF codecs tools *)typeutf_decode=int(* This is an int [0xDUUUUUU] decomposed as follows:
- [D] is four bits for decode information, the highest bit is set if the
decode is valid. The three lower bits indicate the number of elements
from the source that were consumed by the decode.
- [UUUUUU] is the decoded Unicode character or the Unicode replacement
character U+FFFD if for invalid decodes. *)letrep=0xFFFDletvalid_bit=27letdecode_bits=24let[@inline]utf_decode_is_validd=dlsrvalid_bit=1let[@inline]utf_decode_lengthd=(dlsrdecode_bits)land0b111let[@inline]utf_decode_uchard=unsafe_of_int(dland0xFFFFFF)let[@inline]utf_decodenu=((8lorn)lsldecode_bits)lorto_intulet[@inline]utf_decode_invalidn=(nlsldecode_bits)lorrepletutf_8_byte_lengthu=matchto_intuwith|uwhenu<0->assertfalse|uwhenu<=0x007F->1|uwhenu<=0x07FF->2|uwhenu<=0xFFFF->3|uwhenu<=0x10FFFF->4|_->assertfalseletutf_16_byte_lengthu=matchto_intuwith|uwhenu<0->assertfalse|uwhenu<=0xFFFF->2|uwhenu<=0x10FFFF->4|_->assertfalseendincludeUtf_decodeendmoduleBuffer=structincludeBufferletarray_conv=Array.init16(funi->"0123456789abcdef".[i])letadd_char_hexb(c:Char.t)=letc=Char.codecinBuffer.add_charb(Array.unsafe_getarray_conv(clsr4));Buffer.add_charb(Array.unsafe_getarray_conv(cland0xf))endmoduleBytes=BytesLabelsmoduleString=structincludeStringLabelslethash(a:string)=Hashtbl.hasha[@@ifocaml_version<(5,0,0)]moduleHashtbl=Hashtbl.Make(structincludeStringlethash=hashend)letis_empty=function|""->true|_->falseletdrop_prefix~prefixs=letplen=String.lengthprefixinifplen>String.lengthsthenNoneelsetryfori=0toString.lengthprefix-1doifnot(Char.equals.[i]prefix.[i])thenraiseExitdone;Some(String.subsplen(String.lengths-plen))withExit->Noneletis_asciis=letres=reftrueinfori=0toString.lengths-1domatchs.[i]with|'\000'..'\127'->()|'\128'..'\255'->res:=falsedone;!reslethas_backslashs=letres=reffalseinfori=0toString.lengths-1doifChar.equals.[i]'\\'thenres:=truedone;!resletlsplit2line~on:delim=tryletpos=indexlinedeliminSome(subline~pos:0~len:pos,subline~pos:(pos+1)~len:(lengthline-pos-1))withNot_found->Noneletrsplit2line~on:delim=tryletpos=rindexlinedeliminSome(subline~pos:0~len:pos,subline~pos:(pos+1)~len:(lengthline-pos-1))withNot_found->Nonelet[@inline]not_in_x80_to_xBFb=blsr6<>0b10let[@inline]not_in_xA0_to_xBFb=blsr5<>0b101let[@inline]not_in_x80_to_x9Fb=blsr5<>0b100let[@inline]not_in_x90_to_xBFb=b<0x90||0xBF<blet[@inline]not_in_x80_to_x8Fb=blsr4<>0x8let[@inline]utf_8_uchar_2b0b1=((b0land0x1F)lsl6)lor(b1land0x3F)let[@inline]utf_8_uchar_3b0b1b2=((b0land0x0F)lsl12)lor((b1land0x3F)lsl6)lor(b2land0x3F)let[@inline]utf_8_uchar_4b0b1b2b3=((b0land0x07)lsl18)lor((b1land0x3F)lsl12)lor((b2land0x3F)lsl6)lor(b3land0x3F)externalget_uint8:string->int->int="%string_safe_get"externalunsafe_get_uint8:string->int->int="%string_unsafe_get"letdec_invalid=Uchar.utf_decode_invalidlet[@inline]dec_retnu=Uchar.utf_decoden(Uchar.unsafe_of_intu)letget_utf_8_ucharbi=letb0=get_uint8biin(* raises if [i] is not a valid index. *)letget=unsafe_get_uint8inletmax=lengthb-1inmatchChar.unsafe_chrb0with(* See The Unicode Standard, Table 3.7 *)|'\x00'..'\x7F'->dec_ret1b0|'\xC2'..'\xDF'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x80_to_xBFb1thendec_invalid1elsedec_ret2(utf_8_uchar_2b0b1)|'\xE0'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_xA0_to_xBFb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elsedec_ret3(utf_8_uchar_3b0b1b2)|'\xE1'..'\xEC'|'\xEE'..'\xEF'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x80_to_xBFb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elsedec_ret3(utf_8_uchar_3b0b1b2)|'\xED'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x80_to_x9Fb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elsedec_ret3(utf_8_uchar_3b0b1b2)|'\xF0'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x90_to_xBFb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elseleti=i+1inifi>maxthendec_invalid3elseletb3=getbiinifnot_in_x80_to_xBFb3thendec_invalid3elsedec_ret4(utf_8_uchar_4b0b1b2b3)|'\xF1'..'\xF3'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x80_to_xBFb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elseleti=i+1inifi>maxthendec_invalid3elseletb3=getbiinifnot_in_x80_to_xBFb3thendec_invalid3elsedec_ret4(utf_8_uchar_4b0b1b2b3)|'\xF4'->leti=i+1inifi>maxthendec_invalid1elseletb1=getbiinifnot_in_x80_to_x8Fb1thendec_invalid1elseleti=i+1inifi>maxthendec_invalid2elseletb2=getbiinifnot_in_x80_to_xBFb2thendec_invalid2elseleti=i+1inifi>maxthendec_invalid3elseletb3=getbiinifnot_in_x80_to_xBFb3thendec_invalid3elsedec_ret4(utf_8_uchar_4b0b1b2b3)|_->dec_invalid1letfold_utf_8s~facc=letrecloopis~pos~facc=ifString.lengths=posthenaccelseletr=get_utf_8_ucharsposinletl=Uchar.utf_decode_lengthrinletacc=facci(Uchar.utf_decode_ucharr)inloop(i+1)s~pos:(pos+l)~faccinloop0s~pos:0~faccletfix_utf_8s=letb=Buffer.create(String.lengths)infold_utf_8s()~f:(fun()_iu->Buffer.add_utf_8_ucharbu);Buffer.contentsbletis_valid_utf_8b=letrecloopmaxbi=ifi>maxthentrueelseletget=unsafe_get_uint8inmatchChar.unsafe_chr(getbi)with|'\x00'..'\x7F'->loopmaxb(i+1)|'\xC2'..'\xDF'->letlast=i+1iniflast>max||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xE0'->letlast=i+2iniflast>max||not_in_xA0_to_xBF(getb(i+1))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xE1'..'\xEC'|'\xEE'..'\xEF'->letlast=i+2iniflast>max||not_in_x80_to_xBF(getb(i+1))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xED'->letlast=i+2iniflast>max||not_in_x80_to_x9F(getb(i+1))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xF0'->letlast=i+3iniflast>max||not_in_x90_to_xBF(getb(i+1))||not_in_x80_to_xBF(getb(i+2))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xF1'..'\xF3'->letlast=i+3iniflast>max||not_in_x80_to_xBF(getb(i+1))||not_in_x80_to_xBF(getb(i+2))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|'\xF4'->letlast=i+3iniflast>max||not_in_x80_to_x8F(getb(i+1))||not_in_x80_to_xBF(getb(i+2))||not_in_x80_to_xBF(getblast)thenfalseelseloopmaxb(last+1)|_->falseinloop(lengthb-1)b0endmoduleUtf8_string:sigtypet=privateUtf8ofstring[@@ocaml.unboxed]valof_string_exn:string->tvalcompare:t->t->intvalequal:t->t->boolend=structtypet=Utf8ofstring[@@ocaml.unboxed]letof_string_exns=ifString.is_valid_utf_8sthenUtf8selseinvalid_arg"Utf8_string.of_string: invalid utf8 string"letcompare(Utf8x)(Utf8y)=String.comparexyletequal(Utf8x)(Utf8y)=String.equalxyendmoduleInt=structincludeIntlethash(x:t)=xmoduleHashtbl=Hashtbl.Make(structincludeIntlethashx=xend)endmoduleIntSet=Set.Make(Int)moduleIntMap=Map.Make(Int)moduleStringSet=Set.Make(String)moduleStringMap=Map.Make(String)moduleUtf8_string_set=Set.Make(Utf8_string)moduleUtf8_string_map=Map.Make(Utf8_string)moduleBitSet:sigtypetvalcreate:unit->tvalcreate':int->tvalmem:t->int->boolvalset:t->int->unitvalunset:t->int->unitvalcopy:t->tvaliter:f:(int->unit)->t->unitvalsize:t->intvalnext_free:t->int->intvalnext_mem:t->int->intvalclear:t->unitend=structtypet={mutablearr:intarray}letcreate()={arr=Array.make10}letcreate'n={arr=Array.make((n/Sys.int_size)+1)0}letcleart=Array.fillt.arr0(Array.lengtht.arr)0letsizet=Array.lengtht.arr*Sys.int_sizeletmemti=letarr=t.arrinletidx=i/Sys.int_sizeinletoff=imodSys.int_sizeinidx<Array.lengtharr&&letx=Array.unsafe_getarridxinx<>0&&xland(1lsloff)<>0let[@ocaml.inlinenever]resizetidx=letsize=Array.lengtht.arrinletsize_ref=refsizeinwhileidx>=!size_refdosize_ref:=!size_ref*2done;leta=Array.make!size_ref0inArray.blitt.arr0a0size;t.arr<-aletsetti=letidx=i/Sys.int_sizeinletoff=imodSys.int_sizeinletsize=Array.lengtht.arrinifidx>=sizethenresizetidx;Array.unsafe_sett.arridx(Array.unsafe_gett.arridxlor(1lsloff))letunsetti=letidx=i/Sys.int_sizeinletoff=imodSys.int_sizeinletsize=Array.lengtht.arrinifidx>=sizethen()elseletb=Array.unsafe_gett.arridxinletmask=1lsloffinifb<>0&&blandmask<>0thenArray.unsafe_sett.arridx(blxormask)letnext_freeti=letx=refiinwhilememt!xdoincrxdone;!xletnext_memti=letx=refiinwhilenot(memt!x)doincrxdone;!xletcopyt={arr=Array.copyt.arr}letiter~ft=fori=0tosizetdoifmemtithenfidoneendmoduleArray=structincludeArrayLabelsletfold_right_ia~f~init:x=letr=refxinfori=Array.lengtha-1downto0dor:=fi(Array.unsafe_getai)!rdone;!rletequaleqab=letlen_a=Array.lengthainiflen_a<>Array.lengthbthenfalseelseleti=ref0inwhile!i<len_a&&eqa.(!i)b.(!i)doincridone;!i=len_aendmoduleFilename=structincludeFilenamelettemp_file_name=(* Inlined unavailable Filename.temp_file_name. Filename.temp_file gives
us incorrect permissions. https://github.com/ocsigen/js_of_ocaml/issues/182 *)letprng=lazy(Random.State.make_self_init())infun~temp_dirprefixsuffix->letrnd=Random.State.bits(Lazy.forceprng)land0xFFFFFFinFilename.concattemp_dir(Printf.sprintf"%s%06x%s"prefixrndsuffix)letgen_filefilef=letf_tmp=temp_file_name~temp_dir:(Filename.dirnamefile)(Filename.basenamefile)".tmp"intryletch=open_out_binf_tmpinletres=tryfchwithe->close_outch;raiseeinclose_outch;(trySys.removefilewithSys_error_->());Sys.renamef_tmpfile;reswithexc->Sys.removef_tmp;raiseexcendmoduleFun=structincludeFunletmemoizef=leth=Hashtbl.create4infunx->tryHashtbl.findhxwithNot_found->letr=fxinHashtbl.addhxr;rendmoduleIn_channel=structletstdlib_input_line=input_line(* Read up to [len] bytes into [buf], starting at [ofs]. Return total bytes
read. *)letread_uptoicbufofslen=letrecloopofslen=iflen=0thenofselseletr=inputicbufofsleninifr=0thenofselseloop(ofs+r)(len-r)inloopofslen-ofs(* Best effort attempt to return a buffer with >= (ofs + n) bytes of storage,
and such that it coincides with [buf] at indices < [ofs].
The returned buffer is equal to [buf] itself if it already has sufficient
free space.
The returned buffer may have *fewer* than [ofs + n] bytes of storage if this
number is > [Sys.max_string_length]. However the returned buffer will
*always* have > [ofs] bytes of storage. In the limiting case when [ofs = len
= Sys.max_string_length] (so that it is not possible to resize the buffer at
all), an exception is raised. *)letensurebufofsn=letlen=Bytes.lengthbufiniflen>=ofs+nthenbufelseletnew_len=refleninwhile!new_len<ofs+ndonew_len:=(2*!new_len)+1done;letnew_len=!new_leninletnew_len=ifnew_len<=Sys.max_string_lengththennew_lenelseifofs<Sys.max_string_lengththenSys.max_string_lengthelsefailwith"In_channel.input_all: channel content is larger than maximum string length"inletnew_buf=Bytes.createnew_leninBytes.blit~src:buf~src_pos:0~dst:new_buf~dst_pos:0~len:ofs;new_bufletinput_allic=letchunk_size=65536in(* IO_BUFFER_SIZE *)letinitial_size=tryin_channel_lengthic-pos_inicwithSys_error_->-1inletinitial_size=ifinitial_size<0thenchunk_sizeelseinitial_sizeinletinitial_size=ifinitial_size<=Sys.max_string_lengththeninitial_sizeelseSys.max_string_lengthinletbuf=Bytes.createinitial_sizeinletnread=read_uptoicbuf0initial_sizeinifnread<initial_sizethen(* EOF reached, buffer partially filled *)Bytes.sub_stringbuf~pos:0~len:nreadelse(* nread = initial_size, maybe EOF reached *)matchinput_charicwith|exceptionEnd_of_file->(* EOF reached, buffer is completely filled *)Bytes.unsafe_to_stringbuf|c->(* EOF not reached *)letrecloopbufofs=letbuf=ensurebufofschunk_sizeinletrem=Bytes.lengthbuf-ofsin(* [rem] can be < [chunk_size] if buffer size close to
[Sys.max_string_length] *)letr=read_uptoicbufofsreminifr<remthen(* EOF reached *)Bytes.sub_stringbuf~pos:0~len:(ofs+r)else(* r = rem *)loopbuf(ofs+rem)inletbuf=ensurebufnread(chunk_size+1)inBytes.setbufnreadc;loopbuf(nread+1)letinput_linesic=letrecauxacc=matchinput_lineicwith|line->aux(line::acc)|exceptionEnd_of_file->accinList.rev(aux[])letinput_line_exn=stdlib_input_lineend[@@ifocaml_version<(4,14,0)]moduleIn_channel=structletstdlib_input_line=input_lineincludeIn_channel(* [In_channel.input_lines] only exists in the stdlib since 5.1. *)let[@tail_mod_cons]recinput_linesic=matchstdlib_input_lineicwith|line->line::input_linesic|exceptionEnd_of_file->[][@@ifocaml_version<(5,1,0)]letinput_line_exn=stdlib_input_lineend[@@ifocaml_version>=(4,14,0)]moduleSeq=structincludeSeqletrecmapi_auxfixs()=matchxs()with|Nil->Nil|Cons(x,xs)->Cons(fix,mapi_auxf(i+1)xs)(* Available since OCaml 4.14 *)let[@inline]mapifxs=mapi_auxf0xsendletsplit_liness=ifString.equals""then[]elseletsep='\n'inletr=ref[]inletj=ref(String.lengths)in(* ignore trailing new line *)ifChar.equal(String.unsafe_gets(!j-1))septhendecrj;fori=!j-1downto0doifChar.equal(String.unsafe_getsi)septhen(r:=String.subs~pos:(i+1)~len:(!j-i-1)::!r;j:=i)done;String.subs~pos:0~len:!j::!rletinput_lines_read_onceiclen=really_input_stringiclen|>split_linesletfile_lines_binfname=(* If possible, read the entire file and split it in lines.
This is faster than reading it line by line.
Otherwise, we fall back to a line-by-line read. *)letic=open_in_binfnameinletlen=in_channel_lengthicinletx=iflen<Sys.max_string_lengththeninput_lines_read_onceiclenelseIn_channel.input_linesicinclose_inic;xletfile_lines_textfile=letic=open_in_textfileinletc=In_channel.input_linesicinclose_inic;cletgenerated_name=function|"param"|"match"|"switcher"->true|s->String.starts_with~prefix:"cst_"smoduleHashtbl=structincludeHashtbllet(create[@deprecated"Use Int.Hashtbl, String.Hashtbl, Var.Hashtbl, Addr.Hashtbl"])=Hashtbl.createlet(of_seq[@deprecated"Use Int.Hashtbl, String.Hashtbl, Var.Hashtbl, Addr.Hashtbl"])=Hashtbl.of_seqendmoduleLexing=structincludeLexingletrange_to_string(pos1,pos2)=ifphys_equalpos1dummy_pos||phys_equalpos2dummy_posthen"At an unknown location:\n"elseletfile=pos1.pos_fnameinletline=pos1.pos_lnuminletchar1=pos1.pos_cnum-pos1.pos_bolinletchar2=pos2.pos_cnum-pos1.pos_bolin(* yes, [pos1.pos_bol] *)Printf.sprintf"File \"%s\", line %d, characters %d-%d:\n"filelinechar1char2(* use [char1 + 1] and [char2 + 1] if *not* using Caml mode *)end