{- |
    Module      :  $Header$
    Description :  Nested Environments
    Copyright   :  (c) 1999 - 2003 Wolfgang Lux
                       2011 - 2015 Björn Peemöller
    License     :  BSD-3-clause

    Maintainer  :  bjp@informatik.uni-kiel.de
    Stability   :  experimental
    Portability :  portable

   The 'NestEnv' environment type extends top-level environments  to manage
   nested scopes. Local scopes allow only for a single, unambiguous definition.

   As a matter of convenience, the module 'TopEnv' is exported by
   the module 'NestEnv'. Thus, only the latter needs to be imported.
-}

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

-- Rebinds a value to a variable, failes if the variable was unbound before
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))

-- Applies a function to a value binding, does nothing if the variable is unbound
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

-- Returns the variables and values bound on the bottom (meaning non-top) scope
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

-- Returns wether the variable is bound on the bottom (meaning non-top) scope
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