--  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)