Adds smart constructors and support for MIPS `(x)` references.
[hsc2hs.git] / Flags.hs
1
2 module Flags where
3
4 import System.Console.GetOpt
5
6 data Mode
7 = Help
8 | Version
9 | UseConfig (ConfigM Maybe)
10
11 newtype Id a = Id { fromId :: a }
12 type Config = ConfigM Id
13
14 data ConfigM m = Config {
15 cmTemplate :: m FilePath,
16 cmCompiler :: m FilePath,
17 cmLinker :: m FilePath,
18 cKeepFiles :: Bool,
19 cNoCompile :: Bool,
20 cCrossCompile :: Bool,
21 cViaAsm :: Bool,
22 cCrossSafe :: Bool,
23 cColumn :: Bool,
24 cVerbose :: Bool,
25 cFlags :: [Flag]
26 }
27
28 cTemplate :: ConfigM Id -> FilePath
29 cTemplate c = fromId $ cmTemplate c
30
31 cCompiler :: ConfigM Id -> FilePath
32 cCompiler c = fromId $ cmCompiler c
33
34 cLinker :: ConfigM Id -> FilePath
35 cLinker c = fromId $ cmLinker c
36
37 emptyMode :: Mode
38 emptyMode = UseConfig $ Config {
39 cmTemplate = Nothing,
40 cmCompiler = Nothing,
41 cmLinker = Nothing,
42 cKeepFiles = False,
43 cNoCompile = False,
44 cCrossCompile = False,
45 cViaAsm = False,
46 cCrossSafe = False,
47 cColumn = False,
48 cVerbose = False,
49 cFlags = []
50 }
51
52 data Flag
53 = CompFlag String
54 | LinkFlag String
55 | Include String
56 | Define String (Maybe String)
57 | Output String
58 deriving Show
59
60 options :: [OptDescr (Mode -> Mode)]
61 options = [
62 Option ['o'] ["output"] (ReqArg (addFlag . Output) "FILE")
63 "name of main output file",
64 Option ['t'] ["template"] (ReqArg (withConfig . setTemplate) "FILE")
65 "template file",
66 Option ['c'] ["cc"] (ReqArg (withConfig . setCompiler) "PROG")
67 "C compiler to use",
68 Option ['l'] ["ld"] (ReqArg (withConfig . setLinker) "PROG")
69 "linker to use",
70 Option ['C'] ["cflag"] (ReqArg (addFlag . CompFlag) "FLAG")
71 "flag to pass to the C compiler",
72 Option ['I'] [] (ReqArg (addFlag . CompFlag . ("-I"++)) "DIR")
73 "passed to the C compiler",
74 Option ['L'] ["lflag"] (ReqArg (addFlag . LinkFlag) "FLAG")
75 "flag to pass to the linker",
76 Option ['i'] ["include"] (ReqArg (addFlag . include) "FILE")
77 "as if placed in the source",
78 Option ['D'] ["define"] (ReqArg (addFlag . define) "NAME[=VALUE]")
79 "as if placed in the source",
80 Option [] ["no-compile"] (NoArg (withConfig $ setNoCompile True))
81 "stop after writing *_hsc_make.c",
82 Option ['x'] ["cross-compile"] (NoArg (withConfig $ setCrossCompile True))
83 "activate cross-compilation mode",
84 Option [] ["via-asm"] (NoArg (withConfig $ setViaAsm True))
85 "use a crude asm parser to compute constants when cross compiling",
86 Option [] ["cross-safe"] (NoArg (withConfig $ setCrossSafe True))
87 "restrict .hsc directives to those supported by --cross-compile",
88 Option ['k'] ["keep-files"] (NoArg (withConfig $ setKeepFiles True))
89 "do not remove temporary files",
90 Option [] ["column"] (NoArg (withConfig $ setColumn True))
91 "annotate output with COLUMN pragmas (requires GHC 8.2)",
92 Option ['v'] ["verbose"] (NoArg (withConfig $ setVerbose True))
93 "dump commands to stderr",
94 Option ['?'] ["help"] (NoArg (setMode Help))
95 "display this help and exit",
96 Option ['V'] ["version"] (NoArg (setMode Version))
97 "output version information and exit" ]
98
99 addFlag :: Flag -> Mode -> Mode
100 addFlag f (UseConfig c) = UseConfig $ c { cFlags = f : cFlags c }
101 addFlag _ mode = mode
102
103 setMode :: Mode -> Mode -> Mode
104 setMode Help _ = Help
105 setMode _ Help = Help
106 setMode Version _ = Version
107 setMode (UseConfig {}) _ = error "setMode: UseConfig: Can't happen"
108
109 withConfig :: (ConfigM Maybe -> ConfigM Maybe) -> Mode -> Mode
110 withConfig f (UseConfig c) = UseConfig $ f c
111 withConfig _ m = m
112
113 setTemplate :: FilePath -> ConfigM Maybe -> ConfigM Maybe
114 setTemplate fp c = c { cmTemplate = Just fp }
115
116 setCompiler :: FilePath -> ConfigM Maybe -> ConfigM Maybe
117 setCompiler fp c = c { cmCompiler = Just fp }
118
119 setLinker :: FilePath -> ConfigM Maybe -> ConfigM Maybe
120 setLinker fp c = c { cmLinker = Just fp }
121
122 setKeepFiles :: Bool -> ConfigM Maybe -> ConfigM Maybe
123 setKeepFiles b c = c { cKeepFiles = b }
124
125 setNoCompile :: Bool -> ConfigM Maybe -> ConfigM Maybe
126 setNoCompile b c = c { cNoCompile = b }
127
128 setCrossCompile :: Bool -> ConfigM Maybe -> ConfigM Maybe
129 setCrossCompile b c = c { cCrossCompile = b }
130
131 setViaAsm :: Bool -> ConfigM Maybe -> ConfigM Maybe
132 setViaAsm b c = c { cViaAsm = b }
133
134 setCrossSafe :: Bool -> ConfigM Maybe -> ConfigM Maybe
135 setCrossSafe b c = c { cCrossSafe = b }
136
137 setColumn :: Bool -> ConfigM Maybe -> ConfigM Maybe
138 setColumn b c = c { cColumn = b }
139
140 setVerbose :: Bool -> ConfigM Maybe -> ConfigM Maybe
141 setVerbose v c = c { cVerbose = v }
142
143 include :: String -> Flag
144 include s@('\"':_) = Include s
145 include s@('<' :_) = Include s
146 include s = Include ("\""++s++"\"")
147
148 define :: String -> Flag
149 define s = case break (== '=') s of
150 (name, []) -> Define name Nothing
151 (name, _:value) -> Define name (Just value)
152