{-# LANGUAGE PatternGuards, DeriveDataTypeable  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Analysis.DefTable
-- Copyright   :  (c) 2008 Benedikt Huber
--                  based on code from c2hs
--                (c) [1999..2001] Manuel M. T. Chakravarty
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  alpha
-- Portability :  ghc
--
-- This module manages symbols in local and global scopes.
--
-- There are four different kind of identifiers: ordinary identifiers (henceforth
-- simply called `identifier'), tag names (names of struct\/union\/enum types),
-- labels and structure members.
-----------------------------------------------------------------------------
module Language.C.Analysis.DefTable (
    IdentEntry, identOfTyDecl,
    TagEntry, TagFwdDecl(..),
    DefTable(..),
    emptyDefTable,
    globalDefs,
    inFileScope,
    enterFunctionScope,leaveFunctionScope,enterBlockScope,leaveBlockScope,
    enterMemberDecl,leaveMemberDecl,
    DeclarationStatus(..),declStatusDescr,
    defineTypeDef, defineGlobalIdent, defineScopedIdent, defineScopedIdentWhen,
    declareTag,defineTag,defineLabel,lookupIdent,
    lookupTag,lookupLabel,lookupIdentInner,lookupTagInner,
    insertType, lookupType,
    mergeDefTable
)
where
import Language.C.Data
import Language.C.Analysis.NameSpaceMap
import Language.C.Analysis.SemRep

import qualified Data.Map as Map
import Data.IntMap (IntMap, union)
import qualified Data.IntMap as IntMap
import Data.Data (Data)
import Data.Typeable (Typeable)

{- Name spaces, scopes and contexts [Scopes]

 In C, there are 4 categories of identifiers:

  * labels
  * tag names (@(struct|union|enum) tag-name@), where /all/ tag names live in one namespace
  * members of structures and unions
  * ordinary identifiers, denoting objects, functions, typeDefs and enumeration constants

 There are 4 kind of scopes:

  * file scope: outside of parameter lists and blocks
  * function prototype scope
  * function scope: labels are visible within the entire function, and declared implicitely
  * block scope

 While function scope is irrelevant for variable declarations, they might also appear in member declarations.
 Therefore, there are also 4 kinds of contexts where a variable might be declared:

  * File Scope Context: external declaration \/ definition
  * Block Scope Context: either external or local definition
  * Function prototype scope context
  * Member Declaration context

 See
   <http://www.embedded.com/design/206901036>
   C99 6
-}

-- | All ordinary identifiers map to 'IdenTyDecl': either a typedef or a object\/function\/enumerator
type IdentEntry = Either TypeDef IdentDecl

identOfTyDecl :: IdentEntry -> Ident
identOfTyDecl :: IdentEntry -> Ident
identOfTyDecl = (TypeDef -> Ident) -> (IdentDecl -> Ident) -> IdentEntry -> Ident
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TypeDef -> Ident
identOfTypeDef IdentDecl -> Ident
forall n. Declaration n => n -> Ident
declIdent

data TagFwdDecl = CompDecl CompTypeRef
                | EnumDecl EnumTypeRef
instance HasSUERef TagFwdDecl where
  sueRef :: TagFwdDecl -> SUERef
sueRef (CompDecl CompTypeRef
ctr) = CompTypeRef -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef CompTypeRef
ctr
  sueRef (EnumDecl EnumTypeRef
etr) = EnumTypeRef -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef EnumTypeRef
etr
instance CNode TagFwdDecl where
  nodeInfo :: TagFwdDecl -> NodeInfo
nodeInfo (CompDecl CompTypeRef
ctr) = CompTypeRef -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo CompTypeRef
ctr
  nodeInfo (EnumDecl EnumTypeRef
etr) = EnumTypeRef -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo EnumTypeRef
etr

-- | Tag names map to forward declarations or definitions of struct\/union\/enum types
type TagEntry = Either TagFwdDecl TagDef

-- | Table holding current definitions
data DefTable = DefTable
    {
        DefTable -> NameSpaceMap Ident IdentEntry
identDecls   :: NameSpaceMap Ident IdentEntry,     -- ^ declared `ordinary identifiers'
        DefTable -> NameSpaceMap SUERef TagEntry
tagDecls   :: NameSpaceMap SUERef TagEntry,        -- ^ declared struct/union/enum  tags
        DefTable -> NameSpaceMap Ident Ident
labelDefs  :: NameSpaceMap Ident Ident,            -- ^ defined labels
        DefTable -> NameSpaceMap Ident MemberDecl
memberDecls :: NameSpaceMap Ident MemberDecl,      -- ^ member declarations (only local)
        DefTable -> IntMap Name
refTable   :: IntMap Name,                         -- ^ link names with definitions
        DefTable -> IntMap Type
typeTable  :: IntMap Type
    }

-- | empty definition table, with all name space maps in global scope
emptyDefTable :: DefTable
emptyDefTable :: DefTable
emptyDefTable = NameSpaceMap Ident IdentEntry
-> NameSpaceMap SUERef TagEntry
-> NameSpaceMap Ident Ident
-> NameSpaceMap Ident MemberDecl
-> IntMap Name
-> IntMap Type
-> DefTable
DefTable NameSpaceMap Ident IdentEntry
forall k v. Ord k => NameSpaceMap k v
nameSpaceMap NameSpaceMap SUERef TagEntry
forall k v. Ord k => NameSpaceMap k v
nameSpaceMap NameSpaceMap Ident Ident
forall k v. Ord k => NameSpaceMap k v
nameSpaceMap NameSpaceMap Ident MemberDecl
forall k v. Ord k => NameSpaceMap k v
nameSpaceMap IntMap Name
forall a. IntMap a
IntMap.empty IntMap Type
forall a. IntMap a
IntMap.empty

-- | get the globally defined entries of a definition table
globalDefs :: DefTable -> GlobalDecls
globalDefs :: DefTable -> GlobalDecls
globalDefs DefTable
deftbl = (Ident -> IdentEntry -> GlobalDecls -> GlobalDecls)
-> GlobalDecls -> Map Ident IdentEntry -> GlobalDecls
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey Ident -> IdentEntry -> GlobalDecls -> GlobalDecls
insertDecl (Map Ident IdentDecl
-> Map SUERef TagDef -> Map Ident TypeDef -> GlobalDecls
GlobalDecls Map Ident IdentDecl
forall {k} {a}. Map k a
e Map SUERef TagDef
gtags Map Ident TypeDef
forall {k} {a}. Map k a
e) (NameSpaceMap Ident IdentEntry -> Map Ident IdentEntry
forall k v. Ord k => NameSpaceMap k v -> Map k v
globalNames (NameSpaceMap Ident IdentEntry -> Map Ident IdentEntry)
-> NameSpaceMap Ident IdentEntry -> Map Ident IdentEntry
forall a b. (a -> b) -> a -> b
$ DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl)
    where
    e :: Map k a
e = Map k a
forall {k} {a}. Map k a
Map.empty
    (Map SUERef TagFwdDecl
_fwd_decls,Map SUERef TagDef
gtags) = (TagEntry -> TagEntry)
-> Map SUERef TagEntry
-> (Map SUERef TagFwdDecl, Map SUERef TagDef)
forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither TagEntry -> TagEntry
forall a. a -> a
id (Map SUERef TagEntry -> (Map SUERef TagFwdDecl, Map SUERef TagDef))
-> Map SUERef TagEntry
-> (Map SUERef TagFwdDecl, Map SUERef TagDef)
forall a b. (a -> b) -> a -> b
$ NameSpaceMap SUERef TagEntry -> Map SUERef TagEntry
forall k v. Ord k => NameSpaceMap k v -> Map k v
globalNames (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl)
    insertDecl :: Ident -> IdentEntry -> GlobalDecls -> GlobalDecls
insertDecl Ident
ident (Left TypeDef
tydef) GlobalDecls
ds = GlobalDecls
ds { gTypeDefs :: Map Ident TypeDef
gTypeDefs = Ident -> TypeDef -> Map Ident TypeDef -> Map Ident TypeDef
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
ident TypeDef
tydef (GlobalDecls -> Map Ident TypeDef
gTypeDefs GlobalDecls
ds)}
    insertDecl Ident
ident (Right IdentDecl
obj) GlobalDecls
ds = GlobalDecls
ds { gObjs :: Map Ident IdentDecl
gObjs = Ident -> IdentDecl -> Map Ident IdentDecl -> Map Ident IdentDecl
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
ident IdentDecl
obj (GlobalDecls -> Map Ident IdentDecl
gObjs GlobalDecls
ds) }

inFileScope :: DefTable -> Bool
inFileScope :: DefTable -> Bool
inFileScope DefTable
dt = Bool -> Bool
not (NameSpaceMap Ident IdentEntry -> Bool
forall k v. NameSpaceMap k v -> Bool
hasLocalNames (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
dt) Bool -> Bool -> Bool
|| NameSpaceMap Ident Ident -> Bool
forall k v. NameSpaceMap k v -> Bool
hasLocalNames (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
dt))

leaveScope_ :: (Ord k) => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ :: forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ = (NameSpaceMap k a, [(k, a)]) -> NameSpaceMap k a
forall a b. (a, b) -> a
fst ((NameSpaceMap k a, [(k, a)]) -> NameSpaceMap k a)
-> (NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)]))
-> NameSpaceMap k a
-> NameSpaceMap k a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
forall k a.
Ord k =>
NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
leaveScope

enterLocalScope :: DefTable -> DefTable
enterLocalScope :: DefTable -> DefTable
enterLocalScope DefTable
deftbl = DefTable
deftbl {
        identDecls :: NameSpaceMap Ident IdentEntry
identDecls = NameSpaceMap Ident IdentEntry -> NameSpaceMap Ident IdentEntry
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl),
        tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = NameSpaceMap SUERef TagEntry -> NameSpaceMap SUERef TagEntry
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl)
    }
leaveLocalScope :: DefTable -> DefTable
leaveLocalScope :: DefTable -> DefTable
leaveLocalScope DefTable
deftbl = DefTable
deftbl {
                        identDecls :: NameSpaceMap Ident IdentEntry
identDecls = NameSpaceMap Ident IdentEntry -> NameSpaceMap Ident IdentEntry
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl),
                        tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = NameSpaceMap SUERef TagEntry -> NameSpaceMap SUERef TagEntry
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl)
                       }

-- | Enter function scope (AND the corresponding block scope)
enterFunctionScope :: DefTable -> DefTable
enterFunctionScope :: DefTable -> DefTable
enterFunctionScope DefTable
deftbl = DefTable -> DefTable
enterLocalScope  (DefTable -> DefTable) -> DefTable -> DefTable
forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = NameSpaceMap Ident Ident -> NameSpaceMap Ident Ident
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) }

-- | Leave function scope, and return the associated DefTable.
--   Error if not in function scope.
leaveFunctionScope :: DefTable -> DefTable
leaveFunctionScope :: DefTable -> DefTable
leaveFunctionScope DefTable
deftbl = DefTable -> DefTable
leaveLocalScope (DefTable -> DefTable) -> DefTable -> DefTable
forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = NameSpaceMap Ident Ident -> NameSpaceMap Ident Ident
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) }

-- | Enter new block scope
enterBlockScope :: DefTable -> DefTable
enterBlockScope :: DefTable -> DefTable
enterBlockScope DefTable
deftbl = DefTable -> DefTable
enterLocalScope (DefTable -> DefTable) -> DefTable -> DefTable
forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = NameSpaceMap Ident Ident -> NameSpaceMap Ident Ident
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) }

-- | Leave innermost block scope
leaveBlockScope :: DefTable -> DefTable
leaveBlockScope :: DefTable -> DefTable
leaveBlockScope DefTable
deftbl = DefTable -> DefTable
leaveLocalScope (DefTable -> DefTable) -> DefTable -> DefTable
forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = NameSpaceMap Ident Ident -> NameSpaceMap Ident Ident
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) }

-- | Enter new member declaration scope
enterMemberDecl :: DefTable -> DefTable
enterMemberDecl :: DefTable -> DefTable
enterMemberDecl DefTable
deftbl = DefTable
deftbl { memberDecls :: NameSpaceMap Ident MemberDecl
memberDecls = NameSpaceMap Ident MemberDecl -> NameSpaceMap Ident MemberDecl
forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap Ident MemberDecl
memberDecls DefTable
deftbl) }

-- | Leave innermost member declaration scope
leaveMemberDecl :: DefTable -> ([MemberDecl], DefTable)
leaveMemberDecl :: DefTable -> ([MemberDecl], DefTable)
leaveMemberDecl DefTable
deftbl =
    let (NameSpaceMap Ident MemberDecl
decls',[(Ident, MemberDecl)]
members) = NameSpaceMap Ident MemberDecl
-> (NameSpaceMap Ident MemberDecl, [(Ident, MemberDecl)])
forall k a.
Ord k =>
NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
leaveScope (DefTable -> NameSpaceMap Ident MemberDecl
memberDecls DefTable
deftbl)
    in (,) (((Ident, MemberDecl) -> MemberDecl)
-> [(Ident, MemberDecl)] -> [MemberDecl]
forall a b. (a -> b) -> [a] -> [b]
map (Ident, MemberDecl) -> MemberDecl
forall a b. (a, b) -> b
snd [(Ident, MemberDecl)]
members)
           (DefTable
deftbl { memberDecls :: NameSpaceMap Ident MemberDecl
memberDecls = NameSpaceMap Ident MemberDecl
decls' })

-- * declarations

-- | Status of a declaration
data DeclarationStatus t =
      NewDecl         -- ^ new entry
    | Redeclared t    -- ^ old def was overwritten
    | KeepDef t       -- ^ new def was discarded
    | Shadowed t      -- ^ new def shadows one in outer scope
    | KindMismatch t  -- ^ kind mismatch
    deriving (Typeable (DeclarationStatus t)
Typeable (DeclarationStatus t)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> DeclarationStatus t
    -> c (DeclarationStatus t))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (DeclarationStatus t))
-> (DeclarationStatus t -> Constr)
-> (DeclarationStatus t -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (DeclarationStatus t)))
-> ((forall b. Data b => b -> b)
    -> DeclarationStatus t -> DeclarationStatus t)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> DeclarationStatus t -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeclarationStatus t -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> DeclarationStatus t -> m (DeclarationStatus t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeclarationStatus t -> m (DeclarationStatus t))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> DeclarationStatus t -> m (DeclarationStatus t))
-> Data (DeclarationStatus t)
DeclarationStatus t -> DataType
DeclarationStatus t -> Constr
(forall b. Data b => b -> b)
-> DeclarationStatus t -> DeclarationStatus t
forall {t}. Data t => Typeable (DeclarationStatus t)
forall t. Data t => DeclarationStatus t -> DataType
forall t. Data t => DeclarationStatus t -> Constr
forall t.
Data t =>
(forall b. Data b => b -> b)
-> DeclarationStatus t -> DeclarationStatus t
forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> DeclarationStatus t -> u
forall t u.
Data t =>
(forall d. Data d => d -> u) -> DeclarationStatus t -> [u]
forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DeclarationStatus t)
forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeclarationStatus t
-> c (DeclarationStatus t)
forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t))
forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DeclarationStatus t))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> DeclarationStatus t -> u
forall u.
(forall d. Data d => d -> u) -> DeclarationStatus t -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DeclarationStatus t)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeclarationStatus t
-> c (DeclarationStatus t)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DeclarationStatus t))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
$cgmapMo :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
$cgmapMp :: forall t (m :: * -> *).
(Data t, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
$cgmapM :: forall t (m :: * -> *).
(Data t, Monad m) =>
(forall d. Data d => d -> m d)
-> DeclarationStatus t -> m (DeclarationStatus t)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> DeclarationStatus t -> u
$cgmapQi :: forall t u.
Data t =>
Int -> (forall d. Data d => d -> u) -> DeclarationStatus t -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> DeclarationStatus t -> [u]
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> DeclarationStatus t -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
$cgmapQr :: forall t r r'.
Data t =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
$cgmapQl :: forall t r r'.
Data t =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeclarationStatus t -> r
gmapT :: (forall b. Data b => b -> b)
-> DeclarationStatus t -> DeclarationStatus t
$cgmapT :: forall t.
Data t =>
(forall b. Data b => b -> b)
-> DeclarationStatus t -> DeclarationStatus t
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DeclarationStatus t))
$cdataCast2 :: forall t (t :: * -> * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (DeclarationStatus t))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t))
$cdataCast1 :: forall t (t :: * -> *) (c :: * -> *).
(Data t, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t))
dataTypeOf :: DeclarationStatus t -> DataType
$cdataTypeOf :: forall t. Data t => DeclarationStatus t -> DataType
toConstr :: DeclarationStatus t -> Constr
$ctoConstr :: forall t. Data t => DeclarationStatus t -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DeclarationStatus t)
$cgunfold :: forall t (c :: * -> *).
Data t =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (DeclarationStatus t)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeclarationStatus t
-> c (DeclarationStatus t)
$cgfoldl :: forall t (c :: * -> *).
Data t =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeclarationStatus t
-> c (DeclarationStatus t)
Data,Typeable)
declStatusDescr :: DeclarationStatus t -> String
declStatusDescr :: forall t. DeclarationStatus t -> String
declStatusDescr DeclarationStatus t
NewDecl = String
"new"
declStatusDescr (Redeclared t
_) = String
"redeclared"
declStatusDescr (KeepDef t
_) = String
"keep old"
declStatusDescr (Shadowed t
_) = String
"shadowed"
declStatusDescr (KindMismatch t
_) = String
"kind mismatch"

compatIdentEntry :: IdentEntry -> IdentEntry -> Bool
compatIdentEntry :: IdentEntry -> IdentEntry -> Bool
compatIdentEntry (Left TypeDef
_tydef) = (TypeDef -> Bool) -> (IdentDecl -> Bool) -> IdentEntry -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> TypeDef -> Bool
forall a b. a -> b -> a
const Bool
True) (Bool -> IdentDecl -> Bool
forall a b. a -> b -> a
const Bool
False)
compatIdentEntry (Right IdentDecl
def) = (TypeDef -> Bool) -> (IdentDecl -> Bool) -> IdentEntry -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> TypeDef -> Bool
forall a b. a -> b -> a
const Bool
False) ((IdentDecl -> Bool) -> IdentEntry -> Bool)
-> (IdentDecl -> Bool) -> IdentEntry -> Bool
forall a b. (a -> b) -> a -> b
$
  \IdentDecl
other_def -> case (IdentDecl
def,IdentDecl
other_def) of
                  (EnumeratorDef Enumerator
_, EnumeratorDef Enumerator
_) -> Bool
True
                  (EnumeratorDef Enumerator
_, IdentDecl
_) -> Bool
True
                  (IdentDecl
_, EnumeratorDef Enumerator
_) -> Bool
True
                  (IdentDecl
_,IdentDecl
_) -> Bool
True

data TagEntryKind = CompKind CompTyKind | EnumKind
                    deriving (TagEntryKind -> TagEntryKind -> Bool
(TagEntryKind -> TagEntryKind -> Bool)
-> (TagEntryKind -> TagEntryKind -> Bool) -> Eq TagEntryKind
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TagEntryKind -> TagEntryKind -> Bool
$c/= :: TagEntryKind -> TagEntryKind -> Bool
== :: TagEntryKind -> TagEntryKind -> Bool
$c== :: TagEntryKind -> TagEntryKind -> Bool
Eq,Eq TagEntryKind
Eq TagEntryKind
-> (TagEntryKind -> TagEntryKind -> Ordering)
-> (TagEntryKind -> TagEntryKind -> Bool)
-> (TagEntryKind -> TagEntryKind -> Bool)
-> (TagEntryKind -> TagEntryKind -> Bool)
-> (TagEntryKind -> TagEntryKind -> Bool)
-> (TagEntryKind -> TagEntryKind -> TagEntryKind)
-> (TagEntryKind -> TagEntryKind -> TagEntryKind)
-> Ord TagEntryKind
TagEntryKind -> TagEntryKind -> Bool
TagEntryKind -> TagEntryKind -> Ordering
TagEntryKind -> TagEntryKind -> TagEntryKind
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: TagEntryKind -> TagEntryKind -> TagEntryKind
$cmin :: TagEntryKind -> TagEntryKind -> TagEntryKind
max :: TagEntryKind -> TagEntryKind -> TagEntryKind
$cmax :: TagEntryKind -> TagEntryKind -> TagEntryKind
>= :: TagEntryKind -> TagEntryKind -> Bool
$c>= :: TagEntryKind -> TagEntryKind -> Bool
> :: TagEntryKind -> TagEntryKind -> Bool
$c> :: TagEntryKind -> TagEntryKind -> Bool
<= :: TagEntryKind -> TagEntryKind -> Bool
$c<= :: TagEntryKind -> TagEntryKind -> Bool
< :: TagEntryKind -> TagEntryKind -> Bool
$c< :: TagEntryKind -> TagEntryKind -> Bool
compare :: TagEntryKind -> TagEntryKind -> Ordering
$ccompare :: TagEntryKind -> TagEntryKind -> Ordering
Ord)
instance Show TagEntryKind where
  show :: TagEntryKind -> String
show (CompKind CompTyKind
ctk) = CompTyKind -> String
forall a. Show a => a -> String
show CompTyKind
ctk
  show TagEntryKind
EnumKind = String
"enum"

-- | @sameTagKind ty1 ty2@ returns @True@ if @ty1,ty2@ are the same kind of tag (struct,union or enum)
tagKind :: TagEntry -> TagEntryKind
tagKind :: TagEntry -> TagEntryKind
tagKind (Left (CompDecl CompTypeRef
cd)) = CompTyKind -> TagEntryKind
CompKind (CompTypeRef -> CompTyKind
forall a. HasCompTyKind a => a -> CompTyKind
compTag CompTypeRef
cd)
tagKind (Left (EnumDecl EnumTypeRef
_)) = TagEntryKind
EnumKind
tagKind (Right (CompDef CompType
cd)) = CompTyKind -> TagEntryKind
CompKind (CompType -> CompTyKind
forall a. HasCompTyKind a => a -> CompTyKind
compTag CompType
cd)
tagKind (Right (EnumDef EnumType
_)) =  TagEntryKind
EnumKind

compatTagEntry :: TagEntry -> TagEntry -> Bool
compatTagEntry :: TagEntry -> TagEntry -> Bool
compatTagEntry  TagEntry
te1 TagEntry
te2 = TagEntry -> TagEntryKind
tagKind TagEntry
te1 TagEntryKind -> TagEntryKind -> Bool
forall a. Eq a => a -> a -> Bool
== TagEntry -> TagEntryKind
tagKind TagEntry
te2

defRedeclStatus :: (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus :: forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus t -> t -> Bool
sameKind t
def Maybe t
oldDecl =
    case Maybe t
oldDecl of
        Just t
def' | t
def t -> t -> Bool
`sameKind` t
def' -> t -> DeclarationStatus t
forall t. t -> DeclarationStatus t
Redeclared t
def'
                  | Bool
otherwise           -> t -> DeclarationStatus t
forall t. t -> DeclarationStatus t
KindMismatch t
def'
        Maybe t
Nothing                         -> DeclarationStatus t
forall t. DeclarationStatus t
NewDecl

defRedeclStatusLocal :: (Ord k) =>
                        (t -> t -> Bool) -> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal :: forall k t.
Ord k =>
(t -> t -> Bool)
-> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal t -> t -> Bool
sameKind k
ident t
def Maybe t
oldDecl NameSpaceMap k t
nsm =
    case (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus t -> t -> Bool
sameKind t
def Maybe t
oldDecl of
        DeclarationStatus t
NewDecl -> case NameSpaceMap k t -> k -> Maybe t
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName NameSpaceMap k t
nsm k
ident of
                     Just t
shadowed -> t -> DeclarationStatus t
forall t. t -> DeclarationStatus t
Shadowed t
shadowed
                     Maybe t
Nothing       -> DeclarationStatus t
forall t. DeclarationStatus t
NewDecl
        DeclarationStatus t
redecl  -> DeclarationStatus t
redecl

defineTypeDef :: Ident -> TypeDef -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineTypeDef :: Ident
-> TypeDef -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineTypeDef Ident
ident TypeDef
tydef DefTable
deftbl =
  ((IdentEntry -> IdentEntry -> Bool)
-> IdentEntry -> Maybe IdentEntry -> DeclarationStatus IdentEntry
forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus IdentEntry -> IdentEntry -> Bool
compatIdentEntry (TypeDef -> IdentEntry
forall a b. a -> Either a b
Left TypeDef
tydef) Maybe IdentEntry
oldDecl, DefTable
deftbl { identDecls :: NameSpaceMap Ident IdentEntry
identDecls = NameSpaceMap Ident IdentEntry
decls' })
  where
  (NameSpaceMap Ident IdentEntry
decls', Maybe IdentEntry
oldDecl) = NameSpaceMap Ident IdentEntry
-> Ident
-> IdentEntry
-> (NameSpaceMap Ident IdentEntry, Maybe IdentEntry)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl) Ident
ident (TypeDef -> IdentEntry
forall a b. a -> Either a b
Left TypeDef
tydef)

-- | declare\/define a global object\/function\/typeDef
--
--  returns @Redeclared def@ if there is already an object\/function\/typeDef
--  in global scope, or @DifferentKindRedec def@ if the old declaration is of a different kind.
defineGlobalIdent :: Ident -> IdentDecl -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineGlobalIdent :: Ident
-> IdentDecl
-> DefTable
-> (DeclarationStatus IdentEntry, DefTable)
defineGlobalIdent Ident
ident IdentDecl
def DefTable
deftbl =
    ((IdentEntry -> IdentEntry -> Bool)
-> IdentEntry -> Maybe IdentEntry -> DeclarationStatus IdentEntry
forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus IdentEntry -> IdentEntry -> Bool
compatIdentEntry (IdentDecl -> IdentEntry
forall a b. b -> Either a b
Right IdentDecl
def) Maybe IdentEntry
oldDecl, DefTable
deftbl { identDecls :: NameSpaceMap Ident IdentEntry
identDecls = NameSpaceMap Ident IdentEntry
decls' })
    where
    (NameSpaceMap Ident IdentEntry
decls',Maybe IdentEntry
oldDecl) = NameSpaceMap Ident IdentEntry
-> Ident
-> IdentEntry
-> (NameSpaceMap Ident IdentEntry, Maybe IdentEntry)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defGlobal (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl) Ident
ident (IdentDecl -> IdentEntry
forall a b. b -> Either a b
Right IdentDecl
def)
-- | declare\/define a object\/function\/typeDef with lexical scope
--
--  returns @Redeclared def@ or @DifferentKindRedec def@  if there is already an object\/function\/typeDef
--  in the same scope.
defineScopedIdent :: Ident -> IdentDecl -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineScopedIdent :: Ident
-> IdentDecl
-> DefTable
-> (DeclarationStatus IdentEntry, DefTable)
defineScopedIdent = (IdentDecl -> Bool)
-> Ident
-> IdentDecl
-> DefTable
-> (DeclarationStatus IdentEntry, DefTable)
defineScopedIdentWhen (Bool -> IdentDecl -> Bool
forall a b. a -> b -> a
const Bool
True)

-- | declare\/define a object\/function\/typeDef with lexical scope, if the given predicate holds on the old
--   entry.
--
--  returns @Keep old_def@ if the old definition shouldn't be overwritten, and otherwise @Redeclared def@ or
--  @DifferentKindRedecl def@  if there is already an object\/function\/typeDef in the same scope.
defineScopedIdentWhen :: (IdentDecl -> Bool) -> Ident -> IdentDecl -> DefTable ->
                           (DeclarationStatus IdentEntry, DefTable)
defineScopedIdentWhen :: (IdentDecl -> Bool)
-> Ident
-> IdentDecl
-> DefTable
-> (DeclarationStatus IdentEntry, DefTable)
defineScopedIdentWhen IdentDecl -> Bool
override_def Ident
ident IdentDecl
def DefTable
deftbl
    = (DeclarationStatus IdentEntry
redecl_status, DefTable
deftbl { identDecls :: NameSpaceMap Ident IdentEntry
identDecls = NameSpaceMap Ident IdentEntry
decls' })
    where
    new_def :: Either a IdentDecl
new_def = IdentDecl -> Either a IdentDecl
forall a b. b -> Either a b
Right IdentDecl
def
    old_decls :: NameSpaceMap Ident IdentEntry
old_decls = DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl
    old_decl_opt :: Maybe IdentEntry
old_decl_opt = NameSpaceMap Ident IdentEntry -> Ident -> Maybe IdentEntry
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupInnermostScope NameSpaceMap Ident IdentEntry
old_decls Ident
ident
    (NameSpaceMap Ident IdentEntry
decls',DeclarationStatus IdentEntry
redecl_status)  | (Just IdentEntry
old_decl) <- Maybe IdentEntry
old_decl_opt, Bool -> Bool
not (IdentEntry
old_decl IdentEntry -> IdentEntry -> Bool
`compatIdentEntry` IdentEntry
forall {a}. Either a IdentDecl
new_def)
                              = (NameSpaceMap Ident IdentEntry
new_decls, IdentEntry -> DeclarationStatus IdentEntry
forall t. t -> DeclarationStatus t
KindMismatch IdentEntry
old_decl)
                            | Bool -> (IdentEntry -> Bool) -> Maybe IdentEntry -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True IdentEntry -> Bool
forall {a}. Either a IdentDecl -> Bool
doOverride Maybe IdentEntry
old_decl_opt
                              = (NameSpaceMap Ident IdentEntry
new_decls, Maybe IdentEntry -> DeclarationStatus IdentEntry
redeclStatus' Maybe IdentEntry
old_decl_opt)
                            | Bool
otherwise
                              = (NameSpaceMap Ident IdentEntry
old_decls, DeclarationStatus IdentEntry
-> (IdentEntry -> DeclarationStatus IdentEntry)
-> Maybe IdentEntry
-> DeclarationStatus IdentEntry
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DeclarationStatus IdentEntry
forall t. DeclarationStatus t
NewDecl IdentEntry -> DeclarationStatus IdentEntry
forall t. t -> DeclarationStatus t
KeepDef Maybe IdentEntry
old_decl_opt)
    new_decls :: NameSpaceMap Ident IdentEntry
new_decls = (NameSpaceMap Ident IdentEntry, Maybe IdentEntry)
-> NameSpaceMap Ident IdentEntry
forall a b. (a, b) -> a
fst (NameSpaceMap Ident IdentEntry
-> Ident
-> IdentEntry
-> (NameSpaceMap Ident IdentEntry, Maybe IdentEntry)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal NameSpaceMap Ident IdentEntry
old_decls Ident
ident IdentEntry
forall {a}. Either a IdentDecl
new_def)
    doOverride :: Either a IdentDecl -> Bool
doOverride (Left a
_) = Bool
False
    doOverride (Right IdentDecl
old_def) = IdentDecl -> Bool
override_def IdentDecl
old_def
    redeclStatus' :: Maybe IdentEntry -> DeclarationStatus IdentEntry
redeclStatus' Maybe IdentEntry
overriden_decl = (IdentEntry -> IdentEntry -> Bool)
-> Ident
-> IdentEntry
-> Maybe IdentEntry
-> NameSpaceMap Ident IdentEntry
-> DeclarationStatus IdentEntry
forall k t.
Ord k =>
(t -> t -> Bool)
-> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal IdentEntry -> IdentEntry -> Bool
compatIdentEntry Ident
ident IdentEntry
forall {a}. Either a IdentDecl
new_def Maybe IdentEntry
overriden_decl NameSpaceMap Ident IdentEntry
old_decls

-- | declare a tag (fwd decl in case the struct name isn't defined yet)
declareTag :: SUERef -> TagFwdDecl -> DefTable -> (DeclarationStatus TagEntry, DefTable)
declareTag :: SUERef
-> TagFwdDecl -> DefTable -> (DeclarationStatus TagEntry, DefTable)
declareTag SUERef
sueref TagFwdDecl
decl DefTable
deftbl =
  case SUERef -> DefTable -> Maybe TagEntry
lookupTag SUERef
sueref DefTable
deftbl of
    Maybe TagEntry
Nothing -> (DeclarationStatus TagEntry
forall t. DeclarationStatus t
NewDecl, DefTable
deftbl { tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = (NameSpaceMap SUERef TagEntry, Maybe TagEntry)
-> NameSpaceMap SUERef TagEntry
forall a b. (a, b) -> a
fst ((NameSpaceMap SUERef TagEntry, Maybe TagEntry)
 -> NameSpaceMap SUERef TagEntry)
-> (NameSpaceMap SUERef TagEntry, Maybe TagEntry)
-> NameSpaceMap SUERef TagEntry
forall a b. (a -> b) -> a -> b
$ NameSpaceMap SUERef TagEntry
-> SUERef
-> TagEntry
-> (NameSpaceMap SUERef TagEntry, Maybe TagEntry)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl) SUERef
sueref (TagFwdDecl -> TagEntry
forall a b. a -> Either a b
Left TagFwdDecl
decl) })
    Just TagEntry
old_def | TagEntry -> TagEntryKind
tagKind TagEntry
old_def TagEntryKind -> TagEntryKind -> Bool
forall a. Eq a => a -> a -> Bool
== TagEntry -> TagEntryKind
tagKind (TagFwdDecl -> TagEntry
forall a b. a -> Either a b
Left TagFwdDecl
decl) ->  (TagEntry -> DeclarationStatus TagEntry
forall t. t -> DeclarationStatus t
KeepDef TagEntry
old_def, DefTable
deftbl)
                 | Bool
otherwise -> (TagEntry -> DeclarationStatus TagEntry
forall t. t -> DeclarationStatus t
KindMismatch TagEntry
old_def, DefTable
deftbl)

-- | define a tag
defineTag :: SUERef -> TagDef -> DefTable -> (DeclarationStatus TagEntry, DefTable)
defineTag :: SUERef
-> TagDef -> DefTable -> (DeclarationStatus TagEntry, DefTable)
defineTag SUERef
sueref TagDef
def DefTable
deftbl =
    (DeclarationStatus TagEntry
redeclStatus, DefTable
deftbl { tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = NameSpaceMap SUERef TagEntry
decls'})
    where
    (NameSpaceMap SUERef TagEntry
decls',Maybe TagEntry
olddecl) = NameSpaceMap SUERef TagEntry
-> SUERef
-> TagEntry
-> (NameSpaceMap SUERef TagEntry, Maybe TagEntry)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl) SUERef
sueref (TagDef -> TagEntry
forall a b. b -> Either a b
Right TagDef
def)
    redeclStatus :: DeclarationStatus TagEntry
redeclStatus =
      case Maybe TagEntry
olddecl of
        Just fwd_decl :: TagEntry
fwd_decl@(Left TagFwdDecl
_) | TagEntry -> TagEntryKind
tagKind TagEntry
fwd_decl TagEntryKind -> TagEntryKind -> Bool
forall a. Eq a => a -> a -> Bool
== TagEntry -> TagEntryKind
tagKind (TagDef -> TagEntry
forall a b. b -> Either a b
Right TagDef
def) -> DeclarationStatus TagEntry
forall t. DeclarationStatus t
NewDecl -- should be NewDef
                               | Bool
otherwise -> TagEntry -> DeclarationStatus TagEntry
forall t. t -> DeclarationStatus t
KindMismatch TagEntry
fwd_decl
        Maybe TagEntry
_ -> (TagEntry -> TagEntry -> Bool)
-> SUERef
-> TagEntry
-> Maybe TagEntry
-> NameSpaceMap SUERef TagEntry
-> DeclarationStatus TagEntry
forall k t.
Ord k =>
(t -> t -> Bool)
-> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal TagEntry -> TagEntry -> Bool
compatTagEntry SUERef
sueref (TagDef -> TagEntry
forall a b. b -> Either a b
Right TagDef
def) Maybe TagEntry
olddecl (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl)

-- | define a label
-- Return the old label if it is already defined in this function's scope
defineLabel :: Ident -> DefTable -> (DeclarationStatus Ident, DefTable)
defineLabel :: Ident -> DefTable -> (DeclarationStatus Ident, DefTable)
defineLabel Ident
ident DefTable
deftbl =
    let (NameSpaceMap Ident Ident
labels',Maybe Ident
old_label) = NameSpaceMap Ident Ident
-> Ident -> Ident -> (NameSpaceMap Ident Ident, Maybe Ident)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) Ident
ident Ident
ident
    in  (DeclarationStatus Ident
-> (Ident -> DeclarationStatus Ident)
-> Maybe Ident
-> DeclarationStatus Ident
forall b a. b -> (a -> b) -> Maybe a -> b
maybe DeclarationStatus Ident
forall t. DeclarationStatus t
NewDecl Ident -> DeclarationStatus Ident
forall t. t -> DeclarationStatus t
Redeclared Maybe Ident
old_label, DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = NameSpaceMap Ident Ident
labels' })

-- | lookup identifier (object, function, typeDef, enumerator)
lookupIdent :: Ident -> DefTable -> Maybe IdentEntry
lookupIdent :: Ident -> DefTable -> Maybe IdentEntry
lookupIdent Ident
ident DefTable
deftbl = NameSpaceMap Ident IdentEntry -> Ident -> Maybe IdentEntry
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl) Ident
ident

-- | lookup tag
lookupTag :: SUERef -> DefTable -> Maybe TagEntry
lookupTag :: SUERef -> DefTable -> Maybe TagEntry
lookupTag SUERef
sue_ref DefTable
deftbl = NameSpaceMap SUERef TagEntry -> SUERef -> Maybe TagEntry
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl) SUERef
sue_ref

-- | lookup label
lookupLabel :: Ident -> DefTable -> Maybe Ident
lookupLabel :: Ident -> DefTable -> Maybe Ident
lookupLabel Ident
ident DefTable
deftbl = NameSpaceMap Ident Ident -> Ident -> Maybe Ident
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName (DefTable -> NameSpaceMap Ident Ident
labelDefs DefTable
deftbl) Ident
ident

-- | lookup an object in the innermost scope
lookupIdentInner :: Ident -> DefTable -> Maybe IdentEntry
lookupIdentInner :: Ident -> DefTable -> Maybe IdentEntry
lookupIdentInner Ident
ident DefTable
deftbl = NameSpaceMap Ident IdentEntry -> Ident -> Maybe IdentEntry
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupInnermostScope (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl) Ident
ident

-- | lookup an identifier in the innermost scope
lookupTagInner :: SUERef -> DefTable -> Maybe TagEntry
lookupTagInner :: SUERef -> DefTable -> Maybe TagEntry
lookupTagInner SUERef
sue_ref DefTable
deftbl = NameSpaceMap SUERef TagEntry -> SUERef -> Maybe TagEntry
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupInnermostScope (DefTable -> NameSpaceMap SUERef TagEntry
tagDecls DefTable
deftbl) SUERef
sue_ref

-- | Record the type of a node.
insertType :: DefTable -> Name -> Type -> DefTable
insertType :: DefTable -> Name -> Type -> DefTable
insertType DefTable
dt Name
n Type
t = DefTable
dt { typeTable :: IntMap Type
typeTable = Int -> Type -> IntMap Type -> IntMap Type
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert (Name -> Int
nameId Name
n) Type
t (DefTable -> IntMap Type
typeTable DefTable
dt) }

-- | Lookup the type of a node.
lookupType :: DefTable -> Name -> Maybe Type
lookupType :: DefTable -> Name -> Maybe Type
lookupType DefTable
dt Name
n = Int -> IntMap Type -> Maybe Type
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Name -> Int
nameId Name
n) (DefTable -> IntMap Type
typeTable DefTable
dt)

-- | Merge two DefTables. If both tables contain an entry for a given
--   key, they must agree on its value.
mergeDefTable :: DefTable -> DefTable -> DefTable
mergeDefTable :: DefTable -> DefTable -> DefTable
mergeDefTable (DefTable NameSpaceMap Ident IdentEntry
i1 NameSpaceMap SUERef TagEntry
t1 NameSpaceMap Ident Ident
l1 NameSpaceMap Ident MemberDecl
m1 IntMap Name
r1 IntMap Type
tt1) (DefTable NameSpaceMap Ident IdentEntry
i2 NameSpaceMap SUERef TagEntry
t2 NameSpaceMap Ident Ident
l2 NameSpaceMap Ident MemberDecl
m2 IntMap Name
r2 IntMap Type
tt2) =
  NameSpaceMap Ident IdentEntry
-> NameSpaceMap SUERef TagEntry
-> NameSpaceMap Ident Ident
-> NameSpaceMap Ident MemberDecl
-> IntMap Name
-> IntMap Type
-> DefTable
DefTable
  (NameSpaceMap Ident IdentEntry
-> NameSpaceMap Ident IdentEntry -> NameSpaceMap Ident IdentEntry
forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident IdentEntry
i1 NameSpaceMap Ident IdentEntry
i2)
  (NameSpaceMap SUERef TagEntry
-> NameSpaceMap SUERef TagEntry -> NameSpaceMap SUERef TagEntry
forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap SUERef TagEntry
t1 NameSpaceMap SUERef TagEntry
t2)
  (NameSpaceMap Ident Ident
-> NameSpaceMap Ident Ident -> NameSpaceMap Ident Ident
forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident Ident
l1 NameSpaceMap Ident Ident
l2)
  (NameSpaceMap Ident MemberDecl
-> NameSpaceMap Ident MemberDecl -> NameSpaceMap Ident MemberDecl
forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident MemberDecl
m1 NameSpaceMap Ident MemberDecl
m2)
  (IntMap Name -> IntMap Name -> IntMap Name
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap Name
r1 IntMap Name
r2)
  (IntMap Type -> IntMap Type -> IntMap Type
forall a. IntMap a -> IntMap a -> IntMap a
union IntMap Type
tt1 IntMap Type
tt2)