epic-0.9: Main.lhs

> module Main where

> import System.Exit
> import System.Directory
> import System.Environment
> import System.IO
> import Distribution.Version
> import Control.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) outfile (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 (DbgInfo:xs) = Debug:(mkOpts xs)
>         mkOpts (CheckLvl i:xs) = Checking i:(mkOpts xs)
>         mkOpts (ExtMain:xs) = ExternalMain:(mkOpts xs)
>         mkOpts (ExtraInc i:xs) = MainInc i:(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 $ "Epic version " ++ versionString
>                putStrLn "Usage:\n\tepic <input file> [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
>             | CheckLvl Int -- Checking level, 0 for none, default none
>   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 ("-checking":lvl:args) = CheckLvl (read lvl):(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 []

> 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