setup.ml 201 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562256325642565256625672568256925702571257225732574257525762577257825792580258125822583258425852586258725882589259025912592259325942595259625972598259926002601260226032604260526062607260826092610261126122613261426152616261726182619262026212622262326242625262626272628262926302631263226332634263526362637263826392640264126422643264426452646264726482649265026512652265326542655265626572658265926602661266226632664266526662667266826692670267126722673267426752676267726782679268026812682268326842685268626872688268926902691269226932694269526962697269826992700270127022703270427052706270727082709271027112712271327142715271627172718271927202721272227232724272527262727272827292730273127322733273427352736273727382739274027412742274327442745274627472748274927502751275227532754275527562757275827592760276127622763276427652766276727682769277027712772277327742775277627772778277927802781278227832784278527862787278827892790279127922793279427952796279727982799280028012802280328042805280628072808280928102811281228132814281528162817281828192820282128222823282428252826282728282829283028312832283328342835283628372838283928402841284228432844284528462847284828492850285128522853285428552856285728582859286028612862286328642865286628672868286928702871287228732874287528762877287828792880288128822883288428852886288728882889289028912892289328942895289628972898289929002901290229032904290529062907290829092910291129122913291429152916291729182919292029212922292329242925292629272928292929302931293229332934293529362937293829392940294129422943294429452946294729482949295029512952295329542955295629572958295929602961296229632964296529662967296829692970297129722973297429752976297729782979298029812982298329842985298629872988298929902991299229932994299529962997299829993000300130023003300430053006300730083009301030113012301330143015301630173018301930203021302230233024302530263027302830293030303130323033303430353036303730383039304030413042304330443045304630473048304930503051305230533054305530563057305830593060306130623063306430653066306730683069307030713072307330743075307630773078307930803081308230833084308530863087308830893090309130923093309430953096309730983099310031013102310331043105310631073108310931103111311231133114311531163117311831193120312131223123312431253126312731283129313031313132313331343135313631373138313931403141314231433144314531463147314831493150315131523153315431553156315731583159316031613162316331643165316631673168316931703171317231733174317531763177317831793180318131823183318431853186318731883189319031913192319331943195319631973198319932003201320232033204320532063207320832093210321132123213321432153216321732183219322032213222322332243225322632273228322932303231323232333234323532363237323832393240324132423243324432453246324732483249325032513252325332543255325632573258325932603261326232633264326532663267326832693270327132723273327432753276327732783279328032813282328332843285328632873288328932903291329232933294329532963297329832993300330133023303330433053306330733083309331033113312331333143315331633173318331933203321332233233324332533263327332833293330333133323333333433353336333733383339334033413342334333443345334633473348334933503351335233533354335533563357335833593360336133623363336433653366336733683369337033713372337333743375337633773378337933803381338233833384338533863387338833893390339133923393339433953396339733983399340034013402340334043405340634073408340934103411341234133414341534163417341834193420342134223423342434253426342734283429343034313432343334343435343634373438343934403441344234433444344534463447344834493450345134523453345434553456345734583459346034613462346334643465346634673468346934703471347234733474347534763477347834793480348134823483348434853486348734883489349034913492349334943495349634973498349935003501350235033504350535063507350835093510351135123513351435153516351735183519352035213522352335243525352635273528352935303531353235333534353535363537353835393540354135423543354435453546354735483549355035513552355335543555355635573558355935603561356235633564356535663567356835693570357135723573357435753576357735783579358035813582358335843585358635873588358935903591359235933594359535963597359835993600360136023603360436053606360736083609361036113612361336143615361636173618361936203621362236233624362536263627362836293630363136323633363436353636363736383639364036413642364336443645364636473648364936503651365236533654365536563657365836593660366136623663366436653666366736683669367036713672367336743675367636773678367936803681368236833684368536863687368836893690369136923693369436953696369736983699370037013702370337043705370637073708370937103711371237133714371537163717371837193720372137223723372437253726372737283729373037313732373337343735373637373738373937403741374237433744374537463747374837493750375137523753375437553756375737583759376037613762376337643765376637673768376937703771377237733774377537763777377837793780378137823783378437853786378737883789379037913792379337943795379637973798379938003801380238033804380538063807380838093810381138123813381438153816381738183819382038213822382338243825382638273828382938303831383238333834383538363837383838393840384138423843384438453846384738483849385038513852385338543855385638573858385938603861386238633864386538663867386838693870387138723873387438753876387738783879388038813882388338843885388638873888388938903891389238933894389538963897389838993900390139023903390439053906390739083909391039113912391339143915391639173918391939203921392239233924392539263927392839293930393139323933393439353936393739383939394039413942394339443945394639473948394939503951395239533954395539563957395839593960396139623963396439653966396739683969397039713972397339743975397639773978397939803981398239833984398539863987398839893990399139923993399439953996399739983999400040014002400340044005400640074008400940104011401240134014401540164017401840194020402140224023402440254026402740284029403040314032403340344035403640374038403940404041404240434044404540464047404840494050405140524053405440554056405740584059406040614062406340644065406640674068406940704071407240734074407540764077407840794080408140824083408440854086408740884089409040914092409340944095409640974098409941004101410241034104410541064107410841094110411141124113411441154116411741184119412041214122412341244125412641274128412941304131413241334134413541364137413841394140414141424143414441454146414741484149415041514152415341544155415641574158415941604161416241634164416541664167416841694170417141724173417441754176417741784179418041814182418341844185418641874188418941904191419241934194419541964197419841994200420142024203420442054206420742084209421042114212421342144215421642174218421942204221422242234224422542264227422842294230423142324233423442354236423742384239424042414242424342444245424642474248424942504251425242534254425542564257425842594260426142624263426442654266426742684269427042714272427342744275427642774278427942804281428242834284428542864287428842894290429142924293429442954296429742984299430043014302430343044305430643074308430943104311431243134314431543164317431843194320432143224323432443254326432743284329433043314332433343344335433643374338433943404341434243434344434543464347434843494350435143524353435443554356435743584359436043614362436343644365436643674368436943704371437243734374437543764377437843794380438143824383438443854386438743884389439043914392439343944395439643974398439944004401440244034404440544064407440844094410441144124413441444154416441744184419442044214422442344244425442644274428442944304431443244334434443544364437443844394440444144424443444444454446444744484449445044514452445344544455445644574458445944604461446244634464446544664467446844694470447144724473447444754476447744784479448044814482448344844485448644874488448944904491449244934494449544964497449844994500450145024503450445054506450745084509451045114512451345144515451645174518451945204521452245234524452545264527452845294530453145324533453445354536453745384539454045414542454345444545454645474548454945504551455245534554455545564557455845594560456145624563456445654566456745684569457045714572457345744575457645774578457945804581458245834584458545864587458845894590459145924593459445954596459745984599460046014602460346044605460646074608460946104611461246134614461546164617461846194620462146224623462446254626462746284629463046314632463346344635463646374638463946404641464246434644464546464647464846494650465146524653465446554656465746584659466046614662466346644665466646674668466946704671467246734674467546764677467846794680468146824683468446854686468746884689469046914692469346944695469646974698469947004701470247034704470547064707470847094710471147124713471447154716471747184719472047214722472347244725472647274728472947304731473247334734473547364737473847394740474147424743474447454746474747484749475047514752475347544755475647574758475947604761476247634764476547664767476847694770477147724773477447754776477747784779478047814782478347844785478647874788478947904791479247934794479547964797479847994800480148024803480448054806480748084809481048114812481348144815481648174818481948204821482248234824482548264827482848294830483148324833483448354836483748384839484048414842484348444845484648474848484948504851485248534854485548564857485848594860486148624863486448654866486748684869487048714872487348744875487648774878487948804881488248834884488548864887488848894890489148924893489448954896489748984899490049014902490349044905490649074908490949104911491249134914491549164917491849194920492149224923492449254926492749284929493049314932493349344935493649374938493949404941494249434944494549464947494849494950495149524953495449554956495749584959496049614962496349644965496649674968496949704971497249734974497549764977497849794980498149824983498449854986498749884989499049914992499349944995499649974998499950005001500250035004500550065007500850095010501150125013501450155016501750185019502050215022502350245025502650275028502950305031503250335034503550365037503850395040504150425043504450455046504750485049505050515052505350545055505650575058505950605061506250635064506550665067506850695070507150725073507450755076507750785079508050815082508350845085508650875088508950905091509250935094509550965097509850995100510151025103510451055106510751085109511051115112511351145115511651175118511951205121512251235124512551265127512851295130513151325133513451355136513751385139514051415142514351445145514651475148514951505151515251535154515551565157515851595160516151625163516451655166516751685169517051715172517351745175517651775178517951805181518251835184518551865187518851895190519151925193519451955196519751985199520052015202520352045205520652075208520952105211521252135214521552165217521852195220522152225223522452255226522752285229523052315232523352345235523652375238523952405241524252435244524552465247524852495250525152525253525452555256525752585259526052615262526352645265526652675268526952705271527252735274527552765277527852795280528152825283528452855286528752885289529052915292529352945295529652975298529953005301530253035304530553065307530853095310531153125313531453155316531753185319532053215322532353245325532653275328532953305331533253335334533553365337533853395340534153425343534453455346534753485349535053515352535353545355535653575358535953605361536253635364536553665367536853695370537153725373537453755376537753785379538053815382538353845385538653875388538953905391539253935394539553965397539853995400540154025403540454055406540754085409541054115412541354145415541654175418541954205421542254235424542554265427542854295430543154325433543454355436543754385439544054415442544354445445544654475448544954505451545254535454545554565457545854595460546154625463546454655466546754685469547054715472547354745475547654775478547954805481548254835484548554865487548854895490549154925493549454955496549754985499550055015502550355045505550655075508550955105511551255135514551555165517551855195520552155225523552455255526552755285529553055315532553355345535553655375538553955405541554255435544554555465547554855495550555155525553555455555556555755585559556055615562556355645565556655675568556955705571557255735574557555765577557855795580558155825583558455855586558755885589559055915592559355945595559655975598559956005601560256035604560556065607560856095610561156125613561456155616561756185619562056215622562356245625562656275628562956305631563256335634563556365637563856395640564156425643564456455646564756485649565056515652565356545655565656575658565956605661566256635664566556665667566856695670567156725673567456755676567756785679568056815682568356845685568656875688568956905691569256935694569556965697569856995700570157025703570457055706570757085709571057115712571357145715571657175718571957205721572257235724572557265727572857295730573157325733573457355736573757385739574057415742574357445745574657475748574957505751575257535754575557565757575857595760576157625763576457655766576757685769577057715772577357745775577657775778577957805781578257835784578557865787578857895790579157925793579457955796579757985799580058015802580358045805580658075808580958105811581258135814581558165817581858195820582158225823582458255826582758285829583058315832583358345835583658375838583958405841584258435844584558465847584858495850585158525853585458555856585758585859586058615862586358645865586658675868586958705871587258735874587558765877587858795880588158825883588458855886588758885889589058915892589358945895589658975898589959005901590259035904590559065907590859095910591159125913591459155916591759185919592059215922592359245925592659275928592959305931593259335934593559365937593859395940594159425943594459455946594759485949595059515952595359545955595659575958595959605961596259635964596559665967596859695970597159725973597459755976597759785979598059815982598359845985598659875988598959905991599259935994599559965997599859996000600160026003600460056006600760086009601060116012601360146015601660176018601960206021602260236024602560266027602860296030603160326033603460356036603760386039604060416042604360446045604660476048604960506051605260536054605560566057605860596060606160626063606460656066606760686069607060716072607360746075607660776078607960806081608260836084608560866087608860896090609160926093609460956096609760986099610061016102610361046105610661076108610961106111611261136114611561166117611861196120612161226123612461256126612761286129613061316132613361346135613661376138613961406141614261436144614561466147614861496150615161526153615461556156615761586159616061616162616361646165616661676168616961706171617261736174617561766177617861796180618161826183618461856186618761886189619061916192619361946195619661976198619962006201620262036204620562066207620862096210621162126213621462156216621762186219622062216222622362246225622662276228622962306231623262336234623562366237623862396240624162426243624462456246624762486249625062516252625362546255625662576258625962606261626262636264626562666267626862696270627162726273627462756276627762786279628062816282628362846285628662876288628962906291629262936294629562966297629862996300630163026303630463056306630763086309631063116312631363146315631663176318631963206321632263236324632563266327632863296330633163326333633463356336633763386339634063416342634363446345634663476348634963506351635263536354635563566357635863596360636163626363636463656366636763686369637063716372637363746375637663776378637963806381638263836384638563866387638863896390639163926393639463956396639763986399640064016402640364046405640664076408640964106411641264136414641564166417641864196420642164226423642464256426642764286429643064316432643364346435643664376438643964406441644264436444644564466447644864496450645164526453645464556456645764586459646064616462646364646465646664676468646964706471647264736474647564766477647864796480648164826483648464856486648764886489649064916492649364946495649664976498649965006501650265036504650565066507650865096510651165126513651465156516651765186519652065216522652365246525652665276528652965306531653265336534653565366537653865396540654165426543654465456546654765486549655065516552655365546555655665576558655965606561656265636564656565666567656865696570657165726573657465756576657765786579658065816582658365846585658665876588658965906591659265936594659565966597659865996600660166026603660466056606660766086609661066116612661366146615661666176618661966206621662266236624662566266627662866296630663166326633663466356636663766386639664066416642664366446645664666476648664966506651665266536654665566566657665866596660666166626663666466656666666766686669667066716672667366746675667666776678667966806681668266836684668566866687668866896690669166926693669466956696669766986699670067016702670367046705670667076708670967106711671267136714671567166717671867196720672167226723672467256726672767286729673067316732673367346735673667376738673967406741674267436744674567466747674867496750675167526753675467556756675767586759676067616762676367646765676667676768676967706771677267736774677567766777677867796780678167826783678467856786678767886789679067916792679367946795679667976798679968006801680268036804680568066807680868096810681168126813681468156816681768186819682068216822682368246825682668276828682968306831683268336834683568366837683868396840684168426843684468456846684768486849685068516852685368546855685668576858685968606861686268636864686568666867686868696870687168726873687468756876687768786879688068816882688368846885688668876888688968906891689268936894689568966897689868996900690169026903690469056906690769086909691069116912691369146915691669176918691969206921692269236924692569266927692869296930693169326933693469356936693769386939694069416942694369446945694669476948694969506951695269536954695569566957695869596960696169626963696469656966696769686969697069716972697369746975697669776978697969806981698269836984698569866987698869896990699169926993699469956996699769986999700070017002700370047005700670077008700970107011701270137014701570167017701870197020702170227023702470257026702770287029703070317032703370347035703670377038703970407041704270437044704570467047704870497050705170527053705470557056705770587059706070617062706370647065706670677068706970707071707270737074707570767077707870797080708170827083708470857086708770887089709070917092709370947095709670977098709971007101710271037104710571067107710871097110711171127113711471157116711771187119712071217122712371247125712671277128712971307131713271337134713571367137713871397140714171427143714471457146714771487149715071517152715371547155715671577158715971607161716271637164716571667167716871697170717171727173717471757176717771787179718071817182718371847185718671877188718971907191719271937194719571967197719871997200720172027203720472057206720772087209721072117212721372147215721672177218721972207221722272237224722572267227722872297230723172327233723472357236723772387239724072417242724372447245724672477248724972507251725272537254725572567257725872597260726172627263726472657266726772687269727072717272727372747275727672777278727972807281728272837284728572867287728872897290729172927293729472957296729772987299730073017302730373047305730673077308730973107311731273137314731573167317731873197320732173227323732473257326732773287329733073317332733373347335733673377338733973407341734273437344734573467347734873497350735173527353735473557356735773587359736073617362736373647365736673677368736973707371737273737374737573767377737873797380738173827383738473857386738773887389739073917392739373947395739673977398739974007401740274037404740574067407740874097410741174127413741474157416741774187419742074217422742374247425742674277428742974307431743274337434743574367437743874397440744174427443744474457446744774487449745074517452745374547455745674577458
  1. (* setup.ml generated for the first time by OASIS v0.4.5 *)
  2. (* OASIS_START *)
  3. (* DO NOT EDIT (digest: fef05c5a1060338107ca74be27db843d) *)
  4. (*
  5. Regenerated by OASIS v0.4.8
  6. Visit http://oasis.forge.ocamlcore.org for more information and
  7. documentation about functions used in this file.
  8. *)
  9. module OASISGettext = struct
  10. (* # 22 "src/oasis/OASISGettext.ml" *)
  11. let ns_ str = str
  12. let s_ str = str
  13. let f_ (str: ('a, 'b, 'c, 'd) format4) = str
  14. let fn_ fmt1 fmt2 n =
  15. if n = 1 then
  16. fmt1^^""
  17. else
  18. fmt2^^""
  19. let init = []
  20. end
  21. module OASISString = struct
  22. (* # 22 "src/oasis/OASISString.ml" *)
  23. (** Various string utilities.
  24. Mostly inspired by extlib and batteries ExtString and BatString libraries.
  25. @author Sylvain Le Gall
  26. *)
  27. let nsplitf str f =
  28. if str = "" then
  29. []
  30. else
  31. let buf = Buffer.create 13 in
  32. let lst = ref [] in
  33. let push () =
  34. lst := Buffer.contents buf :: !lst;
  35. Buffer.clear buf
  36. in
  37. let str_len = String.length str in
  38. for i = 0 to str_len - 1 do
  39. if f str.[i] then
  40. push ()
  41. else
  42. Buffer.add_char buf str.[i]
  43. done;
  44. push ();
  45. List.rev !lst
  46. (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
  47. separator.
  48. *)
  49. let nsplit str c =
  50. nsplitf str ((=) c)
  51. let find ~what ?(offset=0) str =
  52. let what_idx = ref 0 in
  53. let str_idx = ref offset in
  54. while !str_idx < String.length str &&
  55. !what_idx < String.length what do
  56. if str.[!str_idx] = what.[!what_idx] then
  57. incr what_idx
  58. else
  59. what_idx := 0;
  60. incr str_idx
  61. done;
  62. if !what_idx <> String.length what then
  63. raise Not_found
  64. else
  65. !str_idx - !what_idx
  66. let sub_start str len =
  67. let str_len = String.length str in
  68. if len >= str_len then
  69. ""
  70. else
  71. String.sub str len (str_len - len)
  72. let sub_end ?(offset=0) str len =
  73. let str_len = String.length str in
  74. if len >= str_len then
  75. ""
  76. else
  77. String.sub str 0 (str_len - len)
  78. let starts_with ~what ?(offset=0) str =
  79. let what_idx = ref 0 in
  80. let str_idx = ref offset in
  81. let ok = ref true in
  82. while !ok &&
  83. !str_idx < String.length str &&
  84. !what_idx < String.length what do
  85. if str.[!str_idx] = what.[!what_idx] then
  86. incr what_idx
  87. else
  88. ok := false;
  89. incr str_idx
  90. done;
  91. if !what_idx = String.length what then
  92. true
  93. else
  94. false
  95. let strip_starts_with ~what str =
  96. if starts_with ~what str then
  97. sub_start str (String.length what)
  98. else
  99. raise Not_found
  100. let ends_with ~what ?(offset=0) str =
  101. let what_idx = ref ((String.length what) - 1) in
  102. let str_idx = ref ((String.length str) - 1) in
  103. let ok = ref true in
  104. while !ok &&
  105. offset <= !str_idx &&
  106. 0 <= !what_idx do
  107. if str.[!str_idx] = what.[!what_idx] then
  108. decr what_idx
  109. else
  110. ok := false;
  111. decr str_idx
  112. done;
  113. if !what_idx = -1 then
  114. true
  115. else
  116. false
  117. let strip_ends_with ~what str =
  118. if ends_with ~what str then
  119. sub_end str (String.length what)
  120. else
  121. raise Not_found
  122. let replace_chars f s =
  123. let buf = Buffer.create (String.length s) in
  124. String.iter (fun c -> Buffer.add_char buf (f c)) s;
  125. Buffer.contents buf
  126. let lowercase_ascii =
  127. replace_chars
  128. (fun c ->
  129. if (c >= 'A' && c <= 'Z') then
  130. Char.chr (Char.code c + 32)
  131. else
  132. c)
  133. let uncapitalize_ascii s =
  134. if s <> "" then
  135. (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
  136. else
  137. s
  138. let uppercase_ascii =
  139. replace_chars
  140. (fun c ->
  141. if (c >= 'a' && c <= 'z') then
  142. Char.chr (Char.code c - 32)
  143. else
  144. c)
  145. let capitalize_ascii s =
  146. if s <> "" then
  147. (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
  148. else
  149. s
  150. end
  151. module OASISUtils = struct
  152. (* # 22 "src/oasis/OASISUtils.ml" *)
  153. open OASISGettext
  154. module MapExt =
  155. struct
  156. module type S =
  157. sig
  158. include Map.S
  159. val add_list: 'a t -> (key * 'a) list -> 'a t
  160. val of_list: (key * 'a) list -> 'a t
  161. val to_list: 'a t -> (key * 'a) list
  162. end
  163. module Make (Ord: Map.OrderedType) =
  164. struct
  165. include Map.Make(Ord)
  166. let rec add_list t =
  167. function
  168. | (k, v) :: tl -> add_list (add k v t) tl
  169. | [] -> t
  170. let of_list lst = add_list empty lst
  171. let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
  172. end
  173. end
  174. module MapString = MapExt.Make(String)
  175. module SetExt =
  176. struct
  177. module type S =
  178. sig
  179. include Set.S
  180. val add_list: t -> elt list -> t
  181. val of_list: elt list -> t
  182. val to_list: t -> elt list
  183. end
  184. module Make (Ord: Set.OrderedType) =
  185. struct
  186. include Set.Make(Ord)
  187. let rec add_list t =
  188. function
  189. | e :: tl -> add_list (add e t) tl
  190. | [] -> t
  191. let of_list lst = add_list empty lst
  192. let to_list = elements
  193. end
  194. end
  195. module SetString = SetExt.Make(String)
  196. let compare_csl s1 s2 =
  197. String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
  198. module HashStringCsl =
  199. Hashtbl.Make
  200. (struct
  201. type t = string
  202. let equal s1 s2 = (compare_csl s1 s2) = 0
  203. let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
  204. end)
  205. module SetStringCsl =
  206. SetExt.Make
  207. (struct
  208. type t = string
  209. let compare = compare_csl
  210. end)
  211. let varname_of_string ?(hyphen='_') s =
  212. if String.length s = 0 then
  213. begin
  214. invalid_arg "varname_of_string"
  215. end
  216. else
  217. begin
  218. let buf =
  219. OASISString.replace_chars
  220. (fun c ->
  221. if ('a' <= c && c <= 'z')
  222. ||
  223. ('A' <= c && c <= 'Z')
  224. ||
  225. ('0' <= c && c <= '9') then
  226. c
  227. else
  228. hyphen)
  229. s;
  230. in
  231. let buf =
  232. (* Start with a _ if digit *)
  233. if '0' <= s.[0] && s.[0] <= '9' then
  234. "_"^buf
  235. else
  236. buf
  237. in
  238. OASISString.lowercase_ascii buf
  239. end
  240. let varname_concat ?(hyphen='_') p s =
  241. let what = String.make 1 hyphen in
  242. let p =
  243. try
  244. OASISString.strip_ends_with ~what p
  245. with Not_found ->
  246. p
  247. in
  248. let s =
  249. try
  250. OASISString.strip_starts_with ~what s
  251. with Not_found ->
  252. s
  253. in
  254. p^what^s
  255. let is_varname str =
  256. str = varname_of_string str
  257. let failwithf fmt = Printf.ksprintf failwith fmt
  258. let rec file_location ?pos1 ?pos2 ?lexbuf () =
  259. match pos1, pos2, lexbuf with
  260. | Some p, None, _ | None, Some p, _ ->
  261. file_location ~pos1:p ~pos2:p ?lexbuf ()
  262. | Some p1, Some p2, _ ->
  263. let open Lexing in
  264. let fn, lineno = p1.pos_fname, p1.pos_lnum in
  265. let c1 = p1.pos_cnum - p1.pos_bol in
  266. let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
  267. Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
  268. | _, _, Some lexbuf ->
  269. file_location
  270. ~pos1:(Lexing.lexeme_start_p lexbuf)
  271. ~pos2:(Lexing.lexeme_end_p lexbuf)
  272. ()
  273. | None, None, None ->
  274. s_ "<position undefined>"
  275. let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
  276. let loc = file_location ?pos1 ?pos2 ?lexbuf () in
  277. Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
  278. end
  279. module OASISUnixPath = struct
  280. (* # 22 "src/oasis/OASISUnixPath.ml" *)
  281. type unix_filename = string
  282. type unix_dirname = string
  283. type host_filename = string
  284. type host_dirname = string
  285. let current_dir_name = "."
  286. let parent_dir_name = ".."
  287. let is_current_dir fn =
  288. fn = current_dir_name || fn = ""
  289. let concat f1 f2 =
  290. if is_current_dir f1 then
  291. f2
  292. else
  293. let f1' =
  294. try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
  295. in
  296. f1'^"/"^f2
  297. let make =
  298. function
  299. | hd :: tl ->
  300. List.fold_left
  301. (fun f p -> concat f p)
  302. hd
  303. tl
  304. | [] ->
  305. invalid_arg "OASISUnixPath.make"
  306. let dirname f =
  307. try
  308. String.sub f 0 (String.rindex f '/')
  309. with Not_found ->
  310. current_dir_name
  311. let basename f =
  312. try
  313. let pos_start =
  314. (String.rindex f '/') + 1
  315. in
  316. String.sub f pos_start ((String.length f) - pos_start)
  317. with Not_found ->
  318. f
  319. let chop_extension f =
  320. try
  321. let last_dot =
  322. String.rindex f '.'
  323. in
  324. let sub =
  325. String.sub f 0 last_dot
  326. in
  327. try
  328. let last_slash =
  329. String.rindex f '/'
  330. in
  331. if last_slash < last_dot then
  332. sub
  333. else
  334. f
  335. with Not_found ->
  336. sub
  337. with Not_found ->
  338. f
  339. let capitalize_file f =
  340. let dir = dirname f in
  341. let base = basename f in
  342. concat dir (OASISString.capitalize_ascii base)
  343. let uncapitalize_file f =
  344. let dir = dirname f in
  345. let base = basename f in
  346. concat dir (OASISString.uncapitalize_ascii base)
  347. end
  348. module OASISHostPath = struct
  349. (* # 22 "src/oasis/OASISHostPath.ml" *)
  350. open Filename
  351. open OASISGettext
  352. module Unix = OASISUnixPath
  353. let make =
  354. function
  355. | [] ->
  356. invalid_arg "OASISHostPath.make"
  357. | hd :: tl ->
  358. List.fold_left Filename.concat hd tl
  359. let of_unix ufn =
  360. match Sys.os_type with
  361. | "Unix" | "Cygwin" -> ufn
  362. | "Win32" ->
  363. make
  364. (List.map
  365. (fun p ->
  366. if p = Unix.current_dir_name then
  367. current_dir_name
  368. else if p = Unix.parent_dir_name then
  369. parent_dir_name
  370. else
  371. p)
  372. (OASISString.nsplit ufn '/'))
  373. | os_type ->
  374. OASISUtils.failwithf
  375. (f_ "Don't know the path format of os_type %S when translating unix \
  376. filename. %S")
  377. os_type ufn
  378. end
  379. module OASISFileSystem = struct
  380. (* # 22 "src/oasis/OASISFileSystem.ml" *)
  381. (** File System functions
  382. @author Sylvain Le Gall
  383. *)
  384. type 'a filename = string
  385. class type closer =
  386. object
  387. method close: unit
  388. end
  389. class type reader =
  390. object
  391. inherit closer
  392. method input: Buffer.t -> int -> unit
  393. end
  394. class type writer =
  395. object
  396. inherit closer
  397. method output: Buffer.t -> unit
  398. end
  399. class type ['a] fs =
  400. object
  401. method string_of_filename: 'a filename -> string
  402. method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer
  403. method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader
  404. method file_exists: 'a filename -> bool
  405. method remove: 'a filename -> unit
  406. end
  407. module Mode =
  408. struct
  409. let default_in = [Open_rdonly]
  410. let default_out = [Open_wronly; Open_creat; Open_trunc]
  411. let text_in = Open_text :: default_in
  412. let text_out = Open_text :: default_out
  413. let binary_in = Open_binary :: default_in
  414. let binary_out = Open_binary :: default_out
  415. end
  416. let std_length = 4096 (* Standard buffer/read length. *)
  417. let binary_out = Mode.binary_out
  418. let binary_in = Mode.binary_in
  419. let of_unix_filename ufn = (ufn: 'a filename)
  420. let to_unix_filename fn = (fn: string)
  421. let defer_close o f =
  422. try
  423. let r = f o in o#close; r
  424. with e ->
  425. o#close; raise e
  426. let stream_of_reader rdr =
  427. let buf = Buffer.create std_length in
  428. let pos = ref 0 in
  429. let eof = ref false in
  430. let rec next idx =
  431. let bpos = idx - !pos in
  432. if !eof then begin
  433. None
  434. end else if bpos < Buffer.length buf then begin
  435. Some (Buffer.nth buf bpos)
  436. end else begin
  437. pos := !pos + Buffer.length buf;
  438. Buffer.clear buf;
  439. begin
  440. try
  441. rdr#input buf std_length;
  442. with End_of_file ->
  443. if Buffer.length buf = 0 then
  444. eof := true
  445. end;
  446. next idx
  447. end
  448. in
  449. Stream.from next
  450. let read_all buf rdr =
  451. try
  452. while true do
  453. rdr#input buf std_length
  454. done
  455. with End_of_file ->
  456. ()
  457. class ['a] host_fs rootdir : ['a] fs =
  458. object (self)
  459. method private host_filename fn = Filename.concat rootdir fn
  460. method string_of_filename = self#host_filename
  461. method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn =
  462. let chn = open_out_gen mode perm (self#host_filename fn) in
  463. object
  464. method close = close_out chn
  465. method output buf = Buffer.output_buffer chn buf
  466. end
  467. method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =
  468. (* TODO: use Buffer.add_channel when minimal version of OCaml will
  469. * be >= 4.03.0 (previous version was discarding last chars).
  470. *)
  471. let chn = open_in_gen mode perm (self#host_filename fn) in
  472. let strm = Stream.of_channel chn in
  473. object
  474. method close = close_in chn
  475. method input buf len =
  476. let read = ref 0 in
  477. try
  478. for _i = 0 to len do
  479. Buffer.add_char buf (Stream.next strm);
  480. incr read
  481. done
  482. with Stream.Failure ->
  483. if !read = 0 then
  484. raise End_of_file
  485. end
  486. method file_exists fn = Sys.file_exists (self#host_filename fn)
  487. method remove fn = Sys.remove (self#host_filename fn)
  488. end
  489. end
  490. module OASISContext = struct
  491. (* # 22 "src/oasis/OASISContext.ml" *)
  492. open OASISGettext
  493. type level =
  494. [ `Debug
  495. | `Info
  496. | `Warning
  497. | `Error]
  498. type source
  499. type source_filename = source OASISFileSystem.filename
  500. let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn
  501. type t =
  502. {
  503. (* TODO: replace this by a proplist. *)
  504. quiet: bool;
  505. info: bool;
  506. debug: bool;
  507. ignore_plugins: bool;
  508. ignore_unknown_fields: bool;
  509. printf: level -> string -> unit;
  510. srcfs: source OASISFileSystem.fs;
  511. load_oasis_plugin: string -> bool;
  512. }
  513. let printf lvl str =
  514. let beg =
  515. match lvl with
  516. | `Error -> s_ "E: "
  517. | `Warning -> s_ "W: "
  518. | `Info -> s_ "I: "
  519. | `Debug -> s_ "D: "
  520. in
  521. prerr_endline (beg^str)
  522. let default =
  523. ref
  524. {
  525. quiet = false;
  526. info = false;
  527. debug = false;
  528. ignore_plugins = false;
  529. ignore_unknown_fields = false;
  530. printf = printf;
  531. srcfs = new OASISFileSystem.host_fs(Sys.getcwd ());
  532. load_oasis_plugin = (fun _ -> false);
  533. }
  534. let quiet =
  535. {!default with quiet = true}
  536. let fspecs () =
  537. (* TODO: don't act on default. *)
  538. let ignore_plugins = ref false in
  539. ["-quiet",
  540. Arg.Unit (fun () -> default := {!default with quiet = true}),
  541. s_ " Run quietly";
  542. "-info",
  543. Arg.Unit (fun () -> default := {!default with info = true}),
  544. s_ " Display information message";
  545. "-debug",
  546. Arg.Unit (fun () -> default := {!default with debug = true}),
  547. s_ " Output debug message";
  548. "-ignore-plugins",
  549. Arg.Set ignore_plugins,
  550. s_ " Ignore plugin's field.";
  551. "-C",
  552. Arg.String
  553. (fun str ->
  554. Sys.chdir str;
  555. default := {!default with srcfs = new OASISFileSystem.host_fs str}),
  556. s_ "dir Change directory before running (affects setup.{data,log})."],
  557. fun () -> {!default with ignore_plugins = !ignore_plugins}
  558. end
  559. module PropList = struct
  560. (* # 22 "src/oasis/PropList.ml" *)
  561. open OASISGettext
  562. type name = string
  563. exception Not_set of name * string option
  564. exception No_printer of name
  565. exception Unknown_field of name * name
  566. let () =
  567. Printexc.register_printer
  568. (function
  569. | Not_set (nm, Some rsn) ->
  570. Some
  571. (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
  572. | Not_set (nm, None) ->
  573. Some
  574. (Printf.sprintf (f_ "Field '%s' is not set") nm)
  575. | No_printer nm ->
  576. Some
  577. (Printf.sprintf (f_ "No default printer for value %s") nm)
  578. | Unknown_field (nm, schm) ->
  579. Some
  580. (Printf.sprintf
  581. (f_ "Field %s is not defined in schema %s") nm schm)
  582. | _ ->
  583. None)
  584. module Data =
  585. struct
  586. type t =
  587. (name, unit -> unit) Hashtbl.t
  588. let create () =
  589. Hashtbl.create 13
  590. let clear t =
  591. Hashtbl.clear t
  592. (* # 77 "src/oasis/PropList.ml" *)
  593. end
  594. module Schema =
  595. struct
  596. type ('ctxt, 'extra) value =
  597. {
  598. get: Data.t -> string;
  599. set: Data.t -> ?context:'ctxt -> string -> unit;
  600. help: (unit -> string) option;
  601. extra: 'extra;
  602. }
  603. type ('ctxt, 'extra) t =
  604. {
  605. name: name;
  606. fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
  607. order: name Queue.t;
  608. name_norm: string -> string;
  609. }
  610. let create ?(case_insensitive=false) nm =
  611. {
  612. name = nm;
  613. fields = Hashtbl.create 13;
  614. order = Queue.create ();
  615. name_norm =
  616. (if case_insensitive then
  617. OASISString.lowercase_ascii
  618. else
  619. fun s -> s);
  620. }
  621. let add t nm set get extra help =
  622. let key =
  623. t.name_norm nm
  624. in
  625. if Hashtbl.mem t.fields key then
  626. failwith
  627. (Printf.sprintf
  628. (f_ "Field '%s' is already defined in schema '%s'")
  629. nm t.name);
  630. Hashtbl.add
  631. t.fields
  632. key
  633. {
  634. set = set;
  635. get = get;
  636. help = help;
  637. extra = extra;
  638. };
  639. Queue.add nm t.order
  640. let mem t nm =
  641. Hashtbl.mem t.fields nm
  642. let find t nm =
  643. try
  644. Hashtbl.find t.fields (t.name_norm nm)
  645. with Not_found ->
  646. raise (Unknown_field (nm, t.name))
  647. let get t data nm =
  648. (find t nm).get data
  649. let set t data nm ?context x =
  650. (find t nm).set
  651. data
  652. ?context
  653. x
  654. let fold f acc t =
  655. Queue.fold
  656. (fun acc k ->
  657. let v =
  658. find t k
  659. in
  660. f acc k v.extra v.help)
  661. acc
  662. t.order
  663. let iter f t =
  664. fold
  665. (fun () -> f)
  666. ()
  667. t
  668. let name t =
  669. t.name
  670. end
  671. module Field =
  672. struct
  673. type ('ctxt, 'value, 'extra) t =
  674. {
  675. set: Data.t -> ?context:'ctxt -> 'value -> unit;
  676. get: Data.t -> 'value;
  677. sets: Data.t -> ?context:'ctxt -> string -> unit;
  678. gets: Data.t -> string;
  679. help: (unit -> string) option;
  680. extra: 'extra;
  681. }
  682. let new_id =
  683. let last_id =
  684. ref 0
  685. in
  686. fun () -> incr last_id; !last_id
  687. let create ?schema ?name ?parse ?print ?default ?update ?help extra =
  688. (* Default value container *)
  689. let v =
  690. ref None
  691. in
  692. (* If name is not given, create unique one *)
  693. let nm =
  694. match name with
  695. | Some s -> s
  696. | None -> Printf.sprintf "_anon_%d" (new_id ())
  697. in
  698. (* Last chance to get a value: the default *)
  699. let default () =
  700. match default with
  701. | Some d -> d
  702. | None -> raise (Not_set (nm, Some (s_ "no default value")))
  703. in
  704. (* Get data *)
  705. let get data =
  706. (* Get value *)
  707. try
  708. (Hashtbl.find data nm) ();
  709. match !v with
  710. | Some x -> x
  711. | None -> default ()
  712. with Not_found ->
  713. default ()
  714. in
  715. (* Set data *)
  716. let set data ?context x =
  717. let x =
  718. match update with
  719. | Some f ->
  720. begin
  721. try
  722. f ?context (get data) x
  723. with Not_set _ ->
  724. x
  725. end
  726. | None ->
  727. x
  728. in
  729. Hashtbl.replace
  730. data
  731. nm
  732. (fun () -> v := Some x)
  733. in
  734. (* Parse string value, if possible *)
  735. let parse =
  736. match parse with
  737. | Some f ->
  738. f
  739. | None ->
  740. fun ?context s ->
  741. failwith
  742. (Printf.sprintf
  743. (f_ "Cannot parse field '%s' when setting value %S")
  744. nm
  745. s)
  746. in
  747. (* Set data, from string *)
  748. let sets data ?context s =
  749. set ?context data (parse ?context s)
  750. in
  751. (* Output value as string, if possible *)
  752. let print =
  753. match print with
  754. | Some f ->
  755. f
  756. | None ->
  757. fun _ -> raise (No_printer nm)
  758. in
  759. (* Get data, as a string *)
  760. let gets data =
  761. print (get data)
  762. in
  763. begin
  764. match schema with
  765. | Some t ->
  766. Schema.add t nm sets gets extra help
  767. | None ->
  768. ()
  769. end;
  770. {
  771. set = set;
  772. get = get;
  773. sets = sets;
  774. gets = gets;
  775. help = help;
  776. extra = extra;
  777. }
  778. let fset data t ?context x =
  779. t.set data ?context x
  780. let fget data t =
  781. t.get data
  782. let fsets data t ?context s =
  783. t.sets data ?context s
  784. let fgets data t =
  785. t.gets data
  786. end
  787. module FieldRO =
  788. struct
  789. let create ?schema ?name ?parse ?print ?default ?update ?help extra =
  790. let fld =
  791. Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
  792. in
  793. fun data -> Field.fget data fld
  794. end
  795. end
  796. module OASISMessage = struct
  797. (* # 22 "src/oasis/OASISMessage.ml" *)
  798. open OASISGettext
  799. open OASISContext
  800. let generic_message ~ctxt lvl fmt =
  801. let cond =
  802. if ctxt.quiet then
  803. false
  804. else
  805. match lvl with
  806. | `Debug -> ctxt.debug
  807. | `Info -> ctxt.info
  808. | _ -> true
  809. in
  810. Printf.ksprintf
  811. (fun str ->
  812. if cond then
  813. begin
  814. ctxt.printf lvl str
  815. end)
  816. fmt
  817. let debug ~ctxt fmt =
  818. generic_message ~ctxt `Debug fmt
  819. let info ~ctxt fmt =
  820. generic_message ~ctxt `Info fmt
  821. let warning ~ctxt fmt =
  822. generic_message ~ctxt `Warning fmt
  823. let error ~ctxt fmt =
  824. generic_message ~ctxt `Error fmt
  825. end
  826. module OASISVersion = struct
  827. (* # 22 "src/oasis/OASISVersion.ml" *)
  828. open OASISGettext
  829. type t = string
  830. type comparator =
  831. | VGreater of t
  832. | VGreaterEqual of t
  833. | VEqual of t
  834. | VLesser of t
  835. | VLesserEqual of t
  836. | VOr of comparator * comparator
  837. | VAnd of comparator * comparator
  838. (* Range of allowed characters *)
  839. let is_digit c = '0' <= c && c <= '9'
  840. let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
  841. let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false
  842. let rec version_compare v1 v2 =
  843. if v1 <> "" || v2 <> "" then
  844. begin
  845. (* Compare ascii string, using special meaning for version
  846. * related char
  847. *)
  848. let val_ascii c =
  849. if c = '~' then -1
  850. else if is_digit c then 0
  851. else if c = '\000' then 0
  852. else if is_alpha c then Char.code c
  853. else (Char.code c) + 256
  854. in
  855. let len1 = String.length v1 in
  856. let len2 = String.length v2 in
  857. let p = ref 0 in
  858. (** Compare ascii part *)
  859. let compare_vascii () =
  860. let cmp = ref 0 in
  861. while !cmp = 0 &&
  862. !p < len1 && !p < len2 &&
  863. not (is_digit v1.[!p] && is_digit v2.[!p]) do
  864. cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
  865. incr p
  866. done;
  867. if !cmp = 0 && !p < len1 && !p = len2 then
  868. val_ascii v1.[!p]
  869. else if !cmp = 0 && !p = len1 && !p < len2 then
  870. - (val_ascii v2.[!p])
  871. else
  872. !cmp
  873. in
  874. (** Compare digit part *)
  875. let compare_digit () =
  876. let extract_int v p =
  877. let start_p = !p in
  878. while !p < String.length v && is_digit v.[!p] do
  879. incr p
  880. done;
  881. let substr =
  882. String.sub v !p ((String.length v) - !p)
  883. in
  884. let res =
  885. match String.sub v start_p (!p - start_p) with
  886. | "" -> 0
  887. | s -> int_of_string s
  888. in
  889. res, substr
  890. in
  891. let i1, tl1 = extract_int v1 (ref !p) in
  892. let i2, tl2 = extract_int v2 (ref !p) in
  893. i1 - i2, tl1, tl2
  894. in
  895. match compare_vascii () with
  896. | 0 ->
  897. begin
  898. match compare_digit () with
  899. | 0, tl1, tl2 ->
  900. if tl1 <> "" && is_digit tl1.[0] then
  901. 1
  902. else if tl2 <> "" && is_digit tl2.[0] then
  903. -1
  904. else
  905. version_compare tl1 tl2
  906. | n, _, _ ->
  907. n
  908. end
  909. | n ->
  910. n
  911. end
  912. else begin
  913. 0
  914. end
  915. let version_of_string str = str
  916. let string_of_version t = t
  917. let chop t =
  918. try
  919. let pos =
  920. String.rindex t '.'
  921. in
  922. String.sub t 0 pos
  923. with Not_found ->
  924. t
  925. let rec comparator_apply v op =
  926. match op with
  927. | VGreater cv ->
  928. (version_compare v cv) > 0
  929. | VGreaterEqual cv ->
  930. (version_compare v cv) >= 0
  931. | VLesser cv ->
  932. (version_compare v cv) < 0
  933. | VLesserEqual cv ->
  934. (version_compare v cv) <= 0
  935. | VEqual cv ->
  936. (version_compare v cv) = 0
  937. | VOr (op1, op2) ->
  938. (comparator_apply v op1) || (comparator_apply v op2)
  939. | VAnd (op1, op2) ->
  940. (comparator_apply v op1) && (comparator_apply v op2)
  941. let rec string_of_comparator =
  942. function
  943. | VGreater v -> "> "^(string_of_version v)
  944. | VEqual v -> "= "^(string_of_version v)
  945. | VLesser v -> "< "^(string_of_version v)
  946. | VGreaterEqual v -> ">= "^(string_of_version v)
  947. | VLesserEqual v -> "<= "^(string_of_version v)
  948. | VOr (c1, c2) ->
  949. (string_of_comparator c1)^" || "^(string_of_comparator c2)
  950. | VAnd (c1, c2) ->
  951. (string_of_comparator c1)^" && "^(string_of_comparator c2)
  952. let rec varname_of_comparator =
  953. let concat p v =
  954. OASISUtils.varname_concat
  955. p
  956. (OASISUtils.varname_of_string
  957. (string_of_version v))
  958. in
  959. function
  960. | VGreater v -> concat "gt" v
  961. | VLesser v -> concat "lt" v
  962. | VEqual v -> concat "eq" v
  963. | VGreaterEqual v -> concat "ge" v
  964. | VLesserEqual v -> concat "le" v
  965. | VOr (c1, c2) ->
  966. (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
  967. | VAnd (c1, c2) ->
  968. (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
  969. end
  970. module OASISLicense = struct
  971. (* # 22 "src/oasis/OASISLicense.ml" *)
  972. (** License for _oasis fields
  973. @author Sylvain Le Gall
  974. *)
  975. type license = string
  976. type license_exception = string
  977. type license_version =
  978. | Version of OASISVersion.t
  979. | VersionOrLater of OASISVersion.t
  980. | NoVersion
  981. type license_dep_5_unit =
  982. {
  983. license: license;
  984. excption: license_exception option;
  985. version: license_version;
  986. }
  987. type license_dep_5 =
  988. | DEP5Unit of license_dep_5_unit
  989. | DEP5Or of license_dep_5 list
  990. | DEP5And of license_dep_5 list
  991. type t =
  992. | DEP5License of license_dep_5
  993. | OtherLicense of string (* URL *)
  994. end
  995. module OASISExpr = struct
  996. (* # 22 "src/oasis/OASISExpr.ml" *)
  997. open OASISGettext
  998. open OASISUtils
  999. type test = string
  1000. type flag = string
  1001. type t =
  1002. | EBool of bool
  1003. | ENot of t
  1004. | EAnd of t * t
  1005. | EOr of t * t
  1006. | EFlag of flag
  1007. | ETest of test * string
  1008. type 'a choices = (t * 'a) list
  1009. let eval var_get t =
  1010. let rec eval' =
  1011. function
  1012. | EBool b ->
  1013. b
  1014. | ENot e ->
  1015. not (eval' e)
  1016. | EAnd (e1, e2) ->
  1017. (eval' e1) && (eval' e2)
  1018. | EOr (e1, e2) ->
  1019. (eval' e1) || (eval' e2)
  1020. | EFlag nm ->
  1021. let v =
  1022. var_get nm
  1023. in
  1024. assert(v = "true" || v = "false");
  1025. (v = "true")
  1026. | ETest (nm, vl) ->
  1027. let v =
  1028. var_get nm
  1029. in
  1030. (v = vl)
  1031. in
  1032. eval' t
  1033. let choose ?printer ?name var_get lst =
  1034. let rec choose_aux =
  1035. function
  1036. | (cond, vl) :: tl ->
  1037. if eval var_get cond then
  1038. vl
  1039. else
  1040. choose_aux tl
  1041. | [] ->
  1042. let str_lst =
  1043. if lst = [] then
  1044. s_ "<empty>"
  1045. else
  1046. String.concat
  1047. (s_ ", ")
  1048. (List.map
  1049. (fun (cond, vl) ->
  1050. match printer with
  1051. | Some p -> p vl
  1052. | None -> s_ "<no printer>")
  1053. lst)
  1054. in
  1055. match name with
  1056. | Some nm ->
  1057. failwith
  1058. (Printf.sprintf
  1059. (f_ "No result for the choice list '%s': %s")
  1060. nm str_lst)
  1061. | None ->
  1062. failwith
  1063. (Printf.sprintf
  1064. (f_ "No result for a choice list: %s")
  1065. str_lst)
  1066. in
  1067. choose_aux (List.rev lst)
  1068. end
  1069. module OASISText = struct
  1070. (* # 22 "src/oasis/OASISText.ml" *)
  1071. type elt =
  1072. | Para of string
  1073. | Verbatim of string
  1074. | BlankLine
  1075. type t = elt list
  1076. end
  1077. module OASISSourcePatterns = struct
  1078. (* # 22 "src/oasis/OASISSourcePatterns.ml" *)
  1079. open OASISUtils
  1080. open OASISGettext
  1081. module Templater =
  1082. struct
  1083. (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)
  1084. type t =
  1085. {
  1086. atoms: atom list;
  1087. origin: string
  1088. }
  1089. and atom =
  1090. | Text of string
  1091. | Expr of expr
  1092. and expr =
  1093. | Ident of string
  1094. | String of string
  1095. | Call of string * expr
  1096. type env =
  1097. {
  1098. variables: string MapString.t;
  1099. functions: (string -> string) MapString.t;
  1100. }
  1101. let eval env t =
  1102. let rec eval_expr env =
  1103. function
  1104. | String str -> str
  1105. | Ident nm ->
  1106. begin
  1107. try
  1108. MapString.find nm env.variables
  1109. with Not_found ->
  1110. (* TODO: add error location within the string. *)
  1111. failwithf
  1112. (f_ "Unable to find variable %S in source pattern %S")
  1113. nm t.origin
  1114. end
  1115. | Call (fn, expr) ->
  1116. begin
  1117. try
  1118. (MapString.find fn env.functions) (eval_expr env expr)
  1119. with Not_found ->
  1120. (* TODO: add error location within the string. *)
  1121. failwithf
  1122. (f_ "Unable to find function %S in source pattern %S")
  1123. fn t.origin
  1124. end
  1125. in
  1126. String.concat ""
  1127. (List.map
  1128. (function
  1129. | Text str -> str
  1130. | Expr expr -> eval_expr env expr)
  1131. t.atoms)
  1132. let parse env s =
  1133. let lxr = Genlex.make_lexer [] in
  1134. let parse_expr s =
  1135. let st = lxr (Stream.of_string s) in
  1136. match Stream.npeek 3 st with
  1137. | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)
  1138. | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)
  1139. | [Genlex.String str] -> String str
  1140. | [Genlex.Ident nm] -> Ident nm
  1141. (* TODO: add error location within the string. *)
  1142. | _ -> failwithf (f_ "Unable to parse expression %S") s
  1143. in
  1144. let parse s =
  1145. let lst_exprs = ref [] in
  1146. let ss =
  1147. let buff = Buffer.create (String.length s) in
  1148. Buffer.add_substitute
  1149. buff
  1150. (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000")
  1151. s;
  1152. Buffer.contents buff
  1153. in
  1154. let rec join =
  1155. function
  1156. | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)
  1157. | [], tl -> List.map (fun e -> Expr e) tl
  1158. | tl, [] -> List.map (fun e -> Text e) tl
  1159. in
  1160. join (OASISString.nsplit ss '\000', List.rev (!lst_exprs))
  1161. in
  1162. let t = {atoms = parse s; origin = s} in
  1163. (* We rely on a simple evaluation for checking variables/functions.
  1164. It works because there is no if/loop statement.
  1165. *)
  1166. let _s : string = eval env t in
  1167. t
  1168. (* # 144 "src/oasis/OASISSourcePatterns.ml" *)
  1169. end
  1170. type t = Templater.t
  1171. let env ~modul () =
  1172. {
  1173. Templater.
  1174. variables = MapString.of_list ["module", modul];
  1175. functions = MapString.of_list
  1176. [
  1177. "capitalize_file", OASISUnixPath.capitalize_file;
  1178. "uncapitalize_file", OASISUnixPath.uncapitalize_file;
  1179. ];
  1180. }
  1181. let all_possible_files lst ~path ~modul =
  1182. let eval = Templater.eval (env ~modul ()) in
  1183. List.fold_left
  1184. (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)
  1185. [] lst
  1186. let to_string t = t.Templater.origin
  1187. end
  1188. module OASISTypes = struct
  1189. (* # 22 "src/oasis/OASISTypes.ml" *)
  1190. type name = string
  1191. type package_name = string
  1192. type url = string
  1193. type unix_dirname = string
  1194. type unix_filename = string (* TODO: replace everywhere. *)
  1195. type host_dirname = string (* TODO: replace everywhere. *)
  1196. type host_filename = string (* TODO: replace everywhere. *)
  1197. type prog = string
  1198. type arg = string
  1199. type args = string list
  1200. type command_line = (prog * arg list)
  1201. type findlib_name = string
  1202. type findlib_full = string
  1203. type compiled_object =
  1204. | Byte
  1205. | Native
  1206. | Best
  1207. type dependency =
  1208. | FindlibPackage of findlib_full * OASISVersion.comparator option
  1209. | InternalLibrary of name
  1210. type tool =
  1211. | ExternalTool of name
  1212. | InternalExecutable of name
  1213. type vcs =
  1214. | Darcs
  1215. | Git
  1216. | Svn
  1217. | Cvs
  1218. | Hg
  1219. | Bzr
  1220. | Arch
  1221. | Monotone
  1222. | OtherVCS of url
  1223. type plugin_kind =
  1224. [ `Configure
  1225. | `Build
  1226. | `Doc
  1227. | `Test
  1228. | `Install
  1229. | `Extra
  1230. ]
  1231. type plugin_data_purpose =
  1232. [ `Configure
  1233. | `Build
  1234. | `Install
  1235. | `Clean
  1236. | `Distclean
  1237. | `Install
  1238. | `Uninstall
  1239. | `Test
  1240. | `Doc
  1241. | `Extra
  1242. | `Other of string
  1243. ]
  1244. type 'a plugin = 'a * name * OASISVersion.t option
  1245. type all_plugin = plugin_kind plugin
  1246. type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
  1247. type 'a conditional = 'a OASISExpr.choices
  1248. type custom =
  1249. {
  1250. pre_command: (command_line option) conditional;
  1251. post_command: (command_line option) conditional;
  1252. }
  1253. type common_section =
  1254. {
  1255. cs_name: name;
  1256. cs_data: PropList.Data.t;
  1257. cs_plugin_data: plugin_data;
  1258. }
  1259. type build_section =
  1260. {
  1261. bs_build: bool conditional;
  1262. bs_install: bool conditional;
  1263. bs_path: unix_dirname;
  1264. bs_compiled_object: compiled_object;
  1265. bs_build_depends: dependency list;
  1266. bs_build_tools: tool list;
  1267. bs_interface_patterns: OASISSourcePatterns.t list;
  1268. bs_implementation_patterns: OASISSourcePatterns.t list;
  1269. bs_c_sources: unix_filename list;
  1270. bs_data_files: (unix_filename * unix_filename option) list;
  1271. bs_findlib_extra_files: unix_filename list;
  1272. bs_ccopt: args conditional;
  1273. bs_cclib: args conditional;
  1274. bs_dlllib: args conditional;
  1275. bs_dllpath: args conditional;
  1276. bs_byteopt: args conditional;
  1277. bs_nativeopt: args conditional;
  1278. }
  1279. type library =
  1280. {
  1281. lib_modules: string list;
  1282. lib_pack: bool;
  1283. lib_internal_modules: string list;
  1284. lib_findlib_parent: findlib_name option;
  1285. lib_findlib_name: findlib_name option;
  1286. lib_findlib_directory: unix_dirname option;
  1287. lib_findlib_containers: findlib_name list;
  1288. }
  1289. type object_ =
  1290. {
  1291. obj_modules: string list;
  1292. obj_findlib_fullname: findlib_name list option;
  1293. obj_findlib_directory: unix_dirname option;
  1294. }
  1295. type executable =
  1296. {
  1297. exec_custom: bool;
  1298. exec_main_is: unix_filename;
  1299. }
  1300. type flag =
  1301. {
  1302. flag_description: string option;
  1303. flag_default: bool conditional;
  1304. }
  1305. type source_repository =
  1306. {
  1307. src_repo_type: vcs;
  1308. src_repo_location: url;
  1309. src_repo_browser: url option;
  1310. src_repo_module: string option;
  1311. src_repo_branch: string option;
  1312. src_repo_tag: string option;
  1313. src_repo_subdir: unix_filename option;
  1314. }
  1315. type test =
  1316. {
  1317. test_type: [`Test] plugin;
  1318. test_command: command_line conditional;
  1319. test_custom: custom;
  1320. test_working_directory: unix_filename option;
  1321. test_run: bool conditional;
  1322. test_tools: tool list;
  1323. }
  1324. type doc_format =
  1325. | HTML of unix_filename (* TODO: source filename. *)
  1326. | DocText
  1327. | PDF
  1328. | PostScript
  1329. | Info of unix_filename (* TODO: source filename. *)
  1330. | DVI
  1331. | OtherDoc
  1332. type doc =
  1333. {
  1334. doc_type: [`Doc] plugin;
  1335. doc_custom: custom;
  1336. doc_build: bool conditional;
  1337. doc_install: bool conditional;
  1338. doc_install_dir: unix_filename; (* TODO: dest filename ?. *)
  1339. doc_title: string;
  1340. doc_authors: string list;
  1341. doc_abstract: string option;
  1342. doc_format: doc_format;
  1343. (* TODO: src filename. *)
  1344. doc_data_files: (unix_filename * unix_filename option) list;
  1345. doc_build_tools: tool list;
  1346. }
  1347. type section =
  1348. | Library of common_section * build_section * library
  1349. | Object of common_section * build_section * object_
  1350. | Executable of common_section * build_section * executable
  1351. | Flag of common_section * flag
  1352. | SrcRepo of common_section * source_repository
  1353. | Test of common_section * test
  1354. | Doc of common_section * doc
  1355. type section_kind =
  1356. [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
  1357. type package =
  1358. {
  1359. oasis_version: OASISVersion.t;
  1360. ocaml_version: OASISVersion.comparator option;
  1361. findlib_version: OASISVersion.comparator option;
  1362. alpha_features: string list;
  1363. beta_features: string list;
  1364. name: package_name;
  1365. version: OASISVersion.t;
  1366. license: OASISLicense.t;
  1367. license_file: unix_filename option; (* TODO: source filename. *)
  1368. copyrights: string list;
  1369. maintainers: string list;
  1370. authors: string list;
  1371. homepage: url option;
  1372. bugreports: url option;
  1373. synopsis: string;
  1374. description: OASISText.t option;
  1375. tags: string list;
  1376. categories: url list;
  1377. conf_type: [`Configure] plugin;
  1378. conf_custom: custom;
  1379. build_type: [`Build] plugin;
  1380. build_custom: custom;
  1381. install_type: [`Install] plugin;
  1382. install_custom: custom;
  1383. uninstall_custom: custom;
  1384. clean_custom: custom;
  1385. distclean_custom: custom;
  1386. files_ab: unix_filename list; (* TODO: source filename. *)
  1387. sections: section list;
  1388. plugins: [`Extra] plugin list;
  1389. disable_oasis_section: unix_filename list; (* TODO: source filename. *)
  1390. schema_data: PropList.Data.t;
  1391. plugin_data: plugin_data;
  1392. }
  1393. end
  1394. module OASISFeatures = struct
  1395. (* # 22 "src/oasis/OASISFeatures.ml" *)
  1396. open OASISTypes
  1397. open OASISUtils
  1398. open OASISGettext
  1399. open OASISVersion
  1400. module MapPlugin =
  1401. Map.Make
  1402. (struct
  1403. type t = plugin_kind * name
  1404. let compare = Pervasives.compare
  1405. end)
  1406. module Data =
  1407. struct
  1408. type t =
  1409. {
  1410. oasis_version: OASISVersion.t;
  1411. plugin_versions: OASISVersion.t option MapPlugin.t;
  1412. alpha_features: string list;
  1413. beta_features: string list;
  1414. }
  1415. let create oasis_version alpha_features beta_features =
  1416. {
  1417. oasis_version = oasis_version;
  1418. plugin_versions = MapPlugin.empty;
  1419. alpha_features = alpha_features;
  1420. beta_features = beta_features
  1421. }
  1422. let of_package pkg =
  1423. create
  1424. pkg.OASISTypes.oasis_version
  1425. pkg.OASISTypes.alpha_features
  1426. pkg.OASISTypes.beta_features
  1427. let add_plugin (plugin_kind, plugin_name, plugin_version) t =
  1428. {t with
  1429. plugin_versions = MapPlugin.add
  1430. (plugin_kind, plugin_name)
  1431. plugin_version
  1432. t.plugin_versions}
  1433. let plugin_version plugin_kind plugin_name t =
  1434. MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
  1435. let to_string t =
  1436. Printf.sprintf
  1437. "oasis_version: %s; alpha_features: %s; beta_features: %s; \
  1438. plugins_version: %s"
  1439. (OASISVersion.string_of_version (t:t).oasis_version)
  1440. (String.concat ", " t.alpha_features)
  1441. (String.concat ", " t.beta_features)
  1442. (String.concat ", "
  1443. (MapPlugin.fold
  1444. (fun (_, plg) ver_opt acc ->
  1445. (plg^
  1446. (match ver_opt with
  1447. | Some v ->
  1448. " "^(OASISVersion.string_of_version v)
  1449. | None -> ""))
  1450. :: acc)
  1451. t.plugin_versions []))
  1452. end
  1453. type origin =
  1454. | Field of string * string
  1455. | Section of string
  1456. | NoOrigin
  1457. type stage = Alpha | Beta
  1458. let string_of_stage =
  1459. function
  1460. | Alpha -> "alpha"
  1461. | Beta -> "beta"
  1462. let field_of_stage =
  1463. function
  1464. | Alpha -> "AlphaFeatures"
  1465. | Beta -> "BetaFeatures"
  1466. type publication = InDev of stage | SinceVersion of OASISVersion.t
  1467. type t =
  1468. {
  1469. name: string;
  1470. plugin: all_plugin option;
  1471. publication: publication;
  1472. description: unit -> string;
  1473. }
  1474. (* TODO: mutex protect this. *)
  1475. let all_features = Hashtbl.create 13
  1476. let since_version ver_str = SinceVersion (version_of_string ver_str)
  1477. let alpha = InDev Alpha
  1478. let beta = InDev Beta
  1479. let to_string t =
  1480. Printf.sprintf
  1481. "feature: %s; plugin: %s; publication: %s"
  1482. (t:t).name
  1483. (match t.plugin with
  1484. | None -> "<none>"
  1485. | Some (_, nm, _) -> nm)
  1486. (match t.publication with
  1487. | InDev stage -> string_of_stage stage
  1488. | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
  1489. let data_check t data origin =
  1490. let no_message = "no message" in
  1491. let check_feature features stage =
  1492. let has_feature = List.mem (t:t).name features in
  1493. if not has_feature then
  1494. match (origin:origin) with
  1495. | Field (fld, where) ->
  1496. Some
  1497. (Printf.sprintf
  1498. (f_ "Field %s in %s is only available when feature %s \
  1499. is in field %s.")
  1500. fld where t.name (field_of_stage stage))
  1501. | Section sct ->
  1502. Some
  1503. (Printf.sprintf
  1504. (f_ "Section %s is only available when features %s \
  1505. is in field %s.")
  1506. sct t.name (field_of_stage stage))
  1507. | NoOrigin ->
  1508. Some no_message
  1509. else
  1510. None
  1511. in
  1512. let version_is_good ~min_version version fmt =
  1513. let version_is_good =
  1514. OASISVersion.comparator_apply
  1515. version (OASISVersion.VGreaterEqual min_version)
  1516. in
  1517. Printf.ksprintf
  1518. (fun str -> if version_is_good then None else Some str)
  1519. fmt
  1520. in
  1521. match origin, t.plugin, t.publication with
  1522. | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
  1523. | _, _, InDev Beta -> check_feature data.Data.beta_features Beta
  1524. | Field(fld, where), None, SinceVersion min_version ->
  1525. version_is_good ~min_version data.Data.oasis_version
  1526. (f_ "Field %s in %s is only valid since OASIS v%s, update \
  1527. OASISFormat field from '%s' to '%s' after checking \
  1528. OASIS changelog.")
  1529. fld where (string_of_version min_version)
  1530. (string_of_version data.Data.oasis_version)
  1531. (string_of_version min_version)
  1532. | Field(fld, where), Some(plugin_knd, plugin_name, _),
  1533. SinceVersion min_version ->
  1534. begin
  1535. try
  1536. let plugin_version_current =
  1537. try
  1538. match Data.plugin_version plugin_knd plugin_name data with
  1539. | Some ver -> ver
  1540. | None ->
  1541. failwithf
  1542. (f_ "Field %s in %s is only valid for the OASIS \
  1543. plugin %s since v%s, but no plugin version is \
  1544. defined in the _oasis file, change '%s' to \
  1545. '%s (%s)' in your _oasis file.")
  1546. fld where plugin_name (string_of_version min_version)
  1547. plugin_name
  1548. plugin_name (string_of_version min_version)
  1549. with Not_found ->
  1550. failwithf
  1551. (f_ "Field %s in %s is only valid when the OASIS plugin %s \
  1552. is defined.")
  1553. fld where plugin_name
  1554. in
  1555. version_is_good ~min_version plugin_version_current
  1556. (f_ "Field %s in %s is only valid for the OASIS plugin %s \
  1557. since v%s, update your plugin from '%s (%s)' to \
  1558. '%s (%s)' after checking the plugin's changelog.")
  1559. fld where plugin_name (string_of_version min_version)
  1560. plugin_name (string_of_version plugin_version_current)
  1561. plugin_name (string_of_version min_version)
  1562. with Failure msg ->
  1563. Some msg
  1564. end
  1565. | Section sct, None, SinceVersion min_version ->
  1566. version_is_good ~min_version data.Data.oasis_version
  1567. (f_ "Section %s is only valid for since OASIS v%s, update \
  1568. OASISFormat field from '%s' to '%s' after checking OASIS \
  1569. changelog.")
  1570. sct (string_of_version min_version)
  1571. (string_of_version data.Data.oasis_version)
  1572. (string_of_version min_version)
  1573. | Section sct, Some(plugin_knd, plugin_name, _),
  1574. SinceVersion min_version ->
  1575. begin
  1576. try
  1577. let plugin_version_current =
  1578. try
  1579. match Data.plugin_version plugin_knd plugin_name data with
  1580. | Some ver -> ver
  1581. | None ->
  1582. failwithf
  1583. (f_ "Section %s is only valid for the OASIS \
  1584. plugin %s since v%s, but no plugin version is \
  1585. defined in the _oasis file, change '%s' to \
  1586. '%s (%s)' in your _oasis file.")
  1587. sct plugin_name (string_of_version min_version)
  1588. plugin_name
  1589. plugin_name (string_of_version min_version)
  1590. with Not_found ->
  1591. failwithf
  1592. (f_ "Section %s is only valid when the OASIS plugin %s \
  1593. is defined.")
  1594. sct plugin_name
  1595. in
  1596. version_is_good ~min_version plugin_version_current
  1597. (f_ "Section %s is only valid for the OASIS plugin %s \
  1598. since v%s, update your plugin from '%s (%s)' to \
  1599. '%s (%s)' after checking the plugin's changelog.")
  1600. sct plugin_name (string_of_version min_version)
  1601. plugin_name (string_of_version plugin_version_current)
  1602. plugin_name (string_of_version min_version)
  1603. with Failure msg ->
  1604. Some msg
  1605. end
  1606. | NoOrigin, None, SinceVersion min_version ->
  1607. version_is_good ~min_version data.Data.oasis_version "%s" no_message
  1608. | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
  1609. begin
  1610. try
  1611. let plugin_version_current =
  1612. match Data.plugin_version plugin_knd plugin_name data with
  1613. | Some ver -> ver
  1614. | None -> raise Not_found
  1615. in
  1616. version_is_good ~min_version plugin_version_current
  1617. "%s" no_message
  1618. with Not_found ->
  1619. Some no_message
  1620. end
  1621. let data_assert t data origin =
  1622. match data_check t data origin with
  1623. | None -> ()
  1624. | Some str -> failwith str
  1625. let data_test t data =
  1626. match data_check t data NoOrigin with
  1627. | None -> true
  1628. | Some _ -> false
  1629. let package_test t pkg =
  1630. data_test t (Data.of_package pkg)
  1631. let create ?plugin name publication description =
  1632. let () =
  1633. if Hashtbl.mem all_features name then
  1634. failwithf "Feature '%s' is already declared." name
  1635. in
  1636. let t =
  1637. {
  1638. name = name;
  1639. plugin = plugin;
  1640. publication = publication;
  1641. description = description;
  1642. }
  1643. in
  1644. Hashtbl.add all_features name t;
  1645. t
  1646. let get_stage name =
  1647. try
  1648. (Hashtbl.find all_features name).publication
  1649. with Not_found ->
  1650. failwithf (f_ "Feature %s doesn't exist.") name
  1651. let list () =
  1652. Hashtbl.fold (fun _ v acc -> v :: acc) all_features []
  1653. (*
  1654. * Real flags.
  1655. *)
  1656. let features =
  1657. create "features_fields"
  1658. (since_version "0.4")
  1659. (fun () ->
  1660. s_ "Enable to experiment not yet official features.")
  1661. let flag_docs =
  1662. create "flag_docs"
  1663. (since_version "0.3")
  1664. (fun () ->
  1665. s_ "Make building docs require '-docs' flag at configure.")
  1666. let flag_tests =
  1667. create "flag_tests"
  1668. (since_version "0.3")
  1669. (fun () ->
  1670. s_ "Make running tests require '-tests' flag at configure.")
  1671. let pack =
  1672. create "pack"
  1673. (since_version "0.3")
  1674. (fun () ->
  1675. s_ "Allow to create packed library.")
  1676. let section_object =
  1677. create "section_object" beta
  1678. (fun () ->
  1679. s_ "Implement an object section.")
  1680. let dynrun_for_release =
  1681. create "dynrun_for_release" alpha
  1682. (fun () ->
  1683. s_ "Make '-setup-update dynamic' suitable for releasing project.")
  1684. let compiled_setup_ml =
  1685. create "compiled_setup_ml" alpha
  1686. (fun () ->
  1687. s_ "Compile the setup.ml and speed-up actions done with it.")
  1688. let disable_oasis_section =
  1689. create "disable_oasis_section" alpha
  1690. (fun () ->
  1691. s_ "Allow the OASIS section comments and digests to be omitted in \
  1692. generated files.")
  1693. let no_automatic_syntax =
  1694. create "no_automatic_syntax" alpha
  1695. (fun () ->
  1696. s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
  1697. that matches the internal heuristic (if a dependency ends with \
  1698. a .syntax or is a well known syntax).")
  1699. let findlib_directory =
  1700. create "findlib_directory" beta
  1701. (fun () ->
  1702. s_ "Allow to install findlib libraries in sub-directories of the target \
  1703. findlib directory.")
  1704. let findlib_extra_files =
  1705. create "findlib_extra_files" beta
  1706. (fun () ->
  1707. s_ "Allow to install extra files for findlib libraries.")
  1708. let source_patterns =
  1709. create "source_patterns" alpha
  1710. (fun () ->
  1711. s_ "Customize mapping between module name and source file.")
  1712. end
  1713. module OASISSection = struct
  1714. (* # 22 "src/oasis/OASISSection.ml" *)
  1715. open OASISTypes
  1716. let section_kind_common =
  1717. function
  1718. | Library (cs, _, _) ->
  1719. `Library, cs
  1720. | Object (cs, _, _) ->
  1721. `Object, cs
  1722. | Executable (cs, _, _) ->
  1723. `Executable, cs
  1724. | Flag (cs, _) ->
  1725. `Flag, cs
  1726. | SrcRepo (cs, _) ->
  1727. `SrcRepo, cs
  1728. | Test (cs, _) ->
  1729. `Test, cs
  1730. | Doc (cs, _) ->
  1731. `Doc, cs
  1732. let section_common sct =
  1733. snd (section_kind_common sct)
  1734. let section_common_set cs =
  1735. function
  1736. | Library (_, bs, lib) -> Library (cs, bs, lib)
  1737. | Object (_, bs, obj) -> Object (cs, bs, obj)
  1738. | Executable (_, bs, exec) -> Executable (cs, bs, exec)
  1739. | Flag (_, flg) -> Flag (cs, flg)
  1740. | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
  1741. | Test (_, tst) -> Test (cs, tst)
  1742. | Doc (_, doc) -> Doc (cs, doc)
  1743. (** Key used to identify section
  1744. *)
  1745. let section_id sct =
  1746. let k, cs =
  1747. section_kind_common sct
  1748. in
  1749. k, cs.cs_name
  1750. let string_of_section_kind =
  1751. function
  1752. | `Library -> "library"
  1753. | `Object -> "object"
  1754. | `Executable -> "executable"
  1755. | `Flag -> "flag"
  1756. | `SrcRepo -> "src repository"
  1757. | `Test -> "test"
  1758. | `Doc -> "doc"
  1759. let string_of_section sct =
  1760. let k, nm = section_id sct in
  1761. (string_of_section_kind k)^" "^nm
  1762. let section_find id scts =
  1763. List.find
  1764. (fun sct -> id = section_id sct)
  1765. scts
  1766. module CSection =
  1767. struct
  1768. type t = section
  1769. let id = section_id
  1770. let compare t1 t2 =
  1771. compare (id t1) (id t2)
  1772. let equal t1 t2 =
  1773. (id t1) = (id t2)
  1774. let hash t =
  1775. Hashtbl.hash (id t)
  1776. end
  1777. module MapSection = Map.Make(CSection)
  1778. module SetSection = Set.Make(CSection)
  1779. end
  1780. module OASISBuildSection = struct
  1781. (* # 22 "src/oasis/OASISBuildSection.ml" *)
  1782. open OASISTypes
  1783. (* Look for a module file, considering capitalization or not. *)
  1784. let find_module source_file_exists bs modul =
  1785. let possible_lst =
  1786. OASISSourcePatterns.all_possible_files
  1787. (bs.bs_interface_patterns @ bs.bs_implementation_patterns)
  1788. ~path:bs.bs_path
  1789. ~modul
  1790. in
  1791. match List.filter source_file_exists possible_lst with
  1792. | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)
  1793. | [] ->
  1794. let open OASISUtils in
  1795. let _, rev_lst =
  1796. List.fold_left
  1797. (fun (set, acc) fn ->
  1798. let base_fn = OASISUnixPath.chop_extension fn in
  1799. if SetString.mem base_fn set then
  1800. set, acc
  1801. else
  1802. SetString.add base_fn set, base_fn :: acc)
  1803. (SetString.empty, []) possible_lst
  1804. in
  1805. `No_sources (List.rev rev_lst)
  1806. end
  1807. module OASISExecutable = struct
  1808. (* # 22 "src/oasis/OASISExecutable.ml" *)
  1809. open OASISTypes
  1810. let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
  1811. let dir =
  1812. OASISUnixPath.concat
  1813. bs.bs_path
  1814. (OASISUnixPath.dirname exec.exec_main_is)
  1815. in
  1816. let is_native_exec =
  1817. match bs.bs_compiled_object with
  1818. | Native -> true
  1819. | Best -> is_native ()
  1820. | Byte -> false
  1821. in
  1822. OASISUnixPath.concat
  1823. dir
  1824. (cs.cs_name^(suffix_program ())),
  1825. if not is_native_exec &&
  1826. not exec.exec_custom &&
  1827. bs.bs_c_sources <> [] then
  1828. Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
  1829. else
  1830. None
  1831. end
  1832. module OASISLibrary = struct
  1833. (* # 22 "src/oasis/OASISLibrary.ml" *)
  1834. open OASISTypes
  1835. open OASISGettext
  1836. let find_module ~ctxt source_file_exists cs bs modul =
  1837. match OASISBuildSection.find_module source_file_exists bs modul with
  1838. | `Sources _ as res -> res
  1839. | `No_sources _ as res ->
  1840. OASISMessage.warning
  1841. ~ctxt
  1842. (f_ "Cannot find source file matching module '%s' in library %s.")
  1843. modul cs.cs_name;
  1844. OASISMessage.warning
  1845. ~ctxt
  1846. (f_ "Use InterfacePatterns or ImplementationPatterns to define \
  1847. this file with feature %S.")
  1848. (OASISFeatures.source_patterns.OASISFeatures.name);
  1849. res
  1850. let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
  1851. List.fold_left
  1852. (fun acc modul ->
  1853. match find_module ~ctxt source_file_exists cs bs modul with
  1854. | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
  1855. | `No_sources _ -> acc)
  1856. []
  1857. (lib.lib_modules @ lib.lib_internal_modules)
  1858. let generated_unix_files
  1859. ~ctxt
  1860. ~is_native
  1861. ~has_native_dynlink
  1862. ~ext_lib
  1863. ~ext_dll
  1864. ~source_file_exists
  1865. (cs, bs, lib) =
  1866. let find_modules lst ext =
  1867. let find_module modul =
  1868. match find_module ~ctxt source_file_exists cs bs modul with
  1869. | `Sources (_, [fn]) when ext <> "cmi"
  1870. && Filename.check_suffix fn ".mli" ->
  1871. None (* No implementation files for pure interface. *)
  1872. | `Sources (base_fn, _) -> Some [base_fn]
  1873. | `No_sources lst -> Some lst
  1874. in
  1875. List.fold_left
  1876. (fun acc nm ->
  1877. match find_module nm with
  1878. | None -> acc
  1879. | Some base_fns ->
  1880. List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
  1881. []
  1882. lst
  1883. in
  1884. (* The .cmx that be compiled along *)
  1885. let cmxs =
  1886. let should_be_built =
  1887. match bs.bs_compiled_object with
  1888. | Native -> true
  1889. | Best -> is_native
  1890. | Byte -> false
  1891. in
  1892. if should_be_built then
  1893. if lib.lib_pack then
  1894. find_modules
  1895. [cs.cs_name]
  1896. "cmx"
  1897. else
  1898. find_modules
  1899. (lib.lib_modules @ lib.lib_internal_modules)
  1900. "cmx"
  1901. else
  1902. []
  1903. in
  1904. let acc_nopath =
  1905. []
  1906. in
  1907. (* The headers and annot/cmt files that should be compiled along *)
  1908. let headers =
  1909. let sufx =
  1910. if lib.lib_pack
  1911. then [".cmti"; ".cmt"; ".annot"]
  1912. else [".cmi"; ".cmti"; ".cmt"; ".annot"]
  1913. in
  1914. List.map
  1915. (List.fold_left
  1916. (fun accu s ->
  1917. let dot = String.rindex s '.' in
  1918. let base = String.sub s 0 dot in
  1919. List.map ((^) base) sufx @ accu)
  1920. [])
  1921. (find_modules lib.lib_modules "cmi")
  1922. in
  1923. (* Compute what libraries should be built *)
  1924. let acc_nopath =
  1925. (* Add the packed header file if required *)
  1926. let add_pack_header acc =
  1927. if lib.lib_pack then
  1928. [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
  1929. else
  1930. acc
  1931. in
  1932. let byte acc =
  1933. add_pack_header ([cs.cs_name^".cma"] :: acc)
  1934. in
  1935. let native acc =
  1936. let acc =
  1937. add_pack_header
  1938. (if has_native_dynlink then
  1939. [cs.cs_name^".cmxs"] :: acc
  1940. else acc)
  1941. in
  1942. [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
  1943. in
  1944. match bs.bs_compiled_object with
  1945. | Native -> byte (native acc_nopath)
  1946. | Best when is_native -> byte (native acc_nopath)
  1947. | Byte | Best -> byte acc_nopath
  1948. in
  1949. (* Add C library to be built *)
  1950. let acc_nopath =
  1951. if bs.bs_c_sources <> [] then begin
  1952. ["lib"^cs.cs_name^"_stubs"^ext_lib]
  1953. ::
  1954. if has_native_dynlink then
  1955. ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath
  1956. else
  1957. acc_nopath
  1958. end else begin
  1959. acc_nopath
  1960. end
  1961. in
  1962. (* All the files generated *)
  1963. List.rev_append
  1964. (List.rev_map
  1965. (List.rev_map
  1966. (OASISUnixPath.concat bs.bs_path))
  1967. acc_nopath)
  1968. (headers @ cmxs)
  1969. end
  1970. module OASISObject = struct
  1971. (* # 22 "src/oasis/OASISObject.ml" *)
  1972. open OASISTypes
  1973. open OASISGettext
  1974. let find_module ~ctxt source_file_exists cs bs modul =
  1975. match OASISBuildSection.find_module source_file_exists bs modul with
  1976. | `Sources _ as res -> res
  1977. | `No_sources _ as res ->
  1978. OASISMessage.warning
  1979. ~ctxt
  1980. (f_ "Cannot find source file matching module '%s' in object %s.")
  1981. modul cs.cs_name;
  1982. OASISMessage.warning
  1983. ~ctxt
  1984. (f_ "Use InterfacePatterns or ImplementationPatterns to define \
  1985. this file with feature %S.")
  1986. (OASISFeatures.source_patterns.OASISFeatures.name);
  1987. res
  1988. let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =
  1989. List.fold_left
  1990. (fun acc modul ->
  1991. match find_module ~ctxt source_file_exists cs bs modul with
  1992. | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
  1993. | `No_sources _ -> acc)
  1994. []
  1995. obj.obj_modules
  1996. let generated_unix_files
  1997. ~ctxt
  1998. ~is_native
  1999. ~source_file_exists
  2000. (cs, bs, obj) =
  2001. let find_module ext modul =
  2002. match find_module ~ctxt source_file_exists cs bs modul with
  2003. | `Sources (base_fn, _) -> [base_fn ^ ext]
  2004. | `No_sources lst -> lst
  2005. in
  2006. let header, byte, native, c_object, f =
  2007. match obj.obj_modules with
  2008. | [ m ] -> (find_module ".cmi" m,
  2009. find_module ".cmo" m,
  2010. find_module ".cmx" m,
  2011. find_module ".o" m,
  2012. fun x -> x)
  2013. | _ -> ([cs.cs_name ^ ".cmi"],
  2014. [cs.cs_name ^ ".cmo"],
  2015. [cs.cs_name ^ ".cmx"],
  2016. [cs.cs_name ^ ".o"],
  2017. OASISUnixPath.concat bs.bs_path)
  2018. in
  2019. List.map (List.map f) (
  2020. match bs.bs_compiled_object with
  2021. | Native ->
  2022. native :: c_object :: byte :: header :: []
  2023. | Best when is_native ->
  2024. native :: c_object :: byte :: header :: []
  2025. | Byte | Best ->
  2026. byte :: header :: [])
  2027. end
  2028. module OASISFindlib = struct
  2029. (* # 22 "src/oasis/OASISFindlib.ml" *)
  2030. open OASISTypes
  2031. open OASISUtils
  2032. open OASISGettext
  2033. type library_name = name
  2034. type findlib_part_name = name
  2035. type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
  2036. exception InternalLibraryNotFound of library_name
  2037. exception FindlibPackageNotFound of findlib_name
  2038. type group_t =
  2039. | Container of findlib_name * group_t list
  2040. | Package of (findlib_name *
  2041. common_section *
  2042. build_section *
  2043. [`Library of library | `Object of object_] *
  2044. unix_dirname option *
  2045. group_t list)
  2046. type data = common_section *
  2047. build_section *
  2048. [`Library of library | `Object of object_]
  2049. type tree =
  2050. | Node of (data option) * (tree MapString.t)
  2051. | Leaf of data
  2052. let findlib_mapping pkg =
  2053. (* Map from library name to either full findlib name or parts + parent. *)
  2054. let fndlb_parts_of_lib_name =
  2055. let fndlb_parts cs lib =
  2056. let name =
  2057. match lib.lib_findlib_name with
  2058. | Some nm -> nm
  2059. | None -> cs.cs_name
  2060. in
  2061. let name =
  2062. String.concat "." (lib.lib_findlib_containers @ [name])
  2063. in
  2064. name
  2065. in
  2066. List.fold_left
  2067. (fun mp ->
  2068. function
  2069. | Library (cs, _, lib) ->
  2070. begin
  2071. let lib_name = cs.cs_name in
  2072. let fndlb_parts = fndlb_parts cs lib in
  2073. if MapString.mem lib_name mp then
  2074. failwithf
  2075. (f_ "The library name '%s' is used more than once.")
  2076. lib_name;
  2077. match lib.lib_findlib_parent with
  2078. | Some lib_name_parent ->
  2079. MapString.add
  2080. lib_name
  2081. (`Unsolved (lib_name_parent, fndlb_parts))
  2082. mp
  2083. | None ->
  2084. MapString.add
  2085. lib_name
  2086. (`Solved fndlb_parts)
  2087. mp
  2088. end
  2089. | Object (cs, _, obj) ->
  2090. begin
  2091. let obj_name = cs.cs_name in
  2092. if MapString.mem obj_name mp then
  2093. failwithf
  2094. (f_ "The object name '%s' is used more than once.")
  2095. obj_name;
  2096. let findlib_full_name = match obj.obj_findlib_fullname with
  2097. | Some ns -> String.concat "." ns
  2098. | None -> obj_name
  2099. in
  2100. MapString.add
  2101. obj_name
  2102. (`Solved findlib_full_name)
  2103. mp
  2104. end
  2105. | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
  2106. mp)
  2107. MapString.empty
  2108. pkg.sections
  2109. in
  2110. (* Solve the above graph to be only library name to full findlib name. *)
  2111. let fndlb_name_of_lib_name =
  2112. let rec solve visited mp lib_name lib_name_child =
  2113. if SetString.mem lib_name visited then
  2114. failwithf
  2115. (f_ "Library '%s' is involved in a cycle \
  2116. with regard to findlib naming.")
  2117. lib_name;
  2118. let visited = SetString.add lib_name visited in
  2119. try
  2120. match MapString.find lib_name mp with
  2121. | `Solved fndlb_nm ->
  2122. fndlb_nm, mp
  2123. | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
  2124. let pre_fndlb_nm, mp =
  2125. solve visited mp lib_nm_parent lib_name
  2126. in
  2127. let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
  2128. fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
  2129. with Not_found ->
  2130. failwithf
  2131. (f_ "Library '%s', which is defined as the findlib parent of \
  2132. library '%s', doesn't exist.")
  2133. lib_name lib_name_child
  2134. in
  2135. let mp =
  2136. MapString.fold
  2137. (fun lib_name status mp ->
  2138. match status with
  2139. | `Solved _ ->
  2140. (* Solved initialy, no need to go further *)
  2141. mp
  2142. | `Unsolved _ ->
  2143. let _, mp = solve SetString.empty mp lib_name "<none>" in
  2144. mp)
  2145. fndlb_parts_of_lib_name
  2146. fndlb_parts_of_lib_name
  2147. in
  2148. MapString.map
  2149. (function
  2150. | `Solved fndlb_nm -> fndlb_nm
  2151. | `Unsolved _ -> assert false)
  2152. mp
  2153. in
  2154. (* Convert an internal library name to a findlib name. *)
  2155. let findlib_name_of_library_name lib_nm =
  2156. try
  2157. MapString.find lib_nm fndlb_name_of_lib_name
  2158. with Not_found ->
  2159. raise (InternalLibraryNotFound lib_nm)
  2160. in
  2161. (* Add a library to the tree.
  2162. *)
  2163. let add sct mp =
  2164. let fndlb_fullname =
  2165. let cs, _, _ = sct in
  2166. let lib_name = cs.cs_name in
  2167. findlib_name_of_library_name lib_name
  2168. in
  2169. let rec add_children nm_lst (children: tree MapString.t) =
  2170. match nm_lst with
  2171. | (hd :: tl) ->
  2172. begin
  2173. let node =
  2174. try
  2175. add_node tl (MapString.find hd children)
  2176. with Not_found ->
  2177. (* New node *)
  2178. new_node tl
  2179. in
  2180. MapString.add hd node children
  2181. end
  2182. | [] ->
  2183. (* Should not have a nameless library. *)
  2184. assert false
  2185. and add_node tl node =
  2186. if tl = [] then
  2187. begin
  2188. match node with
  2189. | Node (None, children) ->
  2190. Node (Some sct, children)
  2191. | Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
  2192. (* TODO: allow to merge Package, i.e.
  2193. * archive(byte) = "foo.cma foo_init.cmo"
  2194. *)
  2195. let cs, _, _ = sct in
  2196. failwithf
  2197. (f_ "Library '%s' and '%s' have the same findlib name '%s'")
  2198. cs.cs_name cs'.cs_name fndlb_fullname
  2199. end
  2200. else
  2201. begin
  2202. match node with
  2203. | Leaf data ->
  2204. Node (Some data, add_children tl MapString.empty)
  2205. | Node (data_opt, children) ->
  2206. Node (data_opt, add_children tl children)
  2207. end
  2208. and new_node =
  2209. function
  2210. | [] ->
  2211. Leaf sct
  2212. | hd :: tl ->
  2213. Node (None, MapString.add hd (new_node tl) MapString.empty)
  2214. in
  2215. add_children (OASISString.nsplit fndlb_fullname '.') mp
  2216. in
  2217. let unix_directory dn lib =
  2218. let directory =
  2219. match lib with
  2220. | `Library lib -> lib.lib_findlib_directory
  2221. | `Object obj -> obj.obj_findlib_directory
  2222. in
  2223. match dn, directory with
  2224. | None, None -> None
  2225. | None, Some dn | Some dn, None -> Some dn
  2226. | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)
  2227. in
  2228. let rec group_of_tree dn mp =
  2229. MapString.fold
  2230. (fun nm node acc ->
  2231. let cur =
  2232. match node with
  2233. | Node (Some (cs, bs, lib), children) ->
  2234. let current_dn = unix_directory dn lib in
  2235. Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)
  2236. | Node (None, children) ->
  2237. Container (nm, group_of_tree dn children)
  2238. | Leaf (cs, bs, lib) ->
  2239. let current_dn = unix_directory dn lib in
  2240. Package (nm, cs, bs, lib, current_dn, [])
  2241. in
  2242. cur :: acc)
  2243. mp []
  2244. in
  2245. let group_mp =
  2246. List.fold_left
  2247. (fun mp ->
  2248. function
  2249. | Library (cs, bs, lib) ->
  2250. add (cs, bs, `Library lib) mp
  2251. | Object (cs, bs, obj) ->
  2252. add (cs, bs, `Object obj) mp
  2253. | _ ->
  2254. mp)
  2255. MapString.empty
  2256. pkg.sections
  2257. in
  2258. let groups = group_of_tree None group_mp in
  2259. let library_name_of_findlib_name =
  2260. lazy begin
  2261. (* Revert findlib_name_of_library_name. *)
  2262. MapString.fold
  2263. (fun k v mp -> MapString.add v k mp)
  2264. fndlb_name_of_lib_name
  2265. MapString.empty
  2266. end
  2267. in
  2268. let library_name_of_findlib_name fndlb_nm =
  2269. try
  2270. MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)
  2271. with Not_found ->
  2272. raise (FindlibPackageNotFound fndlb_nm)
  2273. in
  2274. groups,
  2275. findlib_name_of_library_name,
  2276. library_name_of_findlib_name
  2277. let findlib_of_group =
  2278. function
  2279. | Container (fndlb_nm, _)
  2280. | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm
  2281. let root_of_group grp =
  2282. let rec root_lib_aux =
  2283. (* We do a DFS in the group. *)
  2284. function
  2285. | Container (_, children) ->
  2286. List.fold_left
  2287. (fun res grp ->
  2288. if res = None then
  2289. root_lib_aux grp
  2290. else
  2291. res)
  2292. None
  2293. children
  2294. | Package (_, cs, bs, lib, _, _) ->
  2295. Some (cs, bs, lib)
  2296. in
  2297. match root_lib_aux grp with
  2298. | Some res ->
  2299. res
  2300. | None ->
  2301. failwithf
  2302. (f_ "Unable to determine root library of findlib library '%s'")
  2303. (findlib_of_group grp)
  2304. end
  2305. module OASISFlag = struct
  2306. (* # 22 "src/oasis/OASISFlag.ml" *)
  2307. end
  2308. module OASISPackage = struct
  2309. (* # 22 "src/oasis/OASISPackage.ml" *)
  2310. end
  2311. module OASISSourceRepository = struct
  2312. (* # 22 "src/oasis/OASISSourceRepository.ml" *)
  2313. end
  2314. module OASISTest = struct
  2315. (* # 22 "src/oasis/OASISTest.ml" *)
  2316. end
  2317. module OASISDocument = struct
  2318. (* # 22 "src/oasis/OASISDocument.ml" *)
  2319. end
  2320. module OASISExec = struct
  2321. (* # 22 "src/oasis/OASISExec.ml" *)
  2322. open OASISGettext
  2323. open OASISUtils
  2324. open OASISMessage
  2325. (* TODO: I don't like this quote, it is there because $(rm) foo expands to
  2326. * 'rm -f' foo...
  2327. *)
  2328. let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
  2329. let cmd =
  2330. if quote then
  2331. if Sys.os_type = "Win32" then
  2332. if String.contains cmd ' ' then
  2333. (* Double the 1st double quote... win32... sigh *)
  2334. "\""^(Filename.quote cmd)
  2335. else
  2336. cmd
  2337. else
  2338. Filename.quote cmd
  2339. else
  2340. cmd
  2341. in
  2342. let cmdline =
  2343. String.concat " " (cmd :: args)
  2344. in
  2345. info ~ctxt (f_ "Running command '%s'") cmdline;
  2346. match f_exit_code, Sys.command cmdline with
  2347. | None, 0 -> ()
  2348. | None, i ->
  2349. failwithf
  2350. (f_ "Command '%s' terminated with error code %d")
  2351. cmdline i
  2352. | Some f, i ->
  2353. f i
  2354. let run_read_output ~ctxt ?f_exit_code cmd args =
  2355. let fn =
  2356. Filename.temp_file "oasis-" ".txt"
  2357. in
  2358. try
  2359. begin
  2360. let () =
  2361. run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
  2362. in
  2363. let chn =
  2364. open_in fn
  2365. in
  2366. let routput =
  2367. ref []
  2368. in
  2369. begin
  2370. try
  2371. while true do
  2372. routput := (input_line chn) :: !routput
  2373. done
  2374. with End_of_file ->
  2375. ()
  2376. end;
  2377. close_in chn;
  2378. Sys.remove fn;
  2379. List.rev !routput
  2380. end
  2381. with e ->
  2382. (try Sys.remove fn with _ -> ());
  2383. raise e
  2384. let run_read_one_line ~ctxt ?f_exit_code cmd args =
  2385. match run_read_output ~ctxt ?f_exit_code cmd args with
  2386. | [fst] ->
  2387. fst
  2388. | lst ->
  2389. failwithf
  2390. (f_ "Command return unexpected output %S")
  2391. (String.concat "\n" lst)
  2392. end
  2393. module OASISFileUtil = struct
  2394. (* # 22 "src/oasis/OASISFileUtil.ml" *)
  2395. open OASISGettext
  2396. let file_exists_case fn =
  2397. let dirname = Filename.dirname fn in
  2398. let basename = Filename.basename fn in
  2399. if Sys.file_exists dirname then
  2400. if basename = Filename.current_dir_name then
  2401. true
  2402. else
  2403. List.mem
  2404. basename
  2405. (Array.to_list (Sys.readdir dirname))
  2406. else
  2407. false
  2408. let find_file ?(case_sensitive=true) paths exts =
  2409. (* Cardinal product of two list *)
  2410. let ( * ) lst1 lst2 =
  2411. List.flatten
  2412. (List.map
  2413. (fun a ->
  2414. List.map
  2415. (fun b -> a, b)
  2416. lst2)
  2417. lst1)
  2418. in
  2419. let rec combined_paths lst =
  2420. match lst with
  2421. | p1 :: p2 :: tl ->
  2422. let acc =
  2423. (List.map
  2424. (fun (a, b) -> Filename.concat a b)
  2425. (p1 * p2))
  2426. in
  2427. combined_paths (acc :: tl)
  2428. | [e] ->
  2429. e
  2430. | [] ->
  2431. []
  2432. in
  2433. let alternatives =
  2434. List.map
  2435. (fun (p, e) ->
  2436. if String.length e > 0 && e.[0] <> '.' then
  2437. p ^ "." ^ e
  2438. else
  2439. p ^ e)
  2440. ((combined_paths paths) * exts)
  2441. in
  2442. List.find (fun file ->
  2443. (if case_sensitive then
  2444. file_exists_case file
  2445. else
  2446. Sys.file_exists file)
  2447. && not (Sys.is_directory file)
  2448. ) alternatives
  2449. let which ~ctxt prg =
  2450. let path_sep =
  2451. match Sys.os_type with
  2452. | "Win32" ->
  2453. ';'
  2454. | _ ->
  2455. ':'
  2456. in
  2457. let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
  2458. let exec_ext =
  2459. match Sys.os_type with
  2460. | "Win32" ->
  2461. "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
  2462. | _ ->
  2463. [""]
  2464. in
  2465. find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
  2466. (**/**)
  2467. let rec fix_dir dn =
  2468. (* Windows hack because Sys.file_exists "src\\" = false when
  2469. * Sys.file_exists "src" = true
  2470. *)
  2471. let ln =
  2472. String.length dn
  2473. in
  2474. if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
  2475. fix_dir (String.sub dn 0 (ln - 1))
  2476. else
  2477. dn
  2478. let q = Filename.quote
  2479. (**/**)
  2480. let cp ~ctxt ?(recurse=false) src tgt =
  2481. if recurse then
  2482. match Sys.os_type with
  2483. | "Win32" ->
  2484. OASISExec.run ~ctxt
  2485. "xcopy" [q src; q tgt; "/E"]
  2486. | _ ->
  2487. OASISExec.run ~ctxt
  2488. "cp" ["-r"; q src; q tgt]
  2489. else
  2490. OASISExec.run ~ctxt
  2491. (match Sys.os_type with
  2492. | "Win32" -> "copy"
  2493. | _ -> "cp")
  2494. [q src; q tgt]
  2495. let mkdir ~ctxt tgt =
  2496. OASISExec.run ~ctxt
  2497. (match Sys.os_type with
  2498. | "Win32" -> "md"
  2499. | _ -> "mkdir")
  2500. [q tgt]
  2501. let rec mkdir_parent ~ctxt f tgt =
  2502. let tgt =
  2503. fix_dir tgt
  2504. in
  2505. if Sys.file_exists tgt then
  2506. begin
  2507. if not (Sys.is_directory tgt) then
  2508. OASISUtils.failwithf
  2509. (f_ "Cannot create directory '%s', a file of the same name already \
  2510. exists")
  2511. tgt
  2512. end
  2513. else
  2514. begin
  2515. mkdir_parent ~ctxt f (Filename.dirname tgt);
  2516. if not (Sys.file_exists tgt) then
  2517. begin
  2518. f tgt;
  2519. mkdir ~ctxt tgt
  2520. end
  2521. end
  2522. let rmdir ~ctxt tgt =
  2523. if Sys.readdir tgt = [||] then begin
  2524. match Sys.os_type with
  2525. | "Win32" ->
  2526. OASISExec.run ~ctxt "rd" [q tgt]
  2527. | _ ->
  2528. OASISExec.run ~ctxt "rm" ["-r"; q tgt]
  2529. end else begin
  2530. OASISMessage.error ~ctxt
  2531. (f_ "Cannot remove directory '%s': not empty.")
  2532. tgt
  2533. end
  2534. let glob ~ctxt fn =
  2535. let basename =
  2536. Filename.basename fn
  2537. in
  2538. if String.length basename >= 2 &&
  2539. basename.[0] = '*' &&
  2540. basename.[1] = '.' then
  2541. begin
  2542. let ext_len =
  2543. (String.length basename) - 2
  2544. in
  2545. let ext =
  2546. String.sub basename 2 ext_len
  2547. in
  2548. let dirname =
  2549. Filename.dirname fn
  2550. in
  2551. Array.fold_left
  2552. (fun acc fn ->
  2553. try
  2554. let fn_ext =
  2555. String.sub
  2556. fn
  2557. ((String.length fn) - ext_len)
  2558. ext_len
  2559. in
  2560. if fn_ext = ext then
  2561. (Filename.concat dirname fn) :: acc
  2562. else
  2563. acc
  2564. with Invalid_argument _ ->
  2565. acc)
  2566. []
  2567. (Sys.readdir dirname)
  2568. end
  2569. else
  2570. begin
  2571. if file_exists_case fn then
  2572. [fn]
  2573. else
  2574. []
  2575. end
  2576. end
  2577. # 3165 "setup.ml"
  2578. module BaseEnvLight = struct
  2579. (* # 22 "src/base/BaseEnvLight.ml" *)
  2580. module MapString = Map.Make(String)
  2581. type t = string MapString.t
  2582. let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
  2583. let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
  2584. let line = ref 1 in
  2585. let lexer st =
  2586. let st_line =
  2587. Stream.from
  2588. (fun _ ->
  2589. try
  2590. match Stream.next st with
  2591. | '\n' -> incr line; Some '\n'
  2592. | c -> Some c
  2593. with Stream.Failure -> None)
  2594. in
  2595. Genlex.make_lexer ["="] st_line
  2596. in
  2597. let rec read_file lxr mp =
  2598. match Stream.npeek 3 lxr with
  2599. | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
  2600. Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
  2601. read_file lxr (MapString.add nm value mp)
  2602. | [] -> mp
  2603. | _ ->
  2604. failwith
  2605. (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
  2606. in
  2607. match stream with
  2608. | Some st -> read_file (lexer st) MapString.empty
  2609. | None ->
  2610. if Sys.file_exists filename then begin
  2611. let chn = open_in_bin filename in
  2612. let st = Stream.of_channel chn in
  2613. try
  2614. let mp = read_file (lexer st) MapString.empty in
  2615. close_in chn; mp
  2616. with e ->
  2617. close_in chn; raise e
  2618. end else if allow_empty then begin
  2619. MapString.empty
  2620. end else begin
  2621. failwith
  2622. (Printf.sprintf
  2623. "Unable to load environment, the file '%s' doesn't exist."
  2624. filename)
  2625. end
  2626. let rec var_expand str env =
  2627. let buff = Buffer.create ((String.length str) * 2) in
  2628. Buffer.add_substitute
  2629. buff
  2630. (fun var ->
  2631. try
  2632. var_expand (MapString.find var env) env
  2633. with Not_found ->
  2634. failwith
  2635. (Printf.sprintf
  2636. "No variable %s defined when trying to expand %S."
  2637. var
  2638. str))
  2639. str;
  2640. Buffer.contents buff
  2641. let var_get name env = var_expand (MapString.find name env) env
  2642. let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst
  2643. end
  2644. # 3245 "setup.ml"
  2645. module BaseContext = struct
  2646. (* # 22 "src/base/BaseContext.ml" *)
  2647. (* TODO: get rid of this module. *)
  2648. open OASISContext
  2649. let args () = fst (fspecs ())
  2650. let default = default
  2651. end
  2652. module BaseMessage = struct
  2653. (* # 22 "src/base/BaseMessage.ml" *)
  2654. (** Message to user, overrid for Base
  2655. @author Sylvain Le Gall
  2656. *)
  2657. open OASISMessage
  2658. open BaseContext
  2659. let debug fmt = debug ~ctxt:!default fmt
  2660. let info fmt = info ~ctxt:!default fmt
  2661. let warning fmt = warning ~ctxt:!default fmt
  2662. let error fmt = error ~ctxt:!default fmt
  2663. end
  2664. module BaseEnv = struct
  2665. (* # 22 "src/base/BaseEnv.ml" *)
  2666. open OASISGettext
  2667. open OASISUtils
  2668. open OASISContext
  2669. open PropList
  2670. module MapString = BaseEnvLight.MapString
  2671. type origin_t =
  2672. | ODefault
  2673. | OGetEnv
  2674. | OFileLoad
  2675. | OCommandLine
  2676. type cli_handle_t =
  2677. | CLINone
  2678. | CLIAuto
  2679. | CLIWith
  2680. | CLIEnable
  2681. | CLIUser of (Arg.key * Arg.spec * Arg.doc) list
  2682. type definition_t =
  2683. {
  2684. hide: bool;
  2685. dump: bool;
  2686. cli: cli_handle_t;
  2687. arg_help: string option;
  2688. group: string option;
  2689. }
  2690. let schema = Schema.create "environment"
  2691. (* Environment data *)
  2692. let env = Data.create ()
  2693. (* Environment data from file *)
  2694. let env_from_file = ref MapString.empty
  2695. (* Lexer for var *)
  2696. let var_lxr = Genlex.make_lexer []
  2697. let rec var_expand str =
  2698. let buff =
  2699. Buffer.create ((String.length str) * 2)
  2700. in
  2701. Buffer.add_substitute
  2702. buff
  2703. (fun var ->
  2704. try
  2705. (* TODO: this is a quick hack to allow calling Test.Command
  2706. * without defining executable name really. I.e. if there is
  2707. * an exec Executable toto, then $(toto) should be replace
  2708. * by its real name. It is however useful to have this function
  2709. * for other variable that depend on the host and should be
  2710. * written better than that.
  2711. *)
  2712. let st =
  2713. var_lxr (Stream.of_string var)
  2714. in
  2715. match Stream.npeek 3 st with
  2716. | [Genlex.Ident "utoh"; Genlex.Ident nm] ->
  2717. OASISHostPath.of_unix (var_get nm)
  2718. | [Genlex.Ident "utoh"; Genlex.String s] ->
  2719. OASISHostPath.of_unix s
  2720. | [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
  2721. String.escaped (var_get nm)
  2722. | [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
  2723. String.escaped s
  2724. | [Genlex.Ident nm] ->
  2725. var_get nm
  2726. | _ ->
  2727. failwithf
  2728. (f_ "Unknown expression '%s' in variable expansion of %s.")
  2729. var
  2730. str
  2731. with
  2732. | Unknown_field (_, _) ->
  2733. failwithf
  2734. (f_ "No variable %s defined when trying to expand %S.")
  2735. var
  2736. str
  2737. | Stream.Error e ->
  2738. failwithf
  2739. (f_ "Syntax error when parsing '%s' when trying to \
  2740. expand %S: %s")
  2741. var
  2742. str
  2743. e)
  2744. str;
  2745. Buffer.contents buff
  2746. and var_get name =
  2747. let vl =
  2748. try
  2749. Schema.get schema env name
  2750. with Unknown_field _ as e ->
  2751. begin
  2752. try
  2753. MapString.find name !env_from_file
  2754. with Not_found ->
  2755. raise e
  2756. end
  2757. in
  2758. var_expand vl
  2759. let var_choose ?printer ?name lst =
  2760. OASISExpr.choose
  2761. ?printer
  2762. ?name
  2763. var_get
  2764. lst
  2765. let var_protect vl =
  2766. let buff =
  2767. Buffer.create (String.length vl)
  2768. in
  2769. String.iter
  2770. (function
  2771. | '$' -> Buffer.add_string buff "\\$"
  2772. | c -> Buffer.add_char buff c)
  2773. vl;
  2774. Buffer.contents buff
  2775. let var_define
  2776. ?(hide=false)
  2777. ?(dump=true)
  2778. ?short_desc
  2779. ?(cli=CLINone)
  2780. ?arg_help
  2781. ?group
  2782. name (* TODO: type constraint on the fact that name must be a valid OCaml
  2783. id *)
  2784. dflt =
  2785. let default =
  2786. [
  2787. OFileLoad, (fun () -> MapString.find name !env_from_file);
  2788. ODefault, dflt;
  2789. OGetEnv, (fun () -> Sys.getenv name);
  2790. ]
  2791. in
  2792. let extra =
  2793. {
  2794. hide = hide;
  2795. dump = dump;
  2796. cli = cli;
  2797. arg_help = arg_help;
  2798. group = group;
  2799. }
  2800. in
  2801. (* Try to find a value that can be defined
  2802. *)
  2803. let var_get_low lst =
  2804. let errors, res =
  2805. List.fold_left
  2806. (fun (errors, res) (_, v) ->
  2807. if res = None then
  2808. begin
  2809. try
  2810. errors, Some (v ())
  2811. with
  2812. | Not_found ->
  2813. errors, res
  2814. | Failure rsn ->
  2815. (rsn :: errors), res
  2816. | e ->
  2817. (Printexc.to_string e) :: errors, res
  2818. end
  2819. else
  2820. errors, res)
  2821. ([], None)
  2822. (List.sort
  2823. (fun (o1, _) (o2, _) ->
  2824. Pervasives.compare o2 o1)
  2825. lst)
  2826. in
  2827. match res, errors with
  2828. | Some v, _ ->
  2829. v
  2830. | None, [] ->
  2831. raise (Not_set (name, None))
  2832. | None, lst ->
  2833. raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
  2834. in
  2835. let help =
  2836. match short_desc with
  2837. | Some fs -> Some fs
  2838. | None -> None
  2839. in
  2840. let var_get_lst =
  2841. FieldRO.create
  2842. ~schema
  2843. ~name
  2844. ~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
  2845. ~print:var_get_low
  2846. ~default
  2847. ~update:(fun ?context:_ x old_x -> x @ old_x)
  2848. ?help
  2849. extra
  2850. in
  2851. fun () ->
  2852. var_expand (var_get_low (var_get_lst env))
  2853. let var_redefine
  2854. ?hide
  2855. ?dump
  2856. ?short_desc
  2857. ?cli
  2858. ?arg_help
  2859. ?group
  2860. name
  2861. dflt =
  2862. if Schema.mem schema name then
  2863. begin
  2864. (* TODO: look suspsicious, we want to memorize dflt not dflt () *)
  2865. Schema.set schema env ~context:ODefault name (dflt ());
  2866. fun () -> var_get name
  2867. end
  2868. else
  2869. begin
  2870. var_define
  2871. ?hide
  2872. ?dump
  2873. ?short_desc
  2874. ?cli
  2875. ?arg_help
  2876. ?group
  2877. name
  2878. dflt
  2879. end
  2880. let var_ignore (_: unit -> string) = ()
  2881. let print_hidden =
  2882. var_define
  2883. ~hide:true
  2884. ~dump:false
  2885. ~cli:CLIAuto
  2886. ~arg_help:"Print even non-printable variable. (debug)"
  2887. "print_hidden"
  2888. (fun () -> "false")
  2889. let var_all () =
  2890. List.rev
  2891. (Schema.fold
  2892. (fun acc nm def _ ->
  2893. if not def.hide || bool_of_string (print_hidden ()) then
  2894. nm :: acc
  2895. else
  2896. acc)
  2897. []
  2898. schema)
  2899. let default_filename = in_srcdir "setup.data"
  2900. let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =
  2901. let open OASISFileSystem in
  2902. env_from_file :=
  2903. let repr_filename = ctxt.srcfs#string_of_filename filename in
  2904. if ctxt.srcfs#file_exists filename then begin
  2905. let buf = Buffer.create 13 in
  2906. defer_close
  2907. (ctxt.srcfs#open_in ~mode:binary_in filename)
  2908. (read_all buf);
  2909. defer_close
  2910. (ctxt.srcfs#open_in ~mode:binary_in filename)
  2911. (fun rdr ->
  2912. OASISMessage.info ~ctxt "Loading environment from %S." repr_filename;
  2913. BaseEnvLight.load ~allow_empty
  2914. ~filename:(repr_filename)
  2915. ~stream:(stream_of_reader rdr)
  2916. ())
  2917. end else if allow_empty then begin
  2918. BaseEnvLight.MapString.empty
  2919. end else begin
  2920. failwith
  2921. (Printf.sprintf
  2922. (f_ "Unable to load environment, the file '%s' doesn't exist.")
  2923. repr_filename)
  2924. end
  2925. let unload () =
  2926. env_from_file := MapString.empty;
  2927. Data.clear env
  2928. let dump ~ctxt ?(filename=default_filename) () =
  2929. let open OASISFileSystem in
  2930. defer_close
  2931. (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)
  2932. (fun wrtr ->
  2933. let buf = Buffer.create 63 in
  2934. let output nm value =
  2935. Buffer.add_string buf (Printf.sprintf "%s=%S\n" nm value)
  2936. in
  2937. let mp_todo =
  2938. (* Dump data from schema *)
  2939. Schema.fold
  2940. (fun mp_todo nm def _ ->
  2941. if def.dump then begin
  2942. try
  2943. output nm (Schema.get schema env nm)
  2944. with Not_set _ ->
  2945. ()
  2946. end;
  2947. MapString.remove nm mp_todo)
  2948. !env_from_file
  2949. schema
  2950. in
  2951. (* Dump data defined outside of schema *)
  2952. MapString.iter output mp_todo;
  2953. wrtr#output buf)
  2954. let print () =
  2955. let printable_vars =
  2956. Schema.fold
  2957. (fun acc nm def short_descr_opt ->
  2958. if not def.hide || bool_of_string (print_hidden ()) then
  2959. begin
  2960. try
  2961. let value = Schema.get schema env nm in
  2962. let txt =
  2963. match short_descr_opt with
  2964. | Some s -> s ()
  2965. | None -> nm
  2966. in
  2967. (txt, value) :: acc
  2968. with Not_set _ ->
  2969. acc
  2970. end
  2971. else
  2972. acc)
  2973. []
  2974. schema
  2975. in
  2976. let max_length =
  2977. List.fold_left max 0
  2978. (List.rev_map String.length
  2979. (List.rev_map fst printable_vars))
  2980. in
  2981. let dot_pad str = String.make ((max_length - (String.length str)) + 3) '.' in
  2982. Printf.printf "\nConfiguration:\n";
  2983. List.iter
  2984. (fun (name, value) ->
  2985. Printf.printf "%s: %s" name (dot_pad name);
  2986. if value = "" then
  2987. Printf.printf "\n"
  2988. else
  2989. Printf.printf " %s\n" value)
  2990. (List.rev printable_vars);
  2991. Printf.printf "\n%!"
  2992. let args () =
  2993. let arg_concat = OASISUtils.varname_concat ~hyphen:'-' in
  2994. [
  2995. "--override",
  2996. Arg.Tuple
  2997. (
  2998. let rvr = ref ""
  2999. in
  3000. let rvl = ref ""
  3001. in
  3002. [
  3003. Arg.Set_string rvr;
  3004. Arg.Set_string rvl;
  3005. Arg.Unit
  3006. (fun () ->
  3007. Schema.set
  3008. schema
  3009. env
  3010. ~context:OCommandLine
  3011. !rvr
  3012. !rvl)
  3013. ]
  3014. ),
  3015. "var+val Override any configuration variable.";
  3016. ]
  3017. @
  3018. List.flatten
  3019. (Schema.fold
  3020. (fun acc name def short_descr_opt ->
  3021. let var_set s =
  3022. Schema.set
  3023. schema
  3024. env
  3025. ~context:OCommandLine
  3026. name
  3027. s
  3028. in
  3029. let arg_name =
  3030. OASISUtils.varname_of_string ~hyphen:'-' name
  3031. in
  3032. let hlp =
  3033. match short_descr_opt with
  3034. | Some txt -> txt ()
  3035. | None -> ""
  3036. in
  3037. let arg_hlp =
  3038. match def.arg_help with
  3039. | Some s -> s
  3040. | None -> "str"
  3041. in
  3042. let default_value =
  3043. try
  3044. Printf.sprintf
  3045. (f_ " [%s]")
  3046. (Schema.get
  3047. schema
  3048. env
  3049. name)
  3050. with Not_set _ ->
  3051. ""
  3052. in
  3053. let args =
  3054. match def.cli with
  3055. | CLINone ->
  3056. []
  3057. | CLIAuto ->
  3058. [
  3059. arg_concat "--" arg_name,
  3060. Arg.String var_set,
  3061. Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
  3062. ]
  3063. | CLIWith ->
  3064. [
  3065. arg_concat "--with-" arg_name,
  3066. Arg.String var_set,
  3067. Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
  3068. ]
  3069. | CLIEnable ->
  3070. let dflt =
  3071. if default_value = " [true]" then
  3072. s_ " [default: enabled]"
  3073. else
  3074. s_ " [default: disabled]"
  3075. in
  3076. [
  3077. arg_concat "--enable-" arg_name,
  3078. Arg.Unit (fun () -> var_set "true"),
  3079. Printf.sprintf (f_ " %s%s") hlp dflt;
  3080. arg_concat "--disable-" arg_name,
  3081. Arg.Unit (fun () -> var_set "false"),
  3082. Printf.sprintf (f_ " %s%s") hlp dflt
  3083. ]
  3084. | CLIUser lst ->
  3085. lst
  3086. in
  3087. args :: acc)
  3088. []
  3089. schema)
  3090. end
  3091. module BaseArgExt = struct
  3092. (* # 22 "src/base/BaseArgExt.ml" *)
  3093. open OASISUtils
  3094. open OASISGettext
  3095. let parse argv args =
  3096. (* Simulate command line for Arg *)
  3097. let current =
  3098. ref 0
  3099. in
  3100. try
  3101. Arg.parse_argv
  3102. ~current:current
  3103. (Array.concat [[|"none"|]; argv])
  3104. (Arg.align args)
  3105. (failwithf (f_ "Don't know what to do with arguments: '%s'"))
  3106. (s_ "configure options:")
  3107. with
  3108. | Arg.Help txt ->
  3109. print_endline txt;
  3110. exit 0
  3111. | Arg.Bad txt ->
  3112. prerr_endline txt;
  3113. exit 1
  3114. end
  3115. module BaseCheck = struct
  3116. (* # 22 "src/base/BaseCheck.ml" *)
  3117. open BaseEnv
  3118. open BaseMessage
  3119. open OASISUtils
  3120. open OASISGettext
  3121. let prog_best prg prg_lst =
  3122. var_redefine
  3123. prg
  3124. (fun () ->
  3125. let alternate =
  3126. List.fold_left
  3127. (fun res e ->
  3128. match res with
  3129. | Some _ ->
  3130. res
  3131. | None ->
  3132. try
  3133. Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
  3134. with Not_found ->
  3135. None)
  3136. None
  3137. prg_lst
  3138. in
  3139. match alternate with
  3140. | Some prg -> prg
  3141. | None -> raise Not_found)
  3142. let prog prg =
  3143. prog_best prg [prg]
  3144. let prog_opt prg =
  3145. prog_best prg [prg^".opt"; prg]
  3146. let ocamlfind =
  3147. prog "ocamlfind"
  3148. let version
  3149. var_prefix
  3150. cmp
  3151. fversion
  3152. () =
  3153. (* Really compare version provided *)
  3154. let var =
  3155. var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
  3156. in
  3157. var_redefine
  3158. ~hide:true
  3159. var
  3160. (fun () ->
  3161. let version_str =
  3162. match fversion () with
  3163. | "[Distributed with OCaml]" ->
  3164. begin
  3165. try
  3166. (var_get "ocaml_version")
  3167. with Not_found ->
  3168. warning
  3169. (f_ "Variable ocaml_version not defined, fallback \
  3170. to default");
  3171. Sys.ocaml_version
  3172. end
  3173. | res ->
  3174. res
  3175. in
  3176. let version =
  3177. OASISVersion.version_of_string version_str
  3178. in
  3179. if OASISVersion.comparator_apply version cmp then
  3180. version_str
  3181. else
  3182. failwithf
  3183. (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
  3184. var_prefix
  3185. (OASISVersion.string_of_comparator cmp)
  3186. version_str)
  3187. ()
  3188. let package_version pkg =
  3189. OASISExec.run_read_one_line ~ctxt:!BaseContext.default
  3190. (ocamlfind ())
  3191. ["query"; "-format"; "%v"; pkg]
  3192. let package ?version_comparator pkg () =
  3193. let var =
  3194. OASISUtils.varname_concat
  3195. "pkg_"
  3196. (OASISUtils.varname_of_string pkg)
  3197. in
  3198. let findlib_dir pkg =
  3199. let dir =
  3200. OASISExec.run_read_one_line ~ctxt:!BaseContext.default
  3201. (ocamlfind ())
  3202. ["query"; "-format"; "%d"; pkg]
  3203. in
  3204. if Sys.file_exists dir && Sys.is_directory dir then
  3205. dir
  3206. else
  3207. failwithf
  3208. (f_ "When looking for findlib package %s, \
  3209. directory %s return doesn't exist")
  3210. pkg dir
  3211. in
  3212. let vl =
  3213. var_redefine
  3214. var
  3215. (fun () -> findlib_dir pkg)
  3216. ()
  3217. in
  3218. (
  3219. match version_comparator with
  3220. | Some ver_cmp ->
  3221. ignore
  3222. (version
  3223. var
  3224. ver_cmp
  3225. (fun _ -> package_version pkg)
  3226. ())
  3227. | None ->
  3228. ()
  3229. );
  3230. vl
  3231. end
  3232. module BaseOCamlcConfig = struct
  3233. (* # 22 "src/base/BaseOCamlcConfig.ml" *)
  3234. open BaseEnv
  3235. open OASISUtils
  3236. open OASISGettext
  3237. module SMap = Map.Make(String)
  3238. let ocamlc =
  3239. BaseCheck.prog_opt "ocamlc"
  3240. let ocamlc_config_map =
  3241. (* Map name to value for ocamlc -config output
  3242. (name ^": "^value)
  3243. *)
  3244. let rec split_field mp lst =
  3245. match lst with
  3246. | line :: tl ->
  3247. let mp =
  3248. try
  3249. let pos_semicolon =
  3250. String.index line ':'
  3251. in
  3252. if pos_semicolon > 1 then
  3253. (
  3254. let name =
  3255. String.sub line 0 pos_semicolon
  3256. in
  3257. let linelen =
  3258. String.length line
  3259. in
  3260. let value =
  3261. if linelen > pos_semicolon + 2 then
  3262. String.sub
  3263. line
  3264. (pos_semicolon + 2)
  3265. (linelen - pos_semicolon - 2)
  3266. else
  3267. ""
  3268. in
  3269. SMap.add name value mp
  3270. )
  3271. else
  3272. (
  3273. mp
  3274. )
  3275. with Not_found ->
  3276. (
  3277. mp
  3278. )
  3279. in
  3280. split_field mp tl
  3281. | [] ->
  3282. mp
  3283. in
  3284. let cache =
  3285. lazy
  3286. (var_protect
  3287. (Marshal.to_string
  3288. (split_field
  3289. SMap.empty
  3290. (OASISExec.run_read_output
  3291. ~ctxt:!BaseContext.default
  3292. (ocamlc ()) ["-config"]))
  3293. []))
  3294. in
  3295. var_redefine
  3296. "ocamlc_config_map"
  3297. ~hide:true
  3298. ~dump:false
  3299. (fun () ->
  3300. (* TODO: update if ocamlc change !!! *)
  3301. Lazy.force cache)
  3302. let var_define nm =
  3303. (* Extract data from ocamlc -config *)
  3304. let avlbl_config_get () =
  3305. Marshal.from_string
  3306. (ocamlc_config_map ())
  3307. 0
  3308. in
  3309. let chop_version_suffix s =
  3310. try
  3311. String.sub s 0 (String.index s '+')
  3312. with _ ->
  3313. s
  3314. in
  3315. let nm_config, value_config =
  3316. match nm with
  3317. | "ocaml_version" ->
  3318. "version", chop_version_suffix
  3319. | _ -> nm, (fun x -> x)
  3320. in
  3321. var_redefine
  3322. nm
  3323. (fun () ->
  3324. try
  3325. let map =
  3326. avlbl_config_get ()
  3327. in
  3328. let value =
  3329. SMap.find nm_config map
  3330. in
  3331. value_config value
  3332. with Not_found ->
  3333. failwithf
  3334. (f_ "Cannot find field '%s' in '%s -config' output")
  3335. nm
  3336. (ocamlc ()))
  3337. end
  3338. module BaseStandardVar = struct
  3339. (* # 22 "src/base/BaseStandardVar.ml" *)
  3340. open OASISGettext
  3341. open OASISTypes
  3342. open BaseCheck
  3343. open BaseEnv
  3344. let ocamlfind = BaseCheck.ocamlfind
  3345. let ocamlc = BaseOCamlcConfig.ocamlc
  3346. let ocamlopt = prog_opt "ocamlopt"
  3347. let ocamlbuild = prog "ocamlbuild"
  3348. (**/**)
  3349. let rpkg =
  3350. ref None
  3351. let pkg_get () =
  3352. match !rpkg with
  3353. | Some pkg -> pkg
  3354. | None -> failwith (s_ "OASIS Package is not set")
  3355. let var_cond = ref []
  3356. let var_define_cond ~since_version f dflt =
  3357. let holder = ref (fun () -> dflt) in
  3358. let since_version =
  3359. OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
  3360. in
  3361. var_cond :=
  3362. (fun ver ->
  3363. if OASISVersion.comparator_apply ver since_version then
  3364. holder := f ()) :: !var_cond;
  3365. fun () -> !holder ()
  3366. (**/**)
  3367. let pkg_name =
  3368. var_define
  3369. ~short_desc:(fun () -> s_ "Package name")
  3370. "pkg_name"
  3371. (fun () -> (pkg_get ()).name)
  3372. let pkg_version =
  3373. var_define
  3374. ~short_desc:(fun () -> s_ "Package version")
  3375. "pkg_version"
  3376. (fun () ->
  3377. (OASISVersion.string_of_version (pkg_get ()).version))
  3378. let c = BaseOCamlcConfig.var_define
  3379. let os_type = c "os_type"
  3380. let system = c "system"
  3381. let architecture = c "architecture"
  3382. let ccomp_type = c "ccomp_type"
  3383. let ocaml_version = c "ocaml_version"
  3384. (* TODO: Check standard variable presence at runtime *)
  3385. let standard_library_default = c "standard_library_default"
  3386. let standard_library = c "standard_library"
  3387. let standard_runtime = c "standard_runtime"
  3388. let bytecomp_c_compiler = c "bytecomp_c_compiler"
  3389. let native_c_compiler = c "native_c_compiler"
  3390. let model = c "model"
  3391. let ext_obj = c "ext_obj"
  3392. let ext_asm = c "ext_asm"
  3393. let ext_lib = c "ext_lib"
  3394. let ext_dll = c "ext_dll"
  3395. let default_executable_name = c "default_executable_name"
  3396. let systhread_supported = c "systhread_supported"
  3397. let flexlink =
  3398. BaseCheck.prog "flexlink"
  3399. let flexdll_version =
  3400. var_define
  3401. ~short_desc:(fun () -> "FlexDLL version (Win32)")
  3402. "flexdll_version"
  3403. (fun () ->
  3404. let lst =
  3405. OASISExec.run_read_output ~ctxt:!BaseContext.default
  3406. (flexlink ()) ["-help"]
  3407. in
  3408. match lst with
  3409. | line :: _ ->
  3410. Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
  3411. | [] ->
  3412. raise Not_found)
  3413. (**/**)
  3414. let p name hlp dflt =
  3415. var_define
  3416. ~short_desc:hlp
  3417. ~cli:CLIAuto
  3418. ~arg_help:"dir"
  3419. name
  3420. dflt
  3421. let (/) a b =
  3422. if os_type () = Sys.os_type then
  3423. Filename.concat a b
  3424. else if os_type () = "Unix" || os_type () = "Cygwin" then
  3425. OASISUnixPath.concat a b
  3426. else
  3427. OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
  3428. (os_type ())
  3429. (**/**)
  3430. let prefix =
  3431. p "prefix"
  3432. (fun () -> s_ "Install architecture-independent files dir")
  3433. (fun () ->
  3434. match os_type () with
  3435. | "Win32" ->
  3436. let program_files =
  3437. Sys.getenv "PROGRAMFILES"
  3438. in
  3439. program_files/(pkg_name ())
  3440. | _ ->
  3441. "/usr/local")
  3442. let exec_prefix =
  3443. p "exec_prefix"
  3444. (fun () -> s_ "Install architecture-dependent files in dir")
  3445. (fun () -> "$prefix")
  3446. let bindir =
  3447. p "bindir"
  3448. (fun () -> s_ "User executables")
  3449. (fun () -> "$exec_prefix"/"bin")
  3450. let sbindir =
  3451. p "sbindir"
  3452. (fun () -> s_ "System admin executables")
  3453. (fun () -> "$exec_prefix"/"sbin")
  3454. let libexecdir =
  3455. p "libexecdir"
  3456. (fun () -> s_ "Program executables")
  3457. (fun () -> "$exec_prefix"/"libexec")
  3458. let sysconfdir =
  3459. p "sysconfdir"
  3460. (fun () -> s_ "Read-only single-machine data")
  3461. (fun () -> "$prefix"/"etc")
  3462. let sharedstatedir =
  3463. p "sharedstatedir"
  3464. (fun () -> s_ "Modifiable architecture-independent data")
  3465. (fun () -> "$prefix"/"com")
  3466. let localstatedir =
  3467. p "localstatedir"
  3468. (fun () -> s_ "Modifiable single-machine data")
  3469. (fun () -> "$prefix"/"var")
  3470. let libdir =
  3471. p "libdir"
  3472. (fun () -> s_ "Object code libraries")
  3473. (fun () -> "$exec_prefix"/"lib")
  3474. let datarootdir =
  3475. p "datarootdir"
  3476. (fun () -> s_ "Read-only arch-independent data root")
  3477. (fun () -> "$prefix"/"share")
  3478. let datadir =
  3479. p "datadir"
  3480. (fun () -> s_ "Read-only architecture-independent data")
  3481. (fun () -> "$datarootdir")
  3482. let infodir =
  3483. p "infodir"
  3484. (fun () -> s_ "Info documentation")
  3485. (fun () -> "$datarootdir"/"info")
  3486. let localedir =
  3487. p "localedir"
  3488. (fun () -> s_ "Locale-dependent data")
  3489. (fun () -> "$datarootdir"/"locale")
  3490. let mandir =
  3491. p "mandir"
  3492. (fun () -> s_ "Man documentation")
  3493. (fun () -> "$datarootdir"/"man")
  3494. let docdir =
  3495. p "docdir"
  3496. (fun () -> s_ "Documentation root")
  3497. (fun () -> "$datarootdir"/"doc"/"$pkg_name")
  3498. let htmldir =
  3499. p "htmldir"
  3500. (fun () -> s_ "HTML documentation")
  3501. (fun () -> "$docdir")
  3502. let dvidir =
  3503. p "dvidir"
  3504. (fun () -> s_ "DVI documentation")
  3505. (fun () -> "$docdir")
  3506. let pdfdir =
  3507. p "pdfdir"
  3508. (fun () -> s_ "PDF documentation")
  3509. (fun () -> "$docdir")
  3510. let psdir =
  3511. p "psdir"
  3512. (fun () -> s_ "PS documentation")
  3513. (fun () -> "$docdir")
  3514. let destdir =
  3515. p "destdir"
  3516. (fun () -> s_ "Prepend a path when installing package")
  3517. (fun () ->
  3518. raise
  3519. (PropList.Not_set
  3520. ("destdir",
  3521. Some (s_ "undefined by construct"))))
  3522. let findlib_version =
  3523. var_define
  3524. "findlib_version"
  3525. (fun () ->
  3526. BaseCheck.package_version "findlib")
  3527. let is_native =
  3528. var_define
  3529. "is_native"
  3530. (fun () ->
  3531. try
  3532. let _s: string =
  3533. ocamlopt ()
  3534. in
  3535. "true"
  3536. with PropList.Not_set _ ->
  3537. let _s: string =
  3538. ocamlc ()
  3539. in
  3540. "false")
  3541. let ext_program =
  3542. var_define
  3543. "suffix_program"
  3544. (fun () ->
  3545. match os_type () with
  3546. | "Win32" | "Cygwin" -> ".exe"
  3547. | _ -> "")
  3548. let rm =
  3549. var_define
  3550. ~short_desc:(fun () -> s_ "Remove a file.")
  3551. "rm"
  3552. (fun () ->
  3553. match os_type () with
  3554. | "Win32" -> "del"
  3555. | _ -> "rm -f")
  3556. let rmdir =
  3557. var_define
  3558. ~short_desc:(fun () -> s_ "Remove a directory.")
  3559. "rmdir"
  3560. (fun () ->
  3561. match os_type () with
  3562. | "Win32" -> "rd"
  3563. | _ -> "rm -rf")
  3564. let debug =
  3565. var_define
  3566. ~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
  3567. ~cli:CLIEnable
  3568. "debug"
  3569. (fun () -> "true")
  3570. let profile =
  3571. var_define
  3572. ~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
  3573. ~cli:CLIEnable
  3574. "profile"
  3575. (fun () -> "false")
  3576. let tests =
  3577. var_define_cond ~since_version:"0.3"
  3578. (fun () ->
  3579. var_define
  3580. ~short_desc:(fun () ->
  3581. s_ "Compile tests executable and library and run them")
  3582. ~cli:CLIEnable
  3583. "tests"
  3584. (fun () -> "false"))
  3585. "true"
  3586. let docs =
  3587. var_define_cond ~since_version:"0.3"
  3588. (fun () ->
  3589. var_define
  3590. ~short_desc:(fun () -> s_ "Create documentations")
  3591. ~cli:CLIEnable
  3592. "docs"
  3593. (fun () -> "true"))
  3594. "true"
  3595. let native_dynlink =
  3596. var_define
  3597. ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
  3598. ~cli:CLINone
  3599. "native_dynlink"
  3600. (fun () ->
  3601. let res =
  3602. let ocaml_lt_312 () =
  3603. OASISVersion.comparator_apply
  3604. (OASISVersion.version_of_string (ocaml_version ()))
  3605. (OASISVersion.VLesser
  3606. (OASISVersion.version_of_string "3.12.0"))
  3607. in
  3608. let flexdll_lt_030 () =
  3609. OASISVersion.comparator_apply
  3610. (OASISVersion.version_of_string (flexdll_version ()))
  3611. (OASISVersion.VLesser
  3612. (OASISVersion.version_of_string "0.30"))
  3613. in
  3614. let has_native_dynlink =
  3615. let ocamlfind = ocamlfind () in
  3616. try
  3617. let fn =
  3618. OASISExec.run_read_one_line
  3619. ~ctxt:!BaseContext.default
  3620. ocamlfind
  3621. ["query"; "-predicates"; "native"; "dynlink";
  3622. "-format"; "%d/%a"]
  3623. in
  3624. Sys.file_exists fn
  3625. with _ ->
  3626. false
  3627. in
  3628. if not has_native_dynlink then
  3629. false
  3630. else if ocaml_lt_312 () then
  3631. false
  3632. else if (os_type () = "Win32" || os_type () = "Cygwin")
  3633. && flexdll_lt_030 () then
  3634. begin
  3635. BaseMessage.warning
  3636. (f_ ".cmxs generation disabled because FlexDLL needs to be \
  3637. at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
  3638. (flexdll_version ());
  3639. false
  3640. end
  3641. else
  3642. true
  3643. in
  3644. string_of_bool res)
  3645. let init pkg =
  3646. rpkg := Some pkg;
  3647. List.iter (fun f -> f pkg.oasis_version) !var_cond
  3648. end
  3649. module BaseFileAB = struct
  3650. (* # 22 "src/base/BaseFileAB.ml" *)
  3651. open BaseEnv
  3652. open OASISGettext
  3653. open BaseMessage
  3654. open OASISContext
  3655. let to_filename fn =
  3656. if not (Filename.check_suffix fn ".ab") then
  3657. warning (f_ "File '%s' doesn't have '.ab' extension") fn;
  3658. OASISFileSystem.of_unix_filename (Filename.chop_extension fn)
  3659. let replace ~ctxt fn_lst =
  3660. let open OASISFileSystem in
  3661. let ibuf, obuf = Buffer.create 13, Buffer.create 13 in
  3662. List.iter
  3663. (fun fn ->
  3664. Buffer.clear ibuf; Buffer.clear obuf;
  3665. defer_close
  3666. (ctxt.srcfs#open_in (of_unix_filename fn))
  3667. (read_all ibuf);
  3668. Buffer.add_string obuf (var_expand (Buffer.contents ibuf));
  3669. defer_close
  3670. (ctxt.srcfs#open_out (to_filename fn))
  3671. (fun wrtr -> wrtr#output obuf))
  3672. fn_lst
  3673. end
  3674. module BaseLog = struct
  3675. (* # 22 "src/base/BaseLog.ml" *)
  3676. open OASISUtils
  3677. open OASISContext
  3678. open OASISGettext
  3679. open OASISFileSystem
  3680. let default_filename = in_srcdir "setup.log"
  3681. let load ~ctxt () =
  3682. let module SetTupleString =
  3683. Set.Make
  3684. (struct
  3685. type t = string * string
  3686. let compare (s11, s12) (s21, s22) =
  3687. match String.compare s11 s21 with
  3688. | 0 -> String.compare s12 s22
  3689. | n -> n
  3690. end)
  3691. in
  3692. if ctxt.srcfs#file_exists default_filename then begin
  3693. defer_close
  3694. (ctxt.srcfs#open_in default_filename)
  3695. (fun rdr ->
  3696. let line = ref 1 in
  3697. let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in
  3698. let rec read_aux (st, lst) =
  3699. match Stream.npeek 2 lxr with
  3700. | [Genlex.String e; Genlex.String d] ->
  3701. let t = e, d in
  3702. Stream.junk lxr; Stream.junk lxr;
  3703. if SetTupleString.mem t st then
  3704. read_aux (st, lst)
  3705. else
  3706. read_aux (SetTupleString.add t st, t :: lst)
  3707. | [] -> List.rev lst
  3708. | _ ->
  3709. failwithf
  3710. (f_ "Malformed log file '%s' at line %d")
  3711. (ctxt.srcfs#string_of_filename default_filename)
  3712. !line
  3713. in
  3714. read_aux (SetTupleString.empty, []))
  3715. end else begin
  3716. []
  3717. end
  3718. let register ~ctxt event data =
  3719. defer_close
  3720. (ctxt.srcfs#open_out
  3721. ~mode:[Open_append; Open_creat; Open_text]
  3722. ~perm:0o644
  3723. default_filename)
  3724. (fun wrtr ->
  3725. let buf = Buffer.create 13 in
  3726. Printf.bprintf buf "%S %S\n" event data;
  3727. wrtr#output buf)
  3728. let unregister ~ctxt event data =
  3729. let lst = load ~ctxt () in
  3730. let buf = Buffer.create 13 in
  3731. List.iter
  3732. (fun (e, d) ->
  3733. if e <> event || d <> data then
  3734. Printf.bprintf buf "%S %S\n" e d)
  3735. lst;
  3736. if Buffer.length buf > 0 then
  3737. defer_close
  3738. (ctxt.srcfs#open_out default_filename)
  3739. (fun wrtr -> wrtr#output buf)
  3740. else
  3741. ctxt.srcfs#remove default_filename
  3742. let filter ~ctxt events =
  3743. let st_events = SetString.of_list events in
  3744. List.filter
  3745. (fun (e, _) -> SetString.mem e st_events)
  3746. (load ~ctxt ())
  3747. let exists ~ctxt event data =
  3748. List.exists
  3749. (fun v -> (event, data) = v)
  3750. (load ~ctxt ())
  3751. end
  3752. module BaseBuilt = struct
  3753. (* # 22 "src/base/BaseBuilt.ml" *)
  3754. open OASISTypes
  3755. open OASISGettext
  3756. open BaseStandardVar
  3757. open BaseMessage
  3758. type t =
  3759. | BExec (* Executable *)
  3760. | BExecLib (* Library coming with executable *)
  3761. | BLib (* Library *)
  3762. | BObj (* Library *)
  3763. | BDoc (* Document *)
  3764. let to_log_event_file t nm =
  3765. "built_"^
  3766. (match t with
  3767. | BExec -> "exec"
  3768. | BExecLib -> "exec_lib"
  3769. | BLib -> "lib"
  3770. | BObj -> "obj"
  3771. | BDoc -> "doc")^
  3772. "_"^nm
  3773. let to_log_event_done t nm =
  3774. "is_"^(to_log_event_file t nm)
  3775. let register ~ctxt t nm lst =
  3776. BaseLog.register ~ctxt (to_log_event_done t nm) "true";
  3777. List.iter
  3778. (fun alt ->
  3779. let registered =
  3780. List.fold_left
  3781. (fun registered fn ->
  3782. if OASISFileUtil.file_exists_case fn then begin
  3783. BaseLog.register ~ctxt
  3784. (to_log_event_file t nm)
  3785. (if Filename.is_relative fn then
  3786. Filename.concat (Sys.getcwd ()) fn
  3787. else
  3788. fn);
  3789. true
  3790. end else begin
  3791. registered
  3792. end)
  3793. false
  3794. alt
  3795. in
  3796. if not registered then
  3797. warning
  3798. (f_ "Cannot find an existing alternative files among: %s")
  3799. (String.concat (s_ ", ") alt))
  3800. lst
  3801. let unregister ~ctxt t nm =
  3802. List.iter
  3803. (fun (e, d) -> BaseLog.unregister ~ctxt e d)
  3804. (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])
  3805. let fold ~ctxt t nm f acc =
  3806. List.fold_left
  3807. (fun acc (_, fn) ->
  3808. if OASISFileUtil.file_exists_case fn then begin
  3809. f acc fn
  3810. end else begin
  3811. warning
  3812. (f_ "File '%s' has been marked as built \
  3813. for %s but doesn't exist")
  3814. fn
  3815. (Printf.sprintf
  3816. (match t with
  3817. | BExec | BExecLib -> (f_ "executable %s")
  3818. | BLib -> (f_ "library %s")
  3819. | BObj -> (f_ "object %s")
  3820. | BDoc -> (f_ "documentation %s"))
  3821. nm);
  3822. acc
  3823. end)
  3824. acc
  3825. (BaseLog.filter ~ctxt [to_log_event_file t nm])
  3826. let is_built ~ctxt t nm =
  3827. List.fold_left
  3828. (fun _ (_, d) -> try bool_of_string d with _ -> false)
  3829. false
  3830. (BaseLog.filter ~ctxt [to_log_event_done t nm])
  3831. let of_executable ffn (cs, bs, exec) =
  3832. let unix_exec_is, unix_dll_opt =
  3833. OASISExecutable.unix_exec_is
  3834. (cs, bs, exec)
  3835. (fun () ->
  3836. bool_of_string
  3837. (is_native ()))
  3838. ext_dll
  3839. ext_program
  3840. in
  3841. let evs =
  3842. (BExec, cs.cs_name, [[ffn unix_exec_is]])
  3843. ::
  3844. (match unix_dll_opt with
  3845. | Some fn ->
  3846. [BExecLib, cs.cs_name, [[ffn fn]]]
  3847. | None ->
  3848. [])
  3849. in
  3850. evs,
  3851. unix_exec_is,
  3852. unix_dll_opt
  3853. let of_library ffn (cs, bs, lib) =
  3854. let unix_lst =
  3855. OASISLibrary.generated_unix_files
  3856. ~ctxt:!BaseContext.default
  3857. ~source_file_exists:(fun fn ->
  3858. OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
  3859. ~is_native:(bool_of_string (is_native ()))
  3860. ~has_native_dynlink:(bool_of_string (native_dynlink ()))
  3861. ~ext_lib:(ext_lib ())
  3862. ~ext_dll:(ext_dll ())
  3863. (cs, bs, lib)
  3864. in
  3865. let evs =
  3866. [BLib,
  3867. cs.cs_name,
  3868. List.map (List.map ffn) unix_lst]
  3869. in
  3870. evs, unix_lst
  3871. let of_object ffn (cs, bs, obj) =
  3872. let unix_lst =
  3873. OASISObject.generated_unix_files
  3874. ~ctxt:!BaseContext.default
  3875. ~source_file_exists:(fun fn ->
  3876. OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
  3877. ~is_native:(bool_of_string (is_native ()))
  3878. (cs, bs, obj)
  3879. in
  3880. let evs =
  3881. [BObj,
  3882. cs.cs_name,
  3883. List.map (List.map ffn) unix_lst]
  3884. in
  3885. evs, unix_lst
  3886. end
  3887. module BaseCustom = struct
  3888. (* # 22 "src/base/BaseCustom.ml" *)
  3889. open BaseEnv
  3890. open BaseMessage
  3891. open OASISTypes
  3892. open OASISGettext
  3893. let run cmd args extra_args =
  3894. OASISExec.run ~ctxt:!BaseContext.default ~quote:false
  3895. (var_expand cmd)
  3896. (List.map
  3897. var_expand
  3898. (args @ (Array.to_list extra_args)))
  3899. let hook ?(failsafe=false) cstm f e =
  3900. let optional_command lst =
  3901. let printer =
  3902. function
  3903. | Some (cmd, args) -> String.concat " " (cmd :: args)
  3904. | None -> s_ "No command"
  3905. in
  3906. match
  3907. var_choose
  3908. ~name:(s_ "Pre/Post Command")
  3909. ~printer
  3910. lst with
  3911. | Some (cmd, args) ->
  3912. begin
  3913. try
  3914. run cmd args [||]
  3915. with e when failsafe ->
  3916. warning
  3917. (f_ "Command '%s' fail with error: %s")
  3918. (String.concat " " (cmd :: args))
  3919. (match e with
  3920. | Failure msg -> msg
  3921. | e -> Printexc.to_string e)
  3922. end
  3923. | None ->
  3924. ()
  3925. in
  3926. let res =
  3927. optional_command cstm.pre_command;
  3928. f e
  3929. in
  3930. optional_command cstm.post_command;
  3931. res
  3932. end
  3933. module BaseDynVar = struct
  3934. (* # 22 "src/base/BaseDynVar.ml" *)
  3935. open OASISTypes
  3936. open OASISGettext
  3937. open BaseEnv
  3938. open BaseBuilt
  3939. let init ~ctxt pkg =
  3940. (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
  3941. (* TODO: provide compile option for library libary_byte_args_VARNAME... *)
  3942. List.iter
  3943. (function
  3944. | Executable (cs, bs, _) ->
  3945. if var_choose bs.bs_build then
  3946. var_ignore
  3947. (var_redefine
  3948. (* We don't save this variable *)
  3949. ~dump:false
  3950. ~short_desc:(fun () ->
  3951. Printf.sprintf
  3952. (f_ "Filename of executable '%s'")
  3953. cs.cs_name)
  3954. (OASISUtils.varname_of_string cs.cs_name)
  3955. (fun () ->
  3956. let fn_opt =
  3957. fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None
  3958. in
  3959. match fn_opt with
  3960. | Some fn -> fn
  3961. | None ->
  3962. raise
  3963. (PropList.Not_set
  3964. (cs.cs_name,
  3965. Some (Printf.sprintf
  3966. (f_ "Executable '%s' not yet built.")
  3967. cs.cs_name)))))
  3968. | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
  3969. ())
  3970. pkg.sections
  3971. end
  3972. module BaseTest = struct
  3973. (* # 22 "src/base/BaseTest.ml" *)
  3974. open BaseEnv
  3975. open BaseMessage
  3976. open OASISTypes
  3977. open OASISGettext
  3978. let test ~ctxt lst pkg extra_args =
  3979. let one_test (failure, n) (test_plugin, cs, test) =
  3980. if var_choose
  3981. ~name:(Printf.sprintf
  3982. (f_ "test %s run")
  3983. cs.cs_name)
  3984. ~printer:string_of_bool
  3985. test.test_run then
  3986. begin
  3987. let () = info (f_ "Running test '%s'") cs.cs_name in
  3988. let back_cwd =
  3989. match test.test_working_directory with
  3990. | Some dir ->
  3991. let cwd = Sys.getcwd () in
  3992. let chdir d =
  3993. info (f_ "Changing directory to '%s'") d;
  3994. Sys.chdir d
  3995. in
  3996. chdir dir;
  3997. fun () -> chdir cwd
  3998. | None ->
  3999. fun () -> ()
  4000. in
  4001. try
  4002. let failure_percent =
  4003. BaseCustom.hook
  4004. test.test_custom
  4005. (test_plugin ~ctxt pkg (cs, test))
  4006. extra_args
  4007. in
  4008. back_cwd ();
  4009. (failure_percent +. failure, n + 1)
  4010. with e ->
  4011. begin
  4012. back_cwd ();
  4013. raise e
  4014. end
  4015. end
  4016. else
  4017. begin
  4018. info (f_ "Skipping test '%s'") cs.cs_name;
  4019. (failure, n)
  4020. end
  4021. in
  4022. let failed, n = List.fold_left one_test (0.0, 0) lst in
  4023. let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in
  4024. let msg =
  4025. Printf.sprintf
  4026. (f_ "Tests had a %.2f%% failure rate")
  4027. (100. *. failure_percent)
  4028. in
  4029. if failure_percent > 0.0 then
  4030. failwith msg
  4031. else
  4032. info "%s" msg;
  4033. (* Possible explanation why the tests where not run. *)
  4034. if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
  4035. not (bool_of_string (BaseStandardVar.tests ())) &&
  4036. lst <> [] then
  4037. BaseMessage.warning
  4038. "Tests are turned off, consider enabling with \
  4039. 'ocaml setup.ml -configure --enable-tests'"
  4040. end
  4041. module BaseDoc = struct
  4042. (* # 22 "src/base/BaseDoc.ml" *)
  4043. open BaseEnv
  4044. open BaseMessage
  4045. open OASISTypes
  4046. open OASISGettext
  4047. let doc ~ctxt lst pkg extra_args =
  4048. let one_doc (doc_plugin, cs, doc) =
  4049. if var_choose
  4050. ~name:(Printf.sprintf
  4051. (f_ "documentation %s build")
  4052. cs.cs_name)
  4053. ~printer:string_of_bool
  4054. doc.doc_build then
  4055. begin
  4056. info (f_ "Building documentation '%s'") cs.cs_name;
  4057. BaseCustom.hook
  4058. doc.doc_custom
  4059. (doc_plugin ~ctxt pkg (cs, doc))
  4060. extra_args
  4061. end
  4062. in
  4063. List.iter one_doc lst;
  4064. if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
  4065. not (bool_of_string (BaseStandardVar.docs ())) &&
  4066. lst <> [] then
  4067. BaseMessage.warning
  4068. "Docs are turned off, consider enabling with \
  4069. 'ocaml setup.ml -configure --enable-docs'"
  4070. end
  4071. module BaseSetup = struct
  4072. (* # 22 "src/base/BaseSetup.ml" *)
  4073. open OASISContext
  4074. open BaseEnv
  4075. open BaseMessage
  4076. open OASISTypes
  4077. open OASISGettext
  4078. open OASISUtils
  4079. type std_args_fun =
  4080. ctxt:OASISContext.t -> package -> string array -> unit
  4081. type ('a, 'b) section_args_fun =
  4082. name *
  4083. (ctxt:OASISContext.t ->
  4084. package ->
  4085. (common_section * 'a) ->
  4086. string array ->
  4087. 'b)
  4088. type t =
  4089. {
  4090. configure: std_args_fun;
  4091. build: std_args_fun;
  4092. doc: ((doc, unit) section_args_fun) list;
  4093. test: ((test, float) section_args_fun) list;
  4094. install: std_args_fun;
  4095. uninstall: std_args_fun;
  4096. clean: std_args_fun list;
  4097. clean_doc: (doc, unit) section_args_fun list;
  4098. clean_test: (test, unit) section_args_fun list;
  4099. distclean: std_args_fun list;
  4100. distclean_doc: (doc, unit) section_args_fun list;
  4101. distclean_test: (test, unit) section_args_fun list;
  4102. package: package;
  4103. oasis_fn: string option;
  4104. oasis_version: string;
  4105. oasis_digest: Digest.t option;
  4106. oasis_exec: string option;
  4107. oasis_setup_args: string list;
  4108. setup_update: bool;
  4109. }
  4110. (* Associate a plugin function with data from package *)
  4111. let join_plugin_sections filter_map lst =
  4112. List.rev
  4113. (List.fold_left
  4114. (fun acc sct ->
  4115. match filter_map sct with
  4116. | Some e ->
  4117. e :: acc
  4118. | None ->
  4119. acc)
  4120. []
  4121. lst)
  4122. (* Search for plugin data associated with a section name *)
  4123. let lookup_plugin_section plugin action nm lst =
  4124. try
  4125. List.assoc nm lst
  4126. with Not_found ->
  4127. failwithf
  4128. (f_ "Cannot find plugin %s matching section %s for %s action")
  4129. plugin
  4130. nm
  4131. action
  4132. let configure ~ctxt t args =
  4133. (* Run configure *)
  4134. BaseCustom.hook
  4135. t.package.conf_custom
  4136. (fun () ->
  4137. (* Reload if preconf has changed it *)
  4138. begin
  4139. try
  4140. unload ();
  4141. load ~ctxt ();
  4142. with _ ->
  4143. ()
  4144. end;
  4145. (* Run plugin's configure *)
  4146. t.configure ~ctxt t.package args;
  4147. (* Dump to allow postconf to change it *)
  4148. dump ~ctxt ())
  4149. ();
  4150. (* Reload environment *)
  4151. unload ();
  4152. load ~ctxt ();
  4153. (* Save environment *)
  4154. print ();
  4155. (* Replace data in file *)
  4156. BaseFileAB.replace ~ctxt t.package.files_ab
  4157. let build ~ctxt t args =
  4158. BaseCustom.hook
  4159. t.package.build_custom
  4160. (t.build ~ctxt t.package)
  4161. args
  4162. let doc ~ctxt t args =
  4163. BaseDoc.doc
  4164. ~ctxt
  4165. (join_plugin_sections
  4166. (function
  4167. | Doc (cs, e) ->
  4168. Some
  4169. (lookup_plugin_section
  4170. "documentation"
  4171. (s_ "build")
  4172. cs.cs_name
  4173. t.doc,
  4174. cs,
  4175. e)
  4176. | _ ->
  4177. None)
  4178. t.package.sections)
  4179. t.package
  4180. args
  4181. let test ~ctxt t args =
  4182. BaseTest.test
  4183. ~ctxt
  4184. (join_plugin_sections
  4185. (function
  4186. | Test (cs, e) ->
  4187. Some
  4188. (lookup_plugin_section
  4189. "test"
  4190. (s_ "run")
  4191. cs.cs_name
  4192. t.test,
  4193. cs,
  4194. e)
  4195. | _ ->
  4196. None)
  4197. t.package.sections)
  4198. t.package
  4199. args
  4200. let all ~ctxt t args =
  4201. let rno_doc = ref false in
  4202. let rno_test = ref false in
  4203. let arg_rest = ref [] in
  4204. Arg.parse_argv
  4205. ~current:(ref 0)
  4206. (Array.of_list
  4207. ((Sys.executable_name^" all") ::
  4208. (Array.to_list args)))
  4209. [
  4210. "-no-doc",
  4211. Arg.Set rno_doc,
  4212. s_ "Don't run doc target";
  4213. "-no-test",
  4214. Arg.Set rno_test,
  4215. s_ "Don't run test target";
  4216. "--",
  4217. Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
  4218. s_ "All arguments for configure.";
  4219. ]
  4220. (failwithf (f_ "Don't know what to do with '%s'"))
  4221. "";
  4222. info "Running configure step";
  4223. configure ~ctxt t (Array.of_list (List.rev !arg_rest));
  4224. info "Running build step";
  4225. build ~ctxt t [||];
  4226. (* Load setup.log dynamic variables *)
  4227. BaseDynVar.init ~ctxt t.package;
  4228. if not !rno_doc then begin
  4229. info "Running doc step";
  4230. doc ~ctxt t [||]
  4231. end else begin
  4232. info "Skipping doc step"
  4233. end;
  4234. if not !rno_test then begin
  4235. info "Running test step";
  4236. test ~ctxt t [||]
  4237. end else begin
  4238. info "Skipping test step"
  4239. end
  4240. let install ~ctxt t args =
  4241. BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args
  4242. let uninstall ~ctxt t args =
  4243. BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args
  4244. let reinstall ~ctxt t args =
  4245. uninstall ~ctxt t args;
  4246. install ~ctxt t args
  4247. let clean, distclean =
  4248. let failsafe f a =
  4249. try
  4250. f a
  4251. with e ->
  4252. warning
  4253. (f_ "Action fail with error: %s")
  4254. (match e with
  4255. | Failure msg -> msg
  4256. | e -> Printexc.to_string e)
  4257. in
  4258. let generic_clean ~ctxt t cstm mains docs tests args =
  4259. BaseCustom.hook
  4260. ~failsafe:true
  4261. cstm
  4262. (fun () ->
  4263. (* Clean section *)
  4264. List.iter
  4265. (function
  4266. | Test (cs, test) ->
  4267. let f =
  4268. try
  4269. List.assoc cs.cs_name tests
  4270. with Not_found ->
  4271. fun ~ctxt:_ _ _ _ -> ()
  4272. in
  4273. failsafe (f ~ctxt t.package (cs, test)) args
  4274. | Doc (cs, doc) ->
  4275. let f =
  4276. try
  4277. List.assoc cs.cs_name docs
  4278. with Not_found ->
  4279. fun ~ctxt:_ _ _ _ -> ()
  4280. in
  4281. failsafe (f ~ctxt t.package (cs, doc)) args
  4282. | Library _ | Object _ | Executable _ | Flag _ | SrcRepo _ -> ())
  4283. t.package.sections;
  4284. (* Clean whole package *)
  4285. List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)
  4286. ()
  4287. in
  4288. let clean ~ctxt t args =
  4289. generic_clean
  4290. ~ctxt
  4291. t
  4292. t.package.clean_custom
  4293. t.clean
  4294. t.clean_doc
  4295. t.clean_test
  4296. args
  4297. in
  4298. let distclean ~ctxt t args =
  4299. (* Call clean *)
  4300. clean ~ctxt t args;
  4301. (* Call distclean code *)
  4302. generic_clean
  4303. ~ctxt
  4304. t
  4305. t.package.distclean_custom
  4306. t.distclean
  4307. t.distclean_doc
  4308. t.distclean_test
  4309. args;
  4310. (* Remove generated source files. *)
  4311. List.iter
  4312. (fun fn ->
  4313. if ctxt.srcfs#file_exists fn then begin
  4314. info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn);
  4315. ctxt.srcfs#remove fn
  4316. end)
  4317. ([BaseEnv.default_filename; BaseLog.default_filename]
  4318. @ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
  4319. in
  4320. clean, distclean
  4321. let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version
  4322. let update_setup_ml, no_update_setup_ml_cli =
  4323. let b = ref true in
  4324. b,
  4325. ("-no-update-setup-ml",
  4326. Arg.Clear b,
  4327. s_ " Don't try to update setup.ml, even if _oasis has changed.")
  4328. (* TODO: srcfs *)
  4329. let default_oasis_fn = "_oasis"
  4330. let update_setup_ml t =
  4331. let oasis_fn =
  4332. match t.oasis_fn with
  4333. | Some fn -> fn
  4334. | None -> default_oasis_fn
  4335. in
  4336. let oasis_exec =
  4337. match t.oasis_exec with
  4338. | Some fn -> fn
  4339. | None -> "oasis"
  4340. in
  4341. let ocaml =
  4342. Sys.executable_name
  4343. in
  4344. let setup_ml, args =
  4345. match Array.to_list Sys.argv with
  4346. | setup_ml :: args ->
  4347. setup_ml, args
  4348. | [] ->
  4349. failwith
  4350. (s_ "Expecting non-empty command line arguments.")
  4351. in
  4352. let ocaml, setup_ml =
  4353. if Sys.executable_name = Sys.argv.(0) then
  4354. (* We are not running in standard mode, probably the script
  4355. * is precompiled.
  4356. *)
  4357. "ocaml", "setup.ml"
  4358. else
  4359. ocaml, setup_ml
  4360. in
  4361. let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in
  4362. let do_update () =
  4363. let oasis_exec_version =
  4364. OASISExec.run_read_one_line
  4365. ~ctxt:!BaseContext.default
  4366. ~f_exit_code:
  4367. (function
  4368. | 0 ->
  4369. ()
  4370. | 1 ->
  4371. failwithf
  4372. (f_ "Executable '%s' is probably an old version \
  4373. of oasis (< 0.3.0), please update to version \
  4374. v%s.")
  4375. oasis_exec t.oasis_version
  4376. | 127 ->
  4377. failwithf
  4378. (f_ "Cannot find executable '%s', please install \
  4379. oasis v%s.")
  4380. oasis_exec t.oasis_version
  4381. | n ->
  4382. failwithf
  4383. (f_ "Command '%s version' exited with code %d.")
  4384. oasis_exec n)
  4385. oasis_exec ["version"]
  4386. in
  4387. if OASISVersion.comparator_apply
  4388. (OASISVersion.version_of_string oasis_exec_version)
  4389. (OASISVersion.VGreaterEqual
  4390. (OASISVersion.version_of_string t.oasis_version)) then
  4391. begin
  4392. (* We have a version >= for the executable oasis, proceed with
  4393. * update.
  4394. *)
  4395. (* TODO: delegate this check to 'oasis setup'. *)
  4396. if Sys.os_type = "Win32" then
  4397. failwithf
  4398. (f_ "It is not possible to update the running script \
  4399. setup.ml on Windows. Please update setup.ml by \
  4400. running '%s'.")
  4401. (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
  4402. else
  4403. begin
  4404. OASISExec.run
  4405. ~ctxt:!BaseContext.default
  4406. ~f_exit_code:
  4407. (fun n ->
  4408. if n <> 0 then
  4409. failwithf
  4410. (f_ "Unable to update setup.ml using '%s', \
  4411. please fix the problem and retry.")
  4412. oasis_exec)
  4413. oasis_exec ("setup" :: t.oasis_setup_args);
  4414. OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
  4415. end
  4416. end
  4417. else
  4418. failwithf
  4419. (f_ "The version of '%s' (v%s) doesn't match the version of \
  4420. oasis used to generate the %s file. Please install at \
  4421. least oasis v%s.")
  4422. oasis_exec oasis_exec_version setup_ml t.oasis_version
  4423. in
  4424. if !update_setup_ml then
  4425. begin
  4426. try
  4427. match t.oasis_digest with
  4428. | Some dgst ->
  4429. if Sys.file_exists oasis_fn &&
  4430. dgst <> Digest.file default_oasis_fn then
  4431. begin
  4432. do_update ();
  4433. true
  4434. end
  4435. else
  4436. false
  4437. | None ->
  4438. false
  4439. with e ->
  4440. error
  4441. (f_ "Error when updating setup.ml. If you want to avoid this error, \
  4442. you can bypass the update of %s by running '%s %s %s %s'")
  4443. setup_ml ocaml setup_ml no_update_setup_ml_cli
  4444. (String.concat " " args);
  4445. raise e
  4446. end
  4447. else
  4448. false
  4449. let setup t =
  4450. let catch_exn = ref true in
  4451. let act_ref =
  4452. ref (fun ~ctxt:_ _ ->
  4453. failwithf
  4454. (f_ "No action defined, run '%s %s -help'")
  4455. Sys.executable_name
  4456. Sys.argv.(0))
  4457. in
  4458. let extra_args_ref = ref [] in
  4459. let allow_empty_env_ref = ref false in
  4460. let arg_handle ?(allow_empty_env=false) act =
  4461. Arg.Tuple
  4462. [
  4463. Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
  4464. Arg.Unit
  4465. (fun () ->
  4466. allow_empty_env_ref := allow_empty_env;
  4467. act_ref := act);
  4468. ]
  4469. in
  4470. try
  4471. let () =
  4472. Arg.parse
  4473. (Arg.align
  4474. ([
  4475. "-configure",
  4476. arg_handle ~allow_empty_env:true configure,
  4477. s_ "[options*] Configure the whole build process.";
  4478. "-build",
  4479. arg_handle build,
  4480. s_ "[options*] Build executables and libraries.";
  4481. "-doc",
  4482. arg_handle doc,
  4483. s_ "[options*] Build documents.";
  4484. "-test",
  4485. arg_handle test,
  4486. s_ "[options*] Run tests.";
  4487. "-all",
  4488. arg_handle ~allow_empty_env:true all,
  4489. s_ "[options*] Run configure, build, doc and test targets.";
  4490. "-install",
  4491. arg_handle install,
  4492. s_ "[options*] Install libraries, data, executables \
  4493. and documents.";
  4494. "-uninstall",
  4495. arg_handle uninstall,
  4496. s_ "[options*] Uninstall libraries, data, executables \
  4497. and documents.";
  4498. "-reinstall",
  4499. arg_handle reinstall,
  4500. s_ "[options*] Uninstall and install libraries, data, \
  4501. executables and documents.";
  4502. "-clean",
  4503. arg_handle ~allow_empty_env:true clean,
  4504. s_ "[options*] Clean files generated by a build.";
  4505. "-distclean",
  4506. arg_handle ~allow_empty_env:true distclean,
  4507. s_ "[options*] Clean files generated by a build and configure.";
  4508. "-version",
  4509. arg_handle ~allow_empty_env:true version,
  4510. s_ " Display version of OASIS used to generate this setup.ml.";
  4511. "-no-catch-exn",
  4512. Arg.Clear catch_exn,
  4513. s_ " Don't catch exception, useful for debugging.";
  4514. ]
  4515. @
  4516. (if t.setup_update then
  4517. [no_update_setup_ml_cli]
  4518. else
  4519. [])
  4520. @ (BaseContext.args ())))
  4521. (failwithf (f_ "Don't know what to do with '%s'"))
  4522. (s_ "Setup and run build process current package\n")
  4523. in
  4524. (* Instantiate the context. *)
  4525. let ctxt = !BaseContext.default in
  4526. (* Build initial environment *)
  4527. load ~ctxt ~allow_empty:!allow_empty_env_ref ();
  4528. (** Initialize flags *)
  4529. List.iter
  4530. (function
  4531. | Flag (cs, {flag_description = hlp;
  4532. flag_default = choices}) ->
  4533. begin
  4534. let apply ?short_desc () =
  4535. var_ignore
  4536. (var_define
  4537. ~cli:CLIEnable
  4538. ?short_desc
  4539. (OASISUtils.varname_of_string cs.cs_name)
  4540. (fun () ->
  4541. string_of_bool
  4542. (var_choose
  4543. ~name:(Printf.sprintf
  4544. (f_ "default value of flag %s")
  4545. cs.cs_name)
  4546. ~printer:string_of_bool
  4547. choices)))
  4548. in
  4549. match hlp with
  4550. | Some hlp -> apply ~short_desc:(fun () -> hlp) ()
  4551. | None -> apply ()
  4552. end
  4553. | _ ->
  4554. ())
  4555. t.package.sections;
  4556. BaseStandardVar.init t.package;
  4557. BaseDynVar.init ~ctxt t.package;
  4558. if not (t.setup_update && update_setup_ml t) then
  4559. !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))
  4560. with e when !catch_exn ->
  4561. error "%s" (Printexc.to_string e);
  4562. exit 1
  4563. end
  4564. module BaseCompat = struct
  4565. (* # 22 "src/base/BaseCompat.ml" *)
  4566. (** Compatibility layer to provide a stable API inside setup.ml.
  4567. This layer allows OASIS to change in between minor versions
  4568. (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This
  4569. enables to write functions that manipulate setup_t inside setup.ml. See
  4570. deps.ml for an example.
  4571. The module opened by default will depend on the version of the _oasis. E.g.
  4572. if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and
  4573. the function Compat_0_3 will be called. If setup.ml is generated with the
  4574. -nocompat, no module will be opened.
  4575. @author Sylvain Le Gall
  4576. *)
  4577. module Compat_0_4 =
  4578. struct
  4579. let rctxt = ref !BaseContext.default
  4580. module BaseSetup =
  4581. struct
  4582. module Original = BaseSetup
  4583. open OASISTypes
  4584. type std_args_fun = package -> string array -> unit
  4585. type ('a, 'b) section_args_fun =
  4586. name * (package -> (common_section * 'a) -> string array -> 'b)
  4587. type t =
  4588. {
  4589. configure: std_args_fun;
  4590. build: std_args_fun;
  4591. doc: ((doc, unit) section_args_fun) list;
  4592. test: ((test, float) section_args_fun) list;
  4593. install: std_args_fun;
  4594. uninstall: std_args_fun;
  4595. clean: std_args_fun list;
  4596. clean_doc: (doc, unit) section_args_fun list;
  4597. clean_test: (test, unit) section_args_fun list;
  4598. distclean: std_args_fun list;
  4599. distclean_doc: (doc, unit) section_args_fun list;
  4600. distclean_test: (test, unit) section_args_fun list;
  4601. package: package;
  4602. oasis_fn: string option;
  4603. oasis_version: string;
  4604. oasis_digest: Digest.t option;
  4605. oasis_exec: string option;
  4606. oasis_setup_args: string list;
  4607. setup_update: bool;
  4608. }
  4609. let setup t =
  4610. let mk_std_args_fun f =
  4611. fun ~ctxt pkg args -> rctxt := ctxt; f pkg args
  4612. in
  4613. let mk_section_args_fun l =
  4614. List.map
  4615. (fun (nm, f) ->
  4616. nm,
  4617. (fun ~ctxt pkg sct args ->
  4618. rctxt := ctxt;
  4619. f pkg sct args))
  4620. l
  4621. in
  4622. let t' =
  4623. {
  4624. Original.
  4625. configure = mk_std_args_fun t.configure;
  4626. build = mk_std_args_fun t.build;
  4627. doc = mk_section_args_fun t.doc;
  4628. test = mk_section_args_fun t.test;
  4629. install = mk_std_args_fun t.install;
  4630. uninstall = mk_std_args_fun t.uninstall;
  4631. clean = List.map mk_std_args_fun t.clean;
  4632. clean_doc = mk_section_args_fun t.clean_doc;
  4633. clean_test = mk_section_args_fun t.clean_test;
  4634. distclean = List.map mk_std_args_fun t.distclean;
  4635. distclean_doc = mk_section_args_fun t.distclean_doc;
  4636. distclean_test = mk_section_args_fun t.distclean_test;
  4637. package = t.package;
  4638. oasis_fn = t.oasis_fn;
  4639. oasis_version = t.oasis_version;
  4640. oasis_digest = t.oasis_digest;
  4641. oasis_exec = t.oasis_exec;
  4642. oasis_setup_args = t.oasis_setup_args;
  4643. setup_update = t.setup_update;
  4644. }
  4645. in
  4646. Original.setup t'
  4647. end
  4648. let adapt_setup_t setup_t =
  4649. let module O = BaseSetup.Original in
  4650. let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in
  4651. let mk_section_args_fun l =
  4652. List.map
  4653. (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))
  4654. l
  4655. in
  4656. {
  4657. BaseSetup.
  4658. configure = mk_std_args_fun setup_t.O.configure;
  4659. build = mk_std_args_fun setup_t.O.build;
  4660. doc = mk_section_args_fun setup_t.O.doc;
  4661. test = mk_section_args_fun setup_t.O.test;
  4662. install = mk_std_args_fun setup_t.O.install;
  4663. uninstall = mk_std_args_fun setup_t.O.uninstall;
  4664. clean = List.map mk_std_args_fun setup_t.O.clean;
  4665. clean_doc = mk_section_args_fun setup_t.O.clean_doc;
  4666. clean_test = mk_section_args_fun setup_t.O.clean_test;
  4667. distclean = List.map mk_std_args_fun setup_t.O.distclean;
  4668. distclean_doc = mk_section_args_fun setup_t.O.distclean_doc;
  4669. distclean_test = mk_section_args_fun setup_t.O.distclean_test;
  4670. package = setup_t.O.package;
  4671. oasis_fn = setup_t.O.oasis_fn;
  4672. oasis_version = setup_t.O.oasis_version;
  4673. oasis_digest = setup_t.O.oasis_digest;
  4674. oasis_exec = setup_t.O.oasis_exec;
  4675. oasis_setup_args = setup_t.O.oasis_setup_args;
  4676. setup_update = setup_t.O.setup_update;
  4677. }
  4678. end
  4679. module Compat_0_3 =
  4680. struct
  4681. include Compat_0_4
  4682. end
  4683. end
  4684. # 5668 "setup.ml"
  4685. module InternalConfigurePlugin = struct
  4686. (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
  4687. (** Configure using internal scheme
  4688. @author Sylvain Le Gall
  4689. *)
  4690. open BaseEnv
  4691. open OASISTypes
  4692. open OASISUtils
  4693. open OASISGettext
  4694. open BaseMessage
  4695. (** Configure build using provided series of check to be done
  4696. and then output corresponding file.
  4697. *)
  4698. let configure ~ctxt:_ pkg argv =
  4699. let var_ignore_eval var = let _s: string = var () in () in
  4700. let errors = ref SetString.empty in
  4701. let buff = Buffer.create 13 in
  4702. let add_errors fmt =
  4703. Printf.kbprintf
  4704. (fun b ->
  4705. errors := SetString.add (Buffer.contents b) !errors;
  4706. Buffer.clear b)
  4707. buff
  4708. fmt
  4709. in
  4710. let warn_exception e =
  4711. warning "%s" (Printexc.to_string e)
  4712. in
  4713. (* Check tools *)
  4714. let check_tools lst =
  4715. List.iter
  4716. (function
  4717. | ExternalTool tool ->
  4718. begin
  4719. try
  4720. var_ignore_eval (BaseCheck.prog tool)
  4721. with e ->
  4722. warn_exception e;
  4723. add_errors (f_ "Cannot find external tool '%s'") tool
  4724. end
  4725. | InternalExecutable nm1 ->
  4726. (* Check that matching tool is built *)
  4727. List.iter
  4728. (function
  4729. | Executable ({cs_name = nm2; _},
  4730. {bs_build = build; _},
  4731. _) when nm1 = nm2 ->
  4732. if not (var_choose build) then
  4733. add_errors
  4734. (f_ "Cannot find buildable internal executable \
  4735. '%s' when checking build depends")
  4736. nm1
  4737. | _ ->
  4738. ())
  4739. pkg.sections)
  4740. lst
  4741. in
  4742. let build_checks sct bs =
  4743. if var_choose bs.bs_build then
  4744. begin
  4745. if bs.bs_compiled_object = Native then
  4746. begin
  4747. try
  4748. var_ignore_eval BaseStandardVar.ocamlopt
  4749. with e ->
  4750. warn_exception e;
  4751. add_errors
  4752. (f_ "Section %s requires native compilation")
  4753. (OASISSection.string_of_section sct)
  4754. end;
  4755. (* Check tools *)
  4756. check_tools bs.bs_build_tools;
  4757. (* Check depends *)
  4758. List.iter
  4759. (function
  4760. | FindlibPackage (findlib_pkg, version_comparator) ->
  4761. begin
  4762. try
  4763. var_ignore_eval
  4764. (BaseCheck.package ?version_comparator findlib_pkg)
  4765. with e ->
  4766. warn_exception e;
  4767. match version_comparator with
  4768. | None ->
  4769. add_errors
  4770. (f_ "Cannot find findlib package %s")
  4771. findlib_pkg
  4772. | Some ver_cmp ->
  4773. add_errors
  4774. (f_ "Cannot find findlib package %s (%s)")
  4775. findlib_pkg
  4776. (OASISVersion.string_of_comparator ver_cmp)
  4777. end
  4778. | InternalLibrary nm1 ->
  4779. (* Check that matching library is built *)
  4780. List.iter
  4781. (function
  4782. | Library ({cs_name = nm2; _},
  4783. {bs_build = build; _},
  4784. _) when nm1 = nm2 ->
  4785. if not (var_choose build) then
  4786. add_errors
  4787. (f_ "Cannot find buildable internal library \
  4788. '%s' when checking build depends")
  4789. nm1
  4790. | _ ->
  4791. ())
  4792. pkg.sections)
  4793. bs.bs_build_depends
  4794. end
  4795. in
  4796. (* Parse command line *)
  4797. BaseArgExt.parse argv (BaseEnv.args ());
  4798. (* OCaml version *)
  4799. begin
  4800. match pkg.ocaml_version with
  4801. | Some ver_cmp ->
  4802. begin
  4803. try
  4804. var_ignore_eval
  4805. (BaseCheck.version
  4806. "ocaml"
  4807. ver_cmp
  4808. BaseStandardVar.ocaml_version)
  4809. with e ->
  4810. warn_exception e;
  4811. add_errors
  4812. (f_ "OCaml version %s doesn't match version constraint %s")
  4813. (BaseStandardVar.ocaml_version ())
  4814. (OASISVersion.string_of_comparator ver_cmp)
  4815. end
  4816. | None ->
  4817. ()
  4818. end;
  4819. (* Findlib version *)
  4820. begin
  4821. match pkg.findlib_version with
  4822. | Some ver_cmp ->
  4823. begin
  4824. try
  4825. var_ignore_eval
  4826. (BaseCheck.version
  4827. "findlib"
  4828. ver_cmp
  4829. BaseStandardVar.findlib_version)
  4830. with e ->
  4831. warn_exception e;
  4832. add_errors
  4833. (f_ "Findlib version %s doesn't match version constraint %s")
  4834. (BaseStandardVar.findlib_version ())
  4835. (OASISVersion.string_of_comparator ver_cmp)
  4836. end
  4837. | None ->
  4838. ()
  4839. end;
  4840. (* Make sure the findlib version is fine for the OCaml compiler. *)
  4841. begin
  4842. let ocaml_ge4 =
  4843. OASISVersion.version_compare
  4844. (OASISVersion.version_of_string (BaseStandardVar.ocaml_version ()))
  4845. (OASISVersion.version_of_string "4.0.0") >= 0 in
  4846. if ocaml_ge4 then
  4847. let findlib_lt132 =
  4848. OASISVersion.version_compare
  4849. (OASISVersion.version_of_string (BaseStandardVar.findlib_version()))
  4850. (OASISVersion.version_of_string "1.3.2") < 0 in
  4851. if findlib_lt132 then
  4852. add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2"
  4853. end;
  4854. (* FlexDLL *)
  4855. if BaseStandardVar.os_type () = "Win32" ||
  4856. BaseStandardVar.os_type () = "Cygwin" then
  4857. begin
  4858. try
  4859. var_ignore_eval BaseStandardVar.flexlink
  4860. with e ->
  4861. warn_exception e;
  4862. add_errors (f_ "Cannot find 'flexlink'")
  4863. end;
  4864. (* Check build depends *)
  4865. List.iter
  4866. (function
  4867. | Executable (_, bs, _)
  4868. | Library (_, bs, _) as sct ->
  4869. build_checks sct bs
  4870. | Doc (_, doc) ->
  4871. if var_choose doc.doc_build then
  4872. check_tools doc.doc_build_tools
  4873. | Test (_, test) ->
  4874. if var_choose test.test_run then
  4875. check_tools test.test_tools
  4876. | _ ->
  4877. ())
  4878. pkg.sections;
  4879. (* Check if we need native dynlink (presence of libraries that compile to
  4880. native)
  4881. *)
  4882. begin
  4883. let has_cmxa =
  4884. List.exists
  4885. (function
  4886. | Library (_, bs, _) ->
  4887. var_choose bs.bs_build &&
  4888. (bs.bs_compiled_object = Native ||
  4889. (bs.bs_compiled_object = Best &&
  4890. bool_of_string (BaseStandardVar.is_native ())))
  4891. | _ ->
  4892. false)
  4893. pkg.sections
  4894. in
  4895. if has_cmxa then
  4896. var_ignore_eval BaseStandardVar.native_dynlink
  4897. end;
  4898. (* Check errors *)
  4899. if SetString.empty != !errors then
  4900. begin
  4901. List.iter
  4902. (fun e -> error "%s" e)
  4903. (SetString.elements !errors);
  4904. failwithf
  4905. (fn_
  4906. "%d configuration error"
  4907. "%d configuration errors"
  4908. (SetString.cardinal !errors))
  4909. (SetString.cardinal !errors)
  4910. end
  4911. end
  4912. module InternalInstallPlugin = struct
  4913. (* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *)
  4914. (** Install using internal scheme
  4915. @author Sylvain Le Gall
  4916. *)
  4917. (* TODO: rewrite this module with OASISFileSystem. *)
  4918. open BaseEnv
  4919. open BaseStandardVar
  4920. open BaseMessage
  4921. open OASISTypes
  4922. open OASISFindlib
  4923. open OASISGettext
  4924. open OASISUtils
  4925. let exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)
  4926. let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])
  4927. let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])
  4928. let doc_hook = ref (fun (cs, doc) -> cs, doc)
  4929. let install_file_ev = "install-file"
  4930. let install_dir_ev = "install-dir"
  4931. let install_findlib_ev = "install-findlib"
  4932. (* TODO: this can be more generic and used elsewhere. *)
  4933. let win32_max_command_line_length = 8000
  4934. let split_install_command ocamlfind findlib_name meta files =
  4935. if Sys.os_type = "Win32" then
  4936. (* Arguments for the first command: *)
  4937. let first_args = ["install"; findlib_name; meta] in
  4938. (* Arguments for remaining commands: *)
  4939. let other_args = ["install"; findlib_name; "-add"] in
  4940. (* Extract as much files as possible from [files], [len] is
  4941. the current command line length: *)
  4942. let rec get_files len acc files =
  4943. match files with
  4944. | [] ->
  4945. (List.rev acc, [])
  4946. | file :: rest ->
  4947. let len = len + 1 + String.length file in
  4948. if len > win32_max_command_line_length then
  4949. (List.rev acc, files)
  4950. else
  4951. get_files len (file :: acc) rest
  4952. in
  4953. (* Split the command into several commands. *)
  4954. let rec split args files =
  4955. match files with
  4956. | [] ->
  4957. []
  4958. | _ ->
  4959. (* Length of "ocamlfind install <lib> [META|-add]" *)
  4960. let len =
  4961. List.fold_left
  4962. (fun len arg ->
  4963. len + 1 (* for the space *) + String.length arg)
  4964. (String.length ocamlfind)
  4965. args
  4966. in
  4967. match get_files len [] files with
  4968. | ([], _) ->
  4969. failwith (s_ "Command line too long.")
  4970. | (firsts, others) ->
  4971. let cmd = args @ firsts in
  4972. (* Use -add for remaining commands: *)
  4973. let () =
  4974. let findlib_ge_132 =
  4975. OASISVersion.comparator_apply
  4976. (OASISVersion.version_of_string
  4977. (BaseStandardVar.findlib_version ()))
  4978. (OASISVersion.VGreaterEqual
  4979. (OASISVersion.version_of_string "1.3.2"))
  4980. in
  4981. if not findlib_ge_132 then
  4982. failwithf
  4983. (f_ "Installing the library %s require to use the \
  4984. flag '-add' of ocamlfind because the command \
  4985. line is too long. This flag is only available \
  4986. for findlib 1.3.2. Please upgrade findlib from \
  4987. %s to 1.3.2")
  4988. findlib_name (BaseStandardVar.findlib_version ())
  4989. in
  4990. let cmds = split other_args others in
  4991. cmd :: cmds
  4992. in
  4993. (* The first command does not use -add: *)
  4994. split first_args files
  4995. else
  4996. ["install" :: findlib_name :: meta :: files]
  4997. let install =
  4998. let in_destdir =
  4999. try
  5000. let destdir =
  5001. destdir ()
  5002. in
  5003. (* Practically speaking destdir is prepended
  5004. * at the beginning of the target filename
  5005. *)
  5006. fun fn -> destdir^fn
  5007. with PropList.Not_set _ ->
  5008. fun fn -> fn
  5009. in
  5010. let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
  5011. let tgt_dir =
  5012. if prepend_destdir then in_destdir (envdir ()) else envdir ()
  5013. in
  5014. let tgt_file =
  5015. Filename.concat
  5016. tgt_dir
  5017. (match tgt_fn with
  5018. | Some fn ->
  5019. fn
  5020. | None ->
  5021. Filename.basename src_file)
  5022. in
  5023. (* Create target directory if needed *)
  5024. OASISFileUtil.mkdir_parent
  5025. ~ctxt
  5026. (fun dn ->
  5027. info (f_ "Creating directory '%s'") dn;
  5028. BaseLog.register ~ctxt install_dir_ev dn)
  5029. (Filename.dirname tgt_file);
  5030. (* Really install files *)
  5031. info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
  5032. OASISFileUtil.cp ~ctxt src_file tgt_file;
  5033. BaseLog.register ~ctxt install_file_ev tgt_file
  5034. in
  5035. (* Install the files for a library. *)
  5036. let install_lib_files ~ctxt findlib_name files =
  5037. let findlib_dir =
  5038. let dn =
  5039. let findlib_destdir =
  5040. OASISExec.run_read_one_line ~ctxt (ocamlfind ())
  5041. ["printconf" ; "destdir"]
  5042. in
  5043. Filename.concat findlib_destdir findlib_name
  5044. in
  5045. fun () -> dn
  5046. in
  5047. let () =
  5048. if not (OASISFileUtil.file_exists_case (findlib_dir ())) then
  5049. failwithf
  5050. (f_ "Directory '%s' doesn't exist for findlib library %s")
  5051. (findlib_dir ()) findlib_name
  5052. in
  5053. let f dir file =
  5054. let basename = Filename.basename file in
  5055. let tgt_fn = Filename.concat dir basename in
  5056. (* Destdir is already include in printconf. *)
  5057. install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir
  5058. in
  5059. List.iter (fun (dir, files) -> List.iter (f dir) files) files ;
  5060. in
  5061. (* Install data into defined directory *)
  5062. let install_data ~ctxt srcdir lst tgtdir =
  5063. let tgtdir =
  5064. OASISHostPath.of_unix (var_expand tgtdir)
  5065. in
  5066. List.iter
  5067. (fun (src, tgt_opt) ->
  5068. let real_srcs =
  5069. OASISFileUtil.glob
  5070. ~ctxt:!BaseContext.default
  5071. (Filename.concat srcdir src)
  5072. in
  5073. if real_srcs = [] then
  5074. failwithf
  5075. (f_ "Wildcard '%s' doesn't match any files")
  5076. src;
  5077. List.iter
  5078. (fun fn ->
  5079. install_file ~ctxt
  5080. fn
  5081. (fun () ->
  5082. match tgt_opt with
  5083. | Some s ->
  5084. OASISHostPath.of_unix (var_expand s)
  5085. | None ->
  5086. tgtdir))
  5087. real_srcs)
  5088. lst
  5089. in
  5090. let make_fnames modul sufx =
  5091. List.fold_right
  5092. begin fun sufx accu ->
  5093. (OASISString.capitalize_ascii modul ^ sufx) ::
  5094. (OASISString.uncapitalize_ascii modul ^ sufx) ::
  5095. accu
  5096. end
  5097. sufx
  5098. []
  5099. in
  5100. (** Install all libraries *)
  5101. let install_libs ~ctxt pkg =
  5102. let find_first_existing_files_in_path bs lst =
  5103. let path = OASISHostPath.of_unix bs.bs_path in
  5104. List.find
  5105. OASISFileUtil.file_exists_case
  5106. (List.map (Filename.concat path) lst)
  5107. in
  5108. let files_of_modules new_files typ cs bs modules =
  5109. List.fold_left
  5110. (fun acc modul ->
  5111. begin
  5112. try
  5113. (* Add uncompiled header from the source tree *)
  5114. [find_first_existing_files_in_path
  5115. bs (make_fnames modul [".mli"; ".ml"])]
  5116. with Not_found ->
  5117. warning
  5118. (f_ "Cannot find source header for module %s \
  5119. in %s %s")
  5120. typ modul cs.cs_name;
  5121. []
  5122. end
  5123. @
  5124. List.fold_left
  5125. (fun acc fn ->
  5126. try
  5127. find_first_existing_files_in_path bs [fn] :: acc
  5128. with Not_found ->
  5129. acc)
  5130. acc (make_fnames modul [".annot";".cmti";".cmt"]))
  5131. new_files
  5132. modules
  5133. in
  5134. let files_of_build_section (f_data, new_files) typ cs bs =
  5135. let extra_files =
  5136. List.map
  5137. (fun fn ->
  5138. try
  5139. find_first_existing_files_in_path bs [fn]
  5140. with Not_found ->
  5141. failwithf
  5142. (f_ "Cannot find extra findlib file %S in %s %s ")
  5143. fn
  5144. typ
  5145. cs.cs_name)
  5146. bs.bs_findlib_extra_files
  5147. in
  5148. let f_data () =
  5149. (* Install data associated with the library *)
  5150. install_data
  5151. ~ctxt
  5152. bs.bs_path
  5153. bs.bs_data_files
  5154. (Filename.concat
  5155. (datarootdir ())
  5156. pkg.name);
  5157. f_data ()
  5158. in
  5159. f_data, new_files @ extra_files
  5160. in
  5161. let files_of_library (f_data, acc) data_lib =
  5162. let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in
  5163. if var_choose bs.bs_install &&
  5164. BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin
  5165. (* Start with lib_extra *)
  5166. let new_files = lib_extra in
  5167. let new_files =
  5168. files_of_modules new_files "library" cs bs lib.lib_modules
  5169. in
  5170. let f_data, new_files =
  5171. files_of_build_section (f_data, new_files) "library" cs bs
  5172. in
  5173. let new_files =
  5174. (* Get generated files *)
  5175. BaseBuilt.fold
  5176. ~ctxt
  5177. BaseBuilt.BLib
  5178. cs.cs_name
  5179. (fun acc fn -> fn :: acc)
  5180. new_files
  5181. in
  5182. let acc = (dn, new_files) :: acc in
  5183. let f_data () =
  5184. (* Install data associated with the library *)
  5185. install_data
  5186. ~ctxt
  5187. bs.bs_path
  5188. bs.bs_data_files
  5189. (Filename.concat
  5190. (datarootdir ())
  5191. pkg.name);
  5192. f_data ()
  5193. in
  5194. (f_data, acc)
  5195. end else begin
  5196. (f_data, acc)
  5197. end
  5198. and files_of_object (f_data, acc) data_obj =
  5199. let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in
  5200. if var_choose bs.bs_install &&
  5201. BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin
  5202. (* Start with obj_extra *)
  5203. let new_files = obj_extra in
  5204. let new_files =
  5205. files_of_modules new_files "object" cs bs obj.obj_modules
  5206. in
  5207. let f_data, new_files =
  5208. files_of_build_section (f_data, new_files) "object" cs bs
  5209. in
  5210. let new_files =
  5211. (* Get generated files *)
  5212. BaseBuilt.fold
  5213. ~ctxt
  5214. BaseBuilt.BObj
  5215. cs.cs_name
  5216. (fun acc fn -> fn :: acc)
  5217. new_files
  5218. in
  5219. let acc = (dn, new_files) :: acc in
  5220. let f_data () =
  5221. (* Install data associated with the object *)
  5222. install_data
  5223. ~ctxt
  5224. bs.bs_path
  5225. bs.bs_data_files
  5226. (Filename.concat (datarootdir ()) pkg.name);
  5227. f_data ()
  5228. in
  5229. (f_data, acc)
  5230. end else begin
  5231. (f_data, acc)
  5232. end
  5233. in
  5234. (* Install one group of library *)
  5235. let install_group_lib grp =
  5236. (* Iterate through all group nodes *)
  5237. let rec install_group_lib_aux data_and_files grp =
  5238. let data_and_files, children =
  5239. match grp with
  5240. | Container (_, children) ->
  5241. data_and_files, children
  5242. | Package (_, cs, bs, `Library lib, dn, children) ->
  5243. files_of_library data_and_files (cs, bs, lib, dn), children
  5244. | Package (_, cs, bs, `Object obj, dn, children) ->
  5245. files_of_object data_and_files (cs, bs, obj, dn), children
  5246. in
  5247. List.fold_left
  5248. install_group_lib_aux
  5249. data_and_files
  5250. children
  5251. in
  5252. (* Findlib name of the root library *)
  5253. let findlib_name = findlib_of_group grp in
  5254. (* Determine root library *)
  5255. let root_lib = root_of_group grp in
  5256. (* All files to install for this library *)
  5257. let f_data, files = install_group_lib_aux (ignore, []) grp in
  5258. (* Really install, if there is something to install *)
  5259. if files = [] then begin
  5260. warning
  5261. (f_ "Nothing to install for findlib library '%s'") findlib_name
  5262. end else begin
  5263. let meta =
  5264. (* Search META file *)
  5265. let _, bs, _ = root_lib in
  5266. let res = Filename.concat bs.bs_path "META" in
  5267. if not (OASISFileUtil.file_exists_case res) then
  5268. failwithf
  5269. (f_ "Cannot find file '%s' for findlib library %s")
  5270. res
  5271. findlib_name;
  5272. res
  5273. in
  5274. let files =
  5275. (* Make filename shorter to avoid hitting command max line length
  5276. * too early, esp. on Windows.
  5277. *)
  5278. (* TODO: move to OASISHostPath as make_relative. *)
  5279. let remove_prefix p n =
  5280. let plen = String.length p in
  5281. let nlen = String.length n in
  5282. if plen <= nlen && String.sub n 0 plen = p then begin
  5283. let fn_sep = if Sys.os_type = "Win32" then '\\' else '/' in
  5284. let cutpoint =
  5285. plen +
  5286. (if plen < nlen && n.[plen] = fn_sep then 1 else 0)
  5287. in
  5288. String.sub n cutpoint (nlen - cutpoint)
  5289. end else begin
  5290. n
  5291. end
  5292. in
  5293. List.map
  5294. (fun (dir, fn) ->
  5295. (dir, List.map (remove_prefix (Sys.getcwd ())) fn))
  5296. files
  5297. in
  5298. let ocamlfind = ocamlfind () in
  5299. let nodir_files, dir_files =
  5300. List.fold_left
  5301. (fun (nodir, dir) (dn, lst) ->
  5302. match dn with
  5303. | Some dn -> nodir, (dn, lst) :: dir
  5304. | None -> lst @ nodir, dir)
  5305. ([], [])
  5306. (List.rev files)
  5307. in
  5308. info (f_ "Installing findlib library '%s'") findlib_name;
  5309. List.iter
  5310. (OASISExec.run ~ctxt ocamlfind)
  5311. (split_install_command ocamlfind findlib_name meta nodir_files);
  5312. install_lib_files ~ctxt findlib_name dir_files;
  5313. BaseLog.register ~ctxt install_findlib_ev findlib_name
  5314. end;
  5315. (* Install data files *)
  5316. f_data ();
  5317. in
  5318. let group_libs, _, _ = findlib_mapping pkg in
  5319. (* We install libraries in groups *)
  5320. List.iter install_group_lib group_libs
  5321. in
  5322. let install_execs ~ctxt pkg =
  5323. let install_exec data_exec =
  5324. let cs, bs, _ = !exec_hook data_exec in
  5325. if var_choose bs.bs_install &&
  5326. BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin
  5327. let exec_libdir () = Filename.concat (libdir ()) pkg.name in
  5328. BaseBuilt.fold
  5329. ~ctxt
  5330. BaseBuilt.BExec
  5331. cs.cs_name
  5332. (fun () fn ->
  5333. install_file ~ctxt
  5334. ~tgt_fn:(cs.cs_name ^ ext_program ())
  5335. fn
  5336. bindir)
  5337. ();
  5338. BaseBuilt.fold
  5339. ~ctxt
  5340. BaseBuilt.BExecLib
  5341. cs.cs_name
  5342. (fun () fn -> install_file ~ctxt fn exec_libdir)
  5343. ();
  5344. install_data ~ctxt
  5345. bs.bs_path
  5346. bs.bs_data_files
  5347. (Filename.concat (datarootdir ()) pkg.name)
  5348. end
  5349. in
  5350. List.iter
  5351. (function
  5352. | Executable (cs, bs, exec)-> install_exec (cs, bs, exec)
  5353. | _ -> ())
  5354. pkg.sections
  5355. in
  5356. let install_docs ~ctxt pkg =
  5357. let install_doc data =
  5358. let cs, doc = !doc_hook data in
  5359. if var_choose doc.doc_install &&
  5360. BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin
  5361. let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in
  5362. BaseBuilt.fold
  5363. ~ctxt
  5364. BaseBuilt.BDoc
  5365. cs.cs_name
  5366. (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))
  5367. ();
  5368. install_data ~ctxt
  5369. Filename.current_dir_name
  5370. doc.doc_data_files
  5371. doc.doc_install_dir
  5372. end
  5373. in
  5374. List.iter
  5375. (function
  5376. | Doc (cs, doc) -> install_doc (cs, doc)
  5377. | _ -> ())
  5378. pkg.sections
  5379. in
  5380. fun ~ctxt pkg _ ->
  5381. install_libs ~ctxt pkg;
  5382. install_execs ~ctxt pkg;
  5383. install_docs ~ctxt pkg
  5384. (* Uninstall already installed data *)
  5385. let uninstall ~ctxt _ _ =
  5386. let uninstall_aux (ev, data) =
  5387. if ev = install_file_ev then begin
  5388. if OASISFileUtil.file_exists_case data then begin
  5389. info (f_ "Removing file '%s'") data;
  5390. Sys.remove data
  5391. end else begin
  5392. warning (f_ "File '%s' doesn't exist anymore") data
  5393. end
  5394. end else if ev = install_dir_ev then begin
  5395. if Sys.file_exists data && Sys.is_directory data then begin
  5396. if Sys.readdir data = [||] then begin
  5397. info (f_ "Removing directory '%s'") data;
  5398. OASISFileUtil.rmdir ~ctxt data
  5399. end else begin
  5400. warning
  5401. (f_ "Directory '%s' is not empty (%s)")
  5402. data
  5403. (String.concat ", " (Array.to_list (Sys.readdir data)))
  5404. end
  5405. end else begin
  5406. warning (f_ "Directory '%s' doesn't exist anymore") data
  5407. end
  5408. end else if ev = install_findlib_ev then begin
  5409. info (f_ "Removing findlib library '%s'") data;
  5410. OASISExec.run ~ctxt (ocamlfind ()) ["remove"; data]
  5411. end else begin
  5412. failwithf (f_ "Unknown log event '%s'") ev;
  5413. end;
  5414. BaseLog.unregister ~ctxt ev data
  5415. in
  5416. (* We process event in reverse order *)
  5417. List.iter uninstall_aux
  5418. (List.rev
  5419. (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));
  5420. List.iter uninstall_aux
  5421. (List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))
  5422. end
  5423. # 6474 "setup.ml"
  5424. module OCamlbuildCommon = struct
  5425. (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
  5426. (** Functions common to OCamlbuild build and doc plugin
  5427. *)
  5428. open OASISGettext
  5429. open BaseEnv
  5430. open BaseStandardVar
  5431. open OASISTypes
  5432. type extra_args = string list
  5433. let ocamlbuild_clean_ev = "ocamlbuild-clean"
  5434. let ocamlbuildflags =
  5435. var_define
  5436. ~short_desc:(fun () -> "OCamlbuild additional flags")
  5437. "ocamlbuildflags"
  5438. (fun () -> "")
  5439. (** Fix special arguments depending on environment *)
  5440. let fix_args args extra_argv =
  5441. List.flatten
  5442. [
  5443. if (os_type ()) = "Win32" then
  5444. [
  5445. "-classic-display";
  5446. "-no-log";
  5447. "-no-links";
  5448. ]
  5449. else
  5450. [];
  5451. if OASISVersion.comparator_apply
  5452. (OASISVersion.version_of_string (ocaml_version ()))
  5453. (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then
  5454. [
  5455. "-install-lib-dir";
  5456. (Filename.concat (standard_library ()) "ocamlbuild")
  5457. ]
  5458. else
  5459. [];
  5460. if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then
  5461. [
  5462. "-byte-plugin"
  5463. ]
  5464. else
  5465. [];
  5466. args;
  5467. if bool_of_string (debug ()) then
  5468. ["-tag"; "debug"]
  5469. else
  5470. [];
  5471. if bool_of_string (tests ()) then
  5472. ["-tag"; "tests"]
  5473. else
  5474. [];
  5475. if bool_of_string (profile ()) then
  5476. ["-tag"; "profile"]
  5477. else
  5478. [];
  5479. OASISString.nsplit (ocamlbuildflags ()) ' ';
  5480. Array.to_list extra_argv;
  5481. ]
  5482. (** Run 'ocamlbuild -clean' if not already done *)
  5483. let run_clean ~ctxt extra_argv =
  5484. let extra_cli =
  5485. String.concat " " (Array.to_list extra_argv)
  5486. in
  5487. (* Run if never called with these args *)
  5488. if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then
  5489. begin
  5490. OASISExec.run ~ctxt (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
  5491. BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;
  5492. at_exit
  5493. (fun () ->
  5494. try
  5495. BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli
  5496. with _ -> ())
  5497. end
  5498. (** Run ocamlbuild, unregister all clean events *)
  5499. let run_ocamlbuild ~ctxt args extra_argv =
  5500. (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
  5501. *)
  5502. OASISExec.run ~ctxt (ocamlbuild ()) (fix_args args extra_argv);
  5503. (* Remove any clean event, we must run it again *)
  5504. List.iter
  5505. (fun (e, d) -> BaseLog.unregister ~ctxt e d)
  5506. (BaseLog.filter ~ctxt [ocamlbuild_clean_ev])
  5507. (** Determine real build directory *)
  5508. let build_dir extra_argv =
  5509. let rec search_args dir =
  5510. function
  5511. | "-build-dir" :: dir :: tl ->
  5512. search_args dir tl
  5513. | _ :: tl ->
  5514. search_args dir tl
  5515. | [] ->
  5516. dir
  5517. in
  5518. search_args "_build" (fix_args [] extra_argv)
  5519. end
  5520. module OCamlbuildPlugin = struct
  5521. (* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
  5522. (** Build using ocamlbuild
  5523. @author Sylvain Le Gall
  5524. *)
  5525. open OASISTypes
  5526. open OASISGettext
  5527. open OASISUtils
  5528. open OASISString
  5529. open BaseEnv
  5530. open OCamlbuildCommon
  5531. open BaseStandardVar
  5532. let cond_targets_hook = ref (fun lst -> lst)
  5533. let build ~ctxt extra_args pkg argv =
  5534. (* Return the filename in build directory *)
  5535. let in_build_dir fn =
  5536. Filename.concat
  5537. (build_dir argv)
  5538. fn
  5539. in
  5540. (* Return the unix filename in host build directory *)
  5541. let in_build_dir_of_unix fn =
  5542. in_build_dir (OASISHostPath.of_unix fn)
  5543. in
  5544. let cond_targets =
  5545. List.fold_left
  5546. (fun acc ->
  5547. function
  5548. | Library (cs, bs, lib) when var_choose bs.bs_build ->
  5549. begin
  5550. let evs, unix_files =
  5551. BaseBuilt.of_library
  5552. in_build_dir_of_unix
  5553. (cs, bs, lib)
  5554. in
  5555. let tgts =
  5556. List.flatten
  5557. (List.filter
  5558. (fun l -> l <> [])
  5559. (List.map
  5560. (List.filter
  5561. (fun fn ->
  5562. ends_with ~what:".cma" fn
  5563. || ends_with ~what:".cmxs" fn
  5564. || ends_with ~what:".cmxa" fn
  5565. || ends_with ~what:(ext_lib ()) fn
  5566. || ends_with ~what:(ext_dll ()) fn))
  5567. unix_files))
  5568. in
  5569. match tgts with
  5570. | _ :: _ ->
  5571. (evs, tgts) :: acc
  5572. | [] ->
  5573. failwithf
  5574. (f_ "No possible ocamlbuild targets for library %s")
  5575. cs.cs_name
  5576. end
  5577. | Object (cs, bs, obj) when var_choose bs.bs_build ->
  5578. begin
  5579. let evs, unix_files =
  5580. BaseBuilt.of_object
  5581. in_build_dir_of_unix
  5582. (cs, bs, obj)
  5583. in
  5584. let tgts =
  5585. List.flatten
  5586. (List.filter
  5587. (fun l -> l <> [])
  5588. (List.map
  5589. (List.filter
  5590. (fun fn ->
  5591. ends_with ~what:".cmo" fn
  5592. || ends_with ~what:".cmx" fn))
  5593. unix_files))
  5594. in
  5595. match tgts with
  5596. | _ :: _ ->
  5597. (evs, tgts) :: acc
  5598. | [] ->
  5599. failwithf
  5600. (f_ "No possible ocamlbuild targets for object %s")
  5601. cs.cs_name
  5602. end
  5603. | Executable (cs, bs, exec) when var_choose bs.bs_build ->
  5604. begin
  5605. let evs, _, _ =
  5606. BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)
  5607. in
  5608. let target ext =
  5609. let unix_tgt =
  5610. (OASISUnixPath.concat
  5611. bs.bs_path
  5612. (OASISUnixPath.chop_extension
  5613. exec.exec_main_is))^ext
  5614. in
  5615. let evs =
  5616. (* Fix evs, we want to use the unix_tgt, without copying *)
  5617. List.map
  5618. (function
  5619. | BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->
  5620. BaseBuilt.BExec, nm,
  5621. [[in_build_dir_of_unix unix_tgt]]
  5622. | ev ->
  5623. ev)
  5624. evs
  5625. in
  5626. evs, [unix_tgt]
  5627. in
  5628. (* Add executable *)
  5629. let acc =
  5630. match bs.bs_compiled_object with
  5631. | Native ->
  5632. (target ".native") :: acc
  5633. | Best when bool_of_string (is_native ()) ->
  5634. (target ".native") :: acc
  5635. | Byte
  5636. | Best ->
  5637. (target ".byte") :: acc
  5638. in
  5639. acc
  5640. end
  5641. | Library _ | Object _ | Executable _ | Test _
  5642. | SrcRepo _ | Flag _ | Doc _ ->
  5643. acc)
  5644. []
  5645. (* Keep the pkg.sections ordered *)
  5646. (List.rev pkg.sections);
  5647. in
  5648. (* Check and register built files *)
  5649. let check_and_register (bt, bnm, lst) =
  5650. List.iter
  5651. (fun fns ->
  5652. if not (List.exists OASISFileUtil.file_exists_case fns) then
  5653. failwithf
  5654. (fn_
  5655. "Expected built file %s doesn't exist."
  5656. "None of expected built files %s exists."
  5657. (List.length fns))
  5658. (String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
  5659. lst;
  5660. (BaseBuilt.register ~ctxt bt bnm lst)
  5661. in
  5662. (* Run the hook *)
  5663. let cond_targets = !cond_targets_hook cond_targets in
  5664. (* Run a list of target... *)
  5665. run_ocamlbuild
  5666. ~ctxt
  5667. (List.flatten (List.map snd cond_targets) @ extra_args)
  5668. argv;
  5669. (* ... and register events *)
  5670. List.iter check_and_register (List.flatten (List.map fst cond_targets))
  5671. let clean ~ctxt pkg extra_args =
  5672. run_clean ~ctxt extra_args;
  5673. List.iter
  5674. (function
  5675. | Library (cs, _, _) ->
  5676. BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
  5677. | Executable (cs, _, _) ->
  5678. BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
  5679. BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
  5680. | _ ->
  5681. ())
  5682. pkg.sections
  5683. end
  5684. module OCamlbuildDocPlugin = struct
  5685. (* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
  5686. (* Create documentation using ocamlbuild .odocl files
  5687. @author Sylvain Le Gall
  5688. *)
  5689. open OASISTypes
  5690. open OASISGettext
  5691. open OCamlbuildCommon
  5692. type run_t =
  5693. {
  5694. extra_args: string list;
  5695. run_path: unix_filename;
  5696. }
  5697. let doc_build ~ctxt run _ (cs, _) argv =
  5698. let index_html =
  5699. OASISUnixPath.make
  5700. [
  5701. run.run_path;
  5702. cs.cs_name^".docdir";
  5703. "index.html";
  5704. ]
  5705. in
  5706. let tgt_dir =
  5707. OASISHostPath.make
  5708. [
  5709. build_dir argv;
  5710. OASISHostPath.of_unix run.run_path;
  5711. cs.cs_name^".docdir";
  5712. ]
  5713. in
  5714. run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv;
  5715. List.iter
  5716. (fun glb ->
  5717. BaseBuilt.register
  5718. ~ctxt
  5719. BaseBuilt.BDoc
  5720. cs.cs_name
  5721. [OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb)])
  5722. ["*.html"; "*.css"]
  5723. let doc_clean ~ctxt _ _ (cs, _) argv =
  5724. run_clean ~ctxt argv;
  5725. BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
  5726. end
  5727. # 6847 "setup.ml"
  5728. module CustomPlugin = struct
  5729. (* # 22 "src/plugins/custom/CustomPlugin.ml" *)
  5730. (** Generate custom configure/build/doc/test/install system
  5731. @author
  5732. *)
  5733. open BaseEnv
  5734. open OASISGettext
  5735. open OASISTypes
  5736. type t =
  5737. {
  5738. cmd_main: command_line conditional;
  5739. cmd_clean: (command_line option) conditional;
  5740. cmd_distclean: (command_line option) conditional;
  5741. }
  5742. let run = BaseCustom.run
  5743. let main ~ctxt:_ t _ extra_args =
  5744. let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in
  5745. run cmd args extra_args
  5746. let clean ~ctxt:_ t _ extra_args =
  5747. match var_choose t.cmd_clean with
  5748. | Some (cmd, args) -> run cmd args extra_args
  5749. | _ -> ()
  5750. let distclean ~ctxt:_ t _ extra_args =
  5751. match var_choose t.cmd_distclean with
  5752. | Some (cmd, args) -> run cmd args extra_args
  5753. | _ -> ()
  5754. module Build =
  5755. struct
  5756. let main ~ctxt t pkg extra_args =
  5757. main ~ctxt t pkg extra_args;
  5758. List.iter
  5759. (fun sct ->
  5760. let evs =
  5761. match sct with
  5762. | Library (cs, bs, lib) when var_choose bs.bs_build ->
  5763. begin
  5764. let evs, _ =
  5765. BaseBuilt.of_library
  5766. OASISHostPath.of_unix
  5767. (cs, bs, lib)
  5768. in
  5769. evs
  5770. end
  5771. | Executable (cs, bs, exec) when var_choose bs.bs_build ->
  5772. begin
  5773. let evs, _, _ =
  5774. BaseBuilt.of_executable
  5775. OASISHostPath.of_unix
  5776. (cs, bs, exec)
  5777. in
  5778. evs
  5779. end
  5780. | _ ->
  5781. []
  5782. in
  5783. List.iter
  5784. (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst)
  5785. evs)
  5786. pkg.sections
  5787. let clean ~ctxt t pkg extra_args =
  5788. clean ~ctxt t pkg extra_args;
  5789. (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild
  5790. * considering moving this to BaseSetup?
  5791. *)
  5792. List.iter
  5793. (function
  5794. | Library (cs, _, _) ->
  5795. BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
  5796. | Executable (cs, _, _) ->
  5797. BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
  5798. BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
  5799. | _ ->
  5800. ())
  5801. pkg.sections
  5802. let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args
  5803. end
  5804. module Test =
  5805. struct
  5806. let main ~ctxt t pkg (cs, _) extra_args =
  5807. try
  5808. main ~ctxt t pkg extra_args;
  5809. 0.0
  5810. with Failure s ->
  5811. BaseMessage.warning
  5812. (f_ "Test '%s' fails: %s")
  5813. cs.cs_name
  5814. s;
  5815. 1.0
  5816. let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args
  5817. let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
  5818. end
  5819. module Doc =
  5820. struct
  5821. let main ~ctxt t pkg (cs, _) extra_args =
  5822. main ~ctxt t pkg extra_args;
  5823. BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name []
  5824. let clean ~ctxt t pkg (cs, _) extra_args =
  5825. clean ~ctxt t pkg extra_args;
  5826. BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
  5827. let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args
  5828. end
  5829. end
  5830. # 6979 "setup.ml"
  5831. open OASISTypes;;
  5832. let setup_t =
  5833. {
  5834. BaseSetup.configure = InternalConfigurePlugin.configure;
  5835. build =
  5836. OCamlbuildPlugin.build
  5837. [
  5838. "-use-ocamlfind";
  5839. "-tag";
  5840. "\"ppx(ppx-jane";
  5841. "-as-ppx)\"";
  5842. "-tag";
  5843. "thread";
  5844. "-tag";
  5845. "debug";
  5846. "-tag";
  5847. "bin_annot";
  5848. "-tag";
  5849. "short_paths";
  5850. "-cflags";
  5851. "\"-w";
  5852. "A-4-33-40-41-42-43-34-44\"";
  5853. "-cflags";
  5854. "-strict-sequence"
  5855. ];
  5856. test =
  5857. [
  5858. ("alcotests",
  5859. CustomPlugin.Test.main
  5860. {
  5861. CustomPlugin.cmd_main =
  5862. [(OASISExpr.EBool true, ("$run_test", ["-q"]))];
  5863. cmd_clean = [(OASISExpr.EBool true, None)];
  5864. cmd_distclean = [(OASISExpr.EBool true, None)]
  5865. })
  5866. ];
  5867. doc = [];
  5868. install = InternalInstallPlugin.install;
  5869. uninstall = InternalInstallPlugin.uninstall;
  5870. clean = [OCamlbuildPlugin.clean];
  5871. clean_test =
  5872. [
  5873. ("alcotests",
  5874. CustomPlugin.Test.clean
  5875. {
  5876. CustomPlugin.cmd_main =
  5877. [(OASISExpr.EBool true, ("$run_test", ["-q"]))];
  5878. cmd_clean = [(OASISExpr.EBool true, None)];
  5879. cmd_distclean = [(OASISExpr.EBool true, None)]
  5880. })
  5881. ];
  5882. clean_doc = [];
  5883. distclean = [];
  5884. distclean_test =
  5885. [
  5886. ("alcotests",
  5887. CustomPlugin.Test.distclean
  5888. {
  5889. CustomPlugin.cmd_main =
  5890. [(OASISExpr.EBool true, ("$run_test", ["-q"]))];
  5891. cmd_clean = [(OASISExpr.EBool true, None)];
  5892. cmd_distclean = [(OASISExpr.EBool true, None)]
  5893. })
  5894. ];
  5895. distclean_doc = [];
  5896. package =
  5897. {
  5898. oasis_version = "0.4";
  5899. ocaml_version = None;
  5900. version = "0.3.0-rc1";
  5901. license =
  5902. OASISLicense.DEP5License
  5903. (OASISLicense.DEP5Unit
  5904. {
  5905. OASISLicense.license = "CeCILL";
  5906. excption = None;
  5907. version = OASISLicense.NoVersion
  5908. });
  5909. findlib_version = None;
  5910. alpha_features =
  5911. ["stdfiles_markdown"; "compiled_setup_ml"; "ocamlbuild_more_args"
  5912. ];
  5913. beta_features = [];
  5914. name = "OcLaunch";
  5915. license_file = Some "LICENSE";
  5916. copyrights = ["(C) 2014-2016 Joly Cl\195\169ment"];
  5917. maintainers = ["Joly Cl\195\169ment <leowzukw@oclaunch.eu.org>"];
  5918. authors = ["Joly Cl\195\169ment <leowzukw@oclaunch.eu.org>"];
  5919. homepage = Some "https://oclaunch.eu.org";
  5920. bugreports = None;
  5921. synopsis = "Launch commands automagically";
  5922. description =
  5923. Some
  5924. [
  5925. OASISText.Para
  5926. "[![licence CeCILL](https://img.shields.io/badge/licence-CeCILL-blue.svg)](http://oclaunch.eu.org/floss-under-cecill) [![command line](https://img.shields.io/badge/command-line-lightgrey.svg)](http://oclaunch.eu.org/videos) [![platform UNIX (esp. LINUX)](https://img.shields.io/badge/platform-UNIX_\\(esp._LINUX\\)-lightgrey.svg)](http://download.tuxfamily.org/oclaunch/oclaunch.xml) [![language OCaml](https://img.shields.io/badge/language-OCaml-orange.svg)](http://www.ocaml.org/) [![opam oclaunch](https://img.shields.io/badge/opam-oclaunch-red.svg)](http://opam.ocaml.org/packages/oclaunch/oclaunch.0.2.2/) [![Getting help](https://img.shields.io/badge/Get-Help!-orange.svg)](http://www.oclaunch.eu.org/help.html) <hr/><p>OcLaunch is a command-line tool to launch successively (each time the program is called) commands. It is designed to be used with any program, interactive or not. Feedback is welcome at *contact@oclaunch.eu.org*. Detailed presentation at http://ocla.ml.<br/> Try it, it works automagically!</p><p>For example, here is a typical session (you open a terminal emulator between each item): <ul> <li>You open your first terminal, your chat client is opened,</li> <li>On second launch of a terminal, your task list is displayed,</li> <li>On third launch, everything has been done. You will not see anything more.</li> </ul></p>"
  5927. ];
  5928. tags = [];
  5929. categories = [];
  5930. files_ab = [];
  5931. sections =
  5932. [
  5933. Executable
  5934. ({
  5935. cs_name = "oclaunch";
  5936. cs_data = PropList.Data.create ();
  5937. cs_plugin_data = []
  5938. },
  5939. {
  5940. bs_build = [(OASISExpr.EBool true, true)];
  5941. bs_install = [(OASISExpr.EBool true, true)];
  5942. bs_path = "src";
  5943. bs_compiled_object = Best;
  5944. bs_build_depends =
  5945. [
  5946. FindlibPackage ("core", None);
  5947. FindlibPackage ("textutils", None);
  5948. FindlibPackage ("threads", None);
  5949. FindlibPackage ("re2", None);
  5950. FindlibPackage ("atdgen", None);
  5951. FindlibPackage ("yojson", None)
  5952. ];
  5953. bs_build_tools = [ExternalTool "ocamlbuild"];
  5954. bs_interface_patterns =
  5955. [
  5956. {
  5957. OASISSourcePatterns.Templater.atoms =
  5958. [
  5959. OASISSourcePatterns.Templater.Text "";
  5960. OASISSourcePatterns.Templater.Expr
  5961. (OASISSourcePatterns.Templater.Call
  5962. ("capitalize_file",
  5963. OASISSourcePatterns.Templater.Ident
  5964. "module"));
  5965. OASISSourcePatterns.Templater.Text ".mli"
  5966. ];
  5967. origin = "${capitalize_file module}.mli"
  5968. };
  5969. {
  5970. OASISSourcePatterns.Templater.atoms =
  5971. [
  5972. OASISSourcePatterns.Templater.Text "";
  5973. OASISSourcePatterns.Templater.Expr
  5974. (OASISSourcePatterns.Templater.Call
  5975. ("uncapitalize_file",
  5976. OASISSourcePatterns.Templater.Ident
  5977. "module"));
  5978. OASISSourcePatterns.Templater.Text ".mli"
  5979. ];
  5980. origin = "${uncapitalize_file module}.mli"
  5981. }
  5982. ];
  5983. bs_implementation_patterns =
  5984. [
  5985. {
  5986. OASISSourcePatterns.Templater.atoms =
  5987. [
  5988. OASISSourcePatterns.Templater.Text "";
  5989. OASISSourcePatterns.Templater.Expr
  5990. (OASISSourcePatterns.Templater.Call
  5991. ("capitalize_file",
  5992. OASISSourcePatterns.Templater.Ident
  5993. "module"));
  5994. OASISSourcePatterns.Templater.Text ".ml"
  5995. ];
  5996. origin = "${capitalize_file module}.ml"
  5997. };
  5998. {
  5999. OASISSourcePatterns.Templater.atoms =
  6000. [
  6001. OASISSourcePatterns.Templater.Text "";
  6002. OASISSourcePatterns.Templater.Expr
  6003. (OASISSourcePatterns.Templater.Call
  6004. ("uncapitalize_file",
  6005. OASISSourcePatterns.Templater.Ident
  6006. "module"));
  6007. OASISSourcePatterns.Templater.Text ".ml"
  6008. ];
  6009. origin = "${uncapitalize_file module}.ml"
  6010. };
  6011. {
  6012. OASISSourcePatterns.Templater.atoms =
  6013. [
  6014. OASISSourcePatterns.Templater.Text "";
  6015. OASISSourcePatterns.Templater.Expr
  6016. (OASISSourcePatterns.Templater.Call
  6017. ("capitalize_file",
  6018. OASISSourcePatterns.Templater.Ident
  6019. "module"));
  6020. OASISSourcePatterns.Templater.Text ".mll"
  6021. ];
  6022. origin = "${capitalize_file module}.mll"
  6023. };
  6024. {
  6025. OASISSourcePatterns.Templater.atoms =
  6026. [
  6027. OASISSourcePatterns.Templater.Text "";
  6028. OASISSourcePatterns.Templater.Expr
  6029. (OASISSourcePatterns.Templater.Call
  6030. ("uncapitalize_file",
  6031. OASISSourcePatterns.Templater.Ident
  6032. "module"));
  6033. OASISSourcePatterns.Templater.Text ".mll"
  6034. ];
  6035. origin = "${uncapitalize_file module}.mll"
  6036. };
  6037. {
  6038. OASISSourcePatterns.Templater.atoms =
  6039. [
  6040. OASISSourcePatterns.Templater.Text "";
  6041. OASISSourcePatterns.Templater.Expr
  6042. (OASISSourcePatterns.Templater.Call
  6043. ("capitalize_file",
  6044. OASISSourcePatterns.Templater.Ident
  6045. "module"));
  6046. OASISSourcePatterns.Templater.Text ".mly"
  6047. ];
  6048. origin = "${capitalize_file module}.mly"
  6049. };
  6050. {
  6051. OASISSourcePatterns.Templater.atoms =
  6052. [
  6053. OASISSourcePatterns.Templater.Text "";
  6054. OASISSourcePatterns.Templater.Expr
  6055. (OASISSourcePatterns.Templater.Call
  6056. ("uncapitalize_file",
  6057. OASISSourcePatterns.Templater.Ident
  6058. "module"));
  6059. OASISSourcePatterns.Templater.Text ".mly"
  6060. ];
  6061. origin = "${uncapitalize_file module}.mly"
  6062. }
  6063. ];
  6064. bs_c_sources = [];
  6065. bs_data_files = [];
  6066. bs_findlib_extra_files = [];
  6067. bs_ccopt = [(OASISExpr.EBool true, [])];
  6068. bs_cclib = [(OASISExpr.EBool true, [])];
  6069. bs_dlllib = [(OASISExpr.EBool true, [])];
  6070. bs_dllpath = [(OASISExpr.EBool true, [])];
  6071. bs_byteopt = [(OASISExpr.EBool true, [])];
  6072. bs_nativeopt = [(OASISExpr.EBool true, [])]
  6073. },
  6074. {exec_custom = false; exec_main_is = "oclaunch.ml"});
  6075. Executable
  6076. ({
  6077. cs_name = "run_test";
  6078. cs_data = PropList.Data.create ();
  6079. cs_plugin_data = []
  6080. },
  6081. {
  6082. bs_build =
  6083. [
  6084. (OASISExpr.EBool true, false);
  6085. (OASISExpr.EFlag "tests", true)
  6086. ];
  6087. bs_install = [(OASISExpr.EBool true, false)];
  6088. bs_path = "src";
  6089. bs_compiled_object = Best;
  6090. bs_build_depends =
  6091. [
  6092. FindlibPackage ("alcotest", None);
  6093. FindlibPackage ("oUnit", None);
  6094. FindlibPackage ("core", None);
  6095. FindlibPackage ("textutils", None);
  6096. FindlibPackage ("atdgen", None);
  6097. FindlibPackage ("threads", None);
  6098. FindlibPackage ("re2", None)
  6099. ];
  6100. bs_build_tools = [ExternalTool "ocamlbuild"];
  6101. bs_interface_patterns =
  6102. [
  6103. {
  6104. OASISSourcePatterns.Templater.atoms =
  6105. [
  6106. OASISSourcePatterns.Templater.Text "";
  6107. OASISSourcePatterns.Templater.Expr
  6108. (OASISSourcePatterns.Templater.Call
  6109. ("capitalize_file",
  6110. OASISSourcePatterns.Templater.Ident
  6111. "module"));
  6112. OASISSourcePatterns.Templater.Text ".mli"
  6113. ];
  6114. origin = "${capitalize_file module}.mli"
  6115. };
  6116. {
  6117. OASISSourcePatterns.Templater.atoms =
  6118. [
  6119. OASISSourcePatterns.Templater.Text "";
  6120. OASISSourcePatterns.Templater.Expr
  6121. (OASISSourcePatterns.Templater.Call
  6122. ("uncapitalize_file",
  6123. OASISSourcePatterns.Templater.Ident
  6124. "module"));
  6125. OASISSourcePatterns.Templater.Text ".mli"
  6126. ];
  6127. origin = "${uncapitalize_file module}.mli"
  6128. }
  6129. ];
  6130. bs_implementation_patterns =
  6131. [
  6132. {
  6133. OASISSourcePatterns.Templater.atoms =
  6134. [
  6135. OASISSourcePatterns.Templater.Text "";
  6136. OASISSourcePatterns.Templater.Expr
  6137. (OASISSourcePatterns.Templater.Call
  6138. ("capitalize_file",
  6139. OASISSourcePatterns.Templater.Ident
  6140. "module"));
  6141. OASISSourcePatterns.Templater.Text ".ml"
  6142. ];
  6143. origin = "${capitalize_file module}.ml"
  6144. };
  6145. {
  6146. OASISSourcePatterns.Templater.atoms =
  6147. [
  6148. OASISSourcePatterns.Templater.Text "";
  6149. OASISSourcePatterns.Templater.Expr
  6150. (OASISSourcePatterns.Templater.Call
  6151. ("uncapitalize_file",
  6152. OASISSourcePatterns.Templater.Ident
  6153. "module"));
  6154. OASISSourcePatterns.Templater.Text ".ml"
  6155. ];
  6156. origin = "${uncapitalize_file module}.ml"
  6157. };
  6158. {
  6159. OASISSourcePatterns.Templater.atoms =
  6160. [
  6161. OASISSourcePatterns.Templater.Text "";
  6162. OASISSourcePatterns.Templater.Expr
  6163. (OASISSourcePatterns.Templater.Call
  6164. ("capitalize_file",
  6165. OASISSourcePatterns.Templater.Ident
  6166. "module"));
  6167. OASISSourcePatterns.Templater.Text ".mll"
  6168. ];
  6169. origin = "${capitalize_file module}.mll"
  6170. };
  6171. {
  6172. OASISSourcePatterns.Templater.atoms =
  6173. [
  6174. OASISSourcePatterns.Templater.Text "";
  6175. OASISSourcePatterns.Templater.Expr
  6176. (OASISSourcePatterns.Templater.Call
  6177. ("uncapitalize_file",
  6178. OASISSourcePatterns.Templater.Ident
  6179. "module"));
  6180. OASISSourcePatterns.Templater.Text ".mll"
  6181. ];
  6182. origin = "${uncapitalize_file module}.mll"
  6183. };
  6184. {
  6185. OASISSourcePatterns.Templater.atoms =
  6186. [
  6187. OASISSourcePatterns.Templater.Text "";
  6188. OASISSourcePatterns.Templater.Expr
  6189. (OASISSourcePatterns.Templater.Call
  6190. ("capitalize_file",
  6191. OASISSourcePatterns.Templater.Ident
  6192. "module"));
  6193. OASISSourcePatterns.Templater.Text ".mly"
  6194. ];
  6195. origin = "${capitalize_file module}.mly"
  6196. };
  6197. {
  6198. OASISSourcePatterns.Templater.atoms =
  6199. [
  6200. OASISSourcePatterns.Templater.Text "";
  6201. OASISSourcePatterns.Templater.Expr
  6202. (OASISSourcePatterns.Templater.Call
  6203. ("uncapitalize_file",
  6204. OASISSourcePatterns.Templater.Ident
  6205. "module"));
  6206. OASISSourcePatterns.Templater.Text ".mly"
  6207. ];
  6208. origin = "${uncapitalize_file module}.mly"
  6209. }
  6210. ];
  6211. bs_c_sources = [];
  6212. bs_data_files = [];
  6213. bs_findlib_extra_files = [];
  6214. bs_ccopt = [(OASISExpr.EBool true, [])];
  6215. bs_cclib = [(OASISExpr.EBool true, [])];
  6216. bs_dlllib = [(OASISExpr.EBool true, [])];
  6217. bs_dllpath = [(OASISExpr.EBool true, [])];
  6218. bs_byteopt = [(OASISExpr.EBool true, [])];
  6219. bs_nativeopt = [(OASISExpr.EBool true, [])]
  6220. },
  6221. {exec_custom = false; exec_main_is = "test/test.ml"});
  6222. Test
  6223. ({
  6224. cs_name = "alcotests";
  6225. cs_data = PropList.Data.create ();
  6226. cs_plugin_data = []
  6227. },
  6228. {
  6229. test_type = (`Test, "custom", Some "0.4");
  6230. test_command =
  6231. [(OASISExpr.EBool true, ("$run_test", ["-q"]))];
  6232. test_custom =
  6233. {
  6234. pre_command = [(OASISExpr.EBool true, None)];
  6235. post_command = [(OASISExpr.EBool true, None)]
  6236. };
  6237. test_working_directory = Some "src/test";
  6238. test_run =
  6239. [
  6240. (OASISExpr.ENot (OASISExpr.EFlag "tests"), false);
  6241. (OASISExpr.EFlag "tests", false);
  6242. (OASISExpr.EAnd
  6243. (OASISExpr.EFlag "tests",
  6244. OASISExpr.EFlag "tests"),
  6245. true)
  6246. ];
  6247. test_tools = [ExternalTool "ocamlbuild"]
  6248. })
  6249. ];
  6250. disable_oasis_section = [];
  6251. conf_type = (`Configure, "internal", Some "0.4");
  6252. conf_custom =
  6253. {
  6254. pre_command = [(OASISExpr.EBool true, None)];
  6255. post_command = [(OASISExpr.EBool true, None)]
  6256. };
  6257. build_type = (`Build, "ocamlbuild", Some "0.4");
  6258. build_custom =
  6259. {
  6260. pre_command = [(OASISExpr.EBool true, None)];
  6261. post_command = [(OASISExpr.EBool true, None)]
  6262. };
  6263. install_type = (`Install, "internal", Some "0.4");
  6264. install_custom =
  6265. {
  6266. pre_command = [(OASISExpr.EBool true, None)];
  6267. post_command = [(OASISExpr.EBool true, None)]
  6268. };
  6269. uninstall_custom =
  6270. {
  6271. pre_command = [(OASISExpr.EBool true, None)];
  6272. post_command = [(OASISExpr.EBool true, None)]
  6273. };
  6274. clean_custom =
  6275. {
  6276. pre_command = [(OASISExpr.EBool true, None)];
  6277. post_command = [(OASISExpr.EBool true, None)]
  6278. };
  6279. distclean_custom =
  6280. {
  6281. pre_command = [(OASISExpr.EBool true, None)];
  6282. post_command = [(OASISExpr.EBool true, None)]
  6283. };
  6284. plugins =
  6285. [
  6286. (`Extra, "StdFiles", Some "0.4");
  6287. (`Extra, "DevFiles", Some "0.4")
  6288. ];
  6289. schema_data = PropList.Data.create ();
  6290. plugin_data = []
  6291. };
  6292. oasis_fn = Some "_oasis";
  6293. oasis_version = "0.4.8";
  6294. oasis_digest =
  6295. Some "\030l\234\207\178/\012\189\164\241\024p\228\136\234\002";
  6296. oasis_exec = None;
  6297. oasis_setup_args = [];
  6298. setup_update = false
  6299. };;
  6300. let setup () = BaseSetup.setup setup_t;;
  6301. # 7454 "setup.ml"
  6302. let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t
  6303. open BaseCompat.Compat_0_4
  6304. (* OASIS_STOP *)
  6305. let () = setup ();;