diff --git a/src/Control/Abstract/Value.hs b/src/Control/Abstract/Value.hs index 4f81e5e6b..f2e7f97db 100644 --- a/src/Control/Abstract/Value.hs +++ b/src/Control/Abstract/Value.hs @@ -205,7 +205,7 @@ instance ( Monad m namespace n env = do maybeAddr <- lookupEnv n env' <- maybe (pure mempty) (asNamespaceEnv <=< deref) maybeAddr - pure (injValue (Namespace n (env' <> env))) + pure (injValue (Namespace n (Env.overwritingUnion env' env))) where asNamespaceEnv v | Just (Namespace _ env') <- prjValue v = pure env' | otherwise = fail ("expected " <> show v <> " to be a namespace") diff --git a/src/Data/Abstract/Environment.hs b/src/Data/Abstract/Environment.hs index e5a638f29..3871abdad 100644 --- a/src/Data/Abstract/Environment.hs +++ b/src/Data/Abstract/Environment.hs @@ -5,6 +5,7 @@ module Data.Abstract.Environment , bind , delete , head + , overwritingUnion , insert , lookup , names @@ -73,6 +74,14 @@ pop (Environment (_ :| a : as)) = Environment (a :| as) head :: Environment l a -> Environment l a head (Environment (a :| _)) = Environment (a :| []) + +-- | Take the union of two environments. When duplicate keys are found in the +-- name to address map, the second definition wins. +overwritingUnion :: Environment l a -> Environment l a -> Environment l a +overwritingUnion (Environment (a :| as)) (Environment (b :| bs)) = + Environment (combine a b :| alignWith (mergeThese combine) as bs) + where combine = Map.unionWith (flip const) + -- | Extract an association list of bindings from an 'Environment'. -- -- >>> pairs shadowed