----------------------------------------------------------------------------- -- | -- Module : Output -- Copyright : Thomas Hallgren and Malcolm Wallace -- -- Maintainer : Malcolm Wallace -- Stability : Stable -- Portability : All -- -- Constructs the commands for each steps in building (compile, link, -- & clean). Each are parameterized by echo :: Bool which indicates -- whether or not to echo the command to the terminal. ----------------------------------------------------------------------------- module Output(qCompile,qLink,qCleano,qCleanhi) where import ListUtil -- (lconcatMap) import FileName import List (intersperse) import Argv import PreProcessor import Config import RunAndReadStdout (basename) type Graph t t1 t2 t3 = [(String, ((t, String, t1, t2, t3), [String]))] -- | Given a boolean to indicate whether or not to echo this command to -- the terminal, construct the command. doEcho :: Bool -- ^ echo the command before executing it? -> String -> String doEcho True cmd = "echo \"" ++ cmd ++ "\"\n" ++ cmd ++ "\n" doEcho False cmd = cmd ++ "\n" oFile,hiFile,hatFile :: DecodedArgs -> String -> String -> String oFile opts path fmodule = let tmod = if hat opts then ("Hat/"++) else id in fixFile opts (maybe path id (goalDir opts)) (tmod fmodule) (oSuffix opts) hiFile opts path fmodule = fixFile opts (maybe path id (hiDir opts)) fmodule (hiSuffix opts) --iFile opts path fmodule = -- fixFile opts path fmodule ("pp.hs") hatFile opts path fmodule = fixFile opts path ("Hat/"++fmodule) ("hs") hatHiFile opts path fmodule = fixFile opts path ("Hat/"++fmodule) (hiSuffix opts) hxFile opts path fmodule = fixFile opts path fmodule ("hx") cleanModuleName (Program file) = file cleanModuleName (Object file suf) = file -- | Construct a command for the /clean/ step (rm -f .o files) qCleano :: DecodedArgs -> Bool -> Graph a b c d -> Goal -> String qCleano opts echo graph mod = let allfiles = close graph [] [cleanModuleName mod] in doEcho echo ("rm -f" ++ concatMap (\(d,f)-> ' ': oFile opts d f) allfiles) -- | Construct a command for the /realclean/ step (rm -f hi, hat, and hx files) qCleanhi :: DecodedArgs -- ^ /opts/ -> Bool -- ^ Should we echo this command as we run it? -> Graph a b c d -> Goal -- ^ /mod/ -> String qCleanhi opts echo graph mod = let allfiles = close graph [] [cleanModuleName mod] in if hat opts then doEcho echo ("rm -f" ++ concatMap (\(d,f)-> ' ': hatHiFile opts d f) allfiles) ++ doEcho echo ("rm -f" ++ concatMap (\(d,f)-> ' ': hatFile opts d f) allfiles) ++ doEcho echo ("rm -f" ++ concatMap (\(d,f)-> ' ': hxFile opts d f) allfiles) else doEcho echo ("rm -f" ++ concatMap (\(d,f)-> ' ': hiFile opts d f) allfiles) -- | Construct the command for the /compile/ commands, depends upon -- which compiler we're using, whether we're using hat, etc. qCompile :: DecodedArgs -> Bool -> ([(String, String)], (String, String, String, Bool, PreProcessor)) -> String qCompile opts echo (dep,(p,m,srcfile,cpp,pp)) = test dep (preprocess++hattrans++compilecmd) where -- srcfile -(preprocess)-> pfile -(hattrans)-> hfile -(compile)-> ofile ofile = oFile opts p m pfile | null (ppExecutableName pp) = srcfile | otherwise = fixFile opts p m "hs" hfile | hat opts = hatFile opts p m | otherwise = pfile preprocess | null (ppExecutableName pp) = "" | otherwise = doEcho echo $ ppExecutableName pp++" " ++concat (intersperse " " (ppDefaultOptions pp opts ++[ppOutputFileOption pp pfile] ++[srcfile])) hattrans | hat opts && cpp = doEcho echo ("gcc -E -traditional -x c "++pfile ++concatMap doD (defs opts ++ zdefs opts) ++" -o /tmp/"++basename pfile) ++ doEcho echo ("hat-trans $HATFLAGS -P. /tmp/"++basename pfile ++" "++pfile) ++ doEcho echo ("rm /tmp/"++basename pfile) -- ++ doEcho echo ("mv "++hatFile opts "/tmp" m++" "++hfile) -- ++ doEcho echo ("mv "++hxFile opts "/tmp" m++" "++hxFile opts p m) | hat opts && not cpp = doEcho echo $ "hat-trans $HATFLAGS "++pfile | otherwise = "" compilecmd = doEcho echo $ hc ++ "-c " ++ cppcmd ++ (if hat opts then "-package hat " else " ") ++ (if (dflag opts) then "-d "++maybe "." id (goalDir opts)++" " else "-o "++ofile++" ") ++ hfile hc | isUnix opts = compilerPath (compiler opts) ++" "++unwords (extraCompilerFlags (compiler opts)) ++" ${HFLAGS} " | otherwise = compilerPath (compiler opts) ++" "++unwords (extraCompilerFlags (compiler opts)) cppcmd = if cpp then "-cpp"++concatMap doD (defs opts)++" " else "" doD s = " -D"++s test [] comp = comp test dep comp | isUnix opts = "if [ `$OLDER " ++ ofile ++ lconcatMap (\(d,p) -> ' ':hiFile opts p d) dep ++"` = 1 ]\nthen\n" ++ comp ++ "\nfi\n" | otherwise = "older " ++ ofile ++ lconcatMap (\(d,p) -> ' ':hiFile opts p d) dep ++ "\nset Nhc$ReturnCode \n" ++ "IF THEN " ++ comp -- | Construct the command for the /link/ step in building. qLink :: DecodedArgs -> Bool -> Graph a b c d -> Goal -> String qLink opts echo graph (Object file suf) = "" qLink opts echo graph (Program file) = cmd where goal = maybe "" id (goalDir opts) tmod = if hat opts then ("Hat/"++) else id mkOfile path f = if (dflag opts) then fixFile opts "" (tmod f) (oSuffix opts) else fixFile opts path (tmod f) (oSuffix opts) objfiles = close graph [] [file] hatflag = if hat opts then "-package hat " else "" hc | isUnix opts = compilerPath (compiler opts)++" ${HFLAGS} " | otherwise = compilerPath (compiler opts) cmd | isUnix opts = let objs = lconcatMap (\(d,f) -> ' ':mkOfile d f) objfiles in if null goal then let objs = lconcatMap (\(d,f) -> ' ':mkOfile d f) objfiles in "if [ `$OLDER "++file++" "++objs++"` = 1 ]\nthen\n" ++ doEcho echo (hc++hatflag++" -o "++file++objs++" ${LDFLAGS}") ++ "fi\n" else let objs = lconcatMap (\(d,f) -> ' ': fixFile opts "" (tmod f) (oSuffix opts)) objfiles in "if ( cd "++goal++" && [ `$OLDER " ++ file ++ " "++objs++"` = 1 ] )\nthen\n" ++ doEcho echo ("cd "++goal++" && "++hc++hatflag++" -o " ++file++objs++" ${LDFLAGS}") ++ "fi\n" | otherwise = if length objfiles > 3 then "exfile .nhcmk_via STOP\n" ++ lconcatMap (\(d,f) -> ' ': fixFile opts (if null d then goal else d) f (oSuffix opts) ++ "\n") objfiles ++ "STOP\n" ++ "nhc98 " ++ " -o " ++ file ++ " -via .nhcmk_via\n" else "nhc98 " ++ " -o " ++ file ++ lconcatMap (\(d,f) -> ' ': fixFile opts (if null d then goal else d) f (oSuffix opts)) objfiles ++ "\n" -- Could be more polymorphic -- close :: forall b a t3 t2 t1 t. -- (Eq b) => -- [(b, ((t, a, t1, t2, t3), [b]))] -> [(a, b)] -> [b] -> [(a, b)] close :: Graph a b c d -> [(String, String)] -> [String] -> [(String, String)] close graph acc [] = acc close graph acc (f:fs) = if any ((f==).snd) acc then close graph acc fs else case assocDef graph (error "Use?") f of ((tps,d,s,_,_),new) -> close graph ((d,f):acc) (fs ++ new)