    --  C->Haskell Compiler: C attribute definitions and manipulation routines
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 12 August 99
    --
    --  Version $Revision: 1.1 $ from $Date: 2004/11/21 21:05:27 $
    --
    --  Copyright (c) [1999..2001] Manuel M. T. Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This module provides the attributed version of the C structure tree.
    --
    --  * C has several name spaces of which two are represented in this module:
    --    - `CObj' in `defObjsAC': The name space of objects, functions, typedef
    --        names, and enum constants.
    --    - `CTag' in `defTagsAC': The name space of tags of structures, unions,
    --        and enumerations.
    --
    --  * The final state of the names spaces are preserved in the attributed
    --    structure tree.  This allows further fast lookups for globally defined
    --    identifiers after the name anaysis is over.
    --
    --  * In addition to the name spaces, the attribute structure tree contains
    --    a ident-definition table, which for attribute handles of identifiers
    --    refers to the identifiers definition.  These are only used in usage
    --    occurences, except for one exception: The tag identifiers in forward
    --    definitions of structures or enums get a reference to the corresponding
    --    full definition - see `CTrav' for full details.
    --
    --  * We maintain a shadow definition table, it can be populated with aliases
    --    to other objects and maps identifiers to identifiers.  It is populated by
    --    using the `applyPrefix' function.  When looksup performed via the shadow
    --    variant of a lookup function, shadow aliases are also considered, but
    --    they are used only if no normal entry for the identifiers is present.
    --
    --  * Only ranges delimited by a block open a new range for tags (see
    --    `enterNewObjRangeC' and `leaveObjRangeC').
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --- TODO ----------------------------------------------------------------------
    --

    module CAttrs (-- attributed C
                   --
                   AttrC, attrC, getCHeader, enterNewRangeC, enterNewObjRangeC,
                   leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC,
                   lookupDefObjCShadow, addDefTagC, lookupDefTagC,
                   lookupDefTagCShadow, applyPrefix, getDefOfIdentC,
                   setDefOfIdentC, updDefOfIdentC, freezeDefOfIdentsAttrC,
                   softenDefOfIdentsAttrC,
                   --
                   -- C objects
                   --
                   CObj(..), CTag(..), CDef(..))
    where

    import Data.Char          (toUpper)
    import Data.List       (isPrefixOf)
    import Data.Maybe         (mapMaybe)

    import Position   (Position, Pos(posOf), nopos, dontCarePos, builtinPos)
    import Errors     (interr)
    import Idents     (Ident, getIdentAttrs, identToLexeme, onlyPosIdent)
    import Attributes (Attr(..), AttrTable, getAttr, setAttr, updAttr,
                       newAttrTable, freezeAttrTable, softenAttrTable)
    import NameSpaces (NameSpace, nameSpace, enterNewRange, leaveRange, defLocal,
                       defGlobal, find, nameSpaceToList)
    import Binary     (Binary(..), putByte, getByte)

    import CAST

    -- attributed C structure tree
    -- ---------------------------

    -- C unit together with the attributes relevant to the outside world
    -- (EXPORTED ABSTRACT)
    --
    data AttrC = AttrC {
                    AttrC -> CHeader
    headerAC  :: CHeader,           -- raw header
                    AttrC -> CObjNS
    defObjsAC :: CObjNS,            -- defined objects
                    AttrC -> CTagNS
    defTagsAC :: CTagNS,            -- defined tags
                    AttrC -> CShadowNS
    shadowsAC :: CShadowNS,         -- shadow definitions (prefix)
                    AttrC -> CDefTable
    defsAC    :: CDefTable          -- ident-def associations
                  }

    -- make an attribute structure tree from a raw one (EXPORTED)
    --
    attrC        :: CHeader -> AttrC
    attrC :: CHeader -> AttrC
    attrC header :: CHeader
    header  = AttrC :: CHeader -> CObjNS -> CTagNS -> CShadowNS -> CDefTable -> AttrC
    AttrC {
                        headerAC :: CHeader
    headerAC  = CHeader
    header,
                        defObjsAC :: CObjNS
    defObjsAC = CObjNS
    cObjNS,
                        defTagsAC :: CTagNS
    defTagsAC = CTagNS
    cTagNS,
                        shadowsAC :: CShadowNS
    shadowsAC = CShadowNS
    cShadowNS,
                        defsAC :: CDefTable
    defsAC    = CDefTable
    cDefTable
                      }

    -- extract the raw structure tree from an attributes one (EXPORTED)
    --
    getCHeader :: AttrC -> CHeader
    getCHeader :: AttrC -> CHeader
    getCHeader  = AttrC -> CHeader
    headerAC

    -- the name space operations
    --

    -- enter a new range (EXPORTED)
    --
    enterNewRangeC    :: AttrC -> AttrC
    enterNewRangeC :: AttrC -> AttrC
    enterNewRangeC ac :: AttrC
    ac  = AttrC
    ac {
                          defObjsAC :: CObjNS
    defObjsAC = CObjNS -> CObjNS
    forall a. NameSpace a -> NameSpace a
    enterNewRange (CObjNS -> CObjNS) -> (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CObjNS
    defObjsAC (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac,
                          defTagsAC :: CTagNS
    defTagsAC = CTagNS -> CTagNS
    forall a. NameSpace a -> NameSpace a
    enterNewRange (CTagNS -> CTagNS) -> (AttrC -> CTagNS) -> AttrC -> CTagNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CTagNS
    defTagsAC (AttrC -> CTagNS) -> AttrC -> CTagNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac
                         }

    -- enter a new range, only for objects (EXPORTED)
    --
    enterNewObjRangeC    :: AttrC -> AttrC
    enterNewObjRangeC :: AttrC -> AttrC
    enterNewObjRangeC ac :: AttrC
    ac  = AttrC
    ac {
                              defObjsAC :: CObjNS
    defObjsAC = CObjNS -> CObjNS
    forall a. NameSpace a -> NameSpace a
    enterNewRange (CObjNS -> CObjNS) -> (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CObjNS
    defObjsAC (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac
                            }

    -- leave the current range (EXPORTED)
    --
    leaveRangeC    :: AttrC -> AttrC
    leaveRangeC :: AttrC -> AttrC
    leaveRangeC ac :: AttrC
    ac  = AttrC
    ac {
                        defObjsAC :: CObjNS
    defObjsAC = (CObjNS, [(Ident, CObj)]) -> CObjNS
    forall a b. (a, b) -> a
    fst ((CObjNS, [(Ident, CObj)]) -> CObjNS)
    -> (AttrC -> (CObjNS, [(Ident, CObj)])) -> AttrC -> CObjNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CObjNS -> (CObjNS, [(Ident, CObj)])
    forall a. NameSpace a -> (NameSpace a, [(Ident, a)])
    leaveRange (CObjNS -> (CObjNS, [(Ident, CObj)]))
    -> (AttrC -> CObjNS) -> AttrC -> (CObjNS, [(Ident, CObj)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CObjNS
    defObjsAC (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac,
                        defTagsAC :: CTagNS
    defTagsAC = (CTagNS, [(Ident, CTag)]) -> CTagNS
    forall a b. (a, b) -> a
    fst ((CTagNS, [(Ident, CTag)]) -> CTagNS)
    -> (AttrC -> (CTagNS, [(Ident, CTag)])) -> AttrC -> CTagNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CTagNS -> (CTagNS, [(Ident, CTag)])
    forall a. NameSpace a -> (NameSpace a, [(Ident, a)])
    leaveRange (CTagNS -> (CTagNS, [(Ident, CTag)]))
    -> (AttrC -> CTagNS) -> AttrC -> (CTagNS, [(Ident, CTag)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CTagNS
    defTagsAC (AttrC -> CTagNS) -> AttrC -> CTagNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac
                       }

    -- leave the current range, only for objects (EXPORTED)
    --
    leaveObjRangeC    :: AttrC -> AttrC
    leaveObjRangeC :: AttrC -> AttrC
    leaveObjRangeC ac :: AttrC
    ac  = AttrC
    ac {
                           defObjsAC :: CObjNS
    defObjsAC = (CObjNS, [(Ident, CObj)]) -> CObjNS
    forall a b. (a, b) -> a
    fst ((CObjNS, [(Ident, CObj)]) -> CObjNS)
    -> (AttrC -> (CObjNS, [(Ident, CObj)])) -> AttrC -> CObjNS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . CObjNS -> (CObjNS, [(Ident, CObj)])
    forall a. NameSpace a -> (NameSpace a, [(Ident, a)])
    leaveRange (CObjNS -> (CObjNS, [(Ident, CObj)]))
    -> (AttrC -> CObjNS) -> AttrC -> (CObjNS, [(Ident, CObj)])
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AttrC -> CObjNS
    defObjsAC (AttrC -> CObjNS) -> AttrC -> CObjNS
    forall a b. (a -> b) -> a -> b
    $ AttrC
    ac
                         }

    -- add another definitions to the object name space (EXPORTED)
    --
    --  * if a definition of the same name was already present, it is returned
    --
    addDefObjC            :: AttrC -> Ident -> CObj -> (AttrC, Maybe CObj)
    addDefObjC :: AttrC -> Ident -> CObj -> (AttrC, Maybe CObj)
    addDefObjC ac :: AttrC
    ac ide :: Ident
    ide obj :: CObj
    obj  = let om :: CObjNS
    om          = AttrC -> CObjNS
    defObjsAC AttrC
    ac
                                 (ac' :: CObjNS
    ac', obj' :: Maybe CObj
    obj') = CObjNS -> Ident -> CObj -> (CObjNS, Maybe CObj)
    forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defLocal CObjNS
    om Ident
    ide CObj
    obj
                             in
                             (AttrC
    ac {defObjsAC :: CObjNS
    defObjsAC = CObjNS
    ac'}, Maybe CObj
    obj')

    -- lookup an identifier in the object name space (EXPORTED)
    --
    lookupDefObjC        :: AttrC -> Ident -> Maybe CObj
    lookupDefObjC :: AttrC -> Ident -> Maybe CObj
    lookupDefObjC ac :: AttrC
    ac ide :: Ident
    ide  = CObjNS -> Ident -> Maybe CObj
    forall a. NameSpace a -> Ident -> Maybe a
    find (AttrC -> CObjNS
    defObjsAC AttrC
    ac) Ident
    ide

    -- lookup an identifier in the object name space; if nothing found, try
    -- whether there is a shadow identifier that matches (EXPORTED)
    --
    --  * the returned identifier is the _real_ identifier of the object
    --
    lookupDefObjCShadow        :: AttrC -> Ident -> Maybe (CObj, Ident)
    lookupDefObjCShadow :: AttrC -> Ident -> Maybe (CObj, Ident)
    lookupDefObjCShadow ac :: AttrC
    ac ide :: Ident
    ide  =
      case AttrC -> Ident -> Maybe CObj
    lookupDefObjC AttrC
    ac Ident
    ide of
        Just obj :: CObj
    obj -> (CObj, Ident) -> Maybe (CObj, Ident)
    forall a. a -> Maybe a
    Just (CObj
    obj, Ident
    ide)
        Nothing  -> case CShadowNS -> Ident -> Maybe Ident
    forall a. NameSpace a -> Ident -> Maybe a
    find (AttrC -> CShadowNS
    shadowsAC AttrC
    ac) Ident
    ide of
                      Nothing   -> Maybe (CObj, Ident)
    forall a. Maybe a
    Nothing
                      Just ide' :: Ident
    ide' -> case AttrC -> Ident -> Maybe CObj
    lookupDefObjC AttrC
    ac Ident
    ide' of
                                     Just obj :: CObj
    obj -> (CObj, Ident) -> Maybe (CObj, Ident)
    forall a. a -> Maybe a
    Just (CObj
    obj, Ident
    ide')
                                     Nothing  -> Maybe (CObj, Ident)
    forall a. Maybe a
    Nothing

    -- add another definition to the tag name space (EXPORTED)
    --
    --  * if a definition of the same name was already present, it is returned
    --
    addDefTagC            :: AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
    addDefTagC :: AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
    addDefTagC ac :: AttrC
    ac ide :: Ident
    ide obj :: CTag
    obj  = let tm :: CTagNS
    tm          = AttrC -> CTagNS
    defTagsAC AttrC
    ac
                                 (ac' :: CTagNS
    ac', obj' :: Maybe CTag
    obj') = CTagNS -> Ident -> CTag -> (CTagNS, Maybe CTag)
    forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defLocal CTagNS
    tm Ident
    ide CTag
    obj
                             in
                             (AttrC
    ac {defTagsAC :: CTagNS
    defTagsAC = CTagNS
    ac'}, Maybe CTag
    obj')

    -- lookup an identifier in the tag name space (EXPORTED)
    --
    lookupDefTagC        :: AttrC -> Ident -> Maybe CTag
    lookupDefTagC :: AttrC -> Ident -> Maybe CTag
    lookupDefTagC ac :: AttrC
    ac ide :: Ident
    ide  = CTagNS -> Ident -> Maybe CTag
    forall a. NameSpace a -> Ident -> Maybe a
    find (AttrC -> CTagNS
    defTagsAC AttrC
    ac) Ident
    ide

    -- lookup an identifier in the tag name space; if nothing found, try
    -- whether there is a shadow identifier that matches (EXPORTED)
    --
    --  * the returned identifier is the _real_ identifier of the tag
    --
    lookupDefTagCShadow        :: AttrC -> Ident -> Maybe (CTag, Ident)
    lookupDefTagCShadow :: AttrC -> Ident -> Maybe (CTag, Ident)
    lookupDefTagCShadow ac :: AttrC
    ac ide :: Ident
    ide  =
      case AttrC -> Ident -> Maybe CTag
    lookupDefTagC AttrC
    ac Ident
    ide of
        Just tag :: CTag
    tag -> (CTag, Ident) -> Maybe (CTag, Ident)
    forall a. a -> Maybe a
    Just (CTag
    tag, Ident
    ide)
        Nothing  -> case CShadowNS -> Ident -> Maybe Ident
    forall a. NameSpace a -> Ident -> Maybe a
    find (AttrC -> CShadowNS
    shadowsAC AttrC
    ac) Ident
    ide of
                      Nothing   -> Maybe (CTag, Ident)
    forall a. Maybe a
    Nothing
                      Just ide' :: Ident
    ide' -> case AttrC -> Ident -> Maybe CTag
    lookupDefTagC AttrC
    ac Ident
    ide' of
                                     Just tag :: CTag
    tag -> (CTag, Ident) -> Maybe (CTag, Ident)
    forall a. a -> Maybe a
    Just (CTag
    tag, Ident
    ide')
                                     Nothing  -> Maybe (CTag, Ident)
    forall a. Maybe a
    Nothing

    -- enrich the shadow name space with identifiers obtained by dropping
    -- the given prefix from the identifiers already in the object or tag name
    -- space (EXPORTED)
    --
    --  * in case of a collisions, a random entry is selected
    --
    --  * case is not relevant in the prefix and underscores between the prefix and
    --   the stem of an identifier are also dropped
    --
    applyPrefix           :: AttrC -> String -> AttrC
    applyPrefix :: AttrC -> String -> AttrC
    applyPrefix ac :: AttrC
    ac prefix :: String
    prefix  =
      let
        shadows :: CShadowNS
    shadows    = AttrC -> CShadowNS
    shadowsAC AttrC
    ac
        names :: [Ident]
    names      =    ((Ident, CObj) -> Ident) -> [(Ident, CObj)] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident, CObj) -> Ident
    forall a b. (a, b) -> a
    fst (CObjNS -> [(Ident, CObj)]
    forall a. NameSpace a -> [(Ident, a)]
    nameSpaceToList (AttrC -> CObjNS
    defObjsAC AttrC
    ac))
                     [Ident] -> [Ident] -> [Ident]
    forall a. [a] -> [a] -> [a]
    ++ ((Ident, CTag) -> Ident) -> [(Ident, CTag)] -> [Ident]
    forall a b. (a -> b) -> [a] -> [b]
    map (Ident, CTag) -> Ident
    forall a b. (a, b) -> a
    fst (CTagNS -> [(Ident, CTag)]
    forall a. NameSpace a -> [(Ident, a)]
    nameSpaceToList (AttrC -> CTagNS
    defTagsAC AttrC
    ac))
        newShadows :: [(Ident, Ident)]
    newShadows = (Ident -> Maybe (Ident, Ident)) -> [Ident] -> [(Ident, Ident)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (String -> Ident -> Maybe (Ident, Ident)
    strip String
    prefix) [Ident]
    names
      in
      AttrC
    ac {shadowsAC :: CShadowNS
    shadowsAC = (CShadowNS -> (Ident, Ident) -> CShadowNS)
    -> CShadowNS -> [(Ident, Ident)] -> CShadowNS
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl CShadowNS -> (Ident, Ident) -> CShadowNS
    forall a. NameSpace a -> (Ident, a) -> NameSpace a
    define CShadowNS
    shadows [(Ident, Ident)]
    newShadows}
      where
        strip :: String -> Ident -> Maybe (Ident, Ident)
    strip prefix :: String
    prefix ide :: Ident
    ide = case String -> String -> Maybe String
    eat String
    prefix (Ident -> String
    identToLexeme Ident
    ide) of
                             Nothing      -> Maybe (Ident, Ident)
    forall a. Maybe a
    Nothing
                             Just ""      -> Maybe (Ident, Ident)
    forall a. Maybe a
    Nothing
                             Just newName :: String
    newName -> (Ident, Ident) -> Maybe (Ident, Ident)
    forall a. a -> Maybe a
    Just
                                               (Position -> String -> Ident
    onlyPosIdent (Ident -> Position
    forall a. Pos a => a -> Position
    posOf Ident
    ide) String
    newName,
                                                Ident
    ide)
        --
        eat :: String -> String -> Maybe String
    eat []         ('_':cs :: String
    cs)                        = String -> String -> Maybe String
    eat [] String
    cs
        eat []         cs :: String
    cs                              = String -> Maybe String
    forall a. a -> Maybe a
    Just String
    cs
        eat (p :: Char
    p:prefix :: String
    prefix) (c :: Char
    c:cs :: String
    cs) | Char -> Char
    toUpper Char
    p Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char -> Char
    toUpper Char
    c = String -> String -> Maybe String
    eat String
    prefix String
    cs
                              | Bool
    otherwise              = Maybe String
    forall a. Maybe a
    Nothing
        eat _          _                               = Maybe String
    forall a. Maybe a
    Nothing
        --
        define :: NameSpace a -> (Ident, a) -> NameSpace a
    define ns :: NameSpace a
    ns (ide :: Ident
    ide, def :: a
    def) = (NameSpace a, Maybe a) -> NameSpace a
    forall a b. (a, b) -> a
    fst (NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defGlobal NameSpace a
    ns Ident
    ide a
    def)

    -- the attribute table operations on the attributes
    --

    -- get the definition associated with the given identifier (EXPORTED)
    --
    getDefOfIdentC    :: AttrC -> Ident -> CDef
    getDefOfIdentC :: AttrC -> Ident -> CDef
    getDefOfIdentC ac :: AttrC
    ac  = CDefTable -> Attrs -> CDef
    forall a. Attr a => AttrTable a -> Attrs -> a
    getAttr (AttrC -> CDefTable
    defsAC AttrC
    ac) (Attrs -> CDef) -> (Ident -> Attrs) -> Ident -> CDef
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ident -> Attrs
    getIdentAttrs

    setDefOfIdentC           :: AttrC -> Ident -> CDef -> AttrC
    setDefOfIdentC :: AttrC -> Ident -> CDef -> AttrC
    setDefOfIdentC ac :: AttrC
    ac id :: Ident
    id def :: CDef
    def  =
      let tot' :: CDefTable
    tot' = CDefTable -> Attrs -> CDef -> CDefTable
    forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
    setAttr (AttrC -> CDefTable
    defsAC AttrC
    ac) (Ident -> Attrs
    getIdentAttrs Ident
    id) CDef
    def
      in
      AttrC
    ac {defsAC :: CDefTable
    defsAC = CDefTable
    tot'}

    updDefOfIdentC            :: AttrC -> Ident -> CDef -> AttrC
    updDefOfIdentC :: AttrC -> Ident -> CDef -> AttrC
    updDefOfIdentC ac :: AttrC
    ac id :: Ident
    id def :: CDef
    def  =
      let tot' :: CDefTable
    tot' = CDefTable -> Attrs -> CDef -> CDefTable
    forall a. Attr a => AttrTable a -> Attrs -> a -> AttrTable a
    updAttr (AttrC -> CDefTable
    defsAC AttrC
    ac) (Ident -> Attrs
    getIdentAttrs Ident
    id) CDef
    def
      in
      AttrC
    ac {defsAC :: CDefTable
    defsAC = CDefTable
    tot'}

    freezeDefOfIdentsAttrC    :: AttrC -> AttrC
    freezeDefOfIdentsAttrC :: AttrC -> AttrC
    freezeDefOfIdentsAttrC ac :: AttrC
    ac  = AttrC
    ac {defsAC :: CDefTable
    defsAC = CDefTable -> CDefTable
    forall a. Attr a => AttrTable a -> AttrTable a
    freezeAttrTable (AttrC -> CDefTable
    defsAC AttrC
    ac)}

    softenDefOfIdentsAttrC    :: AttrC -> AttrC
    softenDefOfIdentsAttrC :: AttrC -> AttrC
    softenDefOfIdentsAttrC ac :: AttrC
    ac  = AttrC
    ac {defsAC :: CDefTable
    defsAC = CDefTable -> CDefTable
    forall a. Attr a => AttrTable a -> AttrTable a
    softenAttrTable (AttrC -> CDefTable
    defsAC AttrC
    ac)}

    -- C objects including operations
    -- ------------------------------

    -- C objects data definition (EXPORTED)
    --
    data CObj = TypeCO    CDecl             -- typedef declaration
              | ObjCO     CDecl             -- object or function declaration
              | EnumCO    Ident CEnum       -- enumerator
              | BuiltinCO                   -- builtin object

    -- two C objects are equal iff they are defined by the same structure
    -- tree node (i.e., the two nodes referenced have the same attribute
    -- identifier)
    --
    instance Eq CObj where
      (TypeCO decl1 :: CDecl
    decl1     ) == :: CObj -> CObj -> Bool
    == (TypeCO decl2 :: CDecl
    decl2     ) = CDecl
    decl1 CDecl -> CDecl -> Bool
    forall a. Eq a => a -> a -> Bool
    == CDecl
    decl2
      (ObjCO  decl1 :: CDecl
    decl1     ) == (ObjCO  decl2 :: CDecl
    decl2     ) = CDecl
    decl1 CDecl -> CDecl -> Bool
    forall a. Eq a => a -> a -> Bool
    == CDecl
    decl2
      (EnumCO ide1 :: Ident
    ide1 enum1 :: CEnum
    enum1) == (EnumCO ide2 :: Ident
    ide2 enum2 :: CEnum
    enum2) = Ident
    ide1 Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    ide2 Bool -> Bool -> Bool
    && CEnum
    enum1 CEnum -> CEnum -> Bool
    forall a. Eq a => a -> a -> Bool
    == CEnum
    enum2
      _                   == _                   = Bool
    False

    instance Pos CObj where
      posOf :: CObj -> Position
    posOf (TypeCO    def :: CDecl
    def  ) = CDecl -> Position
    forall a. Pos a => a -> Position
    posOf CDecl
    def
      posOf (ObjCO     def :: CDecl
    def  ) = CDecl -> Position
    forall a. Pos a => a -> Position
    posOf CDecl
    def
      posOf (EnumCO    ide :: Ident
    ide _) = Ident -> Position
    forall a. Pos a => a -> Position
    posOf Ident
    ide
      posOf (CObj
    BuiltinCO      ) = Position
    builtinPos

    -- C tagged objects including operations
    -- -------------------------------------

    -- C tagged objects data definition (EXPORTED)
    --
    data CTag = StructUnionCT CStructUnion  -- toplevel struct-union declaration
              | EnumCT        CEnum         -- toplevel enum declaration

    -- two C tag objects are equal iff they are defined by the same structure
    -- tree node (i.e., the two nodes referenced have the same attribute
    -- identifier)
    --
    instance Eq CTag where
      (StructUnionCT struct1 :: CStructUnion
    struct1) == :: CTag -> CTag -> Bool
    == (StructUnionCT struct2 :: CStructUnion
    struct2) = CStructUnion
    struct1 CStructUnion -> CStructUnion -> Bool
    forall a. Eq a => a -> a -> Bool
    == CStructUnion
    struct2
      (EnumCT        enum1 :: CEnum
    enum1  ) == (EnumCT        enum2 :: CEnum
    enum2  ) = CEnum
    enum1 CEnum -> CEnum -> Bool
    forall a. Eq a => a -> a -> Bool
    == CEnum
    enum2
      _                       == _                       = Bool
    False

    instance Pos CTag where
      posOf :: CTag -> Position
    posOf (StructUnionCT def :: CStructUnion
    def) = CStructUnion -> Position
    forall a. Pos a => a -> Position
    posOf CStructUnion
    def
      posOf (EnumCT        def :: CEnum
    def) = CEnum -> Position
    forall a. Pos a => a -> Position
    posOf CEnum
    def

    -- C general definition
    -- --------------------

    -- C general definition (EXPORTED)
    --
    data CDef = UndefCD                     -- undefined object
              | DontCareCD                  -- don't care object
              | ObjCD      CObj             -- C object
              | TagCD      CTag             -- C tag

    -- two C definitions are equal iff they are defined by the same structure
    -- tree node (i.e., the two nodes referenced have the same attribute
    -- identifier), but don't care objects are equal to everything and undefined
    -- objects may not be compared
    --
    instance Eq CDef where
      (ObjCD obj1 :: CObj
    obj1) == :: CDef -> CDef -> Bool
    == (ObjCD obj2 :: CObj
    obj2) = CObj
    obj1 CObj -> CObj -> Bool
    forall a. Eq a => a -> a -> Bool
    == CObj
    obj2
      (TagCD tag1 :: CTag
    tag1) == (TagCD tag2 :: CTag
    tag2) = CTag
    tag1 CTag -> CTag -> Bool
    forall a. Eq a => a -> a -> Bool
    == CTag
    tag2
      DontCareCD   == _            = Bool
    True
      _            == DontCareCD   = Bool
    True
      UndefCD      == _            =
        String -> Bool
    forall a. String -> a
    interr "CAttrs: Attempt to compare an undefined C definition!"
      _            == UndefCD      =
        String -> Bool
    forall a. String -> a
    interr "CAttrs: Attempt to compare an undefined C definition!"
      _            == _            = Bool
    False

    instance Attr CDef where
      undef :: CDef
    undef    = CDef
    UndefCD
      dontCare :: CDef
    dontCare = CDef
    DontCareCD

      isUndef :: CDef -> Bool
    isUndef UndefCD = Bool
    True
      isUndef _       = Bool
    False

      isDontCare :: CDef -> Bool
    isDontCare DontCareCD = Bool
    True
      isDontCare _          = Bool
    False

    instance Pos CDef where
      posOf :: CDef -> Position
    posOf UndefCD     = Position
    nopos
      posOf DontCareCD  = Position
    dontCarePos
      posOf (ObjCD obj :: CObj
    obj) = CObj -> Position
    forall a. Pos a => a -> Position
    posOf CObj
    obj
      posOf (TagCD tag :: CTag
    tag) = CTag -> Position
    forall a. Pos a => a -> Position
    posOf CTag
    tag

    -- object tables (internal use only)
    -- ---------------------------------

    -- the object name space
    --
    type CObjNS = NameSpace CObj

    -- creating a new object name space
    --
    cObjNS :: CObjNS
    cObjNS :: CObjNS
    cObjNS  = CObjNS
    forall a. NameSpace a
    nameSpace

    -- the tag name space
    --
    type CTagNS = NameSpace CTag

    -- creating a new tag name space
    --
    cTagNS :: CTagNS
    cTagNS :: CTagNS
    cTagNS  = CTagNS
    forall a. NameSpace a
    nameSpace

    -- the shadow name space
    --
    type CShadowNS = NameSpace Ident

    -- creating a shadow name space
    --
    cShadowNS :: CShadowNS
    cShadowNS :: CShadowNS
    cShadowNS  = CShadowNS
    forall a. NameSpace a
    nameSpace

    -- the general definition table
    --
    type CDefTable = AttrTable CDef

    -- creating a new definition table
    --
    cDefTable :: CDefTable
    cDefTable :: CDefTable
    cDefTable  = String -> CDefTable
    forall a. Attr a => String -> AttrTable a
    newAttrTable "C General Definition Table for Idents"

    {-! for AttrC derive : GhcBinary !-}
    {-! for CObj derive : GhcBinary !-}
    {-! for CTag derive : GhcBinary !-}
    {-! for CDef derive : GhcBinary !-}
    {-* Generated by DrIFT : Look, but Don't Touch. *-}
    instance Binary AttrC where
        put_ :: BinHandle -> AttrC -> IO ()
    put_ bh :: BinHandle
    bh (AttrC aa :: CHeader
    aa ab :: CObjNS
    ab ac :: CTagNS
    ac ad :: CShadowNS
    ad ae :: CDefTable
    ae) = do
    --          put_ bh aa
                BinHandle -> CObjNS -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CObjNS
    ab
                BinHandle -> CTagNS -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CTagNS
    ac
                BinHandle -> CShadowNS -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CShadowNS
    ad
                BinHandle -> CDefTable -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CDefTable
    ae
        get :: BinHandle -> IO AttrC
    get bh :: BinHandle
    bh = do
    --    aa <- get bh
        CObjNS
    ab <- BinHandle -> IO CObjNS
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        CTagNS
    ac <- BinHandle -> IO CTagNS
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        CShadowNS
    ad <- BinHandle -> IO CShadowNS
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        CDefTable
    ae <- BinHandle -> IO CDefTable
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        AttrC -> IO AttrC
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CHeader -> CObjNS -> CTagNS -> CShadowNS -> CDefTable -> AttrC
    AttrC (String -> CHeader
    forall a. HasCallStack => String -> a
    error "AttrC.headerAC should not be needed") CObjNS
    ab CTagNS
    ac CShadowNS
    ad CDefTable
    ae)

    instance Binary CObj where
        put_ :: BinHandle -> CObj -> IO ()
    put_ bh :: BinHandle
    bh (TypeCO aa :: CDecl
    aa) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 0
                BinHandle -> CDecl -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CDecl
    aa
        put_ bh :: BinHandle
    bh (ObjCO ab :: CDecl
    ab) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 1
                BinHandle -> CDecl -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CDecl
    ab
        put_ bh :: BinHandle
    bh (EnumCO ac :: Ident
    ac ad :: CEnum
    ad) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 2
                BinHandle -> Ident -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Ident
    ac
                BinHandle -> CEnum -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CEnum
    ad
        put_ bh :: BinHandle
    bh BuiltinCO = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 3
        get :: BinHandle -> IO CObj
    get bh :: BinHandle
    bh = do
                Word8
    h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                case Word8
    h of
                  0 -> do
                        CDecl
    aa <- BinHandle -> IO CDecl
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CObj -> IO CObj
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CDecl -> CObj
    TypeCO CDecl
    aa)
                  1 -> do
                        CDecl
    ab <- BinHandle -> IO CDecl
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CObj -> IO CObj
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CDecl -> CObj
    ObjCO CDecl
    ab)
                  2 -> do
                        Ident
    ac <- BinHandle -> IO Ident
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CEnum
    ad <- BinHandle -> IO CEnum
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CObj -> IO CObj
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Ident -> CEnum -> CObj
    EnumCO Ident
    ac CEnum
    ad)
                  3 -> do
                        CObj -> IO CObj
    forall (m :: * -> *) a. Monad m => a -> m a
    return CObj
    BuiltinCO

    instance Binary CTag where
        put_ :: BinHandle -> CTag -> IO ()
    put_ bh :: BinHandle
    bh (StructUnionCT aa :: CStructUnion
    aa) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 0
                BinHandle -> CStructUnion -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CStructUnion
    aa
        put_ bh :: BinHandle
    bh (EnumCT ab :: CEnum
    ab) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 1
                BinHandle -> CEnum -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CEnum
    ab
        get :: BinHandle -> IO CTag
    get bh :: BinHandle
    bh = do
                Word8
    h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                case Word8
    h of
                  0 -> do
                        CStructUnion
    aa <- BinHandle -> IO CStructUnion
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CTag -> IO CTag
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CStructUnion -> CTag
    StructUnionCT CStructUnion
    aa)
                  1 -> do
                        CEnum
    ab <- BinHandle -> IO CEnum
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CTag -> IO CTag
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CEnum -> CTag
    EnumCT CEnum
    ab)

    instance Binary CDef where
        put_ :: BinHandle -> CDef -> IO ()
    put_ bh :: BinHandle
    bh UndefCD = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 0
        put_ bh :: BinHandle
    bh DontCareCD = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 1
        put_ bh :: BinHandle
    bh (ObjCD aa :: CObj
    aa) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 2
                BinHandle -> CObj -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CObj
    aa
        put_ bh :: BinHandle
    bh (TagCD ab :: CTag
    ab) = do
                BinHandle -> Word8 -> IO ()
    putByte BinHandle
    bh 3
                BinHandle -> CTag -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh CTag
    ab
        get :: BinHandle -> IO CDef
    get bh :: BinHandle
    bh = do
                Word8
    h <- BinHandle -> IO Word8
    getByte BinHandle
    bh
                case Word8
    h of
                  0 -> do
                        CDef -> IO CDef
    forall (m :: * -> *) a. Monad m => a -> m a
    return CDef
    UndefCD
                  1 -> do
                        CDef -> IO CDef
    forall (m :: * -> *) a. Monad m => a -> m a
    return CDef
    DontCareCD
                  2 -> do
                        CObj
    aa <- BinHandle -> IO CObj
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CDef -> IO CDef
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CObj -> CDef
    ObjCD CObj
    aa)
                  3 -> do
                        CTag
    ab <- BinHandle -> IO CTag
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
                        CDef -> IO CDef
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CTag -> CDef
    TagCD CTag
    ab)