-----------------------------------------------------------------------------
-- |
-- Module      :  CppIfdef
-- Copyright   :  1999-2004 Malcolm Wallace
-- Licence     :  LGPL
-- 
-- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
-- Stability   :  experimental
-- Portability :  All

-- Perform a cpp.first-pass, gathering \#define's and evaluating \#ifdef's.
-- and \#include's.
-----------------------------------------------------------------------------

module Language.Preprocessor.Cpphs.CppIfdef
  ( cppIfdef    -- :: FilePath -> [(String,String)] -> [String] -> Options
                --      -> String -> IO [(Posn,String)]
  ) where


import Text.Parse
import Language.Preprocessor.Cpphs.SymTab
import Language.Preprocessor.Cpphs.Position  (Posn,newfile,newline,newlines
                                             ,cppline,cpp2hask,newpos)
import Language.Preprocessor.Cpphs.ReadFirst (readFirst)
import Language.Preprocessor.Cpphs.Tokenise  (linesCpp,reslash)
import Language.Preprocessor.Cpphs.Options   (BoolOptions(..))
import Language.Preprocessor.Cpphs.HashDefine(HashDefine(..),parseHashDefine
                                             ,expandMacro)
import Language.Preprocessor.Cpphs.MacroPass (preDefine,defineMacro)
import Data.Char        (isDigit,isSpace,isAlphaNum)
import Data.List        (intercalate,isPrefixOf)
import Numeric          (readHex,readOct,readDec)
import System.IO.Unsafe (unsafeInterleaveIO)
import System.IO        (hPutStrLn,stderr)
import Control.Monad    (when)

-- | Run a first pass of cpp, evaluating \#ifdef's and processing \#include's,
--   whilst taking account of \#define's and \#undef's as we encounter them.
cppIfdef :: FilePath            -- ^ File for error reports
        -> [(String,String)]    -- ^ Pre-defined symbols and their values
        -> [String]             -- ^ Search path for \#includes
        -> BoolOptions          -- ^ Options controlling output style
        -> String               -- ^ The input file content
        -> IO [(Posn,String)]   -- ^ The file after processing (in lines)
cppIfdef :: String
-> [(String, String)]
-> [String]
-> BoolOptions
-> String
-> IO [(Posn, String)]
cppIfdef String
fp [(String, String)]
syms [String]
search BoolOptions
options =
    Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp Posn
posn SymTab HashDefine
defs [String]
search BoolOptions
options ([Posn] -> KeepState
Keep []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
initial forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
linesCpp
  where
    posn :: Posn
posn = String -> Posn
newfile String
fp
    defs :: SymTab HashDefine
defs = BoolOptions -> [(String, String)] -> SymTab HashDefine
preDefine BoolOptions
options [(String, String)]
syms
    initial :: [String] -> [String]
initial = if BoolOptions -> Bool
literate BoolOptions
options then forall a. a -> a
id else (Posn -> String
cppline Posn
posnforall a. a -> [a] -> [a]
:)
-- Previous versions had a very simple symbol table  mapping strings
-- to strings.  Now the #ifdef pass uses a more elaborate table, in
-- particular to deal with parameterised macros in conditionals.


-- | Internal state for whether lines are being kept or dropped.
--   In @Drop n b ps@, @n@ is the depth of nesting, @b@ is whether
--   we have already succeeded in keeping some lines in a chain of
--   @elif@'s, and @ps@ is the stack of positions of open @#if@ contexts,
--   used for error messages in case EOF is reached too soon.
data KeepState = Keep [Posn] | Drop Int Bool [Posn]

-- | Return just the list of lines that the real cpp would decide to keep.
cpp :: Posn -> SymTab HashDefine -> [String] -> BoolOptions -> KeepState
       -> [String] -> IO [(Posn,String)]

cpp :: Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp Posn
_ SymTab HashDefine
_ [String]
_ BoolOptions
_ (Keep [Posn]
ps) [] | Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posn]
ps) = do
    Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Unmatched #if: positions of open context are:\n"forall a. [a] -> [a] -> [a]
++
                       [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map forall a. Show a => a -> String
show [Posn]
ps)
    forall (m :: * -> *) a. Monad m => a -> m a
return []
cpp Posn
_ SymTab HashDefine
_ [String]
_ BoolOptions
_ KeepState
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []

cpp Posn
p SymTab HashDefine
syms [String]
path BoolOptions
options (Keep [Posn]
ps) (l :: String
l@(Char
'#':String
x):[String]
xs) =
    let ws :: [String]
ws = String -> [String]
words String
x
        cmd :: String
cmd = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ws then String
"" else forall a. [a] -> a
head [String]
ws
        line :: [String]
line = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ws then [] else forall a. [a] -> [a]
tail [String]
ws
        sym :: String
sym  = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
line then String
"" else forall a. [a] -> a
head [String]
line
        rest :: [String]
rest = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
line then [] else forall a. [a] -> [a]
tail [String]
line
        def :: (String, HashDefine)
def = BoolOptions -> String -> (String, HashDefine)
defineMacro BoolOptions
options (String
symforall a. [a] -> [a] -> [a]
++String
" "forall a. [a] -> [a] -> [a]
++ forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"1" forall a. a -> a
id ([String] -> Maybe String
un [String]
rest))
        un :: [String] -> Maybe String
un [String]
v = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
v then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just ([String] -> String
unwords [String]
v)
        keepIf :: Bool -> KeepState
keepIf Bool
b = if Bool
b then [Posn] -> KeepState
Keep (Posn
pforall a. a -> [a] -> [a]
:[Posn]
ps) else Int -> Bool -> [Posn] -> KeepState
Drop Int
1 Bool
False (Posn
pforall a. a -> [a] -> [a]
:[Posn]
ps)
        skipn :: SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms' Bool
retain KeepState
ud [String]
xs' =
            let n :: Int
n = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==Char
'\n') String
l) in
            (if BoolOptions -> Bool
macros BoolOptions
options Bool -> Bool -> Bool
&& Bool
retain then forall a. a -> IO [a] -> IO [a]
emitOne  (Posn
p,String -> String
reslash String
l)
                                         else forall a. [a] -> IO [a] -> IO [a]
emitMany (forall a. Int -> a -> [a]
replicate Int
n (Posn
p,String
""))) forall a b. (a -> b) -> a -> b
$
            Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp (Int -> Posn -> Posn
newlines Int
n Posn
p) SymTab HashDefine
syms' [String]
path BoolOptions
options KeepState
ud [String]
xs'
    in case String
cmd of
        String
"define" -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn (forall v. (String, v) -> SymTab v -> SymTab v
insertST (String, HashDefine)
def SymTab HashDefine
syms) Bool
True ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
        String
"undef"  -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn (forall v. String -> SymTab v -> SymTab v
deleteST String
sym SymTab HashDefine
syms) Bool
True ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
        String
"ifndef" -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False (Bool -> KeepState
keepIf (Bool -> Bool
not (forall v. String -> SymTab v -> Bool
definedST String
sym SymTab HashDefine
syms))) [String]
xs
        String
"ifdef"  -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False (Bool -> KeepState
keepIf      (forall v. String -> SymTab v -> Bool
definedST String
sym SymTab HashDefine
syms)) [String]
xs
        String
"if"     -> do Bool
b <- Posn -> SymTab HashDefine -> String -> IO Bool
gatherDefined Posn
p SymTab HashDefine
syms ([String] -> String
unwords [String]
line)
                       SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False (Bool -> KeepState
keepIf Bool
b) [String]
xs
        String
"else"   -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False (Int -> Bool -> [Posn] -> KeepState
Drop Int
1 Bool
False [Posn]
ps) [String]
xs
        String
"elif"   -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False (Int -> Bool -> [Posn] -> KeepState
Drop Int
1 Bool
True [Posn]
ps) [String]
xs
        String
"endif"  | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posn]
ps ->
                    do Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Unmatched #endif at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p
                       forall (m :: * -> *) a. Monad m => a -> m a
return []
        String
"endif"  -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False ([Posn] -> KeepState
Keep (forall a. [a] -> [a]
tail [Posn]
ps)) [String]
xs
        String
"pragma" -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
True  ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
        (Char
'!':String
_)  -> SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs       -- \#!runhs scripts
        String
"include"-> do (String
inc,String
content) <- String -> Posn -> [String] -> Bool -> IO (String, String)
readFirst (SymTab HashDefine -> String -> String
file SymTab HashDefine
syms ([String] -> String
unwords [String]
line))
                                                  Posn
p [String]
path
                                                  (BoolOptions -> Bool
warnings BoolOptions
options)
                       Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp Posn
p SymTab HashDefine
syms [String]
path BoolOptions
options ([Posn] -> KeepState
Keep [Posn]
ps)
                             ((String
"#line 1 "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show String
inc)forall a. a -> [a] -> [a]
: String -> [String]
linesCpp String
content
                                                    forall a. [a] -> [a] -> [a]
++ Posn -> String
cppline (Posn -> Posn
newline Posn
p)forall a. a -> [a] -> [a]
: [String]
xs)
        String
"warning"-> if BoolOptions -> Bool
warnings BoolOptions
options then
                      do Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
lforall a. [a] -> [a] -> [a]
++String
"\nin "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)
                         SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
                    else SymTab HashDefine
-> Bool -> KeepState -> [String] -> IO [(Posn, String)]
skipn SymTab HashDefine
syms Bool
False ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
        String
"error"  -> forall a. HasCallStack => String -> a
error (String
lforall a. [a] -> [a] -> [a]
++String
"\nin "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)
        String
"line"   | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
sym
                 -> (if BoolOptions -> Bool
locations BoolOptions
options Bool -> Bool -> Bool
&& BoolOptions -> Bool
hashline BoolOptions
options then forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String
l)
                     else if BoolOptions -> Bool
locations BoolOptions
options then forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String -> String
cpp2hask String
l)
                     else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                    Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp (Int -> Maybe String -> Posn -> Posn
newpos (forall a. Read a => String -> a
read String
sym) ([String] -> Maybe String
un [String]
rest) Posn
p)
                        SymTab HashDefine
syms [String]
path BoolOptions
options ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
        String
n | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
n Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
n)
                 -> (if BoolOptions -> Bool
locations BoolOptions
options Bool -> Bool -> Bool
&& BoolOptions -> Bool
hashline BoolOptions
options then forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String
l)
                     else if BoolOptions -> Bool
locations BoolOptions
options then forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String -> String
cpp2hask String
l)
                     else forall a. a -> a
id) forall a b. (a -> b) -> a -> b
$
                    Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp (Int -> Maybe String -> Posn -> Posn
newpos (forall a. Read a => String -> a
read String
n) ([String] -> Maybe String
un (forall a. [a] -> [a]
tail [String]
ws)) Posn
p)
                        SymTab HashDefine
syms [String]
path BoolOptions
options ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
          | Bool
otherwise
                 -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BoolOptions -> Bool
warnings BoolOptions
options) forall a b. (a -> b) -> a -> b
$
                           Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: unknown directive #"forall a. [a] -> [a] -> [a]
++String
n
                                             forall a. [a] -> [a] -> [a]
++String
"\nin "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p)
                       forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String
l) forall a b. (a -> b) -> a -> b
$
                               Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp (Posn -> Posn
newline Posn
p) SymTab HashDefine
syms [String]
path BoolOptions
options ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs

cpp Posn
p SymTab HashDefine
syms [String]
path BoolOptions
options (Drop Int
n Bool
b [Posn]
ps) ((Char
'#':String
x):[String]
xs) =
    let ws :: [String]
ws = String -> [String]
words String
x
        cmd :: String
cmd = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ws then String
"" else forall a. [a] -> a
head [String]
ws
        delse :: KeepState
delse    | Int
nforall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
&& Bool
b = Int -> Bool -> [Posn] -> KeepState
Drop Int
1 Bool
b [Posn]
ps
                 | Int
nforall a. Eq a => a -> a -> Bool
==Int
1      = [Posn] -> KeepState
Keep [Posn]
ps
                 | Bool
otherwise = Int -> Bool -> [Posn] -> KeepState
Drop Int
n Bool
b [Posn]
ps
        dend :: KeepState
dend     | Int
nforall a. Eq a => a -> a -> Bool
==Int
1      = [Posn] -> KeepState
Keep (forall a. [a] -> [a]
tail [Posn]
ps)
                 | Bool
otherwise = Int -> Bool -> [Posn] -> KeepState
Drop (Int
nforall a. Num a => a -> a -> a
-Int
1) Bool
b (forall a. [a] -> [a]
tail [Posn]
ps)
        delif :: Bool -> KeepState
delif Bool
v  | Int
nforall a. Eq a => a -> a -> Bool
==Int
1 Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
b Bool -> Bool -> Bool
&& Bool
v
                             = [Posn] -> KeepState
Keep [Posn]
ps
                 | Bool
otherwise = Int -> Bool -> [Posn] -> KeepState
Drop Int
n Bool
b [Posn]
ps
        skipn :: KeepState -> [String] -> IO [(Posn, String)]
skipn KeepState
ud [String]
xs' =
                 let n' :: Int
n' = Int
1 forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
==Char
'\n') String
x) in
                 forall a. [a] -> IO [a] -> IO [a]
emitMany (forall a. Int -> a -> [a]
replicate Int
n' (Posn
p,String
"")) forall a b. (a -> b) -> a -> b
$
                    Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp (Int -> Posn -> Posn
newlines Int
n' Posn
p) SymTab HashDefine
syms [String]
path BoolOptions
options KeepState
ud [String]
xs'
    in
    if      String
cmd forall a. Eq a => a -> a -> Bool
== String
"ifndef" Bool -> Bool -> Bool
||
            String
cmd forall a. Eq a => a -> a -> Bool
== String
"if"     Bool -> Bool -> Bool
||
            String
cmd forall a. Eq a => a -> a -> Bool
== String
"ifdef" then    KeepState -> [String] -> IO [(Posn, String)]
skipn (Int -> Bool -> [Posn] -> KeepState
Drop (Int
nforall a. Num a => a -> a -> a
+Int
1) Bool
b (Posn
pforall a. a -> [a] -> [a]
:[Posn]
ps)) [String]
xs
    else if String
cmd forall a. Eq a => a -> a -> Bool
== String
"elif"  then do Bool
v <- Posn -> SymTab HashDefine -> String -> IO Bool
gatherDefined Posn
p SymTab HashDefine
syms ([String] -> String
unwords (forall a. [a] -> [a]
tail [String]
ws))
                                   KeepState -> [String] -> IO [(Posn, String)]
skipn (Bool -> KeepState
delif Bool
v) [String]
xs
    else if String
cmd forall a. Eq a => a -> a -> Bool
== String
"else"  then    KeepState -> [String] -> IO [(Posn, String)]
skipn  KeepState
delse [String]
xs
    else if String
cmd forall a. Eq a => a -> a -> Bool
== String
"endif" then
            if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Posn]
ps then do Handle -> String -> IO ()
hPutStrLn Handle
stderr forall a b. (a -> b) -> a -> b
$ String
"Unmatched #endif at "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p
                               forall (m :: * -> *) a. Monad m => a -> m a
return []
                       else KeepState -> [String] -> IO [(Posn, String)]
skipn  KeepState
dend  [String]
xs
    else KeepState -> [String] -> IO [(Posn, String)]
skipn (Int -> Bool -> [Posn] -> KeepState
Drop Int
n Bool
b [Posn]
ps) [String]
xs
        -- define, undef, include, error, warning, pragma, line

cpp Posn
p SymTab HashDefine
syms [String]
path BoolOptions
options (Keep [Posn]
ps) (String
x:[String]
xs) =
    let p' :: Posn
p' = Posn -> Posn
newline Posn
p in seq :: forall a b. a -> b -> b
seq Posn
p' forall a b. (a -> b) -> a -> b
$
    forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String
x)  forall a b. (a -> b) -> a -> b
$  Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp Posn
p' SymTab HashDefine
syms [String]
path BoolOptions
options ([Posn] -> KeepState
Keep [Posn]
ps) [String]
xs
cpp Posn
p SymTab HashDefine
syms [String]
path BoolOptions
options d :: KeepState
d@(Drop Int
_ Bool
_ [Posn]
_) (String
_:[String]
xs) =
    let p' :: Posn
p' = Posn -> Posn
newline Posn
p in seq :: forall a b. a -> b -> b
seq Posn
p' forall a b. (a -> b) -> a -> b
$
    forall a. a -> IO [a] -> IO [a]
emitOne (Posn
p,String
"") forall a b. (a -> b) -> a -> b
$  Posn
-> SymTab HashDefine
-> [String]
-> BoolOptions
-> KeepState
-> [String]
-> IO [(Posn, String)]
cpp Posn
p' SymTab HashDefine
syms [String]
path BoolOptions
options KeepState
d [String]
xs


-- | Auxiliary IO functions
emitOne  ::  a  -> IO [a] -> IO [a]
emitMany :: [a] -> IO [a] -> IO [a]
emitOne :: forall a. a -> IO [a] -> IO [a]
emitOne  a
x  IO [a]
io = do [a]
ys <- forall a. IO a -> IO a
unsafeInterleaveIO IO [a]
io
                    forall (m :: * -> *) a. Monad m => a -> m a
return (a
xforall a. a -> [a] -> [a]
:[a]
ys)
emitMany :: forall a. [a] -> IO [a] -> IO [a]
emitMany [a]
xs IO [a]
io = do [a]
ys <- forall a. IO a -> IO a
unsafeInterleaveIO IO [a]
io
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([a]
xsforall a. [a] -> [a] -> [a]
++[a]
ys)


----
gatherDefined :: Posn -> SymTab HashDefine -> String -> IO Bool
gatherDefined :: Posn -> SymTab HashDefine -> String -> IO Bool
gatherDefined Posn
p SymTab HashDefine
st String
inp =
  case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (SymTab HashDefine -> TextParser String
preExpand SymTab HashDefine
st) String
inp of
    (Left String
msg, String
_) -> forall a. HasCallStack => String -> a
error (String
"Cannot expand #if directive in file "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p
                           forall a. [a] -> [a] -> [a]
++String
":\n    "forall a. [a] -> [a] -> [a]
++String
msg)
    (Right String
s, String
xs) -> do
--      hPutStrLn stderr $ "Expanded #if at "++show p++" is:\n  "++s
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
xs) forall a b. (a -> b) -> a -> b
$
             Handle -> String -> IO ()
hPutStrLn Handle
stderr (String
"Warning: trailing characters after #if"
                              forall a. [a] -> [a] -> [a]
++String
" macro expansion in file "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
pforall a. [a] -> [a] -> [a]
++String
": "forall a. [a] -> [a] -> [a]
++String
xs)

        case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser TextParser Bool
parseBoolExp String
s of
          (Left String
msg, String
_) -> forall a. HasCallStack => String -> a
error (String
"Cannot parse #if directive in file "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
p
                                 forall a. [a] -> [a] -> [a]
++String
":\n    "forall a. [a] -> [a] -> [a]
++String
msg)
          (Right Bool
b, String
xs) -> do forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) String
xs Bool -> Bool -> Bool
&& String -> Bool
notComment String
xs) forall a b. (a -> b) -> a -> b
$
                                   Handle -> String -> IO ()
hPutStrLn Handle
stderr
                                     (String
"Warning: trailing characters after #if"
                                      forall a. [a] -> [a] -> [a]
++String
" directive in file "forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show Posn
pforall a. [a] -> [a] -> [a]
++String
": "forall a. [a] -> [a] -> [a]
++String
xs)
                              forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b

notComment :: String -> Bool
notComment = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"//"forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace


-- | The preprocessor must expand all macros (recursively) before evaluating
--   the conditional.
preExpand :: SymTab HashDefine -> TextParser String
preExpand :: SymTab HashDefine -> TextParser String
preExpand SymTab HashDefine
st =
  do  forall t. Parser t ()
eof
      forall (m :: * -> *) a. Monad m => a -> m a
return String
""
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  String
a <- forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
notIdent)
      forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
aforall a. [a] -> [a] -> [a]
++) forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` SymTab HashDefine -> TextParser String
preExpand SymTab HashDefine
st
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  String
b <- SymTab HashDefine -> TextParser String
expandSymOrCall SymTab HashDefine
st
      forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
bforall a. [a] -> [a] -> [a]
++) forall (p :: * -> *) a b. PolyParse p => p (a -> b) -> p a -> p b
`apply` SymTab HashDefine -> TextParser String
preExpand SymTab HashDefine
st

-- | Expansion of symbols.
expandSymOrCall :: SymTab HashDefine -> TextParser String
expandSymOrCall :: SymTab HashDefine -> TextParser String
expandSymOrCall SymTab HashDefine
st =
  do String
sym <- TextParser String
parseSym
     if String
symforall a. Eq a => a -> a -> Bool
==String
"defined" then do String
arg <- forall a. TextParser a -> TextParser a
skip TextParser String
parseSym; String -> [String] -> TextParser String
convert String
sym [String
arg]
                            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
                            do String
arg <- forall a. TextParser a -> TextParser a
skip forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
parenthesis (do String
x <- forall a. TextParser a -> TextParser a
skip TextParser String
parseSym;
                                                             forall a. TextParser a -> TextParser a
skip (forall (m :: * -> *) a. Monad m => a -> m a
return String
x))
                               String -> [String] -> TextParser String
convert String
sym [String
arg]
                            forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [String] -> TextParser String
convert String
sym []
      else
      ( do  [String]
args <- forall a. TextParser a -> TextParser a
parenthesis (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TextParser String
fragment forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy` forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
","))
            [String]
args' <- forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [String]
args forall a b. (a -> b) -> a -> b
$ \String
arg->
                         case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (SymTab HashDefine -> TextParser String
preExpand SymTab HashDefine
st) String
arg of
                             (Left String
msg, String
_) -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
msg
                             (Right String
s, String
_)  -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
            String -> [String] -> TextParser String
convert String
sym [String]
args'
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> String -> [String] -> TextParser String
convert String
sym []
      )
  where
    fragment :: TextParser String
fragment = forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall t. (t -> Bool) -> Parser t t
satisfy (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem`String
",)"))
    convert :: String -> [String] -> TextParser String
convert String
"defined" [String
arg] =
      case forall v. String -> SymTab v -> Maybe v
lookupST String
arg SymTab HashDefine
st of
        Maybe HashDefine
Nothing | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
arg    -> forall (m :: * -> *) a. Monad m => a -> m a
return String
arg 
        Maybe HashDefine
Nothing                      -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"0"
        Just (a :: HashDefine
a@AntiDefined{})       -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"0"
        Just (a :: HashDefine
a@SymbolReplacement{}) -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"1"
        Just (a :: HashDefine
a@MacroExpansion{})    -> forall (m :: * -> *) a. Monad m => a -> m a
return String
"1"
    convert String
sym [String]
args =
      case forall v. String -> SymTab v -> Maybe v
lookupST String
sym SymTab HashDefine
st of
        Maybe HashDefine
Nothing  -> if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args then forall (m :: * -> *) a. Monad m => a -> m a
return String
sym
                    else forall (m :: * -> *) a. Monad m => a -> m a
return String
"0"
                 -- else fail (disp sym args++" is not a defined macro")
        Just (a :: HashDefine
a@SymbolReplacement{}) -> do forall t. [t] -> Parser t ()
reparse (HashDefine -> String
replacement HashDefine
a)
                                           forall (m :: * -> *) a. Monad m => a -> m a
return String
""
        Just (a :: HashDefine
a@MacroExpansion{})    -> do forall t. [t] -> Parser t ()
reparse (HashDefine -> [String] -> Bool -> String
expandMacro HashDefine
a [String]
args Bool
False)
                                           forall (m :: * -> *) a. Monad m => a -> m a
return String
""
        Just (a :: HashDefine
a@AntiDefined{})       ->
                    if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
args then forall (m :: * -> *) a. Monad m => a -> m a
return String
sym
                    else forall (m :: * -> *) a. Monad m => a -> m a
return String
"0"
                 -- else fail (disp sym args++" explicitly undefined with -U")
    disp :: String -> t a -> String
disp String
sym t a
args = let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
args
                        chars :: [String]
chars = forall a b. (a -> b) -> [a] -> [b]
map (forall a. a -> [a] -> [a]
:[]) [Char
'a'..Char
'z']
                    in String
sym forall a. [a] -> [a] -> [a]
++ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t a
args then String
""
                              else String
"("forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a. Int -> [a] -> [a]
take Int
len [String]
chars)forall a. [a] -> [a] -> [a]
++String
")"

parseBoolExp :: TextParser Bool
parseBoolExp :: TextParser Bool
parseBoolExp =
  do  Bool
a <- TextParser Bool
parseExp1
      [Bool]
bs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (do forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"||")
                     forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
skip TextParser Bool
parseBoolExp)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(||) Bool
a [Bool]
bs

parseExp1 :: TextParser Bool
parseExp1 :: TextParser Bool
parseExp1 =
  do  Bool
a <- TextParser Bool
parseExp0
      [Bool]
bs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (do forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"&&")
                     forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
skip TextParser Bool
parseExp1)
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Bool -> Bool -> Bool
(&&) Bool
a [Bool]
bs

parseExp0 :: TextParser Bool
parseExp0 :: TextParser Bool
parseExp0 =
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"!")
      Bool
a <- forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ TextParser Bool
parseExp0
      forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Bool
not Bool
a)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  Integer
val1 <- TextParser Integer
parseArithExp1
      Integer -> Integer -> Bool
op   <- TextParser (Integer -> Integer -> Bool)
parseCmpOp
      Integer
val2 <- TextParser Integer
parseArithExp1
      forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
val1 Integer -> Integer -> Bool
`op` Integer
val2)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  Integer
sym <- TextParser Integer
parseArithExp1
      case Integer
sym of
        Integer
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Integer
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
parenthesis (forall (p :: * -> *) a. Commitment p => p a -> p a
commit TextParser Bool
parseBoolExp)

parseArithExp1 :: TextParser Integer
parseArithExp1 :: TextParser Integer
parseArithExp1 =
  do  Integer
val1 <- TextParser Integer
parseArithExp0
      ( do Integer -> Integer -> Integer
op   <- TextParser (Integer -> Integer -> Integer)
parseArithOp1
           Integer
val2 <- TextParser Integer
parseArithExp1
           forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
val1 Integer -> Integer -> Integer
`op` Integer
val2)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
val1 )
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
parenthesis TextParser Integer
parseArithExp1

parseArithExp0 :: TextParser Integer
parseArithExp0 :: TextParser Integer
parseArithExp0 =
  do  Integer
val1 <- TextParser Integer
parseNumber
      ( do Integer -> Integer -> Integer
op   <- TextParser (Integer -> Integer -> Integer)
parseArithOp0
           Integer
val2 <- TextParser Integer
parseArithExp0
           forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
val1 Integer -> Integer -> Integer
`op` Integer
val2)
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *) a. Monad m => a -> m a
return Integer
val1 )
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
parenthesis TextParser Integer
parseArithExp0

parseNumber :: TextParser Integer
parseNumber :: TextParser Integer
parseNumber = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Integer
safeRead forall a b. (a -> b) -> a -> b
$ forall a. TextParser a -> TextParser a
skip TextParser String
parseSym
  where
    safeRead :: String -> Integer
safeRead String
s =
      case String
s of
        Char
'0':Char
'x':String
s' -> forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
number forall a. (Eq a, Num a) => ReadS a
readHex String
s'
        Char
'0':Char
'o':String
s' -> forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
number forall a. (Eq a, Num a) => ReadS a
readOct String
s'
        String
_          -> forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
number forall a. (Eq a, Num a) => ReadS a
readDec String
s
    number :: (t -> [(Integer, b)]) -> t -> Integer
number t -> [(Integer, b)]
rd t
s =
      case t -> [(Integer, b)]
rd t
s of
        []        -> Integer
0 :: Integer
        ((Integer
n,b
_):[(Integer, b)]
_) -> Integer
n :: Integer

parseCmpOp :: TextParser (Integer -> Integer -> Bool)
parseCmpOp :: TextParser (Integer -> Integer -> Bool)
parseCmpOp =
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
">=")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> a -> Bool
(>=)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
">")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> a -> Bool
(>)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"<=")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> a -> Bool
(<=)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"<")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Ord a => a -> a -> Bool
(<)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"==")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Eq a => a -> a -> Bool
(==)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"!=")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Eq a => a -> a -> Bool
(/=)

parseArithOp1 :: TextParser (Integer -> Integer -> Integer)
parseArithOp1 :: TextParser (Integer -> Integer -> Integer)
parseArithOp1 =
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"+")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a -> a
(+)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"-")
      forall (m :: * -> *) a. Monad m => a -> m a
return (-)

parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
parseArithOp0 =
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"*")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Num a => a -> a -> a
(*)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"/")
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Integral a => a -> a -> a
div)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
"%")
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Integral a => a -> a -> a
rem)

-- | Return the expansion of the symbol (if there is one).
parseSymOrCall :: SymTab HashDefine -> TextParser String
parseSymOrCall :: SymTab HashDefine -> TextParser String
parseSymOrCall SymTab HashDefine
st =
  do  String
sym <- forall a. TextParser a -> TextParser a
skip TextParser String
parseSym
      [String]
args <- forall a. TextParser a -> TextParser a
parenthesis (forall (p :: * -> *) a. Commitment p => p a -> p a
commit forall a b. (a -> b) -> a -> b
$ SymTab HashDefine -> TextParser String
parseSymOrCall SymTab HashDefine
st forall (p :: * -> *) a sep. PolyParse p => p a -> p sep -> p [a]
`sepBy` forall a. TextParser a -> TextParser a
skip (String -> TextParser String
isWord String
","))
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
convert String
sym [String]
args
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  do  String
sym <- forall a. TextParser a -> TextParser a
skip TextParser String
parseSym
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
convert String
sym []
  where
    convert :: String -> [String] -> String
convert String
sym [String]
args =
      case forall v. String -> SymTab v -> Maybe v
lookupST String
sym SymTab HashDefine
st of
        Maybe HashDefine
Nothing  -> String
sym
        Just (a :: HashDefine
a@SymbolReplacement{}) -> SymTab HashDefine -> String -> String
recursivelyExpand SymTab HashDefine
st (HashDefine -> String
replacement HashDefine
a)
        Just (a :: HashDefine
a@MacroExpansion{})    -> SymTab HashDefine -> String -> String
recursivelyExpand SymTab HashDefine
st (HashDefine -> [String] -> Bool -> String
expandMacro HashDefine
a [String]
args Bool
False)
        Just (a :: HashDefine
a@AntiDefined{})       -> HashDefine -> String
name HashDefine
a

recursivelyExpand :: SymTab HashDefine -> String -> String
recursivelyExpand :: SymTab HashDefine -> String -> String
recursivelyExpand SymTab HashDefine
st String
inp =
  case forall t a. Parser t a -> [t] -> (Either String a, [t])
runParser (SymTab HashDefine -> TextParser String
parseSymOrCall SymTab HashDefine
st) String
inp of
    (Left String
msg, String
_) -> String
inp
    (Right String
s,  String
_) -> String
s

parseSym :: TextParser String
parseSym :: TextParser String
parseSym = forall (p :: * -> *) a. PolyParse p => p a -> p [a]
many1 (forall t. (t -> Bool) -> Parser t t
satisfy (\Char
c-> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
cforall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
"'`_"))
           forall t a. Parser t a -> Parser t a -> Parser t a
`onFail`
           do String
xs <- TextParser String
allAsString
              forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expected an identifier, got \""forall a. [a] -> [a] -> [a]
++String
xsforall a. [a] -> [a] -> [a]
++String
"\""

notIdent :: Char -> Bool
notIdent :: Char -> Bool
notIdent Char
c = Bool -> Bool
not (Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
cforall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`String
"'`_")

skip :: TextParser a -> TextParser a
skip :: forall a. TextParser a -> TextParser a
skip TextParser a
p = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall t. (t -> Bool) -> Parser t t
satisfy Char -> Bool
isSpace) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> TextParser a
p

-- | The standard "parens" parser does not work for us here.  Define our own.
parenthesis :: TextParser a -> TextParser a
parenthesis :: forall a. TextParser a -> TextParser a
parenthesis TextParser a
p = do String -> TextParser String
isWord String
"("
                   a
x <- TextParser a
p
                   String -> TextParser String
isWord String
")"
                   forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Determine filename in \#include
file :: SymTab HashDefine -> String -> String
file :: SymTab HashDefine -> String -> String
file SymTab HashDefine
st String
name =
    case String
name of
      (Char
'"':String
ns) -> forall a. [a] -> [a]
init String
ns
      (Char
'<':String
ns) -> forall a. [a] -> [a]
init String
ns
      String
_ -> let ex :: String
ex = SymTab HashDefine -> String -> String
recursivelyExpand SymTab HashDefine
st String
name in
           if String
ex forall a. Eq a => a -> a -> Bool
== String
name then String
name else SymTab HashDefine -> String -> String
file SymTab HashDefine
st String
ex