| 19 | 19 |
|
| 20 | 20 |
data Flags = Flags {
|
| 21 | 21 |
typeCheck :: String,
|
|
22 |
debugExtraction :: Maybe String,
|
| 22 | 23 |
outputPrg :: Maybe String
|
| 23 | 24 |
} deriving (Show, Ord, Eq)
|
| 24 | 25 |
|
| 25 | 26 |
defaultFlags = Flags{
|
| 26 | 27 |
typeCheck = "yes",
|
|
28 |
debugExtraction = Nothing,
|
| 27 | 29 |
outputPrg = Nothing
|
| 28 | 30 |
}
|
| 29 | 31 |
|
| 30 | 32 |
parseFlags flags ("--type-check":s:rest) =
|
| 31 | 33 |
parseFlags flags{ typeCheck = s } rest
|
|
34 |
parseFlags flags ("--debug-extraction":s:rest) =
|
|
35 |
parseFlags flags{ debugExtraction = Just s } rest
|
| 32 | 36 |
parseFlags flags ("--output-prg":s:rest) =
|
| 33 | 37 |
parseFlags flags{ outputPrg = Just s } rest
|
| 34 | 38 |
parseFlags flags other = (flags, other)
|
|
| 81 | 85 |
return $ extract program initialEEnv
|
| 82 | 86 |
other ->
|
| 83 | 87 |
abortWith $ "illegal option: --type-check: " ++ other
|
| 84 | |
case outputPrg flags of
|
|
88 |
case debugExtraction flags of
|
|
89 |
Just "dump" ->
|
|
90 |
putStrLn $ show extracted
|
|
91 |
Just other ->
|
|
92 |
abortWith $ "illegal option: --debug-extraction: " ++ other
|
| 85 | 93 |
Nothing ->
|
| 86 | |
putStrLn $ hexDump $ serialize extracted "main" 0x0200
|
| 87 | |
Just filename ->
|
| 88 | |
writeBinaryFile filename $ serialize extracted "main" 0x0200
|
|
94 |
case outputPrg flags of
|
|
95 |
Nothing ->
|
|
96 |
putStrLn $ hexDump $ serialize extracted "main" 0x0200
|
|
97 |
Just filename ->
|
|
98 |
writeBinaryFile filename $ serialize extracted "main" 0x0200
|
| 89 | 99 |
_ -> do
|
| 90 | 100 |
abortWith $
|
| 91 | 101 |
"Usage: uampirnexol {flags} parse <filename>\n" ++
|
|
| 94 | 104 |
" uampirnexol {flags} extract <filename>\n" ++
|
| 95 | 105 |
" where {flags} can be:\n" ++
|
| 96 | 106 |
" --type-check yes|no (default yes)\n" ++
|
|
107 |
" --debug-extraction dump\n" ++
|
| 97 | 108 |
" --output-prg <filename>"
|
| 98 | 109 |
|
| 99 | 110 |
|