--  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 proportinal 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  = forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
NameSpace forall k a. Map k a
Map.empty []

-- add global definition (EXPORTED)
--
--  * returns the modfied name space
--
--  * if the identfier is already declared, the resulting name space contains
--   the new binding and the second component of the result contains the
--   definition declared previosuly (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  = (forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
NameSpace (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,
                                        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)  = forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
NameSpace Map Ident a
gs ([]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 [])        = forall a. String -> a
interr String
"NameSpaces.leaveRange: \
                                             \No local range!"
leaveRange (NameSpace Map Ident a
gs ([(Ident, a)]
ls:[[(Ident, a)]]
lss))  = (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 modfied name space
--
--  * if there is no local range, the definition is entered globally
--
--  * if the identfier is already declared, the resulting name space contains
--   the new binding and the second component of the result contains the
--   definition declared previosuly (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 = 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 =
  (forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
NameSpace Map Ident a
gs (((Ident
id, a
def)forall a. a -> [a] -> [a]
:[(Ident, a)]
ls)forall a. a -> [a] -> [a]
:[[(Ident, a)]]
lss),
   forall {a}. [(Ident, a)] -> Maybe a
lookup [(Ident, a)]
ls)
  where
    lookup :: [(Ident, a)] -> Maybe a
lookup []                          = forall a. Maybe a
Nothing
    lookup ((Ident
id', a
def):[(Ident, a)]
ls) | Ident
id forall a. Eq a => a -> a -> Bool
== Ident
id' = 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 (forall {a}. [[(Ident, a)]] -> Maybe a
lookup [[(Ident, a)]]
lss) of
                                Maybe a
Nothing  -> forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
id Map Ident a
gs
                                Just a
def -> forall a. a -> Maybe a
Just a
def
                              where
                                lookup :: [[(Ident, a)]] -> Maybe a
lookup []       = forall a. Maybe a
Nothing
                                lookup ([(Ident, a)]
ls:[[(Ident, a)]]
lss) = case (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 -> forall a. a -> Maybe a
Just a
def

                                lookup' :: [(Ident, a)] -> Maybe a
lookup' []              = forall a. Maybe a
Nothing
                                lookup' ((Ident
id', a
def):[(Ident, a)]
ls)
                                        | Ident
id' forall a. Eq a => a -> a -> Bool
== Ident
id     = 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)  = forall k a. Map k a -> [(k, a)]
Map.toList Map Ident a
gs forall a. [a] -> [a] -> [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
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh Map Ident a
aa
            forall a. Binary a => BinHandle -> a -> IO ()
put_ BinHandle
bh [[(Ident, a)]]
ab
    get :: BinHandle -> IO (NameSpace a)
get BinHandle
bh = do
    Map Ident a
aa <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    [[(Ident, a)]]
ab <- forall a. Binary a => BinHandle -> IO a
get BinHandle
bh
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Map Ident a -> [[(Ident, a)]] -> NameSpace a
NameSpace Map Ident a
aa [[(Ident, a)]]
ab)