> module Main where > import System > import System.Directory > import System.Environment > import System.IO > import Distribution.Version > import Monad > import Epic.Compiler > import Paths_epic > versionString = showV (versionBranch version) > where > showV [] = "" > showV [a] = show a > showV (x:xs) = show x ++ "." ++ showV xs > main = do args <- getArgs > (fns, opts) <- getInput args > outfile <- getOutput opts > ofiles <- compileFiles fns (mkOpts opts) > copts <- getCOpts opts > extras <- getExtra opts > if ((length ofiles) > 0 && (not (elem Obj opts))) > then link (ofiles ++ copts) extras outfile (not (elem ExtMain opts)) (mkOpts opts) > else return () > where mkOpts (KeepInt:xs) = KeepC:(mkOpts xs) > mkOpts (TraceOn:xs) = Trace:(mkOpts xs) > mkOpts (Header f:xs) = MakeHeader f:(mkOpts xs) > mkOpts (_:xs) = mkOpts xs > mkOpts [] = [] > compileFiles [] _ = return [] > compileFiles (fn:xs) opts > | isDotE fn = do > let ofile = getRoot fn ++ ".o" > compileOpts fn ofile (Just (getRoot fn ++ ".ei")) opts > rest <- compileFiles xs opts > return (ofile:rest) > | isDotO fn = do > rest <- compileFiles xs opts > return (fn:rest) > | otherwise = do -- probably autogenerated, just build it. > let ofile = fn ++ ".o" > compileOpts fn ofile Nothing opts > rest <- compileFiles xs opts > return (ofile:rest) > isDotE ('.':'e':[]) = True > isDotE (_:xs) = isDotE xs > isDotE [] = False > isDotC ('.':'c':[]) = True > isDotC (_:xs) = isDotC xs > isDotC [] = False > isDotO ('.':'o':[]) = True > isDotO (_:xs) = isDotO xs > isDotO [] = False > mkExecname fn = case span (/='.') fn of > (stem,".e") -> stem > (stem,_) -> fn ++ ".exe" > getRoot fn = case span (/='.') fn of > (stem,_) -> stem > getInput :: [String] -> IO ([FilePath],[Option]) > getInput args = do let opts = parseArgs args > processFlags opts False > fns <- getFile opts > if (length fns == 0) > then do showUsage > return (fns,opts) > else return (fns,opts) > showUsage = do putStrLn $ "Epigram Supercombinator Compiler version " ++ versionString > putStrLn "Usage:\n\tepic [options]" > exitWith (ExitFailure 1) > data Option = KeepInt -- Don't delete intermediate file > | TraceOn -- Trace while running (debug option) > | Obj -- Just make the .o, don't link > | File String -- File to send the compiler > | Output String -- Output filename > | Header String -- Header output filename > | ExtraInc String -- extra files to inlude > | COpt String -- option to send straight to gcc > | ExtMain -- external main (i.e. in a .o) > | CFlags -- output include flags > | LibFlags -- output linker flags > | DbgInfo -- generate debug info > deriving Eq > parseArgs :: [String] -> [Option] > parseArgs [] = [] > parseArgs ("-keepc":args) = KeepInt:(parseArgs args) > parseArgs ("-trace":args) = TraceOn:(parseArgs args) > parseArgs ("-c":args) = Obj:(parseArgs args) > parseArgs ("-extmain":args) = ExtMain:(parseArgs args) > parseArgs ("-o":name:args) = (Output name):(parseArgs args) > parseArgs ("-h":name:args) = (Header name):(parseArgs args) > parseArgs ("-i":inc:args) = (ExtraInc inc):(parseArgs args) > parseArgs ("-includedirs":args) = CFlags:(parseArgs args) > parseArgs ("-libdirs":args) = LibFlags:(parseArgs args) > parseArgs ("-g":args) = DbgInfo:(parseArgs args) > parseArgs (('$':x):args) = (COpt (x ++ concat (map (" "++) args))):[] > parseArgs (('-':x):args) = (COpt x):(parseArgs args) > parseArgs (x:args) = (File x):(parseArgs args) > getFile :: [Option] -> IO [FilePath] > getFile ((File x):xs) = do fns <- getFile xs > return (x:fns) > getFile (_:xs) = getFile xs > getFile [] = return [] > getOutput :: [Option] -> IO FilePath > getOutput ((Output fn):xs) = return fn > getOutput (_:xs) = getOutput xs > getOutput [] = return "a.out" > getCOpts :: [Option] -> IO [String] > getCOpts ((COpt x):xs) = do fns <- getCOpts xs > return (x:fns) > getCOpts (_:xs) = getCOpts xs > getCOpts [] = return [] > getExtra :: [Option] -> IO [String] > getExtra ((ExtraInc x):xs) = do fns <- getExtra xs > return (x:fns) > getExtra (_:xs) = getExtra xs > getExtra [] = return [] > processFlags :: [Option] -> Bool -> IO () > processFlags [] True = do putStrLn ""; exitWith ExitSuccess > processFlags [] False = return () > processFlags (LibFlags:xs) _ = do datadir <- getDataDir > putStr $ "-L"++datadir++"/evm " > processFlags xs True > processFlags (CFlags:xs) _ = do datadir <- getDataDir > putStr $ "-I"++datadir++"/evm " > processFlags xs True > processFlags (_:xs) quit = processFlags xs quit