Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file value.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949open!Core_kernelopen!Importopen!Async_kernelopenValue_intfincludeValue0moduletypeFuncall=Funcallwithtypevalue:=tmoduletypeMake_subtype_arg=Make_subtype_argwithtypevalue:=tmoduleEmacs_value=structtypenonrect=tendtypevalue=t[@@derivingsexp_of](* [Funcall_exit.t] values are only constructed by [ecaml_non_local_exit_get_and_clear]
in [ecaml_stubs.c]. *)moduleFuncall_exit=structtypet=|Return|SignalofEmacs_value.t*Emacs_value.t|ThrowofEmacs_value.t*Emacs_value.t[@@derivingvariants]letinitialize_module=assert(Variants.return.rank=0);assert(Variants.signal.rank=1);assert(Variants.throw.rank=2);;endletinitialize_module=Funcall_exit.initialize_moduleexternalhave_active_env:unit->bool="ecaml_have_active_env"externalnon_local_exit_get_and_clear:unit->Funcall_exit.t="ecaml_non_local_exit_get_and_clear"exceptionElisp_signalof{symbol:t;data:t}exceptionElisp_throwof{tag:t;value:t}letraise_if_emacs_signaled()=matchnon_local_exit_get_and_clear()with|Return->()|Signal(symbol,data)->raise(Elisp_signal{symbol;data})|Throw(tag,value)->raise(Elisp_throw{tag;value});;letwrap_raise1fa=letr=fainraise_if_emacs_signaled();r;;letwrap_raise2fa1a2=letr=fa1a2inraise_if_emacs_signaled();r;;letwrap_raise3fa1a2a3=letr=fa1a2a3inraise_if_emacs_signaled();r;;externalintern:string->t="ecaml_intern"letintern=wrap_raise1internletinterned_symbols=String.Hash_set.create()letall_interned_symbols()=List.sort(Hash_set.to_listinterned_symbols)~compare:[%compare:string];;letinternstring=ifam_running_testthenHash_set.addinterned_symbolsstring;internstring;;moduleQ=structletappend="append"|>internandarrayp="arrayp"|>internandbacktrace="backtrace"|>internandbufferp="bufferp"|>internandcar="car"|>internandcadr="cadr"|>internandcdr="cdr"|>internandcommandp="commandp"|>internandcons="cons"|>internandconsp="consp"|>internanddebug_on_error="debug-on-error"|>internandequal="equal"|>internandequal_including_properties="equal-including-properties"|>internanderror="error"|>internandeventp="eventp"|>internandfloatp="floatp"|>internandfontp="fontp"|>internandframep="framep"|>internandfunctionp="functionp"|>internandhash_table_p="hash-table-p"|>internandkeymapp="keymapp"|>internandlength="length"|>internandlist="list"|>internandmarkerp="markerp"|>internandmessage="message"|>internandnil="nil"|>internandprin1_to_string="prin1-to-string"|>internandprint_length="print-length"|>internandprint_level="print-level"|>internandprocessp="processp"|>internandset="set"|>internandstringp="stringp"|>internandsubstring_no_properties="substring-no-properties"|>internandsymbol_value="symbol-value"|>internandsymbolp="symbolp"|>internandsyntax_table_p="syntax-table-p"|>internandt="t"|>internandtimerp="timerp"|>internandvector="vector"|>internandvectorp="vectorp"|>internandwindow_configuration_p="window-configuration-p"|>internandwindowp="windowp"|>internendmoduleBlock_on_async=structtypet={f:'a.Source_code_position.t->?context:Sexp.tLazy.t->(unit->'aDeferred.t)->'a}letset_once:tSet_once.t=Set_once.create()endmoduleEnqueue_foreground_block_on_async=structtypet={f:Source_code_position.t->?context:Sexp.tLazy.t->?raise_exceptions_to_monitor:Monitor.t->(unit->unitDeferred.t)->unit}letset_once:tSet_once.t=Set_once.create()endmoduleRun_outside_async=structtypet={f:'a.Source_code_position.t->?allowed_in_background:bool->(unit->'a)->'aDeferred.t}letset_once:tSet_once.t=Set_once.create()endletmaybe_profile~should_profilecontextf=ifOption.valueshould_profile~default:truethenprofileSynccontextfelsef();;externalfuncall_array:t->tarray->bool->t="ecaml_funcall_array"letfuncall_array?should_profiletts~should_return_result=maybe_profile~should_profile(lazy[%sexp(t::(ts|>Array.to_list):tlist)])(fun()->funcall_arrayttsshould_return_result);;letfuncallN_array?should_profiletts=letr=funcall_array?should_profiletts~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncallN_array_i?should_profiletts=ignore(funcall_array?should_profiletts~should_return_result:false:t);raise_if_emacs_signaled();;letfuncallN?should_profiletts=funcallN_array?should_profilet(ts|>Array.of_list)letfuncallN_i?should_profiletts=funcallN_array_i?should_profilet(ts|>Array.of_list);;externalfuncall0:t->bool->t="ecaml_funcall0"externalfuncall1:t->t->bool->t="ecaml_funcall1"externalfuncall2:t->t->t->bool->t="ecaml_funcall2"externalfuncall3:t->t->t->t->bool->t="ecaml_funcall3"externalfuncall4:t->t->t->t->t->bool->t="ecaml_funcall4_byte""ecaml_funcall4"externalfuncall5:t->t->t->t->t->t->bool->t="ecaml_funcall5_byte""ecaml_funcall5"letexternal_funcall1=funcall1letfuncall0f~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f]:tlist)])(fun()->funcall0fshould_return_result);;letfuncall1fa1~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f;a1]:tlist)])(fun()->funcall1fa1should_return_result);;letfuncall2fa1a2~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f;a1;a2]:tlist)])(fun()->funcall2fa1a2should_return_result);;letfuncall3fa1a2a3~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f;a1;a2;a3]:tlist)])(fun()->funcall3fa1a2a3should_return_result);;letfuncall4fa1a2a3a4~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f;a1;a2;a3;a4]:tlist)])(fun()->funcall4fa1a2a3a4should_return_result);;letfuncall5fa1a2a3a4a5~should_profile~should_return_result=maybe_profile~should_profile(lazy[%sexp([f;a1;a2;a3;a4;a5]:tlist)])(fun()->funcall5fa1a2a3a4a5should_return_result);;letfuncall0_i?should_profilef=ignore(funcall0f~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall0?should_profilef=letr=funcall0f~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncall1_i?should_profilefa=ignore(funcall1fa~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall1?should_profilefa=letr=funcall1fa~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncall2_i?should_profilefa1a2=ignore(funcall2fa1a2~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall2?should_profilefa1a2=letr=funcall2fa1a2~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncall3_i?should_profilefa1a2a3=ignore(funcall3fa1a2a3~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall3?should_profilefa1a2a3=letr=funcall3fa1a2a3~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncall4_i?should_profilefa1a2a3a4=ignore(funcall4fa1a2a3a4~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall4?should_profilefa1a2a3a4=letr=funcall4fa1a2a3a4~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;letfuncall5_i?should_profilefa1a2a3a4a5=ignore(funcall5fa1a2a3a4a5~should_profile~should_return_result:false:t);raise_if_emacs_signaled();;letfuncall5?should_profilefa1a2a3a4a5=letr=funcall5fa1a2a3a4a5~should_profile~should_return_result:trueinraise_if_emacs_signaled();r;;externalfuncall_int_int_value_unit:t->int->int->t->unit="ecaml_funcall_int_int_value_unit"letfuncall_int_int_value_unit?should_profilefa1a2a3=maybe_profile~should_profile(lazy[%sexp(f:t),(a1:int),(a2:int),(a3:t)])(fun()->funcall_int_int_value_unitfa1a2a3);raise_if_emacs_signaled();;externalfuncall_int_int_value_value_unit:t->int->int->t->t->unit="ecaml_funcall_int_int_value_value_unit"letfuncall_int_int_value_value_unit?should_profilefa1a2a3a4=maybe_profile~should_profile(lazy[%sexp(f:t),(a1:int),(a2:int),(a3:t),(a4:t)])(fun()->funcall_int_int_value_value_unitfa1a2a3a4);raise_if_emacs_signaled();;externaltype_of:t->t="ecaml_type_of"lettype_of=wrap_raise1type_ofexternalis_not_nil:t->bool="ecaml_is_not_nil"letis_not_nil=wrap_raise1is_not_nilexternaleq:t->t->bool="ecaml_eq"leteq=wrap_raise2eqlet[@inlinealways]is_integer(t:t)=Obj.is_int(Obj.reprt)let[@inlinealways]to_int_exn(t:t)=ifnot(is_integert)thenraise_s[%sexp"wrong-type-argument",("integerp",(t:t))]else(Obj.magict:int);;letget_varsymbol=funcall1Q.symbol_valuesymbolletset_varsymbolvalue=funcall2_iQ.setsymbolvalueletget_int_varstring=get_var(string|>intern)|>to_int_exnletdebug_on_error()=is_not_nil(funcall1Q.symbol_valueQ.debug_on_error)letemacs_min_int=get_int_var"most-negative-fixnum"letemacs_max_int=get_int_var"most-positive-fixnum"letof_int_exn:int->t=letcheck_bounds=Int.validate_bound~min:(Inclemacs_min_int)~max:(Inclemacs_max_int)infunn->Validate.maybe_raise(Validate.name"overflow-error"(check_boundsn));(Obj.magicn:t);;externalof_float:float->t="ecaml_of_float"letof_float=wrap_raise1of_floatexternalto_float_exn:t->float="ecaml_to_float"letto_float_exn=wrap_raise1to_float_exnexternalof_utf8_bytes:string->t="ecaml_of_string"letof_utf8_bytes=wrap_raise1of_utf8_bytesletof_utf8_bytes_cache=Hashtbl.create(moduleString)letof_utf8_bytes_cachedstring=Hashtbl.find_or_addof_utf8_bytes_cachestring~default:(fun()->of_utf8_bytesstring);;externalto_utf8_bytes_exn:t->string="ecaml_to_string"letto_utf8_bytes_exn=wrap_raise1to_utf8_bytes_exnexternalvec_get:t->int->t="ecaml_vec_get"letvec_get=wrap_raise2vec_getexternalvec_set:t->int->t->unit="ecaml_vec_set"letvec_set=wrap_raise3vec_setexternalvec_size:t->int="ecaml_vec_size"letvec_size=wrap_raise1vec_sizeletpercent_s=of_utf8_bytes"%s"letmessages=funcall2_iQ.messagepercent_s(of_utf8_bytess)letmessage_zero_alloct=ignore(external_funcall1Q.messagetfalse:t);raise_if_emacs_signaled();;letmessage_tt=funcall2_iQ.messagepercent_stletmessageffmt=ksprintfmessagefmtletmessage_s:Sexp.t->unit=function|Atomstring->messagestring|sexp->messagef"%s"(sexp|>Sexp.to_string_hum);;letnil=Q.nillett=Q.tletto_bool=is_not_nilletof_boolb=ifbthentelsenilletlistts=funcallNQ.listtsletis_nilt=eqtnilletis_arrayt=funcall1Q.arraypt|>to_boolletis_buffert=funcall1Q.bufferpt|>to_boolletis_commandt=funcall1Q.commandpt|>to_boolletis_eventt=funcall1Q.eventpt|>to_boolletis_floatt=funcall1Q.floatpt|>to_boolletis_fontt=funcall1Q.fontpt|>to_boolletis_framet=funcall1Q.framept|>to_boolletis_functiont=funcall1Q.functionpt|>to_boolletis_hash_tablet=funcall1Q.hash_table_pt|>to_boolletis_keymapt=funcall1Q.keymappt|>to_boolletis_markert=funcall1Q.markerpt|>to_boolletis_processt=funcall1Q.processpt|>to_boolletis_stringt=funcall1Q.stringpt|>to_boolletis_symbolt=funcall1Q.symbolpt|>to_boolletis_syntax_tablet=funcall1Q.syntax_table_pt|>to_boolletis_timert=funcall1Q.timerpt|>to_boolletis_vectort=funcall1Q.vectorpt|>to_boolletis_windowt=funcall1Q.windowpt|>to_boolletis_window_configurationt=funcall1Q.window_configuration_pt|>to_boolletequalt1t2=funcall2Q.equalt1t2|>to_boolletconst1t2=funcall2Q.const1t2letcar_exnt=funcall1Q.cartletcdr_exnt=funcall1Q.cdrtletcadr_exnt=funcall1Q.cadrtletis_cons?car?cdrt=funcall1Q.conspt|>to_bool&&(matchcarwith|None->true|Someis_car->is_car(car_exnt))&&matchcdrwith|None->true|Someis_cdr->is_cdr(cdr_exnt);;letto_list_exn(t:t)~f=letreclooptac=ifis_niltthenList.revacelseifis_constthenloop(cdr_exnt)(f(car_exnt)::ac)elseraise_s[%message"[Value.to_list] got strange value"~_:(t:t)]inloopt[];;letlist_to_array_exnt~f=letlength=funcall1Q.lengtht|>to_int_exniniflength=0thenArray.of_list[]else(letelt0=f(car_exnt)inletarray=Array.create~len:lengthelt0inletrecfill_array_loopti=ifis_niltthen()else(array.(i)<-f(car_exnt);fill_array_loop(cdr_exnt)(i+1))infill_array_loop(cdr_exnt)1;array);;letto_array_exn(t:t)~f=letlength=vec_sizetinArray.initlength~f:(funi->f(vec_getti));;letvectorarr=funcallN_arrayQ.vectorarrletnon_local_exit_signalexn=letmoduleM=struct(** [non_local_exit_signal] sets a [pending_error] flag in the Emacs environment that
causes it to, after our C code returns to it, signal instead of returning a
value. *)externalnon_local_exit_signal:t->t->unit="ecaml_non_local_exit_signal"(** [non_local_exit_throw] works like [non_local_exit_signal], except that it throws
instead of signaling when our code returns to emacs. *)externalnon_local_exit_throw:t->t->unit="ecaml_non_local_exit_throw"endinletdebug_on_error=debug_on_error()inmatchexnwith|Elisp_throw{tag;value}->M.non_local_exit_throwtagvalue|Elisp_signal{symbol;data}->(* This case preserves an Elisp signal as it crosses an OCaml boundary. *)letdata=matchdebug_on_errorwith|false->data|true->funcall2Q.appenddata(list[list[Q.backtrace;Backtrace.Exn.most_recent()|>Backtrace.to_string|>of_utf8_bytes]])inM.non_local_exit_signalsymboldata|_->letbacktrace=ifdebug_on_errorthenSome(Backtrace.Exn.most_recent())elseNoneinletmessage=[%message.omit_nil""~_:(exn:exn)(backtrace:Backtrace.toption)]inletmessage=matchmessagewith|Atomstring->string|List_assexp->Sexp.to_string_humsexpin(* For the [error] symbol, the error data should be a list whose car is a string.
See [(Info-goto-node "(elisp)Signaling Errors")]. *)M.non_local_exit_signalQ.error(list[message|>of_utf8_bytes]);;letprin1_to_stringt=funcall1Q.prin1_to_stringt|>to_utf8_bytes_exnlettext_has_propertiest=is_nil(funcall2Q.equal_including_propertiest(funcall1Q.substring_no_propertiest));;letmight_be_a_sexpstring=letstring=string|>String.stripinletn=String.lengthstringinn>=2&&Char.equalstring.[0]'('&&Char.equalstring.[n-1]')';;letwith_print_config~print_length~print_level~f=letold_print_length=get_varQ.print_lengthinletold_print_level=get_varQ.print_levelinset_varQ.print_length(print_length|>of_int_exn);set_varQ.print_level(print_level|>of_int_exn);protect~f~finally:(fun()->set_varQ.print_lengthold_print_length;set_varQ.print_levelold_print_level);;letrecsexp_of_t_internalt~print_length~print_level:Sexp.t=ifprint_length<=0||print_level<=0then[%message"..."]elseifis_stringt&¬(text_has_propertiest)then(letstring=t|>to_utf8_bytes_exninifnot(might_be_a_sexpstring)thenAtomstringelse(matchstring|>Sexp.of_stringwith|x->x|exception_->Atomstring))elseifis_constthen(letcar=sexp_of_t_internal(car_exnt)~print_length~print_level:(print_level-1)inletcdr=sexp_of_t_internal(cdr_exnt)~print_length:(print_length-1)~print_levelinmatchcdrwith|Atom"nil"->List[car]|Atom_->List[car;Atom".";cdr]|Listsexps->List(car::sexps))else(letsexp_string=with_print_config~print_length~print_level~f:(fun()->prin1_to_stringt)inletsexp_string=(* Emacs prefixes some values (like buffers, markers, etc) with [#], which then
makes the sexp unparseable. So in this case we strip the [#]. *)ifString.is_prefixsexp_string~prefix:"#("thenString.chop_prefix_exnsexp_string~prefix:"#"elsesexp_stringinmatchSexp.of_stringsexp_stringwith|sexp->sexp|exception_->Atomsexp_string);;letecaml_profile_print_length=refNoneletecaml_profile_print_level=refNoneletsexp_of_tt=letprint_length,print_level=ifProfile.am_forcing_message()then!ecaml_profile_print_length,!ecaml_profile_print_levelelse(letint_or_nilsymbol=letvalue=get_varsymbolinifis_nilvaluethenNoneelseSome(value|>to_int_exn)inint_or_nilQ.print_length,int_or_nilQ.print_level)inletprint_length=Option.valueprint_length~default:emacs_max_intinletprint_level=Option.valueprint_level~default:emacs_max_intinsexp_of_t_internalt~print_length~print_level;;letinitialize_module=initialize_module;Sexplib.Conv.Exn_converter.add[%extension_constructorElisp_signal](function|Elisp_signal{symbol;data}->ifeqsymbolQ.errorthen[%sexp(data:t)]elseifis_nildatathen[%sexp(symbol:t)]else[%message""~_:(symbol:t)~_:(data:t)]|_->(* Reaching this branch indicates a bug in sexplib. *)assertfalse);sexp_of_t_ref:=sexp_of_t;;moduleType=structtypeasync[@@derivingsexp_of]typesync[@@derivingsexp_of]type('a,'m)t_={id:'aType_equal.Id.t;of_value_exn:value->'a;to_value:'a->value}[@@derivingfields,sexp_of]type'at=('a,sync)t_[@@derivingsexp_of]moduletypeS=Typewithtypevalue:=valuewithtype'at:='atletnamet=Sexp.of_string(Type_equal.Id.namet.id)letto_sexpt=Type_equal.Id.to_sexpt.idletsexp_of_t_t=nametletcreatenamesexp_of_tof_value_exnto_value={id=Type_equal.Id.create~name:(Sexp.to_stringname)sexp_of_t;of_value_exn=(funvalue->tryof_value_exnvaluewith|exn->raise_s[%message"unable to convert Elisp value to OCaml value"~type_:(name:Sexp.t)(value:value)(exn:exn)]);to_value};;letwith_of_value_exntof_value_exn={twithof_value_exn}moduletypeEnum=Enumletenum(typea)name(moduleM:Enumwithtypet=a)to_value=letvalid_values=List.mapM.all~f:(funm->to_valuem,m)inletof_value_exnvalue=matchList.Assoc.findvalid_valuesvalue~equalwith|None->raise_s[%message(valid_values:(value*M.t)list)]|Somem->mincreatename[%sexp_of:M.t]of_value_exnto_value;;letbool=create[%message"bool"][%sexp_of:bool]to_boolof_boolletfloat=create[%message"float"][%sexp_of:float]to_float_exnof_floatletignored=create[%message"ignored"][%sexp_of:unit]ignore(constnil)letint=create[%message"int"][%sexp_of:int]to_int_exnof_int_exnletstring=create[%message"string"][%sexp_of:string]to_utf8_bytes_exnof_utf8_bytes;;letstring_cached=create[%message"string"][%sexp_of:string]to_utf8_bytes_exnof_utf8_bytes_cached;;letunit=create[%message"unit"][%sexp_of:unit](funvalue->assert(is_nilvalue))(constnil);;letvalue=create[%message"value"][%sexp_of:value]Fn.idFn.idletalistt1t2=create[%message"alist"~_:(namet1:Sexp.t)~_:(namet2:Sexp.t)](sexp_of_list(Tuple2.sexp_of_t(to_sexpt1)(to_sexpt2)))(to_list_exn~f:(funcons_cell->of_value_exnt1(car_exncons_cell),of_value_exnt2(cdr_exncons_cell)))(funl->list(List.mapl~f:(fun(a,b)->cons(to_valuet1a)(to_valuet2b))));;letlistt=create[%message"list"~_:(namet:Sexp.t)](sexp_of_list(to_sexpt))(to_list_exn~f:(of_value_exnt))(funl->list(List.mapl~f:(to_valuet)));;letarray_as_listt=create[%message"array-as-list"~_:(namet:Sexp.t)](sexp_of_array(to_sexpt))(list_to_array_exn~f:(of_value_exnt))(Array.fold_right~init:nil~f:(funeltelisp_list->cons(to_valuetelt)elisp_list));;letvectort=create[%message"vector"~_:(namet:Sexp.t)](sexp_of_array(to_sexpt))(to_array_exn~f:(of_value_exnt))(funa->vector(Array.mapa~f:(to_valuet)));;lettuplet1t2=create[%sexp(namet1:Sexp.t),(namet2:Sexp.t)](Tuple2.sexp_of_t(to_sexpt1)(to_sexpt2))(funv->of_value_exnt1(car_exnv),of_value_exnt2(cdr_exnv))(fun(a1,a2)->cons(to_valuet1a1)(to_valuet2a2));;lettuple2_as_listt1t2=create[%sexp(namet1:Sexp.t),(namet2:Sexp.t)](Tuple2.sexp_of_t(to_sexpt1)(to_sexpt2))(funv->of_value_exnt1(car_exnv),of_value_exnt2(cadr_exnv))(fun(a1,a2)->cons(to_valuet1a1)(cons(to_valuet2a2)nil));;letmapt~name~of_~to_=createname(Fn.compose(to_sexpt)to_)(Fn.composeof_(of_value_exnt))(Fn.compose(to_valuet)to_);;letmap_idtname=mapt~name~of_:Fn.id~to_:Fn.idletnil_ort=create[%message"nil_or"~_:(namet:Sexp.t)](function|None->Atom"nil"|Somev->to_sexptv)(funv->ifis_nilvthenNoneelseSome(v|>of_value_exnt))(function|None->nil|Somev->(to_valuet)v);;letoptiont=create[%message"option"~_:(namet:Sexp.t)](sexp_of_option(to_sexpt))(funv->ifis_nilvthenNoneelseSome(car_exnv|>of_value_exnt))(function|None->nil|Somev->cons(to_valuetv)nil);;(* embed ocaml values as strings which are sexp representations *)letsexpable(typea)(moduleA:Sexpablewithtypet=a)~name=create[%message"sexpable"~_:(name:Sexp.t)][%sexp_of:A.t](funv->A.t_of_sexp(Sexp.of_string(of_value_exnstringv)))(funa->A.sexp_of_ta|>Sexp.to_string_mach|>to_valuestring);;letpath_list=map(nil_orstring)~name:[%message"path-list-element"]~of_:(Option.value~default:".")~to_:Option.return|>list;;endmoduletypeSubtype=Subtypewithtypevalue:=twithtype'atype_:='aType.tmoduleMake_subtype(M:Make_subtype_arg)=structopenMtypenonrect=t[@@derivingsexp_of]letis_in_subtype=is_in_subtypeletto_valuet=tletof_value_exnt=ifnot(is_in_subtypet)thenraise_s[%message(concat["[";name;"]'s [of_value_exn] got value not in subtype"])~_:(t:t)];t;;lettype_=Type.create[%messagename][%sexp_of:t]of_value_exnto_valuelett=type_leteq(t1:t)t2=eqt1t2endmoduleStat=structtypet={emacs_free_performed:int;emacs_free_scheduled:int}[@@derivingsexp_of]externalnum_emacs_free_performed:unit->int="ecaml_num_emacs_free_performed"externalnum_emacs_free_scheduled:unit->int="ecaml_num_emacs_free_scheduled"letnow()={emacs_free_performed=num_emacs_free_performed();emacs_free_scheduled=num_emacs_free_scheduled()};;letdifft2t1={emacs_free_performed=t2.emacs_free_performed-t1.emacs_free_performed;emacs_free_scheduled=t2.emacs_free_scheduled-t1.emacs_free_scheduled};;endmoduleExpert=structlethave_active_env=have_active_envletnon_local_exit_signal=non_local_exit_signalletraise_if_emacs_signaled=raise_if_emacs_signaledendmoduleFor_testing=structletall_interned_symbols=all_interned_symbolsexceptionElisp_signal=Elisp_signalexceptionElisp_throw=Elisp_throwletmap_elisp_signalg~f=matchg()with|a->a|exceptionElisp_signal{symbol;data}->Nothing.unreachable_code(f~symbol~data~reraise:(fun~symbol~data->raise(Elisp_signal{symbol;data})));;letmap_elisp_signal_omit_dataf=map_elisp_signalf~f:(fun~symbol~data:_~reraise->reraise~symbol~data:nil);;endmodulePrivate=structmoduleBlock_on_async=Block_on_asyncmoduleEnqueue_foreground_block_on_async=Enqueue_foreground_block_on_asyncmoduleRun_outside_async=Run_outside_asyncletblock_on_asynchere?contextf=(Set_once.get_exnBlock_on_async.set_oncehere).fhere?contextf;;letenqueue_foreground_block_on_asynchere?context?raise_exceptions_to_monitorf=(Set_once.get_exnEnqueue_foreground_block_on_async.set_oncehere).fhere?context?raise_exceptions_to_monitorf;;letrun_outside_asynchere?allowed_in_backgroundf=(Set_once.get_exnRun_outside_async.set_oncehere).fhere?allowed_in_backgroundf;;letecaml_profile_print_length=ecaml_profile_print_lengthletecaml_profile_print_level=ecaml_profile_print_levelletmessage_zero_alloc=message_zero_allocletmessage_t=message_tend