setup.ml 170 KB

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