Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: avsm-devel
Fetching contributors…

Cannot retrieve contributors at this time

file 145 lines (126 sloc) 5.298 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145
> 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 (DbgInfo:xs) = Debug:(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 <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
> 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
Something went wrong with that request. Please try again.