module CTrav (CT, readCT, transCT, getCHeaderCT, runCT, throwCTExc, ifCTExc,
raiseErrorCTExc,
enter, enterObjs, leave, leaveObjs, defObj, findObj,
findObjShadow, defTag, findTag, findTagShadow,
applyPrefixToNameSpaces, getDefOf, refersToDef, refersToNewDef,
getDeclOf, findTypeObjMaybe, findTypeObj, findValueObj,
findFunObj,
isTypedef, simplifyDecl, declrFromDecl, declrNamed,
declaredDeclr, declaredName, structMembers, expandDecl,
structName, enumName, tagName, isArrDeclr, isPtrDeclr, dropPtrDeclr,
isPtrDecl, isFunDeclr, structFromDecl, funResultAndArgs,
chaseDecl, findAndChaseDecl, checkForAlias,
checkForOneAliasName, lookupEnum, lookupStructUnion,
lookupDeclOrTag)
where
import Data.List (find)
import Data.Maybe (fromMaybe)
import Control.Monad (liftM)
import Control.Exception (assert)
import Position (Position, Pos(..), nopos)
import Errors (interr)
import Idents (Ident, dumpIdent, identToLexeme)
import Attributes (Attr(..), newAttrsOnlyPos)
import C2HSState (CST, nop, readCST, transCST, runCST, raiseError, catchExc,
throwExc, Traces(..), putTraceStr)
import CAST
import CAttrs (AttrC, getCHeader, enterNewRangeC, enterNewObjRangeC,
leaveRangeC, leaveObjRangeC, addDefObjC, lookupDefObjC,
lookupDefObjCShadow, addDefTagC, lookupDefTagC,
lookupDefTagCShadow, applyPrefix, getDefOfIdentC,
setDefOfIdentC, updDefOfIdentC, CObj(..), CTag(..),
CDef(..))
type CState s = (AttrC, s)
type CT s a = CST (CState s) a
readAttrCCT :: (AttrC -> a) -> CT s a
readAttrCCT :: (AttrC -> a) -> CT s a
readAttrCCT AttrC -> a
reader = ((AttrC, s) -> a) -> CT s a
forall s a e. (s -> a) -> PreCST e s a
readCST (((AttrC, s) -> a) -> CT s a) -> ((AttrC, s) -> a) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(AttrC
ac, s
_) -> AttrC -> a
reader AttrC
ac
transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT AttrC -> (AttrC, a)
trans = ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall s a e. (s -> (s, a)) -> PreCST e s a
transCST (((AttrC, s) -> ((AttrC, s), a)) -> CT s a)
-> ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(AttrC
ac, s
s) -> let
(AttrC
ac', a
r) = AttrC -> (AttrC, a)
trans AttrC
ac
in
((AttrC
ac', s
s), a
r)
readCT :: (s -> a) -> CT s a
readCT :: (s -> a) -> CT s a
readCT s -> a
reader = ((AttrC, s) -> a) -> CT s a
forall s a e. (s -> a) -> PreCST e s a
readCST (((AttrC, s) -> a) -> CT s a) -> ((AttrC, s) -> a) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(AttrC
_, s
s) -> s -> a
reader s
s
transCT :: (s -> (s, a)) -> CT s a
transCT :: (s -> (s, a)) -> CT s a
transCT s -> (s, a)
trans = ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall s a e. (s -> (s, a)) -> PreCST e s a
transCST (((AttrC, s) -> ((AttrC, s), a)) -> CT s a)
-> ((AttrC, s) -> ((AttrC, s), a)) -> CT s a
forall a b. (a -> b) -> a -> b
$ \(AttrC
ac, s
s) -> let
(s
s', a
r) = s -> (s, a)
trans s
s
in
((AttrC
ac, s
s'), a
r)
getCHeaderCT :: CT s CHeader
= (AttrC -> CHeader) -> CT s CHeader
forall a s. (AttrC -> a) -> CT s a
readAttrCCT AttrC -> CHeader
getCHeader
runCT :: CT s a -> AttrC -> s -> CST t (AttrC, a)
runCT :: CT s a -> AttrC -> s -> CST t (AttrC, a)
runCT CT s a
m AttrC
ac s
s = PreCST SwitchBoard (CState s) (AttrC, a)
-> CState s -> CST t (AttrC, a)
forall e s a s'. PreCST e s a -> s -> PreCST e s' a
runCST PreCST SwitchBoard (CState s) (AttrC, a)
m' (AttrC
ac, s
s)
where
m' :: PreCST SwitchBoard (CState s) (AttrC, a)
m' = do
a
r <- CT s a
m
(AttrC
ac, s
_) <- (CState s -> CState s) -> PreCST SwitchBoard (CState s) (CState s)
forall s a e. (s -> a) -> PreCST e s a
readCST CState s -> CState s
forall a. a -> a
id
(AttrC, a) -> PreCST SwitchBoard (CState s) (AttrC, a)
forall (m :: * -> *) a. Monad m => a -> m a
return (AttrC
ac, a
r)
ctExc :: String
ctExc :: String
ctExc = String
"ctExc"
throwCTExc :: CT s a
throwCTExc :: CT s a
throwCTExc = String -> String -> CT s a
forall e s a. String -> String -> PreCST e s a
throwExc String
ctExc String
"Error during traversal of a C structure tree"
ifCTExc :: CT s a -> CT s a -> CT s a
ifCTExc :: CT s a -> CT s a -> CT s a
ifCTExc CT s a
m CT s a
handler = CT s a
m CT s a -> (String, String -> CT s a) -> CT s a
forall e s a.
PreCST e s a -> (String, String -> PreCST e s a) -> PreCST e s a
`catchExc` (String
ctExc, CT s a -> String -> CT s a
forall a b. a -> b -> a
const CT s a
handler)
raiseErrorCTExc :: Position -> [String] -> CT s a
raiseErrorCTExc :: Position -> [String] -> CT s a
raiseErrorCTExc Position
pos [String]
errs = Position -> [String] -> PreCST SwitchBoard (CState s) ()
forall e s. Position -> [String] -> PreCST e s ()
raiseError Position
pos [String]
errs PreCST SwitchBoard (CState s) () -> CT s a -> CT s a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> CT s a
forall s a. CT s a
throwCTExc
enter :: CT s ()
enter :: CT s ()
enter = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> (AttrC -> AttrC
enterNewRangeC AttrC
ac, ())
enterObjs :: CT s ()
enterObjs :: CT s ()
enterObjs = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> (AttrC -> AttrC
enterNewObjRangeC AttrC
ac, ())
leave :: CT s ()
leave :: CT s ()
leave = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> (AttrC -> AttrC
leaveRangeC AttrC
ac, ())
leaveObjs :: CT s ()
leaveObjs :: CT s ()
leaveObjs = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> (AttrC -> AttrC
leaveObjRangeC AttrC
ac, ())
defObj :: Ident -> CObj -> CT s (Maybe CObj)
defObj :: Ident -> CObj -> CT s (Maybe CObj)
defObj Ident
ide CObj
obj = (AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj))
-> (AttrC -> (AttrC, Maybe CObj)) -> CT s (Maybe CObj)
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> CObj -> (AttrC, Maybe CObj)
addDefObjC AttrC
ac Ident
ide CObj
obj
findObj :: Ident -> CT s (Maybe CObj)
findObj :: Ident -> CT s (Maybe CObj)
findObj Ident
ide = (AttrC -> Maybe CObj) -> CT s (Maybe CObj)
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe CObj) -> CT s (Maybe CObj))
-> (AttrC -> Maybe CObj) -> CT s (Maybe CObj)
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> Maybe CObj
lookupDefObjC AttrC
ac Ident
ide
findObjShadow :: Ident -> CT s (Maybe (CObj, Ident))
findObjShadow :: Ident -> CT s (Maybe (CObj, Ident))
findObjShadow Ident
ide = (AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident))
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident)))
-> (AttrC -> Maybe (CObj, Ident)) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> Maybe (CObj, Ident)
lookupDefObjCShadow AttrC
ac Ident
ide
defTag :: Ident -> CTag -> CT s (Maybe CTag)
defTag :: Ident -> CTag -> CT s (Maybe CTag)
defTag Ident
ide CTag
tag =
do
Maybe CTag
otag <- (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag))
-> (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
addDefTagC AttrC
ac Ident
ide CTag
tag
case Maybe CTag
otag of
Maybe CTag
Nothing -> do
CTag -> CT s ()
forall s. CTag -> CT s ()
assertIfEnumThenFull CTag
tag
Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
forall a. Maybe a
Nothing
Just CTag
prevTag -> case CTag -> CTag -> Maybe (CTag, Ident)
isRefinedOrUse CTag
prevTag CTag
tag of
Maybe (CTag, Ident)
Nothing -> Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
otag
Just (CTag
fullTag, Ident
foreIde) -> do
(AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag))
-> (AttrC -> (AttrC, Maybe CTag)) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
addDefTagC AttrC
ac Ident
ide CTag
fullTag
Ident
foreIde Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToDef` CTag -> CDef
TagCD CTag
fullTag
Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
forall a. Maybe a
Nothing
where
isRefinedOrUse :: CTag -> CTag -> Maybe (CTag, Ident)
isRefinedOrUse (StructUnionCT (CStruct CStructTag
_ (Just Ident
ide) [] Attrs
_))
tag :: CTag
tag@(StructUnionCT (CStruct CStructTag
_ (Just Ident
_ ) [CDecl]
_ Attrs
_)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse tag :: CTag
tag@(StructUnionCT (CStruct CStructTag
_ (Just Ident
_ ) [CDecl]
_ Attrs
_))
(StructUnionCT (CStruct CStructTag
_ (Just Ident
ide) [] Attrs
_)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse tag :: CTag
tag@(EnumCT (CEnum (Just Ident
_ ) [(Ident, Maybe CExpr)]
_ Attrs
_))
(EnumCT (CEnum (Just Ident
ide) [] Attrs
_)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse CTag
_ CTag
_ = Maybe (CTag, Ident)
forall a. Maybe a
Nothing
findTag :: Ident -> CT s (Maybe CTag)
findTag :: Ident -> CT s (Maybe CTag)
findTag Ident
ide = (AttrC -> Maybe CTag) -> CT s (Maybe CTag)
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe CTag) -> CT s (Maybe CTag))
-> (AttrC -> Maybe CTag) -> CT s (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> Maybe CTag
lookupDefTagC AttrC
ac Ident
ide
findTagShadow :: Ident -> CT s (Maybe (CTag, Ident))
findTagShadow :: Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide = (AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident))
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident)))
-> (AttrC -> Maybe (CTag, Ident)) -> CT s (Maybe (CTag, Ident))
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> Maybe (CTag, Ident)
lookupDefTagCShadow AttrC
ac Ident
ide
applyPrefixToNameSpaces :: String -> CT s ()
applyPrefixToNameSpaces :: String -> CT s ()
applyPrefixToNameSpaces String
prefix =
(AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> (AttrC -> String -> AttrC
applyPrefix AttrC
ac String
prefix, ())
getDefOf :: Ident -> CT s CDef
getDefOf :: Ident -> CT s CDef
getDefOf Ident
ide = do
CDef
def <- (AttrC -> CDef) -> CT s CDef
forall a s. (AttrC -> a) -> CT s a
readAttrCCT ((AttrC -> CDef) -> CT s CDef) -> (AttrC -> CDef) -> CT s CDef
forall a b. (a -> b) -> a -> b
$ \AttrC
ac -> AttrC -> Ident -> CDef
getDefOfIdentC AttrC
ac Ident
ide
Bool -> CT s CDef -> CT s CDef
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not (Bool -> Bool) -> (CDef -> Bool) -> CDef -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CDef -> Bool
forall a. Attr a => a -> Bool
isUndef (CDef -> Bool) -> CDef -> Bool
forall a b. (a -> b) -> a -> b
$ CDef
def) (CT s CDef -> CT s CDef) -> CT s CDef -> CT s CDef
forall a b. (a -> b) -> a -> b
$
CDef -> CT s CDef
forall (m :: * -> *) a. Monad m => a -> m a
return CDef
def
refersToDef :: Ident -> CDef -> CT s ()
refersToDef :: Ident -> CDef -> CT s ()
refersToDef Ident
ide CDef
def = (AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
setDefOfIdentC AttrC
akl Ident
ide CDef
def, ())
refersToNewDef :: Ident -> CDef -> CT s ()
refersToNewDef :: Ident -> CDef -> CT s ()
refersToNewDef Ident
ide CDef
def =
(AttrC -> (AttrC, ())) -> CT s ()
forall a s. (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT ((AttrC -> (AttrC, ())) -> CT s ())
-> (AttrC -> (AttrC, ())) -> CT s ()
forall a b. (a -> b) -> a -> b
$ \AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
updDefOfIdentC AttrC
akl Ident
ide CDef
def, ())
getDeclOf :: Ident -> CT s CDecl
getDeclOf :: Ident -> CT s CDecl
getDeclOf Ident
ide =
do
CT s ()
forall s. CT s ()
traceEnter
CDef
def <- Ident -> CT s CDef
forall s. Ident -> CT s CDef
getDefOf Ident
ide
case CDef
def of
CDef
UndefCD -> String -> CT s CDecl
forall a. String -> a
interr String
"CTrav.getDeclOf: Undefined!"
CDef
DontCareCD -> String -> CT s CDecl
forall a. String -> a
interr String
"CTrav.getDeclOf: Don't care!"
TagCD CTag
_ -> String -> CT s CDecl
forall a. String -> a
interr String
"CTrav.getDeclOf: Illegal tag!"
ObjCD CObj
obj -> case CObj
obj of
TypeCO CDecl
decl -> CT s ()
forall s. CT s ()
traceTypeCO CT s () -> CT s CDecl -> CT s CDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
decl
ObjCO CDecl
decl -> CT s ()
forall s. CT s ()
traceObjCO CT s () -> CT s CDecl -> CT s CDecl
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
decl
EnumCO Ident
_ CEnum
_ -> CT s CDecl
forall a. a
illegalEnum
CObj
BuiltinCO -> CT s CDecl
forall a. a
illegalBuiltin
where
illegalEnum :: a
illegalEnum = String -> a
forall a. String -> a
interr String
"CTrav.getDeclOf: Illegal enum!"
illegalBuiltin :: a
illegalBuiltin = String -> a
forall a. String -> a
interr String
"CTrav.getDeclOf: Attempted to get declarator of \
\builtin entity!"
traceEnter :: CT s ()
traceEnter = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$
String
"Entering `getDeclOf' for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"'...\n"
traceTypeCO :: CT s ()
traceTypeCO = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$
String
"...found a type object.\n"
traceObjCO :: CT s ()
traceObjCO = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$
String
"...found a vanilla object.\n"
findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe Ident
ide Bool
useShadows =
do
Maybe (CObj, Ident)
oobj <- if Bool
useShadows
then Ident -> CT s (Maybe (CObj, Ident))
forall s. Ident -> CT s (Maybe (CObj, Ident))
findObjShadow Ident
ide
else (Maybe CObj -> Maybe (CObj, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((CObj -> (CObj, Ident)) -> Maybe CObj -> Maybe (CObj, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CObj
obj -> (CObj
obj, Ident
ide))) (PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident)))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe CObj)
forall s. Ident -> CT s (Maybe CObj)
findObj Ident
ide
case Maybe (CObj, Ident)
oobj of
Just obj :: (CObj, Ident)
obj@(TypeCO CDecl
_ , Ident
_) -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ (CObj, Ident) -> Maybe (CObj, Ident)
forall a. a -> Maybe a
Just (CObj, Ident)
obj
Just obj :: (CObj, Ident)
obj@(CObj
BuiltinCO, Ident
_) -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ (CObj, Ident) -> Maybe (CObj, Ident)
forall a. a -> Maybe a
Just (CObj, Ident)
obj
Just (CObj, Ident)
_ -> Ident -> CT s (Maybe (CObj, Ident))
forall s a. Ident -> CT s a
typedefExpectedErr Ident
ide
Maybe (CObj, Ident)
Nothing -> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident)))
-> Maybe (CObj, Ident) -> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Maybe (CObj, Ident)
forall a. Maybe a
Nothing
findTypeObj :: Ident -> Bool -> CT s (CObj, Ident)
findTypeObj :: Ident -> Bool -> CT s (CObj, Ident)
findTypeObj Ident
ide Bool
useShadows = do
Maybe (CObj, Ident)
oobj <- Ident -> Bool -> CT s (Maybe (CObj, Ident))
forall s. Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe Ident
ide Bool
useShadows
case Maybe (CObj, Ident)
oobj of
Maybe (CObj, Ident)
Nothing -> Ident -> CT s (CObj, Ident)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
Just (CObj, Ident)
obj -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
findValueObj :: Ident -> Bool -> CT s (CObj, Ident)
findValueObj :: Ident -> Bool -> CT s (CObj, Ident)
findValueObj Ident
ide Bool
useShadows =
do
Maybe (CObj, Ident)
oobj <- if Bool
useShadows
then Ident -> CT s (Maybe (CObj, Ident))
forall s. Ident -> CT s (Maybe (CObj, Ident))
findObjShadow Ident
ide
else (Maybe CObj -> Maybe (CObj, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM ((CObj -> (CObj, Ident)) -> Maybe CObj -> Maybe (CObj, Ident)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\CObj
obj -> (CObj
obj, Ident
ide))) (PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident)))
-> PreCST SwitchBoard (CState s) (Maybe CObj)
-> CT s (Maybe (CObj, Ident))
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe CObj)
forall s. Ident -> CT s (Maybe CObj)
findObj Ident
ide
case Maybe (CObj, Ident)
oobj of
Just obj :: (CObj, Ident)
obj@(ObjCO CDecl
_ , Ident
_) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
Just obj :: (CObj, Ident)
obj@(EnumCO Ident
_ CEnum
_, Ident
_) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
Just (CObj, Ident)
_ -> Position -> CT s (CObj, Ident)
forall s a. Position -> CT s a
unexpectedTypedefErr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
Maybe (CObj, Ident)
Nothing -> Ident -> CT s (CObj, Ident)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
findFunObj :: Ident -> Bool -> CT s (CObj, Ident)
findFunObj :: Ident -> Bool -> CT s (CObj, Ident)
findFunObj Ident
ide Bool
useShadows =
do
(CObj
obj, Ident
ide') <- Ident -> Bool -> CT s (CObj, Ident)
forall s. Ident -> Bool -> CT s (CObj, Ident)
findValueObj Ident
ide Bool
useShadows
case CObj
obj of
EnumCO Ident
_ CEnum
_ -> Position -> CT s (CObj, Ident)
forall s a. Position -> CT s a
funExpectedErr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
ObjCO CDecl
decl -> do
let declr :: CDeclr
declr = Ident
ide' Ident -> CDecl -> CDeclr
`declrFromDecl` CDecl
decl
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) CDeclr
declr
(CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj
obj, Ident
ide')
isTypedef :: CDecl -> Bool
isTypedef :: CDecl -> Bool
isTypedef (CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
_ Attrs
_) =
Bool -> Bool
not (Bool -> Bool) -> ([()] -> Bool) -> [()] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [()] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([()] -> Bool) -> [()] -> Bool
forall a b. (a -> b) -> a -> b
$ [() | CStorageSpec (CTypedef Attrs
_) <- [CDeclSpec]
specs]
simplifyDecl :: Ident -> CDecl -> CDecl
Ident
ide simplifyDecl :: Ident -> CDecl -> CDecl
`simplifyDecl` (CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
declrs Attrs
at) =
case ((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Bool)
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
-> Maybe (Maybe CDeclr, Maybe CInit, Maybe CExpr)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find ((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> Ident -> Bool
forall b c. (Maybe CDeclr, b, c) -> Ident -> Bool
`declrPlusNamed` Ident
ide) [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
declrs of
Maybe (Maybe CDeclr, Maybe CInit, Maybe CExpr)
Nothing -> CDecl
forall a. a
err
Just (Maybe CDeclr, Maybe CInit, Maybe CExpr)
declr -> [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)
declr] Attrs
at
where
(Just CDeclr
declr, b
_, c
_) declrPlusNamed :: (Maybe CDeclr, b, c) -> Ident -> Bool
`declrPlusNamed` Ident
ide = CDeclr
declr CDeclr -> Ident -> Bool
`declrNamed` Ident
ide
(Maybe CDeclr, b, c)
_ `declrPlusNamed` Ident
_ = Bool
False
err :: a
err = String -> a
forall a. String -> a
interr (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"CTrav.simplifyDecl: Wrong C object!\n\
\ Looking for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' in decl \
\at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)
declrFromDecl :: Ident -> CDecl -> CDeclr
Ident
ide declrFromDecl :: Ident -> CDecl -> CDeclr
`declrFromDecl` CDecl
decl =
let CDecl [CDeclSpec]
_ [(Just CDeclr
declr, Maybe CInit
_, Maybe CExpr
_)] Attrs
_ = Ident
ide Ident -> CDecl -> CDecl
`simplifyDecl` CDecl
decl
in
CDeclr
declr
declrNamed :: CDeclr -> Ident -> Bool
CDeclr
declr declrNamed :: CDeclr -> Ident -> Bool
`declrNamed` Ident
ide = CDeclr -> Maybe Ident
declrName CDeclr
declr Maybe Ident -> Maybe Ident -> Bool
forall a. Eq a => a -> a -> Bool
== Ident -> Maybe Ident
forall a. a -> Maybe a
Just Ident
ide
declaredDeclr :: CDecl -> Maybe CDeclr
declaredDeclr :: CDecl -> Maybe CDeclr
declaredDeclr (CDecl [CDeclSpec]
_ [] Attrs
_) = Maybe CDeclr
forall a. Maybe a
Nothing
declaredDeclr (CDecl [CDeclSpec]
_ [(Maybe CDeclr
odeclr, Maybe CInit
_, Maybe CExpr
_)] Attrs
_) = Maybe CDeclr
odeclr
declaredDeclr CDecl
decl =
String -> Maybe CDeclr
forall a. String -> a
interr (String -> Maybe CDeclr) -> String -> Maybe CDeclr
forall a b. (a -> b) -> a -> b
$ String
"CTrav.declaredDeclr: Too many declarators!\n\
\ Declaration at " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Position -> String
forall a. Show a => a -> String
show (CDecl -> Position
forall a. Pos a => a -> Position
posOf CDecl
decl)
declaredName :: CDecl -> Maybe Ident
declaredName :: CDecl -> Maybe Ident
declaredName CDecl
decl = CDecl -> Maybe CDeclr
declaredDeclr CDecl
decl Maybe CDeclr -> (CDeclr -> Maybe Ident) -> Maybe Ident
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= CDeclr -> Maybe Ident
declrName
structMembers :: CStructUnion -> ([CDecl], CStructTag)
structMembers :: CStructUnion -> ([CDecl], CStructTag)
structMembers (CStruct CStructTag
tag Maybe Ident
_ [CDecl]
members Attrs
_) = ([[CDecl]] -> [CDecl]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[CDecl]] -> [CDecl])
-> ([CDecl] -> [[CDecl]]) -> [CDecl] -> [CDecl]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CDecl -> [CDecl]) -> [CDecl] -> [[CDecl]]
forall a b. (a -> b) -> [a] -> [b]
map CDecl -> [CDecl]
expandDecl ([CDecl] -> [CDecl]) -> [CDecl] -> [CDecl]
forall a b. (a -> b) -> a -> b
$ [CDecl]
members,
CStructTag
tag)
expandDecl :: CDecl -> [CDecl]
expandDecl :: CDecl -> [CDecl]
expandDecl (CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls Attrs
at) =
((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> CDecl)
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> [CDecl]
forall a b. (a -> b) -> [a] -> [b]
map (\(Maybe CDeclr, Maybe CInit, Maybe CExpr)
decl -> [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)
decl] Attrs
at) [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls
structName :: CStructUnion -> Maybe Ident
structName :: CStructUnion -> Maybe Ident
structName (CStruct CStructTag
_ Maybe Ident
oide [CDecl]
_ Attrs
_) = Maybe Ident
oide
enumName :: CEnum -> Maybe Ident
enumName :: CEnum -> Maybe Ident
enumName (CEnum Maybe Ident
oide [(Ident, Maybe CExpr)]
_ Attrs
_) = Maybe Ident
oide
tagName :: CTag -> Ident
tagName :: CTag -> Ident
tagName CTag
tag =
case CTag
tag of
StructUnionCT CStructUnion
struct -> Ident -> (Ident -> Ident) -> Maybe Ident -> Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ident
forall a. a
err Ident -> Ident
forall a. a -> a
id (Maybe Ident -> Ident) -> Maybe Ident -> Ident
forall a b. (a -> b) -> a -> b
$ CStructUnion -> Maybe Ident
structName CStructUnion
struct
EnumCT CEnum
enum -> Ident -> (Ident -> Ident) -> Maybe Ident -> Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Ident
forall a. a
err Ident -> Ident
forall a. a -> a
id (Maybe Ident -> Ident) -> Maybe Ident -> Ident
forall a b. (a -> b) -> a -> b
$ CEnum -> Maybe Ident
enumName CEnum
enum
where
err :: a
err = String -> a
forall a. String -> a
interr String
"CTrav.tagName: Anonymous tag definition"
isPtrDeclr :: CDeclr -> Bool
isPtrDeclr :: CDeclr -> Bool
isPtrDeclr (CPtrDeclr [CTypeQual]
_ (CVarDeclr Maybe Ident
_ Attrs
_) Attrs
_) = Bool
True
isPtrDeclr (CPtrDeclr [CTypeQual]
_ CDeclr
declr Attrs
_) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CArrDeclr (CVarDeclr Maybe Ident
_ Attrs
_) [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = Bool
True
isPtrDeclr (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CFunDeclr CDeclr
declr [CDecl]
_ Bool
_ Attrs
_) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr CDeclr
_ = Bool
False
isArrDeclr :: CDeclr -> Bool
isArrDeclr :: CDeclr -> Bool
isArrDeclr (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = Bool
True
isArrDeclr CDeclr
_ = Bool
False
dropPtrDeclr :: CDeclr -> CDeclr
dropPtrDeclr :: CDeclr -> CDeclr
dropPtrDeclr (CPtrDeclr [CTypeQual]
qs declr :: CDeclr
declr@(CVarDeclr Maybe Ident
_ Attrs
_) Attrs
ats) = CDeclr
declr
dropPtrDeclr (CPtrDeclr [CTypeQual]
qs CDeclr
declr Attrs
ats) =
let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
in
[CTypeQual] -> CDeclr -> Attrs -> CDeclr
CPtrDeclr [CTypeQual]
qs CDeclr
declr' Attrs
ats
dropPtrDeclr (CArrDeclr declr :: CDeclr
declr@(CVarDeclr Maybe Ident
_ Attrs
_) [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = CDeclr
declr
dropPtrDeclr (CArrDeclr CDeclr
declr [CTypeQual]
tq Maybe CExpr
e Attrs
ats) =
let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
in
CDeclr -> [CTypeQual] -> Maybe CExpr -> Attrs -> CDeclr
CArrDeclr CDeclr
declr' [CTypeQual]
tq Maybe CExpr
e Attrs
ats
dropPtrDeclr (CFunDeclr CDeclr
declr [CDecl]
args Bool
vari Attrs
ats) =
let declr' :: CDeclr
declr' = CDeclr -> CDeclr
dropPtrDeclr CDeclr
declr
in
CDeclr -> [CDecl] -> Bool -> Attrs -> CDeclr
CFunDeclr CDeclr
declr' [CDecl]
args Bool
vari Attrs
ats
dropPtrDeclr CDeclr
_ =
String -> CDeclr
forall a. String -> a
interr String
"CTrav.dropPtrDeclr: No pointer!"
isPtrDecl :: CDecl -> Bool
isPtrDecl :: CDecl -> Bool
isPtrDecl (CDecl [CDeclSpec]
_ [] Attrs
_) = Bool
False
isPtrDecl (CDecl [CDeclSpec]
_ [(Just CDeclr
declr, Maybe CInit
_, Maybe CExpr
_)] Attrs
_) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDecl CDecl
_ =
String -> Bool
forall a. String -> a
interr String
"CTrav.isPtrDecl: There was more than one declarator!"
isFunDeclr :: CDeclr -> Bool
isFunDeclr :: CDeclr -> Bool
isFunDeclr (CPtrDeclr [CTypeQual]
_ CDeclr
declr Attrs
_) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CFunDeclr (CVarDeclr Maybe Ident
_ Attrs
_) [CDecl]
_ Bool
_ Attrs
_) = Bool
True
isFunDeclr (CFunDeclr CDeclr
declr [CDecl]
_ Bool
_ Attrs
_) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr CDeclr
_ = Bool
False
structFromDecl :: Position -> CDecl -> CT s CStructUnion
structFromDecl :: Position -> CDecl -> CT s CStructUnion
structFromDecl Position
pos (CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
_ Attrs
_) =
case [CTypeSpec] -> CTypeSpec
forall a. [a] -> a
head [CTypeSpec
ts | CTypeSpec CTypeSpec
ts <- [CDeclSpec]
specs] of
CSUType CStructUnion
su Attrs
_ -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos (CStructUnion -> CTag
StructUnionCT CStructUnion
su)
CTypeSpec
_ -> Position -> CT s CStructUnion
forall s a. Position -> CT s a
structExpectedErr Position
pos
funResultAndArgs :: CDecl -> ([CDecl], CDecl, Bool)
funResultAndArgs :: CDecl -> ([CDecl], CDecl, Bool)
funResultAndArgs (CDecl [CDeclSpec]
specs [(Just CDeclr
declr, Maybe CInit
_, Maybe CExpr
_)] Attrs
_) =
let ([CDecl]
args, CDeclr
declr', Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
result :: CDecl
result = [CDeclSpec]
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> Attrs -> CDecl
CDecl [CDeclSpec]
specs [(CDeclr -> Maybe CDeclr
forall a. a -> Maybe a
Just CDeclr
declr', Maybe CInit
forall a. Maybe a
Nothing, Maybe CExpr
forall a. Maybe a
Nothing)]
(Position -> Attrs
newAttrsOnlyPos Position
nopos)
in
([CDecl]
args, CDecl
result, Bool
variadic)
where
funArgs :: CDeclr -> ([CDecl], CDeclr, Bool)
funArgs (CFunDeclr var :: CDeclr
var@(CVarDeclr Maybe Ident
_ Attrs
_) [CDecl]
args Bool
variadic Attrs
_) =
([CDecl]
args, CDeclr
var, Bool
variadic)
funArgs (CPtrDeclr [CTypeQual]
qs CDeclr
declr Attrs
at) =
let ([CDecl]
args, CDeclr
declr', Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
in
([CDecl]
args, [CTypeQual] -> CDeclr -> Attrs -> CDeclr
CPtrDeclr [CTypeQual]
qs CDeclr
declr' Attrs
at, Bool
variadic)
funArgs (CArrDeclr CDeclr
declr [CTypeQual]
tqs Maybe CExpr
oe Attrs
at) =
let ([CDecl]
args, CDeclr
declr', Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
in
([CDecl]
args, CDeclr -> [CTypeQual] -> Maybe CExpr -> Attrs -> CDeclr
CArrDeclr CDeclr
declr' [CTypeQual]
tqs Maybe CExpr
oe Attrs
at, Bool
variadic)
funArgs (CFunDeclr CDeclr
declr [CDecl]
args Bool
var Attrs
at) =
let ([CDecl]
args, CDeclr
declr', Bool
variadic) = CDeclr -> ([CDecl], CDeclr, Bool)
funArgs CDeclr
declr
in
([CDecl]
args, CDeclr -> [CDecl] -> Bool -> Attrs -> CDeclr
CFunDeclr CDeclr
declr' [CDecl]
args Bool
var Attrs
at, Bool
variadic)
funArgs CDeclr
_ =
String -> ([CDecl], CDeclr, Bool)
forall a. String -> a
interr String
"CTrav.funResultAndArgs: Illegal declarator!"
chaseDecl :: Ident -> Bool -> CT s CDecl
chaseDecl :: Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide Bool
ind =
do
CT s ()
forall s. CT s ()
traceEnter
CDecl
cdecl <- Ident -> CT s CDecl
forall s. Ident -> CT s CDecl
getDeclOf Ident
ide
let sdecl :: CDecl
sdecl = Ident
ide Ident -> CDecl -> CDecl
`simplifyDecl` CDecl
cdecl
case CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
sdecl Bool
ind of
Just (Ident
ide', Bool
ind') -> Ident -> Bool -> CT s CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
ind'
Maybe (Ident, Bool)
Nothing -> CDecl -> CT s CDecl
forall (m :: * -> *) a. Monad m => a -> m a
return CDecl
sdecl
where
traceEnter :: CT s ()
traceEnter = String -> CT s ()
forall s. String -> CT s ()
traceCTrav (String -> CT s ()) -> String -> CT s ()
forall a b. (a -> b) -> a -> b
$
String
"Entering `chaseDecl' for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (if Bool
ind then String
"" else String
"not ")
String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"following indirections...\n"
findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
ind Bool
useShadows =
do
(CObj
obj, Ident
ide') <- Ident -> Bool -> CT s (CObj, Ident)
forall s. Ident -> Bool -> CT s (CObj, Ident)
findTypeObj Ident
ide Bool
useShadows
Ident
ide Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToNewDef` CObj -> CDef
ObjCD CObj
obj
Ident
ide' Ident -> CDef -> CT s ()
forall s. Ident -> CDef -> CT s ()
`refersToNewDef` CObj -> CDef
ObjCD CObj
obj
Ident -> Bool -> CT s CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
ind
checkForAlias :: CDecl -> CT s (Maybe CDecl)
checkForAlias :: CDecl -> CT s (Maybe CDecl)
checkForAlias CDecl
decl =
case CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
decl Bool
False of
Maybe (Ident, Bool)
Nothing -> Maybe CDecl -> CT s (Maybe CDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CDecl
forall a. Maybe a
Nothing
Just (Ident
ide', Bool
_) -> (CDecl -> Maybe CDecl)
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDecl -> Maybe CDecl
forall a. a -> Maybe a
Just (PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl))
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Maybe CDecl)
forall a b. (a -> b) -> a -> b
$ Ident -> Bool -> PreCST SwitchBoard (CState s) CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
False
checkForOneAliasName :: CDecl -> Maybe Ident
checkForOneAliasName :: CDecl -> Maybe Ident
checkForOneAliasName CDecl
decl = ((Ident, Bool) -> Ident) -> Maybe (Ident, Bool) -> Maybe Ident
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Ident, Bool) -> Ident
forall a b. (a, b) -> a
fst (Maybe (Ident, Bool) -> Maybe Ident)
-> Maybe (Ident, Bool) -> Maybe Ident
forall a b. (a -> b) -> a -> b
$ CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
decl Bool
False
lookupEnum :: Ident -> Bool -> CT s CEnum
lookupEnum :: Ident -> Bool -> CT s CEnum
lookupEnum Ident
ide Bool
useShadows =
do
Maybe CTag
otag <- if Bool
useShadows
then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
case Maybe CTag
otag of
Just (StructUnionCT CStructUnion
_ ) -> Ident -> CT s CEnum
forall s a. Ident -> CT s a
enumExpectedErr Ident
ide
Just (EnumCT CEnum
enum) -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum
Maybe CTag
Nothing -> do
(CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
_ Attrs
_) <- Ident -> Bool -> Bool -> CT s CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
False Bool
useShadows
case [CTypeSpec] -> CTypeSpec
forall a. [a] -> a
head [CTypeSpec
ts | CTypeSpec CTypeSpec
ts <- [CDeclSpec]
specs] of
CEnumType CEnum
enum Attrs
_ -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum
CTypeSpec
_ -> Ident -> CT s CEnum
forall s a. Ident -> CT s a
enumExpectedErr Ident
ide
lookupStructUnion :: Ident -> Bool -> Bool -> CT s CStructUnion
lookupStructUnion :: Ident -> Bool -> Bool -> CT s CStructUnion
lookupStructUnion Ident
ide Bool
ind Bool
useShadows
| Bool
ind = CT s CStructUnion
forall s. PreCST SwitchBoard (CState s) CStructUnion
chase
| Bool
otherwise =
do
Maybe CTag
otag <- if Bool
useShadows
then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
CT s CStructUnion
-> (CTag -> CT s CStructUnion) -> Maybe CTag -> CT s CStructUnion
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CT s CStructUnion
forall s. PreCST SwitchBoard (CState s) CStructUnion
chase (Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)) Maybe CTag
otag
where
chase :: PreCST SwitchBoard (CState s) CStructUnion
chase =
do
CDecl
decl <- Ident -> Bool -> Bool -> CT s CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
ind Bool
useShadows
Position -> CDecl -> PreCST SwitchBoard (CState s) CStructUnion
forall s. Position -> CDecl -> CT s CStructUnion
structFromDecl (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide) CDecl
decl
lookupDeclOrTag :: Ident -> Bool -> CT s (Either CDecl CTag)
lookupDeclOrTag :: Ident -> Bool -> CT s (Either CDecl CTag)
lookupDeclOrTag Ident
ide Bool
useShadows = do
Maybe (CObj, Ident)
oobj <- Ident -> Bool -> CT s (Maybe (CObj, Ident))
forall s. Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe Ident
ide Bool
useShadows
case Maybe (CObj, Ident)
oobj of
Just (CObj
_, Ident
ide) -> (CDecl -> Either CDecl CTag)
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CDecl -> Either CDecl CTag
forall a b. a -> Either a b
Left (PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag))
-> PreCST SwitchBoard (CState s) CDecl -> CT s (Either CDecl CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> Bool -> Bool -> PreCST SwitchBoard (CState s) CDecl
forall s. Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl Ident
ide Bool
False Bool
False
Maybe (CObj, Ident)
Nothing -> do
Maybe CTag
otag <- if Bool
useShadows
then (Maybe (CTag, Ident) -> Maybe CTag)
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (((CTag, Ident) -> CTag) -> Maybe (CTag, Ident) -> Maybe CTag
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (CTag, Ident) -> CTag
forall a b. (a, b) -> a
fst) (PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag))
-> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
-> PreCST SwitchBoard (CState s) (Maybe CTag)
forall a b. (a -> b) -> a -> b
$ Ident -> PreCST SwitchBoard (CState s) (Maybe (CTag, Ident))
forall s. Ident -> CT s (Maybe (CTag, Ident))
findTagShadow Ident
ide
else Ident -> PreCST SwitchBoard (CState s) (Maybe CTag)
forall s. Ident -> CT s (Maybe CTag)
findTag Ident
ide
case Maybe CTag
otag of
Maybe CTag
Nothing -> Ident -> CT s (Either CDecl CTag)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
Just CTag
tag -> Either CDecl CTag -> CT s (Either CDecl CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either CDecl CTag -> CT s (Either CDecl CTag))
-> Either CDecl CTag -> CT s (Either CDecl CTag)
forall a b. (a -> b) -> a -> b
$ CTag -> Either CDecl CTag
forall a b. b -> Either a b
Right CTag
tag
extractAlias :: CDecl -> Bool -> Maybe (Ident, Bool)
decl :: CDecl
decl@(CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
_ Attrs
_) Bool
ind =
case [CTypeSpec
ts | CTypeSpec CTypeSpec
ts <- [CDeclSpec]
specs] of
[CTypeDef Ident
ide' Attrs
_] ->
case CDecl -> Maybe CDeclr
declaredDeclr CDecl
decl of
Maybe CDeclr
Nothing -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
Just (CVarDeclr Maybe Ident
_ Attrs
_ ) -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
Just (CPtrDeclr [CTypeQual
_] (CVarDeclr Maybe Ident
_ Attrs
_) Attrs
_)
| Bool
ind -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
False)
| Bool
otherwise -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
Maybe CDeclr
_ -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
[CTypeSpec]
_ -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
extractStruct :: Position -> CTag -> CT s CStructUnion
Position
pos (EnumCT CEnum
_ ) = Position -> CT s CStructUnion
forall s a. Position -> CT s a
structExpectedErr Position
pos
extractStruct Position
pos (StructUnionCT CStructUnion
su) =
case CStructUnion
su of
CStruct CStructTag
_ (Just Ident
ide') [] Attrs
_ -> do
CDef
def <- Ident -> CT s CDef
forall s. Ident -> CT s CDef
getDefOf Ident
ide'
case CDef
def of
TagCD CTag
tag -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos CTag
tag
CDef
_ -> CT s CStructUnion
forall a. a
err
CStructUnion
_ -> CStructUnion -> CT s CStructUnion
forall (m :: * -> *) a. Monad m => a -> m a
return CStructUnion
su
where
err :: a
err = String -> a
forall a. String -> a
interr String
"CTrav.extractStruct: Illegal reference!"
declrName :: CDeclr -> Maybe Ident
declrName :: CDeclr -> Maybe Ident
declrName (CVarDeclr Maybe Ident
oide Attrs
_) = Maybe Ident
oide
declrName (CPtrDeclr [CTypeQual]
_ CDeclr
declr Attrs
_) = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
_ Attrs
_) = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CFunDeclr CDeclr
declr [CDecl]
_ Bool
_ Attrs
_) = CDeclr -> Maybe Ident
declrName CDeclr
declr
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos (CArrDeclr (CFunDeclr (CVarDeclr Maybe Ident
_ Attrs
_) [CDecl]
_ Bool
_ Attrs
_) [CTypeQual]
_ Maybe CExpr
_ Attrs
_) =
Position -> CT s ()
forall s a. Position -> CT s a
illegalFunResultErr Position
pos
assertFunDeclr Position
pos (CFunDeclr (CVarDeclr Maybe Ident
_ Attrs
_) [CDecl]
_ Bool
_ Attrs
_) =
CT s ()
forall e s. PreCST e s ()
nop
assertFunDeclr Position
pos (CFunDeclr CDeclr
declr [CDecl]
_ Bool
_ Attrs
_) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr Position
pos (CPtrDeclr [CTypeQual]
_ CDeclr
declr Attrs
_) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr Position
pos (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
_ Attrs
_) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr Position
pos CDeclr
_ =
Position -> CT s ()
forall s a. Position -> CT s a
funExpectedErr Position
pos
assertIfEnumThenFull :: CTag -> CT s ()
assertIfEnumThenFull :: CTag -> CT s ()
assertIfEnumThenFull (EnumCT (CEnum Maybe Ident
_ [] Attrs
at)) = Position -> CT s ()
forall s a. Position -> CT s a
enumForwardErr (Attrs -> Position
forall a. Pos a => a -> Position
posOf Attrs
at)
assertIfEnumThenFull CTag
_ = CT s ()
forall e s. PreCST e s ()
nop
traceCTrav :: String -> CT s ()
traceCTrav :: String -> CT s ()
traceCTrav = (Traces -> Bool) -> String -> CT s ()
forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
traceCTravSW
unknownObjErr :: Ident -> CT s a
unknownObjErr :: Ident -> CT s a
unknownObjErr Ident
ide =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Unknown identifier!",
String
"Cannot find a definition for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' in the \
\header file."]
typedefExpectedErr :: Ident -> CT s a
typedefExpectedErr :: Ident -> CT s a
typedefExpectedErr Ident
ide =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Expected type definition!",
String
"The identifier `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' needs to be a C type name."]
unexpectedTypedefErr :: Position -> CT s a
unexpectedTypedefErr :: Position -> CT s a
unexpectedTypedefErr Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
[String
"Unexpected type name!",
String
"An object, function, or enum constant is required here."]
illegalFunResultErr :: Position -> CT s a
illegalFunResultErr :: Position -> CT s a
illegalFunResultErr Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos [String
"Function cannot return an array!",
String
"ANSI C does not allow functions to return an array."]
funExpectedErr :: Position -> CT s a
funExpectedErr :: Position -> CT s a
funExpectedErr Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
[String
"Function expected!",
String
"A function is needed here, but this declarator does not declare",
String
"a function."]
enumExpectedErr :: Ident -> CT s a
enumExpectedErr :: Ident -> CT s a
enumExpectedErr Ident
ide =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
[String
"Expected enum!",
String
"Expected `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"' to denote an enum; instead found",
String
"a struct, union, or object."]
structExpectedErr :: Position -> CT s a
structExpectedErr :: Position -> CT s a
structExpectedErr Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
[String
"Expected a struct!",
String
"Expected a structure or union; instead found an enum or basic type."]
enumForwardErr :: Position -> CT s a
enumForwardErr :: Position -> CT s a
enumForwardErr Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
[String
"Forward definition of enumeration!",
String
"ANSI C does not permit foreward definitions of enumerations!"]