Commit 92227c27 authored by Björn Peemöller 's avatar Björn Peemöller
Browse files

Basic envs moved to Base

parent 6081fb44
......@@ -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
......
% $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}
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))
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment