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 reader :: 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
$ \(ac :: AttrC
ac, _) -> AttrC -> a
reader AttrC
ac
transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT :: (AttrC -> (AttrC, a)) -> CT s a
transAttrCCT trans :: 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
$ \(ac :: AttrC
ac, s :: s
s) -> let
(ac' :: AttrC
ac', r :: 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 reader :: 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
$ \(_, s :: s
s) -> s -> a
reader s
s
transCT :: (s -> (s, a)) -> CT s a
transCT :: (s -> (s, a)) -> CT s a
transCT trans :: 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
$ \(ac :: AttrC
ac, s :: s
s) -> let
(s' :: s
s', r :: 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 m :: CT s a
m ac :: AttrC
ac s :: 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
(ac :: AttrC
ac, _) <- (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 = "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 "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 m :: CT s a
m handler :: 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 pos :: Position
pos errs :: [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
$ \ac :: 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
$ \ac :: 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
$ \ac :: 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
$ \ac :: AttrC
ac -> (AttrC -> AttrC
leaveObjRangeC AttrC
ac, ())
defObj :: Ident -> CObj -> CT s (Maybe CObj)
defObj :: Ident -> CObj -> CT s (Maybe CObj)
defObj ide :: Ident
ide obj :: 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
$ \ac :: 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 ide :: 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
$ \ac :: 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 ide :: 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
$ \ac :: 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 ide :: Ident
ide tag :: 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
$ \ac :: AttrC
ac -> AttrC -> Ident -> CTag -> (AttrC, Maybe CTag)
addDefTagC AttrC
ac Ident
ide CTag
tag
case Maybe CTag
otag of
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 prevTag :: CTag
prevTag -> case CTag -> CTag -> Maybe (CTag, Ident)
isRefinedOrUse CTag
prevTag CTag
tag of
Nothing -> Maybe CTag -> CT s (Maybe CTag)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CTag
otag
Just (fullTag :: CTag
fullTag, foreIde :: 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
$ \ac :: 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 _ (Just ide :: Ident
ide) [] _))
tag :: CTag
tag@(StructUnionCT (CStruct _ (Just _ ) _ _)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse tag :: CTag
tag@(StructUnionCT (CStruct _ (Just _ ) _ _))
(StructUnionCT (CStruct _ (Just ide :: Ident
ide) [] _)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse tag :: CTag
tag@(EnumCT (CEnum (Just _ ) _ _))
(EnumCT (CEnum (Just ide :: Ident
ide) [] _)) =
(CTag, Ident) -> Maybe (CTag, Ident)
forall a. a -> Maybe a
Just (CTag
tag, Ident
ide)
isRefinedOrUse _ _ = Maybe (CTag, Ident)
forall a. Maybe a
Nothing
findTag :: Ident -> CT s (Maybe CTag)
findTag :: Ident -> CT s (Maybe CTag)
findTag ide :: 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
$ \ac :: 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 ide :: 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
$ \ac :: AttrC
ac -> AttrC -> Ident -> Maybe (CTag, Ident)
lookupDefTagCShadow AttrC
ac Ident
ide
applyPrefixToNameSpaces :: String -> CT s ()
applyPrefixToNameSpaces :: String -> CT s ()
applyPrefixToNameSpaces prefix :: 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
$ \ac :: AttrC
ac -> (AttrC -> String -> AttrC
applyPrefix AttrC
ac String
prefix, ())
getDefOf :: Ident -> CT s CDef
getDefOf :: Ident -> CT s CDef
getDefOf ide :: 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
$ \ac :: 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 ide :: Ident
ide def :: 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
$ \akl :: AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
setDefOfIdentC AttrC
akl Ident
ide CDef
def, ())
refersToNewDef :: Ident -> CDef -> CT s ()
refersToNewDef :: Ident -> CDef -> CT s ()
refersToNewDef ide :: Ident
ide def :: 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
$ \akl :: AttrC
akl -> (AttrC -> Ident -> CDef -> AttrC
updDefOfIdentC AttrC
akl Ident
ide CDef
def, ())
getDeclOf :: Ident -> CT s CDecl
getDeclOf :: Ident -> CT s CDecl
getDeclOf ide :: 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
UndefCD -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Undefined!"
DontCareCD -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Don't care!"
TagCD _ -> String -> CT s CDecl
forall a. String -> a
interr "CTrav.getDeclOf: Illegal tag!"
ObjCD obj :: CObj
obj -> case CObj
obj of
TypeCO decl :: 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 decl :: 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 _ _ -> CT s CDecl
forall a. a
illegalEnum
BuiltinCO -> CT s CDecl
forall a. a
illegalBuiltin
where
illegalEnum :: a
illegalEnum = String -> a
forall a. String -> a
interr "CTrav.getDeclOf: Illegal enum!"
illegalBuiltin :: a
illegalBuiltin = String -> a
forall a. String -> a
interr "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
$
"Entering `getDeclOf' for `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "'...\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
$
"...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
$
"...found a vanilla object.\n"
findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe :: Ident -> Bool -> CT s (Maybe (CObj, Ident))
findTypeObjMaybe ide :: Ident
ide useShadows :: 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 (\obj :: 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 _ , _) -> 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@(BuiltinCO, _) -> 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 _ -> Ident -> CT s (Maybe (CObj, Ident))
forall s a. Ident -> CT s a
typedefExpectedErr Ident
ide
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 ide :: Ident
ide useShadows :: 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
Nothing -> Ident -> CT s (CObj, Ident)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
Just obj :: (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 ide :: Ident
ide useShadows :: 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 (\obj :: 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 _ , _) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
Just obj :: (CObj, Ident)
obj@(EnumCO _ _, _) -> (CObj, Ident) -> CT s (CObj, Ident)
forall (m :: * -> *) a. Monad m => a -> m a
return (CObj, Ident)
obj
Just _ -> Position -> CT s (CObj, Ident)
forall s a. Position -> CT s a
unexpectedTypedefErr (Ident -> Position
forall a. Pos a => a -> Position
posOf Ident
ide)
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 ide :: Ident
ide useShadows :: Bool
useShadows =
do
(obj :: CObj
obj, ide' :: 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 _ _ -> 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 decl :: 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 specs :: [CDeclSpec]
specs _ _) =
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 _) <- [CDeclSpec]
specs]
simplifyDecl :: Ident -> CDecl -> CDecl
ide :: Ident
ide simplifyDecl :: Ident -> CDecl -> CDecl
`simplifyDecl` (CDecl specs :: [CDeclSpec]
specs declrs :: [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
declrs at :: 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
Nothing -> CDecl
forall a. a
err
Just declr :: (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 declr :: CDeclr
declr, _, _) declrPlusNamed :: (Maybe CDeclr, b, c) -> Ident -> Bool
`declrPlusNamed` ide :: Ident
ide = CDeclr
declr CDeclr -> Ident -> Bool
`declrNamed` Ident
ide
_ `declrPlusNamed` _ = Bool
False
err :: a
err = String -> a
forall a. String -> a
interr (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ "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]
++ "' 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
ide :: Ident
ide declrFromDecl :: Ident -> CDecl -> CDeclr
`declrFromDecl` decl :: CDecl
decl =
let CDecl _ [(Just declr :: CDeclr
declr, _, _)] _ = Ident
ide Ident -> CDecl -> CDecl
`simplifyDecl` CDecl
decl
in
CDeclr
declr
declrNamed :: CDeclr -> Ident -> Bool
declr :: CDeclr
declr declrNamed :: CDeclr -> Ident -> Bool
`declrNamed` ide :: 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 _ [] _) = Maybe CDeclr
forall a. Maybe a
Nothing
declaredDeclr (CDecl _ [(odeclr :: Maybe CDeclr
odeclr, _, _)] _) = Maybe CDeclr
odeclr
declaredDeclr decl :: CDecl
decl =
String -> Maybe CDeclr
forall a. String -> a
interr (String -> Maybe CDeclr) -> String -> Maybe CDeclr
forall a b. (a -> b) -> a -> b
$ "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 decl :: 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 tag :: CStructTag
tag _ members :: [CDecl]
members _) = ([[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 specs :: [CDeclSpec]
specs decls :: [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls at :: Attrs
at) =
((Maybe CDeclr, Maybe CInit, Maybe CExpr) -> CDecl)
-> [(Maybe CDeclr, Maybe CInit, Maybe CExpr)] -> [CDecl]
forall a b. (a -> b) -> [a] -> [b]
map (\decl :: (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 _ oide :: Maybe Ident
oide _ _) = Maybe Ident
oide
enumName :: CEnum -> Maybe Ident
enumName :: CEnum -> Maybe Ident
enumName (CEnum oide :: Maybe Ident
oide _ _) = Maybe Ident
oide
tagName :: CTag -> Ident
tagName :: CTag -> Ident
tagName tag :: CTag
tag =
case CTag
tag of
StructUnionCT struct :: 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 enum :: 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 "CTrav.tagName: Anonymous tag definition"
isPtrDeclr :: CDeclr -> Bool
isPtrDeclr :: CDeclr -> Bool
isPtrDeclr (CPtrDeclr _ (CVarDeclr _ _) _) = Bool
True
isPtrDeclr (CPtrDeclr _ declr :: CDeclr
declr _) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CArrDeclr (CVarDeclr _ _) _ _ _) = Bool
True
isPtrDeclr (CArrDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr (CFunDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDeclr _ = Bool
False
isArrDeclr :: CDeclr -> Bool
isArrDeclr :: CDeclr -> Bool
isArrDeclr (CArrDeclr declr :: CDeclr
declr _ _ _) = Bool
True
isArrDeclr _ = Bool
False
dropPtrDeclr :: CDeclr -> CDeclr
dropPtrDeclr :: CDeclr -> CDeclr
dropPtrDeclr (CPtrDeclr qs :: [CTypeQual]
qs declr :: CDeclr
declr@(CVarDeclr _ _) ats :: Attrs
ats) = CDeclr
declr
dropPtrDeclr (CPtrDeclr qs :: [CTypeQual]
qs declr :: CDeclr
declr ats :: 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 _ _) _ _ _) = CDeclr
declr
dropPtrDeclr (CArrDeclr declr :: CDeclr
declr tq :: [CTypeQual]
tq e :: Maybe CExpr
e ats :: 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 declr :: CDeclr
declr args :: [CDecl]
args vari :: Bool
vari ats :: 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 _ =
String -> CDeclr
forall a. String -> a
interr "CTrav.dropPtrDeclr: No pointer!"
isPtrDecl :: CDecl -> Bool
isPtrDecl :: CDecl -> Bool
isPtrDecl (CDecl _ [] _) = Bool
False
isPtrDecl (CDecl _ [(Just declr :: CDeclr
declr, _, _)] _) = CDeclr -> Bool
isPtrDeclr CDeclr
declr
isPtrDecl _ =
String -> Bool
forall a. String -> a
interr "CTrav.isPtrDecl: There was more than one declarator!"
isFunDeclr :: CDeclr -> Bool
isFunDeclr :: CDeclr -> Bool
isFunDeclr (CPtrDeclr _ declr :: CDeclr
declr _) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CArrDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr (CFunDeclr (CVarDeclr _ _) _ _ _) = Bool
True
isFunDeclr (CFunDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Bool
isFunDeclr CDeclr
declr
isFunDeclr _ = Bool
False
structFromDecl :: Position -> CDecl -> CT s CStructUnion
structFromDecl :: Position -> CDecl -> CT s CStructUnion
structFromDecl pos :: Position
pos (CDecl specs :: [CDeclSpec]
specs _ _) =
case [CTypeSpec] -> CTypeSpec
forall a. [a] -> a
head [CTypeSpec
ts | CTypeSpec ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
CSUType su :: CStructUnion
su _ -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos (CStructUnion -> CTag
StructUnionCT CStructUnion
su)
_ -> 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 specs :: [CDeclSpec]
specs [(Just declr :: CDeclr
declr, _, _)] _) =
let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: 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 _ _) args :: [CDecl]
args variadic :: Bool
variadic _) =
([CDecl]
args, CDeclr
var, Bool
variadic)
funArgs (CPtrDeclr qs :: [CTypeQual]
qs declr :: CDeclr
declr at :: Attrs
at) =
let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: 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 declr :: CDeclr
declr tqs :: [CTypeQual]
tqs oe :: Maybe CExpr
oe at :: Attrs
at) =
let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: 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 declr :: CDeclr
declr args :: [CDecl]
args var :: Bool
var at :: Attrs
at) =
let (args :: [CDecl]
args, declr' :: CDeclr
declr', variadic :: 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 _ =
String -> ([CDecl], CDeclr, Bool)
forall a. String -> a
interr "CTrav.funResultAndArgs: Illegal declarator!"
chaseDecl :: Ident -> Bool -> CT s CDecl
chaseDecl :: Ident -> Bool -> CT s CDecl
chaseDecl ide :: Ident
ide ind :: 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 (ide' :: Ident
ide', ind' :: Bool
ind') -> Ident -> Bool -> CT s CDecl
forall s. Ident -> Bool -> CT s CDecl
chaseDecl Ident
ide' Bool
ind'
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
$
"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
forall a. [a] -> [a] -> [a]
++ (if Bool
ind then "" else "not ")
String -> String -> String
forall a. [a] -> [a] -> [a]
++ "following indirections...\n"
findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl :: Ident -> Bool -> Bool -> CT s CDecl
findAndChaseDecl ide :: Ident
ide ind :: Bool
ind useShadows :: Bool
useShadows =
do
(obj :: CObj
obj, ide' :: 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 decl :: CDecl
decl =
case CDecl -> Bool -> Maybe (Ident, Bool)
extractAlias CDecl
decl Bool
False of
Nothing -> Maybe CDecl -> CT s (Maybe CDecl)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CDecl
forall a. Maybe a
Nothing
Just (ide' :: Ident
ide', _) -> (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 decl :: 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 ide :: Ident
ide useShadows :: 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 _ ) -> Ident -> CT s CEnum
forall s a. Ident -> CT s a
enumExpectedErr Ident
ide
Just (EnumCT enum :: CEnum
enum) -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum
Nothing -> do
(CDecl specs :: [CDeclSpec]
specs _ _) <- 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 ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
CEnumType enum :: CEnum
enum _ -> CEnum -> CT s CEnum
forall (m :: * -> *) a. Monad m => a -> m a
return CEnum
enum
_ -> 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 ide :: Ident
ide ind :: Bool
ind useShadows :: 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 ide :: Ident
ide useShadows :: 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 (_, ide :: 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
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
Nothing -> Ident -> CT s (Either CDecl CTag)
forall s a. Ident -> CT s a
unknownObjErr Ident
ide
Just tag :: 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 specs :: [CDeclSpec]
specs _ _) ind :: Bool
ind =
case [CTypeSpec
ts | CTypeSpec ts :: CTypeSpec
ts <- [CDeclSpec]
specs] of
[CTypeDef ide' :: Ident
ide' _] ->
case CDecl -> Maybe CDeclr
declaredDeclr CDecl
decl of
Nothing -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
Just (CVarDeclr _ _ ) -> (Ident, Bool) -> Maybe (Ident, Bool)
forall a. a -> Maybe a
Just (Ident
ide', Bool
ind)
Just (CPtrDeclr [_] (CVarDeclr _ _) _)
| 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 (Ident, Bool)
forall a. Maybe a
Nothing
_ -> Maybe (Ident, Bool)
forall a. Maybe a
Nothing
extractStruct :: Position -> CTag -> CT s CStructUnion
pos :: Position
pos (EnumCT _ ) = Position -> CT s CStructUnion
forall s a. Position -> CT s a
structExpectedErr Position
pos
extractStruct pos :: Position
pos (StructUnionCT su :: CStructUnion
su) =
case CStructUnion
su of
CStruct _ (Just ide' :: Ident
ide') [] _ -> do
CDef
def <- Ident -> CT s CDef
forall s. Ident -> CT s CDef
getDefOf Ident
ide'
case CDef
def of
TagCD tag :: CTag
tag -> Position -> CTag -> CT s CStructUnion
forall s. Position -> CTag -> CT s CStructUnion
extractStruct Position
pos CTag
tag
_ -> CT s CStructUnion
forall a. a
err
_ -> 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 "CTrav.extractStruct: Illegal reference!"
declrName :: CDeclr -> Maybe Ident
declrName :: CDeclr -> Maybe Ident
declrName (CVarDeclr oide :: Maybe Ident
oide _) = Maybe Ident
oide
declrName (CPtrDeclr _ declr :: CDeclr
declr _) = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CArrDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Maybe Ident
declrName CDeclr
declr
declrName (CFunDeclr declr :: CDeclr
declr _ _ _) = CDeclr -> Maybe Ident
declrName CDeclr
declr
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr :: Position -> CDeclr -> CT s ()
assertFunDeclr pos :: Position
pos (CArrDeclr (CFunDeclr (CVarDeclr _ _) _ _ _) _ _ _) =
Position -> CT s ()
forall s a. Position -> CT s a
illegalFunResultErr Position
pos
assertFunDeclr pos :: Position
pos (CFunDeclr (CVarDeclr _ _) _ _ _) =
CT s ()
forall e s. PreCST e s ()
nop
assertFunDeclr pos :: Position
pos (CFunDeclr declr :: CDeclr
declr _ _ _) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos (CPtrDeclr _ declr :: CDeclr
declr _) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos (CArrDeclr declr :: CDeclr
declr _ _ _) =
Position -> CDeclr -> CT s ()
forall s. Position -> CDeclr -> CT s ()
assertFunDeclr Position
pos CDeclr
declr
assertFunDeclr pos :: Position
pos _ =
Position -> CT s ()
forall s a. Position -> CT s a
funExpectedErr Position
pos
assertIfEnumThenFull :: CTag -> CT s ()
assertIfEnumThenFull :: CTag -> CT s ()
assertIfEnumThenFull (EnumCT (CEnum _ [] at :: 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 _ = 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 ide :: 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)
["Unknown identifier!",
"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]
++ "' in the \
\header file."]
typedefExpectedErr :: Ident -> CT s a
typedefExpectedErr :: Ident -> CT s a
typedefExpectedErr ide :: 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)
["Expected type definition!",
"The identifier `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' needs to be a C type name."]
unexpectedTypedefErr :: Position -> CT s a
unexpectedTypedefErr :: Position -> CT s a
unexpectedTypedefErr pos :: Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
["Unexpected type name!",
"An object, function, or enum constant is required here."]
illegalFunResultErr :: Position -> CT s a
illegalFunResultErr :: Position -> CT s a
illegalFunResultErr pos :: Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos ["Function cannot return an array!",
"ANSI C does not allow functions to return an array."]
funExpectedErr :: Position -> CT s a
funExpectedErr :: Position -> CT s a
funExpectedErr pos :: Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
["Function expected!",
"A function is needed here, but this declarator does not declare",
"a function."]
enumExpectedErr :: Ident -> CT s a
enumExpectedErr :: Ident -> CT s a
enumExpectedErr ide :: 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)
["Expected enum!",
"Expected `" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Ident -> String
identToLexeme Ident
ide String -> String -> String
forall a. [a] -> [a] -> [a]
++ "' to denote an enum; instead found",
"a struct, union, or object."]
structExpectedErr :: Position -> CT s a
structExpectedErr :: Position -> CT s a
structExpectedErr pos :: Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
["Expected a struct!",
"Expected a structure or union; instead found an enum or basic type."]
enumForwardErr :: Position -> CT s a
enumForwardErr :: Position -> CT s a
enumForwardErr pos :: Position
pos =
Position -> [String] -> CT s a
forall s a. Position -> [String] -> CT s a
raiseErrorCTExc Position
pos
["Forward definition of enumeration!",
"ANSI C does not permit foreward definitions of enumerations!"]