--  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 CHeader
header  = 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 AttrC
ac  = AttrC
ac {
                      defObjsAC :: CObjNS
defObjsAC = forall a. NameSpace a -> NameSpace a
enterNewRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrC -> CObjNS
defObjsAC forall a b. (a -> b) -> a -> b
$ AttrC
ac,
                      defTagsAC :: CTagNS
defTagsAC = forall a. NameSpace a -> NameSpace a
enterNewRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrC -> CTagNS
defTagsAC forall a b. (a -> b) -> a -> b
$ AttrC
ac
                     }

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

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

-- leave the current range, only for objects (EXPORTED)
--
leaveObjRangeC    :: AttrC -> AttrC
leaveObjRangeC :: AttrC -> AttrC
leaveObjRangeC AttrC
ac  = AttrC
ac {
                       defObjsAC :: CObjNS
defObjsAC = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NameSpace a -> (NameSpace a, [(Ident, a)])
leaveRange forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrC -> CObjNS
defObjsAC 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 AttrC
ac Ident
ide CObj
obj  = let om :: CObjNS
om          = AttrC -> CObjNS
defObjsAC AttrC
ac
                             (CObjNS
ac', Maybe CObj
obj') = 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 AttrC
ac Ident
ide  = 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 AttrC
ac Ident
ide  = 
  case AttrC -> Ident -> Maybe CObj
lookupDefObjC AttrC
ac Ident
ide of
    Just CObj
obj -> forall a. a -> Maybe a
Just (CObj
obj, Ident
ide)
    Maybe CObj
Nothing  -> case forall a. NameSpace a -> Ident -> Maybe a
find (AttrC -> CShadowNS
shadowsAC AttrC
ac) Ident
ide of
                  Maybe Ident
Nothing   -> forall a. Maybe a
Nothing
                  Just Ident
ide' -> case AttrC -> Ident -> Maybe CObj
lookupDefObjC AttrC
ac Ident
ide' of
                                 Just CObj
obj -> forall a. a -> Maybe a
Just (CObj
obj, Ident
ide')
                                 Maybe CObj
Nothing  -> 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 AttrC
ac Ident
ide CTag
obj  = let tm :: CTagNS
tm          = AttrC -> CTagNS
defTagsAC AttrC
ac
                             (CTagNS
ac', Maybe CTag
obj') = 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 AttrC
ac Ident
ide  = 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 AttrC
ac Ident
ide  = 
  case AttrC -> Ident -> Maybe CTag
lookupDefTagC AttrC
ac Ident
ide of
    Just CTag
tag -> forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
    Maybe CTag
Nothing  -> case forall a. NameSpace a -> Ident -> Maybe a
find (AttrC -> CShadowNS
shadowsAC AttrC
ac) Ident
ide of
                  Maybe Ident
Nothing   -> forall a. Maybe a
Nothing
                  Just Ident
ide' -> case AttrC -> Ident -> Maybe CTag
lookupDefTagC AttrC
ac Ident
ide' of
                                 Just CTag
tag -> forall a. a -> Maybe a
Just (CTag
tag, Ident
ide')
                                 Maybe CTag
Nothing  -> 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 AttrC
ac String
prefix  =
  let 
    shadows :: CShadowNS
shadows    = AttrC -> CShadowNS
shadowsAC AttrC
ac
    names :: [Ident]
names      =    forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. NameSpace a -> [(Ident, a)]
nameSpaceToList (AttrC -> CObjNS
defObjsAC AttrC
ac))
                 forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst (forall a. NameSpace a -> [(Ident, a)]
nameSpaceToList (AttrC -> CTagNS
defTagsAC AttrC
ac))
    newShadows :: [(Ident, Ident)]
newShadows = 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 = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}. NameSpace a -> (Ident, a) -> NameSpace a
define CShadowNS
shadows [(Ident, Ident)]
newShadows}
  where
    strip :: String -> Ident -> Maybe (Ident, Ident)
strip String
prefix Ident
ide = case String -> String -> Maybe String
eat String
prefix (Ident -> String
identToLexeme Ident
ide) of
                         Maybe String
Nothing      -> forall a. Maybe a
Nothing
                         Just String
""      -> forall a. Maybe a
Nothing
                         Just String
newName -> forall a. a -> Maybe a
Just 
                                           (Position -> String -> Ident
onlyPosIdent (forall a. Pos a => a -> Position
posOf Ident
ide) String
newName,
                                            Ident
ide)
    --
    eat :: String -> String -> Maybe String
eat []         (Char
'_':String
cs)                        = String -> String -> Maybe String
eat [] String
cs
    eat []         String
cs                              = forall a. a -> Maybe a
Just String
cs
    eat (Char
p:String
prefix) (Char
c:String
cs) | Char -> Char
toUpper Char
p forall a. Eq a => a -> a -> Bool
== Char -> Char
toUpper Char
c = String -> String -> Maybe String
eat String
prefix String
cs
                          | Bool
otherwise              = forall a. Maybe a
Nothing
    eat String
_          String
_                               = forall a. Maybe a
Nothing
    --
    define :: NameSpace a -> (Ident, a) -> NameSpace a
define NameSpace a
ns (Ident
ide, a
def) = forall a b. (a, b) -> a
fst (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 AttrC
ac  = forall a. Attr a => AttrTable a -> Attrs -> a
getAttr (AttrC -> CDefTable
defsAC AttrC
ac) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> Attrs
getIdentAttrs

setDefOfIdentC           :: AttrC -> Ident -> CDef -> AttrC
setDefOfIdentC :: AttrC -> Ident -> CDef -> AttrC
setDefOfIdentC AttrC
ac Ident
id CDef
def  = 
  let tot' :: CDefTable
tot' = 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 AttrC
ac Ident
id CDef
def  = 
  let tot' :: CDefTable
tot' = 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 AttrC
ac  = AttrC
ac {defsAC :: CDefTable
defsAC = forall a. Attr a => AttrTable a -> AttrTable a
freezeAttrTable (AttrC -> CDefTable
defsAC AttrC
ac)}

softenDefOfIdentsAttrC    :: AttrC -> AttrC
softenDefOfIdentsAttrC :: AttrC -> AttrC
softenDefOfIdentsAttrC AttrC
ac  = AttrC
ac {defsAC :: CDefTable
defsAC = 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 CDecl
decl1     ) == :: CObj -> CObj -> Bool
== (TypeCO CDecl
decl2     ) = CDecl
decl1 forall a. Eq a => a -> a -> Bool
== CDecl
decl2
  (ObjCO  CDecl
decl1     ) == (ObjCO  CDecl
decl2     ) = CDecl
decl1 forall a. Eq a => a -> a -> Bool
== CDecl
decl2
  (EnumCO Ident
ide1 CEnum
enum1) == (EnumCO Ident
ide2 CEnum
enum2) = Ident
ide1 forall a. Eq a => a -> a -> Bool
== Ident
ide2 Bool -> Bool -> Bool
&& CEnum
enum1 forall a. Eq a => a -> a -> Bool
== CEnum
enum2
  CObj
_                   == CObj
_                   = Bool
False

instance Pos CObj where
  posOf :: CObj -> Position
posOf (TypeCO    CDecl
def  ) = forall a. Pos a => a -> Position
posOf CDecl
def
  posOf (ObjCO     CDecl
def  ) = forall a. Pos a => a -> Position
posOf CDecl
def
  posOf (EnumCO    Ident
ide CEnum
_) = 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 CStructUnion
struct1) == :: CTag -> CTag -> Bool
== (StructUnionCT CStructUnion
struct2) = CStructUnion
struct1 forall a. Eq a => a -> a -> Bool
== CStructUnion
struct2
  (EnumCT        CEnum
enum1  ) == (EnumCT        CEnum
enum2  ) = CEnum
enum1 forall a. Eq a => a -> a -> Bool
== CEnum
enum2
  CTag
_                       == CTag
_                       = Bool
False

instance Pos CTag where
  posOf :: CTag -> Position
posOf (StructUnionCT CStructUnion
def) = forall a. Pos a => a -> Position
posOf CStructUnion
def
  posOf (EnumCT        CEnum
def) = 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 CObj
obj1) == :: CDef -> CDef -> Bool
== (ObjCD CObj
obj2) = CObj
obj1 forall a. Eq a => a -> a -> Bool
== CObj
obj2
  (TagCD CTag
tag1) == (TagCD CTag
tag2) = CTag
tag1 forall a. Eq a => a -> a -> Bool
== CTag
tag2
  CDef
DontCareCD   == CDef
_            = Bool
True
  CDef
_            == CDef
DontCareCD   = Bool
True
  CDef
UndefCD      == CDef
_            = 
    forall a. String -> a
interr String
"CAttrs: Attempt to compare an undefined C definition!"
  CDef
_            == CDef
UndefCD      = 
    forall a. String -> a
interr String
"CAttrs: Attempt to compare an undefined C definition!"
  CDef
_            == CDef
_            = Bool
False

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

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

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

instance Pos CDef where
  posOf :: CDef -> Position
posOf CDef
UndefCD     = Position
nopos
  posOf CDef
DontCareCD  = Position
dontCarePos
  posOf (ObjCD CObj
obj) = forall a. Pos a => a -> Position
posOf CObj
obj
  posOf (TagCD CTag
tag) = 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  = forall a. NameSpace a
nameSpace

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

-- creating a new tag name space
--
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  = forall a. NameSpace a
nameSpace

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

-- creating a new definition table
--
cDefTable :: CDefTable
cDefTable :: CDefTable
cDefTable  = forall a. Attr a => String -> AttrTable a
newAttrTable String
"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_ BinHandle
bh (AttrC CHeader
aa CObjNS
ab CTagNS
ac CShadowNS
ad CDefTable
ae) = do
--          put_ bh aa
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CObjNS
ab
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CTagNS
ac
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CShadowNS
ad
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh CDefTable
ae
    get :: BinHandle -> IO AttrC
get BinHandle
bh = do
--    aa <- get bh
    CObjNS
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    CTagNS
ac <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    CShadowNS
ad <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    CDefTable
ae <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    forall (m :: * -> *) a. Monad m => a -> m a
return (CHeader -> CObjNS -> CTagNS -> CShadowNS -> CDefTable -> AttrC
AttrC (forall a. HasCallStack => String -> a
error String
"AttrC.headerAC should not be needed") CObjNS
ab CTagNS
ac CShadowNS
ad CDefTable
ae)

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

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

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