module CNames (nameAnalysis)
where
import Control.Monad (when, mapM_)
import Position (Position, posOf)
import Idents (Ident, identToLexeme)
import C2HSState (CST, nop)
import CAST
import CAttrs (AttrC, CObj(..), CTag(..), CDef(..))
import CBuiltin (builtinTypeNames)
import CTrav (CT, getCHeaderCT, runCT, enter, enterObjs, leave, leaveObjs,
ifCTExc, raiseErrorCTExc, defObj, findTypeObj, findValueObj,
defTag, refersToDef, isTypedef)
type NA a = CT () a
nameAnalysis :: AttrC -> CST s AttrC
nameAnalysis ac = do
(ac', _) <- runCT naCHeader ac ()
return ac'
naCHeader :: NA ()
naCHeader = do
mapM_ (uncurry defObjOrErr) builtinTypeNames
CHeader decls _ <- getCHeaderCT
mapM_ (\decl -> naCExtDecl decl `ifCTExc` nop) decls
naCExtDecl :: CExtDecl -> NA ()
naCExtDecl (CDeclExt decl ) = naCDecl decl
naCExtDecl (CFDefExt (CFunDef specs declr _ _ at)) =
naCDecl $ CDecl specs [(Just declr, Nothing, Nothing)] at
naCExtDecl (CAsmExt at ) = return ()
naCDecl :: CDecl -> NA ()
naCDecl decl@(CDecl specs decls _) =
do
mapM_ naCDeclSpec specs
mapM_ naTriple decls
where
naTriple (odeclr, oinit, oexpr) =
do
let obj = if isTypedef decl then TypeCO decl else ObjCO decl
mapMaybeM_ (naCDeclr obj) odeclr
mapMaybeM_ naCInit oinit
mapMaybeM_ naCExpr oexpr
naCDeclSpec :: CDeclSpec -> NA ()
naCDeclSpec (CTypeSpec tspec) = naCTypeSpec tspec
naCDeclSpec _ = nop
naCTypeSpec :: CTypeSpec -> NA ()
naCTypeSpec (CSUType su _) = naCStructUnion (StructUnionCT su) su
naCTypeSpec (CEnumType enum _) = naCEnum (EnumCT enum) enum
naCTypeSpec (CTypeDef ide _) = do
(obj, _) <- findTypeObj ide False
ide `refersToDef` ObjCD obj
naCTypeSpec _ = nop
naCStructUnion :: CTag -> CStructUnion -> NA ()
naCStructUnion tag (CStruct _ oide decls _) =
do
mapMaybeM_ (`defTagOrErr` tag) oide
enterObjs
mapM_ naCDecl decls
leaveObjs
naCEnum :: CTag -> CEnum -> NA ()
naCEnum tag enum@(CEnum oide enumrs _) =
do
mapMaybeM_ (`defTagOrErr` tag) oide
mapM_ naEnumr enumrs
where
naEnumr (ide, oexpr) = do
ide `defObjOrErr` EnumCO ide enum
mapMaybeM_ naCExpr oexpr
naCDeclr :: CObj -> CDeclr -> NA ()
naCDeclr obj (CVarDeclr oide _) =
mapMaybeM_ (`defObjOrErr` obj) oide
naCDeclr obj (CPtrDeclr _ declr _ ) =
naCDeclr obj declr
naCDeclr obj (CArrDeclr declr _ oexpr _ ) =
do
naCDeclr obj declr
mapMaybeM_ naCExpr oexpr
naCDeclr obj (CFunDeclr declr decls _ _ ) =
do
naCDeclr obj declr
enterObjs
mapM_ naCDecl decls
leaveObjs
naCInit :: CInit -> NA ()
naCInit (CInitExpr expr _) = naCExpr expr
naCInit (CInitList inits _) = mapM_ (naCInit . snd) inits
naCExpr :: CExpr -> NA ()
naCExpr (CComma exprs _) = mapM_ naCExpr exprs
naCExpr (CAssign _ expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2
naCExpr (CCond expr1 expr2 expr3 _) = naCExpr expr1 >> mapMaybeM_ naCExpr expr2
>> naCExpr expr3
naCExpr (CBinary _ expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2
naCExpr (CCast decl expr _) = naCDecl decl >> naCExpr expr
naCExpr (CUnary _ expr _) = naCExpr expr
naCExpr (CSizeofExpr expr _) = naCExpr expr
naCExpr (CSizeofType decl _) = naCDecl decl
naCExpr (CAlignofExpr expr _) = naCExpr expr
naCExpr (CAlignofType decl _) = naCDecl decl
naCExpr (CIndex expr1 expr2 _) = naCExpr expr1 >> naCExpr expr2
naCExpr (CCall expr exprs _) = naCExpr expr >> mapM_ naCExpr exprs
naCExpr (CMember expr ide _ _) = naCExpr expr
naCExpr (CVar ide _) = do
(obj, _) <- findValueObj ide False
ide `refersToDef` ObjCD obj
naCExpr (CConst _ _) = nop
naCExpr (CCompoundLit _ inits _) = mapM_ (naCInit . snd) inits
defTagOrErr :: Ident -> CTag -> NA ()
ide `defTagOrErr` tag = do
otag <- ide `defTag` tag
case otag of
Nothing -> nop
Just tag' -> declaredTwiceErr ide (posOf tag')
defObjOrErr :: Ident -> CObj -> NA ()
ide `defObjOrErr` obj = ide `defObj` obj >> nop
mapMaybeM_ :: Monad m => (a -> m b) -> Maybe a -> m ()
mapMaybeM_ m Nothing = return ()
mapMaybeM_ m (Just a) = m a >> return ()
declaredTwiceErr :: Ident -> Position -> NA a
declaredTwiceErr ide otherPos =
raiseErrorCTExc (posOf ide)
["Identifier declared twice!",
"The identifier `" ++ identToLexeme ide ++ "' was already declared at "
++ show otherPos ++ "."]