Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file parser.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158openStduneleterror(loc:Loc.t)message=User_error.raise~loc[Pp.textmessage](* To avoid writing two parsers, one for the Cst and one for the Ast, we write
only one that work for both.
The natural thing to do would be to have parser that produce [Cst.t] value
and drop comment for the [Ast.t] one. However the most used parser is the one
producing Ast one, so it is the one we want to go fast. As a result, we
encode comment as special [Ast.t] values and decode them for the [Cst.t]
parser.
We could also do clever things with GADTs, but it will add type variables
everywhere which is annoying. *)letreccst_of_encoded_ast(x:Ast.t):Cst.t=matchxwith|Templatet->Templatet|Quoted_string(loc,s)->Quoted_string(loc,s)|List(loc,l)->List(loc,List.mapl~f:cst_of_encoded_ast)|Atom(loc,(Asasatom))->(matchs.[0]with|'\000'->Comment(loc,Lines(String.drops1|>String.split~on:'\n'))|'\001'->Comment(loc,Legacy)|_->Atom(loc,atom))moduleMode=structtype'at=|Single:Ast.tt|Many:Ast.tlistt|Many_as_one:Ast.tt|Cst:Cst.tlisttletwith_comments:typea.at->bool=function|Single->false|Many->false|Many_as_one->false|Cst->trueletmake_result:typea.at->Lexing.lexbuf->Ast.tlist->a=funtlexbufsexps->matchtwith|Single->(matchsexpswith|[sexp]->sexp|[]->error(Loc.of_lexbuflexbuf)"no s-expression found in input"|_::sexp::_->error(Ast.locsexp)"too many s-expressions found in input")|Many->sexps|Many_as_one->(matchsexpswith|[]->List(Loc.in_file(Path.of_stringlexbuf.lex_curr_p.pos_fname),[])|x::l->letlast=List.fold_leftl~init:x~f:(fun_x->x)inletloc={(Ast.locx)withstop=(Ast.loclast).stop}inList(loc,x::l))|Cst->List.mapsexps~f:cst_of_encoded_astendletrecloopwith_commentsdepthlexerlexbufacc=match(lexer~with_commentslexbuf:Lexer.Token.t)with|Atoma->letloc=Loc.of_lexbuflexbufinloopwith_commentsdepthlexerlexbuf(Ast.Atom(loc,a)::acc)|Quoted_strings->letloc=Loc.of_lexbuflexbufinloopwith_commentsdepthlexerlexbuf(Quoted_string(loc,s)::acc)|Templatet->letloc=Loc.of_lexbuflexbufinloopwith_commentsdepthlexerlexbuf(Template{twithloc}::acc)|Lparen->letstart=Lexing.lexeme_start_plexbufinletsexps=loopwith_comments(depth+1)lexerlexbuf[]inletstop=Lexing.lexeme_end_plexbufinloopwith_commentsdepthlexerlexbuf(List({start;stop},sexps)::acc)|Rparen->ifdepth=0thenerror(Loc.of_lexbuflexbuf)"right parenthesis without matching left parenthesis";List.revacc|Sexp_comment->letsexps=letloc=Loc.of_lexbuflexbufinmatchloopwith_commentsdepthlexerlexbuf[]with|commented::sexps->ifnotwith_commentsthensexpselseAtom(Ast.loccommented,Atom.of_string"\001")::sexps|[]->errorloc"s-expression missing after #;"inList.rev_appendaccsexps|Eof->ifdepth>0thenerror(Loc.of_lexbuflexbuf)"unclosed parenthesis at end of input";List.revacc|Commentcomment->ifnotwith_commentsthenloopfalsedepthlexerlexbufaccelseletloc=Loc.of_lexbuflexbufinletencoded=matchcommentwith|Lineslines->"\000"^String.concatlines~sep:"\n"|Legacy->"\001"inloopwith_commentsdepthlexerlexbuf(Atom(loc,Atom.of_stringencoded)::acc)letparse~mode?(lexer=Lexer.token)lexbuf=letwith_comments=Mode.with_commentsmodeinloopwith_comments0lexerlexbuf[]|>Mode.make_resultmodelexbufletparse_string~fname~mode?lexerstr=letlb=Lexbuf.from_string~fnamestrinparse~mode?lexerlbletload?lexerpath~mode=Io.with_lexbuf_from_filepath~f:(parse~mode?lexer)letinsert_commentscstscomments=(* To insert the comments, we tokenize the csts, reconciliate the token
streams and parse the result again. This is not the fastest implementation,
but at least it is simple. *)letcompare(a,_)(b,_)=Int.comparea.Loc.start.pos_cnumb.Loc.start.pos_cnuminletrecreconciliateacctokens1tokens2=match(tokens1,tokens2)with|[],l|l,[]->List.rev_appendaccl|tok1::rest1,tok2::rest2->(matchcomparetok1tok2with|Eq|Lt->reconciliate(tok1::acc)rest1tokens2|Gt->reconciliate(tok2::acc)tokens1rest2)inlettokens=reconciliate[](Cst.tokenizecsts)(List.sortcomments~compare|>List.map~f:(fun(loc,comment)->(loc,Lexer.Token.Commentcomment)))inlettokens=reftokensinletlexer~with_comments:_(lb:Lexing.lexbuf)=match!tokenswith|[]->lb.lex_curr_p<-lb.lex_start_p;Lexer.Token.Eof|({start;stop},tok)::rest->tokens:=rest;lb.lex_start_p<-start;lb.lex_curr_p<-stop;tokinparse(Lexing.from_string"")~lexer~mode:Cst