setup.ml 178 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680268126822683268426852686268726882689269026912692269326942695269626972698269927002701270227032704270527062707270827092710271127122713271427152716271727182719272027212722272327242725272627272728272927302731273227332734273527362737273827392740274127422743274427452746274727482749275027512752275327542755275627572758275927602761276227632764276527662767276827692770277127722773277427752776277727782779278027812782278327842785278627872788278927902791279227932794279527962797279827992800280128022803280428052806280728082809281028112812281328142815281628172818281928202821282228232824282528262827282828292830283128322833283428352836283728382839284028412842284328442845284628472848284928502851285228532854285528562857285828592860286128622863286428652866286728682869287028712872287328742875287628772878287928802881288228832884288528862887288828892890289128922893289428952896289728982899290029012902290329042905290629072908290929102911291229132914291529162917291829192920292129222923292429252926292729282929293029312932293329342935293629372938293929402941294229432944294529462947294829492950295129522953295429552956295729582959296029612962296329642965296629672968296929702971297229732974297529762977297829792980298129822983298429852986298729882989299029912992299329942995299629972998299930003001300230033004300530063007300830093010301130123013301430153016301730183019302030213022302330243025302630273028302930303031303230333034303530363037303830393040304130423043304430453046304730483049305030513052305330543055305630573058305930603061306230633064306530663067306830693070307130723073307430753076307730783079308030813082308330843085308630873088308930903091309230933094309530963097309830993100310131023103310431053106310731083109311031113112311331143115311631173118311931203121312231233124312531263127312831293130313131323133313431353136313731383139314031413142314331443145314631473148314931503151315231533154315531563157315831593160316131623163316431653166316731683169317031713172317331743175317631773178317931803181318231833184318531863187318831893190319131923193319431953196319731983199320032013202320332043205320632073208320932103211321232133214321532163217321832193220322132223223322432253226322732283229323032313232323332343235323632373238323932403241324232433244324532463247324832493250325132523253325432553256325732583259326032613262326332643265326632673268326932703271327232733274327532763277327832793280328132823283328432853286328732883289329032913292329332943295329632973298329933003301330233033304330533063307330833093310331133123313331433153316331733183319332033213322332333243325332633273328332933303331333233333334333533363337333833393340334133423343334433453346334733483349335033513352335333543355335633573358335933603361336233633364336533663367336833693370337133723373337433753376337733783379338033813382338333843385338633873388338933903391339233933394339533963397339833993400340134023403340434053406340734083409341034113412341334143415341634173418341934203421342234233424342534263427342834293430343134323433343434353436343734383439344034413442344334443445344634473448344934503451345234533454345534563457345834593460346134623463346434653466346734683469347034713472347334743475347634773478347934803481348234833484348534863487348834893490349134923493349434953496349734983499350035013502350335043505350635073508350935103511351235133514351535163517351835193520352135223523352435253526352735283529353035313532353335343535353635373538353935403541354235433544354535463547354835493550355135523553355435553556355735583559356035613562356335643565356635673568356935703571357235733574357535763577357835793580358135823583358435853586358735883589359035913592359335943595359635973598359936003601360236033604360536063607360836093610361136123613361436153616361736183619362036213622362336243625362636273628362936303631363236333634363536363637363836393640364136423643364436453646364736483649365036513652365336543655365636573658365936603661366236633664366536663667366836693670367136723673367436753676367736783679368036813682368336843685368636873688368936903691369236933694369536963697369836993700370137023703370437053706370737083709371037113712371337143715371637173718371937203721372237233724372537263727372837293730373137323733373437353736373737383739374037413742374337443745374637473748374937503751375237533754375537563757375837593760376137623763376437653766376737683769377037713772377337743775377637773778377937803781378237833784378537863787378837893790379137923793379437953796379737983799380038013802380338043805380638073808380938103811381238133814381538163817381838193820382138223823382438253826382738283829383038313832383338343835383638373838383938403841384238433844384538463847384838493850385138523853385438553856385738583859386038613862386338643865386638673868386938703871387238733874387538763877387838793880388138823883388438853886388738883889389038913892389338943895389638973898389939003901390239033904390539063907390839093910391139123913391439153916391739183919392039213922392339243925392639273928392939303931393239333934393539363937393839393940394139423943394439453946394739483949395039513952395339543955395639573958395939603961396239633964396539663967396839693970397139723973397439753976397739783979398039813982398339843985398639873988398939903991399239933994399539963997399839994000400140024003400440054006400740084009401040114012401340144015401640174018401940204021402240234024402540264027402840294030403140324033403440354036403740384039404040414042404340444045404640474048404940504051405240534054405540564057405840594060406140624063406440654066406740684069407040714072407340744075407640774078407940804081408240834084408540864087408840894090409140924093409440954096409740984099410041014102410341044105410641074108410941104111411241134114411541164117411841194120412141224123412441254126412741284129413041314132413341344135413641374138413941404141414241434144414541464147414841494150415141524153415441554156415741584159416041614162416341644165416641674168416941704171417241734174417541764177417841794180418141824183418441854186418741884189419041914192419341944195419641974198419942004201420242034204420542064207420842094210421142124213421442154216421742184219422042214222422342244225422642274228422942304231423242334234423542364237423842394240424142424243424442454246424742484249425042514252425342544255425642574258425942604261426242634264426542664267426842694270427142724273427442754276427742784279428042814282428342844285428642874288428942904291429242934294429542964297429842994300430143024303430443054306430743084309431043114312431343144315431643174318431943204321432243234324432543264327432843294330433143324333433443354336433743384339434043414342434343444345434643474348434943504351435243534354435543564357435843594360436143624363436443654366436743684369437043714372437343744375437643774378437943804381438243834384438543864387438843894390439143924393439443954396439743984399440044014402440344044405440644074408440944104411441244134414441544164417441844194420442144224423442444254426442744284429443044314432443344344435443644374438443944404441444244434444444544464447444844494450445144524453445444554456445744584459446044614462446344644465446644674468446944704471447244734474447544764477447844794480448144824483448444854486448744884489449044914492449344944495449644974498449945004501450245034504450545064507450845094510451145124513451445154516451745184519452045214522452345244525452645274528452945304531453245334534453545364537453845394540454145424543454445454546454745484549455045514552455345544555455645574558455945604561456245634564456545664567456845694570457145724573457445754576457745784579458045814582458345844585458645874588458945904591459245934594459545964597459845994600460146024603460446054606460746084609461046114612461346144615461646174618461946204621462246234624462546264627462846294630463146324633463446354636463746384639464046414642464346444645464646474648464946504651465246534654465546564657465846594660466146624663466446654666466746684669467046714672467346744675467646774678467946804681468246834684468546864687468846894690469146924693469446954696469746984699470047014702470347044705470647074708470947104711471247134714471547164717471847194720472147224723472447254726472747284729473047314732473347344735473647374738473947404741474247434744474547464747474847494750475147524753475447554756475747584759476047614762476347644765476647674768476947704771477247734774477547764777477847794780478147824783478447854786478747884789479047914792479347944795479647974798479948004801480248034804480548064807480848094810481148124813481448154816481748184819482048214822482348244825482648274828482948304831483248334834483548364837483848394840484148424843484448454846484748484849485048514852485348544855485648574858485948604861486248634864486548664867486848694870487148724873487448754876487748784879488048814882488348844885488648874888488948904891489248934894489548964897489848994900490149024903490449054906490749084909491049114912491349144915491649174918491949204921492249234924492549264927492849294930493149324933493449354936493749384939494049414942494349444945494649474948494949504951495249534954495549564957495849594960496149624963496449654966496749684969497049714972497349744975497649774978497949804981498249834984498549864987498849894990499149924993499449954996499749984999500050015002500350045005500650075008500950105011501250135014501550165017501850195020502150225023502450255026502750285029503050315032503350345035503650375038503950405041504250435044504550465047504850495050505150525053505450555056505750585059506050615062506350645065506650675068506950705071507250735074507550765077507850795080508150825083508450855086508750885089509050915092509350945095509650975098509951005101510251035104510551065107510851095110511151125113511451155116511751185119512051215122512351245125512651275128512951305131513251335134513551365137513851395140514151425143514451455146514751485149515051515152515351545155515651575158515951605161516251635164516551665167516851695170517151725173517451755176517751785179518051815182518351845185518651875188518951905191519251935194519551965197519851995200520152025203520452055206520752085209521052115212521352145215521652175218521952205221522252235224522552265227522852295230523152325233523452355236523752385239524052415242524352445245524652475248524952505251525252535254525552565257525852595260526152625263526452655266526752685269527052715272527352745275527652775278527952805281528252835284528552865287528852895290529152925293529452955296529752985299530053015302530353045305530653075308530953105311531253135314531553165317531853195320532153225323532453255326532753285329533053315332533353345335533653375338533953405341534253435344534553465347534853495350535153525353535453555356535753585359536053615362536353645365536653675368536953705371537253735374537553765377537853795380538153825383538453855386538753885389539053915392539353945395539653975398539954005401540254035404540554065407540854095410541154125413541454155416541754185419542054215422542354245425542654275428542954305431543254335434543554365437543854395440544154425443544454455446544754485449545054515452545354545455545654575458545954605461546254635464546554665467546854695470547154725473547454755476547754785479548054815482548354845485548654875488548954905491549254935494549554965497549854995500550155025503550455055506550755085509551055115512551355145515551655175518551955205521552255235524552555265527552855295530553155325533553455355536553755385539554055415542554355445545554655475548554955505551555255535554555555565557555855595560556155625563556455655566556755685569557055715572557355745575557655775578557955805581558255835584558555865587558855895590559155925593559455955596559755985599560056015602560356045605560656075608560956105611561256135614561556165617561856195620562156225623562456255626562756285629563056315632563356345635563656375638563956405641564256435644564556465647564856495650565156525653565456555656565756585659566056615662566356645665566656675668566956705671567256735674567556765677567856795680568156825683568456855686568756885689569056915692569356945695569656975698569957005701570257035704570557065707570857095710571157125713571457155716571757185719572057215722572357245725572657275728572957305731573257335734573557365737573857395740574157425743574457455746574757485749575057515752575357545755575657575758575957605761576257635764576557665767576857695770577157725773577457755776577757785779578057815782578357845785578657875788578957905791579257935794579557965797579857995800580158025803580458055806580758085809581058115812581358145815581658175818581958205821582258235824582558265827582858295830583158325833583458355836583758385839584058415842584358445845584658475848584958505851585258535854585558565857585858595860586158625863586458655866586758685869587058715872587358745875587658775878587958805881588258835884588558865887588858895890589158925893589458955896589758985899590059015902590359045905590659075908590959105911591259135914591559165917591859195920592159225923592459255926592759285929593059315932593359345935593659375938593959405941594259435944594559465947594859495950595159525953595459555956595759585959596059615962596359645965596659675968596959705971597259735974597559765977597859795980598159825983598459855986598759885989599059915992599359945995599659975998599960006001600260036004600560066007600860096010601160126013601460156016601760186019602060216022602360246025602660276028602960306031603260336034603560366037603860396040604160426043604460456046604760486049605060516052605360546055605660576058605960606061606260636064606560666067606860696070607160726073607460756076607760786079608060816082608360846085608660876088608960906091609260936094609560966097609860996100610161026103610461056106610761086109611061116112611361146115611661176118611961206121612261236124612561266127612861296130613161326133613461356136613761386139614061416142614361446145614661476148614961506151615261536154615561566157615861596160616161626163616461656166616761686169617061716172617361746175617661776178617961806181618261836184618561866187618861896190619161926193619461956196619761986199620062016202620362046205620662076208620962106211621262136214621562166217621862196220622162226223622462256226622762286229623062316232623362346235623662376238623962406241624262436244624562466247624862496250625162526253625462556256625762586259626062616262626362646265626662676268626962706271627262736274627562766277627862796280628162826283628462856286628762886289629062916292629362946295629662976298629963006301630263036304630563066307630863096310631163126313631463156316631763186319632063216322632363246325632663276328632963306331633263336334633563366337633863396340634163426343634463456346634763486349635063516352635363546355635663576358635963606361636263636364636563666367636863696370637163726373637463756376637763786379638063816382638363846385638663876388638963906391639263936394639563966397639863996400640164026403640464056406640764086409641064116412641364146415641664176418641964206421642264236424642564266427642864296430643164326433643464356436643764386439644064416442644364446445644664476448644964506451645264536454645564566457645864596460646164626463646464656466646764686469647064716472647364746475647664776478647964806481648264836484648564866487648864896490649164926493649464956496649764986499650065016502650365046505650665076508650965106511651265136514651565166517651865196520652165226523652465256526652765286529653065316532653365346535653665376538653965406541654265436544654565466547654865496550655165526553655465556556655765586559656065616562656365646565656665676568656965706571657265736574657565766577657865796580658165826583658465856586658765886589659065916592659365946595659665976598659966006601660266036604660566066607660866096610661166126613661466156616661766186619662066216622662366246625662666276628662966306631663266336634663566366637663866396640664166426643664466456646664766486649665066516652665366546655665666576658665966606661666266636664666566666667666866696670667166726673667466756676667766786679668066816682668366846685668666876688668966906691669266936694669566966697669866996700670167026703670467056706670767086709671067116712671367146715671667176718671967206721672267236724672567266727672867296730673167326733673467356736673767386739674067416742674367446745674667476748674967506751675267536754675567566757675867596760676167626763676467656766676767686769677067716772677367746775677667776778677967806781678267836784678567866787678867896790679167926793679467956796679767986799680068016802680368046805680668076808680968106811681268136814681568166817681868196820682168226823682468256826682768286829683068316832683368346835683668376838683968406841684268436844684568466847684868496850685168526853685468556856685768586859686068616862686368646865686668676868686968706871687268736874687568766877687868796880688168826883688468856886688768886889689068916892689368946895689668976898689969006901690269036904690569066907690869096910691169126913691469156916691769186919692069216922692369246925692669276928692969306931693269336934693569366937693869396940694169426943694469456946694769486949695069516952695369546955695669576958695969606961696269636964696569666967696869696970697169726973697469756976697769786979698069816982698369846985698669876988698969906991699269936994699569966997699869997000700170027003700470057006700770087009701070117012701370147015701670177018701970207021702270237024702570267027702870297030703170327033
  1. (* setup.ml generated for the first time by OASIS v0.4.5 *)
  2. (* OASIS_START *)
  3. (* DO NOT EDIT (digest: 90a333c7eb112b08d176b1c3616df9f7) *)
  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.3.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 = Some "\164\128&\147\131YL\165\028\233e\144\213\207}\232";
  5867. oasis_exec = None;
  5868. oasis_setup_args = [];
  5869. setup_update = false
  5870. };;
  5871. let setup () = BaseSetup.setup setup_t;;
  5872. # 7031 "setup.ml"
  5873. (* OASIS_STOP *)
  5874. let () = setup ();;