    -----------------------------------------------------------------------------
    -- |
    -- 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 []) ([String] -> IO [(Posn, String)])
    -> (String -> [String]) -> String -> IO [(Posn, String)]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    initial ([String] -> [String])
    -> (String -> [String]) -> String -> [String]
    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 [String] -> [String]
    forall a. a -> a
    id else (Posn -> String
    cppline Posn
    posnString -> [String] -> [String]
    forall 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 ([Posn] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Posn]
    ps) = do
        Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unmatched #if: positions of open context are:\n"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++
                           [String] -> String
    unlines ((Posn -> String) -> [Posn] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map Posn -> String
    forall a. Show a => a -> String
    show [Posn]
    ps)
        [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
    cpp Posn
    _ SymTab HashDefine
    _ [String]
    _ BoolOptions
    _ KeepState
    _ [] = [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO a
    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 [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ws then String
    "" else [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    ws
            line :: [String]
    line = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ws then [] else [String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail [String]
    ws
            sym :: String
    sym  = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    line then String
    "" else [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    line
            rest :: [String]
    rest = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    line then [] else [String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail [String]
    line
            def :: (String, HashDefine)
    def = BoolOptions -> String -> (String, HashDefine)
    defineMacro BoolOptions
    options (String
    symString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    " "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> (String -> String) -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "1" String -> String
    forall a. a -> a
    id ([String] -> Maybe String
    un [String]
    rest))
            un :: [String] -> Maybe String
    un [String]
    v = if [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    v then Maybe String
    forall a. Maybe a
    Nothing else String -> Maybe String
    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
    pPosn -> [Posn] -> [Posn]
    forall a. a -> [a] -> [a]
    :[Posn]
    ps) else Int -> Bool -> [Posn] -> KeepState
    Drop Int
    1 Bool
    False (Posn
    pPosn -> [Posn] -> [Posn]
    forall 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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\n') String
    l) in
                (if BoolOptions -> Bool
    macros BoolOptions
    options Bool -> Bool -> Bool
    && Bool
    retain then (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne  (Posn
    p,String -> String
    reslash String
    l)
                                             else [(Posn, String)] -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. [a] -> IO [a] -> IO [a]
    emitMany (Int -> (Posn, String) -> [(Posn, String)]
    forall a. Int -> a -> [a]
    replicate Int
    n (Posn
    p,String
    ""))) (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, 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 ((String, HashDefine) -> SymTab HashDefine -> SymTab HashDefine
    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 (String -> SymTab HashDefine -> SymTab HashDefine
    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 (String -> SymTab HashDefine -> Bool
    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      (String -> SymTab HashDefine -> Bool
    forall v. String -> SymTab v -> Bool
    definedST String
    sym SymTab HashDefine
    syms)) [String]
    xs
            String
    "if"     -> do b <- Posn -> SymTab HashDefine -> String -> IO Bool
    gatherDefined Posn
    p SymTab HashDefine
    syms ([String] -> String
    unwords [String]
    line)
                           skipn syms False (keepIf b) 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"  | [Posn] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Posn]
    ps ->
                        do Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unmatched #endif at "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    p
                           [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO a
    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 ([Posn] -> [Posn]
    forall a. HasCallStack => [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 (inc,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)
                           cpp p syms path options (Keep ps)
                                 (("#line 1 "++show inc): linesCpp content
                                                        ++ cppline (newline p): xs)
            String
    "warning"-> if BoolOptions -> Bool
    warnings BoolOptions
    options then
                          do Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    lString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\nin "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    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"  -> String -> IO [(Posn, String)]
    forall a. HasCallStack => String -> a
    error (String
    lString -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\nin "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    p)
            String
    "line"   | (Char -> Bool) -> String -> Bool
    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 (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String
    l)
                         else if BoolOptions -> Bool
    locations BoolOptions
    options then (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String -> String
    cpp2hask String
    l)
                         else IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> a
    id) (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. (a -> b) -> a -> b
    $
                        Posn
    -> SymTab HashDefine
    -> [String]
    -> BoolOptions
    -> KeepState
    -> [String]
    -> IO [(Posn, String)]
    cpp (Int -> Maybe String -> Posn -> Posn
    newpos (String -> Int
    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 | (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isDigit String
    n Bool -> Bool -> Bool
    && Bool -> Bool
    not (String -> Bool
    forall a. [a] -> Bool
    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 (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String
    l)
                         else if BoolOptions -> Bool
    locations BoolOptions
    options then (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String -> String
    cpp2hask String
    l)
                         else IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> a
    id) (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. (a -> b) -> a -> b
    $
                        Posn
    -> SymTab HashDefine
    -> [String]
    -> BoolOptions
    -> KeepState
    -> [String]
    -> IO [(Posn, String)]
    cpp (Int -> Maybe String -> Posn -> Posn
    newpos (String -> Int
    forall a. Read a => String -> a
    read String
    n) ([String] -> Maybe String
    un ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail [String]
    ws)) Posn
    p)
                            SymTab HashDefine
    syms [String]
    path BoolOptions
    options ([Posn] -> KeepState
    Keep [Posn]
    ps) [String]
    xs
              | Bool
    otherwise
                     -> do Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (BoolOptions -> Bool
    warnings BoolOptions
    options) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                               Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String
    "Warning: unknown directive #"String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    n
                                                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++String
    "\nin "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    p)
                           (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String
    l) (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, String)]
    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 [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    ws then String
    "" else [String] -> String
    forall a. HasCallStack => [a] -> a
    head [String]
    ws
            delse :: KeepState
    delse    | Int
    nInt -> Int -> Bool
    forall 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
    nInt -> Int -> Bool
    forall 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
    nInt -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Int
    1      = [Posn] -> KeepState
    Keep ([Posn] -> [Posn]
    forall a. HasCallStack => [a] -> [a]
    tail [Posn]
    ps)
                     | Bool
    otherwise = Int -> Bool -> [Posn] -> KeepState
    Drop (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) Bool
    b ([Posn] -> [Posn]
    forall a. HasCallStack => [a] -> [a]
    tail [Posn]
    ps)
            delif :: Bool -> KeepState
    delif Bool
    v  | Int
    nInt -> Int -> Bool
    forall 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 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length ((Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\n') String
    x) in
                     [(Posn, String)] -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. [a] -> IO [a] -> IO [a]
    emitMany (Int -> (Posn, String) -> [(Posn, String)]
    forall a. Int -> a -> [a]
    replicate Int
    n' (Posn
    p,String
    "")) (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, 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 String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "ifndef" Bool -> Bool -> Bool
    ||
                String
    cmd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "if"     Bool -> Bool -> Bool
    ||
                String
    cmd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "ifdef" then    KeepState -> [String] -> IO [(Posn, String)]
    skipn (Int -> Bool -> [Posn] -> KeepState
    Drop (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Bool
    b (Posn
    pPosn -> [Posn] -> [Posn]
    forall a. a -> [a] -> [a]
    :[Posn]
    ps)) [String]
    xs
        else if String
    cmd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "elif"  then do v <- Posn -> SymTab HashDefine -> String -> IO Bool
    gatherDefined Posn
    p SymTab HashDefine
    syms ([String] -> String
    unwords ([String] -> [String]
    forall a. HasCallStack => [a] -> [a]
    tail [String]
    ws))
                                       skipn (delif v) xs
        else if String
    cmd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "else"  then    KeepState -> [String] -> IO [(Posn, String)]
    skipn  KeepState
    delse [String]
    xs
        else if String
    cmd String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "endif" then
                if [Posn] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Posn]
    ps then do Handle -> String -> IO ()
    hPutStrLn Handle
    stderr (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    "Unmatched #endif at "String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++Posn -> String
    forall a. Show a => a -> String
    show Posn
    p
                                   [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO a
    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 Posn -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. a -> b -> b
    seq Posn
    p' (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. (a -> b) -> a -> b
    $
        (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String
    x)  (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, 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 ([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 Posn -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. a -> b -> b
    seq Posn
    p' (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a b. (a -> b) -> a -> b
    $
        (Posn, String) -> IO [(Posn, String)] -> IO [(Posn, String)]
    forall a. a -> IO [a] -> IO [a]
    emitOne (Posn
    p,String
    "") (IO [(Posn, String)] -> IO [(Posn, String)])
    -> IO [(Posn, String)] -> IO [(Posn, 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 ys <- IO [a] -> IO [a]
    forall a. IO a -> IO a
    unsafeInterleaveIO IO [a]
    io
                        return (x:ys)
    emitMany :: forall a. [a] -> IO [a] -> IO [a]
    emitMany [a]
    xs IO [a]
    io = do ys <- IO [a] -> IO [a]
    forall a. IO a -> IO a
    unsafeInterleaveIO IO [a]
    io
                        return (xs++ys)

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

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

    notComment :: String -> Bool
    notComment = Bool -> Bool
    not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String
    "//"String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf`) (String -> Bool) -> (String -> String) -> String -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    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 -> Parser Char String
    preExpand SymTab HashDefine
    st =
      do  Parser Char ()
    forall t. Parser t ()
    eof
          String -> Parser Char String
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    ""
      Parser Char String -> Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  a <- Parser Char Char -> Parser Char String
    forall (p :: * -> *) a. PolyParse p => p a -> p [a]
    many1 ((Char -> Bool) -> Parser Char Char
    forall t. (t -> Bool) -> Parser t t
    satisfy Char -> Bool
    notIdent)
          commit $ pure (a++) `apply` preExpand st
      Parser Char String -> Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  b <- SymTab HashDefine -> Parser Char String
    expandSymOrCall SymTab HashDefine
    st
          commit $ pure (b++) `apply` preExpand st

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

    parseBoolExp :: TextParser Bool
    parseBoolExp :: Parser Char Bool
    parseBoolExp =
      do  a <- Parser Char Bool
    parseExp1
          bs <- many (do skip (isWord "||")
                         commit $ skip parseBoolExp)
          return $ foldr (||) a bs

    parseExp1 :: TextParser Bool
    parseExp1 :: Parser Char Bool
    parseExp1 =
      do  a <- Parser Char Bool
    parseExp0
          bs <- many (do skip (isWord "&&")
                         commit $ skip parseExp1)
          return $ foldr (&&) a bs

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

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

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

    parseNumber :: TextParser Integer
    parseNumber :: TextParser Integer
    parseNumber = (String -> Integer) -> Parser Char String -> TextParser Integer
    forall a b. (a -> b) -> Parser Char a -> Parser Char b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap String -> Integer
    safeRead (Parser Char String -> TextParser Integer)
    -> Parser Char String -> TextParser Integer
    forall a b. (a -> b) -> a -> b
    $ Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip Parser Char String
    parseSym
      where
        safeRead :: String -> Integer
    safeRead String
    s =
          case String
    s of
            Char
    '0':Char
    'x':String
    s' -> (String -> [(Integer, String)]) -> String -> Integer
    forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
    number String -> [(Integer, String)]
    forall a. (Eq a, Num a) => ReadS a
    readHex String
    s'
            Char
    '0':Char
    'o':String
    s' -> (String -> [(Integer, String)]) -> String -> Integer
    forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
    number String -> [(Integer, String)]
    forall a. (Eq a, Num a) => ReadS a
    readOct String
    s'
            String
    _          -> (String -> [(Integer, String)]) -> String -> Integer
    forall {t} {b}. (t -> [(Integer, b)]) -> t -> Integer
    number String -> [(Integer, String)]
    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  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    ">=")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    (>=)
      TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    ">")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    (>)
      TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "<=")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    (<=)
      TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "<")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    (<)
      TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "==")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    (==)
      TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "!=")
          (Integer -> Integer -> Bool)
    -> TextParser (Integer -> Integer -> Bool)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=)

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

    parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
    parseArithOp0 :: TextParser (Integer -> Integer -> Integer)
    parseArithOp0 =
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "*")
          (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    (*)
      TextParser (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "/")
          (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    div)
      TextParser (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip (String -> Parser Char String
    isWord String
    "%")
          (Integer -> Integer -> Integer)
    -> TextParser (Integer -> Integer -> Integer)
    forall a. a -> Parser Char a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Integer -> Integer -> Integer
    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 -> Parser Char String
    parseSymOrCall SymTab HashDefine
    st =
      do  sym <- Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip Parser Char String
    parseSym
          args <- parenthesis (commit $ parseSymOrCall st `sepBy` skip (isWord ","))
          return $ convert sym args
      Parser Char String -> Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a -> Parser Char a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|>
      do  sym <- Parser Char String -> Parser Char String
    forall a. Parser Char a -> Parser Char a
    skip Parser Char String
    parseSym
          return $ convert sym []
      where
        convert :: String -> [String] -> String
    convert String
    sym [String]
    args =
          case String -> SymTab HashDefine -> Maybe HashDefine
    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 Parser Char String -> String -> (Either String String, String)
    forall t a. Parser t a -> [t] -> (Either String a, [t])
    runParser (SymTab HashDefine -> Parser Char String
    parseSymOrCall SymTab HashDefine
    st) String
    inp of
        (Left String
    msg, String
    _) -> String
    inp
        (Right String
    s,  String
    _) -> String
    s

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

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

    skip :: TextParser a -> TextParser a
    skip :: forall a. Parser Char a -> Parser Char a
    skip TextParser a
    p = Parser Char Char -> Parser Char String
    forall a. Parser Char a -> Parser Char [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many ((Char -> Bool) -> Parser Char Char
    forall t. (t -> Bool) -> Parser t t
    satisfy Char -> Bool
    isSpace) Parser Char String -> TextParser a -> TextParser a
    forall a b. Parser Char a -> Parser Char b -> Parser Char b
    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. Parser Char a -> Parser Char a
    parenthesis TextParser a
    p = do String -> Parser Char String
    isWord String
    "("
                       x <- TextParser a
    p
                       isWord ")"
                       return 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) -> String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    ns
          (Char
    '<':String
    ns) -> String -> String
    forall a. HasCallStack => [a] -> [a]
    init String
    ns
          String
    _ -> let ex :: String
    ex = SymTab HashDefine -> String -> String
    recursivelyExpand SymTab HashDefine
    st String
    name in
               if String
    ex String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    name then String
    name else SymTab HashDefine -> String -> String
    file SymTab HashDefine
    st String
    ex