123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212(**************************************************************************)(* *)(* OCaml *)(* *)(* Xavier Leroy, 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. *)(* *)(**************************************************************************)(* The parsing engine *)openLexing(* Internal interface to the parsing engine *)typeparser_env={mutables_stack:intarray;(* States *)mutablev_stack:Obj.tarray;(* Semantic attributes *)mutablesymb_start_stack:positionarray;(* Start positions *)mutablesymb_end_stack:positionarray;(* End positions *)mutablestacksize:int;(* Size of the stacks *)mutablestackbase:int;(* Base sp for current parse *)mutablecurr_char:int;(* Last token read *)mutablelval:Obj.t;(* Its semantic attribute *)mutablesymb_start:position;(* Start pos. of the current symbol*)mutablesymb_end:position;(* End pos. of the current symbol *)mutableasp:int;(* The stack pointer for attributes *)mutablerule_len:int;(* Number of rhs items in the rule *)mutablerule_number:int;(* Rule number to reduce by *)mutablesp:int;(* Saved sp for parse_engine *)mutablestate:int;(* Saved state for parse_engine *)mutableerrflag:int}(* Saved error flag for parse_engine *)[@@warning"-unused-field"]typeparse_tables={actions:(parser_env->Obj.t)array;transl_const:intarray;transl_block:intarray;lhs:string;len:string;defred:string;dgoto:string;sindex:string;rindex:string;gindex:string;tablesize:int;table:string;check:string;error_function:string->unit;names_const:string;names_block:string}exceptionYYexitofObj.texceptionParse_errortypeparser_input=Start|Token_read|Stacks_grown_1|Stacks_grown_2|Semantic_action_computed|Error_detectedtypeparser_output=Read_token|Raise_parse_error|Grow_stacks_1|Grow_stacks_2|Compute_semantic_action|Call_error_function(* to avoid warnings *)let_=[Read_token;Raise_parse_error;Grow_stacks_1;Grow_stacks_2;Compute_semantic_action;Call_error_function]externalparse_engine:parse_tables->parser_env->parser_input->Obj.t->parser_output="caml_parse_engine"externalset_trace:bool->bool="caml_set_parser_trace"letenv={s_stack=Array.make1000;v_stack=Array.make100(Obj.repr());symb_start_stack=Array.make100dummy_pos;symb_end_stack=Array.make100dummy_pos;stacksize=100;stackbase=0;curr_char=0;lval=Obj.repr();symb_start=dummy_pos;symb_end=dummy_pos;asp=0;rule_len=0;rule_number=0;sp=0;state=0;errflag=0}letgrow_stacks()=letoldsize=env.stacksizeinletnewsize=oldsize*2inletnew_s=Array.makenewsize0andnew_v=Array.makenewsize(Obj.repr())andnew_start=Array.makenewsizedummy_posandnew_end=Array.makenewsizedummy_posinArray.blitenv.s_stack0new_s0oldsize;env.s_stack<-new_s;Array.blitenv.v_stack0new_v0oldsize;env.v_stack<-new_v;Array.blitenv.symb_start_stack0new_start0oldsize;env.symb_start_stack<-new_start;Array.blitenv.symb_end_stack0new_end0oldsize;env.symb_end_stack<-new_end;env.stacksize<-newsizeletclear_parser()=Array.fillenv.v_stack0env.stacksize(Obj.repr());env.lval<-Obj.repr()letcurrent_lookahead_fun=ref(fun(_:Obj.t)->false)letyyparsetablesstartlexerlexbuf=letrecloopcmdarg=matchparse_enginetablesenvcmdargwithRead_token->lett=Obj.repr(lexerlexbuf)inenv.symb_start<-lexbuf.lex_start_p;env.symb_end<-lexbuf.lex_curr_p;loopToken_readt|Raise_parse_error->raiseParse_error|Compute_semantic_action->let(action,value)=try(Semantic_action_computed,tables.actions.(env.rule_number)env)withParse_error->(Error_detected,Obj.repr())inloopactionvalue|Grow_stacks_1->grow_stacks();loopStacks_grown_1(Obj.repr())|Grow_stacks_2->grow_stacks();loopStacks_grown_2(Obj.repr())|Call_error_function->tables.error_function"syntax error";loopError_detected(Obj.repr())inletinit_asp=env.aspandinit_sp=env.spandinit_stackbase=env.stackbaseandinit_state=env.stateandinit_curr_char=env.curr_charandinit_lval=env.lvalandinit_errflag=env.errflaginenv.stackbase<-env.sp+1;env.curr_char<-start;env.symb_end<-lexbuf.lex_curr_p;tryloopStart(Obj.repr())withexn->letcurr_char=env.curr_charinenv.asp<-init_asp;env.sp<-init_sp;env.stackbase<-init_stackbase;env.state<-init_state;env.curr_char<-init_curr_char;env.lval<-init_lval;env.errflag<-init_errflag;matchexnwithYYexitv->Obj.magicv|_->current_lookahead_fun:=(funtok->ifObj.is_blocktokthentables.transl_block.(Obj.tagtok)=curr_charelsetables.transl_const.(Obj.magictok)=curr_char);raiseexnletpeek_valenvn=Obj.magicenv.v_stack.(env.asp-n)letsymbol_start_pos()=letrecloopi=ifi<=0thenenv.symb_end_stack.(env.asp)elsebeginletst=env.symb_start_stack.(env.asp-i+1)inleten=env.symb_end_stack.(env.asp-i+1)inifst<>enthenstelseloop(i-1)endinloopenv.rule_lenletsymbol_end_pos()=env.symb_end_stack.(env.asp)letrhs_start_posn=env.symb_start_stack.(env.asp-(env.rule_len-n))letrhs_end_posn=env.symb_end_stack.(env.asp-(env.rule_len-n))letsymbol_start()=(symbol_start_pos()).pos_cnumletsymbol_end()=(symbol_end_pos()).pos_cnumletrhs_startn=(rhs_start_posn).pos_cnumletrhs_endn=(rhs_end_posn).pos_cnumletis_current_lookaheadtok=(!current_lookahead_fun)(Obj.reprtok)letparse_error(_:string)=()