Basic envs moved to Base

curry-frontend.cabal

@@ -57,8 +57,12 @@ Executable cymake
     , Base.CurryTypes
     , Base.Expr
     , Base.Messages
+    , Base.NestEnv
+    , Base.OldScopeEnv
     , Base.SCC
+    , Base.ScopeEnv
     , Base.Subst
+    , Base.TopEnv
     , Base.Types
     , Base.TypeSubst
     , Base.Typing
@@ -73,11 +77,7 @@ Executable cymake
     , Env.Interface
     , Env.Label
     , Env.ModuleAlias
-    , Env.NestEnv
-    , Env.OldScopeEnv
     , Env.OpPrec
-    , Env.ScopeEnv
-    , Env.TopEnv
     , Env.TypeConstructors
     , Env.Value
     , Generators.GenAbstractCurry

src/Env/NestEnv.lhs → src/Base/NestEnv.lhs

-
 % $Id: NestEnv.lhs,v 1.11 2003/10/04 17:04:23 wlux Exp $
 %
 % Copyright (c) 1999-2003, Wolfgang Lux
@@ -11,12 +10,11 @@ The \texttt{NestEnv} environment type extends top-level environments
 scopes allow only for a single, unambiguous definition.
 
 As a matter of convenience, the module \texttt{TopEnv} is exported by
-the module \texttt{NestEnv}.  Thus, only the latter needs to be
-imported.
+the module \texttt{NestEnv}. Thus, only the latter needs to be imported.
 \begin{verbatim}
 
-> module Env.NestEnv
->   ( module Env.TopEnv
+> module Base.NestEnv
+>   ( module Base.TopEnv
 >   , NestEnv, bindNestEnv, qualBindNestEnv, lookupNestEnv, qualLookupNestEnv
 >   , toplevelEnv, globalEnv, nestEnv
 >   ) where
@@ -25,56 +23,53 @@ imported.
 > import Curry.Base.Ident
 
 > import Base.Messages (internalError)
+> import Base.TopEnv
 
-> import Env.TopEnv
-
-> data NestEnv a = GlobalEnv (TopEnv a)
->                | LocalEnv (NestEnv a) (Map.Map Ident a)
-> --                 deriving Show
+> data NestEnv a
+>   = GlobalEnv (TopEnv a)
+>   | LocalEnv (NestEnv a) (Map.Map Ident a)
+>     deriving Show
 
 > instance Functor NestEnv where
->   fmap f (GlobalEnv env) = GlobalEnv (fmap f env)
->   fmap f (LocalEnv genv env) = LocalEnv (fmap f genv) (fmap f env)
+>   fmap f (GlobalEnv     env) = GlobalEnv (fmap f  env)
+>   fmap f (LocalEnv genv env) = LocalEnv  (fmap f genv) (fmap f env)
+
+> globalEnv :: TopEnv a -> NestEnv a
+> globalEnv = GlobalEnv
+
+> nestEnv :: NestEnv a -> NestEnv a
+> nestEnv env = LocalEnv env Map.empty
+
+> toplevelEnv :: NestEnv a -> TopEnv a
+> toplevelEnv (GlobalEnv   env) = env
+> toplevelEnv (LocalEnv genv _) = toplevelEnv genv
 
 > bindNestEnv :: Ident -> a -> NestEnv a -> NestEnv a
 > bindNestEnv x y (GlobalEnv env)
->   = GlobalEnv (bindTopEnv "NestEnv.bindNestEnv" x y env)
-> bindNestEnv x y (LocalEnv genv env) =
->   case Map.lookup x env of
->     Just _ -> internalError "NestEnv.bindNestEnv"
->     Nothing -> LocalEnv genv (Map.insert x y env)
+>   = GlobalEnv $ bindTopEnv "NestEnv.bindNestEnv" x y env
+> bindNestEnv x y (LocalEnv genv env) = case Map.lookup x env of
+>   Just  _ -> internalError "NestEnv.bindNestEnv"
+>   Nothing -> LocalEnv genv $ Map.insert x y env
 
 > qualBindNestEnv :: QualIdent -> a -> NestEnv a -> NestEnv a
 > qualBindNestEnv x y (GlobalEnv env)
->   = GlobalEnv (qualBindTopEnv "NestEnv.qualBindNestEnv" x y env)
+>   = GlobalEnv $ qualBindTopEnv "NestEnv.qualBindNestEnv" x y env
 > qualBindNestEnv x y (LocalEnv genv env)
 >   | isQualified x = internalError "NestEnv.qualBindNestEnv"
->   | otherwise =
->       case Map.lookup x' env of
->         Just _ -> internalError "NestEnv.qualBindNestEnv"
->         Nothing -> LocalEnv genv (Map.insert x' y env)
->   where x' = unqualify x
+>   | otherwise     = case Map.lookup x' env of
+>       Just  _ -> internalError "NestEnv.qualBindNestEnv"
+>       Nothing -> LocalEnv genv $ Map.insert x' y env
+>     where x' = unqualify x
 
 > lookupNestEnv :: Ident -> NestEnv a -> [a]
-> lookupNestEnv x (GlobalEnv env) = lookupTopEnv x env
-> lookupNestEnv x (LocalEnv genv env) =
->   case Map.lookup x env of
->     Just y -> [y]
->     Nothing -> lookupNestEnv x genv
+> lookupNestEnv x (GlobalEnv     env) = lookupTopEnv x env
+> lookupNestEnv x (LocalEnv genv env) = case Map.lookup x env of
+>   Just  y -> [y]
+>   Nothing -> lookupNestEnv x genv
 
 > qualLookupNestEnv :: QualIdent -> NestEnv a -> [a]
 > qualLookupNestEnv x env
->   | isQualified x = qualLookupTopEnv x (toplevelEnv env)
->   | otherwise = lookupNestEnv (unqualify x) env
-
-> toplevelEnv :: NestEnv a -> TopEnv a
-> toplevelEnv (GlobalEnv env) = env
-> toplevelEnv (LocalEnv genv _) = toplevelEnv genv
-
-> globalEnv :: TopEnv a -> NestEnv a
-> globalEnv = GlobalEnv
-
-> nestEnv :: NestEnv a -> NestEnv a
-> nestEnv env = LocalEnv env Map.empty
+>   | isQualified x = qualLookupTopEnv x $ toplevelEnv env
+>   | otherwise     = lookupNestEnv (unqualify x) env
 
 \end{verbatim}

src/Env/OldScopeEnv.hs → src/Base/OldScopeEnv.hs

-module Env.OldScopeEnv
-  ( ScopeEnv, newScopeEnv, insertIdent, getIdentLevel, isVisible, isDeclared
-  , beginScope, endScope, getLevel, genIdent, genIdentList
+module Base.OldScopeEnv
+  ( ScopeEnv, newScopeEnv, beginScope, insertIdent, genIdentList
   ) where
 
-import Data.Maybe
 import qualified Data.Map as Map
 
 import Curry.Base.Ident
 
+-- The IdEnv is an environment which stores the level in which an identifier
+-- was defined, starting with 0 for the top-level.
+type IdEnv = Map.Map IdRep Integer
+data IdRep = Name String | Index Integer deriving (Eq, Ord)
+
+insertId :: Integer -> Ident -> IdEnv -> IdEnv
+insertId level ident = Map.insert (Name  (name     ident)) level
+                     . Map.insert (Index (uniqueId ident)) level
+
+nameExists :: String -> IdEnv -> Bool
+nameExists idName = Map.member (Name idName)
+
+indexExists :: Integer -> IdEnv -> Bool
+indexExists index = Map.member (Index index)
+
+genId :: String -> IdEnv -> Maybe Ident
+genId n env
+   | nameExists n env = Nothing
+   | otherwise        = Just (p_genId (mkIdent n) 0)
+ where
+   p_genId ident index
+      | indexExists index env = p_genId ident (index + 1)
+      | otherwise             = renameIdent ident index
+
 {- Type for representing an environment containing identifiers in several
    scope levels -}
 type ScopeLevel = Integer
-type ScopeEnv = (IdEnv, [IdEnv], ScopeLevel)
+type ScopeEnv   = (IdEnv, [IdEnv], ScopeLevel)
+-- (top-level IdEnv, stack of lower level IdEnv, current level)
+-- Invariant: The current level is the number of stack elements
 
 -- Generates a new instance of a scope table
 newScopeEnv :: ScopeEnv
 newScopeEnv = (Map.empty, [], 0)
 
--- Inserts an identifier into the current level of the scope environment
+-- Insert an identifier into the current level of the scope environment
 insertIdent :: Ident -> ScopeEnv -> ScopeEnv
-insertIdent ident (topleveltab, leveltabs, level)
-   = case leveltabs of
-       (lt:lts) -> (topleveltab, (insertId level ident lt):lts, level)
-       []       -> ((insertId level ident topleveltab), [], 0)
-
--- Returns the declaration level of an identifier if it exists
-getIdentLevel :: Ident -> ScopeEnv -> Maybe Integer
-getIdentLevel ident (topleveltab, leveltabs, _)
-   = case leveltabs of
-       (lt:_) -> maybe (getIdLevel ident topleveltab) Just (getIdLevel ident lt)
-       []     -> getIdLevel ident topleveltab
-
--- Checks whether the specified identifier is visible in the current scope
--- (i.e. checks whether the identifier occurs in the scope environment)
-isVisible :: Ident -> ScopeEnv -> Bool
-isVisible ident (topleveltab, leveltabs, _)
-   = case leveltabs of
-       (lt:_) -> idExists ident lt || idExists ident topleveltab
-       []     -> idExists ident topleveltab
-
--- Checks whether the specified identifier is declared in the
--- current scope (i.e. checks whether the identifier occurs in the
--- current level of the scope environment)
-isDeclared :: Ident -> ScopeEnv -> Bool
-isDeclared ident (topleveltab, leveltabs, level)
-   = case leveltabs of
-       (lt:_) -> maybe False ((==) level) (getIdLevel ident lt)
-       []     -> maybe False ((==) 0) (getIdLevel ident topleveltab)
-
--- Increases the level of the scope.
-beginScope :: ScopeEnv -> ScopeEnv
-beginScope (topleveltab, leveltabs, level)
-   = case leveltabs of
-       (lt:lts) -> (topleveltab, (lt:lt:lts), level + 1)
-       []       -> (topleveltab, [Map.empty], 1)
-
--- Decreases the level of the scope. Identifier from higher levels
--- will be lost.
-endScope :: ScopeEnv -> ScopeEnv
-endScope (topleveltab, leveltabs, level)
-   = case leveltabs of
-       (_:lts) -> (topleveltab, lts, level - 1)
-       []      -> (topleveltab, [], 0)
-
--- Returns the level of the current scope. Top level is 0
-getLevel :: ScopeEnv -> ScopeLevel
-getLevel (_, _, level) = level
+insertIdent ident (topleveltab, leveltabs, level) = case leveltabs of
+  []       -> ((insertId level ident topleveltab), [], 0)
+  (lt:lts) -> (topleveltab, (insertId level ident lt) : lts, level)
 
--- Generates a new identifier for the specified name. The new identifier is
--- unique within the current scope. If no identifier can be generated for
--- 'name' then 'Nothing' will be returned
-genIdent :: String -> ScopeEnv -> Maybe Ident
-genIdent idName (topleveltab, leveltabs, _)
-   = case leveltabs of
-       (lt:_) -> genId idName lt
-       []     -> genId idName topleveltab
+-- Increase the level of the scope.
+beginScope :: ScopeEnv -> ScopeEnv
+beginScope (topleveltab, leveltabs, level) = case leveltabs of
+  []       -> (topleveltab, [Map.empty], 1)
+  (lt:lts) -> (topleveltab, (lt:lt:lts), level + 1)
 
 -- Generates a list of new identifiers where each identifier has
 -- the prefix 'name' followed by  an index (i.e. "var3" if 'name' was "var").
@@ -92,43 +69,48 @@ genIdentList size idName scopeenv = p_genIdentList size idName scopeenv 0
                           (i + 1)))
                           (genIdent (n ++ (show i)) env)
 
-{- ---------------------------------------------------------------------------
-  Private declarations...
---------------------------------------------------------------------------- -}
-
-type IdEnv = Map.Map IdRep Integer
-
-data IdRep = Name String | Index Integer deriving (Eq, Ord)
-
---
-insertId :: Integer -> Ident -> IdEnv -> IdEnv
-insertId level ident env
-   = Map.insert (Name (name ident))
-             level
-             (Map.insert (Index (uniqueId ident)) level env)
-
---
-idExists :: Ident -> IdEnv -> Bool
-idExists ident env = indexExists (uniqueId ident) env
-
---
-getIdLevel :: Ident -> IdEnv -> Maybe Integer
-getIdLevel ident env = Map.lookup (Index (uniqueId ident)) env
-
---
-genId :: String -> IdEnv -> Maybe Ident
-genId n env
-   | nameExists n env = Nothing
-   | otherwise        = Just (p_genId (mkIdent n) 0)
- where
-   p_genId ident index
-      | indexExists index env = p_genId ident (index + 1)
-      | otherwise             = renameIdent ident index
-
---
-nameExists :: String -> IdEnv -> Bool
-nameExists idName env = isJust (Map.lookup (Name idName) env)
-
+-- Generates a new identifier for the specified name. The new identifier is
+-- unique within the current scope. If no identifier can be generated for
+-- 'name' then 'Nothing' will be returned
+genIdent :: String -> ScopeEnv -> Maybe Ident
+genIdent idName (topleveltab, leveltabs, _) = case leveltabs of
+  []     -> genId idName topleveltab
+  (lt:_) -> genId idName lt
+
+-- -- Return the declaration level of an identifier if it exists
+-- getIdentLevel :: Ident -> ScopeEnv -> Maybe Integer
+-- getIdentLevel ident (topleveltab, leveltabs, _) = case leveltabs of
+--   []     -> getIdLevel ident topleveltab
+--   (lt:_) -> maybe (getIdLevel ident topleveltab) Just (getIdLevel ident lt)
+
+-- -- Checkswhether the specified identifier is visible in the current scope
+-- -- (i.e. check whether the identifier occurs in the scope environment)
+-- isVisible :: Ident -> ScopeEnv -> Bool
+-- isVisible ident (topleveltab, leveltabs, _) = case leveltabs of
+--   []     -> idExists ident topleveltab
+--   (lt:_) -> idExists ident lt || idExists ident topleveltab
 --
-indexExists :: Integer -> IdEnv -> Bool
-indexExists index env = isJust (Map.lookup (Index index) env)
+-- -- Check whether the specified identifier is declared in the
+-- -- current scope (i.e. checks whether the identifier occurs in the
+-- -- current level of the scope environment)
+-- isDeclared :: Ident -> ScopeEnv -> Bool
+-- isDeclared ident (topleveltab, leveltabs, level) = case leveltabs of
+--   []     -> maybe False ((==) 0) (getIdLevel ident topleveltab)
+--   (lt:_) -> maybe False ((==) level) (getIdLevel ident lt)
+
+-- -- Decrease the level of the scope. Identifier from higher levels
+-- -- will be lost.
+-- endScope :: ScopeEnv -> ScopeEnv
+-- endScope (topleveltab, leveltabs, level) = case leveltabs of
+--   []      -> (topleveltab, [], 0)
+--   (_:lts) -> (topleveltab, lts, level - 1)
+
+-- -- Return the level of the current scope. Top level is 0
+-- getLevel :: ScopeEnv -> ScopeLevel
+-- getLevel (_, _, level) = level
+
+-- idExists :: Ident -> IdEnv -> Bool
+-- idExists ident = indexExists (uniqueId ident)
+
+-- getIdLevel :: Ident -> IdEnv -> Maybe Integer
+-- getIdLevel ident = Map.lookup (Index (uniqueId ident))

src/Env/ScopeEnv.hs → src/Base/ScopeEnv.hs

@@ -7,7 +7,7 @@
     November 2005,
     Martin Engelke (men@informatik.uni-kiel.de)
 -}
-module Env.ScopeEnv
+module Base.ScopeEnv
   ( ScopeEnv
   , new, insert, update, modify, lookup, sureLookup, level, exists, beginScope
   , endScope, endScopeUp, toList, toLevelList, currentLevel