----------------------------------------------------------------------------- -- | -- Module : Main -- Copyright : Thomas Hallgren and Malcolm Wallace -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- Main program for hmake ----------------------------------------------------------------------------- module Main(main) where import Argv import GetDep import Getmodtime(isOlder,When(..)) import ListUtil(lconcatMap,assocDef,pair) import Order (scctsort) import Output import IO import System main = getArgs >>= \args-> decode args >>= \d-> let echo = not (quiet d) order g = (scctsort . map (\(f,(tps,i)) -> (f,i))) g fdeps g = map (\(f,((t,p,s,c,pp),is)) -> ((f,p,s,c) , map (\i->(i, path (assocDef g (undefModule i) i))) is ) ) g where path ((t,p,s,cpp,pp),i) = p build_graph mods = -- First, get a list of all the important info about every file -- that might be touched. dependency d [] (map (\m->(stripGoal m,"commandline")) mods) >>= \infos -> -- infos is a list of (file, (timestamps,imports)) let -- srcs is the simple list of source files. srcs = map fst infos -- localdeps removes prelude imports from the import lists localdeps = map (\(f,(x,i))-> (f,(x,filter (`elem` srcs) i))) infos -- sorted removes timestamps, finds strongly connected -- components, and orders them. sorted = order localdeps -- sorted' is the flattened scc list sorted' = concat sorted -- cycles identifies cyclic dependencies cycles = filter ((1 /=) . length) sorted -- hsT and hiT are assoc-lists of static timestamps hsT = hsTimes localdeps sorted' hiT = hiTimes localdeps sorted' hiP = hiPaths localdeps sorted' -- graph calculates which files definitely need to be -- compiled based on initial timestamps, and which ones -- might need to be compiled, depending on whether some -- imported modules' .hi files changed or not. graph = makeGraph [] hiT hiP hsT in return (cycles, graph, localdeps, fdeps localdeps) makeGraph seen hiT hiP [] = [] makeGraph seen hiT hiP ((hs,(src,obj,p,s,cpp,pp,dep)):hsT) = -- If at least one of the imported .hi files or the source file -- is younger than the object file, then we definitely recompile. if or (map (isOlder obj) (src: map (assocDef hiT (undefModule "??")) dep)) then ([],(p,hs,s,cpp,pp)): makeGraph (hs:seen) hiT hiP hsT else -- Otherwise, we need to build a dynamic dependency on those .hi files -- which might change (due to cycles). But if all the imported .hi's -- have already been seen, we leave this one alone. case filter (`elem` seen) dep of [] -> makeGraph seen hiT hiP hsT xs -> (map impPath xs, (p,hs,s,cpp,pp)): makeGraph (hs:seen) hiT hiP hsT where impPath x = (x, assocDef hiP (undefModule x) x) hsTimes g m = map (\v-> (v, hsTime (assocDef g (undefModule v) v))) m where hsTime (((ppT,hsT,hiT,oT),p,s,cpp,pp),i) = (min ppT hsT,oT,p,s,cpp,pp,i) min Never t = t min t _ = t hiTimes g m = map (\v-> (v, hiTime (assocDef g (undefModule v) v))) m where hiTime (((_,_,hiT,_),p,s,cpp,pp),i) = hiT hiPaths g m = map (\v-> (v, hiPath (assocDef g (undefModule v) v))) m where hiPath (((_,_,_,_),p,s,cpp,pp),i) = p undefModule m = error ("undefined module "++show m++"\n") in if null (modules d) then hPutStr stderr ("Usage: MkProg [-q] [-dobjdir] [-g] [-M] target ...\n" ++" [must have at least one target]\n") else do (cycles, build, localdeps, fdep) <- build_graph (modules d) let objcmds = lconcatMap (qCompile d echo) build execmds = lconcatMap (qLink d echo localdeps) (modules d) cleano = lconcatMap (qCleano d echo localdeps) (modules d) cleanhi = lconcatMap (qCleanhi d echo localdeps) (modules d) hPutStr stderr (if null cycles then "" else "Cycles:\n"++lconcatMap ((++"\n") . show) cycles) putStr (ifopt d ["g"] (lconcatMap showdep localdeps)) putStr (ifopt d ["gd"] (lconcatMap showdebug localdeps)) putStr (ifopt d ["M"] ("# dependencies generated by hmake -M:\n" ++lconcatMap (showmake d (maybe "" id (goalDir d))) fdep)) putStr (ifopt d ["Md"] ("# dependencies generated by hmake -Md:\n" ++"OBJDIR=" ++ (maybe "." id (goalDir d)) ++ "\n" ++lconcatMap (showmake d "${OBJDIR}") fdep)) putStr (ifopt d ["clean", "realclean"] cleano) putStr (ifopt d ["realclean"] cleanhi) putStr (ifnotopt d ["g", "gd", "M", "Md", "clean", "realclean"] (objcmds ++ execmds))