module CAttrs (
AttrC, attrC, getCHeader, enterNewRangeC, enterNewObjRangeC,
leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC,
lookupDefObjCShadow, addDefTagC, lookupDefTagC,
lookupDefTagCShadow, applyPrefix, getDefOfIdentC,
setDefOfIdentC, updDefOfIdentC, freezeDefOfIdentsAttrC,
softenDefOfIdentsAttrC,
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
data AttrC = AttrC {
:: CHeader,
AttrC -> CObjNS
defObjsAC :: CObjNS,
AttrC -> CTagNS
defTagsAC :: CTagNS,
AttrC -> CShadowNS
shadowsAC :: CShadowNS,
AttrC -> CDefTable
defsAC :: CDefTable
}
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
}
getCHeader :: AttrC -> CHeader
= AttrC -> CHeader
headerAC
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
}
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
}
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
}
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
}
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')
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
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
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')
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
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
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)
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)}
data CObj = TypeCO CDecl
| ObjCO CDecl
| EnumCO Ident CEnum
| BuiltinCO
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
data CTag = StructUnionCT CStructUnion
| EnumCT CEnum
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
data CDef = UndefCD
| DontCareCD
| ObjCD CObj
| TagCD CTag
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
type CObjNS = NameSpace CObj
cObjNS :: CObjNS
cObjNS :: CObjNS
cObjNS = CObjNS
forall a. NameSpace a
nameSpace
type CTagNS = NameSpace CTag
cTagNS :: CTagNS
cTagNS :: CTagNS
cTagNS = CTagNS
forall a. NameSpace a
nameSpace
type CShadowNS = NameSpace Ident
cShadowNS :: CShadowNS
cShadowNS :: CShadowNS
cShadowNS = CShadowNS
forall a. NameSpace a
nameSpace
type CDefTable = AttrTable CDef
cDefTable :: CDefTable
cDefTable :: CDefTable
cDefTable = String -> CDefTable
forall a. Attr a => String -> AttrTable a
newAttrTable "C General Definition Table for Idents"
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
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
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)