Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file bigint.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498openCore_kernelopenPolymoduleZ=Zarith.Ztypet=Z.t[@@derivingtyperep~abstract]letmodule_name="Bigint"moduleStringable_t=structtypenonrect=tletto_string=Z.to_stringletrecis_integer_suffixsi~len~char_is_digit=ifi<lenthen(letc=s.[i]inifchar_is_digitc||Char.equalc'_'thenis_integer_suffixs(i+1)~len~char_is_digitelsefalse)elsetrue;;letis_integer_strings~char_is_digit=letlen=String.lengthsinif0<lenthen(leti=ifChar.equals.[0]'-'then1else0inifi<lenthenifchar_is_digits.[i]thenis_integer_suffixs(i+1)~len~char_is_digitelsefalseelsefalse)elsefalse;;letof_string_basestr~name~of_string_no_underscores~char_is_digit=tryof_string_no_underscoresstrwith|_->ifis_integer_stringstr~char_is_digitthenof_string_no_underscores(String.filterstr~f:(func->c<>'_'))elsefailwithf"%s.%s: invalid argument %S"namemodule_namestr();;letof_stringstr=of_string_basestr~name:"of_string"~of_string_no_underscores:Z.of_string~char_is_digit:Char.is_digit;;endmoduleStable=structmoduleV1=structmoduleBin_rep=structtypet=|Zero|Posofstring|Negofstring[@@derivingbin_io]endmoduleBin_rep_conversion=structtypenonrect=tletto_binablet=lets=Z.signtinifs>0thenBin_rep.Pos(Z.to_bitst)elseifs<0thenBin_rep.Neg(Z.to_bitst)elseBin_rep.Zero;;letof_binable=function|Bin_rep.Zero->Z.zero|Bin_rep.Posbits->Z.of_bitsbits|Bin_rep.Negbits->Z.of_bitsbits|>Z.neg;;endtypenonrect=tletcompare=Z.compareincludeSexpable.Stable.Of_stringable.V1(Stringable_t)includeBinable.Stable.Of_binable.V1(Bin_rep)(Bin_rep_conversion)endmoduleV2=structtypenonrect=tletcompare=Z.compareincludeSexpable.Stable.Of_stringable.V1(Stringable_t)letcompute_size_in_bytesx=letnumbits=Z.numbitsxinInt.round_up~to_multiple_of:8numbits/8;;letcompute_tag~size_in_bytes~negative=letopenInt63inletsign_bit=ifnegativethenoneelsezeroin(* Can't overflow:
size <= String.length bits < 2 * max_string_length < max_int63
*)shift_left(of_intsize_in_bytes)1+sign_bit;;letbin_size_t:tBin_prot.Size.sizer=funx->letsize_in_bytes=compute_size_in_bytesxinifsize_in_bytes=0thenInt63.bin_size_tInt63.zeroelse(letnegative=Z.signx=-1inlettag=compute_tag~size_in_bytes~negativeinInt63.bin_size_ttag+size_in_bytes);;letbin_write_t:tBin_prot.Write.writer=funbuf~posx->letsize_in_bytes=compute_size_in_bytesxinifsize_in_bytes=0thenInt63.bin_write_tbuf~posInt63.zeroelse(letbits=Z.to_bitsxinletnegative=Z.signx=-1inlettag=compute_tag~size_in_bytes~negativeinletpos=Int63.bin_write_tbuf~postaginBin_prot.Common.blit_string_bufbits~dst_pos:posbuf~len:size_in_bytes;pos+size_in_bytes);;letbin_read_t:tBin_prot.Read.reader=funbuf~pos_ref->lettag=Core_kernel.Int63.bin_read_tbuf~pos_refinifInt63.equaltagInt63.zerothenZ.zeroelse(letnegative=Int63.(taglandone=one)inletsize_in_bytes=Int63.(to_int_exn(shift_righttag1))in(* Even though we could cache a buffer for small sizes, the extra logic leads to
a decrease in performance *)letbytes=Bytes.createsize_in_bytesinBin_prot.Common.blit_buf_bytes~src_pos:!pos_refbufbytes~len:size_in_bytes;letabs=Z.of_bits(Bytes.unsafe_to_string~no_mutation_while_string_reachable:bytes)inpos_ref:=!pos_ref+size_in_bytes;ifnegativethenZ.negabselseabs);;letmodule_name="Bigint.Stable.V2.t"letbin_writer_t:tBin_prot.Type_class.writer={size=bin_size_t;write=bin_write_t};;let__bin_read_t___buf~pos_ref_vint=Bin_prot.Common.raise_variant_wrong_typemodule_name!pos_ref;;letbin_reader_t:tBin_prot.Type_class.reader={read=bin_read_t;vtag_read=__bin_read_t__};;letbin_shape_t:Bin_prot.Shape.t=Bin_prot.Shape.basetype(Bin_prot.Shape.Uuid.of_string"7a8cceb2-f3a2-11e9-b7cb-aae95a547ff6")[];;letbin_t:tBin_prot.Type_class.t={shape=bin_shape_t;writer=bin_writer_t;reader=bin_reader_t};;endendmoduleUnstable=structincludeStable.V1includeStringable_tletof_zarith_bigintt=tletto_zarith_bigintt=tlet(/%)xy=ifZ.signy>=0thenZ.edivxyelsefailwithf"%s.(%s /%% %s) : divisor must be positive"module_name(to_stringx)(to_stringy)();;let(%)xy=ifZ.signy>=0thenZ.eremxyelsefailwithf"%s.(%s %% %s) : divisor must be positive"module_name(to_stringx)(to_stringy)();;lethash_fold_tstatet=Int.hash_fold_tstate(Z.hasht)lethash=Z.hashletcompare=Z.comparelet(-)=Z.(-)let(+)=Z.(+)let(*)=Z.(*)let(/)=Z.(/)letrem=Z.remlet(~-)=Z.(~-)letneg=Z.negletabs=Z.absletsucc=Z.succletpred=Z.predletequal=Z.equallet(=)=Z.equallet(<)=Z.ltlet(>)=Z.gtlet(<=)=Z.leqlet(>=)=Z.geqletmax=Z.maxletmin=Z.minletascending=compareletshift_right=Z.shift_rightletshift_left=Z.shift_leftletbit_not=Z.lognotletbit_xor=Z.logxorletbit_or=Z.logorletbit_and=Z.logandlet(land)=bit_andlet(lor)=bit_orlet(lxor)=bit_xorletlnot=bit_notlet(lsl)=shift_leftlet(asr)=shift_rightletof_int=Z.of_intletof_int32=Z.of_int32letof_int64=Z.of_int64letof_nativeint=Z.of_nativeintletof_float_unchecked=Z.of_floatletof_float=Z.of_floatletof_int_exn=of_intletof_int32_exn=of_int32letof_int64_exn=of_int64letof_nativeint_exn=of_nativeintletto_int_exn=Z.to_intletto_int32_exn=Z.to_int32letto_int64_exn=Z.to_int64letto_nativeint_exn=Z.to_nativeintletto_float=Z.to_floatletzero=Z.zeroletone=Z.oneletminus_one=Z.minus_oneletto_intt=ifZ.fits_inttthenSome(Z.to_intt)elseNoneletto_int32t=ifZ.fits_int32tthenSome(Z.to_int32t)elseNoneletto_int64t=ifZ.fits_int64tthenSome(Z.to_int64t)elseNoneletto_nativeintt=ifZ.fits_nativeinttthenSome(Z.to_nativeintt)elseNonelet(<>)xy=not(equalxy)letincrcell=cell:=succ!cellletdecrcell=cell:=pred!cellletpowxy=Z.powx(to_int_exny)let(**)xy=powxyletpopcountx=Z.popcountxendmoduleT_math=Int_math.Make(Unstable)moduleT_conversions=Int_conversions.Make(Unstable)moduleT_comparable_with_zero=Comparable.Validate_with_zero(Unstable)moduleT_identifiable=Identifiable.Make(structletmodule_name=module_nameincludeUnstableend)(* Including in opposite order to shadow functorized bindings with direct bindings. *)moduleO=structincludeT_identifiableincludeT_comparable_with_zeroincludeT_conversionsincludeT_mathincludeUnstableendinclude(O:moduletypeofOwithtypet:=t)moduleMake_random(State:sigtypetvalbits:t->intvalint:t->int->intend):sigvalrandom:state:State.t->t->tend=struct(* Uniform random generation of Bigint values.
[random ~state range] chooses a [depth] and generates random values using
[Random.State.bits state], called [1 lsl depth] times and concatenated. The
preliminary result [n] therefore satisfies [0 <= n < 1 lsl (30 lsl depth)].
In order for the random choice to be uniform between [0] and [range-1], there must
exist [k > 0] such that [n < k * range <= 1 lsl (30 lsl depth)]. If so, [n % range]
is returned. Otherwise the random choice process is repeated from scratch.
The [depth] value is chosen so that repeating is uncommon (1 in 1,000 or less). *)letbits_at_depth~depth=Int.shift_left30depthletrange_at_depth~depth=shift_leftone(bits_at_depth~depth)letrecchoose_bit_depth_for_range_from~range~depth=ifrange_at_depth~depth>=rangethendepthelsechoose_bit_depth_for_range_from~range~depth:(Int.succdepth);;letchoose_bit_depth_for_range~range=choose_bit_depth_for_range_from~range~depth:0letrecrandom_bigint_at_depth~state~depth=ifInt.equaldepth0thenof_int(State.bitsstate)else(letprev_depth=Int.preddepthinletprefix=random_bigint_at_depth~state~depth:prev_depthinletsuffix=random_bigint_at_depth~state~depth:prev_depthinbit_or(shift_leftprefix(bits_at_depth~depth:prev_depth))suffix);;letrandom_value_is_uniform_in_range~range~depthn=letk=range_at_depth~depth/rangeinn<k*range;;letreclarge_random_at_depth~state~range~depth=letresult=random_bigint_at_depth~state~depthinifrandom_value_is_uniform_in_range~range~depthresultthenresult%rangeelselarge_random_at_depth~state~range~depth;;letlarge_random~state~range=lettolerance_factor=of_int1_000inletdepth=choose_bit_depth_for_range~range:(range*tolerance_factor)inlarge_random_at_depth~state~range~depth;;letrandom~staterange=ifrange<=zerothenfailwithf"Bigint.random: argument %s <= 0"(to_string_humrange)()(* Note that it's not safe to do [1 lsl 30] on a 32-bit machine (with 31-bit signed
integers) *)elseifrange<shift_leftone30thenof_int(State.intstate(to_int_exnrange))elselarge_random~state~range;;endmoduleRandom_internal=Make_random(Random.State)letrandom?(state=Random.State.default)range=Random_internal.random~staterangemoduleFor_quickcheck:sigincludeQuickcheckable.S_intwithtypet:=tvalgen_negative:tQuickcheck.Generator.tvalgen_positive:tQuickcheck.Generator.tend=structmoduleGenerator=Quickcheck.GeneratoropenGenerator.Let_syntaxmoduleUniform=Make_random(structtypet=Splittable_random.State.tletinttrange=Splittable_random.intt~lo:0~hi:(Int.predrange)letbitst=intt(Int.shift_left130)end)letrandom_uniform~statelohi=lo+Uniform.random~state(succ(hi-lo))letgen_uniform_incllower_boundupper_bound=iflower_bound>upper_boundthenraise_s[%message"Bigint.gen_uniform_incl: bounds are crossed"(lower_bound:t)(upper_bound:t)];Generator.create(fun~size:_~random:state->random_uniform~statelower_boundupper_bound);;letgen_incllower_boundupper_bound=Generator.weighted_union[0.05,Generator.returnlower_bound;0.05,Generator.returnupper_bound;0.9,gen_uniform_incllower_boundupper_bound];;letmin_represented_by_n_bitsn=ifInt.equaln0thenzeroelseshift_leftone(Int.predn);;letmax_represented_by_n_bitsn=pred(shift_leftonen)letgen_log_uniform_incllower_boundupper_bound=iflower_bound<zero||lower_bound>upper_boundthenraise_s[%message"Bigint.gen_log_incl: invalid bounds"(lower_bound:t)(upper_bound:t)];letmin_bits=Z.numbitslower_boundinletmax_bits=Z.numbitsupper_boundinlet%bindbits=Int.gen_uniform_inclmin_bitsmax_bitsingen_uniform_incl(maxlower_bound(min_represented_by_n_bitsbits))(minupper_bound(max_represented_by_n_bitsbits));;letgen_log_incllower_boundupper_bound=Generator.weighted_union[0.05,Generator.returnlower_bound;0.05,Generator.returnupper_bound;0.9,gen_log_uniform_incllower_boundupper_bound];;letgen_positive=let%bindextra_bytes=Generator.sizeinletnum_bytes=Int.succextra_bytesinletnum_bits=Int.(*)num_bytes8ingen_log_uniform_inclone(pred(shift_leftonenum_bits));;letgen_negative=Generator.mapgen_positive~f:negletquickcheck_generator=Generator.weighted_union[0.45,gen_positive;0.1,Generator.returnzero;0.45,gen_negative];;letquickcheck_observer=Quickcheck.Observer.create(funt~size:_~hash->hash_fold_thasht);;letquickcheck_shrinker=Quickcheck.Shrinker.empty()endincludeFor_quickcheckmoduleHex=structtypenonrect=t[@@derivingbin_io,typerep]moduleM=Base.Int_conversions.Make_hex(structtypenonrect=t[@@derivinghash,compare]letto_stringi=Z.format"%x"iletchar_is_hex_digit=function|'0'..'9'|'a'..'f'|'A'..'F'->true|_->false;;letof_hex_string_no_underscoresstr=Z.of_string_base16strletof_stringstr=of_string_basestr~name:"Hex.of_string"~char_is_digit:char_is_hex_digit~of_string_no_underscores:of_hex_string_no_underscores;;let(<)=(<)letneg=negletzero=zeroletmodule_name=module_name^".Hex"end)include(M.Hex:moduletypeofstructincludeM.Hexendwithtypet:=t)end