forked from avsm/EpiVM
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Ignore-this: 6bd53353340074fe26df80716b5989a7 darcs-hash:20091217122452-6ac22-47e0d89be4f0105341b9752efa084b3021637322.gz
- Loading branch information
eb
committed
Dec 17, 2009
1 parent
b6f2119
commit 738525c
Showing
2 changed files
with
119 additions
and
2 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,118 @@ | ||
> module Main where | ||
|
||
> import System | ||
> import System.Directory | ||
> import System.Environment | ||
> import System.IO | ||
> import Monad | ||
|
||
> import Epic.Compiler | ||
|
||
> 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)) | ||
> 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 | ||
> fns <- getFile opts | ||
> if (length fns == 0) | ||
> then do showUsage | ||
> return (fns,opts) | ||
> else return (fns,opts) | ||
|
||
> showUsage = do putStrLn "Epigram Supercombinator Compiler version 0.1" | ||
> 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) | ||
> 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 (('$':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 [] |