-----------------------------------------------------------------------------
-- |
-- Module : Output
-- Copyright : Thomas Hallgren and Malcolm Wallace
--
-- Maintainer : Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- 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 <Sys$ReturnCode>\n"
++ "IF <Nhc$ReturnCode> 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 <Wimp$ScrapDir>.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 <Wimp$ScrapDir>.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)
|
