Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file path.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151(* Path: Module for Substitutions within S-expressions *)openFormatopenSexptypeel=Posofint|Matchofstring*int|Recofstringtypet=ellistletillegal_atomlocsexp=failwith(sprintf"Path.%s: illegal atom: %s"loc(Sexp.to_stringsexp))letextract_pos_lstlocsexpixlst=letrecloopaccn=function|[]->letsexp_str=Sexp.to_stringsexpinfailwith(sprintf"Path.%s: illegal index %d in: %s"locixsexp_str)|h::t->ifn=0thenletsubst=function|None->List.rev_appendacct|Somex->List.rev_appendacc(x::t)insubst,helseloop(h::acc)(n-1)tinloop[]ixlstletextract_posn=function|Listlstassexp->letsubst,el=extract_pos_lst"extract_pos"sexpnlstin(funx->List(substx)),el|Atom_assexp->illegal_atom"extract_pos"sexpletextract_matchtagarg_ix=function|List(Atomstrassexp::args)whenstr=tag->letsubst,el=extract_pos_lst"extract_match"(Listargs)arg_ixargsin(funmaybe_x->List(sexp::substmaybe_x)),el|List_assexp->letsexp_str=Sexp.to_stringsexpinfailwith("Path.extract_match: unexpected nested list in: "^sexp_str)|Atom_assexp->illegal_atom"extract_match"sexpletextract_reckey=function|Listlstassexp->letrecloopacc=function|[]->letsexp_str=Sexp.to_stringsexpinfailwith(sprintf"Path.extract_rec: key \"%s\" not found in: %s"keysexp_str)|List[Atomstrassexp;v]::restwhenstr=key->letsubstx=List(List.rev_appendacc(List[sexp;x]::rest))insubst,v|h::t->loop(h::acc)tinloop[]lst|Atom_assexp->illegal_atom"extract_rec"sexpletidx=xletrecsubst_option(sup_subst,el)rest=letsub_subst,sub_el=subst_pathelrestinletsubstx=sup_subst(Some(sub_substx))insubst,sub_elandsubst_pathsexp=function|Posn::t->subst_option(extract_posnsexp)t|Match(tag,arg_ix)::t->subst_option(extract_matchtagarg_ixsexp)t|Reckey::rest->letrec_subst,el=extract_reckeysexpinletsub_subst,sub_el=subst_pathelrestinletsubstx=rec_subst(sub_substx)insubst,sub_el|[]->id,sexpletimplodelst=letlen=List.lengthlstinletstr=Bytes.createleninletrecloopix=function|h::t->Bytes.setstrixh;loop(ix+1)t|[]->Bytes.unsafe_to_stringstrinloop0lstletfail_parsemsg=failwith("Path.parse: "^msg)letparsestr=letlen=String.lengthstriniflen=0thenfail_parse"path empty"elseletrecloopaccdot_ix=matchstr.[dot_ix]with|'.'->letdot_ix1=dot_ix+1inifdot_ix1=lenthenList.revaccelseletrecparse_dotaccstr_accix=ifix=lenthenList.rev_appendacc[Rec(implode(List.revstr_acc))]elsematchstr.[ix]with|'['->letrecparse_indexindex_accix=ifix=lenthenfail_parse"EOF reading index"elsematchstr.[ix],index_accwith|'0'..'9'asc,None->parse_index(Some(int_of_charc-48))(ix+1)|'0'..'9'asc,Someindex_acc->letnew_index_acc=Some(10*index_acc+int_of_charc-48)inparse_indexnew_index_acc(ix+1)|']',None->fail_parse"empty index"|']',Someindex_acc->letpath_el=ifstr_acc=[]thenPosindex_accelseMatch(implode(List.revstr_acc),index_acc)inletix1=ix+1inifix1=lenthenList.rev_appendacc[path_el]elseloop(path_el::acc)ix1|c,_->fail_parse(sprintf"illegal character in index: %c"c)inparse_indexNone(ix+1)|'\\'->letix1=ix+1inifix1=lenthenfail_parse"EOF after escape"elseparse_dotacc(str.[ix1]::str_acc)(ix+1)|'.'->ifstr_acc=[]thenfail_parse"double '.'";letpath_el=Rec(implode(List.revstr_acc))inparse_dot(path_el::acc)[](ix+1)|c->parse_dotacc(c::str_acc)(ix+1)inparse_dotacc[]dot_ix1|c->fail_parse(sprintf"'.' expected; got '%c'"c)inloop[]0letget_substpathstrsexp=letpath=matchpath,strwith|Somepath,_->path|None,Somestr->parsestr|None,None->[]insubst_pathsexppathletget?path?strsexp=snd(get_substpathstrsexp)letreplace?path?strsexp~subst=letsubst_fun,_=get_substpathstrsexpinsubst_funsubstletreplace_no_path~strsexp~subst=replace~strsexp~subst