setup.ml 180 KB

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