module DDC.Base.Env
(
Bind (..)
, Bound (..)
, Env (..)
, fromList
, fromNameList
, fromNameMap
, empty
, singleton
, extend, extends
, union, unions
, member
, lookup
, lookupName, lookupIx
, depth)
where
import Data.Maybe
import Data.Map (Map)
import qualified Data.Map.Strict as Map
import qualified Prelude as P
import Prelude hiding (lookup)
data Bind n
= BNone
| BAnon
| BName !n
deriving (Eq, Ord, Show)
data Bound n
= UIx !Int
| UName !n
deriving (Eq, Ord, Show)
data Env n a
= Env
{
envMap :: !(Map n a)
, envStack :: ![a]
, envStackLength :: !Int }
fromList :: Ord n => [(Bind n, a)] -> Env n a
fromList bs
= foldr (uncurry extend) empty bs
fromNameList :: Ord n => [(n, a)] -> Env n a
fromNameList bs
= foldr (uncurry extend) empty
$ [(BName n, x) | (n, x) <- bs ]
fromNameMap :: Map n a -> Env n a
fromNameMap m
= empty { envMap = m }
empty :: Env n a
empty = Env
{ envMap = Map.empty
, envStack = []
, envStackLength = 0 }
singleton :: Ord n => Bind n -> a -> Env n a
singleton b x
= extend b x empty
extend :: Ord n => Bind n -> a -> Env n a -> Env n a
extend bb x env
= case bb of
BNone{} -> env
BAnon -> env { envStack = x : envStack env
, envStackLength = envStackLength env + 1 }
BName n -> env { envMap = Map.insert n x (envMap env) }
extends :: Ord n => [(Bind n, a)] -> Env n a -> Env n a
extends bs env
= foldl (flip (uncurry extend)) env bs
union :: Ord n => Env n a -> Env n a -> Env n a
union env1 env2
= Env
{ envMap = envMap env1 `Map.union` envMap env2
, envStack = envStack env2 ++ envStack env1
, envStackLength = envStackLength env2 + envStackLength env1 }
unions :: Ord n => [Env n a] -> Env n a
unions envs
= foldr union empty envs
member :: Ord n => Bound n -> Env n a -> Bool
member uu env
= isJust $ lookup uu env
lookup :: Ord n => Bound n -> Env n a -> Maybe a
lookup uu env
= case uu of
UIx i -> P.lookup i (zip [0..] (envStack env))
UName n -> Map.lookup n (envMap env)
lookupName :: Ord n => n -> Env n a -> Maybe a
lookupName n env
= Map.lookup n (envMap env)
lookupIx :: Ord n => Int -> Env n a -> Maybe a
lookupIx ix env
= P.lookup ix (zip [0..] (envStack env))
depth :: Env n a -> Int
depth env = envStackLength env