-----------------------------------------------------------------------------
-- |
-- Module      :  Language.C.Analysis.NameSpaceMap
-- Copyright   :  (c) [1995..1999] Manuel M. T. Chakravarty
--                (c) 2008 Benedikt Huber
-- License     :  BSD-style
-- Maintainer  :  benedikt.huber@gmail.com
-- Stability   :  alpha
-- Portability :  portable
--
-- This module manages name spaces.
--
--  * A name space map associates identifiers with their definition.
--
--  * Each name space map is organized in a hierarchical way using the notion of
--    scopes. A name space map, at any moment, always has a global scope and may
--    have several local scopes. Definitions in inner scopes hide definitions
--    of the same identifier in outer scopes.
--
module Language.C.Analysis.NameSpaceMap (
    -- * name space maps
    NameSpaceMap, nameSpaceMap, nsMapToList,
    globalNames,localNames,hasLocalNames,
    -- * scope modification
    defGlobal,
    enterNewScope, leaveScope,
    defLocal,
    lookupName,lookupGlobal,lookupInnermostScope,
    mergeNameSpace
    )
where
import Prelude hiding (lookup)
import qualified Prelude
import qualified Data.Map as Map (empty, insert, lookup, toList, union)
import qualified Data.List as List (unionBy)
import Data.Map   (Map)

{-
C Namespaces and scopes:


-}

-- DevDocs:
--
-- * the definitions in the global scope are stored in a finite map, because
--   they tend to be a lot.
--
-- * the definitions of the local scopes are stored in a single list, usually
--   they are not very many and the definitions entered last are the most
--   frequently accessed ones; the list structure naturally hides older
--   definitions, i.e., definitions from outer scopes; adding new definitions
--   is done in time proportinal to the current size of the scope; removing a
--   scope is done in constant time (and the definitions of a scope can be
--   returned as a result of leaving the scope); lookup is proportional to the
--   number of definitions in the local scopes and the logarithm of the number
--   of definitions in the global scope -- i.e., efficiency relies on a
--   relatively low number of local definitions together with frequent lookup
--   of the most recently defined local identifiers
--

-- | @NameSpaceMap a@ is a Map from identifiers to @a@, which manages
-- global and local name spaces.
data NameSpaceMap k v = NsMap (Map k v)  -- defs in global scope
                              [[(k, v)]] -- stack of local scopes
globalNames :: (Ord k) => NameSpaceMap k v -> Map k v
globalNames :: forall k v. Ord k => NameSpaceMap k v -> Map k v
globalNames (NsMap Map k v
g [[(k, v)]]
_) = Map k v
g
hasLocalNames :: NameSpaceMap k v -> Bool
hasLocalNames :: forall k v. NameSpaceMap k v -> Bool
hasLocalNames (NsMap Map k v
_ [[(k, v)]]
l) = Bool -> Bool
not ([[(k, v)]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[(k, v)]]
l)
localNames :: (Ord k) => NameSpaceMap k v -> [[(k,v)]]
localNames :: forall k v. Ord k => NameSpaceMap k v -> [[(k, v)]]
localNames (NsMap Map k v
_ [[(k, v)]]
l) = [[(k, v)]]
l

-- | create a name space
nameSpaceMap :: (Ord k) => NameSpaceMap k v
nameSpaceMap :: forall k v. Ord k => NameSpaceMap k v
nameSpaceMap  = Map k v -> [[(k, v)]] -> NameSpaceMap k v
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap Map k v
forall k a. Map k a
Map.empty []



-- | Add global definition
--
-- @(ns',oldDef) = defGlobal ns ident def@
--   adds a global definition @ident := def@ to the namespace.
--   It returns the modified namespace @ns'@. If the identifier is
--   already declared in the global namespace, the definition is overwritten
--   and the old definition @oldDef@ is returned.
defGlobal :: (Ord k) => NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defGlobal :: forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defGlobal (NsMap Map k a
gs [[(k, a)]]
lss) k
ident a
def
    = (Map k a -> [[(k, a)]] -> NameSpaceMap k a
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap (k -> a -> Map k a -> Map k a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert k
ident a
def Map k a
gs) [[(k, a)]]
lss, k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ident Map k a
gs)

-- | Enter new local scope
--
-- @ns' = enterNewScope ns@ creates and enters a new local scope.
enterNewScope :: (Ord k) => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope :: forall k a. Ord k => NameSpaceMap k a -> NameSpaceMap k a
enterNewScope (NsMap Map k a
gs [[(k, a)]]
lss)  = Map k a -> [[(k, a)]] -> NameSpaceMap k a
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap Map k a
gs ([][(k, a)] -> [[(k, a)]] -> [[(k, a)]]
forall a. a -> [a] -> [a]
:[[(k, a)]]
lss)

-- | Leave innermost local scope
--
-- @(ns',defs) = leaveScope ns@ pops leaves the innermost local scope.
--  and returns its definitions
leaveScope :: (Ord k) => NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
leaveScope :: forall k a.
Ord k =>
NameSpaceMap k a -> (NameSpaceMap k a, [(k, a)])
leaveScope (NsMap Map k a
_ [])         = [Char] -> (NameSpaceMap k a, [(k, a)])
forall a. HasCallStack => [Char] -> a
error [Char]
"NsMaps.leaveScope: No local scope!"
leaveScope (NsMap Map k a
gs ([(k, a)]
ls:[[(k, a)]]
lss))  = (Map k a -> [[(k, a)]] -> NameSpaceMap k a
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap Map k a
gs [[(k, a)]]
lss, [(k, a)]
ls)

-- | Add local definition
--
-- @(ns',oldDef) = defLocal ns ident def@ adds the local definition
--   @ident := def@ to the innermost local scope, if there is a local scope,
--     and to the global scope otherwise.
--   It returns the modified name space @ns'@ and the old  binding of
--   the identifier @oldDef@, which is overwritten.
defLocal :: (Ord k) => NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal :: forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defLocal ns :: NameSpaceMap k a
ns@(NsMap Map k a
_ []) k
ident a
def = NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
forall k a.
Ord k =>
NameSpaceMap k a -> k -> a -> (NameSpaceMap k a, Maybe a)
defGlobal NameSpaceMap k a
ns k
ident a
def
defLocal (NsMap    Map k a
gs ([(k, a)]
ls:[[(k, a)]]
lss)) k
ident a
def =
  (Map k a -> [[(k, a)]] -> NameSpaceMap k a
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap Map k a
gs (((k
ident, a
def)(k, a) -> [(k, a)] -> [(k, a)]
forall a. a -> [a] -> [a]
:[(k, a)]
ls)[(k, a)] -> [[(k, a)]] -> [[(k, a)]]
forall a. a -> [a] -> [a]
:[[(k, a)]]
lss),
   k -> [(k, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup k
ident [(k, a)]
ls)

-- | Search for a definition
--
-- @def = find ns ident@ returns the definition in some scope (inner to outer),
-- if there is one.
lookupName :: (Ord k) => NameSpaceMap k a -> k -> Maybe a
lookupName :: forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupName ns :: NameSpaceMap k a
ns@(NsMap Map k a
_ [[(k, a)]]
localDefs) k
ident
    = case [[(k, a)]] -> Maybe a
forall {a}. [[(k, a)]] -> Maybe a
lookupLocal [[(k, a)]]
localDefs of
        Maybe a
Nothing  -> NameSpaceMap k a -> k -> Maybe a
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupGlobal NameSpaceMap k a
ns k
ident
        Just a
def -> a -> Maybe a
forall a. a -> Maybe a
Just a
def
  where
    lookupLocal :: [[(k, a)]] -> Maybe a
lookupLocal []       = Maybe a
forall a. Maybe a
Nothing
    lookupLocal ([(k, a)]
ls:[[(k, a)]]
lss) =
      case k -> [(k, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup k
ident [(k, a)]
ls of
        Maybe a
Nothing  -> [[(k, a)]] -> Maybe a
lookupLocal [[(k, a)]]
lss
        Just a
def -> a -> Maybe a
forall a. a -> Maybe a
Just a
def

lookupGlobal :: (Ord k) => NameSpaceMap k a -> k -> Maybe a
lookupGlobal :: forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupGlobal (NsMap Map k a
gs [[(k, a)]]
_) k
ident = k -> Map k a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
ident Map k a
gs

lookupInnermostScope :: (Ord k) => NameSpaceMap k a -> k -> Maybe a
lookupInnermostScope :: forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupInnermostScope nsm :: NameSpaceMap k a
nsm@(NsMap Map k a
_gs [[(k, a)]]
localDefs) k
ident  =
    case [[(k, a)]]
localDefs of
        ([(k, a)]
ls : [[(k, a)]]
_lss) -> k -> [(k, a)] -> Maybe a
forall a b. Eq a => a -> [(a, b)] -> Maybe b
Prelude.lookup k
ident [(k, a)]
ls
        [] -> NameSpaceMap k a -> k -> Maybe a
forall k a. Ord k => NameSpaceMap k a -> k -> Maybe a
lookupGlobal NameSpaceMap k a
nsm k
ident

-- | flatten a namespace into a assoc list
--
--  @nameSpaceToList ns = (localDefInnermost ns ++ .. ++ localDefsOutermost ns) ++ globalDefs ns@
nsMapToList :: (Ord k) => NameSpaceMap k a -> [(k, a)]
nsMapToList :: forall k a. Ord k => NameSpaceMap k a -> [(k, a)]
nsMapToList (NsMap Map k a
gs [[(k, a)]]
lss)  = [[(k, a)]] -> [(k, a)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(k, a)]]
lss [(k, a)] -> [(k, a)] -> [(k, a)]
forall a. [a] -> [a] -> [a]
++ Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k a
gs

-- | Merge two namespaces. If they disagree on the types of any
--   variables, all bets are off.
mergeNameSpace :: (Ord k) =>
                  NameSpaceMap k a
               -> NameSpaceMap k a
               -> NameSpaceMap k a
mergeNameSpace :: forall k a.
Ord k =>
NameSpaceMap k a -> NameSpaceMap k a -> NameSpaceMap k a
mergeNameSpace (NsMap Map k a
global1 [[(k, a)]]
local1) (NsMap Map k a
global2 [[(k, a)]]
local2) =
  Map k a -> [[(k, a)]] -> NameSpaceMap k a
forall k v. Map k v -> [[(k, v)]] -> NameSpaceMap k v
NsMap (Map k a -> Map k a -> Map k a
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map k a
global1 Map k a
global2) ([[(k, a)]] -> [[(k, a)]] -> [[(k, a)]]
forall {a} {b}. Eq a => [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
localUnion [[(k, a)]]
local1 [[(k, a)]]
local2)
  where localUnion :: [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
localUnion ([(a, b)]
l1:[[(a, b)]]
ls1) ([(a, b)]
l2:[[(a, b)]]
ls2) =
          ((a, b) -> (a, b) -> Bool) -> [(a, b)] -> [(a, b)] -> [(a, b)]
forall a. (a -> a -> Bool) -> [a] -> [a] -> [a]
List.unionBy (\(a, b)
p1 (a, b)
p2 -> (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
p1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== (a, b) -> a
forall a b. (a, b) -> a
fst (a, b)
p2) [(a, b)]
l1 [(a, b)]
l2 [(a, b)] -> [[(a, b)]] -> [[(a, b)]]
forall a. a -> [a] -> [a]
: [[(a, b)]] -> [[(a, b)]] -> [[(a, b)]]
localUnion [[(a, b)]]
ls1 [[(a, b)]]
ls2
        localUnion [] [[(a, b)]]
ls2 = [[(a, b)]]
ls2
        localUnion [[(a, b)]]
ls1 [] = [[(a, b)]]
ls1