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