module Base.NestEnv
( module Base.TopEnv
, NestEnv, emptyEnv, bindNestEnv, qualBindNestEnv
, lookupNestEnv, qualLookupNestEnv
, rebindNestEnv, qualRebindNestEnv
, unnestEnv, toplevelEnv, globalEnv, nestEnv, elemNestEnv
, qualModifyNestEnv, modifyNestEnv, localNestEnv, qualInLocalNestEnv
) where
import qualified Data.Map as Map
import Curry.Base.Ident
import Base.Messages (internalError)
import Base.TopEnv
data NestEnv a
= GlobalEnv (TopEnv a)
| LocalEnv (NestEnv a) (Map.Map Ident a)
deriving Int -> NestEnv a -> ShowS
[NestEnv a] -> ShowS
NestEnv a -> String
(Int -> NestEnv a -> ShowS)
-> (NestEnv a -> String)
-> ([NestEnv a] -> ShowS)
-> Show (NestEnv a)
forall a. Show a => Int -> NestEnv a -> ShowS
forall a. Show a => [NestEnv a] -> ShowS
forall a. Show a => NestEnv a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NestEnv a] -> ShowS
$cshowList :: forall a. Show a => [NestEnv a] -> ShowS
show :: NestEnv a -> String
$cshow :: forall a. Show a => NestEnv a -> String
showsPrec :: Int -> NestEnv a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> NestEnv a -> ShowS
Show
instance Functor NestEnv where
fmap :: (a -> b) -> NestEnv a -> NestEnv b
fmap f :: a -> b
f (GlobalEnv env :: TopEnv a
env) = TopEnv b -> NestEnv b
forall a. TopEnv a -> NestEnv a
GlobalEnv ((a -> b) -> TopEnv a -> TopEnv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f TopEnv a
env)
fmap f :: a -> b
f (LocalEnv genv :: NestEnv a
genv env :: Map Ident a
env) = NestEnv b -> Map Ident b -> NestEnv b
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv ((a -> b) -> NestEnv a -> NestEnv b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f NestEnv a
genv) ((a -> b) -> Map Ident a -> Map Ident b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Map Ident a
env)
globalEnv :: TopEnv a -> NestEnv a
globalEnv :: TopEnv a -> NestEnv a
globalEnv = TopEnv a -> NestEnv a
forall a. TopEnv a -> NestEnv a
GlobalEnv
emptyEnv :: NestEnv a
emptyEnv :: NestEnv a
emptyEnv = TopEnv a -> NestEnv a
forall a. TopEnv a -> NestEnv a
globalEnv TopEnv a
forall a. TopEnv a
emptyTopEnv
nestEnv :: NestEnv a -> NestEnv a
nestEnv :: NestEnv a -> NestEnv a
nestEnv env :: NestEnv a
env = NestEnv a -> Map Ident a -> NestEnv a
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv NestEnv a
env Map Ident a
forall k a. Map k a
Map.empty
unnestEnv :: NestEnv a -> NestEnv a
unnestEnv :: NestEnv a -> NestEnv a
unnestEnv g :: NestEnv a
g@(GlobalEnv _) = NestEnv a
g
unnestEnv (LocalEnv genv :: NestEnv a
genv _) = NestEnv a
genv
toplevelEnv :: NestEnv a -> TopEnv a
toplevelEnv :: NestEnv a -> TopEnv a
toplevelEnv (GlobalEnv env :: TopEnv a
env) = TopEnv a
env
toplevelEnv (LocalEnv genv :: NestEnv a
genv _) = NestEnv a -> TopEnv a
forall a. NestEnv a -> TopEnv a
toplevelEnv NestEnv a
genv
bindNestEnv :: Ident -> a -> NestEnv a -> NestEnv a
bindNestEnv :: Ident -> a -> NestEnv a -> NestEnv a
bindNestEnv x :: Ident
x y :: a
y (GlobalEnv env :: TopEnv a
env) = TopEnv a -> NestEnv a
forall a. TopEnv a -> NestEnv a
GlobalEnv (TopEnv a -> NestEnv a) -> TopEnv a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ Ident -> a -> TopEnv a -> TopEnv a
forall a. Ident -> a -> TopEnv a -> TopEnv a
bindTopEnv Ident
x a
y TopEnv a
env
bindNestEnv x :: Ident
x y :: a
y (LocalEnv genv :: NestEnv a
genv env :: Map Ident a
env) = case Ident -> Map Ident a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x Map Ident a
env of
Just _ -> String -> NestEnv a
forall a. String -> a
internalError (String -> NestEnv a) -> String -> NestEnv a
forall a b. (a -> b) -> a -> b
$ "NestEnv.bindNestEnv: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Ident -> String
forall a. Show a => a -> String
show Ident
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ " is already bound"
Nothing -> NestEnv a -> Map Ident a -> NestEnv a
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv NestEnv a
genv (Map Ident a -> NestEnv a) -> Map Ident a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ Ident -> a -> Map Ident a -> Map Ident a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
x a
y Map Ident a
env
qualBindNestEnv :: QualIdent -> a -> NestEnv a -> NestEnv a
qualBindNestEnv :: QualIdent -> a -> NestEnv a -> NestEnv a
qualBindNestEnv x :: QualIdent
x y :: a
y (GlobalEnv env :: TopEnv a
env) = TopEnv a -> NestEnv a
forall a. TopEnv a -> NestEnv a
GlobalEnv (TopEnv a -> NestEnv a) -> TopEnv a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ QualIdent -> a -> TopEnv a -> TopEnv a
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualBindTopEnv QualIdent
x a
y TopEnv a
env
qualBindNestEnv x :: QualIdent
x y :: a
y (LocalEnv genv :: NestEnv a
genv env :: Map Ident a
env)
| QualIdent -> Bool
isQualified QualIdent
x = String -> NestEnv a
forall a. String -> a
internalError (String -> NestEnv a) -> String -> NestEnv a
forall a b. (a -> b) -> a -> b
$ "NestEnv.qualBindNestEnv " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
x
| Bool
otherwise = case Ident -> Map Ident a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x' Map Ident a
env of
Just _ -> String -> NestEnv a
forall a. String -> a
internalError (String -> NestEnv a) -> String -> NestEnv a
forall a b. (a -> b) -> a -> b
$ "NestEnv.qualBindNestEnv " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
x
Nothing -> NestEnv a -> Map Ident a -> NestEnv a
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv NestEnv a
genv (Map Ident a -> NestEnv a) -> Map Ident a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ Ident -> a -> Map Ident a -> Map Ident a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
x' a
y Map Ident a
env
where x' :: Ident
x' = QualIdent -> Ident
unqualify QualIdent
x
rebindNestEnv :: Ident -> a -> NestEnv a -> NestEnv a
rebindNestEnv :: Ident -> a -> NestEnv a -> NestEnv a
rebindNestEnv = QualIdent -> a -> NestEnv a -> NestEnv a
forall a. QualIdent -> a -> NestEnv a -> NestEnv a
qualRebindNestEnv (QualIdent -> a -> NestEnv a -> NestEnv a)
-> (Ident -> QualIdent) -> Ident -> a -> NestEnv a -> NestEnv a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify
qualRebindNestEnv :: QualIdent -> a -> NestEnv a -> NestEnv a
qualRebindNestEnv :: QualIdent -> a -> NestEnv a -> NestEnv a
qualRebindNestEnv x :: QualIdent
x y :: a
y (GlobalEnv env :: TopEnv a
env) = TopEnv a -> NestEnv a
forall a. TopEnv a -> NestEnv a
GlobalEnv (TopEnv a -> NestEnv a) -> TopEnv a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ QualIdent -> a -> TopEnv a -> TopEnv a
forall a. QualIdent -> a -> TopEnv a -> TopEnv a
qualRebindTopEnv QualIdent
x a
y TopEnv a
env
qualRebindNestEnv x :: QualIdent
x y :: a
y (LocalEnv genv :: NestEnv a
genv env :: Map Ident a
env)
| QualIdent -> Bool
isQualified QualIdent
x = String -> NestEnv a
forall a. String -> a
internalError (String -> NestEnv a) -> String -> NestEnv a
forall a b. (a -> b) -> a -> b
$ "NestEnv.qualRebindNestEnv " String -> ShowS
forall a. [a] -> [a] -> [a]
++ QualIdent -> String
forall a. Show a => a -> String
show QualIdent
x
| Bool
otherwise = case Ident -> Map Ident a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x' Map Ident a
env of
Just _ -> NestEnv a -> Map Ident a -> NestEnv a
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv NestEnv a
genv (Map Ident a -> NestEnv a) -> Map Ident a -> NestEnv a
forall a b. (a -> b) -> a -> b
$ Ident -> a -> Map Ident a -> Map Ident a
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Ident
x' a
y Map Ident a
env
Nothing -> NestEnv a -> Map Ident a -> NestEnv a
forall a. NestEnv a -> Map Ident a -> NestEnv a
LocalEnv (QualIdent -> a -> NestEnv a -> NestEnv a
forall a. QualIdent -> a -> NestEnv a -> NestEnv a
qualRebindNestEnv QualIdent
x a
y NestEnv a
genv) Map Ident a
env
where x' :: Ident
x' = QualIdent -> Ident
unqualify QualIdent
x
lookupNestEnv :: Ident -> NestEnv a -> [a]
lookupNestEnv :: Ident -> NestEnv a -> [a]
lookupNestEnv x :: Ident
x (GlobalEnv env :: TopEnv a
env) = Ident -> TopEnv a -> [a]
forall a. Ident -> TopEnv a -> [a]
lookupTopEnv Ident
x TopEnv a
env
lookupNestEnv x :: Ident
x (LocalEnv genv :: NestEnv a
genv env :: Map Ident a
env) = case Ident -> Map Ident a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Ident
x Map Ident a
env of
Just y :: a
y -> [a
y]
Nothing -> Ident -> NestEnv a -> [a]
forall a. Ident -> NestEnv a -> [a]
lookupNestEnv Ident
x NestEnv a
genv
qualLookupNestEnv :: QualIdent -> NestEnv a -> [a]
qualLookupNestEnv :: QualIdent -> NestEnv a -> [a]
qualLookupNestEnv x :: QualIdent
x env :: NestEnv a
env
| QualIdent -> Bool
isQualified QualIdent
x = QualIdent -> TopEnv a -> [a]
forall a. QualIdent -> TopEnv a -> [a]
qualLookupTopEnv QualIdent
x (TopEnv a -> [a]) -> TopEnv a -> [a]
forall a b. (a -> b) -> a -> b
$ NestEnv a -> TopEnv a
forall a. NestEnv a -> TopEnv a
toplevelEnv NestEnv a
env
| Bool
otherwise = Ident -> NestEnv a -> [a]
forall a. Ident -> NestEnv a -> [a]
lookupNestEnv (QualIdent -> Ident
unqualify QualIdent
x) NestEnv a
env
elemNestEnv :: Ident -> NestEnv a -> Bool
elemNestEnv :: Ident -> NestEnv a -> Bool
elemNestEnv x :: Ident
x env :: NestEnv a
env = Bool -> Bool
not ([a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Ident -> NestEnv a -> [a]
forall a. Ident -> NestEnv a -> [a]
lookupNestEnv Ident
x NestEnv a
env))
modifyNestEnv :: (a -> a) -> Ident -> NestEnv a -> NestEnv a
modifyNestEnv :: (a -> a) -> Ident -> NestEnv a -> NestEnv a
modifyNestEnv f :: a -> a
f = (a -> a) -> QualIdent -> NestEnv a -> NestEnv a
forall a. (a -> a) -> QualIdent -> NestEnv a -> NestEnv a
qualModifyNestEnv a -> a
f (QualIdent -> NestEnv a -> NestEnv a)
-> (Ident -> QualIdent) -> Ident -> NestEnv a -> NestEnv a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ident -> QualIdent
qualify
qualModifyNestEnv :: (a -> a) -> QualIdent -> NestEnv a -> NestEnv a
qualModifyNestEnv :: (a -> a) -> QualIdent -> NestEnv a -> NestEnv a
qualModifyNestEnv f :: a -> a
f x :: QualIdent
x env :: NestEnv a
env = case QualIdent -> NestEnv a -> [a]
forall a. QualIdent -> NestEnv a -> [a]
qualLookupNestEnv QualIdent
x NestEnv a
env of
[] -> NestEnv a
env
y :: a
y : _ -> QualIdent -> a -> NestEnv a -> NestEnv a
forall a. QualIdent -> a -> NestEnv a -> NestEnv a
qualRebindNestEnv QualIdent
x (a -> a
f a
y) NestEnv a
env
localNestEnv :: NestEnv a -> [(Ident, a)]
localNestEnv :: NestEnv a -> [(Ident, a)]
localNestEnv (GlobalEnv env :: TopEnv a
env) = TopEnv a -> [(Ident, a)]
forall a. TopEnv a -> [(Ident, a)]
localBindings TopEnv a
env
localNestEnv (LocalEnv _ env :: Map Ident a
env) = Map Ident a -> [(Ident, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Ident a
env
qualInLocalNestEnv :: QualIdent -> NestEnv a -> Bool
qualInLocalNestEnv :: QualIdent -> NestEnv a -> Bool
qualInLocalNestEnv x :: QualIdent
x (GlobalEnv env :: TopEnv a
env) = QualIdent -> TopEnv a -> Bool
forall a. QualIdent -> TopEnv a -> Bool
qualElemTopEnv QualIdent
x TopEnv a
env
qualInLocalNestEnv x :: QualIdent
x (LocalEnv _ env :: Map Ident a
env) = (Bool -> Bool
not (QualIdent -> Bool
isQualified QualIdent
x))
Bool -> Bool -> Bool
&& Ident -> Map Ident a -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member (QualIdent -> Ident
unqualify QualIdent
x) Map Ident a
env