1 Star 0 Fork 0

怕万一错了/sparrow

加入 Gitee
与超过 1200万 开发者一起发现、参与优秀开源项目,私有仓库也完全免费 :)
免费加入
克隆/下载
setup.ml 207.52 KB
一键复制 编辑 原始数据 按行查看 历史
Kihong Heo 提交于 2018-05-25 05:41 . [Build] bump ocaml version to 4.06.1
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458745974607461746274637464746574667467746874697470747174727473747474757476747774787479748074817482748374847485748674877488748974907491749274937494749574967497749874997500750175027503750475057506750775087509751075117512751375147515751675177518751975207521752275237524752575267527752875297530753175327533753475357536753775387539754075417542754375447545754675477548754975507551755275537554755575567557755875597560756175627563756475657566756775687569757075717572757375747575757675777578757975807581758275837584758575867587758875897590759175927593759475957596759775987599760076017602760376047605760676077608760976107611761276137614
(* setup.ml generated for the first time by OASIS v0.4.8 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: 0f40c274f4205253a0db59bbb42393d5) *)
(*
Regenerated by OASIS v0.4.11
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
(* # 22 "src/oasis/OASISGettext.ml" *)
let ns_ str = str
let s_ str = str
let f_ (str: ('a, 'b, 'c, 'd) format4) = str
let fn_ fmt1 fmt2 n =
if n = 1 then
fmt1^^""
else
fmt2^^""
let init = []
end
module OASISString = struct
(* # 22 "src/oasis/OASISString.ml" *)
(** Various string utilities.
Mostly inspired by extlib and batteries ExtString and BatString libraries.
@author Sylvain Le Gall
*)
let nsplitf str f =
if str = "" then
[]
else
let buf = Buffer.create 13 in
let lst = ref [] in
let push () =
lst := Buffer.contents buf :: !lst;
Buffer.clear buf
in
let str_len = String.length str in
for i = 0 to str_len - 1 do
if f str.[i] then
push ()
else
Buffer.add_char buf str.[i]
done;
push ();
List.rev !lst
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
separator.
*)
let nsplit str c =
nsplitf str ((=) c)
let find ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
while !str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
what_idx := 0;
incr str_idx
done;
if !what_idx <> String.length what then
raise Not_found
else
!str_idx - !what_idx
let sub_start str len =
let str_len = String.length str in
if len >= str_len then
""
else
String.sub str len (str_len - len)
let sub_end ?(offset=0) str len =
let str_len = String.length str in
if len >= str_len then
""
else
String.sub str 0 (str_len - len)
let starts_with ~what ?(offset=0) str =
let what_idx = ref 0 in
let str_idx = ref offset in
let ok = ref true in
while !ok &&
!str_idx < String.length str &&
!what_idx < String.length what do
if str.[!str_idx] = what.[!what_idx] then
incr what_idx
else
ok := false;
incr str_idx
done;
!what_idx = String.length what
let strip_starts_with ~what str =
if starts_with ~what str then
sub_start str (String.length what)
else
raise Not_found
let ends_with ~what ?(offset=0) str =
let what_idx = ref ((String.length what) - 1) in
let str_idx = ref ((String.length str) - 1) in
let ok = ref true in
while !ok &&
offset <= !str_idx &&
0 <= !what_idx do
if str.[!str_idx] = what.[!what_idx] then
decr what_idx
else
ok := false;
decr str_idx
done;
!what_idx = -1
let strip_ends_with ~what str =
if ends_with ~what str then
sub_end str (String.length what)
else
raise Not_found
let replace_chars f s =
let buf = Buffer.create (String.length s) in
String.iter (fun c -> Buffer.add_char buf (f c)) s;
Buffer.contents buf
let lowercase_ascii =
replace_chars
(fun c ->
if (c >= 'A' && c <= 'Z') then
Char.chr (Char.code c + 32)
else
c)
let uncapitalize_ascii s =
if s <> "" then
(lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
else
s
let uppercase_ascii =
replace_chars
(fun c ->
if (c >= 'a' && c <= 'z') then
Char.chr (Char.code c - 32)
else
c)
let capitalize_ascii s =
if s <> "" then
(uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
else
s
end
module OASISUtils = struct
(* # 22 "src/oasis/OASISUtils.ml" *)
open OASISGettext
module MapExt =
struct
module type S =
sig
include Map.S
val add_list: 'a t -> (key * 'a) list -> 'a t
val of_list: (key * 'a) list -> 'a t
val to_list: 'a t -> (key * 'a) list
end
module Make (Ord: Map.OrderedType) =
struct
include Map.Make(Ord)
let rec add_list t =
function
| (k, v) :: tl -> add_list (add k v t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
end
end
module MapString = MapExt.Make(String)
module SetExt =
struct
module type S =
sig
include Set.S
val add_list: t -> elt list -> t
val of_list: elt list -> t
val to_list: t -> elt list
end
module Make (Ord: Set.OrderedType) =
struct
include Set.Make(Ord)
let rec add_list t =
function
| e :: tl -> add_list (add e t) tl
| [] -> t
let of_list lst = add_list empty lst
let to_list = elements
end
end
module SetString = SetExt.Make(String)
let compare_csl s1 s2 =
String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
module HashStringCsl =
Hashtbl.Make
(struct
type t = string
let equal s1 s2 = (compare_csl s1 s2) = 0
let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
end)
module SetStringCsl =
SetExt.Make
(struct
type t = string
let compare = compare_csl
end)
let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
invalid_arg "varname_of_string"
end
else
begin
let buf =
OASISString.replace_chars
(fun c ->
if ('a' <= c && c <= 'z')
||
('A' <= c && c <= 'Z')
||
('0' <= c && c <= '9') then
c
else
hyphen)
s;
in
let buf =
(* Start with a _ if digit *)
if '0' <= s.[0] && s.[0] <= '9' then
"_"^buf
else
buf
in
OASISString.lowercase_ascii buf
end
let varname_concat ?(hyphen='_') p s =
let what = String.make 1 hyphen in
let p =
try
OASISString.strip_ends_with ~what p
with Not_found ->
p
in
let s =
try
OASISString.strip_starts_with ~what s
with Not_found ->
s
in
p^what^s
let is_varname str =
str = varname_of_string str
let failwithf fmt = Printf.ksprintf failwith fmt
let rec file_location ?pos1 ?pos2 ?lexbuf () =
match pos1, pos2, lexbuf with
| Some p, None, _ | None, Some p, _ ->
file_location ~pos1:p ~pos2:p ?lexbuf ()
| Some p1, Some p2, _ ->
let open Lexing in
let fn, lineno = p1.pos_fname, p1.pos_lnum in
let c1 = p1.pos_cnum - p1.pos_bol in
let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
| _, _, Some lexbuf ->
file_location
~pos1:(Lexing.lexeme_start_p lexbuf)
~pos2:(Lexing.lexeme_end_p lexbuf)
()
| None, None, None ->
s_ "<position undefined>"
let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
let loc = file_location ?pos1 ?pos2 ?lexbuf () in
Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
end
module OASISUnixPath = struct
(* # 22 "src/oasis/OASISUnixPath.ml" *)
type unix_filename = string
type unix_dirname = string
type host_filename = string
type host_dirname = string
let current_dir_name = "."
let parent_dir_name = ".."
let is_current_dir fn =
fn = current_dir_name || fn = ""
let concat f1 f2 =
if is_current_dir f1 then
f2
else
let f1' =
try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
in
f1'^"/"^f2
let make =
function
| hd :: tl ->
List.fold_left
(fun f p -> concat f p)
hd
tl
| [] ->
invalid_arg "OASISUnixPath.make"
let dirname f =
try
String.sub f 0 (String.rindex f '/')
with Not_found ->
current_dir_name
let basename f =
try
let pos_start =
(String.rindex f '/') + 1
in
String.sub f pos_start ((String.length f) - pos_start)
with Not_found ->
f
let chop_extension f =
try
let last_dot =
String.rindex f '.'
in
let sub =
String.sub f 0 last_dot
in
try
let last_slash =
String.rindex f '/'
in
if last_slash < last_dot then
sub
else
f
with Not_found ->
sub
with Not_found ->
f
let capitalize_file f =
let dir = dirname f in
let base = basename f in
concat dir (OASISString.capitalize_ascii base)
let uncapitalize_file f =
let dir = dirname f in
let base = basename f in
concat dir (OASISString.uncapitalize_ascii base)
end
module OASISHostPath = struct
(* # 22 "src/oasis/OASISHostPath.ml" *)
open Filename
open OASISGettext
module Unix = OASISUnixPath
let make =
function
| [] ->
invalid_arg "OASISHostPath.make"
| hd :: tl ->
List.fold_left Filename.concat hd tl
let of_unix ufn =
match Sys.os_type with
| "Unix" | "Cygwin" -> ufn
| "Win32" ->
make
(List.map
(fun p ->
if p = Unix.current_dir_name then
current_dir_name
else if p = Unix.parent_dir_name then
parent_dir_name
else
p)
(OASISString.nsplit ufn '/'))
| os_type ->
OASISUtils.failwithf
(f_ "Don't know the path format of os_type %S when translating unix \
filename. %S")
os_type ufn
end
module OASISFileSystem = struct
(* # 22 "src/oasis/OASISFileSystem.ml" *)
(** File System functions
@author Sylvain Le Gall
*)
type 'a filename = string
class type closer =
object
method close: unit
end
class type reader =
object
inherit closer
method input: Buffer.t -> int -> unit
end
class type writer =
object
inherit closer
method output: Buffer.t -> unit
end
class type ['a] fs =
object
method string_of_filename: 'a filename -> string
method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer
method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader
method file_exists: 'a filename -> bool
method remove: 'a filename -> unit
end
module Mode =
struct
let default_in = [Open_rdonly]
let default_out = [Open_wronly; Open_creat; Open_trunc]
let text_in = Open_text :: default_in
let text_out = Open_text :: default_out
let binary_in = Open_binary :: default_in
let binary_out = Open_binary :: default_out
end
let std_length = 4096 (* Standard buffer/read length. *)
let binary_out = Mode.binary_out
let binary_in = Mode.binary_in
let of_unix_filename ufn = (ufn: 'a filename)
let to_unix_filename fn = (fn: string)
let defer_close o f =
try
let r = f o in o#close; r
with e ->
o#close; raise e
let stream_of_reader rdr =
let buf = Buffer.create std_length in
let pos = ref 0 in
let eof = ref false in
let rec next idx =
let bpos = idx - !pos in
if !eof then begin
None
end else if bpos < Buffer.length buf then begin
Some (Buffer.nth buf bpos)
end else begin
pos := !pos + Buffer.length buf;
Buffer.clear buf;
begin
try
rdr#input buf std_length;
with End_of_file ->
if Buffer.length buf = 0 then
eof := true
end;
next idx
end
in
Stream.from next
let read_all buf rdr =
try
while true do
rdr#input buf std_length
done
with End_of_file ->
()
class ['a] host_fs rootdir : ['a] fs =
object (self)
method private host_filename fn = Filename.concat rootdir fn
method string_of_filename = self#host_filename
method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn =
let chn = open_out_gen mode perm (self#host_filename fn) in
object
method close = close_out chn
method output buf = Buffer.output_buffer chn buf
end
method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =
(* TODO: use Buffer.add_channel when minimal version of OCaml will
* be >= 4.03.0 (previous version was discarding last chars).
*)
let chn = open_in_gen mode perm (self#host_filename fn) in
let strm = Stream.of_channel chn in
object
method close = close_in chn
method input buf len =
let read = ref 0 in
try
for _i = 0 to len do
Buffer.add_char buf (Stream.next strm);
incr read
done
with Stream.Failure ->
if !read = 0 then
raise End_of_file
end
method file_exists fn = Sys.file_exists (self#host_filename fn)
method remove fn = Sys.remove (self#host_filename fn)
end
end
module OASISContext = struct
(* # 22 "src/oasis/OASISContext.ml" *)
open OASISGettext
type level =
[ `Debug
| `Info
| `Warning
| `Error]
type source
type source_filename = source OASISFileSystem.filename
let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn
type t =
{
(* TODO: replace this by a proplist. *)
quiet: bool;
info: bool;
debug: bool;
ignore_plugins: bool;
ignore_unknown_fields: bool;
printf: level -> string -> unit;
srcfs: source OASISFileSystem.fs;
load_oasis_plugin: string -> bool;
}
let printf lvl str =
let beg =
match lvl with
| `Error -> s_ "E: "
| `Warning -> s_ "W: "
| `Info -> s_ "I: "
| `Debug -> s_ "D: "
in
prerr_endline (beg^str)
let default =
ref
{
quiet = false;
info = false;
debug = false;
ignore_plugins = false;
ignore_unknown_fields = false;
printf = printf;
srcfs = new OASISFileSystem.host_fs(Sys.getcwd ());
load_oasis_plugin = (fun _ -> false);
}
let quiet =
{!default with quiet = true}
let fspecs () =
(* TODO: don't act on default. *)
let ignore_plugins = ref false in
["-quiet",
Arg.Unit (fun () -> default := {!default with quiet = true}),
s_ " Run quietly";
"-info",
Arg.Unit (fun () -> default := {!default with info = true}),
s_ " Display information message";
"-debug",
Arg.Unit (fun () -> default := {!default with debug = true}),
s_ " Output debug message";
"-ignore-plugins",
Arg.Set ignore_plugins,
s_ " Ignore plugin's field.";
"-C",
Arg.String
(fun str ->
Sys.chdir str;
default := {!default with srcfs = new OASISFileSystem.host_fs str}),
s_ "dir Change directory before running (affects setup.{data,log})."],
fun () -> {!default with ignore_plugins = !ignore_plugins}
end
module PropList = struct
(* # 22 "src/oasis/PropList.ml" *)
open OASISGettext
type name = string
exception Not_set of name * string option
exception No_printer of name
exception Unknown_field of name * name
let () =
Printexc.register_printer
(function
| Not_set (nm, Some rsn) ->
Some
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
| Not_set (nm, None) ->
Some
(Printf.sprintf (f_ "Field '%s' is not set") nm)
| No_printer nm ->
Some
(Printf.sprintf (f_ "No default printer for value %s") nm)
| Unknown_field (nm, schm) ->
Some
(Printf.sprintf
(f_ "Field %s is not defined in schema %s") nm schm)
| _ ->
None)
module Data =
struct
type t =
(name, unit -> unit) Hashtbl.t
let create () =
Hashtbl.create 13
let clear t =
Hashtbl.clear t
(* # 77 "src/oasis/PropList.ml" *)
end
module Schema =
struct
type ('ctxt, 'extra) value =
{
get: Data.t -> string;
set: Data.t -> ?context:'ctxt -> string -> unit;
help: (unit -> string) option;
extra: 'extra;
}
type ('ctxt, 'extra) t =
{
name: name;
fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
order: name Queue.t;
name_norm: string -> string;
}
let create ?(case_insensitive=false) nm =
{
name = nm;
fields = Hashtbl.create 13;
order = Queue.create ();
name_norm =
(if case_insensitive then
OASISString.lowercase_ascii
else
fun s -> s);
}
let add t nm set get extra help =
let key =
t.name_norm nm
in
if Hashtbl.mem t.fields key then
failwith
(Printf.sprintf
(f_ "Field '%s' is already defined in schema '%s'")
nm t.name);
Hashtbl.add
t.fields
key
{
set = set;
get = get;
help = help;
extra = extra;
};
Queue.add nm t.order
let mem t nm =
Hashtbl.mem t.fields nm
let find t nm =
try
Hashtbl.find t.fields (t.name_norm nm)
with Not_found ->
raise (Unknown_field (nm, t.name))
let get t data nm =
(find t nm).get data
let set t data nm ?context x =
(find t nm).set
data
?context
x
let fold f acc t =
Queue.fold
(fun acc k ->
let v =
find t k
in
f acc k v.extra v.help)
acc
t.order
let iter f t =
fold
(fun () -> f)
()
t
let name t =
t.name
end
module Field =
struct
type ('ctxt, 'value, 'extra) t =
{
set: Data.t -> ?context:'ctxt -> 'value -> unit;
get: Data.t -> 'value;
sets: Data.t -> ?context:'ctxt -> string -> unit;
gets: Data.t -> string;
help: (unit -> string) option;
extra: 'extra;
}
let new_id =
let last_id =
ref 0
in
fun () -> incr last_id; !last_id
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
(* Default value container *)
let v =
ref None
in
(* If name is not given, create unique one *)
let nm =
match name with
| Some s -> s
| None -> Printf.sprintf "_anon_%d" (new_id ())
in
(* Last chance to get a value: the default *)
let default () =
match default with
| Some d -> d
| None -> raise (Not_set (nm, Some (s_ "no default value")))
in
(* Get data *)
let get data =
(* Get value *)
try
(Hashtbl.find data nm) ();
match !v with
| Some x -> x
| None -> default ()
with Not_found ->
default ()
in
(* Set data *)
let set data ?context x =
let x =
match update with
| Some f ->
begin
try
f ?context (get data) x
with Not_set _ ->
x
end
| None ->
x
in
Hashtbl.replace
data
nm
(fun () -> v := Some x)
in
(* Parse string value, if possible *)
let parse =
match parse with
| Some f ->
f
| None ->
fun ?context s ->
failwith
(Printf.sprintf
(f_ "Cannot parse field '%s' when setting value %S")
nm
s)
in
(* Set data, from string *)
let sets data ?context s =
set ?context data (parse ?context s)
in
(* Output value as string, if possible *)
let print =
match print with
| Some f ->
f
| None ->
fun _ -> raise (No_printer nm)
in
(* Get data, as a string *)
let gets data =
print (get data)
in
begin
match schema with
| Some t ->
Schema.add t nm sets gets extra help
| None ->
()
end;
{
set = set;
get = get;
sets = sets;
gets = gets;
help = help;
extra = extra;
}
let fset data t ?context x =
t.set data ?context x
let fget data t =
t.get data
let fsets data t ?context s =
t.sets data ?context s
let fgets data t =
t.gets data
end
module FieldRO =
struct
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
let fld =
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
in
fun data -> Field.fget data fld
end
end
module OASISMessage = struct
(* # 22 "src/oasis/OASISMessage.ml" *)
open OASISGettext
open OASISContext
let generic_message ~ctxt lvl fmt =
let cond =
if ctxt.quiet then
false
else
match lvl with
| `Debug -> ctxt.debug
| `Info -> ctxt.info
| _ -> true
in
Printf.ksprintf
(fun str ->
if cond then
begin
ctxt.printf lvl str
end)
fmt
let debug ~ctxt fmt =
generic_message ~ctxt `Debug fmt
let info ~ctxt fmt =
generic_message ~ctxt `Info fmt
let warning ~ctxt fmt =
generic_message ~ctxt `Warning fmt
let error ~ctxt fmt =
generic_message ~ctxt `Error fmt
end
module OASISVersion = struct
(* # 22 "src/oasis/OASISVersion.ml" *)
open OASISGettext
type t = string
type comparator =
| VGreater of t
| VGreaterEqual of t
| VEqual of t
| VLesser of t
| VLesserEqual of t
| VOr of comparator * comparator
| VAnd of comparator * comparator
(* Range of allowed characters *)
let is_digit c = '0' <= c && c <= '9'
let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false
let rec version_compare v1 v2 =
if v1 <> "" || v2 <> "" then
begin
(* Compare ascii string, using special meaning for version
* related char
*)
let val_ascii c =
if c = '~' then -1
else if is_digit c then 0
else if c = '\000' then 0
else if is_alpha c then Char.code c
else (Char.code c) + 256
in
let len1 = String.length v1 in
let len2 = String.length v2 in
let p = ref 0 in
(** Compare ascii part *)
let compare_vascii () =
let cmp = ref 0 in
while !cmp = 0 &&
!p < len1 && !p < len2 &&
not (is_digit v1.[!p] && is_digit v2.[!p]) do
cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
incr p
done;
if !cmp = 0 && !p < len1 && !p = len2 then
val_ascii v1.[!p]
else if !cmp = 0 && !p = len1 && !p < len2 then
- (val_ascii v2.[!p])
else
!cmp
in
(** Compare digit part *)
let compare_digit () =
let extract_int v p =
let start_p = !p in
while !p < String.length v && is_digit v.[!p] do
incr p
done;
let substr =
String.sub v !p ((String.length v) - !p)
in
let res =
match String.sub v start_p (!p - start_p) with
| "" -> 0
| s -> int_of_string s
in
res, substr
in
let i1, tl1 = extract_int v1 (ref !p) in
let i2, tl2 = extract_int v2 (ref !p) in
i1 - i2, tl1, tl2
in
match compare_vascii () with
| 0 ->
begin
match compare_digit () with
| 0, tl1, tl2 ->
if tl1 <> "" && is_digit tl1.[0] then
1
else if tl2 <> "" && is_digit tl2.[0] then
-1
else
version_compare tl1 tl2
| n, _, _ ->
n
end
| n ->
n
end
else begin
0
end
let version_of_string str = str
let string_of_version t = t
let chop t =
try
let pos =
String.rindex t '.'
in
String.sub t 0 pos
with Not_found ->
t
let rec comparator_apply v op =
match op with
| VGreater cv ->
(version_compare v cv) > 0
| VGreaterEqual cv ->
(version_compare v cv) >= 0
| VLesser cv ->
(version_compare v cv) < 0
| VLesserEqual cv ->
(version_compare v cv) <= 0
| VEqual cv ->
(version_compare v cv) = 0
| VOr (op1, op2) ->
(comparator_apply v op1) || (comparator_apply v op2)
| VAnd (op1, op2) ->
(comparator_apply v op1) && (comparator_apply v op2)
let rec string_of_comparator =
function
| VGreater v -> "> "^(string_of_version v)
| VEqual v -> "= "^(string_of_version v)
| VLesser v -> "< "^(string_of_version v)
| VGreaterEqual v -> ">= "^(string_of_version v)
| VLesserEqual v -> "<= "^(string_of_version v)
| VOr (c1, c2) ->
(string_of_comparator c1)^" || "^(string_of_comparator c2)
| VAnd (c1, c2) ->
(string_of_comparator c1)^" && "^(string_of_comparator c2)
let rec varname_of_comparator =
let concat p v =
OASISUtils.varname_concat
p
(OASISUtils.varname_of_string
(string_of_version v))
in
function
| VGreater v -> concat "gt" v
| VLesser v -> concat "lt" v
| VEqual v -> concat "eq" v
| VGreaterEqual v -> concat "ge" v
| VLesserEqual v -> concat "le" v
| VOr (c1, c2) ->
(varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
| VAnd (c1, c2) ->
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
end
module OASISLicense = struct
(* # 22 "src/oasis/OASISLicense.ml" *)
(** License for _oasis fields
@author Sylvain Le Gall
*)
type license = string
type license_exception = string
type license_version =
| Version of OASISVersion.t
| VersionOrLater of OASISVersion.t
| NoVersion
type license_dep_5_unit =
{
license: license;
excption: license_exception option;
version: license_version;
}
type license_dep_5 =
| DEP5Unit of license_dep_5_unit
| DEP5Or of license_dep_5 list
| DEP5And of license_dep_5 list
type t =
| DEP5License of license_dep_5
| OtherLicense of string (* URL *)
end
module OASISExpr = struct
(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
open OASISUtils
type test = string
type flag = string
type t =
| EBool of bool
| ENot of t
| EAnd of t * t
| EOr of t * t
| EFlag of flag
| ETest of test * string
type 'a choices = (t * 'a) list
let eval var_get t =
let rec eval' =
function
| EBool b ->
b
| ENot e ->
not (eval' e)
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
| EOr (e1, e2) ->
(eval' e1) || (eval' e2)
| EFlag nm ->
let v =
var_get nm
in
assert(v = "true" || v = "false");
(v = "true")
| ETest (nm, vl) ->
let v =
var_get nm
in
(v = vl)
in
eval' t
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
| (cond, vl) :: tl ->
if eval var_get cond then
vl
else
choose_aux tl
| [] ->
let str_lst =
if lst = [] then
s_ "<empty>"
else
String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
match printer with
| Some p -> p vl
| None -> s_ "<no printer>")
lst)
in
match name with
| Some nm ->
failwith
(Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
failwith
(Printf.sprintf
(f_ "No result for a choice list: %s")
str_lst)
in
choose_aux (List.rev lst)
end
module OASISText = struct
(* # 22 "src/oasis/OASISText.ml" *)
type elt =
| Para of string
| Verbatim of string
| BlankLine
type t = elt list
end
module OASISSourcePatterns = struct
(* # 22 "src/oasis/OASISSourcePatterns.ml" *)
open OASISUtils
open OASISGettext
module Templater =
struct
(* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)
type t =
{
atoms: atom list;
origin: string
}
and atom =
| Text of string
| Expr of expr
and expr =
| Ident of string
| String of string
| Call of string * expr
type env =
{
variables: string MapString.t;
functions: (string -> string) MapString.t;
}
let eval env t =
let rec eval_expr env =
function
| String str -> str
| Ident nm ->
begin
try
MapString.find nm env.variables
with Not_found ->
(* TODO: add error location within the string. *)
failwithf
(f_ "Unable to find variable %S in source pattern %S")
nm t.origin
end
| Call (fn, expr) ->
begin
try
(MapString.find fn env.functions) (eval_expr env expr)
with Not_found ->
(* TODO: add error location within the string. *)
failwithf
(f_ "Unable to find function %S in source pattern %S")
fn t.origin
end
in
String.concat ""
(List.map
(function
| Text str -> str
| Expr expr -> eval_expr env expr)
t.atoms)
let parse env s =
let lxr = Genlex.make_lexer [] in
let parse_expr s =
let st = lxr (Stream.of_string s) in
match Stream.npeek 3 st with
| [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)
| [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)
| [Genlex.String str] -> String str
| [Genlex.Ident nm] -> Ident nm
(* TODO: add error location within the string. *)
| _ -> failwithf (f_ "Unable to parse expression %S") s
in
let parse s =
let lst_exprs = ref [] in
let ss =
let buff = Buffer.create (String.length s) in
Buffer.add_substitute
buff
(fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000")
s;
Buffer.contents buff
in
let rec join =
function
| hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)
| [], tl -> List.map (fun e -> Expr e) tl
| tl, [] -> List.map (fun e -> Text e) tl
in
join (OASISString.nsplit ss '\000', List.rev (!lst_exprs))
in
let t = {atoms = parse s; origin = s} in
(* We rely on a simple evaluation for checking variables/functions.
It works because there is no if/loop statement.
*)
let _s : string = eval env t in
t
(* # 144 "src/oasis/OASISSourcePatterns.ml" *)
end
type t = Templater.t
let env ~modul () =
{
Templater.
variables = MapString.of_list ["module", modul];
functions = MapString.of_list
[
"capitalize_file", OASISUnixPath.capitalize_file;
"uncapitalize_file", OASISUnixPath.uncapitalize_file;
];
}
let all_possible_files lst ~path ~modul =
let eval = Templater.eval (env ~modul ()) in
List.fold_left
(fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)
[] lst
let to_string t = t.Templater.origin
end
module OASISTypes = struct
(* # 22 "src/oasis/OASISTypes.ml" *)
type name = string
type package_name = string
type url = string
type unix_dirname = string
type unix_filename = string (* TODO: replace everywhere. *)
type host_dirname = string (* TODO: replace everywhere. *)
type host_filename = string (* TODO: replace everywhere. *)
type prog = string
type arg = string
type args = string list
type command_line = (prog * arg list)
type findlib_name = string
type findlib_full = string
type compiled_object =
| Byte
| Native
| Best
type dependency =
| FindlibPackage of findlib_full * OASISVersion.comparator option
| InternalLibrary of name
type tool =
| ExternalTool of name
| InternalExecutable of name
type vcs =
| Darcs
| Git
| Svn
| Cvs
| Hg
| Bzr
| Arch
| Monotone
| OtherVCS of url
type plugin_kind =
[ `Configure
| `Build
| `Doc
| `Test
| `Install
| `Extra
]
type plugin_data_purpose =
[ `Configure
| `Build
| `Install
| `Clean
| `Distclean
| `Install
| `Uninstall
| `Test
| `Doc
| `Extra
| `Other of string
]
type 'a plugin = 'a * name * OASISVersion.t option
type all_plugin = plugin_kind plugin
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
type 'a conditional = 'a OASISExpr.choices
type custom =
{
pre_command: (command_line option) conditional;
post_command: (command_line option) conditional;
}
type common_section =
{
cs_name: name;
cs_data: PropList.Data.t;
cs_plugin_data: plugin_data;
}
type build_section =
{
bs_build: bool conditional;
bs_install: bool conditional;
bs_path: unix_dirname;
bs_compiled_object: compiled_object;
bs_build_depends: dependency list;
bs_build_tools: tool list;
bs_interface_patterns: OASISSourcePatterns.t list;
bs_implementation_patterns: OASISSourcePatterns.t list;
bs_c_sources: unix_filename list;
bs_data_files: (unix_filename * unix_filename option) list;
bs_findlib_extra_files: unix_filename list;
bs_ccopt: args conditional;
bs_cclib: args conditional;
bs_dlllib: args conditional;
bs_dllpath: args conditional;
bs_byteopt: args conditional;
bs_nativeopt: args conditional;
}
type library =
{
lib_modules: string list;
lib_pack: bool;
lib_internal_modules: string list;
lib_findlib_parent: findlib_name option;
lib_findlib_name: findlib_name option;
lib_findlib_directory: unix_dirname option;
lib_findlib_containers: findlib_name list;
}
type object_ =
{
obj_modules: string list;
obj_findlib_fullname: findlib_name list option;
obj_findlib_directory: unix_dirname option;
}
type executable =
{
exec_custom: bool;
exec_main_is: unix_filename;
}
type flag =
{
flag_description: string option;
flag_default: bool conditional;
}
type source_repository =
{
src_repo_type: vcs;
src_repo_location: url;
src_repo_browser: url option;
src_repo_module: string option;
src_repo_branch: string option;
src_repo_tag: string option;
src_repo_subdir: unix_filename option;
}
type test =
{
test_type: [`Test] plugin;
test_command: command_line conditional;
test_custom: custom;
test_working_directory: unix_filename option;
test_run: bool conditional;
test_tools: tool list;
}
type doc_format =
| HTML of unix_filename (* TODO: source filename. *)
| DocText
| PDF
| PostScript
| Info of unix_filename (* TODO: source filename. *)
| DVI
| OtherDoc
type doc =
{
doc_type: [`Doc] plugin;
doc_custom: custom;
doc_build: bool conditional;
doc_install: bool conditional;
doc_install_dir: unix_filename; (* TODO: dest filename ?. *)
doc_title: string;
doc_authors: string list;
doc_abstract: string option;
doc_format: doc_format;
(* TODO: src filename. *)
doc_data_files: (unix_filename * unix_filename option) list;
doc_build_tools: tool list;
}
type section =
| Library of common_section * build_section * library
| Object of common_section * build_section * object_
| Executable of common_section * build_section * executable
| Flag of common_section * flag
| SrcRepo of common_section * source_repository
| Test of common_section * test
| Doc of common_section * doc
type section_kind =
[ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
type package =
{
oasis_version: OASISVersion.t;
ocaml_version: OASISVersion.comparator option;
findlib_version: OASISVersion.comparator option;
alpha_features: string list;
beta_features: string list;
name: package_name;
version: OASISVersion.t;
license: OASISLicense.t;
license_file: unix_filename option; (* TODO: source filename. *)
copyrights: string list;
maintainers: string list;
authors: string list;
homepage: url option;
bugreports: url option;
synopsis: string;
description: OASISText.t option;
tags: string list;
categories: url list;
conf_type: [`Configure] plugin;
conf_custom: custom;
build_type: [`Build] plugin;
build_custom: custom;
install_type: [`Install] plugin;
install_custom: custom;
uninstall_custom: custom;
clean_custom: custom;
distclean_custom: custom;
files_ab: unix_filename list; (* TODO: source filename. *)
sections: section list;
plugins: [`Extra] plugin list;
disable_oasis_section: unix_filename list; (* TODO: source filename. *)
schema_data: PropList.Data.t;
plugin_data: plugin_data;
}
end
module OASISFeatures = struct
(* # 22 "src/oasis/OASISFeatures.ml" *)
open OASISTypes
open OASISUtils
open OASISGettext
open OASISVersion
module MapPlugin =
Map.Make
(struct
type t = plugin_kind * name
let compare = Pervasives.compare
end)
module Data =
struct
type t =
{
oasis_version: OASISVersion.t;
plugin_versions: OASISVersion.t option MapPlugin.t;
alpha_features: string list;
beta_features: string list;
}
let create oasis_version alpha_features beta_features =
{
oasis_version = oasis_version;
plugin_versions = MapPlugin.empty;
alpha_features = alpha_features;
beta_features = beta_features
}
let of_package pkg =
create
pkg.OASISTypes.oasis_version
pkg.OASISTypes.alpha_features
pkg.OASISTypes.beta_features
let add_plugin (plugin_kind, plugin_name, plugin_version) t =
{t with
plugin_versions = MapPlugin.add
(plugin_kind, plugin_name)
plugin_version
t.plugin_versions}
let plugin_version plugin_kind plugin_name t =
MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
let to_string t =
Printf.sprintf
"oasis_version: %s; alpha_features: %s; beta_features: %s; \
plugins_version: %s"
(OASISVersion.string_of_version (t:t).oasis_version)
(String.concat ", " t.alpha_features)
(String.concat ", " t.beta_features)
(String.concat ", "
(MapPlugin.fold
(fun (_, plg) ver_opt acc ->
(plg^
(match ver_opt with
| Some v ->
" "^(OASISVersion.string_of_version v)
| None -> ""))
:: acc)
t.plugin_versions []))
end
type origin =
| Field of string * string
| Section of string
| NoOrigin
type stage = Alpha | Beta
let string_of_stage =
function
| Alpha -> "alpha"
| Beta -> "beta"
let field_of_stage =
function
| Alpha -> "AlphaFeatures"
| Beta -> "BetaFeatures"
type publication = InDev of stage | SinceVersion of OASISVersion.t
type t =
{
name: string;
plugin: all_plugin option;
publication: publication;
description: unit -> string;
}
(* TODO: mutex protect this. *)
let all_features = Hashtbl.create 13
let since_version ver_str = SinceVersion (version_of_string ver_str)
let alpha = InDev Alpha
let beta = InDev Beta
let to_string t =
Printf.sprintf
"feature: %s; plugin: %s; publication: %s"
(t:t).name
(match t.plugin with
| None -> "<none>"
| Some (_, nm, _) -> nm)
(match t.publication with
| InDev stage -> string_of_stage stage
| SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
let data_check t data origin =
let no_message = "no message" in
let check_feature features stage =
let has_feature = List.mem (t:t).name features in
if not has_feature then
match (origin:origin) with
| Field (fld, where) ->
Some
(Printf.sprintf
(f_ "Field %s in %s is only available when feature %s \
is in field %s.")
fld where t.name (field_of_stage stage))
| Section sct ->
Some
(Printf.sprintf
(f_ "Section %s is only available when features %s \
is in field %s.")
sct t.name (field_of_stage stage))
| NoOrigin ->
Some no_message
else
None
in
let version_is_good ~min_version version fmt =
let version_is_good =
OASISVersion.comparator_apply
version (OASISVersion.VGreaterEqual min_version)
in
Printf.ksprintf
(fun str -> if version_is_good then None else Some str)
fmt
in
match origin, t.plugin, t.publication with
| _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
| _, _, InDev Beta -> check_feature data.Data.beta_features Beta
| Field(fld, where), None, SinceVersion min_version ->
version_is_good ~min_version data.Data.oasis_version
(f_ "Field %s in %s is only valid since OASIS v%s, update \
OASISFormat field from '%s' to '%s' after checking \
OASIS changelog.")
fld where (string_of_version min_version)
(string_of_version data.Data.oasis_version)
(string_of_version min_version)
| Field(fld, where), Some(plugin_knd, plugin_name, _),
SinceVersion min_version ->
begin
try
let plugin_version_current =
try
match Data.plugin_version plugin_knd plugin_name data with
| Some ver -> ver
| None ->
failwithf
(f_ "Field %s in %s is only valid for the OASIS \
plugin %s since v%s, but no plugin version is \
defined in the _oasis file, change '%s' to \
'%s (%s)' in your _oasis file.")
fld where plugin_name (string_of_version min_version)
plugin_name
plugin_name (string_of_version min_version)
with Not_found ->
failwithf
(f_ "Field %s in %s is only valid when the OASIS plugin %s \
is defined.")
fld where plugin_name
in
version_is_good ~min_version plugin_version_current
(f_ "Field %s in %s is only valid for the OASIS plugin %s \
since v%s, update your plugin from '%s (%s)' to \
'%s (%s)' after checking the plugin's changelog.")
fld where plugin_name (string_of_version min_version)
plugin_name (string_of_version plugin_version_current)
plugin_name (string_of_version min_version)
with Failure msg ->
Some msg
end
| Section sct, None, SinceVersion min_version ->
version_is_good ~min_version data.Data.oasis_version
(f_ "Section %s is only valid for since OASIS v%s, update \
OASISFormat field from '%s' to '%s' after checking OASIS \
changelog.")
sct (string_of_version min_version)
(string_of_version data.Data.oasis_version)
(string_of_version min_version)
| Section sct, Some(plugin_knd, plugin_name, _),
SinceVersion min_version ->
begin
try
let plugin_version_current =
try
match Data.plugin_version plugin_knd plugin_name data with
| Some ver -> ver
| None ->
failwithf
(f_ "Section %s is only valid for the OASIS \
plugin %s since v%s, but no plugin version is \
defined in the _oasis file, change '%s' to \
'%s (%s)' in your _oasis file.")
sct plugin_name (string_of_version min_version)
plugin_name
plugin_name (string_of_version min_version)
with Not_found ->
failwithf
(f_ "Section %s is only valid when the OASIS plugin %s \
is defined.")
sct plugin_name
in
version_is_good ~min_version plugin_version_current
(f_ "Section %s is only valid for the OASIS plugin %s \
since v%s, update your plugin from '%s (%s)' to \
'%s (%s)' after checking the plugin's changelog.")
sct plugin_name (string_of_version min_version)
plugin_name (string_of_version plugin_version_current)
plugin_name (string_of_version min_version)
with Failure msg ->
Some msg
end
| NoOrigin, None, SinceVersion min_version ->
version_is_good ~min_version data.Data.oasis_version "%s" no_message
| NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
begin
try
let plugin_version_current =
match Data.plugin_version plugin_knd plugin_name data with
| Some ver -> ver
| None -> raise Not_found
in
version_is_good ~min_version plugin_version_current
"%s" no_message
with Not_found ->
Some no_message
end
let data_assert t data origin =
match data_check t data origin with
| None -> ()
| Some str -> failwith str
let data_test t data =
match data_check t data NoOrigin with
| None -> true
| Some _ -> false
let package_test t pkg =
data_test t (Data.of_package pkg)
let create ?plugin name publication description =
let () =
if Hashtbl.mem all_features name then
failwithf "Feature '%s' is already declared." name
in
let t =
{
name = name;
plugin = plugin;
publication = publication;
description = description;
}
in
Hashtbl.add all_features name t;
t
let get_stage name =
try
(Hashtbl.find all_features name).publication
with Not_found ->
failwithf (f_ "Feature %s doesn't exist.") name
let list () =
Hashtbl.fold (fun _ v acc -> v :: acc) all_features []
(*
* Real flags.
*)
let features =
create "features_fields"
(since_version "0.4")
(fun () ->
s_ "Enable to experiment not yet official features.")
let flag_docs =
create "flag_docs"
(since_version "0.3")
(fun () ->
s_ "Make building docs require '-docs' flag at configure.")
let flag_tests =
create "flag_tests"
(since_version "0.3")
(fun () ->
s_ "Make running tests require '-tests' flag at configure.")
let pack =
create "pack"
(since_version "0.3")
(fun () ->
s_ "Allow to create packed library.")
let section_object =
create "section_object" beta
(fun () ->
s_ "Implement an object section.")
let dynrun_for_release =
create "dynrun_for_release" alpha
(fun () ->
s_ "Make '-setup-update dynamic' suitable for releasing project.")
let compiled_setup_ml =
create "compiled_setup_ml" alpha
(fun () ->
s_ "Compile the setup.ml and speed-up actions done with it.")
let disable_oasis_section =
create "disable_oasis_section" alpha
(fun () ->
s_ "Allow the OASIS section comments and digests to be omitted in \
generated files.")
let no_automatic_syntax =
create "no_automatic_syntax" alpha
(fun () ->
s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
that matches the internal heuristic (if a dependency ends with \
a .syntax or is a well known syntax).")
let findlib_directory =
create "findlib_directory" beta
(fun () ->
s_ "Allow to install findlib libraries in sub-directories of the target \
findlib directory.")
let findlib_extra_files =
create "findlib_extra_files" beta
(fun () ->
s_ "Allow to install extra files for findlib libraries.")
let source_patterns =
create "source_patterns" alpha
(fun () ->
s_ "Customize mapping between module name and source file.")
end
module OASISSection = struct
(* # 22 "src/oasis/OASISSection.ml" *)
open OASISTypes
let section_kind_common =
function
| Library (cs, _, _) ->
`Library, cs
| Object (cs, _, _) ->
`Object, cs
| Executable (cs, _, _) ->
`Executable, cs
| Flag (cs, _) ->
`Flag, cs
| SrcRepo (cs, _) ->
`SrcRepo, cs
| Test (cs, _) ->
`Test, cs
| Doc (cs, _) ->
`Doc, cs
let section_common sct =
snd (section_kind_common sct)
let section_common_set cs =
function
| Library (_, bs, lib) -> Library (cs, bs, lib)
| Object (_, bs, obj) -> Object (cs, bs, obj)
| Executable (_, bs, exec) -> Executable (cs, bs, exec)
| Flag (_, flg) -> Flag (cs, flg)
| SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
| Test (_, tst) -> Test (cs, tst)
| Doc (_, doc) -> Doc (cs, doc)
(** Key used to identify section
*)
let section_id sct =
let k, cs =
section_kind_common sct
in
k, cs.cs_name
let string_of_section_kind =
function
| `Library -> "library"
| `Object -> "object"
| `Executable -> "executable"
| `Flag -> "flag"
| `SrcRepo -> "src repository"
| `Test -> "test"
| `Doc -> "doc"
let string_of_section sct =
let k, nm = section_id sct in
(string_of_section_kind k)^" "^nm
let section_find id scts =
List.find
(fun sct -> id = section_id sct)
scts
module CSection =
struct
type t = section
let id = section_id
let compare t1 t2 =
compare (id t1) (id t2)
let equal t1 t2 =
(id t1) = (id t2)
let hash t =
Hashtbl.hash (id t)
end
module MapSection = Map.Make(CSection)
module SetSection = Set.Make(CSection)
end
module OASISBuildSection = struct
(* # 22 "src/oasis/OASISBuildSection.ml" *)
open OASISTypes
(* Look for a module file, considering capitalization or not. *)
let find_module source_file_exists bs modul =
let possible_lst =
OASISSourcePatterns.all_possible_files
(bs.bs_interface_patterns @ bs.bs_implementation_patterns)
~path:bs.bs_path
~modul
in
match List.filter source_file_exists possible_lst with
| (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)
| [] ->
let open OASISUtils in
let _, rev_lst =
List.fold_left
(fun (set, acc) fn ->
let base_fn = OASISUnixPath.chop_extension fn in
if SetString.mem base_fn set then
set, acc
else
SetString.add base_fn set, base_fn :: acc)
(SetString.empty, []) possible_lst
in
`No_sources (List.rev rev_lst)
end
module OASISExecutable = struct
(* # 22 "src/oasis/OASISExecutable.ml" *)
open OASISTypes
let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
let dir =
OASISUnixPath.concat
bs.bs_path
(OASISUnixPath.dirname exec.exec_main_is)
in
let is_native_exec =
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native ()
| Byte -> false
in
OASISUnixPath.concat
dir
(cs.cs_name^(suffix_program ())),
if not is_native_exec &&
not exec.exec_custom &&
bs.bs_c_sources <> [] then
Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
else
None
end
module OASISLibrary = struct
(* # 22 "src/oasis/OASISLibrary.ml" *)
open OASISTypes
open OASISGettext
let find_module ~ctxt source_file_exists cs bs modul =
match OASISBuildSection.find_module source_file_exists bs modul with
| `Sources _ as res -> res
| `No_sources _ as res ->
OASISMessage.warning
~ctxt
(f_ "Cannot find source file matching module '%s' in library %s.")
modul cs.cs_name;
OASISMessage.warning
~ctxt
(f_ "Use InterfacePatterns or ImplementationPatterns to define \
this file with feature %S.")
(OASISFeatures.source_patterns.OASISFeatures.name);
res
let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
List.fold_left
(fun acc modul ->
match find_module ~ctxt source_file_exists cs bs modul with
| `Sources (base_fn, lst) -> (base_fn, lst) :: acc
| `No_sources _ -> acc)
[]
(lib.lib_modules @ lib.lib_internal_modules)
let generated_unix_files
~ctxt
~is_native
~has_native_dynlink
~ext_lib
~ext_dll
~source_file_exists
(cs, bs, lib) =
let find_modules lst ext =
let find_module modul =
match find_module ~ctxt source_file_exists cs bs modul with
| `Sources (_, [fn]) when ext <> "cmi"
&& Filename.check_suffix fn ".mli" ->
None (* No implementation files for pure interface. *)
| `Sources (base_fn, _) -> Some [base_fn]
| `No_sources lst -> Some lst
in
List.fold_left
(fun acc nm ->
match find_module nm with
| None -> acc
| Some base_fns ->
List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
[]
lst
in
(* The .cmx that be compiled along *)
let cmxs =
let should_be_built =
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native
| Byte -> false
in
if should_be_built then
if lib.lib_pack then
find_modules
[cs.cs_name]
"cmx"
else
find_modules
(lib.lib_modules @ lib.lib_internal_modules)
"cmx"
else
[]
in
let acc_nopath =
[]
in
(* The headers and annot/cmt files that should be compiled along *)
let headers =
let sufx =
if lib.lib_pack
then [".cmti"; ".cmt"; ".annot"]
else [".cmi"; ".cmti"; ".cmt"; ".annot"]
in
List.map
(List.fold_left
(fun accu s ->
let dot = String.rindex s '.' in
let base = String.sub s 0 dot in
List.map ((^) base) sufx @ accu)
[])
(find_modules lib.lib_modules "cmi")
in
(* Compute what libraries should be built *)
let acc_nopath =
(* Add the packed header file if required *)
let add_pack_header acc =
if lib.lib_pack then
[cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
else
acc
in
let byte acc =
add_pack_header ([cs.cs_name^".cma"] :: acc)
in
let native acc =
let acc =
add_pack_header
(if has_native_dynlink then
[cs.cs_name^".cmxs"] :: acc
else acc)
in
[cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
in
match bs.bs_compiled_object with
| Native -> byte (native acc_nopath)
| Best when is_native -> byte (native acc_nopath)
| Byte | Best -> byte acc_nopath
in
(* Add C library to be built *)
let acc_nopath =
if bs.bs_c_sources <> [] then begin
["lib"^cs.cs_name^"_stubs"^ext_lib]
::
if has_native_dynlink then
["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath
else
acc_nopath
end else begin
acc_nopath
end
in
(* All the files generated *)
List.rev_append
(List.rev_map
(List.rev_map
(OASISUnixPath.concat bs.bs_path))
acc_nopath)
(headers @ cmxs)
end
module OASISObject = struct
(* # 22 "src/oasis/OASISObject.ml" *)
open OASISTypes
open OASISGettext
let find_module ~ctxt source_file_exists cs bs modul =
match OASISBuildSection.find_module source_file_exists bs modul with
| `Sources _ as res -> res
| `No_sources _ as res ->
OASISMessage.warning
~ctxt
(f_ "Cannot find source file matching module '%s' in object %s.")
modul cs.cs_name;
OASISMessage.warning
~ctxt
(f_ "Use InterfacePatterns or ImplementationPatterns to define \
this file with feature %S.")
(OASISFeatures.source_patterns.OASISFeatures.name);
res
let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =
List.fold_left
(fun acc modul ->
match find_module ~ctxt source_file_exists cs bs modul with
| `Sources (base_fn, lst) -> (base_fn, lst) :: acc
| `No_sources _ -> acc)
[]
obj.obj_modules
let generated_unix_files
~ctxt
~is_native
~source_file_exists
(cs, bs, obj) =
let find_module ext modul =
match find_module ~ctxt source_file_exists cs bs modul with
| `Sources (base_fn, _) -> [base_fn ^ ext]
| `No_sources lst -> lst
in
let header, byte, native, c_object, f =
match obj.obj_modules with
| [ m ] -> (find_module ".cmi" m,
find_module ".cmo" m,
find_module ".cmx" m,
find_module ".o" m,
fun x -> x)
| _ -> ([cs.cs_name ^ ".cmi"],
[cs.cs_name ^ ".cmo"],
[cs.cs_name ^ ".cmx"],
[cs.cs_name ^ ".o"],
OASISUnixPath.concat bs.bs_path)
in
List.map (List.map f) (
match bs.bs_compiled_object with
| Native ->
native :: c_object :: byte :: header :: []
| Best when is_native ->
native :: c_object :: byte :: header :: []
| Byte | Best ->
byte :: header :: [])
end
module OASISFindlib = struct
(* # 22 "src/oasis/OASISFindlib.ml" *)
open OASISTypes
open OASISUtils
open OASISGettext
type library_name = name
type findlib_part_name = name
type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
exception InternalLibraryNotFound of library_name
exception FindlibPackageNotFound of findlib_name
type group_t =
| Container of findlib_name * group_t list
| Package of (findlib_name *
common_section *
build_section *
[`Library of library | `Object of object_] *
unix_dirname option *
group_t list)
type data = common_section *
build_section *
[`Library of library | `Object of object_]
type tree =
| Node of (data option) * (tree MapString.t)
| Leaf of data
let findlib_mapping pkg =
(* Map from library name to either full findlib name or parts + parent. *)
let fndlb_parts_of_lib_name =
let fndlb_parts cs lib =
let name =
match lib.lib_findlib_name with
| Some nm -> nm
| None -> cs.cs_name
in
let name =
String.concat "." (lib.lib_findlib_containers @ [name])
in
name
in
List.fold_left
(fun mp ->
function
| Library (cs, _, lib) ->
begin
let lib_name = cs.cs_name in
let fndlb_parts = fndlb_parts cs lib in
if MapString.mem lib_name mp then
failwithf
(f_ "The library name '%s' is used more than once.")
lib_name;
match lib.lib_findlib_parent with
| Some lib_name_parent ->
MapString.add
lib_name
(`Unsolved (lib_name_parent, fndlb_parts))
mp
| None ->
MapString.add
lib_name
(`Solved fndlb_parts)
mp
end
| Object (cs, _, obj) ->
begin
let obj_name = cs.cs_name in
if MapString.mem obj_name mp then
failwithf
(f_ "The object name '%s' is used more than once.")
obj_name;
let findlib_full_name = match obj.obj_findlib_fullname with
| Some ns -> String.concat "." ns
| None -> obj_name
in
MapString.add
obj_name
(`Solved findlib_full_name)
mp
end
| Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
mp)
MapString.empty
pkg.sections
in
(* Solve the above graph to be only library name to full findlib name. *)
let fndlb_name_of_lib_name =
let rec solve visited mp lib_name lib_name_child =
if SetString.mem lib_name visited then
failwithf
(f_ "Library '%s' is involved in a cycle \
with regard to findlib naming.")
lib_name;
let visited = SetString.add lib_name visited in
try
match MapString.find lib_name mp with
| `Solved fndlb_nm ->
fndlb_nm, mp
| `Unsolved (lib_nm_parent, post_fndlb_nm) ->
let pre_fndlb_nm, mp =
solve visited mp lib_nm_parent lib_name
in
let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
with Not_found ->
failwithf
(f_ "Library '%s', which is defined as the findlib parent of \
library '%s', doesn't exist.")
lib_name lib_name_child
in
let mp =
MapString.fold
(fun lib_name status mp ->
match status with
| `Solved _ ->
(* Solved initialy, no need to go further *)
mp
| `Unsolved _ ->
let _, mp = solve SetString.empty mp lib_name "<none>" in
mp)
fndlb_parts_of_lib_name
fndlb_parts_of_lib_name
in
MapString.map
(function
| `Solved fndlb_nm -> fndlb_nm
| `Unsolved _ -> assert false)
mp
in
(* Convert an internal library name to a findlib name. *)
let findlib_name_of_library_name lib_nm =
try
MapString.find lib_nm fndlb_name_of_lib_name
with Not_found ->
raise (InternalLibraryNotFound lib_nm)
in
(* Add a library to the tree.
*)
let add sct mp =
let fndlb_fullname =
let cs, _, _ = sct in
let lib_name = cs.cs_name in
findlib_name_of_library_name lib_name
in
let rec add_children nm_lst (children: tree MapString.t) =
match nm_lst with
| (hd :: tl) ->
begin
let node =
try
add_node tl (MapString.find hd children)
with Not_found ->
(* New node *)
new_node tl
in
MapString.add hd node children
end
| [] ->
(* Should not have a nameless library. *)
assert false
and add_node tl node =
if tl = [] then
begin
match node with
| Node (None, children) ->
Node (Some sct, children)
| Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
(* TODO: allow to merge Package, i.e.
* archive(byte) = "foo.cma foo_init.cmo"
*)
let cs, _, _ = sct in
failwithf
(f_ "Library '%s' and '%s' have the same findlib name '%s'")
cs.cs_name cs'.cs_name fndlb_fullname
end
else
begin
match node with
| Leaf data ->
Node (Some data, add_children tl MapString.empty)
| Node (data_opt, children) ->
Node (data_opt, add_children tl children)
end
and new_node =
function
| [] ->
Leaf sct
| hd :: tl ->
Node (None, MapString.add hd (new_node tl) MapString.empty)
in
add_children (OASISString.nsplit fndlb_fullname '.') mp
in
let unix_directory dn lib =
let directory =
match lib with
| `Library lib -> lib.lib_findlib_directory
| `Object obj -> obj.obj_findlib_directory
in
match dn, directory with
| None, None -> None
| None, Some dn | Some dn, None -> Some dn
| Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)
in
let rec group_of_tree dn mp =
MapString.fold
(fun nm node acc ->
let cur =
match node with
| Node (Some (cs, bs, lib), children) ->
let current_dn = unix_directory dn lib in
Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)
| Node (None, children) ->
Container (nm, group_of_tree dn children)
| Leaf (cs, bs, lib) ->
let current_dn = unix_directory dn lib in
Package (nm, cs, bs, lib, current_dn, [])
in
cur :: acc)
mp []
in
let group_mp =
List.fold_left
(fun mp ->
function
| Library (cs, bs, lib) ->
add (cs, bs, `Library lib) mp
| Object (cs, bs, obj) ->
add (cs, bs, `Object obj) mp
| _ ->
mp)
MapString.empty
pkg.sections
in
let groups = group_of_tree None group_mp in
let library_name_of_findlib_name =
lazy begin
(* Revert findlib_name_of_library_name. *)
MapString.fold
(fun k v mp -> MapString.add v k mp)
fndlb_name_of_lib_name
MapString.empty
end
in
let library_name_of_findlib_name fndlb_nm =
try
MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)
with Not_found ->
raise (FindlibPackageNotFound fndlb_nm)
in
groups,
findlib_name_of_library_name,
library_name_of_findlib_name
let findlib_of_group =
function
| Container (fndlb_nm, _)
| Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm
let root_of_group grp =
let rec root_lib_aux =
(* We do a DFS in the group. *)
function
| Container (_, children) ->
List.fold_left
(fun res grp ->
if res = None then
root_lib_aux grp
else
res)
None
children
| Package (_, cs, bs, lib, _, _) ->
Some (cs, bs, lib)
in
match root_lib_aux grp with
| Some res ->
res
| None ->
failwithf
(f_ "Unable to determine root library of findlib library '%s'")
(findlib_of_group grp)
end
module OASISFlag = struct
(* # 22 "src/oasis/OASISFlag.ml" *)
end
module OASISPackage = struct
(* # 22 "src/oasis/OASISPackage.ml" *)
end
module OASISSourceRepository = struct
(* # 22 "src/oasis/OASISSourceRepository.ml" *)
end
module OASISTest = struct
(* # 22 "src/oasis/OASISTest.ml" *)
end
module OASISDocument = struct
(* # 22 "src/oasis/OASISDocument.ml" *)
end
module OASISExec = struct
(* # 22 "src/oasis/OASISExec.ml" *)
open OASISGettext
open OASISUtils
open OASISMessage
(* TODO: I don't like this quote, it is there because $(rm) foo expands to
* 'rm -f' foo...
*)
let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
let cmd =
if quote then
if Sys.os_type = "Win32" then
if String.contains cmd ' ' then
(* Double the 1st double quote... win32... sigh *)
"\""^(Filename.quote cmd)
else
cmd
else
Filename.quote cmd
else
cmd
in
let cmdline =
String.concat " " (cmd :: args)
in
info ~ctxt (f_ "Running command '%s'") cmdline;
match f_exit_code, Sys.command cmdline with
| None, 0 -> ()
| None, i ->
failwithf
(f_ "Command '%s' terminated with error code %d")
cmdline i
| Some f, i ->
f i
let run_read_output ~ctxt ?f_exit_code cmd args =
let fn =
Filename.temp_file "oasis-" ".txt"
in
try
begin
let () =
run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
in
let chn =
open_in fn
in
let routput =
ref []
in
begin
try
while true do
routput := (input_line chn) :: !routput
done
with End_of_file ->
()
end;
close_in chn;
Sys.remove fn;
List.rev !routput
end
with e ->
(try Sys.remove fn with _ -> ());
raise e
let run_read_one_line ~ctxt ?f_exit_code cmd args =
match run_read_output ~ctxt ?f_exit_code cmd args with
| [fst] ->
fst
| lst ->
failwithf
(f_ "Command return unexpected output %S")
(String.concat "\n" lst)
end
module OASISFileUtil = struct
(* # 22 "src/oasis/OASISFileUtil.ml" *)
open OASISGettext
let file_exists_case fn =
let dirname = Filename.dirname fn in
let basename = Filename.basename fn in
if Sys.file_exists dirname then
if basename = Filename.current_dir_name then
true
else
List.mem
basename
(Array.to_list (Sys.readdir dirname))
else
false
let find_file ?(case_sensitive=true) paths exts =
(* Cardinal product of two list *)
let ( * ) lst1 lst2 =
List.flatten
(List.map
(fun a ->
List.map
(fun b -> a, b)
lst2)
lst1)
in
let rec combined_paths lst =
match lst with
| p1 :: p2 :: tl ->
let acc =
(List.map
(fun (a, b) -> Filename.concat a b)
(p1 * p2))
in
combined_paths (acc :: tl)
| [e] ->
e
| [] ->
[]
in
let alternatives =
List.map
(fun (p, e) ->
if String.length e > 0 && e.[0] <> '.' then
p ^ "." ^ e
else
p ^ e)
((combined_paths paths) * exts)
in
List.find (fun file ->
(if case_sensitive then
file_exists_case file
else
Sys.file_exists file)
&& not (Sys.is_directory file)
) alternatives
let which ~ctxt prg =
let path_sep =
match Sys.os_type with
| "Win32" ->
';'
| _ ->
':'
in
let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
let exec_ext =
match Sys.os_type with
| "Win32" ->
"" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
| _ ->
[""]
in
find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
(**/**)
let rec fix_dir dn =
(* Windows hack because Sys.file_exists "src\\" = false when
* Sys.file_exists "src" = true
*)
let ln =
String.length dn
in
if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
fix_dir (String.sub dn 0 (ln - 1))
else
dn
let q = Filename.quote
(**/**)
let cp ~ctxt ?(recurse=false) src tgt =
if recurse then
match Sys.os_type with
| "Win32" ->
OASISExec.run ~ctxt
"xcopy" [q src; q tgt; "/E"]
| _ ->
OASISExec.run ~ctxt
"cp" ["-r"; q src; q tgt]
else
OASISExec.run ~ctxt
(match Sys.os_type with
| "Win32" -> "copy"
| _ -> "cp")
[q src; q tgt]
let mkdir ~ctxt tgt =
OASISExec.run ~ctxt
(match Sys.os_type with
| "Win32" -> "md"
| _ -> "mkdir")
[q tgt]
let rec mkdir_parent ~ctxt f tgt =
let tgt =
fix_dir tgt
in
if Sys.file_exists tgt then
begin
if not (Sys.is_directory tgt) then
OASISUtils.failwithf
(f_ "Cannot create directory '%s', a file of the same name already \
exists")
tgt
end
else
begin
mkdir_parent ~ctxt f (Filename.dirname tgt);
if not (Sys.file_exists tgt) then
begin
f tgt;
mkdir ~ctxt tgt
end
end
let rmdir ~ctxt tgt =
if Sys.readdir tgt = [||] then begin
match Sys.os_type with
| "Win32" ->
OASISExec.run ~ctxt "rd" [q tgt]
| _ ->
OASISExec.run ~ctxt "rm" ["-r"; q tgt]
end else begin
OASISMessage.error ~ctxt
(f_ "Cannot remove directory '%s': not empty.")
tgt
end
let glob ~ctxt fn =
let basename =
Filename.basename fn
in
if String.length basename >= 2 &&
basename.[0] = '*' &&
basename.[1] = '.' then
begin
let ext_len =
(String.length basename) - 2
in
let ext =
String.sub basename 2 ext_len
in
let dirname =
Filename.dirname fn
in
Array.fold_left
(fun acc fn ->
try
let fn_ext =
String.sub
fn
((String.length fn) - ext_len)
ext_len
in
if fn_ext = ext then
(Filename.concat dirname fn) :: acc
else
acc
with Invalid_argument _ ->
acc)
[]
(Sys.readdir dirname)
end
else
begin
if file_exists_case fn then
[fn]
else
[]
end
end
# 3159 "setup.ml"
module BaseEnvLight = struct
(* # 22 "src/base/BaseEnvLight.ml" *)
module MapString = Map.Make(String)
type t = string MapString.t
let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
let line = ref 1 in
let lexer st =
let st_line =
Stream.from
(fun _ ->
try
match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
Genlex.make_lexer ["="] st_line
in
let rec read_file lxr mp =
match Stream.npeek 3 lxr with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
read_file lxr (MapString.add nm value mp)
| [] -> mp
| _ ->
failwith
(Printf.sprintf "Malformed data file '%s' line %d" filename !line)
in
match stream with
| Some st -> read_file (lexer st) MapString.empty
| None ->
if Sys.file_exists filename then begin
let chn = open_in_bin filename in
let st = Stream.of_channel chn in
try
let mp = read_file (lexer st) MapString.empty in
close_in chn; mp
with e ->
close_in chn; raise e
end else if allow_empty then begin
MapString.empty
end else begin
failwith
(Printf.sprintf
"Unable to load environment, the file '%s' doesn't exist."
filename)
end
let rec var_expand str env =
let buff = Buffer.create ((String.length str) * 2) in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env) env
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
let var_get name env = var_expand (MapString.find name env) env
let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
end
# 3239 "setup.ml"
module BaseContext = struct
(* # 22 "src/base/BaseContext.ml" *)
(* TODO: get rid of this module. *)
open OASISContext
let args () = fst (fspecs ())
let default = default
end
module BaseMessage = struct
(* # 22 "src/base/BaseMessage.ml" *)
(** Message to user, overrid for Base
@author Sylvain Le Gall
*)
open OASISMessage
open BaseContext
let debug fmt = debug ~ctxt:!default fmt
let info fmt = info ~ctxt:!default fmt
let warning fmt = warning ~ctxt:!default fmt
let error fmt = error ~ctxt:!default fmt
end
module BaseEnv = struct
(* # 22 "src/base/BaseEnv.ml" *)
open OASISGettext
open OASISUtils
open OASISContext
open PropList
module MapString = BaseEnvLight.MapString
type origin_t =
| ODefault
| OGetEnv
| OFileLoad
| OCommandLine
type cli_handle_t =
| CLINone
| CLIAuto
| CLIWith
| CLIEnable
| CLIUser of (Arg.key * Arg.spec * Arg.doc) list
type definition_t =
{
hide: bool;
dump: bool;
cli: cli_handle_t;
arg_help: string option;
group: string option;
}
let schema = Schema.create "environment"
(* Environment data *)
let env = Data.create ()
(* Environment data from file *)
let env_from_file = ref MapString.empty
(* Lexer for var *)
let var_lxr = Genlex.make_lexer []
let rec var_expand str =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
(* TODO: this is a quick hack to allow calling Test.Command
* without defining executable name really. I.e. if there is
* an exec Executable toto, then $(toto) should be replace
* by its real name. It is however useful to have this function
* for other variable that depend on the host and should be
* written better than that.
*)
let st =
var_lxr (Stream.of_string var)
in
match Stream.npeek 3 st with
| [Genlex.Ident "utoh"; Genlex.Ident nm] ->
OASISHostPath.of_unix (var_get nm)
| [Genlex.Ident "utoh"; Genlex.String s] ->
OASISHostPath.of_unix s
| [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
String.escaped (var_get nm)
| [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
String.escaped s
| [Genlex.Ident nm] ->
var_get nm
| _ ->
failwithf
(f_ "Unknown expression '%s' in variable expansion of %s.")
var
str
with
| Unknown_field (_, _) ->
failwithf
(f_ "No variable %s defined when trying to expand %S.")
var
str
| Stream.Error e ->
failwithf
(f_ "Syntax error when parsing '%s' when trying to \
expand %S: %s")
var
str
e)
str;
Buffer.contents buff
and var_get name =
let vl =
try
Schema.get schema env name
with Unknown_field _ as e ->
begin
try
MapString.find name !env_from_file
with Not_found ->
raise e
end
in
var_expand vl
let var_choose ?printer ?name lst =
OASISExpr.choose
?printer
?name
var_get
lst
let var_protect vl =
let buff =
Buffer.create (String.length vl)
in
String.iter
(function
| '$' -> Buffer.add_string buff "\\$"
| c -> Buffer.add_char buff c)
vl;
Buffer.contents buff
let var_define
?(hide=false)
?(dump=true)
?short_desc
?(cli=CLINone)
?arg_help
?group
name (* TODO: type constraint on the fact that name must be a valid OCaml
id *)
dflt =
let default =
[
OFileLoad, (fun () -> MapString.find name !env_from_file);
ODefault, dflt;
OGetEnv, (fun () -> Sys.getenv name);
]
in
let extra =
{
hide = hide;
dump = dump;
cli = cli;
arg_help = arg_help;
group = group;
}
in
(* Try to find a value that can be defined
*)
let var_get_low lst =
let errors, res =
List.fold_left
(fun (errors, res) (_, v) ->
if res = None then
begin
try
errors, Some (v ())
with
| Not_found ->
errors, res
| Failure rsn ->
(rsn :: errors), res
| e ->
(Printexc.to_string e) :: errors, res
end
else
errors, res)
([], None)
(List.sort
(fun (o1, _) (o2, _) ->
Pervasives.compare o2 o1)
lst)
in
match res, errors with
| Some v, _ ->
v
| None, [] ->
raise (Not_set (name, None))
| None, lst ->
raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
in
let help =
match short_desc with
| Some fs -> Some fs
| None -> None
in
let var_get_lst =
FieldRO.create
~schema
~name
~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
~print:var_get_low
~default
~update:(fun ?context:_ x old_x -> x @ old_x)
?help
extra
in
fun () ->
var_expand (var_get_low (var_get_lst env))
let var_redefine
?hide
?dump
?short_desc
?cli
?arg_help
?group
name
dflt =
if Schema.mem schema name then
begin
(* TODO: look suspsicious, we want to memorize dflt not dflt () *)
Schema.set schema env ~context:ODefault name (dflt ());
fun () -> var_get name
end
else
begin
var_define
?hide
?dump
?short_desc
?cli
?arg_help
?group
name
dflt
end
let var_ignore (_: unit -> string) = ()
let print_hidden =
var_define
~hide:true
~dump:false
~cli:CLIAuto
~arg_help:"Print even non-printable variable. (debug)"
"print_hidden"
(fun () -> "false")
let var_all () =
List.rev
(Schema.fold
(fun acc nm def _ ->
if not def.hide || bool_of_string (print_hidden ()) then
nm :: acc
else
acc)
[]
schema)
let default_filename = in_srcdir "setup.data"
let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =
let open OASISFileSystem in
env_from_file :=
let repr_filename = ctxt.srcfs#string_of_filename filename in
if ctxt.srcfs#file_exists filename then begin
let buf = Buffer.create 13 in
defer_close
(ctxt.srcfs#open_in ~mode:binary_in filename)
(read_all buf);
defer_close
(ctxt.srcfs#open_in ~mode:binary_in filename)
(fun rdr ->
OASISMessage.info ~ctxt "Loading environment from %S." repr_filename;
BaseEnvLight.load ~allow_empty
~filename:(repr_filename)
~stream:(stream_of_reader rdr)
())
end else if allow_empty then begin
BaseEnvLight.MapString.empty
end else begin
failwith
(Printf.sprintf
(f_ "Unable to load environment, the file '%s' doesn't exist.")
repr_filename)
end
let unload () =
env_from_file := MapString.empty;
Data.clear env
let dump ~ctxt ?(filename=default_filename) () =
let open OASISFileSystem in
defer_close
(ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)
(fun wrtr ->
let buf = Buffer.create 63 in
let output nm value =
Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value)
in
let mp_todo =
(* Dump data from schema *)
Schema.fold
(fun mp_todo nm def _ ->
if def.dump then begin
try
output nm (Schema.get schema env nm)
with Not_set _ ->
()
end;
MapString.remove nm mp_todo)
!env_from_file
schema
in
(* Dump data defined outside of schema *)
MapString.iter output mp_todo;
wrtr#output buf)
let print () =
let printable_vars =
Schema.fold
(fun acc nm def short_descr_opt ->
if not def.hide || bool_of_string (print_hidden ()) then
begin
try
let value = Schema.get schema env nm in
let txt =
match short_descr_opt with
| Some s -> s ()
| None -> nm
in
(txt, value) :: acc
with Not_set _ ->
acc
end
else
acc)
[]
schema
in
let max_length =
List.fold_left max 0
(List.rev_map String.length
(List.rev_map fst printable_vars))
in
let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in
Printf.printf "\nConfiguration:\n";
List.iter
(fun (name, value) ->
Printf.printf "%s: %s" name (dot_pad name);
if value = "" then
Printf.printf "\n"
else
Printf.printf " %s\n" value)
(List.rev printable_vars);
Printf.printf "\n%!"
let args () =
let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in
[
"--override",
Arg.Tuple
(
let rvr = ref ""
in
let rvl = ref ""
in
[
Arg.Set_string rvr;
Arg.Set_string rvl;
Arg.Unit
(fun () ->
Schema.set
schema
env
~context:OCommandLine
!rvr
!rvl)
]
),
"var+val Override any configuration variable.";
]
@
List.flatten
(Schema.fold
(fun acc name def short_descr_opt ->
let var_set s =
Schema.set
schema
env
~context:OCommandLine
name
s
in
let arg_name =
OASISUtils.varname_of_string ~hyphen:'-' name
in
let hlp =
match short_descr_opt with
| Some txt -> txt ()
| None -> ""
in
let arg_hlp =
match def.arg_help with
| Some s -> s
| None -> "str"
in
let default_value =
try
Printf.sprintf
(f_ " [%s]")
(Schema.get
schema
env
name)
with Not_set _ ->
""
in
let args =
match def.cli with
| CLINone ->
[]
| CLIAuto ->
[
arg_concat "--" arg_name,
Arg.String var_set,
Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
]
| CLIWith ->
[
arg_concat "--with-" arg_name,
Arg.String var_set,
Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
]
| CLIEnable ->
let dflt =
if default_value = " [true]" then
s_ " [default: enabled]"
else
s_ " [default: disabled]"
in
[
arg_concat "--enable-" arg_name,
Arg.Unit (fun () -> var_set "true"),
Printf.sprintf (f_ " %s%s") hlp dflt;
arg_concat "--disable-" arg_name,
Arg.Unit (fun () -> var_set "false"),
Printf.sprintf (f_ " %s%s") hlp dflt
]
| CLIUser lst ->
lst
in
args :: acc)
[]
schema)
end
module BaseArgExt = struct
(* # 22 "src/base/BaseArgExt.ml" *)
open OASISUtils
open OASISGettext
let parse argv args =
(* Simulate command line for Arg *)
let current =
ref 0
in
try
Arg.parse_argv
~current:current
(Array.concat [[|"none"|]; argv])
(Arg.align args)
(failwithf (f_ "Don't know what to do with arguments: '%s'"))
(s_ "configure options:")
with
| Arg.Help txt ->
print_endline txt;
exit 0
| Arg.Bad txt ->
prerr_endline txt;
exit 1
end
module BaseCheck = struct
(* # 22 "src/base/BaseCheck.ml" *)
open BaseEnv
open BaseMessage
open OASISUtils
open OASISGettext
let prog_best prg prg_lst =
var_redefine
prg
(fun () ->
let alternate =
List.fold_left
(fun res e ->
match res with
| Some _ ->
res
| None ->
try
Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
with Not_found ->
None)
None
prg_lst
in
match alternate with
| Some prg -> prg
| None -> raise Not_found)
let prog prg =
prog_best prg [prg]
let prog_opt prg =
prog_best prg [prg^".opt"; prg]
let ocamlfind =
prog "ocamlfind"
let version
var_prefix
cmp
fversion
() =
(* Really compare version provided *)
let var =
var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
in
var_redefine
~hide:true
var
(fun () ->
let version_str =
match fversion () with
| "[Distributed with OCaml]" ->
begin
try
(var_get "ocaml_version")
with Not_found ->
warning
(f_ "Variable ocaml_version not defined, fallback \
to default");
Sys.ocaml_version
end
| res ->
res
in
let version =
OASISVersion.version_of_string version_str
in
if OASISVersion.comparator_apply version cmp then
version_str
else
failwithf
(f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
var_prefix
(OASISVersion.string_of_comparator cmp)
version_str)
()
let package_version pkg =
OASISExec.run_read_one_line ~ctxt:!BaseContext.default
(ocamlfind ())
["query"; "-format"; "%v"; pkg]
let package ?version_comparator pkg () =
let var =
OASISUtils.varname_concat
"pkg_"
(OASISUtils.varname_of_string pkg)
in
let findlib_dir pkg =
let dir =
OASISExec.run_read_one_line ~ctxt:!BaseContext.default
(ocamlfind ())
["query"; "-format"; "%d"; pkg]
in
if Sys.file_exists dir && Sys.is_directory dir then
dir
else
failwithf
(f_ "When looking for findlib package %s, \
directory %s return doesn't exist")
pkg dir
in
let vl =
var_redefine
var
(fun () -> findlib_dir pkg)
()
in
(
match version_comparator with
| Some ver_cmp ->
ignore
(version
var
ver_cmp
(fun _ -> package_version pkg)
())
| None ->
()
);
vl
end
module BaseOCamlcConfig = struct
(* # 22 "src/base/BaseOCamlcConfig.ml" *)
open BaseEnv
open OASISUtils
open OASISGettext
module SMap = Map.Make(String)
let ocamlc =
BaseCheck.prog_opt "ocamlc"
let ocamlc_config_map =
(* Map name to value for ocamlc -config output
(name ^": "^value)
*)
let rec split_field mp lst =
match lst with
| line :: tl ->
let mp =
try
let pos_semicolon =
String.index line ':'
in
if pos_semicolon > 1 then
(
let name =
String.sub line 0 pos_semicolon
in
let linelen =
String.length line
in
let value =
if linelen > pos_semicolon + 2 then
String.sub
line
(pos_semicolon + 2)
(linelen - pos_semicolon - 2)
else
""
in
SMap.add name value mp
)
else
(
mp
)
with Not_found ->
(
mp
)
in
split_field mp tl
| [] ->
mp
in
let cache =
lazy
(var_protect
(Marshal.to_string
(split_field
SMap.empty
(OASISExec.run_read_output
~ctxt:!BaseContext.default
(ocamlc ()) ["-config"]))
[]))
in
var_redefine
"ocamlc_config_map"
~hide:true
~dump:false
(fun () ->
(* TODO: update if ocamlc change !!! *)
Lazy.force cache)
let var_define nm =
(* Extract data from ocamlc -config *)
let avlbl_config_get () =
Marshal.from_string
(ocamlc_config_map ())
0
in
let chop_version_suffix s =
try
String.sub s 0 (String.index s '+')
with _ ->
s
in
let nm_config, value_config =
match nm with
| "ocaml_version" ->
"version", chop_version_suffix
| _ -> nm, (fun x -> x)
in
var_redefine
nm
(fun () ->
try
let map =
avlbl_config_get ()
in
let value =
SMap.find nm_config map
in
value_config value
with Not_found ->
failwithf
(f_ "Cannot find field '%s' in '%s -config' output")
nm
(ocamlc ()))
end
module BaseStandardVar = struct
(* # 22 "src/base/BaseStandardVar.ml" *)
open OASISGettext
open OASISTypes
open BaseCheck
open BaseEnv
let ocamlfind = BaseCheck.ocamlfind
let ocamlc = BaseOCamlcConfig.ocamlc
let ocamlopt = prog_opt "ocamlopt"
let ocamlbuild = prog "ocamlbuild"
(**/**)
let rpkg =
ref None
let pkg_get () =
match !rpkg with
| Some pkg -> pkg
| None -> failwith (s_ "OASIS Package is not set")
let var_cond = ref []
let var_define_cond ~since_version f dflt =
let holder = ref (fun () -> dflt) in
let since_version =
OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
in
var_cond :=
(fun ver ->
if OASISVersion.comparator_apply ver since_version then
holder := f ()) :: !var_cond;
fun () -> !holder ()
(**/**)
let pkg_name =
var_define
~short_desc:(fun () -> s_ "Package name")
"pkg_name"
(fun () -> (pkg_get ()).name)
let pkg_version =
var_define
~short_desc:(fun () -> s_ "Package version")
"pkg_version"
(fun () ->
(OASISVersion.string_of_version (pkg_get ()).version))
let c = BaseOCamlcConfig.var_define
let os_type = c "os_type"
let system = c "system"
let architecture = c "architecture"
let ccomp_type = c "ccomp_type"
let ocaml_version = c "ocaml_version"
(* TODO: Check standard variable presence at runtime *)
let standard_library_default = c "standard_library_default"
let standard_library = c "standard_library"
let standard_runtime = c "standard_runtime"
let bytecomp_c_compiler = c "bytecomp_c_compiler"
let native_c_compiler = c "native_c_compiler"
let model = c "model"
let ext_obj = c "ext_obj"
let ext_asm = c "ext_asm"
let ext_lib = c "ext_lib"
let ext_dll = c "ext_dll"
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
let flexlink =
BaseCheck.prog "flexlink"
let flexdll_version =
var_define
~short_desc:(fun () -> "FlexDLL version (Win32)")
"flexdll_version"
(fun () ->
let lst =
OASISExec.run_read_output ~ctxt:!BaseContext.default
(flexlink ()) ["-help"]
in
match lst with
| line :: _ ->
Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
| [] ->
raise Not_found)
(**/**)
let p name hlp dflt =
var_define
~short_desc:hlp
~cli:CLIAuto
~arg_help:"dir"
name
dflt
let (/) a b =
if os_type () = Sys.os_type then
Filename.concat a b
else if os_type () = "Unix" || os_type () = "Cygwin" then
OASISUnixPath.concat a b
else
OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
(os_type ())
(**/**)
let prefix =
p "prefix"
(fun () -> s_ "Install architecture-independent files dir")
(fun () ->
match os_type () with
| "Win32" ->
let program_files =
Sys.getenv "PROGRAMFILES"
in
program_files/(pkg_name ())
| _ ->
"/usr/local")
let exec_prefix =
p "exec_prefix"
(fun () -> s_ "Install architecture-dependent files in dir")
(fun () -> "$prefix")
let bindir =
p "bindir"
(fun () -> s_ "User executables")
(fun () -> "$exec_prefix"/"bin")
let sbindir =
p "sbindir"
(fun () -> s_ "System admin executables")
(fun () -> "$exec_prefix"/"sbin")
let libexecdir =
p "libexecdir"
(fun () -> s_ "Program executables")
(fun () -> "$exec_prefix"/"libexec")
let sysconfdir =
p "sysconfdir"
(fun () -> s_ "Read-only single-machine data")
(fun () -> "$prefix"/"etc")
let sharedstatedir =
p "sharedstatedir"
(fun () -> s_ "Modifiable architecture-independent data")
(fun () -> "$prefix"/"com")
let localstatedir =
p "localstatedir"
(fun () -> s_ "Modifiable single-machine data")
(fun () -> "$prefix"/"var")
let libdir =
p "libdir"
(fun () -> s_ "Object code libraries")
(fun () -> "$exec_prefix"/"lib")
let datarootdir =
p "datarootdir"
(fun () -> s_ "Read-only arch-independent data root")
(fun () -> "$prefix"/"share")
let datadir =
p "datadir"
(fun () -> s_ "Read-only architecture-independent data")
(fun () -> "$datarootdir")
let infodir =
p "infodir"
(fun () -> s_ "Info documentation")
(fun () -> "$datarootdir"/"info")
let localedir =
p "localedir"
(fun () -> s_ "Locale-dependent data")
(fun () -> "$datarootdir"/"locale")
let mandir =
p "mandir"
(fun () -> s_ "Man documentation")
(fun () -> "$datarootdir"/"man")
let docdir =
p "docdir"
(fun () -> s_ "Documentation root")
(fun () -> "$datarootdir"/"doc"/"$pkg_name")
let htmldir =
p "htmldir"
(fun () -> s_ "HTML documentation")
(fun () -> "$docdir")
let dvidir =
p "dvidir"
(fun () -> s_ "DVI documentation")
(fun () -> "$docdir")
let pdfdir =
p "pdfdir"
(fun () -> s_ "PDF documentation")
(fun () -> "$docdir")
let psdir =
p "psdir"
(fun () -> s_ "PS documentation")
(fun () -> "$docdir")
let destdir =
p "destdir"
(fun () -> s_ "Prepend a path when installing package")
(fun () ->
raise
(PropList.Not_set
("destdir",
Some (s_ "undefined by construct"))))
let findlib_version =
var_define
"findlib_version"
(fun () ->
BaseCheck.package_version "findlib")
let is_native =
var_define
"is_native"
(fun () ->
try
let _s: string =
ocamlopt ()
in
"true"
with PropList.Not_set _ ->
let _s: string =
ocamlc ()
in
"false")
let ext_program =
var_define
"suffix_program"
(fun () ->
match os_type () with
| "Win32" | "Cygwin" -> ".exe"
| _ -> "")
let rm =
var_define
~short_desc:(fun () -> s_ "Remove a file.")
"rm"
(fun () ->
match os_type () with
| "Win32" -> "del"
| _ -> "rm -f")
let rmdir =
var_define
~short_desc:(fun () -> s_ "Remove a directory.")
"rmdir"
(fun () ->
match os_type () with
| "Win32" -> "rd"
| _ -> "rm -rf")
let debug =
var_define
~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
~cli:CLIEnable
"debug"
(fun () -> "true")
let profile =
var_define
~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
~cli:CLIEnable
"profile"
(fun () -> "false")
let tests =
var_define_cond ~since_version:"0.3"
(fun () ->
var_define
~short_desc:(fun () ->
s_ "Compile tests executable and library and run them")
~cli:CLIEnable
"tests"
(fun () -> "false"))
"true"
let docs =
var_define_cond ~since_version:"0.3"
(fun () ->
var_define
~short_desc:(fun () -> s_ "Create documentations")
~cli:CLIEnable
"docs"
(fun () -> "true"))
"true"
let native_dynlink =
var_define
~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
~cli:CLINone
"native_dynlink"
(fun () ->
let res =
let ocaml_lt_312 () =
OASISVersion.comparator_apply
(OASISVersion.version_of_string (ocaml_version ()))
(OASISVersion.VLesser
(OASISVersion.version_of_string "3.12.0"))
in
let flexdll_lt_030 () =
OASISVersion.comparator_apply
(OASISVersion.version_of_string (flexdll_version ()))
(OASISVersion.VLesser
(OASISVersion.version_of_string "0.30"))
in
let has_native_dynlink =
let ocamlfind = ocamlfind () in
try
let fn =
OASISExec.run_read_one_line
~ctxt:!BaseContext.default
ocamlfind
["query"; "-predicates"; "native"; "dynlink";
"-format"; "%d/%a"]
in
Sys.file_exists fn
with _ ->
false
in
if not has_native_dynlink then
false
else if ocaml_lt_312 () then
false
else if (os_type () = "Win32" || os_type () = "Cygwin")
&& flexdll_lt_030 () then
begin
BaseMessage.warning
(f_ ".cmxs generation disabled because FlexDLL needs to be \
at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
(flexdll_version ());
false
end
else
true
in
string_of_bool res)
let init pkg =
rpkg := Some pkg;
List.iter (fun f -> f pkg.oasis_version) !var_cond
end
module BaseFileAB = struct
(* # 22 "src/base/BaseFileAB.ml" *)
open BaseEnv
open OASISGettext
open BaseMessage
open OASISContext
let to_filename fn =
if not (Filename.check_suffix fn ".ab") then
warning (f_ "File '%s' doesn't have '.ab' extension") fn;
OASISFileSystem.of_unix_filename (Filename.chop_extension fn)
let replace ~ctxt fn_lst =
let open OASISFileSystem in
let ibuf, obuf = Buffer.create 13, Buffer.create 13 in
List.iter
(fun fn ->
Buffer.clear ibuf; Buffer.clear obuf;
defer_close
(ctxt.srcfs#open_in (of_unix_filename fn))
(read_all ibuf);
Buffer.add_string obuf (var_expand (Buffer.contents ibuf));
defer_close
(ctxt.srcfs#open_out (to_filename fn))
(fun wrtr -> wrtr#output obuf))
fn_lst
end
module BaseLog = struct
(* # 22 "src/base/BaseLog.ml" *)
open OASISUtils
open OASISContext
open OASISGettext
open OASISFileSystem
let default_filename = in_srcdir "setup.log"
let load ~ctxt () =
let module SetTupleString =
Set.Make
(struct
type t = string * string
let compare (s11, s12) (s21, s22) =
match String.compare s11 s21 with
| 0 -> String.compare s12 s22
| n -> n
end)
in
if ctxt.srcfs#file_exists default_filename then begin
defer_close
(ctxt.srcfs#open_in default_filename)
(fun rdr ->
let line = ref 1 in
let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in
let rec read_aux (st, lst) =
match Stream.npeek 2 lxr with
| [Genlex.String e; Genlex.String d] ->
let t = e, d in
Stream.junk lxr; Stream.junk lxr;
if SetTupleString.mem t st then
read_aux (st, lst)
else
read_aux (SetTupleString.add t st, t :: lst)
| [] -> List.rev lst
| _ ->
failwithf
(f_ "Malformed log file '%s' at line %d")
(ctxt.srcfs#string_of_filename default_filename)
!line
in
read_aux (SetTupleString.empty, []))
end else begin
[]
end
let register ~ctxt event data =
defer_close
(ctxt.srcfs#open_out
~mode:[Open_append; Open_creat; Open_text]
~perm:0o644
default_filename)
(fun wrtr ->
let buf = Buffer.create 13 in
Printf.bprintf buf "%S %S\n" event data;
wrtr#output buf)
let unregister ~ctxt event data =
let lst = load ~ctxt () in
let buf = Buffer.create 13 in
List.iter
(fun (e, d) ->
if e <> event || d <> data then
Printf.bprintf buf "%S %S\n" e d)
lst;
if Buffer.length buf > 0 then
defer_close
(ctxt.srcfs#open_out default_filename)
(fun wrtr -> wrtr#output buf)
else
ctxt.srcfs#remove default_filename
let filter ~ctxt events =
let st_events = SetString.of_list events in
List.filter
(fun (e, _) -> SetString.mem e st_events)
(load ~ctxt ())
let exists ~ctxt event data =
List.exists
(fun v -> (event, data) = v)
(load ~ctxt ())
end
module BaseBuilt = struct
(* # 22 "src/base/BaseBuilt.ml" *)
open OASISTypes
open OASISGettext
open BaseStandardVar
open BaseMessage
type t =
| BExec (* Executable *)
| BExecLib (* Library coming with executable *)
| BLib (* Library *)
| BObj (* Library *)
| BDoc (* Document *)
let to_log_event_file t nm =
"built_"^
(match t with
| BExec -> "exec"
| BExecLib -> "exec_lib"
| BLib -> "lib"
| BObj -> "obj"
| BDoc -> "doc")^
"_"^nm
let to_log_event_done t nm =
"is_"^(to_log_event_file t nm)
let register ~ctxt t nm lst =
BaseLog.register ~ctxt (to_log_event_done t nm) "true";
List.iter
(fun alt ->
let registered =
List.fold_left
(fun registered fn ->
if OASISFileUtil.file_exists_case fn then begin
BaseLog.register ~ctxt
(to_log_event_file t nm)
(if Filename.is_relative fn then
Filename.concat (Sys.getcwd ()) fn
else
fn);
true
end else begin
registered
end)
false
alt
in
if not registered then
warning
(f_ "Cannot find an existing alternative files among: %s")
(String.concat (s_ ", ") alt))
lst
let unregister ~ctxt t nm =
List.iter
(fun (e, d) -> BaseLog.unregister ~ctxt e d)
(BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])
let fold ~ctxt t nm f acc =
List.fold_left
(fun acc (_, fn) ->
if OASISFileUtil.file_exists_case fn then begin
f acc fn
end else begin
warning
(f_ "File '%s' has been marked as built \
for %s but doesn't exist")
fn
(Printf.sprintf
(match t with
| BExec | BExecLib -> (f_ "executable %s")
| BLib -> (f_ "library %s")
| BObj -> (f_ "object %s")
| BDoc -> (f_ "documentation %s"))
nm);
acc
end)
acc
(BaseLog.filter ~ctxt [to_log_event_file t nm])
let is_built ~ctxt t nm =
List.fold_left
(fun _ (_, d) -> try bool_of_string d with _ -> false)
false
(BaseLog.filter ~ctxt [to_log_event_done t nm])
let of_executable ffn (cs, bs, exec) =
let unix_exec_is, unix_dll_opt =
OASISExecutable.unix_exec_is
(cs, bs, exec)
(fun () ->
bool_of_string
(is_native ()))
ext_dll
ext_program
in
let evs =
(BExec, cs.cs_name, [[ffn unix_exec_is]])
::
(match unix_dll_opt with
| Some fn ->
[BExecLib, cs.cs_name, [[ffn fn]]]
| None ->
[])
in
evs,
unix_exec_is,
unix_dll_opt
let of_library ffn (cs, bs, lib) =
let unix_lst =
OASISLibrary.generated_unix_files
~ctxt:!BaseContext.default
~source_file_exists:(fun fn ->
OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
~is_native:(bool_of_string (is_native ()))
~has_native_dynlink:(bool_of_string (native_dynlink ()))
~ext_lib:(ext_lib ())
~ext_dll:(ext_dll ())
(cs, bs, lib)
in
let evs =
[BLib,
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
evs, unix_lst
let of_object ffn (cs, bs, obj) =
let unix_lst =
OASISObject.generated_unix_files
~ctxt:!BaseContext.default
~source_file_exists:(fun fn ->
OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
~is_native:(bool_of_string (is_native ()))
(cs, bs, obj)
in
let evs =
[BObj,
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
evs, unix_lst
end
module BaseCustom = struct
(* # 22 "src/base/BaseCustom.ml" *)
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
let run cmd args extra_args =
OASISExec.run ~ctxt:!BaseContext.default ~quote:false
(var_expand cmd)
(List.map
var_expand
(args @ (Array.to_list extra_args)))
let hook ?(failsafe=false) cstm f e =
let optional_command lst =
let printer =
function
| Some (cmd, args) -> String.concat " " (cmd :: args)
| None -> s_ "No command"
in
match
var_choose
~name:(s_ "Pre/Post Command")
~printer
lst with
| Some (cmd, args) ->
begin
try
run cmd args [||]
with e when failsafe ->
warning
(f_ "Command '%s' fail with error: %s")
(String.concat " " (cmd :: args))
(match e with
| Failure msg -> msg
| e -> Printexc.to_string e)
end
| None ->
()
in
let res =
optional_command cstm.pre_command;
f e
in
optional_command cstm.post_command;
res
end
module BaseDynVar = struct
(* # 22 "src/base/BaseDynVar.ml" *)
open OASISTypes
open OASISGettext
open BaseEnv
open BaseBuilt
let init ~ctxt pkg =
(* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
(* TODO: provide compile option for library libary_byte_args_VARNAME... *)
List.iter
(function
| Executable (cs, bs, _) ->
if var_choose bs.bs_build then
var_ignore
(var_redefine
(* We don't save this variable *)
~dump:false
~short_desc:(fun () ->
Printf.sprintf
(f_ "Filename of executable '%s'")
cs.cs_name)
(OASISUtils.varname_of_string cs.cs_name)
(fun () ->
let fn_opt =
fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None
in
match fn_opt with
| Some fn -> fn
| None ->
raise
(PropList.Not_set
(cs.cs_name,
Some (Printf.sprintf
(f_ "Executable '%s' not yet built.")
cs.cs_name)))))
| Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
())
pkg.sections
end
module BaseTest = struct
(* # 22 "src/base/BaseTest.ml" *)
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
let test ~ctxt lst pkg extra_args =
let one_test (failure, n) (test_plugin, cs, test) =
if var_choose
~name:(Printf.sprintf
(f_ "test %s run")
cs.cs_name)
~printer:string_of_bool
test.test_run then
begin
let () = info (f_ "Running test '%s'") cs.cs_name in
let back_cwd =
match test.test_working_directory with
| Some dir ->
let cwd = Sys.getcwd () in
let chdir d =
info (f_ "Changing directory to '%s'") d;
Sys.chdir d
in
chdir dir;
fun () -> chdir cwd
| None ->
fun () -> ()
in
try
let failure_percent =
BaseCustom.hook
test.test_custom
(test_plugin ~ctxt pkg (cs, test))
extra_args
in
back_cwd ();
(failure_percent +. failure, n + 1)
with e ->
begin
back_cwd ();
raise e
end
end
else
begin
info (f_ "Skipping test '%s'") cs.cs_name;
(failure, n)
end
in
let failed, n = List.fold_left one_test (0.0, 0) lst in
let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in
let msg =
Printf.sprintf
(f_ "Tests had a %.2f%% failure rate")
(100. *. failure_percent)
in
if failure_percent > 0.0 then
failwith msg
else
info "%s" msg;
(* Possible explanation why the tests where not run. *)
if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
not (bool_of_string (BaseStandardVar.tests ())) &&
lst <> [] then
BaseMessage.warning
"Tests are turned off, consider enabling with \
'ocaml setup.ml -configure --enable-tests'"
end
module BaseDoc = struct
(* # 22 "src/base/BaseDoc.ml" *)
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
let doc ~ctxt lst pkg extra_args =
let one_doc (doc_plugin, cs, doc) =
if var_choose
~name:(Printf.sprintf
(f_ "documentation %s build")
cs.cs_name)
~printer:string_of_bool
doc.doc_build then
begin
info (f_ "Building documentation '%s'") cs.cs_name;
BaseCustom.hook
doc.doc_custom
(doc_plugin ~ctxt pkg (cs, doc))
extra_args
end
in
List.iter one_doc lst;
if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
not (bool_of_string (BaseStandardVar.docs ())) &&
lst <> [] then
BaseMessage.warning
"Docs are turned off, consider enabling with \
'ocaml setup.ml -configure --enable-docs'"
end
module BaseSetup = struct
(* # 22 "src/base/BaseSetup.ml" *)
open OASISContext
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
open OASISUtils
type std_args_fun =
ctxt:OASISContext.t -> package -> string array -> unit
type ('a, 'b) section_args_fun =
name *
(ctxt:OASISContext.t ->
package ->
(common_section * 'a) ->
string array ->
'b)
type t =
{
configure: std_args_fun;
build: std_args_fun;
doc: ((doc, unit) section_args_fun) list;
test: ((test, float) section_args_fun) list;
install: std_args_fun;
uninstall: std_args_fun;
clean: std_args_fun list;
clean_doc: (doc, unit) section_args_fun list;
clean_test: (test, unit) section_args_fun list;
distclean: std_args_fun list;
distclean_doc: (doc, unit) section_args_fun list;
distclean_test: (test, unit) section_args_fun list;
package: package;
oasis_fn: string option;
oasis_version: string;
oasis_digest: Digest.t option;
oasis_exec: string option;
oasis_setup_args: string list;
setup_update: bool;
}
(* Associate a plugin function with data from package *)
let join_plugin_sections filter_map lst =
List.rev
(List.fold_left
(fun acc sct ->
match filter_map sct with
| Some e ->
e :: acc
| None ->
acc)
[]
lst)
(* Search for plugin data associated with a section name *)
let lookup_plugin_section plugin action nm lst =
try
List.assoc nm lst
with Not_found ->
failwithf
(f_ "Cannot find plugin %s matching section %s for %s action")
plugin
nm
action
let configure ~ctxt t args =
(* Run configure *)
BaseCustom.hook
t.package.conf_custom
(fun () ->
(* Reload if preconf has changed it *)
begin
try
unload ();
load ~ctxt ();
with _ ->
()
end;
(* Run plugin's configure *)
t.configure ~ctxt t.package args;
(* Dump to allow postconf to change it *)
dump ~ctxt ())
();
(* Reload environment *)
unload ();
load ~ctxt ();
(* Save environment *)
print ();
(* Replace data in file *)
BaseFileAB.replace ~ctxt t.package.files_ab
let build ~ctxt t args =
BaseCustom.hook
t.package.build_custom
(t.build ~ctxt t.package)
args
let doc ~ctxt t args =
BaseDoc.doc
~ctxt
(join_plugin_sections
(function
| Doc (cs, e) ->
Some
(lookup_plugin_section
"documentation"
(s_ "build")
cs.cs_name
t.doc,
cs,
e)
| _ ->
None)
t.package.sections)
t.package
args
let test ~ctxt t args =
BaseTest.test
~ctxt
(join_plugin_sections
(function
| Test (cs, e) ->
Some
(lookup_plugin_section
"test"
(s_ "run")
cs.cs_name
t.test,
cs,
e)
| _ ->
None)
t.package.sections)
t.package
args
let all ~ctxt t args =
let rno_doc = ref false in
let rno_test = ref false in
let arg_rest = ref [] in
Arg.parse_argv
~current:(ref 0)
(Array.of_list
((Sys.executable_name^" all") ::
(Array.to_list args)))
[
"-no-doc",
Arg.Set rno_doc,
s_ "Don't run doc target";
"-no-test",
Arg.Set rno_test,
s_ "Don't run test target";
"--",
Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
s_ "All arguments for configure.";
]
(failwithf (f_ "Don't know what to do with '%s'"))
"";
info "Running configure step";
configure ~ctxt t (Array.of_list (List.rev !arg_rest));
info "Running build step";
build ~ctxt t [||];
(* Load setup.log dynamic variables *)
BaseDynVar.init ~ctxt t.package;
if not !rno_doc then begin
info "Running doc step";
doc ~ctxt t [||]
end else begin
info "Skipping doc step"
end;
if not !rno_test then begin
info "Running test step";
test ~ctxt t [||]
end else begin
info "Skipping test step"
end
let install ~ctxt t args =
BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args
let uninstall ~ctxt t args =
BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args
let reinstall ~ctxt t args =
uninstall ~ctxt t args;
install ~ctxt t args
let clean, distclean =
let failsafe f a =
try
f a
with e ->
warning
(f_ "Action fail with error: %s")
(match e with
| Failure msg -> msg
| e -> Printexc.to_string e)
in
let generic_clean ~ctxt t cstm mains docs tests args =
BaseCustom.hook
~failsafe:true
cstm
(fun () ->
(* Clean section *)
List.iter
(function
| Test (cs, test) ->
let f =
try
List.assoc cs.cs_name tests
with Not_found ->
fun ~ctxt:_ _ _ _ -> ()
in
failsafe (f ~ctxt t.package (cs, test)) args
| Doc (cs, doc) ->
let f =
try
List.assoc cs.cs_name docs
with Not_found ->
fun ~ctxt:_ _ _ _ -> ()
in
failsafe (f ~ctxt t.package (cs, doc)) args
| Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ())
t.package.sections;
(* Clean whole package *)
List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)
()
in
let clean ~ctxt t args =
generic_clean
~ctxt
t
t.package.clean_custom
t.clean
t.clean_doc
t.clean_test
args
in
let distclean ~ctxt t args =
(* Call clean *)
clean ~ctxt t args;
(* Call distclean code *)
generic_clean
~ctxt
t
t.package.distclean_custom
t.distclean
t.distclean_doc
t.distclean_test
args;
(* Remove generated source files. *)
List.iter
(fun fn ->
if ctxt.srcfs#file_exists fn then begin
info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn);
ctxt.srcfs#remove fn
end)
([BaseEnv.default_filename; BaseLog.default_filename]
@ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
in
clean, distclean
let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version
let update_setup_ml, no_update_setup_ml_cli =
let b = ref true in
b,
("-no-update-setup-ml",
Arg.Clear b,
s_ " Don't try to update setup.ml, even if _oasis has changed.")
(* TODO: srcfs *)
let default_oasis_fn = "_oasis"
let update_setup_ml t =
let oasis_fn =
match t.oasis_fn with
| Some fn -> fn
| None -> default_oasis_fn
in
let oasis_exec =
match t.oasis_exec with
| Some fn -> fn
| None -> "oasis"
in
let ocaml =
Sys.executable_name
in
let setup_ml, args =
match Array.to_list Sys.argv with
| setup_ml :: args ->
setup_ml, args
| [] ->
failwith
(s_ "Expecting non-empty command line arguments.")
in
let ocaml, setup_ml =
if Sys.executable_name = Sys.argv.(0) then
(* We are not running in standard mode, probably the script
* is precompiled.
*)
"ocaml", "setup.ml"
else
ocaml, setup_ml
in
let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in
let do_update () =
let oasis_exec_version =
OASISExec.run_read_one_line
~ctxt:!BaseContext.default
~f_exit_code:
(function
| 0 ->
()
| 1 ->
failwithf
(f_ "Executable '%s' is probably an old version \
of oasis (< 0.3.0), please update to version \
v%s.")
oasis_exec t.oasis_version
| 127 ->
failwithf
(f_ "Cannot find executable '%s', please install \
oasis v%s.")
oasis_exec t.oasis_version
| n ->
failwithf
(f_ "Command '%s version' exited with code %d.")
oasis_exec n)
oasis_exec ["version"]
in
if OASISVersion.comparator_apply
(OASISVersion.version_of_string oasis_exec_version)
(OASISVersion.VGreaterEqual
(OASISVersion.version_of_string t.oasis_version)) then
begin
(* We have a version >= for the executable oasis, proceed with
* update.
*)
(* TODO: delegate this check to 'oasis setup'. *)
if Sys.os_type = "Win32" then
failwithf
(f_ "It is not possible to update the running script \
setup.ml on Windows. Please update setup.ml by \
running '%s'.")
(String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
else
begin
OASISExec.run
~ctxt:!BaseContext.default
~f_exit_code:
(fun n ->
if n <> 0 then
failwithf
(f_ "Unable to update setup.ml using '%s', \
please fix the problem and retry.")
oasis_exec)
oasis_exec ("setup" :: t.oasis_setup_args);
OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
end
end
else
failwithf
(f_ "The version of '%s' (v%s) doesn't match the version of \
oasis used to generate the %s file. Please install at \
least oasis v%s.")
oasis_exec oasis_exec_version setup_ml t.oasis_version
in
if !update_setup_ml then
begin
try
match t.oasis_digest with
| Some dgst ->
if Sys.file_exists oasis_fn &&
dgst <> Digest.file default_oasis_fn then
begin
do_update ();
true
end
else
false
| None ->
false
with e ->
error
(f_ "Error when updating setup.ml. If you want to avoid this error, \
you can bypass the update of %s by running '%s %s %s %s'")
setup_ml ocaml setup_ml no_update_setup_ml_cli
(String.concat " " args);
raise e
end
else
false
let setup t =
let catch_exn = ref true in
let act_ref =
ref (fun ~ctxt:_ _ ->
failwithf
(f_ "No action defined, run '%s %s -help'")
Sys.executable_name
Sys.argv.(0))
in
let extra_args_ref = ref [] in
let allow_empty_env_ref = ref false in
let arg_handle ?(allow_empty_env=false) act =
Arg.Tuple
[
Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
Arg.Unit
(fun () ->
allow_empty_env_ref := allow_empty_env;
act_ref := act);
]
in
try
let () =
Arg.parse
(Arg.align
([
"-configure",
arg_handle ~allow_empty_env:true configure,
s_ "[options*] Configure the whole build process.";
"-build",
arg_handle build,
s_ "[options*] Build executables and libraries.";
"-doc",
arg_handle doc,
s_ "[options*] Build documents.";
"-test",
arg_handle test,
s_ "[options*] Run tests.";
"-all",
arg_handle ~allow_empty_env:true all,
s_ "[options*] Run configure, build, doc and test targets.";
"-install",
arg_handle install,
s_ "[options*] Install libraries, data, executables \
and documents.";
"-uninstall",
arg_handle uninstall,
s_ "[options*] Uninstall libraries, data, executables \
and documents.";
"-reinstall",
arg_handle reinstall,
s_ "[options*] Uninstall and install libraries, data, \
executables and documents.";
"-clean",
arg_handle ~allow_empty_env:true clean,
s_ "[options*] Clean files generated by a build.";
"-distclean",
arg_handle ~allow_empty_env:true distclean,
s_ "[options*] Clean files generated by a build and configure.";
"-version",
arg_handle ~allow_empty_env:true version,
s_ " Display version of OASIS used to generate this setup.ml.";
"-no-catch-exn",
Arg.Clear catch_exn,
s_ " Don't catch exception, useful for debugging.";
]
@
(if t.setup_update then
[no_update_setup_ml_cli]
else
[])
@ (BaseContext.args ())))
(failwithf (f_ "Don't know what to do with '%s'"))
(s_ "Setup and run build process current package\n")
in
(* Instantiate the context. *)
let ctxt = !BaseContext.default in
(* Build initial environment *)
load ~ctxt ~allow_empty:!allow_empty_env_ref ();
(** Initialize flags *)
List.iter
(function
| Flag (cs, {flag_description = hlp;
flag_default = choices}) ->
begin
let apply ?short_desc () =
var_ignore
(var_define
~cli:CLIEnable
?short_desc
(OASISUtils.varname_of_string cs.cs_name)
(fun () ->
string_of_bool
(var_choose
~name:(Printf.sprintf
(f_ "default value of flag %s")
cs.cs_name)
~printer:string_of_bool
choices)))
in
match hlp with
| Some hlp -> apply ~short_desc:(fun () -> hlp) ()
| None -> apply ()
end
| _ ->
())
t.package.sections;
BaseStandardVar.init t.package;
BaseDynVar.init ~ctxt t.package;
if not (t.setup_update && update_setup_ml t) then
!act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))
with e when !catch_exn ->
error "%s" (Printexc.to_string e);
exit 1
end
module BaseCompat = struct
(* # 22 "src/base/BaseCompat.ml" *)
(** Compatibility layer to provide a stable API inside setup.ml.
This layer allows OASIS to change in between minor versions
(e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This
enables to write functions that manipulate setup_t inside setup.ml. See
deps.ml for an example.
The module opened by default will depend on the version of the _oasis. E.g.
if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and
the function Compat_0_3 will be called. If setup.ml is generated with the
-nocompat, no module will be opened.
@author Sylvain Le Gall
*)
module Compat_0_4 =
struct
let rctxt = ref !BaseContext.default
module BaseSetup =
struct
module Original = BaseSetup
open OASISTypes
type std_args_fun = package -> string array -> unit
type ('a, 'b) section_args_fun =
name * (package -> (common_section * 'a) -> string array -> 'b)
type t =
{
configure: std_args_fun;
build: std_args_fun;
doc: ((doc, unit) section_args_fun) list;
test: ((test, float) section_args_fun) list;
install: std_args_fun;
uninstall: std_args_fun;
clean: std_args_fun list;
clean_doc: (doc, unit) section_args_fun list;
clean_test: (test, unit) section_args_fun list;
distclean: std_args_fun list;
distclean_doc: (doc, unit) section_args_fun list;
distclean_test: (test, unit) section_args_fun list;
package: package;
oasis_fn: string option;
oasis_version: string;
oasis_digest: Digest.t option;
oasis_exec: string option;
oasis_setup_args: string list;
setup_update: bool;
}
let setup t =
let mk_std_args_fun f =
fun ~ctxt pkg args -> rctxt := ctxt; f pkg args
in
let mk_section_args_fun l =
List.map
(fun (nm, f) ->
nm,
(fun ~ctxt pkg sct args ->
rctxt := ctxt;
f pkg sct args))
l
in
let t' =
{
Original.
configure = mk_std_args_fun t.configure;
build = mk_std_args_fun t.build;
doc = mk_section_args_fun t.doc;
test = mk_section_args_fun t.test;
install = mk_std_args_fun t.install;
uninstall = mk_std_args_fun t.uninstall;
clean = List.map mk_std_args_fun t.clean;
clean_doc = mk_section_args_fun t.clean_doc;
clean_test = mk_section_args_fun t.clean_test;
distclean = List.map mk_std_args_fun t.distclean;
distclean_doc = mk_section_args_fun t.distclean_doc;
distclean_test = mk_section_args_fun t.distclean_test;
package = t.package;
oasis_fn = t.oasis_fn;
oasis_version = t.oasis_version;
oasis_digest = t.oasis_digest;
oasis_exec = t.oasis_exec;
oasis_setup_args = t.oasis_setup_args;
setup_update = t.setup_update;
}
in
Original.setup t'
end
let adapt_setup_t setup_t =
let module O = BaseSetup.Original in
let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in
let mk_section_args_fun l =
List.map
(fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))
l
in
{
BaseSetup.
configure = mk_std_args_fun setup_t.O.configure;
build = mk_std_args_fun setup_t.O.build;
doc = mk_section_args_fun setup_t.O.doc;
test = mk_section_args_fun setup_t.O.test;
install = mk_std_args_fun setup_t.O.install;
uninstall = mk_std_args_fun setup_t.O.uninstall;
clean = List.map mk_std_args_fun setup_t.O.clean;
clean_doc = mk_section_args_fun setup_t.O.clean_doc;
clean_test = mk_section_args_fun setup_t.O.clean_test;
distclean = List.map mk_std_args_fun setup_t.O.distclean;
distclean_doc = mk_section_args_fun setup_t.O.distclean_doc;
distclean_test = mk_section_args_fun setup_t.O.distclean_test;
package = setup_t.O.package;
oasis_fn = setup_t.O.oasis_fn;
oasis_version = setup_t.O.oasis_version;
oasis_digest = setup_t.O.oasis_digest;
oasis_exec = setup_t.O.oasis_exec;
oasis_setup_args = setup_t.O.oasis_setup_args;
setup_update = setup_t.O.setup_update;
}
end
module Compat_0_3 =
struct
include Compat_0_4
end
end
# 5662 "setup.ml"
module InternalConfigurePlugin = struct
(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
(** Configure using internal scheme
@author Sylvain Le Gall
*)
open BaseEnv
open OASISTypes
open OASISUtils
open OASISGettext
open BaseMessage
(** Configure build using provided series of check to be done
and then output corresponding file.
*)
let configure ~ctxt:_ pkg argv =
let var_ignore_eval var = let _s: string = var () in () in
let errors = ref SetString.empty in
let buff = Buffer.create 13 in
let add_errors fmt =
Printf.kbprintf
(fun b ->
errors := SetString.add (Buffer.contents b) !errors;
Buffer.clear b)
buff
fmt
in
let warn_exception e =
warning "%s" (Printexc.to_string e)
in
(* Check tools *)
let check_tools lst =
List.iter
(function
| ExternalTool tool ->
begin
try
var_ignore_eval (BaseCheck.prog tool)
with e ->
warn_exception e;
add_errors (f_ "Cannot find external tool '%s'") tool
end
| InternalExecutable nm1 ->
(* Check that matching tool is built *)
List.iter
(function
| Executable ({cs_name = nm2; _},
{bs_build = build; _},
_) when nm1 = nm2 ->
if not (var_choose build) then
add_errors
(f_ "Cannot find buildable internal executable \
'%s' when checking build depends")
nm1
| _ ->
())
pkg.sections)
lst
in
let build_checks sct bs =
if var_choose bs.bs_build then
begin
if bs.bs_compiled_object = Native then
begin
try
var_ignore_eval BaseStandardVar.ocamlopt
with e ->
warn_exception e;
add_errors
(f_ "Section %s requires native compilation")
(OASISSection.string_of_section sct)
end;
(* Check tools *)
check_tools bs.bs_build_tools;
(* Check depends *)
List.iter
(function
| FindlibPackage (findlib_pkg, version_comparator) ->
begin
try
var_ignore_eval
(BaseCheck.package ?version_comparator findlib_pkg)
with e ->
warn_exception e;
match version_comparator with
| None ->
add_errors
(f_ "Cannot find findlib package %s")
findlib_pkg
| Some ver_cmp ->
add_errors
(f_ "Cannot find findlib package %s (%s)")
findlib_pkg
(OASISVersion.string_of_comparator ver_cmp)
end
| InternalLibrary nm1 ->
(* Check that matching library is built *)
List.iter
(function
| Library ({cs_name = nm2; _},
{bs_build = build; _},
_) when nm1 = nm2 ->
if not (var_choose build) then
add_errors
(f_ "Cannot find buildable internal library \
'%s' when checking build depends")
nm1
| _ ->
())
pkg.sections)
bs.bs_build_depends
end
in
(* Parse command line *)
BaseArgExt.parse argv (BaseEnv.args ());
(* OCaml version *)
begin
match pkg.ocaml_version with
| Some ver_cmp ->
begin
try
var_ignore_eval
(BaseCheck.version
"ocaml"
ver_cmp
BaseStandardVar.ocaml_version)
with e ->
warn_exception e;
add_errors
(f_ "OCaml version %s doesn't match version constraint %s")
(BaseStandardVar.ocaml_version ())
(OASISVersion.string_of_comparator ver_cmp)
end
| None ->
()
end;
(* Findlib version *)
begin
match pkg.findlib_version with
| Some ver_cmp ->
begin
try
var_ignore_eval
(BaseCheck.version
"findlib"
ver_cmp
BaseStandardVar.findlib_version)
with e ->
warn_exception e;
add_errors
(f_ "Findlib version %s doesn't match version constraint %s")
(BaseStandardVar.findlib_version ())
(OASISVersion.string_of_comparator ver_cmp)
end
| None ->
()
end;
(* Make sure the findlib version is fine for the OCaml compiler. *)
begin
let ocaml_ge4 =
OASISVersion.version_compare
(OASISVersion.version_of_string (BaseStandardVar.ocaml_version ()))
(OASISVersion.version_of_string "4.0.0") >= 0 in
if ocaml_ge4 then
let findlib_lt132 =
OASISVersion.version_compare
(OASISVersion.version_of_string (BaseStandardVar.findlib_version()))
(OASISVersion.version_of_string "1.3.2") < 0 in
if findlib_lt132 then
add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2"
end;
(* FlexDLL *)
if BaseStandardVar.os_type () = "Win32" ||
BaseStandardVar.os_type () = "Cygwin" then
begin
try
var_ignore_eval BaseStandardVar.flexlink
with e ->
warn_exception e;
add_errors (f_ "Cannot find 'flexlink'")
end;
(* Check build depends *)
List.iter
(function
| Executable (_, bs, _)
| Library (_, bs, _) as sct ->
build_checks sct bs
| Doc (_, doc) ->
if var_choose doc.doc_build then
check_tools doc.doc_build_tools
| Test (_, test) ->
if var_choose test.test_run then
check_tools test.test_tools
| _ ->
())
pkg.sections;
(* Check if we need native dynlink (presence of libraries that compile to
native)
*)
begin
let has_cmxa =
List.exists
(function
| Library (_, bs, _) ->
var_choose bs.bs_build &&
(bs.bs_compiled_object = Native ||
(bs.bs_compiled_object = Best &&
bool_of_string (BaseStandardVar.is_native ())))
| _ ->
false)
pkg.sections
in
if has_cmxa then
var_ignore_eval BaseStandardVar.native_dynlink
end;
(* Check errors *)
if SetString.empty != !errors then
begin
List.iter
(fun e -> error "%s" e)
(SetString.elements !errors);
failwithf
(fn_
"%d configuration error"
"%d configuration errors"
(SetString.cardinal !errors))
(SetString.cardinal !errors)
end
end
module InternalInstallPlugin = struct
(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *)
(** Install using internal scheme
@author Sylvain Le Gall
*)
(* TODO: rewrite this module with OASISFileSystem. *)
open BaseEnv
open BaseStandardVar
open BaseMessage
open OASISTypes
open OASISFindlib
open OASISGettext
open OASISUtils
let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)
let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])
let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])
let doc_hook = ref (fun (cs, doc) -> cs, doc)
let install_file_ev = "install-file"
let install_dir_ev = "install-dir"
let install_findlib_ev = "install-findlib"
(* TODO: this can be more generic and used elsewhere. *)
let win32_max_command_line_length = 8000
let split_install_command ocamlfind findlib_name meta files =
if Sys.os_type = "Win32" then
(* Arguments for the first command: *)
let first_args = ["install"; findlib_name; meta] in
(* Arguments for remaining commands: *)
let other_args = ["install"; findlib_name; "-add"] in
(* Extract as much files as possible from [files], [len] is
the current command line length: *)
let rec get_files len acc files =
match files with
| [] ->
(List.rev acc, [])
| file :: rest ->
let len = len + 1 + String.length file in
if len > win32_max_command_line_length then
(List.rev acc, files)
else
get_files len (file :: acc) rest
in
(* Split the command into several commands. *)
let rec split args files =
match files with
| [] ->
[]
| _ ->
(* Length of "ocamlfind install <lib> [META|-add]" *)
let len =
List.fold_left
(fun len arg ->
len + 1 (* for the space *) + String.length arg)
(String.length ocamlfind)
args
in
match get_files len [] files with
| ([], _) ->
failwith (s_ "Command line too long.")
| (firsts, others) ->
let cmd = args @ firsts in
(* Use -add for remaining commands: *)
let () =
let findlib_ge_132 =
OASISVersion.comparator_apply
(OASISVersion.version_of_string
(BaseStandardVar.findlib_version ()))
(OASISVersion.VGreaterEqual
(OASISVersion.version_of_string "1.3.2"))
in
if not findlib_ge_132 then
failwithf
(f_ "Installing the library %s require to use the \
flag '-add' of ocamlfind because the command \
line is too long. This flag is only available \
for findlib 1.3.2. Please upgrade findlib from \
%s to 1.3.2")
findlib_name (BaseStandardVar.findlib_version ())
in
let cmds = split other_args others in
cmd :: cmds
in
(* The first command does not use -add: *)
split first_args files
else
["install" :: findlib_name :: meta :: files]
let install =
let in_destdir fn =
try
(* Practically speaking destdir is prepended at the beginning of the
target filename
*)
(destdir ())^fn
with PropList.Not_set _ ->
fn
in
let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
let tgt_dir =
if prepend_destdir then in_destdir (envdir ()) else envdir ()
in
let tgt_file =
Filename.concat
tgt_dir
(match tgt_fn with
| Some fn ->
fn
| None ->
Filename.basename src_file)
in
(* Create target directory if needed *)
OASISFileUtil.mkdir_parent
~ctxt
(fun dn ->
info (f_ "Creating directory '%s'") dn;
BaseLog.register ~ctxt install_dir_ev dn)
(Filename.dirname tgt_file);
(* Really install files *)
info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
OASISFileUtil.cp ~ctxt src_file tgt_file;
BaseLog.register ~ctxt install_file_ev tgt_file
in
(* Install the files for a library. *)
let install_lib_files ~ctxt findlib_name files =
let findlib_dir =
let dn =
let findlib_destdir =
OASISExec.run_read_one_line ~ctxt (ocamlfind ())
["printconf" ; "destdir"]
in
Filename.concat findlib_destdir findlib_name
in
fun () -> dn
in
let () =
if not (OASISFileUtil.file_exists_case (findlib_dir ())) then
failwithf
(f_ "Directory '%s' doesn't exist for findlib library %s")
(findlib_dir ()) findlib_name
in
let f dir file =
let basename = Filename.basename file in
let tgt_fn = Filename.concat dir basename in
(* Destdir is already include in printconf. *)
install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir
in
List.iter (fun (dir, files) -> List.iter (f dir) files) files ;
in
(* Install data into defined directory *)
let install_data ~ctxt srcdir lst tgtdir =
let tgtdir =
OASISHostPath.of_unix (var_expand tgtdir)
in
List.iter
(fun (src, tgt_opt) ->
let real_srcs =
OASISFileUtil.glob
~ctxt:!BaseContext.default
(Filename.concat srcdir src)
in
if real_srcs = [] then
failwithf
(f_ "Wildcard '%s' doesn't match any files")
src;
List.iter
(fun fn ->
install_file ~ctxt
fn
(fun () ->
match tgt_opt with
| Some s ->
OASISHostPath.of_unix (var_expand s)
| None ->
tgtdir))
real_srcs)
lst
in
let make_fnames modul sufx =
List.fold_right
begin fun sufx accu ->
(OASISString.capitalize_ascii modul ^ sufx) ::
(OASISString.uncapitalize_ascii modul ^ sufx) ::
accu
end
sufx
[]
in
(** Install all libraries *)
let install_libs ~ctxt pkg =
let find_first_existing_files_in_path bs lst =
let path = OASISHostPath.of_unix bs.bs_path in
List.find
OASISFileUtil.file_exists_case
(List.map (Filename.concat path) lst)
in
let files_of_modules new_files typ cs bs modules =
List.fold_left
(fun acc modul ->
begin
try
(* Add uncompiled header from the source tree *)
[find_first_existing_files_in_path
bs (make_fnames modul [".mli"; ".ml"])]
with Not_found ->
warning
(f_ "Cannot find source header for module %s \
in %s %s")
typ modul cs.cs_name;
[]
end
@
List.fold_left
(fun acc fn ->
try
find_first_existing_files_in_path bs [fn] :: acc
with Not_found ->
acc)
acc (make_fnames modul [".annot";".cmti";".cmt"]))
new_files
modules
in
let files_of_build_section (f_data, new_files) typ cs bs =
let extra_files =
List.map
(fun fn ->
try
find_first_existing_files_in_path bs [fn]
with Not_found ->
failwithf
(f_ "Cannot find extra findlib file %S in %s %s ")
fn
typ
cs.cs_name)
bs.bs_findlib_extra_files
in
let f_data () =
(* Install data associated with the library *)
install_data
~ctxt
bs.bs_path
bs.bs_data_files
(Filename.concat
(datarootdir ())
pkg.name);
f_data ()
in
f_data, new_files @ extra_files
in
let files_of_library (f_data, acc) data_lib =
let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in
if var_choose bs.bs_install &&
BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin
(* Start with lib_extra *)
let new_files = lib_extra in
let new_files =
files_of_modules new_files "library" cs bs lib.lib_modules
in
let f_data, new_files =
files_of_build_section (f_data, new_files) "library" cs bs
in
let new_files =
(* Get generated files *)
BaseBuilt.fold
~ctxt
BaseBuilt.BLib
cs.cs_name
(fun acc fn -> fn :: acc)
new_files
in
let acc = (dn, new_files) :: acc in
let f_data () =
(* Install data associated with the library *)
install_data
~ctxt
bs.bs_path
bs.bs_data_files
(Filename.concat
(datarootdir ())
pkg.name);
f_data ()
in
(f_data, acc)
end else begin
(f_data, acc)
end
and files_of_object (f_data, acc) data_obj =
let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in
if var_choose bs.bs_install &&
BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin
(* Start with obj_extra *)
let new_files = obj_extra in
let new_files =
files_of_modules new_files "object" cs bs obj.obj_modules
in
let f_data, new_files =
files_of_build_section (f_data, new_files) "object" cs bs
in
let new_files =
(* Get generated files *)
BaseBuilt.fold
~ctxt
BaseBuilt.BObj
cs.cs_name
(fun acc fn -> fn :: acc)
new_files
in
let acc = (dn, new_files) :: acc in
let f_data () =
(* Install data associated with the object *)
install_data
~ctxt
bs.bs_path
bs.bs_data_files
(Filename.concat (datarootdir ()) pkg.name);
f_data ()
in
(f_data, acc)
end else begin
(f_data, acc)
end
in
(* Install one group of library *)
let install_group_lib grp =
(* Iterate through all group nodes *)
let rec install_group_lib_aux data_and_files grp =
let data_and_files, children =
match grp with
| Container (_, children) ->
data_and_files, children
| Package (_, cs, bs, `Library lib, dn, children) ->
files_of_library data_and_files (cs, bs, lib, dn), children
| Package (_, cs, bs, `Object obj, dn, children) ->
files_of_object data_and_files (cs, bs, obj, dn), children
in
List.fold_left
install_group_lib_aux
data_and_files
children
in
(* Findlib name of the root library *)
let findlib_name = findlib_of_group grp in
(* Determine root library *)
let root_lib = root_of_group grp in
(* All files to install for this library *)
let f_data, files = install_group_lib_aux (ignore, []) grp in
(* Really install, if there is something to install *)
if files = [] then begin
warning
(f_ "Nothing to install for findlib library '%s'") findlib_name
end else begin
let meta =
(* Search META file *)
let _, bs, _ = root_lib in
let res = Filename.concat bs.bs_path "META" in
if not (OASISFileUtil.file_exists_case res) then
failwithf
(f_ "Cannot find file '%s' for findlib library %s")
res
findlib_name;
res
in
let files =
(* Make filename shorter to avoid hitting command max line length
* too early, esp. on Windows.
*)
(* TODO: move to OASISHostPath as make_relative. *)
let remove_prefix p n =
let plen = String.length p in
let nlen = String.length n in
if plen <= nlen && String.sub n 0 plen = p then begin
let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in
let cutpoint =
plen +
(if plen < nlen && n.[plen] = fn_sep then 1 else 0)
in
String.sub n cutpoint (nlen - cutpoint)
end else begin
n
end
in
List.map
(fun (dir, fn) ->
(dir, List.map (remove_prefix (Sys.getcwd ())) fn))
files
in
let ocamlfind = ocamlfind () in
let nodir_files, dir_files =
List.fold_left
(fun (nodir, dir) (dn, lst) ->
match dn with
| Some dn -> nodir, (dn, lst) :: dir
| None -> lst @ nodir, dir)
([], [])
(List.rev files)
in
info (f_ "Installing findlib library '%s'") findlib_name;
List.iter
(OASISExec.run ~ctxt ocamlfind)
(split_install_command ocamlfind findlib_name meta nodir_files);
install_lib_files ~ctxt findlib_name dir_files;
BaseLog.register ~ctxt install_findlib_ev findlib_name
end;
(* Install data files *)
f_data ();
in
let group_libs, _, _ = findlib_mapping pkg in
(* We install libraries in groups *)
List.iter install_group_lib group_libs
in
let install_execs ~ctxt pkg =
let install_exec data_exec =
let cs, bs, _ = !exec_hook data_exec in
if var_choose bs.bs_install &&
BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin
let exec_libdir () = Filename.concat (libdir ()) pkg.name in
BaseBuilt.fold
~ctxt
BaseBuilt.BExec
cs.cs_name
(fun () fn ->
install_file ~ctxt
~tgt_fn:(cs.cs_name ^ ext_program ())
fn
bindir)
();
BaseBuilt.fold
~ctxt
BaseBuilt.BExecLib
cs.cs_name
(fun () fn -> install_file ~ctxt fn exec_libdir)
();
install_data ~ctxt
bs.bs_path
bs.bs_data_files
(Filename.concat (datarootdir ()) pkg.name)
end
in
List.iter
(function
| Executable (cs, bs, exec)-> install_exec (cs, bs, exec)
| _ -> ())
pkg.sections
in
let install_docs ~ctxt pkg =
let install_doc data =
let cs, doc = !doc_hook data in
if var_choose doc.doc_install &&
BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin
let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in
BaseBuilt.fold
~ctxt
BaseBuilt.BDoc
cs.cs_name
(fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))
();
install_data ~ctxt
Filename.current_dir_name
doc.doc_data_files
doc.doc_install_dir
end
in
List.iter
(function
| Doc (cs, doc) -> install_doc (cs, doc)
| _ -> ())
pkg.sections
in
fun ~ctxt pkg _ ->
install_libs ~ctxt pkg;
install_execs ~ctxt pkg;
install_docs ~ctxt pkg
(* Uninstall already installed data *)
let uninstall ~ctxt _ _ =
let uninstall_aux (ev, data) =
if ev = install_file_ev then begin
if OASISFileUtil.file_exists_case data then begin
info (f_ "Removing file '%s'") data;
Sys.remove data
end else begin
warning (f_ "File '%s' doesn't exist anymore") data
end
end else if ev = install_dir_ev then begin
if Sys.file_exists data && Sys.is_directory data then begin
if Sys.readdir data = [||] then begin
info (f_ "Removing directory '%s'") data;
OASISFileUtil.rmdir ~ctxt data
end else begin
warning
(f_ "Directory '%s' is not empty (%s)")
data
(String.concat ", " (Array.to_list (Sys.readdir data)))
end
end else begin
warning (f_ "Directory '%s' doesn't exist anymore") data
end
end else if ev = install_findlib_ev then begin
info (f_ "Removing findlib library '%s'") data;
OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data]
end else begin
failwithf (f_ "Unknown log event '%s'") ev;
end;
BaseLog.unregister ~ctxt ev data
in
(* We process event in reverse order *)
List.iter uninstall_aux
(List.rev
(BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));
List.iter uninstall_aux
(List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))
end
# 6465 "setup.ml"
module OCamlbuildCommon = struct
(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
(** Functions common to OCamlbuild build and doc plugin
*)
open OASISGettext
open BaseEnv
open BaseStandardVar
open OASISTypes
type args =
{
plugin_tags: string option;
extra: string list;
}
let ocamlbuild_clean_ev = "ocamlbuild-clean"
let ocamlbuildflags =
var_define
~short_desc:(fun () -> "OCamlbuild additional flags")
"ocamlbuildflags"
(fun () -> "")
(** Fix special arguments depending on environment *)
let fix_args args extra_argv =
List.flatten
[
if (os_type ()) = "Win32" then
[
"-classic-display";
"-no-log";
"-no-links";
]
else
[];
if OASISVersion.comparator_apply
(OASISVersion.version_of_string (ocaml_version ()))
(OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then
[
"-install-lib-dir";
(Filename.concat (standard_library ()) "ocamlbuild")
]
else
[];
if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then
[
"-byte-plugin"
]
else
[];
args.extra;
begin
match args.plugin_tags with
| Some t -> ["-plugin-tag"; Filename.quote t]
| None -> []
end;
if bool_of_string (debug ()) then
["-tag"; "debug"]
else
[];
if bool_of_string (tests ()) then
["-tag"; "tests"]
else
[];
if bool_of_string (profile ()) then
["-tag"; "profile"]
else
[];
OASISString.nsplit (ocamlbuildflags ()) ' ';
Array.to_list extra_argv;
]
(** Run 'ocamlbuild -clean' if not already done *)
let run_clean ~ctxt extra_argv =
let extra_cli =
String.concat " " (Array.to_list extra_argv)
in
(* Run if never called with these args *)
if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then
begin
OASISExec.run
~ctxt (ocamlbuild ())
(fix_args {extra = ["-clean"]; plugin_tags = None} extra_argv);
BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;
at_exit
(fun () ->
try
BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli
with _ -> ())
end
(** Run ocamlbuild, unregister all clean events *)
let run_ocamlbuild ~ctxt args extra_argv =
(* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
*)
OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv);
(* Remove any clean event, we must run it again *)
List.iter
(fun (e, d) -> BaseLog.unregister ~ctxt e d)
(BaseLog.filter ~ctxt [ocamlbuild_clean_ev])
(** Determine real build directory *)
let build_dir extra_argv =
let rec search_args dir =
function
| "-build-dir" :: dir :: tl ->
search_args dir tl
| _ :: tl ->
search_args dir tl
| [] ->
dir
in
search_args "_build" (fix_args {extra = []; plugin_tags = None} extra_argv)
end
module OCamlbuildPlugin = struct
(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
(** Build using ocamlbuild
@author Sylvain Le Gall
*)
open OASISTypes
open OASISGettext
open OASISUtils
open OASISString
open BaseEnv
open OCamlbuildCommon
open BaseStandardVar
let cond_targets_hook = ref (fun lst -> lst)
let build ~ctxt args pkg argv =
(* Return the filename in build directory *)
let in_build_dir fn =
Filename.concat
(build_dir argv)
fn
in
(* Return the unix filename in host build directory *)
let in_build_dir_of_unix fn =
in_build_dir (OASISHostPath.of_unix fn)
in
let cond_targets =
List.fold_left
(fun acc ->
function
| Library (cs, bs, lib) when var_choose bs.bs_build ->
begin
let evs, unix_files =
BaseBuilt.of_library
in_build_dir_of_unix
(cs, bs, lib)
in
let tgts =
List.flatten
(List.filter
(fun l -> l <> [])
(List.map
(List.filter
(fun fn ->
ends_with ~what:".cma" fn
|| ends_with ~what:".cmxs" fn
|| ends_with ~what:".cmxa" fn
|| ends_with ~what:(ext_lib ()) fn
|| ends_with ~what:(ext_dll ()) fn))
unix_files))
in
match tgts with
| _ :: _ ->
(evs, tgts) :: acc
| [] ->
failwithf
(f_ "No possible ocamlbuild targets for library %s")
cs.cs_name
end
| Object (cs, bs, obj) when var_choose bs.bs_build ->
begin
let evs, unix_files =
BaseBuilt.of_object
in_build_dir_of_unix
(cs, bs, obj)
in
let tgts =
List.flatten
(List.filter
(fun l -> l <> [])
(List.map
(List.filter
(fun fn ->
ends_with ~what:".cmo" fn
|| ends_with ~what:".cmx" fn))
unix_files))
in
match tgts with
| _ :: _ ->
(evs, tgts) :: acc
| [] ->
failwithf
(f_ "No possible ocamlbuild targets for object %s")
cs.cs_name
end
| Executable (cs, bs, exec) when var_choose bs.bs_build ->
begin
let evs, _, _ =
BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)
in
let target ext =
let unix_tgt =
(OASISUnixPath.concat
bs.bs_path
(OASISUnixPath.chop_extension
exec.exec_main_is))^ext
in
let evs =
(* Fix evs, we want to use the unix_tgt, without copying *)
List.map
(function
| BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->
BaseBuilt.BExec, nm,
[[in_build_dir_of_unix unix_tgt]]
| ev ->
ev)
evs
in
evs, [unix_tgt]
in
(* Add executable *)
let acc =
match bs.bs_compiled_object with
| Native ->
(target ".native") :: acc
| Best when bool_of_string (is_native ()) ->
(target ".native") :: acc
| Byte
| Best ->
(target ".byte") :: acc
in
acc
end
| Library _ | Object _ | Executable _ | Test _
| SrcRepo _ | Flag _ | Doc _ ->
acc)
[]
(* Keep the pkg.sections ordered *)
(List.rev pkg.sections);
in
(* Check and register built files *)
let check_and_register (bt, bnm, lst) =
List.iter
(fun fns ->
if not (List.exists OASISFileUtil.file_exists_case fns) then
failwithf
(fn_
"Expected built file %s doesn't exist."
"None of expected built files %s exists."
(List.length fns))
(String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
lst;
(BaseBuilt.register ~ctxt bt bnm lst)
in
(* Run the hook *)
let cond_targets = !cond_targets_hook cond_targets in
(* Run a list of target... *)
run_ocamlbuild
~ctxt
{args with extra = List.flatten (List.map snd cond_targets) @ args.extra}
argv;
(* ... and register events *)
List.iter check_and_register (List.flatten (List.map fst cond_targets))
let clean ~ctxt pkg args =
run_clean ~ctxt args;
List.iter
(function
| Library (cs, _, _) ->
BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
| Executable (cs, _, _) ->
BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
| _ ->
())
pkg.sections
end
module OCamlbuildDocPlugin = struct
(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
(* Create documentation using ocamlbuild .odocl files
@author Sylvain Le Gall
*)
open OASISTypes
open OASISGettext
open OCamlbuildCommon
type run_t =
{
args: args;
run_path: unix_filename;
}
let doc_build ~ctxt run _ (cs, _) argv =
let index_html =
OASISUnixPath.make
[
run.run_path;
cs.cs_name^".docdir";
"index.html";
]
in
let tgt_dir =
OASISHostPath.make
[
build_dir argv;
OASISHostPath.of_unix run.run_path;
cs.cs_name^".docdir";
]
in
run_ocamlbuild ~ctxt
{run.args with extra = index_html :: run.args.extra} argv;
List.iter
(fun glb ->
match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with
| (_ :: _) as filenames ->
BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]
| [] -> ())
["*.html"; "*.css"]
let doc_clean ~ctxt _ _ (cs, _) argv =
run_clean ~ctxt argv;
BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
end
# 6851 "setup.ml"
module CustomPlugin = struct
(* # 22 "src/plugins/custom/CustomPlugin.ml" *)
(** Generate custom configure/build/doc/test/install system
@author
*)
open BaseEnv
open OASISGettext
open OASISTypes
type t =
{
cmd_main: command_line conditional;
cmd_clean: (command_line option) conditional;
cmd_distclean: (command_line option) conditional;
}
let run = BaseCustom.run
let main ~ctxt:_ t _ extra_args =
let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in
run cmd args extra_args
let clean ~ctxt:_ t _ extra_args =
match var_choose t.cmd_clean with
| Some (cmd, args) -> run cmd args extra_args
| _ -> ()
let distclean ~ctxt:_ t _ extra_args =
match var_choose t.cmd_distclean with
| Some (cmd, args) -> run cmd args extra_args
| _ -> ()
module Build =
struct
let main ~ctxt t pkg extra_args =
main ~ctxt t pkg extra_args;
List.iter
(fun sct ->
let evs =
match sct with
| Library (cs, bs, lib) when var_choose bs.bs_build ->
begin
let evs, _ =
BaseBuilt.of_library
OASISHostPath.of_unix
(cs, bs, lib)
in
evs
end
| Executable (cs, bs, exec) when var_choose bs.bs_build ->
begin
let evs, _, _ =
BaseBuilt.of_executable
OASISHostPath.of_unix
(cs, bs, exec)
in
evs
end
| _ ->
[]
in
List.iter
(fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst)
evs)
pkg.sections
let clean ~ctxt t pkg extra_args =
clean ~ctxt t pkg extra_args;
(* TODO: this seems to be pretty generic (at least wrt to ocamlbuild
* considering moving this to BaseSetup?
*)
List.iter
(function
| Library (cs, _, _) ->
BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
| Executable (cs, _, _) ->
BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
| _ ->
())
pkg.sections
let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args
end
module Test =
struct
let main ~ctxt t pkg (cs, _) extra_args =
try
main ~ctxt t pkg extra_args;
0.0
with Failure s ->
BaseMessage.warning
(f_ "Test '%s' fails: %s")
cs.cs_name
s;
1.0
let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args
let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
end
module Doc =
struct
let main ~ctxt t pkg (cs, _) extra_args =
main ~ctxt t pkg extra_args;
BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name []
let clean ~ctxt t pkg (cs, _) extra_args =
clean ~ctxt t pkg extra_args;
BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
end
end
# 6983 "setup.ml"
open OASISTypes;;
let setup_t =
{
BaseSetup.configure = InternalConfigurePlugin.configure;
build =
OCamlbuildPlugin.build
{OCamlbuildCommon.plugin_tags = None; extra = []};
test =
[
("main",
CustomPlugin.Test.main
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
})
];
doc = [];
install = InternalInstallPlugin.install;
uninstall = InternalInstallPlugin.uninstall;
clean = [OCamlbuildPlugin.clean];
clean_test =
[
("main",
CustomPlugin.Test.clean
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
})
];
clean_doc = [];
distclean = [];
distclean_test =
[
("main",
CustomPlugin.Test.distclean
{
CustomPlugin.cmd_main =
[(OASISExpr.EBool true, ("$test", []))];
cmd_clean = [(OASISExpr.EBool true, None)];
cmd_distclean = [(OASISExpr.EBool true, None)]
})
];
distclean_doc = [];
package =
{
oasis_version = "0.4";
ocaml_version = None;
version = "0.2";
license =
OASISLicense.DEP5License
(OASISLicense.DEP5Unit
{
OASISLicense.license = "BSD-3-clause";
excption = None;
version = OASISLicense.NoVersion
});
findlib_version = None;
alpha_features = [];
beta_features = [];
name = "Sparrow";
license_file = None;
copyrights = [];
maintainers = [];
authors =
[
"Programmin Research Laboratory (ROPAS)";
"Seoul National University"
];
homepage = Some "https://github.com/ropas/sparrow";
bugreports = None;
synopsis = "Static analyzer for C.";
description =
Some
[
OASISText.Para
"Sparrow is a state-of-the-art static analyzer that aims to verify the absence of fatal bugs in C source."
];
tags = [];
categories = [];
files_ab = [];
sections =
[
Executable
({
cs_name = "sparrow";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/core";
bs_compiled_object = Best;
bs_build_depends = [];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_interface_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${capitalize_file module}.mli"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${uncapitalize_file module}.mli"
}
];
bs_implementation_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${capitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${uncapitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${capitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${uncapitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${capitalize_file module}.mly"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${uncapitalize_file module}.mly"
}
];
bs_c_sources = [];
bs_data_files = [];
bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
bs_dllpath = [(OASISExpr.EBool true, [])];
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = false; exec_main_is = "main.ml"});
Executable
({
cs_name = "sparrow-vis";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src/core";
bs_compiled_object = Best;
bs_build_depends = [];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_interface_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${capitalize_file module}.mli"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${uncapitalize_file module}.mli"
}
];
bs_implementation_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${capitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${uncapitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${capitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${uncapitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${capitalize_file module}.mly"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${uncapitalize_file module}.mly"
}
];
bs_c_sources = [];
bs_data_files = [];
bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
bs_dllpath = [(OASISExpr.EBool true, [])];
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = false; exec_main_is = "vis.ml"});
Executable
({
cs_name = "test";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
bs_build =
[
(OASISExpr.EBool true, false);
(OASISExpr.EFlag "tests", true)
];
bs_install = [(OASISExpr.EBool true, false)];
bs_path = "test";
bs_compiled_object = Best;
bs_build_depends = [];
bs_build_tools = [ExternalTool "ocamlbuild"];
bs_interface_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${capitalize_file module}.mli"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mli"
];
origin = "${uncapitalize_file module}.mli"
}
];
bs_implementation_patterns =
[
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${capitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".ml"
];
origin = "${uncapitalize_file module}.ml"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${capitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mll"
];
origin = "${uncapitalize_file module}.mll"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("capitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${capitalize_file module}.mly"
};
{
OASISSourcePatterns.Templater.atoms =
[
OASISSourcePatterns.Templater.Text "";
OASISSourcePatterns.Templater.Expr
(OASISSourcePatterns.Templater.Call
("uncapitalize_file",
OASISSourcePatterns.Templater.Ident
"module"));
OASISSourcePatterns.Templater.Text ".mly"
];
origin = "${uncapitalize_file module}.mly"
}
];
bs_c_sources = [];
bs_data_files = [];
bs_findlib_extra_files = [];
bs_ccopt = [(OASISExpr.EBool true, [])];
bs_cclib = [(OASISExpr.EBool true, [])];
bs_dlllib = [(OASISExpr.EBool true, [])];
bs_dllpath = [(OASISExpr.EBool true, [])];
bs_byteopt = [(OASISExpr.EBool true, [])];
bs_nativeopt = [(OASISExpr.EBool true, [])]
},
{exec_custom = false; exec_main_is = "test.ml"});
Test
({
cs_name = "main";
cs_data = PropList.Data.create ();
cs_plugin_data = []
},
{
test_type = (`Test, "custom", Some "0.4");
test_command = [(OASISExpr.EBool true, ("$test", []))];
test_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
test_working_directory = Some "test";
test_run =
[
(OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
(OASISExpr.EFlag "tests", true)
];
test_tools =
[
ExternalTool "ocamlbuild";
InternalExecutable "sparrow"
]
})
];
disable_oasis_section = [];
conf_type = (`Configure, "internal", Some "0.4");
conf_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
build_type = (`Build, "ocamlbuild", Some "0.4");
build_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command =
[
(OASISExpr.EBool true,
Some
(("cp",
[
"-f";
"main.native";
"bin/sparrow\ncp";
"-f";
"vis.native";
"bin/sparrow-vis\nrm";
"-f";
"main.native";
"vis.native";
"test.native"
])))
]
};
install_type = (`Install, "internal", Some "0.4");
install_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command =
[
(OASISExpr.EBool true,
Some
(("install",
[
"bin/harmless_unsoundness.py";
"$bindir\ninstall";
"-d";
"$prefix/etc/sparrow\ninstall";
"etc/*";
"$prefix/etc/sparrow/"
])))
]
};
uninstall_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command =
[
(OASISExpr.EBool true,
Some
(("rm",
[
"$bindir/sparrow*\nrm";
"$bindir/harmless_unsoundness.py\nrm";
"-rf";
"$prefix/etc/sparrow"
])))
]
};
clean_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command =
[
(OASISExpr.EBool true,
Some
(("rm",
[
"-f";
"bin/sparrow*\nrm";
"-f";
"bin/.lymp*\nrm";
"-f";
"bin/*.pyc\nrm";
"-f";
"bin/python_log"
])))
]
};
distclean_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)]
};
plugins =
[(`Extra, "META", Some "0.4"); (`Extra, "DevFiles", Some "0.4")];
schema_data = PropList.Data.create ();
plugin_data = []
};
oasis_fn = Some "_oasis";
oasis_version = "0.4.11";
oasis_digest =
Some "\172\006#\172\211\018\148\134Q\199\233\155\0216w\248";
oasis_exec = None;
oasis_setup_args = [];
setup_update = false
};;
let setup () = BaseSetup.setup setup_t;;
# 7611 "setup.ml"
let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
open BaseCompat.Compat_0_4
(* OASIS_STOP *)
let () = setup ();;
马建仓 AI 助手
尝试更多
代码解读
代码找茬
代码优化
1
https://gitee.com/qq_connect-EA0/sparrow.git
[email protected]:qq_connect-EA0/sparrow.git
qq_connect-EA0
sparrow
sparrow
master

搜索帮助