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
|
{-
-- The main program wrapper for cpphs, a simple C pre-processor
-- written in Haskell.
-- Author: Malcolm Wallace, 2004
-- This file is licensed under the GPL. Note however, that all other
-- modules used by it are either distributed under the LGPL, or are Haskell'98.
--
-- Thus, when compiled as a standalone executable, this program will fall
-- under the GPL.
-}
module Main where
import System.Environment ( getArgs, getProgName)
import System.Exit ( exitWith, ExitCode(..) )
import Data.Maybe
import Language.Preprocessor.Cpphs ( runCpphs, CpphsOptions(..), parseOptions )
import System.IO ( stdout, IOMode(WriteMode), openFile, hPutStr, hFlush, hClose )
import Control.Monad ( when )
import Data.List ( isPrefixOf )
version :: String
version = "1.18.5"
main :: IO ()
main = do
args <- getArgs
args <- return $ if "--cpp" `elem` args then convertArgs args else args
prog <- getProgName
when ("--version" `elem` args)
(do putStrLn (prog++" "++version)
exitWith ExitSuccess)
when ("--help" `elem` args)
(do putStrLn ("Usage: "++prog
++" [file ...] [ -Dsym | -Dsym=val | -Ipath ]* [-Ofile]\n"
++"\t\t[--nomacro] [--noline] [--linepragma] [--pragma] [--text]\n"
++"\t\t[--strip] [--strip-eol] [--hashes] [--layout] [--unlit]\n"
++"\t\t[ --cpp std-cpp-options ] [--include=filename]")
exitWith ExitSuccess)
let parsedArgs = parseOptions args
options = fromRight parsedArgs
ins = infiles options
outs = outfiles options
out = listToMaybe outs
when (isLeft parsedArgs)
(do putStrLn $ "Unknown option "++fromLeft parsedArgs
++", for valid options try "++prog++" --help\n"
exitWith (ExitFailure 1))
when (length outs > 1)
(do putStrLn $ "At most one output file (-O) can be specified"
exitWith (ExitFailure 2))
if null ins then execute options out Nothing
else mapM_ (execute options out) (map Just ins)
-- | Execute the preprocessor.
-- If the filepath is Nothing then default to stdout\/stdin as appropriate.
execute :: CpphsOptions -> Maybe FilePath -> Maybe FilePath -> IO ()
execute opts ofile infile =
let (filename, readIt) = case infile of
Just x -> (x, readFile x)
Nothing -> ("stdin", getContents)
output Nothing x = do putStr x; hFlush stdout
output (Just f) x = writeFile f x
in do contents <- readIt
transformed <- runCpphs opts filename contents
output ofile transformed
isLeft (Left _) = True
isLeft _ = False
fromLeft (Left x) = x
fromRight (Right x) = x
-- | Convert commandline options to remain compatible with cpp.
-- Based on a shell script cpphs.compat
data ConvertArgs = ConvertArgs { traditional, strip :: Bool
, infile, outfile :: String }
convertArgs :: [String] -> [String]
convertArgs xs = f (ConvertArgs False True "-" "-") xs
where
flg = "DUI"
f e (['-',r]:x:xs) | r `elem` flg = ('-':r:x) : f e xs
f e (x@('-':r:_):xs) | r `elem` flg = x : f e xs
f e ("-o":x:xs) = ('-':'O':x) : f e xs
f e (('-':'o':x):xs) = ('-':'O':drop 2 x) : f e xs
f e (('-':x):xs) | "ansi" `isPrefixOf` x = f e{traditional=False} xs
| "traditional" `isPrefixOf` x = f e{traditional=True} xs
| "std" `isPrefixOf` x = f e xs -- ignore language spec
f e ("-x":x:xs) = f e xs -- ignore language spec
f e ("-include":x:xs) = ("--include="++x) : f e xs
f e ("-P":xs) = "--noline" : f e xs
f e (x:xs) | x == "-C" || x == "-CC" = f e{strip=False} xs
f e ("-A":x:xs) = f e xs -- strip assertions
f e ("--help":xs) = "--help" : f e xs
f e ("--version":xs) = "--version" : f e xs
f e ("-version":xs) = "--version" : f e xs
f e (('-':x):xs) = f e xs -- strip all other flags
f e (x:xs) = f (if infile e == "-" then e{infile=x} else e{outfile=x}) xs
f e [] = ["--hashes" | not (traditional e)] ++
["--strip" | traditional e && strip e] ++
["--strip-eol" | not (traditional e) && strip e] ++
[infile e] ++
["-O" ++ outfile e | outfile e /= "-"]
|
