Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source
Source file syntax.ml
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297open!StdunemoduleVersion=structmoduleT=structtypet=int*intletcompare(major_a,minor_a)(major_b,minor_b)=matchInt.comparemajor_amajor_bwith|(Gt|Lt)asne->ne|Eq->Int.compareminor_aminor_bletto_dynt=letopenDyn.EncoderinpairintinttendincludeTmoduleInfix=Comparator.Operators(T)letequal=Infix.equalletto_string(a,b)=sprintf"%u.%u"ablethash=Hashtbl.hashletencodet=Encoder.string(to_stringt)letdecode:tDecoder.t=letopenDecoderinraw>>|function|Atom(loc,As)->(matchScanf.sscanfs"%u.%u"(funab->(a,b))with|Oks->s|Error()->User_error.raise~loc[Pp.text"Atom of the form NNN.NNN expected"])|sexp->User_error.raise~loc:(Ast.locsexp)[Pp.text"Atom expected"]letcan_read~parser_version:(parser_major,parser_minor)~data_version:(data_major,data_minor)=letopenInt.Infixinparser_major=data_major&&parser_minor>=data_minorendmoduleSupported_versions=struct(* The extension supported versions are declared using an explicit list of all
versions but stored as a map from major versions to maps from minor version
to dune_lang required versions. For instance, if:
- version 1.0 of an extension was introduced in Dune 1.4
- version 1.1 was introduced in Dune 1.6
- version 1.2 was introduced in Dune 2.3
- version 2.0 was introduced in Dune 2.4
we'd have the following map (in associative list syntax):
{[ [ 1, [ 0, (1, 4); 1, (1, 6); 2, (2, 3) ]; 2, [ 0, (2, 3) ] ] ]} *)typet=Version.tInt.Map.tInt.Map.tletto_dynt=Int.Map.to_dyn(Int.Map.to_dynVersion.to_dyn)t(* We convert the exposed extension version type: {[ (Version.t * [ `Since of
Version.t ]) list ]} which is a list of fully qualified versions paired
with the corresponding dune_lang version. To the internal representation:
{[ (Version.t Int.Map.t) Int.Map.t ]} which is a list of major versions
paired with lists of minor versions paires with a dune_lang version. *)letmake(versions:(Version.t*[`SinceofVersion.t])list):t=letv=List.fold_leftversions~init:(Int.Map.empty:t)~f:(funmajor_map((major,minor),`Sincelang_ver)->letadd_minorminor_map=Some(Int.Map.add_exnminor_mapminorlang_ver)inInt.Map.updatemajor_mapmajor~f:(function|Someminor_map->add_minorminor_map|None->add_minorInt.Map.empty))invletremove_uncompatible_versionslang_ver=Int.Map.filter_map~f:(funminors->letminors=Int.Map.filterminors~f:(funmin_lang->lang_ver>=min_lang)inOption.some_if(not(Int.Map.is_emptyminors))minors)letrecgreatest_supported_version?dune_lang_vert=letopenOption.Oinmatchdune_lang_verwith|Somelang_ver->letcompat=remove_uncompatible_versionslang_vertingreatest_supported_versioncompat|None->let*major,minors=Int.Map.max_bindingtinlet*minor,_=Int.Map.max_bindingminorsinSome(major,minor)letget_min_lang_vert(major,minor)=letopenOption.Oinlet*minors=Int.Map.findtmajorinInt.Map.findminorsminorletis_supportedt(major,minor)lang_ver=matchInt.Map.findtmajorwith|Somet->(matchInt.Map.findtminorwith|Somemin_lang_ver->lang_ver>=min_lang_ver|None->false)|None->falseletsupported_rangeslang_ver(t:t)=letcompat=remove_uncompatible_versionslang_vertinInt.Map.to_listcompat|>List.map~f:(fun(major,minors)->letmax_minor,_=Option.value_exn(Int.Map.max_bindingminors)inletlower_bound=(* Map 0.0 to 0.1 since 0.0 is not a valid version number *)ifmajor=0then(0,1)else(major,0)inletupper_bound=(major,max_minor)inassert(lower_bound<=upper_bound);(lower_bound,upper_bound))endtypet={name:string;desc:string;key:Version.tUniv_map.Key.t;supported_versions:Supported_versions.t}moduleError_msg=structletsincetver~what=Printf.sprintf"%s is only available since version %s of %s. Please update your \
dune-project file to have (lang %s)."what(Version.to_stringver)t.desc(Version.to_stringver)endmoduleError=structletsinceloctver~what=User_error.raise~loc[Pp.text(Error_msg.sincetver~what)]letrenamed_inloctver~what~to_=User_error.raise~loc[Pp.textf"%s was renamed to '%s' in the %s version of %s"whatto_(Version.to_stringver)t.desc]letdeleted_in?(extra_info="")loct?(repl=[])ver~what=User_error.raise~loc(Pp.concat[Pp.textf"%s was deleted in version %s of %s."what(Version.to_stringver)t.desc;(ifextra_info=""thenPp.nopelsePp.space);Pp.textextra_info]::repl)endmoduleWarning=structletdeprecated_in?(extra_info="")loct?(repl=[])ver~what=User_warning.emit~loc(Pp.concat[Pp.textf"%s was deprecated in version %s of %s."what(Version.to_stringver)t.desc;(ifextra_info=""thenPp.nopelsePp.space);Pp.textextra_info]::repl)endletcreate~name~descsupported_versions={name;desc;key=Univ_map.Key.create~nameVersion.to_dyn;supported_versions=Supported_versions.makesupported_versions}letnamet=t.nameletcheck_supported~dune_lang_vert(loc,ver)=ifnot(Supported_versions.is_supportedt.supported_versionsverdune_lang_ver)thenletdune_ver_textv=Printf.sprintf"version %s of the dune language"(Version.to_stringv)inletuntil=matchSupported_versions.get_min_lang_vert.supported_versionsverwith|Somev->Printf.sprintf" until %s"(dune_ver_textv)|None->""inletl=Supported_versions.supported_rangesdune_lang_vert.supported_versionsinletsupported=(ifList.is_emptylthenPp.textf"There are no supported versions of this extension in %s."elsePp.textf"Supported versions of this extension in %s:")(dune_ver_textdune_lang_ver)inletmessage=[Pp.textf"Version %s of %s is not supported%s."(Version.to_stringver)t.descuntil;supported;Pp.enumeratel~f:(fun(a,b)->letopenVersion.Infixinifa=bthenPp.text(Version.to_stringa)elsePp.textf"%s to %s"(Version.to_stringa)(Version.to_stringb))]inletis_error=String.is_emptyuntil||dune_lang_ver>=(2,5)inUser_warning.emit~is_error~locmessageletgreatest_supported_version?dune_lang_vert=Supported_versions.greatest_supported_version?dune_lang_vert.supported_versionsletkeyt=t.keyopenDecoderletsettverparser=sett.keyverparserletget_exnt=gett.key>>=function|Somex->returnx|None->let+context=get_allinCode_error.raise"Syntax identifier is unset"[("name",Dyn.Encoder.stringt.name);("supported_versions",Supported_versions.to_dynt.supported_versions);("context",Univ_map.to_dyncontext)]letdesc()=let+kind=kindinmatchkindwith|Values(loc,None)->(loc,"This syntax")|Fields(loc,None)->(loc,"This field")|Values(loc,Somes)->(loc,sprintf"'%s'"s)|Fields(loc,Somes)->(loc,sprintf"Field '%s'"s)letdeleted_in?(extra_info="")tver=letopenVersion.Infixinlet*current_ver=get_exntinifcurrent_ver<verthenreturn()elselet*loc,what=desc()inError.deleted_in~extra_infoloctver~whatletdeprecated_in?(extra_info="")tver=letopenVersion.Infixinlet*current_ver=get_exntinifcurrent_ver<verthenreturn()elselet+loc,what=desc()inWarning.deprecated_in~extra_infoloctver~whatletrenamed_intver~to_=letopenVersion.Infixinlet*current_ver=get_exntinifcurrent_ver<verthenreturn()elselet+loc,what=desc()inError.renamed_inloctver~what~to_letsince?(fatal=true)tver=letopenVersion.Infixinlet*current_ver=get_exntinifcurrent_ver>=verthenreturn()elsedesc()>>=function|loc,whatwhenfatal->Error.sinceloctver~what|loc,what->User_warning.emit~loc[Pp.text(Error_msg.sincetver~what)];return()