github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-23 06:41:45 +03:00
Code Issues Projects Releases Wiki Activity

Try to have a bindEnv

Browse Source
This commit is contained in:
Timothy Clem 2018-02-16 17:01:07 -08:00
parent 874590b2cf
commit 6cf86ee668
1 changed files with 6 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Data/Abstract/Environment.hs
View File

@ -10,6 +10,7 @@ import qualified Data.Set as Set
import Data.Semigroup import Data.Semigroup
import GHC.Generics import GHC.Generics
import Debug.Trace
-- | A map of names to addresses that represents the evaluation environment. -- | A map of names to addresses that represents the evaluation environment.
newtype Environment l a = Environment { unEnvironment :: Map.Map Name (Address l a) } newtype Environment l a = Environment { unEnvironment :: Map.Map Name (Address l a) }
@ -26,6 +27,11 @@ envInsert name value (Environment m) = Environment (Map.insert name value m)
envUnion :: Environment l a -> Environment l a -> Environment l a envUnion :: Environment l a -> Environment l a -> Environment l a
envUnion (Environment e1) (Environment e2) = Environment $ Map.union e1 e2 envUnion (Environment e1) (Environment e2) = Environment $ Map.union e1 e2
bindEnv :: (Show l, Show (t Name), Ord l, Foldable t) => t Name -> Environment l a -> Environment l a
bindEnv names env = trace ("bindEnv: " <> show env <> " : " <> show names) $ Environment (Map.fromList pairs)
where
pairs = foldr (\name b -> maybe b (\v -> (name, v) : b) (envLookup name env)) mempty names
-- | Retrieve the 'Live' set of addresses to which the given free variable names are bound. -- | Retrieve the 'Live' set of addresses to which the given free variable names are bound.
-- --
-- Unbound names are silently dropped. -- Unbound names are silently dropped.