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(..))
data NameSpace a = NameSpace (Map Ident a)
[[(Ident, a)]]
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 []
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)
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)
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)
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
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
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
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)