{-# LANGUAGE CPP #-}--------------------------------------------------------------------------------- Makefile Dependency Generation---- (c) The University of Glasgow 2005-------------------------------------------------------------------------------moduleDriverMkDepend(doMkDependHS )where#include "HsVersions.h"
importGhcPreludeimportqualifiedGHC importGhcMonadimportDynFlagsimportUtilimportHscTypesimportqualifiedSysTools importModuleimportDigraph(SCC(..))importFinder importOutputableimportPanicimportSrcLocimportData.ListimportFastStringimportFileCleanupimportExceptionimportErrUtilsimportSystem.DirectoryimportSystem.FilePathimportSystem.IOimportSystem.IO.Error(isEOFError)importControl.Monad(when)importData.Maybe(isJust)importData.IORef--------------------------------------------------------------------- The main function-------------------------------------------------------------------doMkDependHS::GhcMonadm =>[FilePath]->m ()doMkDependHS srcs =do-- Initialisationdflags0 <-GHC.getSessionDynFlags-- We kludge things a bit for dependency generation. Rather than-- generating dependencies for each way separately, we generate-- them once and then duplicate them for each way's osuf/hisuf.-- We therefore do the initial dependency generation with an empty-- way and .o/.hi extensions, regardless of any flags that might-- be specified.letdflags =dflags0 {ways=[],buildTag=mkBuildTag[],hiSuf="hi",objectSuf="o"}_<-GHC.setSessionDynFlags dflags when(null(depSuffixesdflags ))$liftIO$throwGhcExceptionIO(ProgramError"You must specify at least one -dep-suffix")files <-liftIO$beginMkDependHS dflags -- Do the downsweep to find all the modulestargets <-mapM(\s ->GHC.guessTarget s Nothing)srcs GHC.setTargets targets letexcl_mods =depExcludeModsdflags module_graph <-GHC.depanal excl_mods True{- Allow dup roots -}-- Sort into dependency order-- There should be no cyclesletsorted =GHC.topSortModuleGraph Falsemodule_graph Nothing-- Print out the dependencies if wantedliftIO$debugTraceMsgdflags 2(text"Module dependencies"$$pprsorted )-- Process them one by one, dumping results into makefile-- and complaining about cycleshsc_env <-getSessionroot <-liftIOgetCurrentDirectorymapM_(liftIO.processDeps dflags hsc_env excl_mods root (mkd_tmp_hdlfiles ))sorted -- If -ddump-mod-cycles, show cycles in the module graphliftIO$dumpModCycles dflags module_graph -- Tidy upliftIO$endMkDependHS dflags files -- Unconditional exiting is a bad idea. If an error occurs we'll get an--exception; if that is not caught it's fine, but at least we have a--chance to find out exactly what went wrong. Uncomment the following--line if you disagree.--`GHC.ghcCatch` \_ -> io $ exitWith (ExitFailure 1)--------------------------------------------------------------------- beginMkDependHs-- Create a temporary file,-- find the Makefile,-- slurp through it, etc-------------------------------------------------------------------dataMkDepFiles =MkDep {mkd_make_file ::FilePath,-- Name of the makefilemkd_make_hdl ::MaybeHandle,-- Handle for the open makefilemkd_tmp_file ::FilePath,-- Name of the temporary filemkd_tmp_hdl ::Handle}-- Handle of the open temporary filebeginMkDependHS::DynFlags->IOMkDepFiles beginMkDependHS dflags =do-- open a new temp file in which to stuff the dependency info-- as we go along.tmp_file <-newTempNamedflags TFL_CurrentModule"dep"tmp_hdl <-openFiletmp_file WriteMode-- open the makefileletmakefile =depMakefiledflags exists <-doesFileExistmakefile mb_make_hdl <-ifnotexists thenreturnNothingelsedomakefile_hdl <-openFilemakefile ReadMode-- slurp through until we get the magic start string,-- copying the contents into dep_makefileletslurp =dol <-hGetLinemakefile_hdl if(l ==depStartMarker )thenreturn()elsedohPutStrLntmp_hdl l ;slurp -- slurp through until we get the magic end marker,-- throwing away the contentsletchuck =dol <-hGetLinemakefile_hdl if(l ==depEndMarker )thenreturn()elsechuck catchIOslurp (\e ->ifisEOFErrore thenreturn()elseioErrore )catchIOchuck (\e ->ifisEOFErrore thenreturn()elseioErrore )return(Justmakefile_hdl )-- write the magic marker into the tmp filehPutStrLntmp_hdl depStartMarker return(MkDep {mkd_make_file=makefile ,mkd_make_hdl=mb_make_hdl ,mkd_tmp_file=tmp_file ,mkd_tmp_hdl=tmp_hdl })--------------------------------------------------------------------- processDeps-------------------------------------------------------------------processDeps::DynFlags->HscEnv->[ModuleName]->FilePath->Handle-- Write dependencies to here->SCCModSummary->IO()-- Write suitable dependencies to handle-- Always:-- this.o : this.hs---- If the dependency is on something other than a .hi file:-- this.o this.p_o ... : dep-- otherwise-- this.o ... : dep.hi-- this.p_o ... : dep.p_hi-- ...-- (where .o is $osuf, and the other suffixes come from-- the cmdline -s options).---- For {-# SOURCE #-} imports the "hi" will be "hi-boot".processDeps dflags ____(CyclicSCCnodes )=-- There shouldn't be any cycles; report themthrowGhcExceptionIO(ProgramError(showSDocdflags $GHC.cyclicModuleErr nodes ))processDepsdflags hsc_env excl_mods root hdl (AcyclicSCCnode )=do{letextra_suffixes =depSuffixesdflags include_pkg_deps =depIncludePkgDepsdflags src_file =msHsFilePathnode obj_file =msObjFilePathnode obj_files =insertSuffixes obj_file extra_suffixes do_imp loc is_boot pkg_qual imp_mod =do{mb_hi <-findDependency hsc_env loc pkg_qual imp_mod is_boot include_pkg_deps ;casemb_hi of{Nothing->return();Justhi_file ->do{lethi_files =insertSuffixes hi_file extra_suffixes write_dep (obj ,hi )=writeDependency root hdl [obj ]hi -- Add one dependency for each suffix;-- e.g. A.o : B.hi-- A.x_o : B.x_hi;mapM_write_dep (obj_files `zip`hi_files )}}}-- Emit std dependency of the object(s) on the source file-- Something like A.o : A.hs;writeDependency root hdl obj_files src_file -- Emit a dependency for each CPP import;when(depIncludeCppDepsdflags )$do-- CPP deps are descovered in the module parsing phase by parsing-- comment lines left by the preprocessor.-- Note that GHC.parseModule may throw an exception if the module-- fails to parse, which may not be desirable (see #16616).{session <-Session<$>newIORefhsc_env ;parsedMod <-reflectGhc(GHC.parseModule node )session ;mapM_(writeDependency root hdl obj_files )(GHC.pm_extra_src_filesparsedMod )}-- Emit a dependency for each import;letdo_imps is_boot idecls =sequence_[do_imp loc is_boot mb_pkg mod |(mb_pkg ,Lloc mod )<-idecls ,mod `notElem`excl_mods ];do_imps True(ms_srcimpsnode );do_imps False(ms_impsnode )}findDependency::HscEnv->SrcSpan->MaybeFastString-- package qualifier, if any->ModuleName-- Imported module->IsBootInterface-- Source import->Bool-- Record dependency on package modules->IO(MaybeFilePath)-- Interface file filefindDependency hsc_env srcloc pkg imp is_boot include_pkg_deps =do{-- Find the module; this will be fast because-- we've done it once during downsweepr <-findImportedModule hsc_env imp pkg ;caser ofFoundloc _-- Home package: just depend on the .hi or hi-boot file|isJust(ml_hs_fileloc )||include_pkg_deps ->return(Just(addBootSuffix_maybeis_boot (ml_hi_fileloc )))-- Not in this package: we don't need a dependency|otherwise->returnNothingfail ->letdflags =hsc_dflagshsc_env inthrowOneError$mkPlainErrMsgdflags srcloc $cannotFindModule dflags imp fail }-----------------------------writeDependency::FilePath->Handle->[FilePath]->FilePath->IO()-- (writeDependency r h [t1,t2] dep) writes to handle h the dependency-- t1 t2 : depwriteDependency root hdl targets dep =dolet-- We need to avoid making deps on-- c:/foo/...-- on cygwin as make gets confused by the :-- Making relative deps avoids some instances of this.dep' =makeRelativeroot dep forOutput =escapeSpaces.reslashForwards.normaliseoutput =unwords(mapforOutput targets )++" : "++forOutput dep' hPutStrLnhdl output -----------------------------insertSuffixes::FilePath-- Original filename; e.g. "foo.o"->[String]-- Suffix prefixes e.g. ["x_", "y_"]->[FilePath]-- Zapped filenames e.g. ["foo.x_o", "foo.y_o"]-- Note that that the extra bit gets inserted *before* the old suffix-- We assume the old suffix contains no dots, so we know where to-- split itinsertSuffixes file_name extras =[basename <.>(extra ++suffix )|extra <-extras ]where(basename ,suffix )=casesplitExtensionfile_name of-- Drop the "." from the extension(b ,s )->(b ,drop1s )--------------------------------------------------------------------- endMkDependHs-- Complete the makefile, close the tmp file etc-------------------------------------------------------------------endMkDependHS::DynFlags->MkDepFiles ->IO()endMkDependHS dflags (MkDep {mkd_make_file=makefile ,mkd_make_hdl=makefile_hdl ,mkd_tmp_file=tmp_file ,mkd_tmp_hdl=tmp_hdl })=do-- write the magic marker into the tmp filehPutStrLntmp_hdl depEndMarker casemakefile_hdl ofNothing->return()Justhdl ->do-- slurp the rest of the original makefile and copy it into the outputletslurp =dol <-hGetLinehdl hPutStrLntmp_hdl l slurp catchIOslurp (\e ->ifisEOFErrore thenreturn()elseioErrore )hClosehdl hClosetmp_hdl -- make sure it's flushed-- Create a backup of the original makefilewhen(isJustmakefile_hdl )(SysTools.copy dflags ("Backing up "++makefile )makefile (makefile ++".bak"))-- Copy the new makefile in placeSysTools.copy dflags "Installing new makefile"tmp_file makefile ------------------------------------------------------------------- Module cycles-----------------------------------------------------------------dumpModCycles::DynFlags->ModuleGraph->IO()dumpModCycles dflags module_graph |not(doptOpt_D_dump_mod_cyclesdflags )=return()|nullcycles =putMsgdflags (text"No module cycles")|otherwise=putMsgdflags (hang(text"Module cycles found:")2pp_cycles )wherecycles::[[ModSummary]]cycles =[c |CyclicSCCc <-GHC.topSortModuleGraph Truemodule_graph Nothing]pp_cycles =vcat[(text"---------- Cycle"<+>intn <+>ptext(sLit"----------"))$$pprCycle c $$blankLine|(n ,c )<-[1..]`zip`cycles ]pprCycle::[ModSummary]->SDoc-- Print a cycle, but show only the imports within the cyclepprCycle summaries =pp_group (CyclicSCCsummaries )wherecycle_mods::[ModuleName]-- The modules in this cyclecycle_mods =map(moduleName.ms_mod)summaries pp_group (AcyclicSCCms )=pp_ms ms pp_group(CyclicSCCmss )=ASSERT(not(nullboot_only))-- The boot-only list must be non-empty, else there would-- be an infinite chain of non-boot imoprts, and we've-- already checked for that in processModDepspp_ms loop_breaker $$vcat(mappp_group groups )where(boot_only ,others )=partitionis_boot_only mss is_boot_only ms =not(anyin_group (mapsnd(ms_impsms )))in_group (L_m )=m `elem`group_mods group_mods =map(moduleName.ms_mod)mss loop_breaker =headboot_only all_others =tailboot_only ++others groups =GHC.topSortModuleGraph True(mkModuleGraphall_others )Nothingpp_ms summary =textmod_str <>text(take(20-lengthmod_str )(repeat' '))<+>(pp_imps empty(mapsnd(ms_impssummary ))$$pp_imps (text"{-# SOURCE #-}")(mapsnd(ms_srcimpssummary )))wheremod_str =moduleNameString(moduleName(ms_modsummary ))pp_imps::SDoc->[LocatedModuleName]->SDocpp_imps _[]=emptypp_impswhat lms =case[m |L_m <-lms ,m `elem`cycle_mods ]of[]->emptyms ->what <+>text"imports"<+>pprWithCommaspprms --------------------------------------------------------------------- Flags-------------------------------------------------------------------depStartMarker,depEndMarker::StringdepStartMarker ="# DO NOT DELETE: Beginning of Haskell dependencies"depEndMarker ="# DO NOT DELETE: End of Haskell dependencies"