{-# 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.Generics

{- 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 ctr :: CompTypeRef
ctr) = CompTypeRef -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef CompTypeRef
ctr
  sueRef (EnumDecl etr :: EnumTypeRef
etr) = EnumTypeRef -> SUERef
forall a. HasSUERef a => a -> SUERef
sueRef EnumTypeRef
etr
instance CNode TagFwdDecl where
  nodeInfo :: TagFwdDecl -> NodeInfo
nodeInfo (CompDecl ctr :: CompTypeRef
ctr) = CompTypeRef -> NodeInfo
forall a. CNode a => a -> NodeInfo
nodeInfo CompTypeRef
ctr
  nodeInfo (EnumDecl etr :: 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 deftbl :: 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
    (_fwd_decls :: Map SUERef TagFwdDecl
_fwd_decls,gtags :: 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
ident (Left tydef :: TypeDef
tydef) ds :: 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
ident (Right obj :: IdentDecl
obj) ds :: 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 dt :: 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_ :: 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 deftbl :: 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 deftbl :: 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 deftbl :: 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 deftbl :: 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 deftbl :: 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 deftbl :: 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 deftbl :: 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 deftbl :: DefTable
deftbl =
    let (decls' :: NameSpaceMap Ident MemberDecl
decls',members :: [(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)
DataType
Constr
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 d. Data d => c (t d)) -> Maybe (c (DeclarationStatus t))
(forall b. Data b => b -> b)
-> DeclarationStatus t -> DeclarationStatus t
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> DeclarationStatus t
-> c (DeclarationStatus t)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (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))
$cKindMismatch :: Constr
$cShadowed :: Constr
$cKeepDef :: Constr
$cRedeclared :: Constr
$cNewDecl :: Constr
$tDeclarationStatus :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> DeclarationStatus t -> [u]
$cgmapQ :: forall t u.
Data t =>
(forall d. Data d => d -> u) -> DeclarationStatus t -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall t. Data t => Typeable (DeclarationStatus t)
Data,Typeable)
declStatusDescr :: DeclarationStatus t -> String
declStatusDescr :: DeclarationStatus t -> String
declStatusDescr NewDecl = "new"
declStatusDescr (Redeclared _) = "redeclared"
declStatusDescr (KeepDef _) = "keep old"
declStatusDescr (Shadowed _) = "shadowed"
declStatusDescr (KindMismatch _) = "kind mismatch"

compatIdentEntry :: IdentEntry -> IdentEntry -> Bool
compatIdentEntry :: IdentEntry -> IdentEntry -> Bool
compatIdentEntry (Left _tydef :: 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 def :: 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
$
  \other_def :: IdentDecl
other_def -> case (IdentDecl
def,IdentDecl
other_def) of
                  (EnumeratorDef _, EnumeratorDef _) -> Bool
True
                  (EnumeratorDef _, _) -> Bool
True
                  (_, EnumeratorDef _) -> Bool
True
                  (_,_) -> 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
$cp1Ord :: Eq TagEntryKind
Ord)
instance Show TagEntryKind where
  show :: TagEntryKind -> String
show (CompKind ctk :: CompTyKind
ctk) = CompTyKind -> String
forall a. Show a => a -> String
show CompTyKind
ctk
  show EnumKind = "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 cd :: CompTypeRef
cd)) = CompTyKind -> TagEntryKind
CompKind (CompTypeRef -> CompTyKind
forall a. HasCompTyKind a => a -> CompTyKind
compTag CompTypeRef
cd)
tagKind (Left (EnumDecl _)) = TagEntryKind
EnumKind
tagKind (Right (CompDef cd :: CompType
cd)) = CompTyKind -> TagEntryKind
CompKind (CompType -> CompTyKind
forall a. HasCompTyKind a => a -> CompTyKind
compTag CompType
cd)
tagKind (Right (EnumDef _)) =  TagEntryKind
EnumKind

compatTagEntry :: TagEntry -> TagEntry -> Bool
compatTagEntry :: TagEntry -> TagEntry -> Bool
compatTagEntry  te1 :: TagEntry
te1 te2 :: 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 :: (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus sameKind :: t -> t -> Bool
sameKind def :: t
def oldDecl :: Maybe t
oldDecl =
    case Maybe t
oldDecl of
        Just def' :: 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'
        Nothing                         -> DeclarationStatus t
forall t. DeclarationStatus t
NewDecl

defRedeclStatusLocal :: (Ord k) =>
                        (t -> t -> Bool) -> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal :: (t -> t -> Bool)
-> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal sameKind :: t -> t -> Bool
sameKind ident :: k
ident def :: t
def oldDecl :: Maybe t
oldDecl nsm :: 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
        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 shadowed :: t
shadowed -> t -> DeclarationStatus t
forall t. t -> DeclarationStatus t
Shadowed t
shadowed
                     Nothing       -> DeclarationStatus t
forall t. DeclarationStatus t
NewDecl
        redecl :: DeclarationStatus t
redecl  -> DeclarationStatus t
redecl

defineTypeDef :: Ident -> TypeDef -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineTypeDef :: Ident
-> TypeDef -> DefTable -> (DeclarationStatus IdentEntry, DefTable)
defineTypeDef ident :: Ident
ident tydef :: TypeDef
tydef deftbl :: 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
  (decls' :: NameSpaceMap Ident IdentEntry
decls', oldDecl :: 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
ident def :: IdentDecl
def deftbl :: 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
    (decls' :: NameSpaceMap Ident IdentEntry
decls',oldDecl :: 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 override_def :: IdentDecl -> Bool
override_def ident :: Ident
ident def :: IdentDecl
def deftbl :: 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
    (decls' :: NameSpaceMap Ident IdentEntry
decls',redecl_status :: DeclarationStatus IdentEntry
redecl_status)  | (Just old_decl :: 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 _) = Bool
False
    doOverride (Right old_def :: IdentDecl
old_def) = IdentDecl -> Bool
override_def IdentDecl
old_def
    redeclStatus' :: Maybe IdentEntry -> DeclarationStatus IdentEntry
redeclStatus' overriden_decl :: 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
sueref decl :: TagFwdDecl
decl deftbl :: DefTable
deftbl =
  case SUERef -> DefTable -> Maybe TagEntry
lookupTag SUERef
sueref DefTable
deftbl of
    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 old_def :: 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
sueref def :: TagDef
def deftbl :: DefTable
deftbl =
    (DeclarationStatus TagEntry
redeclStatus, DefTable
deftbl { tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = NameSpaceMap SUERef TagEntry
decls'})
    where
    (decls' :: NameSpaceMap SUERef TagEntry
decls',olddecl :: 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 _) | 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
        _ -> (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
ident deftbl :: DefTable
deftbl =
    let (labels' :: NameSpaceMap Ident Ident
labels',old_label :: 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
ident deftbl :: 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 sue_ref :: SUERef
sue_ref deftbl :: 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
ident deftbl :: 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
ident deftbl :: 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 sue_ref :: SUERef
sue_ref deftbl :: 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 dt :: DefTable
dt n :: Name
n t :: 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 dt :: DefTable
dt n :: 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 i1 :: NameSpaceMap Ident IdentEntry
i1 t1 :: NameSpaceMap SUERef TagEntry
t1 l1 :: NameSpaceMap Ident Ident
l1 m1 :: NameSpaceMap Ident MemberDecl
m1 r1 :: IntMap Name
r1 tt1 :: IntMap Type
tt1) (DefTable i2 :: NameSpaceMap Ident IdentEntry
i2 t2 :: NameSpaceMap SUERef TagEntry
t2 l2 :: NameSpaceMap Ident Ident
l2 m2 :: NameSpaceMap Ident MemberDecl
m2 r2 :: IntMap Name
r2 tt2 :: 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)