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 AttrC
ac = do
(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 [CExtDecl]
decls Attrs
_ <- 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_ (\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 CDecl
decl ) = CDecl -> CT () ()
naCDecl CDecl
decl
naCExtDecl (CFDefExt (CFunDef [CDeclSpec]
specs CDeclr
declr [CDecl]
_ CStat
_ 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 Attrs
at ) = () -> CT () ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
naCDecl :: CDecl -> NA ()
naCDecl :: CDecl -> CT () ()
naCDecl decl :: CDecl
decl@(CDecl [CDeclSpec]
specs [(Maybe CDeclr, Maybe CInit, Maybe CExpr)]
decls Attrs
_) =
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 (Maybe CDeclr
odeclr, Maybe CInit
oinit, 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 CTypeSpec
tspec) = CTypeSpec -> CT () ()
naCTypeSpec CTypeSpec
tspec
naCDeclSpec CDeclSpec
_ = CT () ()
forall e s. PreCST e s ()
nop
naCTypeSpec :: CTypeSpec -> NA ()
naCTypeSpec :: CTypeSpec -> CT () ()
naCTypeSpec (CSUType CStructUnion
su Attrs
_) = CTag -> CStructUnion -> CT () ()
naCStructUnion (CStructUnion -> CTag
StructUnionCT CStructUnion
su) CStructUnion
su
naCTypeSpec (CEnumType CEnum
enum Attrs
_) = CTag -> CEnum -> CT () ()
naCEnum (CEnum -> CTag
EnumCT CEnum
enum) CEnum
enum
naCTypeSpec (CTypeDef Ident
ide Attrs
_) = do
(CObj
obj, Ident
_) <- 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 CTypeSpec
_ = CT () ()
forall e s. PreCST e s ()
nop
naCStructUnion :: CTag -> CStructUnion -> NA ()
naCStructUnion :: CTag -> CStructUnion -> CT () ()
naCStructUnion CTag
tag (CStruct CStructTag
_ Maybe Ident
oide [CDecl]
decls Attrs
_) =
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 CTag
tag enum :: CEnum
enum@(CEnum Maybe Ident
oide [(Ident, Maybe CExpr)]
enumrs Attrs
_) =
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 (Ident
ide, 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 CObj
obj (CVarDeclr Maybe Ident
oide Attrs
_) =
(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 CObj
obj (CPtrDeclr [CTypeQual]
_ CDeclr
declr Attrs
_ ) =
CObj -> CDeclr -> CT () ()
naCDeclr CObj
obj CDeclr
declr
naCDeclr CObj
obj (CArrDeclr CDeclr
declr [CTypeQual]
_ Maybe CExpr
oexpr Attrs
_ ) =
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 CObj
obj (CFunDeclr CDeclr
declr [CDecl]
decls Bool
_ Attrs
_ ) =
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 CExpr
expr Attrs
_) = CExpr -> CT () ()
naCExpr CExpr
expr
naCInit (CInitList CInitList
inits Attrs
_) = (([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 [CExpr]
exprs Attrs
_) = (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 CAssignOp
_ CExpr
expr1 CExpr
expr2 Attrs
_) = 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 CExpr
expr1 Maybe CExpr
expr2 CExpr
expr3 Attrs
_) = 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 CBinaryOp
_ CExpr
expr1 CExpr
expr2 Attrs
_) = 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 CDecl
decl CExpr
expr Attrs
_) = 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 CUnaryOp
_ CExpr
expr Attrs
_) = CExpr -> CT () ()
naCExpr CExpr
expr
naCExpr (CSizeofExpr CExpr
expr Attrs
_) = CExpr -> CT () ()
naCExpr CExpr
expr
naCExpr (CSizeofType CDecl
decl Attrs
_) = CDecl -> CT () ()
naCDecl CDecl
decl
naCExpr (CAlignofExpr CExpr
expr Attrs
_) = CExpr -> CT () ()
naCExpr CExpr
expr
naCExpr (CAlignofType CDecl
decl Attrs
_) = CDecl -> CT () ()
naCDecl CDecl
decl
naCExpr (CIndex CExpr
expr1 CExpr
expr2 Attrs
_) = 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 CExpr
expr [CExpr]
exprs Attrs
_) = 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 CExpr
expr Ident
ide Bool
_ Attrs
_) = CExpr -> CT () ()
naCExpr CExpr
expr
naCExpr (CVar Ident
ide Attrs
_) = do
(CObj
obj, Ident
_) <- 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 CConst
_ Attrs
_) = CT () ()
forall e s. PreCST e s ()
nop
naCExpr (CCompoundLit CDecl
_ CInitList
inits Attrs
_) = (([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 ()
Ident
ide defTagOrErr :: Ident -> CTag -> CT () ()
`defTagOrErr` 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
Maybe CTag
Nothing -> CT () ()
forall e s. PreCST e s ()
nop
Just 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 ()
Ident
ide defObjOrErr :: Ident -> CObj -> CT () ()
`defObjOrErr` 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_ a -> m b
m Maybe a
Nothing = () -> m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
mapMaybeM_ a -> m b
m (Just 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 Ident
ide 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)
[String
"Identifier declared twice!",
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
"' 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]
++ String
"."]