    -----------------------------------------------------------------------------
    -- |
    -- Module      :  HashDefine
    -- Copyright   :  2004 Malcolm Wallace
    -- Licence     :  LGPL
    --
    -- Maintainer  :  Malcolm Wallace <Malcolm.Wallace@cs.york.ac.uk>
    -- Stability   :  experimental
    -- Portability :  All
    --
    -- What structures are declared in a \#define.
    -----------------------------------------------------------------------------

    module Language.Preprocessor.Cpphs.HashDefine
      ( HashDefine(..)
      , ArgOrText(..)
      , expandMacro
      , parseHashDefine
      , simplifyHashDefines
      ) where

    import Data.Char (isSpace)
    import Data.List (intercalate)

    data HashDefine
            = LineDrop
                    { HashDefine -> String
    name :: String }
            | Pragma
                    { name :: String }
            | AntiDefined
                    { name          :: String
                    , HashDefine -> Int
    linebreaks    :: Int
                    }
            | SymbolReplacement
                    { name          :: String
                    , HashDefine -> String
    replacement   :: String
                    , linebreaks    :: Int
                    }
            | MacroExpansion
                    { name          :: String
                    , HashDefine -> [String]
    arguments     :: [String]
                    , HashDefine -> [(ArgOrText, String)]
    expansion     :: [(ArgOrText,String)]
                    , linebreaks    :: Int
                    }
        deriving (HashDefine -> HashDefine -> Bool
    (HashDefine -> HashDefine -> Bool)
    -> (HashDefine -> HashDefine -> Bool) -> Eq HashDefine
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HashDefine -> HashDefine -> Bool
    == :: HashDefine -> HashDefine -> Bool
    $c/= :: HashDefine -> HashDefine -> Bool
    /= :: HashDefine -> HashDefine -> Bool
    Eq,Int -> HashDefine -> ShowS
    [HashDefine] -> ShowS
    HashDefine -> String
    (Int -> HashDefine -> ShowS)
    -> (HashDefine -> String)
    -> ([HashDefine] -> ShowS)
    -> Show HashDefine
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> HashDefine -> ShowS
    showsPrec :: Int -> HashDefine -> ShowS
    $cshow :: HashDefine -> String
    show :: HashDefine -> String
    $cshowList :: [HashDefine] -> ShowS
    showList :: [HashDefine] -> ShowS
    Show)

    -- | 'smart' constructor to avoid warnings from ghc (undefined fields)
    symbolReplacement :: HashDefine
    symbolReplacement :: HashDefine
    symbolReplacement =
        SymbolReplacement
             { name :: String
    name=String
    forall a. HasCallStack => a
    undefined, replacement :: String
    replacement=String
    forall a. HasCallStack => a
    undefined, linebreaks :: Int
    linebreaks=Int
    forall a. HasCallStack => a
    undefined }

    -- | Macro expansion text is divided into sections, each of which is classified
    --   as one of three kinds: a formal argument (Arg), plain text (Text),
    --   or a stringised formal argument (Str).
    data ArgOrText = Arg | Text | Str deriving (ArgOrText -> ArgOrText -> Bool
    (ArgOrText -> ArgOrText -> Bool)
    -> (ArgOrText -> ArgOrText -> Bool) -> Eq ArgOrText
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: ArgOrText -> ArgOrText -> Bool
    == :: ArgOrText -> ArgOrText -> Bool
    $c/= :: ArgOrText -> ArgOrText -> Bool
    /= :: ArgOrText -> ArgOrText -> Bool
    Eq,Int -> ArgOrText -> ShowS
    [ArgOrText] -> ShowS
    ArgOrText -> String
    (Int -> ArgOrText -> ShowS)
    -> (ArgOrText -> String)
    -> ([ArgOrText] -> ShowS)
    -> Show ArgOrText
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> ArgOrText -> ShowS
    showsPrec :: Int -> ArgOrText -> ShowS
    $cshow :: ArgOrText -> String
    show :: ArgOrText -> String
    $cshowList :: [ArgOrText] -> ShowS
    showList :: [ArgOrText] -> ShowS
    Show)

    -- | Expand an instance of a macro.
    --   Precondition: got a match on the macro name.
    expandMacro :: HashDefine -> [String] -> Bool -> String
    expandMacro :: HashDefine -> [String] -> Bool -> String
    expandMacro HashDefine
    macro [String]
    parameters Bool
    layout =
        let env :: [(String, String)]
    env = [String] -> [String] -> [(String, String)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip (HashDefine -> [String]
    arguments HashDefine
    macro) [String]
    parameters
            replace :: (ArgOrText, String) -> String
    replace (ArgOrText
    Arg,String
    s)  = String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String
    "")      ShowS
    forall a. a -> a
    id (String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    s [(String, String)]
    env)
            replace (ArgOrText
    Str,String
    s)  = String -> ShowS -> Maybe String -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (ShowS
    str String
    "") ShowS
    str (String -> [(String, String)] -> Maybe String
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup String
    s [(String, String)]
    env)
            replace (ArgOrText
    Text,String
    s) = if Bool
    layout then String
    s else (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /=Char
    '\n') String
    s
            str :: ShowS
    str String
    s = Char
    '"'Char -> ShowS
    forall a. a -> [a] -> [a]
    :String
    sString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "\""
            checkArity :: a -> a
    checkArity | [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (HashDefine -> [String]
    arguments HashDefine
    macro) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 Bool -> Bool -> Bool
    && [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    parameters Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    1
                       Bool -> Bool -> Bool
    || [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (HashDefine -> [String]
    arguments HashDefine
    macro) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    parameters = a -> a
    forall a. a -> a
    id
                       | Bool
    otherwise = String -> a -> a
    forall a. HasCallStack => String -> a
    error (String
    "macro "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++HashDefine -> String
    name HashDefine
    macroString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    " expected "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                            Int -> String
    forall a. Show a => a -> String
    show ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (HashDefine -> [String]
    arguments HashDefine
    macro))String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                            String
    " arguments, but was given "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++
                                            Int -> String
    forall a. Show a => a -> String
    show ([String] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    parameters))
        in
        ShowS
    forall a. a -> a
    checkArity ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ ((ArgOrText, String) -> String) -> [(ArgOrText, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (ArgOrText, String) -> String
    replace (HashDefine -> [(ArgOrText, String)]
    expansion HashDefine
    macro)

    -- | Parse a \#define, or \#undef, ignoring other \# directives
    parseHashDefine :: Bool -> [String] -> Maybe HashDefine
    parseHashDefine :: Bool -> [String] -> Maybe HashDefine
    parseHashDefine Bool
    ansi [String]
    def = ([String] -> Maybe HashDefine
    command ([String] -> Maybe HashDefine)
    -> ([String] -> [String]) -> [String] -> Maybe HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    def
      where
        skip :: [t Char] -> [t Char]
    skip xss :: [t Char]
    xss@(t Char
    x:[t Char]
    xs) | (Char -> Bool) -> t Char -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace t Char
    x = [t Char] -> [t Char]
    skip [t Char]
    xs
                        | Bool
    otherwise     = [t Char]
    xss
        skip    []      = []
        command :: [String] -> Maybe HashDefine
    command (String
    "line":[String]
    xs)   = HashDefine -> Maybe HashDefine
    forall a. a -> Maybe a
    Just (String -> HashDefine
    LineDrop (String
    "#line"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    xs))
        command (String
    "pragma":[String]
    xs) = HashDefine -> Maybe HashDefine
    forall a. a -> Maybe a
    Just (String -> HashDefine
    Pragma (String
    "#pragma"String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++[String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [String]
    xs))
        command (String
    "define":[String]
    xs) = HashDefine -> Maybe HashDefine
    forall a. a -> Maybe a
    Just ((([String] -> HashDefine
    define ([String] -> HashDefine)
    -> ([String] -> [String]) -> [String] -> HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    xs) { linebreaks=count def })
        command (String
    "undef":[String]
    xs)  = HashDefine -> Maybe HashDefine
    forall a. a -> Maybe a
    Just ((([String] -> HashDefine
    undef  ([String] -> HashDefine)
    -> ([String] -> [String]) -> [String] -> HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    xs))
        command [String]
    _             = Maybe HashDefine
    forall a. Maybe a
    Nothing
        undef :: [String] -> HashDefine
    undef  (String
    sym:[String]
    _)   = AntiDefined { name :: String
    name=String
    sym, linebreaks :: Int
    linebreaks=Int
    0 }
        define :: [String] -> HashDefine
    define (String
    sym:[String]
    xs)  = case {-skip-} [String]
    xs of
                               (String
    "(":[String]
    ys) -> (String -> [String] -> [String] -> HashDefine
    macroHead String
    sym [] ([String] -> HashDefine)
    -> ([String] -> [String]) -> [String] -> HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    ys
                               [String]
    ys   -> HashDefine
    symbolReplacement
                                         { name=sym
                                         , replacement = concatMap snd
                                                 (classifyRhs [] (chop (skip ys))) }
        macroHead :: String -> [String] -> [String] -> HashDefine
    macroHead String
    sym [String]
    args (String
    ",":[String]
    xs) = (String -> [String] -> [String] -> HashDefine
    macroHead String
    sym [String]
    args ([String] -> HashDefine)
    -> ([String] -> [String]) -> [String] -> HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    xs
        macroHead String
    sym [String]
    args (String
    ")":[String]
    xs) = MacroExpansion
                                        { name :: String
    name =String
    sym , arguments :: [String]
    arguments = [String] -> [String]
    forall a. [a] -> [a]
    reverse [String]
    args
                                        , expansion :: [(ArgOrText, String)]
    expansion = [String] -> [String] -> [(ArgOrText, String)]
    forall {t :: * -> *}.
    Foldable t =>
    t String -> [String] -> [(ArgOrText, String)]
    classifyRhs [String]
    args ([String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip [String]
    xs)
                                        , linebreaks :: Int
    linebreaks = Int
    forall a. HasCallStack => a
    undefined }
        macroHead String
    sym [String]
    args (String
    var:[String]
    xs) = (String -> [String] -> [String] -> HashDefine
    macroHead String
    sym (String
    varString -> [String] -> [String]
    forall a. a -> [a] -> [a]
    :[String]
    args) ([String] -> HashDefine)
    -> ([String] -> [String]) -> [String] -> HashDefine
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall {t :: * -> *}. Foldable t => [t Char] -> [t Char]
    skip) [String]
    xs
        macroHead String
    sym [String]
    args []       = String -> HashDefine
    forall a. HasCallStack => String -> a
    error (String
    "incomplete macro definition:\n"
                                            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "  #define "String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    symString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "("
                                            String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," [String]
    args)
        classifyRhs :: t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args (String
    "#":String
    x:[String]
    xs)
                              | Bool
    ansi Bool -> Bool -> Bool
    &&
                                String
    x String -> t String -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t String
    args    = (ArgOrText
    Str,String
    x)(ArgOrText, String)
    -> [(ArgOrText, String)] -> [(ArgOrText, String)]
    forall a. a -> [a] -> [a]
    : t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args [String]
    xs
        classifyRhs t String
    args (String
    "##":[String]
    xs)
                              | Bool
    ansi             = t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args [String]
    xs
        classifyRhs t String
    args (String
    s:String
    "##":String
    s':[String]
    xs)
                              | Bool
    ansi Bool -> Bool -> Bool
    && (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    s Bool -> Bool -> Bool
    && (Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace String
    s'
                                                 = t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args [String]
    xs
        classifyRhs t String
    args (String
    word:[String]
    xs)
                              | String
    word String -> t String -> Bool
    forall a. Eq a => a -> t a -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` t String
    args = (ArgOrText
    Arg,String
    word)(ArgOrText, String)
    -> [(ArgOrText, String)] -> [(ArgOrText, String)]
    forall a. a -> [a] -> [a]
    : t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args [String]
    xs
                              | Bool
    otherwise        = (ArgOrText
    Text,String
    word)(ArgOrText, String)
    -> [(ArgOrText, String)] -> [(ArgOrText, String)]
    forall a. a -> [a] -> [a]
    : t String -> [String] -> [(ArgOrText, String)]
    classifyRhs t String
    args [String]
    xs
        classifyRhs t String
    _    []                      = []
        count :: [String] -> Int
    count = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> ([String] -> String) -> [String] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Char
    '\n') ShowS -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
        chop :: [String] -> [String]
    chop  = [String] -> [String]
    forall a. [a] -> [a]
    reverse ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (String -> Bool) -> [String] -> [String]
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile ((Char -> Bool) -> String -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all Char -> Bool
    isSpace) ([String] -> [String])
    -> ([String] -> [String]) -> [String] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [String]
    forall a. [a] -> [a]
    reverse

    -- | Pretty-print hash defines to a simpler format, as key-value pairs.
    simplifyHashDefines :: [HashDefine] -> [(String,String)]
    simplifyHashDefines :: [HashDefine] -> [(String, String)]
    simplifyHashDefines = (HashDefine -> [(String, String)])
    -> [HashDefine] -> [(String, String)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap HashDefine -> [(String, String)]
    simp
      where
        simp :: HashDefine -> [(String, String)]
    simp hd :: HashDefine
    hd@LineDrop{}    = []
        simp hd :: HashDefine
    hd@Pragma{}      = []
        simp hd :: HashDefine
    hd@AntiDefined{} = []
        simp hd :: HashDefine
    hd@SymbolReplacement{} = [(HashDefine -> String
    name HashDefine
    hd, HashDefine -> String
    replacement HashDefine
    hd)]
        simp hd :: HashDefine
    hd@MacroExpansion{}    = [(HashDefine -> String
    name HashDefine
    hdString -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    "("String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String -> [String] -> String
    forall a. [a] -> [[a]] -> [a]
    intercalate String
    "," (HashDefine -> [String]
    arguments HashDefine
    hd)
                                               String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++String
    ")"
                                       ,((ArgOrText, String) -> String) -> [(ArgOrText, String)] -> String
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap (ArgOrText, String) -> String
    forall a b. (a, b) -> b
    snd (HashDefine -> [(ArgOrText, String)]
    expansion HashDefine
    hd))]