123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179(**************************************************************************)(* *)(* OCaml *)(* *)(* KC Sivaramakrishnan, Indian Institute of Technology, Madras *)(* *)(* Copyright 2021 Indian Institute of Technology, Madras *)(* *)(* 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. *)(* *)(**************************************************************************)type'at=..externalperform:'at->'a="%perform"typeexn+=Unhandled:'at->exnexceptionContinuation_already_resumedlet()=letprinter=function|Unhandledx->letmsg=Printf.sprintf"Stdlib.Effect.Unhandled(%s)"(Printexc.string_of_extension_constructor@@Obj.reprx)inSomemsg|_->NoneinPrintexc.register_printerprinter(* Register the exceptions so that the runtime can access it *)type_t+=Should_not_see_this__:unittlet_=Callback.register_exception"Effect.Unhandled"(UnhandledShould_not_see_this__)let_=Callback.register_exception"Effect.Continuation_already_resumed"Continuation_already_resumedtype('a,'b)stack[@@immediate]typelast_fiber[@@immediate]externalresume:('a,'b)stack->('c->'a)->'c->last_fiber->'b="%resume"externalrunstack:('a,'b)stack->('c->'a)->'c->'b="%runstack"moduleDeep=structtype('a,'b)continuationexternaltake_cont_noexc:('a,'b)continuation->('a,'b)stack="caml_continuation_use_noexc"[@@noalloc]externalalloc_stack:('a->'b)->(exn->'b)->('ct->('c,'b)continuation->last_fiber->'b)->('a,'b)stack="caml_alloc_stack"externalcont_last_fiber:('a,'b)continuation->last_fiber="%field1"externalcont_set_last_fiber:('a,'b)continuation->last_fiber->unit="%setfield1"letcontinuekv=resume(take_cont_noexck)(funx->x)v(cont_last_fiberk)letdiscontinueke=resume(take_cont_noexck)(fune->raisee)e(cont_last_fiberk)letdiscontinue_with_backtracekebt=resume(take_cont_noexck)(fune->Printexc.raise_with_backtraceebt)e(cont_last_fiberk)type('a,'b)handler={retc:'a->'b;exnc:exn->'b;effc:'c.'ct->(('c,'b)continuation->'b)option}externalreperform:'at->('a,'b)continuation->last_fiber->'b="%reperform"letmatch_withcomparghandler=leteffceffklast_fiber=matchhandler.effceffwith|Somef->cont_set_last_fiberklast_fiber;fk|None->reperformeffklast_fiberinlets=alloc_stackhandler.retchandler.exnceffcinrunstackscompargtype'aeffect_handler={effc:'b.'bt->(('b,'a)continuation->'a)option}lettry_withcomparghandler=leteffc'effklast_fiber=matchhandler.effceffwith|Somef->cont_set_last_fiberklast_fiber;fk|None->reperformeffklast_fiberinlets=alloc_stack(funx->x)(fune->raisee)effc'inrunstackscompargexternalget_callstack:('a,'b)continuation->int->Printexc.raw_backtrace="caml_get_continuation_callstack"endmoduleShallow=structtype('a,'b)continuationexternalalloc_stack:('a->'b)->(exn->'b)->('ct->('c,'b)continuation->last_fiber->'b)->('a,'b)stack="caml_alloc_stack"externalcont_last_fiber:('a,'b)continuation->last_fiber="%field1"externalcont_set_last_fiber:('a,'b)continuation->last_fiber->unit="%setfield1"letfiber:typeab.(a->b)->(a,b)continuation=funf->letmoduleM=structtype_t+=Initial_setup__:atendinletexceptionEof(a,b)continuationinletf'()=f(performM.Initial_setup__)inleterror_=failwith"impossible"inleteffceffklast_fiber=matcheffwith|M.Initial_setup__->cont_set_last_fiberklast_fiber;raise_notrace(Ek)|_->error()inlets=alloc_stackerrorerroreffcinmatchrunstacksf'()with|exceptionEk->k|_->error()type('a,'b)handler={retc:'a->'b;exnc:exn->'b;effc:'c.'ct->(('c,'a)continuation->'b)option}externalupdate_handler:('a,'b)continuation->('b->'c)->(exn->'c)->('dt->('d,'b)continuation->last_fiber->'c)->('a,'c)stack="caml_continuation_use_and_update_handler_noexc"[@@noalloc]externalreperform:'at->('a,'b)continuation->last_fiber->'c="%reperform"letcontinue_genkresume_funvhandler=leteffceffklast_fiber=matchhandler.effceffwith|Somef->cont_set_last_fiberklast_fiber;fk|None->reperformeffklast_fiberinletlast_fiber=cont_last_fiberkinletstack=update_handlerkhandler.retchandler.exnceffcinresumestackresume_funvlast_fiberletcontinue_withkvhandler=continue_genk(funx->x)vhandlerletdiscontinue_withkvhandler=continue_genk(fune->raisee)vhandlerletdiscontinue_with_backtracekvbthandler=continue_genk(fune->Printexc.raise_with_backtraceebt)vhandlerexternalget_callstack:('a,'b)continuation->int->Printexc.raw_backtrace="caml_get_continuation_callstack"end