    --  Compiler Toolkit: name space management
    --
    --  Author : Manuel M. T. Chakravarty
    --  Created: 12 November 95
    --
    --  Version $Revision: 1.2 $ from $Date: 2004/11/13 17:26:50 $
    --
    --  Copyright (c) [1995..1999] Manuel M. T. Chakravarty
    --
    --  This file is free software; you can redistribute it and/or modify
    --  it under the terms of the GNU General Public License as published by
    --  the Free Software Foundation; either version 2 of the License, or
    --  (at your option) any later version.
    --
    --  This file is distributed in the hope that it will be useful,
    --  but WITHOUT ANY WARRANTY; without even the implied warranty of
    --  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    --  GNU General Public License for more details.
    --
    --- DESCRIPTION ---------------------------------------------------------------
    --
    --  This module manages name spaces.
    --
    --- DOCU ----------------------------------------------------------------------
    --
    --  language: Haskell 98
    --
    --  * A name space associates identifiers with their definition.
    --
    --  * Each name space is organized in a hierarchical way using the notion of
    --    ranges. A name space, at any moment, always has a global range and may
    --    have several local ranges. Definitions in inner ranges hide definitions
    --    of the same identifiert in outer ranges.
    --
    --- TODO ----------------------------------------------------------------------
    --
    --  * evaluate the performance gain that a hashtable would bring
    --

    module NameSpaces (NameSpace, nameSpace, defGlobal, enterNewRange, leaveRange,
                       defLocal, find, nameSpaceToList)
    where

    import Map        (Map)
    import qualified  Map as Map (empty, insert, lookup, toList)
    import Idents     (Ident)
    import Errors     (interr)
    import Binary     (Binary(..))

    -- name space (EXPORTED ABSTRACT)
    --
    --  * the definitions in the global ranges are stored in a finite map, because
    --   they tend to be a lot and are normally not updated after the global range
    --   is constructed
    --
    --  * the definitions of the local ranges 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 ranges; adding new definitions
    --   is done in time proportional to the current size of the range; removing a
    --   range is done in constant time (and the definitions of a range can be
    --   returned as a result of leaving the range); lookup is proportional to the
    --   number of definitions in the local ranges and the logarithm of the number
    --   of definitions in the global range---i.e., efficiency relies on a
    --   relatively low number of local definitions together with frequent lookup
    --   of the most recently defined local identifiers
    --
    data NameSpace a = NameSpace (Map Ident a)  -- defs in global range
                                 [[(Ident, a)]]       -- stack of local ranges

    -- create a name space (EXPORTED)
    --
    nameSpace :: NameSpace a
    nameSpace :: forall a. NameSpace a
    nameSpace  = Map Ident a -> [[(Ident, a)]] -> NameSpace a
    forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
    NameSpace Map Ident a
    forall k a. Map k a
    Map.empty []

    -- add global definition (EXPORTED)
    --
    --  * returns the modified name space
    --
    --  * if the identifier is already declared, the resulting name space contains
    --   the new binding and the second component of the result contains the
    --   definition declared previously (which is henceforth not contained in the
    --   name space anymore)
    --
    defGlobal :: NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defGlobal :: forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defGlobal (NameSpace Map Ident a
    gs [[(Ident, a)]]
    lss) Ident
    id a
    def  = (Map Ident a -> [[(Ident, a)]] -> NameSpace a
    forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
    NameSpace (Ident -> a -> Map Ident a -> Map Ident a
    forall k a. Ord k => k -> a -> Map k a -> Map k a
    Map.insert Ident
    id a
    def Map Ident a
    gs) [[(Ident, a)]]
    lss,
                                            Ident -> Map Ident a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Ident
    id Map Ident a
    gs)

    -- add new range (EXPORTED)
    --
    enterNewRange                    :: NameSpace a -> NameSpace a
    enterNewRange :: forall a. NameSpace a -> NameSpace a
    enterNewRange (NameSpace Map Ident a
    gs [[(Ident, a)]]
    lss)  = Map Ident a -> [[(Ident, a)]] -> NameSpace a
    forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
    NameSpace Map Ident a
    gs ([][(Ident, a)] -> [[(Ident, a)]] -> [[(Ident, a)]]
    forall a. a -> [a] -> [a]
    :[[(Ident, a)]]
    lss)

    -- pop topmost range and return its definitions (EXPORTED)
    --
    leaveRange :: NameSpace a -> (NameSpace a, [(Ident, a)])
    leaveRange :: forall a. NameSpace a -> (NameSpace a, [(Ident, a)])
    leaveRange (NameSpace Map Ident a
    gs [])        = String -> (NameSpace a, [(Ident, a)])
    forall a. String -> a
    interr String
    "NameSpaces.leaveRange: \
                                                 \No local range!"
    leaveRange (NameSpace Map Ident a
    gs ([(Ident, a)]
    ls:[[(Ident, a)]]
    lss))  = (Map Ident a -> [[(Ident, a)]] -> NameSpace a
    forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
    NameSpace Map Ident a
    gs [[(Ident, a)]]
    lss, [(Ident, a)]
    ls)

    -- add local definition (EXPORTED)
    --
    --  * returns the modified name space
    --
    --  * if there is no local range, the definition is entered globally
    --
    --  * if the identifier is already declared, the resulting name space contains
    --   the new binding and the second component of the result contains the
    --   definition declared previously (which is henceforth not contained in the
    --   name space anymore)
    --
    defLocal :: NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defLocal :: forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defLocal ns :: NameSpace a
    ns@(NameSpace Map Ident a
    gs []      ) Ident
    id a
    def = NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    forall a. NameSpace a -> Ident -> a -> (NameSpace a, Maybe a)
    defGlobal NameSpace a
    ns Ident
    id a
    def
    defLocal (NameSpace    Map Ident a
    gs ([(Ident, a)]
    ls:[[(Ident, a)]]
    lss)) Ident
    id a
    def =
      (Map Ident a -> [[(Ident, a)]] -> NameSpace a
    forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
    NameSpace Map Ident a
    gs (((Ident
    id, a
    def)(Ident, a) -> [(Ident, a)] -> [(Ident, a)]
    forall a. a -> [a] -> [a]
    :[(Ident, a)]
    ls)[(Ident, a)] -> [[(Ident, a)]] -> [[(Ident, a)]]
    forall a. a -> [a] -> [a]
    :[[(Ident, a)]]
    lss),
       [(Ident, a)] -> Maybe a
    forall {a}. [(Ident, a)] -> Maybe a
    lookup [(Ident, a)]
    ls)
      where
        lookup :: [(Ident, a)] -> Maybe a
    lookup []                          = Maybe a
    forall a. Maybe a
    Nothing
        lookup ((Ident
    id', a
    def):[(Ident, a)]
    ls) | Ident
    id Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    id' = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    def
                               | Bool
    otherwise = [(Ident, a)] -> Maybe a
    lookup [(Ident, a)]
    ls

    -- search for a definition (EXPORTED)
    --
    --  * the definition from the innermost range is returned, if any
    --
    find                       :: NameSpace a -> Ident -> Maybe a
    find :: forall a. NameSpace a -> Ident -> Maybe a
    find (NameSpace Map Ident a
    gs [[(Ident, a)]]
    lss) Ident
    id  = case ([[(Ident, a)]] -> Maybe a
    forall {a}. [[(Ident, a)]] -> Maybe a
    lookup [[(Ident, a)]]
    lss) of
                                    Maybe a
    Nothing  -> Ident -> Map Ident a -> Maybe a
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Ident
    id Map Ident a
    gs
                                    Just a
    def -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    def
                                  where
                                    lookup :: [[(Ident, a)]] -> Maybe a
    lookup []       = Maybe a
    forall a. Maybe a
    Nothing
                                    lookup ([(Ident, a)]
    ls:[[(Ident, a)]]
    lss) = case ([(Ident, a)] -> Maybe a
    forall {a}. [(Ident, a)] -> Maybe a
    lookup' [(Ident, a)]
    ls) of
                                                        Maybe a
    Nothing  -> [[(Ident, a)]] -> Maybe a
    lookup [[(Ident, a)]]
    lss
                                                        Just a
    def -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    def

                                    lookup' :: [(Ident, a)] -> Maybe a
    lookup' []              = Maybe a
    forall a. Maybe a
    Nothing
                                    lookup' ((Ident
    id', a
    def):[(Ident, a)]
    ls)
                                            | Ident
    id' Ident -> Ident -> Bool
    forall a. Eq a => a -> a -> Bool
    == Ident
    id     = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    def
                                            | Bool
    otherwise     = [(Ident, a)] -> Maybe a
    lookup' [(Ident, a)]
    ls

    -- dump a name space into a list (EXPORTED)
    --
    --  * local ranges are concatenated
    --
    nameSpaceToList                    :: NameSpace a -> [(Ident, a)]
    nameSpaceToList :: forall a. NameSpace a -> [(Ident, a)]
    nameSpaceToList (NameSpace Map Ident a
    gs [[(Ident, a)]]
    lss)  = Map Ident a -> [(Ident, a)]
    forall k a. Map k a -> [(k, a)]
    Map.toList Map Ident a
    gs [(Ident, a)] -> [(Ident, a)] -> [(Ident, a)]
    forall a. [a] -> [a] -> [a]
    ++ [[(Ident, a)]] -> [(Ident, a)]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat [[(Ident, a)]]
    lss

    {-! for NameSpace derive : GhcBinary !-}
    {-* Generated by DrIFT : Look, but Don't Touch. *-}
    instance (Binary a) => Binary (NameSpace a) where
        put_ :: BinHandle -> NameSpace a -> IO ()
    put_ BinHandle
    bh (NameSpace Map Ident a
    aa [[(Ident, a)]]
    ab) = do
                BinHandle -> Map Ident a -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh Map Ident a
    aa
                BinHandle -> [[(Ident, a)]] -> IO ()
    forall a. Binary a => BinHandle -> a -> IO ()
    put_ BinHandle
    bh [[(Ident, a)]]
    ab
        get :: BinHandle -> IO (NameSpace a)
    get BinHandle
    bh = do
        aa <- BinHandle -> IO (Map Ident a)
    forall a. Binary a => BinHandle -> IO a
    get BinHandle
    bh
        ab <- get bh
        return (NameSpace aa ab)