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