setup.ml 178 KB

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