forked from edwinb/EpiVM
/
Main.lhs
145 lines (126 loc) · 5.17 KB
/
Main.lhs
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