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

ScopeEnv refactored

parent 1929b9bd
......@@ -8,16 +8,19 @@
Martin Engelke (men@informatik.uni-kiel.de)
-}
module Base.ScopeEnv
( ScopeEnv
, new, insert, update, modify, lookup, sureLookup, level, exists, beginScope
, endScope, endScopeUp, toList, toLevelList, currentLevel
( Level, ScopeEnv
, new, insert, modify, lookup, level, exists, beginScope
, endScope, endScopeUp, toLevelList, currentLevel
) where
import qualified Data.Map as Map
import Prelude hiding (lookup)
import qualified Data.Map as Map
type Level = Int
type LevelMap a b = Map.Map a (b, Level)
-- |Data type for representing information in nested scopes.
data ScopeEnv a b = ScopeEnv Int (Map.Map a (b,Int)) [Map.Map a (b,Int)]
data ScopeEnv a b = ScopeEnv Level (LevelMap a b) [LevelMap a b]
deriving Show
-- |Returns an empty scope environment
......@@ -26,116 +29,80 @@ new = ScopeEnv 0 Map.empty []
-- |Inserts a value under a key into the environment of the current scope
insert :: Ord a => a -> b -> ScopeEnv a b -> ScopeEnv a b
insert k v env = modifySE insertLev env where
insertLev lev local = Map.insert k (v,lev) local
{- |Updates the value stored under an existing key in the environment of
the current scope -}
update :: Ord a => a -> b -> ScopeEnv a b -> ScopeEnv a b
update key val env = modifySE updateLev env where
updateLev _ local = maybe local
(\ (_,lev') -> Map.insert key (val,lev') local)
(Map.lookup key local)
{- |Modifies the value of an existing key by applying the function 'fun'
in the environment of the current scope -}
insert k v = modifySE insertLev
where insertLev lev = Map.insert k (v, lev)
-- |Modifies the value of an existing key by applying the function 'fun'
-- in the environment of the current scope
modify :: Ord a => (b -> b) -> a -> ScopeEnv a b -> ScopeEnv a b
modify fun key env = modifySE modifyLev env where
modifyLev _ local
= maybe local
(\ (val',lev') -> Map.insert key (fun val', lev') local)
(Map.lookup key local)
{- |Looks up the value which is stored under a key from the environment of
the current scope -}
lookup :: Ord a => a -> ScopeEnv a b -> Maybe b
lookup key env = selectSE lookupLev env where
lookupLev _ local = maybe Nothing (Just . fst) (Map.lookup key local)
modify f k = modifySE modifyLev
where modifyLev _ = Map.adjust (\ (v, l) -> (f v, l)) k
-- Similar to 'lookup', but returns an alternative value, if the key
-- doesn't exist in the environment of the current scope
sureLookup :: Ord a => a -> b -> ScopeEnv a b -> b
sureLookup key alt env = maybe alt id (lookup key env)
-- |Looks up the value which is stored under a key from the environment of
-- the current scope
lookup :: Ord a => a -> ScopeEnv a b -> Maybe b
lookup k = selectSE lookupLev
where lookupLev _ = fmap fst . Map.lookup k
-- Returns the level of the last insertion of a key
level :: Ord a => a -> ScopeEnv a b -> Int
level key env = selectSE levelLev env
where
levelLev _ local = maybe (-1) snd (Map.lookup key local)
level k = selectSE levelLev
where levelLev _ = maybe (-1) snd . Map.lookup k
-- Checks, whether a key exists in the environment of the current scope
exists :: Ord a => a -> ScopeEnv a b -> Bool
exists key env = selectSE existsLev env
where
existsLev _ local = maybe False (const True) (Map.lookup key local)
exists k = selectSE existsLev
where existsLev _ = Map.member k
-- Switches to the next scope (i.e. pushes the environment of the current
-- scope onto the top of an scope stack and increments the level counter)
beginScope :: Ord a => ScopeEnv a b -> ScopeEnv a b
beginScope (ScopeEnv lev top [])
= ScopeEnv (lev + 1) top [top]
beginScope (ScopeEnv lev top (local:locals))
= ScopeEnv (lev + 1) top (local:local:locals)
beginScope (ScopeEnv lev top [] ) = ScopeEnv (lev + 1) top [top]
beginScope (ScopeEnv lev top (l:ls)) = ScopeEnv (lev + 1) top (l:l:ls)
-- Switches to the previous scope (i.e. pops the environment from the top
-- of the scope stack and decrements the level counter)
endScope :: Ord a => ScopeEnv a b -> ScopeEnv a b
endScope (ScopeEnv _ top [])
= ScopeEnv 0 top []
endScope (ScopeEnv lev top (_:locals))
= ScopeEnv (lev - 1) top locals
endScope (ScopeEnv _ top [] ) = ScopeEnv 0 top []
endScope (ScopeEnv lev top (_:ls)) = ScopeEnv (lev - 1) top ls
-- Behaves like 'endScope' but additionally updates the environment of
-- the previous scope by updating all keys with the corresponding values
-- from the poped environment
-- from the popped environment
endScopeUp :: Ord a => ScopeEnv a b -> ScopeEnv a b
endScopeUp (ScopeEnv _ top [])
= ScopeEnv 0 top []
endScopeUp (ScopeEnv _ top (local:[]))
= ScopeEnv 0 (foldr (updateSE local) top (Map.toList top)) []
endScopeUp (ScopeEnv lev top (local:local':locals))
= ScopeEnv (lev - 1)
top
((foldr (updateSE local) local' (Map.toList local')):locals)
-- Returns the environment of current scope as a (key,value) list
toList :: Ord a => ScopeEnv a b -> [(a,b)]
toList env = selectSE toListLev env
where
toListLev _ local = map (\ (key,(val,_)) -> (key,val)) (Map.toList local)
-- Returns all (key,value) pairs from the environment of the current scope
-- which has been inserted in the current level
toLevelList :: Ord a => ScopeEnv a b -> [(a,b)]
toLevelList env = selectSE toLevelListLev env
where
toLevelListLev lev local
= map (\ (key,(val,_)) -> (key,val))
(filter (\ (_,(_,lev')) -> lev' == lev) (Map.toList local))
-- Returns the current level
currentLevel :: Ord a => ScopeEnv a b -> Int
currentLevel env = selectSE const env
{- ---------------------------------------------------------------------------
Privates...
--------------------------------------------------------------------------- -}
modifySE :: (Int -> Map.Map a (b, Int) -> Map.Map a (b, Int))
-> ScopeEnv a b
-> ScopeEnv a b
modifySE f (ScopeEnv _ top [] ) = ScopeEnv 0 (f 0 top) []
modifySE f (ScopeEnv lev top (l:ls)) = ScopeEnv lev top (f lev l:ls)
selectSE :: (Int -> Map.Map a (b,Int) -> c) -> ScopeEnv a b -> c
selectSE f (ScopeEnv _ top [] ) = f 0 top
endScopeUp (ScopeEnv _ top [] ) = ScopeEnv 0 top []
endScopeUp (ScopeEnv _ top (l:[]) ) = ScopeEnv 0 (integrate l top) []
endScopeUp (ScopeEnv lev top (l:l':ls)) = ScopeEnv (lev - 1) top
(integrate l l' : ls)
-- Return all (key, value) pairs from the environment of the current scope
-- which have been inserted in the current level
toLevelList :: Ord a => ScopeEnv a b -> [(a, b)]
toLevelList = selectSE toList
where toList lev local
= [ (k, v) | (k, (v, lev')) <- Map.toList local, lev' == lev ]
-- Return the current level
currentLevel :: Ord a => ScopeEnv a b -> Level
currentLevel = selectSE const
-- ---------------------------------------------------------------------------
-- Privates
-- ---------------------------------------------------------------------------
modifySE :: (Level -> LevelMap a b -> LevelMap a b)
-> ScopeEnv a b -> ScopeEnv a b
modifySE f (ScopeEnv _ top [] ) = ScopeEnv 0 (f 0 top) []
modifySE f (ScopeEnv lev top (l:ls)) = ScopeEnv lev top (f lev l : ls)
selectSE :: (Level -> LevelMap a b -> c) -> ScopeEnv a b -> c
selectSE f (ScopeEnv _ top [] ) = f 0 top
selectSE f (ScopeEnv lev _ (l:_)) = f lev l
updateSE :: Ord a => Map.Map a (b,Int) -> (a,(b,Int)) -> Map.Map a (b,Int)
-> Map.Map a (b,Int)
updateSE local (key,(_,lev)) local'
= maybe local'
(\ (val',lev')
-> if lev == lev' then Map.insert key (val',lev) local'
else local')
(Map.lookup key local)
integrate :: Ord a => LevelMap a b -> LevelMap a b -> LevelMap a b
integrate local = Map.mapWithKey update
where update k old@(_, l) = case Map.lookup k local of
Nothing -> old
Just (v', l')
| l == l' -> (v', l)
| otherwise -> old
......@@ -26,6 +26,8 @@ import Curry.Syntax
import Base.Messages (Message, posMessage)
import qualified Base.ScopeEnv as ScopeEnv
( ScopeEnv, new, beginScope, endScopeUp, insert, lookup, level, modify
, toLevelList, currentLevel)
import Env.Value (ValueEnv, ValueInfo (..), qualLookupValue)
......
......@@ -28,6 +28,7 @@ import qualified Curry.Syntax as CS
import Base.Messages (internalError)
import Base.ScopeEnv (ScopeEnv)
import qualified Base.ScopeEnv as ScopeEnv
(new, insert, lookup, beginScope, endScope)
import Base.TopEnv (topEnvMap)
import Base.Types
......
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