{-# 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 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either TypeDef -> Ident
identOfTypeDef forall n. Declaration n => n -> Ident
declIdent

data TagFwdDecl = CompDecl CompTypeRef
                | EnumDecl EnumTypeRef
instance HasSUERef TagFwdDecl where
  sueRef :: TagFwdDecl -> SUERef
sueRef (CompDecl CompTypeRef
ctr) = forall a. HasSUERef a => a -> SUERef
sueRef CompTypeRef
ctr
  sueRef (EnumDecl EnumTypeRef
etr) = forall a. HasSUERef a => a -> SUERef
sueRef EnumTypeRef
etr
instance CNode TagFwdDecl where
  nodeInfo :: TagFwdDecl -> NodeInfo
nodeInfo (CompDecl CompTypeRef
ctr) = forall a. CNode a => a -> NodeInfo
nodeInfo CompTypeRef
ctr
  nodeInfo (EnumDecl EnumTypeRef
etr) = 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 forall k v. Ord k => NameSpaceMap k v
nameSpaceMap forall k v. Ord k => NameSpaceMap k v
nameSpaceMap forall k v. Ord k => NameSpaceMap k v
nameSpaceMap forall k v. Ord k => NameSpaceMap k v
nameSpaceMap forall a. IntMap a
IntMap.empty forall a. IntMap a
IntMap.empty

-- | get the globally defined entries of a definition table
globalDefs :: DefTable -> GlobalDecls
globalDefs :: DefTable -> GlobalDecls
globalDefs DefTable
deftbl = 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 forall {k} {a}. Map k a
e Map SUERef TagDef
gtags forall {k} {a}. Map k a
e) (forall k v. Ord k => NameSpaceMap k v -> Map k v
globalNames forall a b. (a -> b) -> a -> b
$ DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl)
    where
    e :: Map k a
e = forall {k} {a}. Map k a
Map.empty
    (Map SUERef TagFwdDecl
_fwd_decls,Map SUERef TagDef
gtags) = forall a b c k. (a -> Either b c) -> Map k a -> (Map k b, Map k c)
Map.mapEither forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ 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 = 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 = 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 (forall k v. NameSpaceMap k v -> Bool
hasLocalNames (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
dt) Bool -> Bool -> 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_ = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl),
        tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = 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 = forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
leaveScope_ (DefTable -> NameSpaceMap Ident IdentEntry
identDecls DefTable
deftbl),
                        tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = 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  forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = 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 forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = 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 forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = 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 forall a b. (a -> b) -> a -> b
$ DefTable
deftbl { labelDefs :: NameSpaceMap Ident Ident
labelDefs = 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 = 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) = forall k a.
Ord k =>
NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
leaveScope (DefTable -> NameSpaceMap Ident MemberDecl
memberDecls DefTable
deftbl)
    in (,) (forall a b. (a -> b) -> [a] -> [b]
map 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 (DeclarationStatus t -> DataType
DeclarationStatus t -> Constr
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 (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))
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) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
True) (forall a b. a -> b -> a
const Bool
False)
compatIdentEntry (Right IdentDecl
def) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const Bool
False) 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
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
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) = 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 (forall a. HasCompTyKind a => a -> CompTyKind
compTag CompTypeRef
cd)
tagKind (Left (EnumDecl EnumTypeRef
_)) = TagEntryKind
EnumKind
tagKind (Right (CompDef CompType
cd)) = CompTyKind -> TagEntryKind
CompKind (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 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' -> forall t. t -> DeclarationStatus t
Redeclared t
def'
                  | Bool
otherwise           -> forall t. t -> DeclarationStatus t
KindMismatch t
def'
        Maybe t
Nothing                         -> 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 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 forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName NameSpaceMap k t
nsm k
ident of
                     Just t
shadowed -> forall t. t -> DeclarationStatus t
Shadowed t
shadowed
                     Maybe t
Nothing       -> 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 =
  (forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus IdentEntry -> IdentEntry -> Bool
compatIdentEntry (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) = 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 (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 =
    (forall t. (t -> t -> Bool) -> t -> Maybe t -> DeclarationStatus t
defRedeclStatus IdentEntry -> IdentEntry -> Bool
compatIdentEntry (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) = 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 (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 (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 = 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 = 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` forall {a}. Either a IdentDecl
new_def)
                              = (NameSpaceMap Ident IdentEntry
new_decls, forall t. t -> DeclarationStatus t
KindMismatch IdentEntry
old_decl)
                            | forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True 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, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall t. DeclarationStatus t
NewDecl forall t. t -> DeclarationStatus t
KeepDef Maybe IdentEntry
old_decl_opt)
    new_decls :: NameSpaceMap Ident IdentEntry
new_decls = forall a b. (a, b) -> a
fst (forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal NameSpaceMap Ident IdentEntry
old_decls Ident
ident 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 = forall k t.
Ord k =>
(t -> t -> Bool)
-> k -> t -> Maybe t -> NameSpaceMap k t -> DeclarationStatus t
defRedeclStatusLocal IdentEntry -> IdentEntry -> Bool
compatIdentEntry Ident
ident 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 -> (forall t. DeclarationStatus t
NewDecl, DefTable
deftbl { tagDecls :: NameSpaceMap SUERef TagEntry
tagDecls = forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ 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 (forall a b. a -> Either a b
Left TagFwdDecl
decl) })
    Just TagEntry
old_def | TagEntry -> TagEntryKind
tagKind TagEntry
old_def forall a. Eq a => a -> a -> Bool
== TagEntry -> TagEntryKind
tagKind (forall a b. a -> Either a b
Left TagFwdDecl
decl) ->  (forall t. t -> DeclarationStatus t
KeepDef TagEntry
old_def, DefTable
deftbl)
                 | Bool
otherwise -> (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) = 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 (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 forall a. Eq a => a -> a -> Bool
== TagEntry -> TagEntryKind
tagKind (forall a b. b -> Either a b
Right TagDef
def) -> forall t. DeclarationStatus t
NewDecl -- should be NewDef
                               | Bool
otherwise -> forall t. t -> DeclarationStatus t
KindMismatch TagEntry
fwd_decl
        Maybe 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 (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) = 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  (forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall t. DeclarationStatus t
NewDecl 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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
  (forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident IdentEntry
i1 NameSpaceMap Ident IdentEntry
i2)
  (forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap SUERef TagEntry
t1 NameSpaceMap SUERef TagEntry
t2)
  (forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident Ident
l1 NameSpaceMap Ident Ident
l2)
  (forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace NameSpaceMap Ident MemberDecl
m1 NameSpaceMap Ident MemberDecl
m2)
  (forall a. IntMap a -> IntMap a -> IntMap a
union IntMap Name
r1 IntMap Name
r2)
  (forall a. IntMap a -> IntMap a -> IntMap a
union IntMap Type
tt1 IntMap Type
tt2)